| # |
| # Calendar |
| # ---------------------------------------------------------------------- |
| # Implements a calendar widget for the selection of a date. It displays |
| # a single month at a time. Buttons exist on the top to change the |
| # month in effect turning th pages of a calendar. As a page is turned, |
| # the dates for the month are modified. Selection of a date visually |
| # marks that date. The selected value can be monitored via the |
| # -command option or just retrieved using the get method. Methods also |
| # exist to select a date and show a particular month. The option set |
| # allows the calendars appearance to take on many forms. |
| # ---------------------------------------------------------------------- |
| # AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com |
| # |
| # ACKNOWLEDGEMENTS: Michael McLennan E-mail: mmclennan@lucent.com |
| # |
| # This code is an [incr Tk] port of the calendar code shown in Michael |
| # J. McLennan's book "Effective Tcl" from Addison Wesley. Small |
| # modificiations were made to the logic here and there to make it a |
| # mega-widget and the command and option interface was expanded to make |
| # it even more configurable, but the underlying logic is the same. |
| # |
| # @(#) $Id: calendar.itk,v 1.7 2002/09/05 19:33:06 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. |
| # ====================================================================== |
| |
| # |
| # Usual options. |
| # |
| itk::usual Calendar { |
| keep -background -cursor |
| } |
| |
| # ------------------------------------------------------------------ |
| # CALENDAR |
| # ------------------------------------------------------------------ |
| itcl::class iwidgets::Calendar { |
| inherit itk::Widget |
| |
| constructor {args} {} |
| |
| itk_option define -days days Days {Su Mo Tu We Th Fr Sa} |
| itk_option define -command command Command {} |
| itk_option define -forwardimage forwardImage Image {} |
| itk_option define -backwardimage backwardImage Image {} |
| itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9 |
| itk_option define -weekendbackground weekendBackground Background \#d9d9d9 |
| itk_option define -outline outline Outline \#d9d9d9 |
| itk_option define -buttonforeground buttonForeground Foreground blue |
| itk_option define -foreground foreground Foreground black |
| itk_option define -selectcolor selectColor Foreground red |
| itk_option define -selectthickness selectThickness SelectThickness 3 |
| itk_option define -titlefont titleFont Font \ |
| -*-helvetica-bold-r-normal--*-140-* |
| itk_option define -dayfont dayFont Font \ |
| -*-helvetica-medium-r-normal--*-120-* |
| itk_option define -datefont dateFont Font \ |
| -*-helvetica-medium-r-normal--*-120-* |
| itk_option define -currentdatefont currentDateFont Font \ |
| -*-helvetica-bold-r-normal--*-120-* |
| itk_option define -startday startDay Day sunday |
| itk_option define -int int DateFormat no |
| |
| public method get {{format "-string"}} ;# Returns the selected date |
| public method select {{date_ "now"}} ;# Selects date, moving select ring |
| public method show {{date_ "now"}} ;# Displays a specific date |
| |
| protected method _drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} |
| |
| private method _change {delta_} |
| private method _configureHandler {} |
| private method _redraw {} |
| private method _days {{wmax {}}} |
| private method _layout {time_} |
| private method _select {date_} |
| private method _selectEvent {date_} |
| private method _adjustday {day_} |
| private method _percentSubst {pattern_ string_ subst_} |
| |
| private variable _time {} |
| private variable _selected {} |
| private variable _initialized 0 |
| private variable _offset 0 |
| private variable _format {} |
| } |
| |
| # |
| # Provide a lowercased access method for the Calendar class. |
| # |
| proc ::iwidgets::calendar {pathName args} { |
| uplevel ::iwidgets::Calendar $pathName $args |
| } |
| |
| # |
| # Use option database to override default resources of base classes. |
| # |
| option add *Calendar.width 200 widgetDefault |
| option add *Calendar.height 165 widgetDefault |
| |
| # ------------------------------------------------------------------ |
| # CONSTRUCTOR |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::constructor {args} { |
| # |
| # Create the canvas which displays each page of the calendar. |
| # |
| itk_component add page { |
| canvas $itk_interior.page |
| } { |
| keep -background -cursor -width -height |
| } |
| pack $itk_component(page) -expand yes -fill both |
| |
| # |
| # Create the forward and backward buttons. Rather than pack |
| # them directly in the hull, we'll waittill later and make |
| # them canvas window items. |
| # |
| itk_component add backward { |
| button $itk_component(page).backward \ |
| -command [itcl::code $this _change -1] |
| } { |
| keep -background -cursor |
| } |
| |
| itk_component add forward { |
| button $itk_component(page).forward \ |
| -command [itcl::code $this _change +1] |
| } { |
| keep -background -cursor |
| } |
| |
| # |
| # Set the initial time to now. |
| # |
| set _time [clock seconds] |
| |
| # |
| # Bind to the configure event which will be used to redraw |
| # the calendar and display the month. |
| # |
| bind $itk_component(page) <Configure> [itcl::code $this _configureHandler] |
| |
| # |
| # Evaluate the option arguments. |
| # |
| eval itk_initialize $args |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTIONS |
| # ------------------------------------------------------------------ |
| # ------------------------------------------------------------------ |
| # OPTION: -int |
| # |
| # Added by Mark Alston 2001/10/21 |
| # |
| # Allows for the use of dates in "international" format: YYYY-MM-DD. |
| # It must be a boolean value. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::int { |
| switch $itk_option(-int) { |
| 1 - yes - true - on { |
| set itk_option(-int) yes |
| } |
| 0 - no - false - off { |
| set itk_option(-int) no |
| } |
| default { |
| error "bad int option \"$itk_option(-int)\": should be boolean" |
| } |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -command |
| # |
| # Sets the selection command for the calendar. When the user |
| # selects a date on the calendar, the date is substituted in |
| # place of "%d" in this command, and the command is executed. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::command {} |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -days |
| # |
| # The days option takes a list of values to set the text used to display the |
| # days of the week header above the dates. The default value is |
| # {Su Mo Tu We Th Fr Sa}. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::days { |
| if {$_initialized} { |
| if {[$itk_component(page) find withtag days] != {}} { |
| $itk_component(page) delete days |
| _days |
| } |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -backwardimage |
| # |
| # Specifies a image to be displayed on the backwards calendar |
| # button. If none is specified, a default is provided. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::backwardimage { |
| |
| # |
| # If no image is given, then we'll use the default image. |
| # |
| if {$itk_option(-backwardimage) == {}} { |
| |
| # |
| # If the default image hasn't yet been created, then we |
| # need to create it. |
| # |
| if {[lsearch [image names] $this-backward] == -1} { |
| image create bitmap $this-backward \ |
| -foreground $itk_option(-buttonforeground) -data { |
| #define back_width 16 |
| #define back_height 16 |
| static unsigned char back_bits[] = { |
| 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x30, |
| 0xe0, 0x38, 0xf0, 0x3c, 0xf8, 0x3e, 0xfc, 0x3f, |
| 0xfc, 0x3f, 0xf8, 0x3e, 0xf0, 0x3c, 0xe0, 0x38, |
| 0xc0, 0x30, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; |
| } |
| } |
| |
| # |
| # Configure the button to use the default image. |
| # |
| $itk_component(backward) configure -image $this-backward |
| |
| # |
| # Else, an image has been specified. First, we'll need to make sure |
| # the image really exists before configuring the button to use it. |
| # If it doesn't generate an error. |
| # |
| } else { |
| if {[lsearch [image names] $itk_option(-backwardimage)] != -1} { |
| $itk_component(backward) configure \ |
| -image $itk_option(-backwardimage) |
| } else { |
| error "bad image name \"$itk_option(-backwardimage)\":\ |
| image does not exist" |
| } |
| |
| # |
| # If we previously created a default image, we'll just remove it. |
| # |
| if {[lsearch [image names] $this-backward] != -1} { |
| image delete $this-backward |
| } |
| } |
| } |
| |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -forwardimage |
| # |
| # Specifies a image to be displayed on the forwards calendar |
| # button. If none is specified, a default is provided. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::forwardimage { |
| |
| # |
| # If no image is given, then we'll use the default image. |
| # |
| if {$itk_option(-forwardimage) == {}} { |
| |
| # |
| # If the default image hasn't yet been created, then we |
| # need to create it. |
| # |
| if {[lsearch [image names] $this-forward] == -1} { |
| image create bitmap $this-forward \ |
| -foreground $itk_option(-buttonforeground) -data { |
| #define fwd_width 16 |
| #define fwd_height 16 |
| static unsigned char fwd_bits[] = { |
| 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x03, |
| 0x1c, 0x07, 0x3c, 0x0f, 0x7c, 0x1f, 0xfc, 0x3f, |
| 0xfc, 0x3f, 0x7c, 0x1f, 0x3c, 0x0f, 0x1c, 0x07, |
| 0x0c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; |
| } |
| } |
| |
| # |
| # Configure the button to use the default image. |
| # |
| $itk_component(forward) configure -image $this-forward |
| |
| # |
| # Else, an image has been specified. First, we'll need to make sure |
| # the image really exists before configuring the button to use it. |
| # If it doesn't generate an error. |
| # |
| } else { |
| if {[lsearch [image names] $itk_option(-forwardimage)] != -1} { |
| $itk_component(forward) configure \ |
| -image $itk_option(-forwardimage) |
| } else { |
| error "bad image name \"$itk_option(-forwardimage)\":\ |
| image does not exist" |
| } |
| |
| # |
| # If we previously created a default image, we'll just remove it. |
| # |
| if {[lsearch [image names] $this-forward] != -1} { |
| image delete $this-forward |
| } |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -weekdaybackground |
| # |
| # Specifies the background for the weekdays which allows it to |
| # be visually distinguished from the weekend. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::weekdaybackground { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure weekday \ |
| -fill $itk_option(-weekdaybackground) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -weekendbackground |
| # |
| # Specifies the background for the weekdays which allows it to |
| # be visually distinguished from the weekdays. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::weekendbackground { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure weekend \ |
| -fill $itk_option(-weekendbackground) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -foreground |
| # |
| # Specifies the foreground color for the textual items, buttons, |
| # and divider on the calendar. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::foreground { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure text \ |
| -fill $itk_option(-foreground) |
| $itk_component(page) itemconfigure line \ |
| -fill $itk_option(-foreground) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -outline |
| # |
| # Specifies the outline color used to surround the date text. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::outline { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure square \ |
| -outline $itk_option(-outline) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -buttonforeground |
| # |
| # Specifies the foreground color of the forward and backward buttons. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::buttonforeground { |
| if {$_initialized} { |
| if {$itk_option(-forwardimage) == {}} { |
| if {[lsearch [image names] $this-forward] != -1} { |
| $this-forward configure \ |
| -foreground $itk_option(-buttonforeground) |
| } |
| } else { |
| $itk_component(forward) configure \ |
| -foreground $itk_option(-buttonforeground) |
| } |
| |
| if {$itk_option(-backwardimage) == {}} { |
| if {[lsearch [image names] $this-backward] != -1} { |
| $this-backward configure \ |
| -foreground $itk_option(-buttonforeground) |
| } |
| } else { |
| $itk_component(-backward) configure \ |
| -foreground $itk_option(-buttonforeground) |
| } |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -selectcolor |
| # |
| # Specifies the color of the ring displayed that distinguishes the |
| # currently selected date. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::selectcolor { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure $_selected-sensor \ |
| -outline $itk_option(-selectcolor) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -selectthickness |
| # |
| # Specifies the thickness of the ring displayed that distinguishes |
| # the currently selected date. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::selectthickness { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure $_selected-sensor \ |
| -width $itk_option(-selectthickness) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -titlefont |
| # |
| # Specifies the font used for the title text that consists of the |
| # month and year. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::titlefont { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure title \ |
| -font $itk_option(-titlefont) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -datefont |
| # |
| # Specifies the font used for the date text that consists of the |
| # day of the month. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::datefont { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure date \ |
| -font $itk_option(-datefont) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -currentdatefont |
| # |
| # Specifies the font used for the current date text. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::currentdatefont { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure now \ |
| -font $itk_option(-currentdatefont) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -dayfont |
| # |
| # Specifies the font used for the day of the week text. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::dayfont { |
| if {$_initialized} { |
| $itk_component(page) itemconfigure days \ |
| -font $itk_option(-dayfont) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -startday |
| # |
| # Specifies the starting day for the week. The value must be a day of the |
| # week: sunday, monday, tuesday, wednesday, thursday, friday, or |
| # saturday. The default is sunday. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Calendar::startday { |
| set day [string tolower $itk_option(-startday)] |
| |
| switch $day { |
| sunday {set _offset 0} |
| monday {set _offset 1} |
| tuesday {set _offset 2} |
| wednesday {set _offset 3} |
| thursday {set _offset 4} |
| friday {set _offset 5} |
| saturday {set _offset 6} |
| default { |
| error "bad startday option \"$itk_option(-startday)\":\ |
| should be sunday, monday, tuesday, wednesday,\ |
| thursday, friday, or saturday" |
| } |
| } |
| |
| if {$_initialized} { |
| $itk_component(page) delete all-page |
| _redraw |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHODS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # PUBLIC METHOD: get ?format? |
| # |
| # Returns the currently selected date 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::Calendar::get {{format "-string"}} { |
| switch -- $format { |
| "-string" { |
| return $_selected |
| } |
| "-clicks" { |
| return [clock scan $_selected] |
| } |
| default { |
| error "bad format option \"$format\":\ |
| should be -string or -clicks" |
| } |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PUBLIC METHOD: select date_ |
| # |
| # Changes the currently selected date to the value specified. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::select {{date_ "now"}} { |
| if {$date_ == "now"} { |
| set time [clock seconds] |
| } else { |
| if {[catch {clock format $date_}] == 0} { |
| set time $date_ |
| } elseif {[catch {set time [clock scan $date_]}] != 0} { |
| error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now" |
| } |
| } |
| switch $itk_option(-int) { |
| yes { set _format "%Y-%m-%d" } |
| no { set _format "%m/%d/%Y" } |
| } |
| _select [clock format $time -format "$_format"] |
| } |
| |
| # ------------------------------------------------------------------ |
| # PUBLIC METHOD: show date_ |
| # |
| # Changes the currently display month to be that of the specified |
| # date. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::show {{date_ "now"}} { |
| if {$date_ == "now"} { |
| set _time [clock seconds] |
| } else { |
| if {[catch {clock format $date_}] == 0} { |
| set _time $date_ |
| } elseif {[catch {set _time [clock scan $date_]}] != 0} { |
| error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now" |
| } |
| } |
| |
| $itk_component(page) delete all-page |
| _redraw |
| } |
| |
| # ------------------------------------------------------------------ |
| # PROTECTED METHOD: _drawtext canvas_ day_ date_ now_ |
| # x0_ y0_ x1_ y1_ |
| # |
| # Draws the text in the date square. The method is protected such that |
| # it can be overridden in derived classes that may wish to add their |
| # own unique text. The method receives the day to draw along with |
| # the coordinates of the square. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} { |
| set item [$canvas_ create text \ |
| [expr {(($x1_ - $x0_) / 2) + $x0_}] \ |
| [expr {(($y1_ -$y0_) / 2) + $y0_ + 1}] \ |
| -anchor center -text "$day_" \ |
| -fill $itk_option(-foreground)] |
| |
| if {$date_ == $now_} { |
| $canvas_ itemconfigure $item \ |
| -font $itk_option(-currentdatefont) \ |
| -tags [list all-page date text now] |
| } else { |
| $canvas_ itemconfigure $item \ |
| -font $itk_option(-datefont) \ |
| -tags [list all-page date text] |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _configureHandler |
| # |
| # Processes a configure event received on the canvas. The method |
| # deletes all the current canvas items and forces a redraw. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_configureHandler {} { |
| set _initialized 1 |
| |
| $itk_component(page) delete all |
| _redraw |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _change delta_ |
| # |
| # Changes the current month displayed in the calendar, moving |
| # forward or backward by <delta_> months where <delta_> is +/- |
| # some number. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_change {delta_} { |
| set dir [expr {($delta_ > 0) ? 1 : -1}] |
| set month [clock format $_time -format "%m"] |
| set month [string trimleft $month 0] |
| set year [clock format $_time -format "%Y"] |
| |
| for {set i 0} {$i < abs($delta_)} {incr i} { |
| incr month $dir |
| if {$month < 1} { |
| set month 12 |
| incr year -1 |
| } elseif {$month > 12} { |
| set month 1 |
| incr year 1 |
| } |
| } |
| if {[catch {set _time [clock scan "$month/1/$year"]}]} { |
| bell |
| } else { |
| _redraw |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _redraw |
| # |
| # Redraws the calendar. This method is invoked whenever the |
| # calendar changes size or we need to effect a change such as draw |
| # it with a new month. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_redraw {} { |
| # |
| # Set the format based on the option -int |
| # |
| switch $itk_option(-int) { |
| yes { set _format "%Y-%m-%d" } |
| no { set _format "%m/%d/%Y" } |
| } |
| # |
| # Remove all the items that typically change per redraw request |
| # such as the title and dates. Also, get the maximum width and |
| # height of the page. |
| # |
| $itk_component(page) delete all-page |
| |
| set wmax [winfo width $itk_component(page)] |
| set hmax [winfo height $itk_component(page)] |
| |
| # |
| # If we haven't yet created the forward and backwards buttons, |
| # then dot it; otherwise, skip it. |
| # |
| if {[$itk_component(page) find withtag button] == {}} { |
| $itk_component(page) create window 3 3 -anchor nw \ |
| -window $itk_component(backward) -tags button |
| $itk_component(page) create window [expr {$wmax-3}] 3 -anchor ne \ |
| -window $itk_component(forward) -tags button |
| } |
| |
| # |
| # Create the title centered between the buttons. |
| # |
| foreach {x0 y0 x1 y1} [$itk_component(page) bbox button] { |
| set x [expr {(($x1-$x0)/2)+$x0}] |
| set y [expr {(($y1-$y0)/2)+$y0}] |
| } |
| |
| set title [clock format $_time -format "%B %Y"] |
| $itk_component(page) create text $x $y -anchor center \ |
| -text $title -font $itk_option(-titlefont) \ |
| -fill $itk_option(-foreground) \ |
| -tags [list title text all-page] |
| |
| # |
| # Add the days of the week labels if they haven't yet been created. |
| # |
| if {[$itk_component(page) find withtag days] == {}} { |
| _days $wmax |
| } |
| |
| # |
| # Add a line between the calendar header and the dates if needed. |
| # |
| set bottom [expr {[lindex [$itk_component(page) bbox all] 3] + 3}] |
| |
| if {[$itk_component(page) find withtag line] == {}} { |
| $itk_component(page) create line 0 $bottom $wmax $bottom \ |
| -width 2 -tags line |
| } |
| |
| incr bottom 3 |
| |
| # |
| # Get the layout for the time value and create the date squares. |
| # This includes the surrounding date rectangle, the date text, |
| # and the sensor. Bind selection to the sensor. |
| # |
| set current "" |
| set now [clock format [clock seconds] -format "$_format"] |
| |
| set layout [_layout $_time] |
| set weeks [expr {[lindex $layout end] + 1}] |
| |
| foreach {day date kind dcol wrow} $layout { |
| set x0 [expr {$dcol*($wmax-7)/7+3}] |
| set y0 [expr {$wrow*($hmax-$bottom-4)/$weeks+$bottom}] |
| set x1 [expr {($dcol+1)*($wmax-7)/7+3}] |
| set y1 [expr {($wrow+1)*($hmax-$bottom-4)/$weeks+$bottom}] |
| |
| if {$date == $_selected} { |
| set current $date |
| } |
| |
| # |
| # Create the rectangle that surrounds the date and configure |
| # its background based on the wheather it is a weekday or |
| # a weekend. |
| # |
| set item [$itk_component(page) create rectangle $x0 $y0 $x1 $y1 \ |
| -outline $itk_option(-outline)] |
| |
| if {$kind == "weekend"} { |
| $itk_component(page) itemconfigure $item \ |
| -fill $itk_option(-weekendbackground) \ |
| -tags [list all-page square weekend] |
| } else { |
| $itk_component(page) itemconfigure $item \ |
| -fill $itk_option(-weekdaybackground) \ |
| -tags [list all-page square weekday] |
| } |
| |
| # |
| # Create the date text and configure its font based on the |
| # wheather or not it is the current date. |
| # |
| _drawtext $itk_component(page) $day $date $now $x0 $y0 $x1 $y1 |
| |
| # |
| # Create a sensor area to detect selections. Bind the |
| # sensor and pass the date to the bind script. |
| # |
| $itk_component(page) create rectangle $x0 $y0 $x1 $y1 \ |
| -outline "" -fill "" \ |
| -tags [list $date-sensor all-sensor all-page] |
| |
| $itk_component(page) bind $date-sensor <ButtonPress-1> \ |
| [itcl::code $this _selectEvent $date] |
| } |
| |
| # |
| # Highlight the selected date if it is on this page. |
| # |
| if {$current != ""} { |
| $itk_component(page) itemconfigure $current-sensor \ |
| -outline $itk_option(-selectcolor) \ |
| -width $itk_option(-selectthickness) |
| |
| $itk_component(page) raise $current-sensor |
| |
| } elseif {$_selected == ""} { |
| set date [clock format $_time -format "$_format"] |
| _select $date |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _days |
| # |
| # Used to rewite the days of the week label just below the month |
| # title string. The days are given in the -days option. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_days {{wmax {}}} { |
| if {$wmax == {}} { |
| set wmax [winfo width $itk_component(page)] |
| } |
| |
| set col 0 |
| set bottom [expr {[lindex [$itk_component(page) bbox title buttons] 3] + 7}] |
| |
| foreach dayoweek $itk_option(-days) { |
| set x0 [expr {$col*($wmax/7)}] |
| set x1 [expr {($col+1)*($wmax/7)}] |
| |
| $itk_component(page) create text \ |
| [expr {(($x1 - $x0) / 2) + $x0}] $bottom \ |
| -anchor n -text "$dayoweek" \ |
| -fill $itk_option(-foreground) \ |
| -font $itk_option(-dayfont) \ |
| -tags [list days text] |
| |
| incr col |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _layout time_ |
| # |
| # Used whenever the calendar is redrawn. Finds the month containing |
| # a <time_> in seconds, and returns a list for all of the days in |
| # that month. The list looks like this: |
| # |
| # {day1 date1 kind1 c1 r1 day2 date2 kind2 c2 r2 ...} |
| # |
| # where dayN is a day number like 1,2,3,..., dateN is the date for |
| # dayN, kindN is the day type of weekday or weekend, and cN,rN |
| # are the column/row indices for the square containing that date. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_layout {time_} { |
| |
| switch $itk_option(-int) { |
| yes { set _format "%Y-%m-%d" } |
| no { set _format "%m/%d/%Y" } |
| } |
| |
| set month [clock format $time_ -format "%m"] |
| set year [clock format $time_ -format "%Y"] |
| |
| foreach lastday {31 30 29 28} { |
| if {[catch {clock scan "$month/$lastday/$year"}] == 0} { |
| break |
| } |
| } |
| set seconds [clock scan "$month/1/$year"] |
| set firstday [_adjustday [clock format $seconds -format %w]] |
| |
| set weeks [expr {ceil(double($lastday+$firstday)/7)}] |
| |
| set rlist "" |
| for {set day 1} {$day <= $lastday} {incr day} { |
| set seconds [clock scan "$month/$day/$year"] |
| set date [clock format $seconds -format "$_format"] |
| set dayoweek [clock format $seconds -format %w] |
| |
| if {$dayoweek == 0 || $dayoweek == 6} { |
| set kind "weekend" |
| } else { |
| set kind "weekday" |
| } |
| |
| set daycol [_adjustday $dayoweek] |
| |
| set weekrow [expr {($firstday+$day-1)/7}] |
| lappend rlist $day $date $kind $daycol $weekrow |
| } |
| return $rlist |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _adjustday day_ |
| # |
| # Modifies the day to be in accordance with the startday option. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_adjustday {day_} { |
| set retday [expr {$day_ - $_offset}] |
| |
| if {$retday < 0} { |
| set retday [expr {$retday + 7}] |
| } |
| |
| return $retday |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _select date_ |
| # |
| # Selects the current <date_> on the calendar. Highlights the date |
| # on the calendar, and executes the command associated with the |
| # calendar, with the selected date substituted in place of "%d". |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_select {date_} { |
| |
| switch $itk_option(-int) { |
| yes { set _format "%Y-%m-%d" } |
| no { set _format "%m/%d/%Y" } |
| } |
| |
| |
| set time [clock scan $date_] |
| set date [clock format $time -format "$_format"] |
| |
| set _selected $date |
| set current [clock format $_time -format "%m %Y"] |
| set selected [clock format $time -format "%m %Y"] |
| |
| if {$current == $selected} { |
| $itk_component(page) itemconfigure all-sensor \ |
| -outline "" -width 1 |
| |
| $itk_component(page) itemconfigure $date-sensor \ |
| -outline $itk_option(-selectcolor) \ |
| -width $itk_option(-selectthickness) |
| $itk_component(page) raise $date-sensor |
| } else { |
| set _time $time |
| _redraw |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _selectEvent date_ |
| # |
| # Selects the current <date_> on the calendar. Highlights the date |
| # on the calendar, and executes the command associated with the |
| # calendar, with the selected date substituted in place of "%d". |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_selectEvent {date_} { |
| _select $date_ |
| |
| if {[string trim $itk_option(-command)] != ""} { |
| set cmd $itk_option(-command) |
| set cmd [_percentSubst %d $cmd [get]] |
| uplevel #0 $cmd |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _percentSubst pattern_ string_ subst_ |
| # |
| # This command is a "safe" version of regsub, for substituting |
| # each occurance of <%pattern_> in <string_> with <subst_>. The |
| # usual Tcl "regsub" command does the same thing, but also |
| # converts characters like "&" and "\0", "\1", etc. that may |
| # be present in the <subst_> string. |
| # |
| # Returns <string_> with <subst_> substituted in place of each |
| # <%pattern_>. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Calendar::_percentSubst {pattern_ string_ subst_} { |
| if {![string match %* $pattern_]} { |
| error "bad pattern \"$pattern_\": should be %something" |
| } |
| |
| set rval "" |
| while {[regexp "(.*)${pattern_}(.*)" $string_ all head tail]} { |
| set rval "$subst_$tail$rval" |
| set string_ $head |
| } |
| set rval "$string_$rval" |
| } |