Subversion Repositories or1k

# Spindate 
# ----------------------------------------------------------------------
# Implements a Date spinner widget.  A date spinner contains three
# Spinner widgets:  one Spinner for months, one SpinInt for days,
# and one SpinInt for years.  Months can be specified as abbreviated
# strings, integers or a user-defined list.  Options exist to manage to 
# behavior, appearance, and format of each component spinner.
#
# ----------------------------------------------------------------------
#  AUTHOR: Sue Yockey                  EMAIL: yockey@actc.com
#          Mark L. Ulferts                    mulferts@austin.dsccc.com
#
#   @(#) $Id: spindate.itk,v 1.1.1.1 2002-01-16 10:24:50 markom Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1997 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Default resources.
#
option add *Spindate.monthLabel "Month" widgetDefault
option add *Spindate.dayLabel "Day" widgetDefault
option add *Spindate.yearLabel "Year" widgetDefault
option add *Spindate.monthWidth 4 widgetDefault
option add *Spindate.dayWidth 4 widgetDefault
option add *Spindate.yearWidth 4 widgetDefault

#
# Usual options.
#
itk::usual Spindate {
    keep -background -cursor -foreground -labelfont -textbackground -textfont 
}

# ------------------------------------------------------------------
#                            SPINDATE
# ------------------------------------------------------------------
class iwidgets::Spindate {
    inherit itk::Widget 
    
    constructor {args} {}
    destructor {}
    
    itk_option define -labelpos labelPos Position w
    itk_option define -orient orient Orient vertical 
    itk_option define -monthon monthOn MonthOn true 
    itk_option define -dayon dayOn DayOn true 
    itk_option define -yearon yearOn YearOn true 
    itk_option define -datemargin dateMargin Margin 1 
    itk_option define -yeardigits yearDigits YearDigits 4
    itk_option define -monthformat monthFormat MonthFormat integer 

    public {
        method get {{format "-string"}} 
        method show {{date now}} 
    }

    protected {
        method _packDate {{when later}} 
        variable _repack {}             ;# Reconfiguration flag.
    }

    private {
        method _lastDay {month year}
        method _spinMonth {direction} 
        method _spinDay {direction} 

        variable _monthFormatStr "%m"
        variable _yearFormatStr "%Y"
        variable _interior
    }
}

#
# Provide a lowercased access method for the Spindate class.
# 
proc ::iwidgets::spindate {pathName args} {
    uplevel ::iwidgets::Spindate $pathName $args
}

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
body iwidgets::Spindate::constructor {args} {
    set _interior $itk_interior

    set clicks [clock seconds]

    #
    # Create Month Spinner
    #
    itk_component add month {
        iwidgets::Spinner $itk_interior.month  -fixed 2 -justify right \
            -decrement [code $this _spinMonth -1] \
            -increment [code $this _spinMonth 1] 
    } {
        keep -background -cursor -arroworient -foreground \
                -labelfont -labelmargin -relief -textbackground \
                -textfont -repeatdelay -repeatinterval

        rename -labeltext -monthlabel monthLabel Text
        rename -width -monthwidth monthWidth Width
    }

    #
    # Take off the default bindings for selction and motion.
    #
    bind [$itk_component(month) component entry] <1> {break}
    bind [$itk_component(month) component entry] <Button1-Motion> {break}
    
    #
    # Create Day Spinner
    #
    itk_component add day {
        iwidgets::Spinint $itk_interior.day -fixed 2 -justify right \
            -decrement [code $this _spinDay -1] \
            -increment [code $this _spinDay 1]
    } {
        keep -background -cursor -arroworient -foreground \
                -labelfont -labelmargin -relief -textbackground \
                -textfont -repeatdelay -repeatinterval

        rename -labeltext -daylabel dayLabel Text
        rename -width -daywidth dayWidth Width
    }
    
    #
    # Take off the default bindings for selction and motion.
    #
    bind [$itk_component(day) component entry] <1> {break}
    bind [$itk_component(day) component entry] <Button1-Motion> {break}
    
    #
    # Create Year Spinner
    #
    itk_component add year {
        iwidgets::Spinint $itk_interior.year -fixed 2 -justify right \
            -range {1900 3000}
    } {
        keep -background -cursor -arroworient -foreground \
                -labelfont -labelmargin -relief -textbackground \
                -textfont -repeatdelay -repeatinterval

        rename -labeltext -yearlabel yearLabel Text
        rename -width -yearwidth yearWidth Width
    }

    #
    # Take off the default bindings for selction and motion.
    #
    bind [$itk_component(year) component entry] <1> {break}
    bind [$itk_component(year) component entry] <Button1-Motion> {break}
    
    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args

    #
    # Show the current date.
    #
    show now
}

