| # 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.5 2001/08/22 15:51:13 smithc 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 |
| # ------------------------------------------------------------------ |
| itcl::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 |
| # ------------------------------------------------------------------ |
| itcl::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 [itcl::code $this _spinMonth -1] \ |
| -increment [itcl::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 [itcl::code $this _spinDay -1] \ |
| -increment [itcl::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 |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spindate::destructor {} { |
| if {$_repack != ""} {after cancel $_repack} |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTIONS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -labelpos |
| # |
| # Specifies the location of all 3 spinners' labels. |
| # ------------------------------------------------------------------ |
| itcl::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. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spindate::orient { |
| _packDate |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -monthon |
| # |
| # Specifies whether or not to display the month spinner. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spindate::monthon { |
| _packDate |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -dayon |
| # |
| # Specifies whether or not to display the day spinner. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spindate::dayon { |
| _packDate |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -yearon |
| # |
| # Specifies whether or not to display the year spinner. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spindate::yearon { |
| _packDate |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -datemargin |
| # |
| # Specifies the margin space between the month and day spinners |
| # and the day and year spinners. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spindate::datemargin { |
| _packDate |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -yeardigits |
| # |
| # Number of digits for year display, 2 or 4 |
| # ------------------------------------------------------------------ |
| itcl::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). |
| # ------------------------------------------------------------------ |
| itcl::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. |
| # ------------------------------------------------------------------ |
| itcl::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. |
| # ------------------------------------------------------------------ |
| itcl::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. |
| # ---------------------------------------------------------------- |
| itcl::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 currday [$itk_component(day) get] |
| set lastday [_lastDay [$itk_component(month) get] $year] |
| |
| if {$currday > $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. |
| # ---------------------------------------------------------------- |
| itcl::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. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spindate::_packDate {{when later}} { |
| if {$when == "later"} { |
| if {$_repack == ""} { |
| set _repack [after idle [itcl::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 |
| } |
| |
| 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 {$itk_option(-monthon) || $itk_option(-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 {$itk_option(-monthon) || $itk_option(-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. |
| # ------------------------------------------------------------------ |
| itcl::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 |
| } |
| } |
| } |
| } |