1# 2# Calendar 3# ---------------------------------------------------------------------- 4# Implements a calendar widget for the selection of a date. It displays 5# a single month at a time. Buttons exist on the top to change the 6# month in effect turning th pages of a calendar. As a page is turned, 7# the dates for the month are modified. Selection of a date visually 8# marks that date. The selected value can be monitored via the 9# -command option or just retrieved using the get method. Methods also 10# exist to select a date and show a particular month. The option set 11# allows the calendars appearance to take on many forms. 12# ---------------------------------------------------------------------- 13# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com 14# 15# ACKNOWLEDGEMENTS: Michael McLennan E-mail: mmclennan@lucent.com 16# 17# This code is an [incr Tk] port of the calendar code shown in Michael 18# J. McLennan's book "Effective Tcl" from Addison Wesley. Small 19# modificiations were made to the logic here and there to make it a 20# mega-widget and the command and option interface was expanded to make 21# it even more configurable, but the underlying logic is the same. 22# 23# @(#) $Id: calendar.itk,v 1.9 2007/05/24 22:41:02 hobbs Exp $ 24# ---------------------------------------------------------------------- 25# Copyright (c) 1997 DSC Technologies Corporation 26# ====================================================================== 27# Permission to use, copy, modify, distribute and license this software 28# and its documentation for any purpose, and without fee or written 29# agreement with DSC, is hereby granted, provided that the above copyright 30# notice appears in all copies and that both the copyright notice and 31# warranty disclaimer below appear in supporting documentation, and that 32# the names of DSC Technologies Corporation or DSC Communications 33# Corporation not be used in advertising or publicity pertaining to the 34# software without specific, written prior permission. 35# 36# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 37# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 38# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 39# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 40# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 41# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 42# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 43# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 44# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 45# SOFTWARE. 46# ====================================================================== 47 48# 49# Usual options. 50# 51itk::usual Calendar { 52 keep -background -cursor 53} 54 55# ------------------------------------------------------------------ 56# CALENDAR 57# ------------------------------------------------------------------ 58itcl::class iwidgets::Calendar { 59 inherit itk::Widget 60 61 constructor {args} {} 62 63 itk_option define -days days Days {Su Mo Tu We Th Fr Sa} 64 itk_option define -command command Command {} 65 itk_option define -forwardimage forwardImage Image {} 66 itk_option define -backwardimage backwardImage Image {} 67 itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9 68 itk_option define -weekendbackground weekendBackground Background \#d9d9d9 69 itk_option define -outline outline Outline \#d9d9d9 70 itk_option define -buttonforeground buttonForeground Foreground blue 71 itk_option define -foreground foreground Foreground black 72 itk_option define -selectcolor selectColor Foreground red 73 itk_option define -selectthickness selectThickness SelectThickness 3 74 itk_option define -titlefont titleFont Font \ 75 -*-helvetica-bold-r-normal--*-140-* 76 itk_option define -dayfont dayFont Font \ 77 -*-helvetica-medium-r-normal--*-120-* 78 itk_option define -datefont dateFont Font \ 79 -*-helvetica-medium-r-normal--*-120-* 80 itk_option define -currentdatefont currentDateFont Font \ 81 -*-helvetica-bold-r-normal--*-120-* 82 itk_option define -startday startDay Day sunday 83 itk_option define -int int DateFormat no 84 85 public method get {{format "-string"}} ;# Returns the selected date 86 public method select {{date_ "now"}} ;# Selects date, moving select ring 87 public method show {{date_ "now"}} ;# Displays a specific date 88 89 protected method _drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} 90 91 private method _change {delta_} 92 private method _configureHandler {} 93 private method _redraw {} 94 private method _days {{wmax {}}} 95 private method _layout {time_} 96 private method _select {date_} 97 private method _selectEvent {date_} 98 private method _adjustday {day_} 99 private method _percentSubst {pattern_ string_ subst_} 100 101 private variable _time {} 102 private variable _selected {} 103 private variable _initialized 0 104 private variable _offset 0 105 private variable _format {} 106} 107 108# 109# Provide a lowercased access method for the Calendar class. 110# 111proc ::iwidgets::calendar {pathName args} { 112 uplevel ::iwidgets::Calendar $pathName $args 113} 114 115# 116# Use option database to override default resources of base classes. 117# 118option add *Calendar.width 200 widgetDefault 119option add *Calendar.height 165 widgetDefault 120 121# ------------------------------------------------------------------ 122# CONSTRUCTOR 123# ------------------------------------------------------------------ 124itcl::body iwidgets::Calendar::constructor {args} { 125 # 126 # Create the canvas which displays each page of the calendar. 127 # 128 itk_component add page { 129 canvas $itk_interior.page 130 } { 131 keep -background -cursor -width -height 132 } 133 pack $itk_component(page) -expand yes -fill both 134 135 # 136 # Create the forward and backward buttons. Rather than pack 137 # them directly in the hull, we'll waittill later and make 138 # them canvas window items. 139 # 140 itk_component add backward { 141 button $itk_component(page).backward \ 142 -command [itcl::code $this _change -1] 143 } { 144 keep -background -cursor 145 } 146 147 itk_component add forward { 148 button $itk_component(page).forward \ 149 -command [itcl::code $this _change +1] 150 } { 151 keep -background -cursor 152 } 153 154 # 155 # Set the initial time to now. 156 # 157 set _time [clock seconds] 158 159 # 160 # Bind to the configure event which will be used to redraw 161 # the calendar and display the month. 162 # 163 bind $itk_component(page) <Configure> [itcl::code $this _configureHandler] 164 165 # 166 # Evaluate the option arguments. 167 # 168 eval itk_initialize $args 169} 170 171# ------------------------------------------------------------------ 172# OPTIONS 173# ------------------------------------------------------------------ 174# ------------------------------------------------------------------ 175# OPTION: -int 176# 177# Added by Mark Alston 2001/10/21 178# 179# Allows for the use of dates in "international" format: YYYY-MM-DD. 180# It must be a boolean value. 181# ------------------------------------------------------------------ 182itcl::configbody iwidgets::Calendar::int { 183 switch $itk_option(-int) { 184 1 - yes - true - on { 185 set itk_option(-int) yes 186 } 187 0 - no - false - off { 188 set itk_option(-int) no 189 } 190 default { 191 error "bad int option \"$itk_option(-int)\": should be boolean" 192 } 193 } 194} 195 196# ------------------------------------------------------------------ 197# OPTION: -command 198# 199# Sets the selection command for the calendar. When the user 200# selects a date on the calendar, the date is substituted in 201# place of "%d" in this command, and the command is executed. 202# ------------------------------------------------------------------ 203itcl::configbody iwidgets::Calendar::command {} 204 205# ------------------------------------------------------------------ 206# OPTION: -days 207# 208# The days option takes a list of values to set the text used to display the 209# days of the week header above the dates. The default value is 210# {Su Mo Tu We Th Fr Sa}. 211# ------------------------------------------------------------------ 212itcl::configbody iwidgets::Calendar::days { 213 if {$_initialized} { 214 if {[$itk_component(page) find withtag days] != {}} { 215 $itk_component(page) delete days 216 _days 217 } 218 } 219} 220 221# ------------------------------------------------------------------ 222# OPTION: -backwardimage 223# 224# Specifies a image to be displayed on the backwards calendar 225# button. If none is specified, a default is provided. 226# ------------------------------------------------------------------ 227itcl::configbody iwidgets::Calendar::backwardimage { 228 229 # 230 # If no image is given, then we'll use the default image. 231 # 232 if {$itk_option(-backwardimage) == {}} { 233 234 # 235 # If the default image hasn't yet been created, then we 236 # need to create it. 237 # 238 if {[lsearch [image names] $this-backward] == -1} { 239 image create bitmap $this-backward \ 240 -foreground $itk_option(-buttonforeground) -data { 241 #define back_width 16 242 #define back_height 16 243 static unsigned char back_bits[] = { 244 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x30, 245 0xe0, 0x38, 0xf0, 0x3c, 0xf8, 0x3e, 0xfc, 0x3f, 246 0xfc, 0x3f, 0xf8, 0x3e, 0xf0, 0x3c, 0xe0, 0x38, 247 0xc0, 0x30, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; 248 } 249 } 250 251 # 252 # Configure the button to use the default image. 253 # 254 $itk_component(backward) configure -image $this-backward 255 256 # 257 # Else, an image has been specified. First, we'll need to make sure 258 # the image really exists before configuring the button to use it. 259 # If it doesn't generate an error. 260 # 261 } else { 262 if {[lsearch [image names] $itk_option(-backwardimage)] != -1} { 263 $itk_component(backward) configure \ 264 -image $itk_option(-backwardimage) 265 } else { 266 error "bad image name \"$itk_option(-backwardimage)\":\ 267 image does not exist" 268 } 269 270 # 271 # If we previously created a default image, we'll just remove it. 272 # 273 if {[lsearch [image names] $this-backward] != -1} { 274 image delete $this-backward 275 } 276 } 277} 278 279 280# ------------------------------------------------------------------ 281# OPTION: -forwardimage 282# 283# Specifies a image to be displayed on the forwards calendar 284# button. If none is specified, a default is provided. 285# ------------------------------------------------------------------ 286itcl::configbody iwidgets::Calendar::forwardimage { 287 288 # 289 # If no image is given, then we'll use the default image. 290 # 291 if {$itk_option(-forwardimage) == {}} { 292 293 # 294 # If the default image hasn't yet been created, then we 295 # need to create it. 296 # 297 if {[lsearch [image names] $this-forward] == -1} { 298 image create bitmap $this-forward \ 299 -foreground $itk_option(-buttonforeground) -data { 300 #define fwd_width 16 301 #define fwd_height 16 302 static unsigned char fwd_bits[] = { 303 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x03, 304 0x1c, 0x07, 0x3c, 0x0f, 0x7c, 0x1f, 0xfc, 0x3f, 305 0xfc, 0x3f, 0x7c, 0x1f, 0x3c, 0x0f, 0x1c, 0x07, 306 0x0c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; 307 } 308 } 309 310 # 311 # Configure the button to use the default image. 312 # 313 $itk_component(forward) configure -image $this-forward 314 315 # 316 # Else, an image has been specified. First, we'll need to make sure 317 # the image really exists before configuring the button to use it. 318 # If it doesn't generate an error. 319 # 320 } else { 321 if {[lsearch [image names] $itk_option(-forwardimage)] != -1} { 322 $itk_component(forward) configure \ 323 -image $itk_option(-forwardimage) 324 } else { 325 error "bad image name \"$itk_option(-forwardimage)\":\ 326 image does not exist" 327 } 328 329 # 330 # If we previously created a default image, we'll just remove it. 331 # 332 if {[lsearch [image names] $this-forward] != -1} { 333 image delete $this-forward 334 } 335 } 336} 337 338# ------------------------------------------------------------------ 339# OPTION: -weekdaybackground 340# 341# Specifies the background for the weekdays which allows it to 342# be visually distinguished from the weekend. 343# ------------------------------------------------------------------ 344itcl::configbody iwidgets::Calendar::weekdaybackground { 345 if {$_initialized} { 346 $itk_component(page) itemconfigure weekday \ 347 -fill $itk_option(-weekdaybackground) 348 } 349} 350 351# ------------------------------------------------------------------ 352# OPTION: -weekendbackground 353# 354# Specifies the background for the weekdays which allows it to 355# be visually distinguished from the weekdays. 356# ------------------------------------------------------------------ 357itcl::configbody iwidgets::Calendar::weekendbackground { 358 if {$_initialized} { 359 $itk_component(page) itemconfigure weekend \ 360 -fill $itk_option(-weekendbackground) 361 } 362} 363 364# ------------------------------------------------------------------ 365# OPTION: -foreground 366# 367# Specifies the foreground color for the textual items, buttons, 368# and divider on the calendar. 369# ------------------------------------------------------------------ 370itcl::configbody iwidgets::Calendar::foreground { 371 if {$_initialized} { 372 $itk_component(page) itemconfigure text \ 373 -fill $itk_option(-foreground) 374 $itk_component(page) itemconfigure line \ 375 -fill $itk_option(-foreground) 376 } 377} 378 379# ------------------------------------------------------------------ 380# OPTION: -outline 381# 382# Specifies the outline color used to surround the date text. 383# ------------------------------------------------------------------ 384itcl::configbody iwidgets::Calendar::outline { 385 if {$_initialized} { 386 $itk_component(page) itemconfigure square \ 387 -outline $itk_option(-outline) 388 } 389} 390 391# ------------------------------------------------------------------ 392# OPTION: -buttonforeground 393# 394# Specifies the foreground color of the forward and backward buttons. 395# ------------------------------------------------------------------ 396itcl::configbody iwidgets::Calendar::buttonforeground { 397 if {$_initialized} { 398 if {$itk_option(-forwardimage) == {}} { 399 if {[lsearch [image names] $this-forward] != -1} { 400 $this-forward configure \ 401 -foreground $itk_option(-buttonforeground) 402 } 403 } else { 404 $itk_component(forward) configure \ 405 -foreground $itk_option(-buttonforeground) 406 } 407 408 if {$itk_option(-backwardimage) == {}} { 409 if {[lsearch [image names] $this-backward] != -1} { 410 $this-backward configure \ 411 -foreground $itk_option(-buttonforeground) 412 } 413 } else { 414 $itk_component(-backward) configure \ 415 -foreground $itk_option(-buttonforeground) 416 } 417 } 418} 419 420# ------------------------------------------------------------------ 421# OPTION: -selectcolor 422# 423# Specifies the color of the ring displayed that distinguishes the 424# currently selected date. 425# ------------------------------------------------------------------ 426itcl::configbody iwidgets::Calendar::selectcolor { 427 if {$_initialized} { 428 $itk_component(page) itemconfigure $_selected-sensor \ 429 -outline $itk_option(-selectcolor) 430 } 431} 432 433# ------------------------------------------------------------------ 434# OPTION: -selectthickness 435# 436# Specifies the thickness of the ring displayed that distinguishes 437# the currently selected date. 438# ------------------------------------------------------------------ 439itcl::configbody iwidgets::Calendar::selectthickness { 440 if {$_initialized} { 441 $itk_component(page) itemconfigure $_selected-sensor \ 442 -width $itk_option(-selectthickness) 443 } 444} 445 446# ------------------------------------------------------------------ 447# OPTION: -titlefont 448# 449# Specifies the font used for the title text that consists of the 450# month and year. 451# ------------------------------------------------------------------ 452itcl::configbody iwidgets::Calendar::titlefont { 453 if {$_initialized} { 454 $itk_component(page) itemconfigure title \ 455 -font $itk_option(-titlefont) 456 } 457} 458 459# ------------------------------------------------------------------ 460# OPTION: -datefont 461# 462# Specifies the font used for the date text that consists of the 463# day of the month. 464# ------------------------------------------------------------------ 465itcl::configbody iwidgets::Calendar::datefont { 466 if {$_initialized} { 467 $itk_component(page) itemconfigure date \ 468 -font $itk_option(-datefont) 469 } 470} 471 472# ------------------------------------------------------------------ 473# OPTION: -currentdatefont 474# 475# Specifies the font used for the current date text. 476# ------------------------------------------------------------------ 477itcl::configbody iwidgets::Calendar::currentdatefont { 478 if {$_initialized} { 479 $itk_component(page) itemconfigure now \ 480 -font $itk_option(-currentdatefont) 481 } 482} 483 484# ------------------------------------------------------------------ 485# OPTION: -dayfont 486# 487# Specifies the font used for the day of the week text. 488# ------------------------------------------------------------------ 489itcl::configbody iwidgets::Calendar::dayfont { 490 if {$_initialized} { 491 $itk_component(page) itemconfigure days \ 492 -font $itk_option(-dayfont) 493 } 494} 495 496# ------------------------------------------------------------------ 497# OPTION: -startday 498# 499# Specifies the starting day for the week. The value must be a day of the 500# week: sunday, monday, tuesday, wednesday, thursday, friday, or 501# saturday. The default is sunday. 502# ------------------------------------------------------------------ 503itcl::configbody iwidgets::Calendar::startday { 504 set day [string tolower $itk_option(-startday)] 505 506 switch $day { 507 sunday {set _offset 0} 508 monday {set _offset 1} 509 tuesday {set _offset 2} 510 wednesday {set _offset 3} 511 thursday {set _offset 4} 512 friday {set _offset 5} 513 saturday {set _offset 6} 514 default { 515 error "bad startday option \"$itk_option(-startday)\":\ 516 should be sunday, monday, tuesday, wednesday,\ 517 thursday, friday, or saturday" 518 } 519 } 520 521 if {$_initialized} { 522 $itk_component(page) delete all-page 523 _redraw 524 } 525} 526 527# ------------------------------------------------------------------ 528# METHODS 529# ------------------------------------------------------------------ 530 531# ------------------------------------------------------------------ 532# PUBLIC METHOD: get ?format? 533# 534# Returns the currently selected date in one of two formats, string 535# or as an integer clock value using the -string and -clicks 536# options respectively. The default is by string. Reference the 537# clock command for more information on obtaining dates and their 538# formats. 539# ------------------------------------------------------------------ 540itcl::body iwidgets::Calendar::get {{format "-string"}} { 541 switch -- $format { 542 "-string" { 543 return $_selected 544 } 545 "-clicks" { 546 return [clock scan $_selected] 547 } 548 default { 549 error "bad format option \"$format\":\ 550 should be -string or -clicks" 551 } 552 } 553} 554 555# ------------------------------------------------------------------ 556# PUBLIC METHOD: select date_ 557# 558# Changes the currently selected date to the value specified. 559# ------------------------------------------------------------------ 560itcl::body iwidgets::Calendar::select {{date_ "now"}} { 561 if {$date_ == "now"} { 562 set time [clock seconds] 563 } else { 564 if {[catch {clock format $date_}] == 0} { 565 set time $date_ 566 } elseif {[catch {set time [clock scan $date_]}] != 0} { 567 error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now" 568 } 569 } 570 switch $itk_option(-int) { 571 yes { set _format "%Y-%m-%d" } 572 no { set _format "%m/%d/%Y" } 573 } 574 _select [clock format $time -format "$_format"] 575} 576 577# ------------------------------------------------------------------ 578# PUBLIC METHOD: show date_ 579# 580# Changes the currently display month to be that of the specified 581# date. 582# ------------------------------------------------------------------ 583itcl::body iwidgets::Calendar::show {{date_ "now"}} { 584 if {$date_ == "now"} { 585 set _time [clock seconds] 586 } else { 587 if {[catch {clock format $date_}] == 0} { 588 set _time $date_ 589 } elseif {[catch {set _time [clock scan $date_]}] != 0} { 590 error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now" 591 } 592 } 593 594 $itk_component(page) delete all-page 595 _redraw 596} 597 598# ------------------------------------------------------------------ 599# PROTECTED METHOD: _drawtext canvas_ day_ date_ now_ 600# x0_ y0_ x1_ y1_ 601# 602# Draws the text in the date square. The method is protected such that 603# it can be overridden in derived classes that may wish to add their 604# own unique text. The method receives the day to draw along with 605# the coordinates of the square. 606# ------------------------------------------------------------------ 607itcl::body iwidgets::Calendar::_drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} { 608 set item [$canvas_ create text \ 609 [expr {(($x1_ - $x0_) / 2) + $x0_}] \ 610 [expr {(($y1_ -$y0_) / 2) + $y0_ + 1}] \ 611 -anchor center -text "$day_" \ 612 -fill $itk_option(-foreground)] 613 614 if {$date_ == $now_} { 615 $canvas_ itemconfigure $item \ 616 -font $itk_option(-currentdatefont) \ 617 -tags [list all-page date $date_-date text now] 618 } else { 619 $canvas_ itemconfigure $item \ 620 -font $itk_option(-datefont) \ 621 -tags [list all-page date $date_-date text] 622 } 623} 624 625# ------------------------------------------------------------------ 626# PRIVATE METHOD: _configureHandler 627# 628# Processes a configure event received on the canvas. The method 629# deletes all the current canvas items and forces a redraw. 630# ------------------------------------------------------------------ 631itcl::body iwidgets::Calendar::_configureHandler {} { 632 set _initialized 1 633 634 $itk_component(page) delete all 635 _redraw 636} 637 638# ------------------------------------------------------------------ 639# PRIVATE METHOD: _change delta_ 640# 641# Changes the current month displayed in the calendar, moving 642# forward or backward by <delta_> months where <delta_> is +/- 643# some number. 644# ------------------------------------------------------------------ 645itcl::body iwidgets::Calendar::_change {delta_} { 646 set dir [expr {($delta_ > 0) ? 1 : -1}] 647 set month [clock format $_time -format "%m"] 648 set month [string trimleft $month 0] 649 set year [clock format $_time -format "%Y"] 650 651 for {set i 0} {$i < abs($delta_)} {incr i} { 652 incr month $dir 653 if {$month < 1} { 654 set month 12 655 incr year -1 656 } elseif {$month > 12} { 657 set month 1 658 incr year 1 659 } 660 } 661 if {[catch {set _time [clock scan "$month/1/$year"]}]} { 662 bell 663 } else { 664 _redraw 665 } 666} 667 668# ------------------------------------------------------------------ 669# PRIVATE METHOD: _redraw 670# 671# Redraws the calendar. This method is invoked whenever the 672# calendar changes size or we need to effect a change such as draw 673# it with a new month. 674# ------------------------------------------------------------------ 675itcl::body iwidgets::Calendar::_redraw {} { 676 # 677 # Set the format based on the option -int 678 # 679 switch $itk_option(-int) { 680 yes { set _format "%Y-%m-%d" } 681 no { set _format "%m/%d/%Y" } 682 } 683 # 684 # Remove all the items that typically change per redraw request 685 # such as the title and dates. Also, get the maximum width and 686 # height of the page. 687 # 688 $itk_component(page) delete all-page 689 690 set wmax [winfo width $itk_component(page)] 691 set hmax [winfo height $itk_component(page)] 692 693 # 694 # If we haven't yet created the forward and backwards buttons, 695 # then dot it; otherwise, skip it. 696 # 697 if {[$itk_component(page) find withtag button] == {}} { 698 $itk_component(page) create window 3 3 -anchor nw \ 699 -window $itk_component(backward) -tags button 700 $itk_component(page) create window [expr {$wmax-3}] 3 -anchor ne \ 701 -window $itk_component(forward) -tags button 702 } 703 704 # 705 # Create the title centered between the buttons. 706 # 707 foreach {x0 y0 x1 y1} [$itk_component(page) bbox button] { 708 set x [expr {(($x1-$x0)/2)+$x0}] 709 set y [expr {(($y1-$y0)/2)+$y0}] 710 } 711 712 set title [clock format $_time -format "%B %Y"] 713 $itk_component(page) create text $x $y -anchor center \ 714 -text $title -font $itk_option(-titlefont) \ 715 -fill $itk_option(-foreground) \ 716 -tags [list title text all-page] 717 718 # 719 # Add the days of the week labels if they haven't yet been created. 720 # 721 if {[$itk_component(page) find withtag days] == {}} { 722 _days $wmax 723 } 724 725 # 726 # Add a line between the calendar header and the dates if needed. 727 # 728 set bottom [expr {[lindex [$itk_component(page) bbox all] 3] + 3}] 729 730 if {[$itk_component(page) find withtag line] == {}} { 731 $itk_component(page) create line 0 $bottom $wmax $bottom \ 732 -width 2 -tags line 733 } 734 735 incr bottom 3 736 737 # 738 # Get the layout for the time value and create the date squares. 739 # This includes the surrounding date rectangle, the date text, 740 # and the sensor. Bind selection to the sensor. 741 # 742 set current "" 743 set now [clock format [clock seconds] -format "$_format"] 744 745 set layout [_layout $_time] 746 set weeks [expr {[lindex $layout end] + 1}] 747 748 foreach {day date kind dcol wrow} $layout { 749 set x0 [expr {$dcol*($wmax-7)/7+3}] 750 set y0 [expr {$wrow*($hmax-$bottom-4)/$weeks+$bottom}] 751 set x1 [expr {($dcol+1)*($wmax-7)/7+3}] 752 set y1 [expr {($wrow+1)*($hmax-$bottom-4)/$weeks+$bottom}] 753 754 if {$date == $_selected} { 755 set current $date 756 } 757 758 # 759 # Create the rectangle that surrounds the date and configure 760 # its background based on the wheather it is a weekday or 761 # a weekend. 762 # 763 set item [$itk_component(page) create rectangle $x0 $y0 $x1 $y1 \ 764 -outline $itk_option(-outline)] 765 766 if {$kind == "weekend"} { 767 $itk_component(page) itemconfigure $item \ 768 -fill $itk_option(-weekendbackground) \ 769 -tags [list all-page square weekend] 770 } else { 771 $itk_component(page) itemconfigure $item \ 772 -fill $itk_option(-weekdaybackground) \ 773 -tags [list all-page square weekday] 774 } 775 776 # 777 # Create the date text and configure its font based on the 778 # wheather or not it is the current date. 779 # 780 _drawtext $itk_component(page) $day $date $now $x0 $y0 $x1 $y1 781 782 # 783 # Create a sensor area to detect selections. Bind the 784 # sensor and pass the date to the bind script. 785 # 786 $itk_component(page) create rectangle $x0 $y0 $x1 $y1 \ 787 -outline "" -fill "" \ 788 -tags [list $date-sensor all-sensor all-page] 789 790 $itk_component(page) bind $date-sensor <ButtonPress-1> \ 791 [itcl::code $this _selectEvent $date] 792 793 $itk_component(page) bind $date-date <ButtonPress-1> \ 794 [itcl::code $this _selectEvent $date] 795 } 796 797 # 798 # Highlight the selected date if it is on this page. 799 # 800 if {$current != ""} { 801 $itk_component(page) itemconfigure $current-sensor \ 802 -outline $itk_option(-selectcolor) \ 803 -width $itk_option(-selectthickness) 804 805 $itk_component(page) raise $current-sensor 806 807 } elseif {$_selected == ""} { 808 set date [clock format $_time -format "$_format"] 809 _select $date 810 } 811} 812 813# ------------------------------------------------------------------ 814# PRIVATE METHOD: _days 815# 816# Used to rewite the days of the week label just below the month 817# title string. The days are given in the -days option. 818# ------------------------------------------------------------------ 819itcl::body iwidgets::Calendar::_days {{wmax {}}} { 820 if {$wmax == {}} { 821 set wmax [winfo width $itk_component(page)] 822 } 823 824 set col 0 825 set bottom [expr {[lindex [$itk_component(page) bbox title buttons] 3] + 7}] 826 827 foreach dayoweek $itk_option(-days) { 828 set x0 [expr {$col*($wmax/7)}] 829 set x1 [expr {($col+1)*($wmax/7)}] 830 831 $itk_component(page) create text \ 832 [expr {(($x1 - $x0) / 2) + $x0}] $bottom \ 833 -anchor n -text "$dayoweek" \ 834 -fill $itk_option(-foreground) \ 835 -font $itk_option(-dayfont) \ 836 -tags [list days text] 837 838 incr col 839 } 840} 841 842# ------------------------------------------------------------------ 843# PRIVATE METHOD: _layout time_ 844# 845# Used whenever the calendar is redrawn. Finds the month containing 846# a <time_> in seconds, and returns a list for all of the days in 847# that month. The list looks like this: 848# 849# {day1 date1 kind1 c1 r1 day2 date2 kind2 c2 r2 ...} 850# 851# where dayN is a day number like 1,2,3,..., dateN is the date for 852# dayN, kindN is the day type of weekday or weekend, and cN,rN 853# are the column/row indices for the square containing that date. 854# ------------------------------------------------------------------ 855itcl::body iwidgets::Calendar::_layout {time_} { 856 857 switch $itk_option(-int) { 858 yes { set _format "%Y-%m-%d" } 859 no { set _format "%m/%d/%Y" } 860 } 861 862 set month [clock format $time_ -format "%m"] 863 set year [clock format $time_ -format "%Y"] 864 865 if {[info tclversion] >= 8.5} { 866 set startOfMonth [clock scan "$year-$month-01" -format %Y-%m-%d] 867 set lastday [clock format [clock add $startOfMonth 1 month -1 day] -format %d] 868 } else { 869 foreach lastday {31 30 29 28} { 870 if {[catch {clock scan "$month/$lastday/$year"}] == 0} { 871 break 872 } 873 } 874 } 875 set seconds [clock scan "$month/1/$year"] 876 set firstday [_adjustday [clock format $seconds -format %w]] 877 878 set weeks [expr {ceil(double($lastday+$firstday)/7)}] 879 880 set rlist "" 881 for {set day 1} {$day <= $lastday} {incr day} { 882 set seconds [clock scan "$month/$day/$year"] 883 set date [clock format $seconds -format "$_format"] 884 set dayoweek [clock format $seconds -format %w] 885 886 if {$dayoweek == 0 || $dayoweek == 6} { 887 set kind "weekend" 888 } else { 889 set kind "weekday" 890 } 891 892 set daycol [_adjustday $dayoweek] 893 894 set weekrow [expr {($firstday+$day-1)/7}] 895 lappend rlist $day $date $kind $daycol $weekrow 896 } 897 return $rlist 898} 899 900# ------------------------------------------------------------------ 901# PRIVATE METHOD: _adjustday day_ 902# 903# Modifies the day to be in accordance with the startday option. 904# ------------------------------------------------------------------ 905itcl::body iwidgets::Calendar::_adjustday {day_} { 906 set retday [expr {$day_ - $_offset}] 907 908 if {$retday < 0} { 909 set retday [expr {$retday + 7}] 910 } 911 912 return $retday 913} 914 915# ------------------------------------------------------------------ 916# PRIVATE METHOD: _select date_ 917# 918# Selects the current <date_> on the calendar. Highlights the date 919# on the calendar, and executes the command associated with the 920# calendar, with the selected date substituted in place of "%d". 921# ------------------------------------------------------------------ 922itcl::body iwidgets::Calendar::_select {date_} { 923 924 switch $itk_option(-int) { 925 yes { set _format "%Y-%m-%d" } 926 no { set _format "%m/%d/%Y" } 927 } 928 929 930 set time [clock scan $date_] 931 set date [clock format $time -format "$_format"] 932 933 set _selected $date 934 set current [clock format $_time -format "%m %Y"] 935 set selected [clock format $time -format "%m %Y"] 936 937 if {$current == $selected} { 938 $itk_component(page) itemconfigure all-sensor \ 939 -outline "" -width 1 940 941 $itk_component(page) itemconfigure $date-sensor \ 942 -outline $itk_option(-selectcolor) \ 943 -width $itk_option(-selectthickness) 944 $itk_component(page) raise $date-sensor 945 } else { 946 set _time $time 947 _redraw 948 } 949} 950 951# ------------------------------------------------------------------ 952# PRIVATE METHOD: _selectEvent date_ 953# 954# Selects the current <date_> on the calendar. Highlights the date 955# on the calendar, and executes the command associated with the 956# calendar, with the selected date substituted in place of "%d". 957# ------------------------------------------------------------------ 958itcl::body iwidgets::Calendar::_selectEvent {date_} { 959 _select $date_ 960 961 if {[string trim $itk_option(-command)] != ""} { 962 set cmd $itk_option(-command) 963 set cmd [_percentSubst %d $cmd [get]] 964 uplevel #0 $cmd 965 } 966} 967 968# ------------------------------------------------------------------ 969# PRIVATE METHOD: _percentSubst pattern_ string_ subst_ 970# 971# This command is a "safe" version of regsub, for substituting 972# each occurance of <%pattern_> in <string_> with <subst_>. The 973# usual Tcl "regsub" command does the same thing, but also 974# converts characters like "&" and "\0", "\1", etc. that may 975# be present in the <subst_> string. 976# 977# Returns <string_> with <subst_> substituted in place of each 978# <%pattern_>. 979# ------------------------------------------------------------------ 980itcl::body iwidgets::Calendar::_percentSubst {pattern_ string_ subst_} { 981 if {![string match %* $pattern_]} { 982 error "bad pattern \"$pattern_\": should be %something" 983 } 984 985 set rval "" 986 while {[regexp "(.*)${pattern_}(.*)" $string_ all head tail]} { 987 set rval "$subst_$tail$rval" 988 set string_ $head 989 } 990 set rval "$string_$rval" 991} 992