# Copyright (c) 1993 by Sanjay Ghemawat
###############################################################################
# DateEditor
#
#	Allows interactive modification of a date.
#
# Description
# ===========
#
# A DateEditor displays a date and allows easy interactive modification
# of the date.  A command is executed whenever the date is modified.
#
# Note
# ====
#
# Code in dateeditor.c depends upon the tags assigned to canvas items.
# If you change the canvas layout, examine dateeditor.c

# Autoload support
proc DateEditor {} {}

# effects - Creates date editor window $name.
#	    Initial date is $date.
#	    Every time the date is changed, the new value is appended to
#	    $command and the resulting string is evaluated.

class DateEditor {name date command} {
    set slot(window) $name
    set slot(date) $date
    set slot(command) $command
    set slot(offset) 0
    set slot(load) 0
    set slot(callback) 0
    set slot(pending) 0
    set slot(itemwidth) 1
    set slot(itemheight) 1
    set slot(hpad) 2
    set slot(vpad) 2

    # Layout the various components
    frame $name -bd 0
    frame $name.top -relief raised -bd 1
    frame $name.bot -relief flat -bd 1
    frame $name.mid -bd 1 -relief raised

    # The month selector
    frame $name.month
    label $name.month.label -text Month\
	-anchor center -width 9\
	-font [pref largeHeadingFont]
    button $name.month.left -bitmap [icon left.xbm] -relief flat\
	-command [list $self month_left]
    button $name.month.right -bitmap [icon right.xbm] -relief flat\
	-command [list $self month_right]
    pack append $name.month\
	$name.month.left {left}\
	$name.month.right {right}\
	$name.month.label {left expand fill}

    # The year selector
    frame $name.year
    label $name.year.label -text Year\
	-anchor center -width 4\
	-font [pref largeHeadingFont]
    button $name.year.left -bitmap [icon left.xbm] -relief flat\
	-command [list $self year_left]
    button $name.year.right -bitmap [icon right.xbm] -relief flat\
	-command [list $self year_right]
    pack append $name.year\
	$name.year.left {left}\
	$name.year.right {right}\
	$name.year.label {left expand fill}

    # Miscellaneous buttons
    button $name.today -bd 1 -text Today -command [list $self today]
    button $name.next -bd 1 -text Next -command [list $self next]
    button $name.last -bd 1 -text Prev -command [list $self last]

    # The monthday selector
    set d $name.days
    canvas $d -relief flat -bd 0

    # Get dimensions for current date marker
    set item [$d create text 0 0 -text " 99" -font [pref weekdayFont]]
    set ibox [$d bbox $item]
    $d delete $item
    set slot(itemwidth)  [expr "[lindex $ibox 2] - [lindex $ibox 0]"]
    set slot(itemheight) [expr "[lindex $ibox 3] - [lindex $ibox 1]"]

    # Get heading dimensions
    set item [$d create text 0 0 -text "Wed" -font [pref weekdayFont]]
    set ibox [$d bbox $item]
    $d delete $item
    set slot(hw) [expr "[lindex $ibox 2] - [lindex $ibox 0] + (2*$slot(hpad))"]
    set slot(hh) [expr "[lindex $ibox 3] - [lindex $ibox 1] + (2*$slot(vpad))"]
    $d configure -width [expr "$slot(hw)*7+4"] -height [expr "$slot(hh)*8"]

    set x [expr -$slot(hpad)]
    set y $slot(vpad)

    # Create monthdays
    foreach r {1 2 3 4 5 6} {
	foreach c {1 2 3 4 5 6 7} {
	    $d create text\
		[expr "$x+($c*$slot(hw))"]\
		[expr "$y+(($r+1)*$slot(hh))"]\
		-text "$r$c" -anchor ne\
		-tags [list Day row$r col$c =[expr ($r-1)*7+$c]]\
		-fill [pref weekdayColor]\
		-font [pref weekdayFont]
	}
    }

    $d bind Day <1> [list $self day_select]

    # Create selection indicator
    $d create rect 0 0 5 5 -fill "" -outline [pref weekdayColor]\
	-width 2.0 -tags {marker}
    $d lower marker Day

