# 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) 3
    set slot(vpad) 2

    # Layout the various components
    frame $name -bd 0

    # 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

    # Create weekday headings and get width
    set w 1
    set h 1
    set l {}
    set col 1
    foreach day {Sun Mon Tue Wed Thu Fri Sat} {
	set item [$d create text 0 0 -text $day -anchor ne\
			-tags [list Heading col$col]\
			-font [pref weekdayFont]]
	lappend l $item
	incr col

	set ibox [$d bbox $item]
	set iw [expr "[lindex $ibox 2] - [lindex $ibox 0]"]
	set ih [expr "[lindex $ibox 3] - [lindex $ibox 1]"]

	if {$w < $iw} {set w $iw}
	if {$h < $ih} {set h $ih}
    }

    # XXX Canvas text width calculation is broken
    label $name.temp -font [pref weekdayFont] -padx 0 -pady 0 -text Wed
    set w [winfo reqwidth $name.temp]
    destroy $name.temp

    set slot(itemwidth) $w
    set slot(itemheight) $h

    set w [expr $w+(2*$slot(hpad))]
    set h [expr $h+(2*$slot(vpad))]
    $d configure -width [expr "$w*8"] -height [expr "$h*8"]

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

    foreach i {1 2 3 4 5 6 7} {
	$d coords [lindex $l [expr $i-1]] [expr "$x+($i*$w)"] $y
    }

    # 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*$w)"] [expr "$y+(($r+1)*$h)"]\
		-text "$r$c" -anchor ne\
		-tags [list Day row$r col$c =[expr ($r-1)*7+$c]]\
		-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

    frame $name.top -relief raised -bd 1
    pack append $name.top $name.month left
    pack append $name.top $name.year right

    frame $name.bot -relief flat -bd 1
    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}

    frame $name.mid -bd 1 -relief raised
    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 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
}

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

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

    # Change colors
    $name.days itemconfig oldinterest\
	-fill [pref weekdayColor] -font [pref weekdayFont]
    $name.days itemconfig col1\
	-fill [pref weekendColor] -font [pref weekendFont]
    $name.days itemconfig col7\
	-fill [pref weekendColor] -font [pref weekendFont]
    $name.days itemconfig interest\
	-fill [pref interestColor] -font [pref interestFont]
    $name.days dtag oldinterest
}

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

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