iwidgets4 4.0.1-6 / usr / share / tcltk / iwidgets4.0.1 / scripts / spindate.itk

# 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
	  }
	}
    }
}