# ------------------------------------------------------------------
#                           DESTRUCTOR
# ------------------------------------------------------------------
body iwidgets::Spindate::destructor {} {
    if {$_repack != ""} {after cancel $_repack}
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -labelpos
#
# Specifies the location of all 3 spinners' labels.
# ------------------------------------------------------------------
configbody iwidgets::Spindate::labelpos {
    switch $itk_option(-labelpos) {
        n {
            $itk_component(month) configure -labelpos n
            $itk_component(day) configure -labelpos n
            $itk_component(year) configure -labelpos n
            
            #
            # Un-align labels
            #
            $itk_component(month) configure -labelmargin 1
            $itk_component(day) configure -labelmargin 1
            $itk_component(year) configure -labelmargin 1 
        }
        
        s {
            $itk_component(month) configure -labelpos s
            $itk_component(day) configure -labelpos s
            $itk_component(year) configure -labelpos s
            
            #
            # Un-align labels
            #
            $itk_component(month) configure -labelmargin 1
            $itk_component(day) configure -labelmargin 1
            $itk_component(year) configure -labelmargin 1 
        }
        
        w {
            $itk_component(month) configure -labelpos w
            $itk_component(day) configure -labelpos w
            $itk_component(year) configure -labelpos w
        }
        
        e {
            $itk_component(month) configure -labelpos e
            $itk_component(day) configure -labelpos e
            $itk_component(year) configure -labelpos e
            
            #
            # Un-align labels
            #
            $itk_component(month) configure -labelmargin 1
            $itk_component(day) configure -labelmargin 1
            $itk_component(year) configure -labelmargin 1 
        }
        
        default {
            error "bad labelpos option \"$itk_option(-labelpos)\",\
                    should be n, s, w or e" 
        }
    }

    _packDate
}

# ------------------------------------------------------------------
# OPTION: -orient
# 
# Specifies the orientation of the 3 spinners for Month, Day 
# and year.
# ------------------------------------------------------------------
configbody iwidgets::Spindate::orient {
    _packDate
}

# ------------------------------------------------------------------
# OPTION: -monthon
# 
# Specifies whether or not to display the month spinner.
# ------------------------------------------------------------------
configbody iwidgets::Spindate::monthon {
    _packDate
}

# ------------------------------------------------------------------
# OPTION: -dayon
# 
# Specifies whether or not to display the day spinner.
# ------------------------------------------------------------------
configbody iwidgets::Spindate::dayon {
    _packDate
}

# ------------------------------------------------------------------
# OPTION: -yearon
# 
# Specifies whether or not to display the year spinner.
# ------------------------------------------------------------------
configbody iwidgets::Spindate::yearon {
    _packDate
}

# ------------------------------------------------------------------
# OPTION: -datemargin
# 
# Specifies the margin space between the month and day spinners 
# and the day and year spinners. 
# ------------------------------------------------------------------
configbody iwidgets::Spindate::datemargin {
    _packDate
}

# ------------------------------------------------------------------
# OPTION: -yeardigits
#
# Number of digits for year display, 2 or 4 
# ------------------------------------------------------------------
configbody iwidgets::Spindate::yeardigits {
    set clicks [clock seconds]

    switch $itk_option(-yeardigits) {
        "2" {
            $itk_component(year) configure -width 2 -fixed 2
            $itk_component(year) clear
            $itk_component(year) insert 0 [clock format $clicks -format "%y"]
            set _yearFormatStr "%y"
        }
        
        "4" {
            $itk_component(year) configure -width 4 -fixed 4
            $itk_component(year) clear
            $itk_component(year) insert 0 [clock format $clicks -format "%Y"]
            set _yearFormatStr "%Y"
        }
        
        default {
            error "bad yeardigits option \"$itk_option(-yeardigits)\",\
                    should be 2 or 4"
        }
    } 
}

# ------------------------------------------------------------------
# OPTION: -monthformat
#
# Format of month display, integers (1-12) or brief strings (Jan - 
# Dec), or full strings (January - December).
# ------------------------------------------------------------------
configbody iwidgets::Spindate::monthformat {
    set clicks [clock seconds]

    if {$itk_option(-monthformat) == "brief"} {
        $itk_component(month) configure -width 3 -fixed 3
        $itk_component(month) delete 0 end
        $itk_component(month) insert 0 [clock format $clicks -format "%b"]
        set _monthFormatStr "%b"
        
    } elseif {$itk_option(-monthformat) == "full"} {
        $itk_component(month) configure -width 9 -fixed 9
        $itk_component(month) delete 0 end
        $itk_component(month) insert 0 [clock format $clicks -format "%B"]
        set _monthFormatStr "%B"
        
    } elseif {$itk_option(-monthformat) == "integer"} {
        $itk_component(month) configure -width 2 -fixed 2 
        $itk_component(month) delete 0 end
        $itk_component(month) insert 0 [clock format $clicks -format "%m"]
        set _monthFormatStr "%m"
        
    } else {
        error "bad monthformat option\
                \"$itk_option(-monthformat)\", should be\
                \"integer\", \"brief\" or \"full\""
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: get ?format?
#
# Return the current contents of the spindate widget in one of 
# two formats string or as an integer clock value using the -string 
# and -clicks options respectively.  The default is by string.  
# Reference the clock command for more information on obtaining dates 
# and their formats.
# ------------------------------------------------------------------
body iwidgets::Spindate::get {{format "-string"}} { 
    set month [$itk_component(month) get]
    set day [$itk_component(day) get]
    set year [$itk_component(year) get]

    if {[regexp {[0-9]+} $month]} {
        set datestr "$month/$day/$year"
    } else {
        set datestr "$day $month $year"
    }

    switch -- $format {
        "-string" {
            return $datestr
        }
        "-clicks" {
            return [clock scan $datestr]
        }
        default {
            error "bad format option \"$format\":\
                   should be -string or -clicks"
        }
    }
}

# ------------------------------------------------------------------
# PUBLIC METHOD: show date
#
# Changes the currently displayed date to be that of the date 
# argument.  The date may be specified either as a string or an
# integer clock value.  Reference the clock command for more 
# information on obtaining dates and their formats.
# ------------------------------------------------------------------
body iwidgets::Spindate::show {{date "now"}} {
    #
    # Convert the date to a clock clicks value.
    #
    if {$date == "now"} {
        set seconds [clock seconds]
    } else {
        if {[catch {clock format $date}] == 0} {
            set seconds $date
        } elseif {[catch {set seconds [clock scan $date]}] != 0} {
            error "bad date: \"$date\", must be a valid date\
               string, clock clicks value or the keyword now"
        }
    }

    #
    # Display the month based on the -monthformat option.
    #
    switch $itk_option(-monthformat) {
        "brief" {
            $itk_component(month) delete 0 end
            $itk_component(month) insert 0 [clock format $seconds -format "%b"]
        }       
        "full" {
            $itk_component(month) delete 0 end
            $itk_component(month) insert 0 [clock format $seconds -format "%B"]
        }       
        "integer" {
            $itk_component(month) delete 0 end
            $itk_component(month) insert 0 [clock format $seconds -format "%m"]
        }
    }

    #
    # Display the day.
    #
    $itk_component(day) delete 0 end
    $itk_component(day) insert end [clock format $seconds -format "%d"]

    #
    # Display the year based on the -yeardigits option.
    #
    switch $itk_option(-yeardigits) {
        "2" {
            $itk_component(year) delete 0 end
            $itk_component(year) insert 0 [clock format $seconds -format "%y"]
        }
        
        "4" {
            $itk_component(year) delete 0 end
            $itk_component(year) insert 0 [clock format $seconds -format "%Y"]
        }
    }

    return
}

# ----------------------------------------------------------------
# PRIVATE METHOD: _spinMonth direction
#
# Increment or decrement month value.  We need to get the values
# for all three fields so we can make sure the day agrees with
# the month.  Should the current day be greater than the day for
# the spun month, then the day is set to the last day for the
# new month.
# ----------------------------------------------------------------
body iwidgets::Spindate::_spinMonth {direction} {
    set month [$itk_component(month) get]
    set day [$itk_component(day) get]
    set year [$itk_component(year) get]

    #
    # There appears to be a bug in the Tcl clock command in that it
    # can't scan a date like "12/31/1999 1 month" or any other date with
    # a year above 2000, but it has no problem scanning "07/01/1998 1 month".
    # So, we're going to play a game and increment by days until this
    # is fixed in Tcl.
    #
    if {$direction == 1} {
        set incrdays 32
        set day 01
    } else {
        set incrdays -28
        set day 28
    }

    if {[regexp {[0-9]+} $month]} {
        set clicks [clock scan "$month/$day/$year $incrdays day"]
    } else {
        set clicks [clock scan "$day $month $year $incrdays day"]
    }

    $itk_component(month) clear
    $itk_component(month) insert 0 \
        [clock format $clicks -format $_monthFormatStr]

    set lastday [_lastDay [$itk_component(month) get] $year]

    if {$day > $lastday} {
        $itk_component(day) clear
        $itk_component(day) insert end $lastday
    }
}

# ----------------------------------------------------------------
# PRIVATE METHOD: _spinDay direction
#
# Increment or decrement day value.  If the previous day was the
# first, then set the new day to the last day for the current
# month.  If it was the last day of the month, change it to the
# first.  Otherwise, spin it to the next day.
# ----------------------------------------------------------------
body iwidgets::Spindate::_spinDay {direction} {
    set month [$itk_component(month) get]
    set day [$itk_component(day) get]
    set year [$itk_component(year) get]
    set lastday [_lastDay $month $year]
    set currclicks [get -clicks]

    $itk_component(day) delete 0 end

    if {(($day == "01") || ($day == "1")) && ($direction == -1)} {
        $itk_component(day) insert 0 $lastday
        return
    }

    if {($day == $lastday) && ($direction == 1)} {
        $itk_component(day) insert 0 "01"
        return
    }

    set clicks [clock scan "$direction day" -base $currclicks]
    $itk_component(day) insert 0 [clock format $clicks -format "%d"]
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _packDate when
#
# Pack the components of the date spinner.  If "when" is "now", the 
# change is applied immediately.  If it is "later" or it is not 
# specified, then the change is applied later, when the application 
# is idle.
# ------------------------------------------------------------------
body iwidgets::Spindate::_packDate {{when later}} {
    if {$when == "later"} {
        if {$_repack == ""} {
            set _repack [after idle [code $this _packDate now]]
        }
        return
    } elseif {$when != "now"} {
        error "bad option \"$when\": should be now or later"
    }

    #
    # Turn off the minsizes for all the rows and columns.  
    #
    for {set i 0} {$i < 5} {incr i} {
        grid rowconfigure $_interior $i -minsize 0
        grid columnconfigure $_interior $i -minsize 0
    }

    #
    # Get some boolean 1/0 values for the -monthon and -dayon options.
    # We need this later so that Tcl doesn't complain about operands
    # of || being strings.
    #
    set monthon [expr {$itk_option(-monthon) == "1"}]
    set dayon [expr {$itk_option(-dayon) == "1"}]

    set _repack ""

    #
    # Based on the orientation, use the grid to place the components into
    # the proper rows and columns.
    #
    switch $itk_option(-orient) {
        vertical {
            set row -1
            
            if {$itk_option(-monthon)} {
                grid $itk_component(month) -row [incr row] -column 0 \
                    -sticky nsew 
            } else {
                grid forget $itk_component(month)
            }
            
            if {$itk_option(-dayon)} {
                if {$itk_option(-dayon)} {
                    grid rowconfigure $_interior [incr row] \
                        -minsize $itk_option(-datemargin)
                }

                grid $itk_component(day) -row [incr row] -column 0 \
                    -sticky nsew 
            } else {
                grid forget $itk_component(day)
            }
            
            if {$itk_option(-yearon)} {
                if {$monthon || $dayon} {
                    grid rowconfigure $_interior [incr row] \
                        -minsize $itk_option(-datemargin)
                }

                grid $itk_component(year) -row [incr row] -column 0 \
                    -sticky nsew 
            } else {
                grid forget $itk_component(year)
            }
            
            if {$itk_option(-labelpos) == "w"} {
                iwidgets::Labeledwidget::alignlabels $itk_component(month) \
                        $itk_component(day) $itk_component(year)
            }
        }
        
        horizontal {
            set column -1

            if {$itk_option(-monthon)} {
                grid $itk_component(month) -row 0 -column [incr column] \
                    -sticky nsew 
            } else {
                grid forget $itk_component(month)
            }
            
            if {$itk_option(-dayon)} {
                if {$itk_option(-monthon)} {
                    grid columnconfigure $_interior [incr column] \
                        -minsize $itk_option(-datemargin)
                }

                grid $itk_component(day) -row 0 -column [incr column] \
                    -sticky nsew 
            } else {
                grid forget $itk_component(day)
            }
            
            if {$itk_option(-yearon)} {
                if {$monthon || $dayon} {
                    grid columnconfigure $_interior [incr column] \
                        -minsize $itk_option(-datemargin)
                }

                grid $itk_component(year) -row 0 -column [incr column] \
                    -sticky nsew 
            } else {
                grid forget $itk_component(year)
            }
            
            #
            # Un-align labels.
            #
            $itk_component(month) configure -labelmargin 1
            $itk_component(day) configure -labelmargin 1
            $itk_component(year) configure -labelmargin 1
        }
        
        default {
            error "bad orient option \"$itk_option(-orient)\", should\
                    be \"vertical\" or \"horizontal\""
        } 
    }
} 

# ------------------------------------------------------------------
# PRIVATE METHOD: _lastDay month year
#
# Internal method which determines the last day of the month for
# the given month and year.  We start at 28 and go forward till
# we fail.  Crude but effective.
# ------------------------------------------------------------------
body iwidgets::Spindate::_lastDay {month year} {
    set lastone 28

    for {set lastone 28} {$lastone < 32} {incr lastone} {
        if {[regexp {[0-9]+} $month]} {
            if {[catch {clock scan "$month/[expr $lastone + 1]/$year"}] != 0} {
                return $lastone
            }
        } else {
            if {[catch {clock scan "[expr $lastone + 1] $month $year"}] != 0} {
                return $lastone
            }
        }
    }
}