    pack append $name.top $name.month left
    pack append $name.top $name.year right

    pack append $name.bot $name.last {left expand fillx}
    pack append $name.bot $name.today {left expand fillx}
    pack append $name.bot $name.next {right expand fillx}

    pack append $name.mid $d {top}

    pack append $name $name.top {top expand fillx}
    pack append $name $name.mid {top expand fill}
    pack append $name $name.bot {top expand fillx}

    # Setup notification for item changes

    trigger on add     [list de_trigger_set $self]
    trigger on change  [list de_trigger_set $self]
    trigger on delete  [list de_trigger_set $self]
    trigger on exclude [list de_trigger_set $self]
    trigger on include [list de_trigger_set $self]

    $self reconfig

    $self load_month
    $self set_selection
}

method DateEditor cleanup {} {
    trigger remove add     [list de_trigger_set $self]
    trigger remove change  [list de_trigger_set $self]
    trigger remove delete  [list de_trigger_set $self]
    trigger remove exclude [list de_trigger_set $self]
    trigger remove include [list de_trigger_set $self]
}

# effects - Set up an interest tag recalculation to occur after
#	    a small delay.  The delay is necessary because various
#	    triggers may be fired before the corresponding calendar
#	    state is changed.  The delay allows the calendar state
#	    to be changed.
proc de_trigger_set {de args} {
    after 50 [list de_calc_run $de]
}

# Wrapper to handle dateeditor deletion
proc de_calc_run {obj} {
    if {[info procs $obj] != $obj} {
	return
    }
    $obj calc_interest
}

method DateEditor reconfig {} {
    set d $slot(window).days
    set wnames {Sun Mon Tue Wed Thu Fri Sat}
    if [cal option MondayFirst] {
	set wnames {Mon Tue Wed Thu Fri Sat Sun}
    }

    $d delete Heading
    set col 1
    foreach w $wnames {
	set item [$d create text\
			[expr "$col*$slot(hw)-$slot(hpad)"] $slot(vpad)\
		  	-text $w -anchor ne\
			-tags [list Heading]\
			-fill [pref weekdayColor]\
			-font [pref weekdayFont]]

	if {($w == "Sun") || ($w == "Sat")} {
	    $d itemconfigure $item\
		-fill [pref weekendColor]\
		-font [pref weekendFont]
	}

	incr col
    }

    # Just configure all items to weekdayColor and weekdayFont
    $d itemconfigure Day -fill [pref weekdayColor] -font [pref weekdayFont]

    $self load_month
    $self set_selection
}

# effects - Reset dateeditor interest tags because of item changes
method DateEditor calc_interest {} {
    set name $slot(window)

    set c1 col7
    set c2 col1
    if [cal option MondayFirst] {set c2 col6}

    # Get correct tags
    $name.days dtag holiday
    $name.days dtag interest

    $name.days addtag holiday withtag $c1
    $name.days addtag holiday withtag $c2

    # Redo interest lists
    de_interest $name.days $slot(date)

    # Change colors
    $name.days itemconfig Day\
	-fill [pref weekdayColor] -font [pref weekdayFont]

    $name.days itemconfig holiday\
	-fill [pref weekendColor] -font [pref weekendFont]

    $name.days itemconfig interest\
	-fill [pref interestColor] -font [pref interestFont]
}

# effects - Sets dateeditor contents for new month.
method DateEditor load_month {} {
    global month_name

    set date  $slot(date)
    set month [date month $date]
    set year  [date year  $date]

    set name $slot(window)
    $name.month.label configure -text $month_name($month)
    $name.year.label configure -text $year

    set first [date make 1 $month $year]
    set slot(offset) [expr [date weekday $first]-1]
    if [cal option MondayFirst] {
	set slot(offset) [expr ($slot(offset)+6)%7]
    }

    de_monthdays $name.days $date

    # Interest calculation
    $self calc_interest
}

