calendar.itk

这是一个Linux下的集成开发环境

        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.
# ------------------------------------------------------------------
body iwidgets::Calendar::_redraw {} {
    #
    # 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 "%m/%d/%Y"]

    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> \
            [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 "%m/%d/%Y"]
        _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.
# ------------------------------------------------------------------
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.
# ------------------------------------------------------------------
body iwidgets::Calendar::_layout {time_} {
    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 "%m/%d/%Y"]
	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.
# ------------------------------------------------------------------
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".
# ------------------------------------------------------------------
body iwidgets::Calendar::_select {date_} {
    set time [clock scan $date_]
    set date [clock format $time -format "%m/%d/%Y"]

    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".
# ------------------------------------------------------------------
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_>.
# ------------------------------------------------------------------
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"
}