# effects - Set selection within month
method DateEditor set_selection {} {
    # Set selection
    set item =[expr [date monthday $slot(date)]+$slot(offset)]

    set name $slot(window)
    set coords [$name.days coords $item]
    $name.days coords marker\
	[expr [lindex $coords 0]+$slot(hpad)]\
	[expr [lindex $coords 1]]\
	[expr [lindex $coords 0]-$slot(itemwidth)]\
	[expr [lindex $coords 1]+$slot(itemheight)]
}

# Bindings

method DateEditor month_left {} {
    # Get previous month
    set d [date split $slot(date)]
    if {[lindex $d 2] == 1} {
	# Need to go to previous year
	set month 12
	set year [expr [lindex $d 3]-1]
    } else {
	set month [expr [lindex $d 2]-1]
	set year [lindex $d 3]
    }

    # Ensure that we are not at first month
    if [catch {date make 1 $month $year} first] {
	return
    }

    # Adjust monthday to month size
    set day [lindex $d 0]
    if {$day > [date monthsize $first]} {
	set day [date monthsize $first]
    }

    $self set_date [date make $day $month $year]
}

method DateEditor month_right {} {
    # Get next month
    set d [date split $slot(date)]
    if {[lindex $d 2] == 12} {
	# Need to go to next year
	set month 1
	set year [expr [lindex $d 3]+1]
    } else {
	set month [expr [lindex $d 2]+1]
	set year [lindex $d 3]
    }

    # Ensure that we are not at last month
    if [catch {date make 1 $month $year} first] {
	return
    }

    # Adjust monthday to month size
    set day [lindex $d 0]
    if {$day > [date monthsize $first]} {
	set day [date monthsize $first]
    }

    $self set_date [date make $day $month $year]
}

method DateEditor year_left {} {
    # Get previous year
    set d [date split $slot(date)]
    set month [lindex $d 2]
    set year [expr [lindex $d 3]-1]

    # Ensure that we are not already at first year
    if [catch {date make 1 $month $year} first] {
	return
    }

    # Adjust monthday to month size
    set day [lindex $d 0]
    if {$day > [date monthsize $first]} {
	set day [date monthsize $first]
    }

    $self set_date [date make $day $month $year]
}

method DateEditor year_right {} {
    # Get next year
    set d [date split $slot(date)]
    set month [lindex $d 2]
    set year [expr [lindex $d 3]+1]

    # Ensure that we are not already at last year
    if [catch {date make 1 $month $year} first] {
	return
    }

    # Adjust monthday to month size
    set day [lindex $d 0]
    if {$day > [date monthsize $first]} {
	set day [date monthsize $first]
    }

    $self set_date [date make $day $month $year]
}

method DateEditor today {} {
    $self set_date [date today]
}

method DateEditor last {} {
    $self set_date [expr $slot(date)-1]
}

method DateEditor next {} {
    $self set_date [expr $slot(date)+1]
}

method DateEditor day_select {} {
    set name $slot(window)
    if {[$name.days type current] != "text"} {
	return
    }

    foreach tag [lindex [$name.days itemconfigure current -tags] 4] {
	if [string match "=*" $tag] {
	    set day [expr [string range $tag 1 end]-$slot(offset)]
	    if {($day < 1) || ($day > [date monthsize $slot(date)])} {
		return
	    }
	    $self set_date [date make $day\
			    [date month $slot(date)]\
			    [date year $slot(date)]]
	    return
	}
    }
}

method DateEditor set_date {date} {
    set old $slot(date)
    if {$old != $date} {
	set slot(date) $date
	if {([date month $old] != [date month $date]) ||
	    ([date year  $old] != [date year  $date])} {
	    set slot(load) 1
	}
	set slot(callback) 1
	set slot(pending) [expr $slot(pending)+1]
	after 50 [list de_check $self]
    }
}

# Wrapper to handle DateEditor deletion
proc de_check {obj} {
    if {[info procs $obj] != $obj} {
	return
    }

    $obj check
}

method DateEditor check {} {
    set slot(pending) [expr $slot(pending)-1]
    if {$slot(pending) > 0} {
	return
    }
    set slot(pending) 0

    if $slot(load) {
	set slot(load) 0
	$self load_month
    }

    if $slot(callback) {
	set slot(callback) 0
	$self set_selection
	eval $slot(command) $slot(date)
    }
}