# Copyright (c) 1993 by Sanjay Ghemawat
##############################################################################
# ApptList
#
#	Maintains list of appointments for a certain date.
#
# Description
# ===========
# An AppointmentList displays appointments for a particular date.

# DisplayList changes (for merging apptlist/codelist)?
# ===========
#
# DisplayList <canvas> <type> <placement> <lineunit> <xpos> <width>
# 
# 	<type>		:= note|appt|all
# 	<placement>	:= list|by-time
# 	<lineunit>	:= pixels per line
# 	<xpos>		:= item x coordinates
# 	<width>		:= item width in pixels
# 
# $dl delete
# 
# $dl date <date>			Change date
# $dl added <item>		Item add notification
# $dl deleted <item>		Item delete notification
# $dl changed <item>		Item change notification
# $dl rescan			Rescan contents from calendar
# $dl focus			Return current focus - empty string if none.
# $dl focus <item>		Set focus to specified item.
# $dl unfocus			Unset focus from specified item.
# $dl width <width>		Set item widths
# $dl window <item>		Return itemwindow for item
# $dl item <window>		Return item in specified itemwindow
# $dl place <item>		Place item in right pos (intended for dragging)

# Autoload support
proc ApptList {} {}

class ApptList {name parent} {
    set slot(window) $name
    set slot(parent) $parent
    set slot(date) [date today]
    set slot(items) ""
    set slot(focus) ""
    set slot(width) 100
    set slot(start) 0
    set slot(finish) 24

    frame $name -bd 0
    scrollbar $name.s -relief raised -bd 1 -orient vertical\
	-command [list $name.c yview]
    canvas $name.c -bd 1 -relief raised -yscroll [list $name.s set]

    $self background

    pack append $name $name.s {right filly}
    pack append $name $name.c {left expand fill}

    # Establish bindings
    $name.c bind all <2> [list $name.c scan mark 0 %y]
    $name.c bind all <B2-Motion> [list $name.c scan dragto 0 %y]
    $name.c bind rest <Button-1> [list $self new %y]
    bind $name.c <Configure> [list $self canvas_resize %w %h]
    bind $name.c <Any-KeyPress> [list $parent key %A]

    # Handle triggers
    trigger on add	[list $self change]
    trigger on delete	[list $self remove]
    trigger on change	[list $self change]
    trigger on text	[list $self textchange]
    trigger on exclude	[list $self exclude]
    trigger on include	[list $self rescan]
}

method ApptList set_date {date} {
    set slot(date) $date
    $self rescan
    $self scroll_default
}

# effects - Cleanup on destruction
method ApptList cleanup {} {
    # We have to be very careful here about making sure callbacks do
    # not occur in the wrong place (i.e. on already deleted objects).

    # Remove triggers as soon as possible
    trigger remove add		[list $self change]
    trigger remove delete	[list $self remove]
    trigger remove change	[list $self change]
    trigger remove text		[list $self textchange]
    trigger remove exclude	[list $self exclude]
    trigger remove include	[list $self rescan]

    # Now unfocus - do not want unfocus callbacks coming back later
    if {$slot(focus) != ""} {
	$slot(window.$slot(focus)) unfocus
    }

    # Should be safe to kill the items now
    foreach item $slot(items) {
	class_kill $slot(window.$item)
    }

    destroy $slot(window)
}

##############################################################################
# Internal Procedures

method ApptList reconfig {} {
    $slot(window).c delete rest
    $self background
    $self scroll_default
    $self layout
}

# effects - Create AppointmentList background
method ApptList background {} {
    set c $slot(window).c

    set slot(width) [winfo pixels $c "[cal option ItemWidth]c"]

    set width [expr "[pref apptLabelWidth]+$slot(width)"]
    set height [expr 48*[pref itemLineHeight]]

    set slot(start)  [cal option DayviewTimeStart]
    set slot(finish) [cal option DayviewTimeFinish]
    set lines [expr ($slot(finish) - $slot(start)) * 2]

    # Set canvas geometry

    $c configure\
	-width $width\
	-height [expr $lines * [pref itemLineHeight]]\
	-confine 1\
	-scrollincrement [pref itemLineHeight]\
	-scrollregion [list 0 0 $width $height]		    
    $c xview 0
    $c yview [expr $slot(start)*2]

    # Create background
    $c create rectangle 0 0 $width $height\
	-fill ""\
	-outline ""\
	-width 0\
	-tags [list bg rest]

    # Draw vertical separator line
    $c create line [pref apptLabelWidth] 0 [pref apptLabelWidth] $height\
	-fill [pref apptLineColor]\
	-tags rest

    set time 0
    for {set i 0} {$i < 48} {incr i} {
	set ypos [expr $i*[pref itemLineHeight]]

	if {($i % 2) != 0} {
	    set stipple gray50
	    set xpos [pref apptLabelWidth]
	} else {
	    set stipple ""
	    set xpos 0

	    $c create text\
		[expr [pref apptLabelWidth]-[pref itemPad]]\
		[expr $ypos+[pref itemLineHeight]-[pref itemPad]]\
		-text [time2text $time]\
		-fill [pref apptLineColor]\
		-font [pref itemFont]\
		-anchor se\
		-tags rest
	}

	$c create line $xpos $ypos [expr 3*$width] $ypos -stipple $stipple\
	    -fill [pref apptLineColor]\
	    -tags rest
	incr time 30
    }

    $c lower rest
}

method ApptList new {y} {
    set y [$slot(window).c canvasy $y]

    if {$slot(focus) != ""} {
	# Just unfocus
	$slot(window.$slot(focus)) unfocus
	return
    }

    if [cal readonly] {
	error_notify [winfo toplevel $slot(window)] "Permission denied"
	return
    }

    set id [appointment]
    $id starttime [expr "([$self time $y]/30)*30"]
    $id length 30
    $id date $slot(date)
    $id earlywarning [cal option DefaultEarlyWarning]
    $id own
    run-hook item-create $id
    cal add $id

    set list $slot(items)
    lappend list $id
    set slot(items) $list

    $self make_window $id
    $slot(window.$id) focus

    trigger fire add $id
}

method ApptList change {item} {
    set list $slot(items)
    if {[$item is appt] && [$item contains $slot(date)]} {
	if {[lsearch $list $item] < 0} {
	    # Add item
	    lappend list $item
	    set slot(items) $list
	    $self make_window $item
	} else {
	    $slot(window.$item) read
	}
	$self layout
	return
    }

    if [lremove list $item] {
	set slot(items) $list
	class_kill $slot(window.$item)
	unset slot(window.$item)
	unset slot(adjust.$item)
	$self layout
    }
}

method ApptList textchange {item} {
    if {[$item is appt] && [$item contains $slot(date)]} {
	$slot(window.$item) read
    }
}

method ApptList exclude {calendar} {
    set oldlist $slot(items)
    set slot(items) ""
    set newlist ""
    foreach item $oldlist {
	if {[$item calendar] == $calendar} {
	    class_kill $slot(window.$item)
	    unset slot(window.$item)
	    unset slot(adjust.$item)
	} else {
	    lappend newlist $item
	}
    }
    set slot(items) $newlist
    $self layout
}

method ApptList remove {item} {
    set list $slot(items)
    if [lremove list $item] {
	set slot(items) $list
	class_kill $slot(window.$item)
	unset slot(window.$item)
	unset slot(adjust.$item)
	$self layout
    }
}

# args are ignored - they just allow trigger to call us directly.
method ApptList rescan {args} {
    set list $slot(items)
    set slot(items) ""
    if {$slot(focus) != ""} {
	$slot(window.$slot(focus)) unfocus
    }

    foreach appt $list {
	class_kill $slot(window.$appt)
	unset slot(window.$appt)
	unset slot(adjust.$appt)
    }

    set list {}
    cal query $slot(date) $slot(date) item d {
	if [$item is appt] {
	    lappend list $item
	    $self make_window $item
	}
    }
    set slot(items) $list
    $self layout
}

method ApptList scroll_default {} {
    set min [expr 24*60]
    set max 0
    foreach a $slot(items) {
	set st [$a starttime]
	set fi [expr [$a starttime]+[$a length]-1]
	if {$st < $min} {set min $st}
	if {$fi > $max} {set max $fi}
    }

    set minLine [expr $min/30]
    set maxLine [expr $max/30]

    set windowSize [expr "[lindex [$slot(window).c configure -height] 4]/
			  [pref itemLineHeight]"]

    # Try to make all appointments visible
    set start [expr $slot(start) * 2]
    if {($start + $windowSize - 1) < $maxLine} {
	set start [expr $maxLine-($slot(finish) - $slot(start))*2+1]
    }
    if {$start > $minLine} {
	set start $minLine
    }

    $slot(window).c yview $start
}

method ApptList time {y} {
    return [expr "($y * 30) / [pref itemLineHeight]"]
}

method ApptList coordinate {time} {
    return [expr "($time * [pref itemLineHeight]) / 30"]
}

method ApptList layout {} {
    $self sortitems

    # Move current appt to end of list so it appears at top
    if {$slot(focus) != ""} {
	set list $slot(items)
	if [lremove list $slot(focus)] {
	    lappend list $slot(focus)
	}
	set slot(items) $list
    }

    # Compute offset for each child (15 minute units?)

    # offset(i) for slot i keeps track of the current horizontal
    # adjustment for slot i
    for {set i 0} {$i < 24*4} {incr i} {
	set offset($i) 0
    }

    foreach a $slot(items) {
	set start [expr [$a starttime]/15]
	set finish [expr ([$a starttime]+[$a length]-1)/15]
	if {$finish >= 24*4} {
	    set finish [expr 24*4-1]
	}

	set adjust 0
	for {set i $start} {$i <= $finish} {incr i} {
	    if {$adjust < $offset($i)} {
		set adjust $offset($i)
	    }
	}
	for {set i $start} {$i <= $finish} {incr i} {
	    set offset($i) [expr $adjust+1]
	}

	# Place the child
	set slot(adjust.$a) $adjust
	$self place $a

	if {$adjust > 0} {
	    $slot(window.$a) raise
	}
    }
}

# effects - Sort item list
method ApptList sortitems {} {
    # Construct list of pairs <time,item>
    set list ""
    foreach item $slot(items) {
	lappend list [list [$item starttime] $item]
    }

    set items ""
    foreach pair [lsort $list] {
	lappend items [lindex $pair 1]
    }
    set slot(items) $items
}

# effects - Create window for item
method ApptList make_window {item} {
    set w [ItemWindow $slot(window).c $item $slot(date)]
    set slot(window.$item) $w
    set slot(adjust.$item) 0

    $w set_move_callback    [list $self move]
    $w set_resize_callback  [list $self resize]
    $w set_focus_callback   [list $self focus]
    $w set_unfocus_callback [list $self unfocus]
}

# effects - Place window for item
method ApptList place {a} {
    set adj [expr "$slot(adjust.$a)*[pref itemLineHeight]"]
    set finish [expr "[$a starttime]+[$a length]"]

    set x [expr "[pref apptLabelWidth]+ $adj + [pref itemPad]"]
    set y [expr "[$self coordinate [$a starttime]]+1"]
    set width [expr "$slot(width)-$adj-2*[pref itemPad]"]
    set height [expr "[$self coordinate $finish] - $y"]

    $slot(window.$a) raise
    $slot(window.$a) geometry $x $y $width $height
}

# Callbacks

method ApptList canvas_resize {w h} {
    $slot(window).c coord bg 0 0 $w [expr 48*[pref itemLineHeight]]
}

method ApptList move {item y} {
    if {$y == "done"} {
	cal changed $item
	trigger fire change $item
	return
    }

    set st [expr "([$self time $y]/15)*15"]
    if {$st < 0} {set st 0}
    if {($st + [$item length]) > 24*60} {set st [expr 24*60-[$item length]]}
    $item starttime $st
    $self place $item
}

method ApptList resize {item top bot} {
    if {$top == "done"} {
	cal changed $item
	trigger fire change $item
	return
    }

    set st [expr "([$self time $top]/15)*15"]
    if {$st < 0} {set st 0}

    set fi [expr "(([$self time $bot]+14)/15)*15"]
    if {$fi > 24*60} {set fi [expr 24*60]}

    if {($fi - $st) >= 30} {
	$item starttime $st
	$item length [expr $fi-$st]
	$self place $item
    }
}

method ApptList focus {item} {
    set slot(focus) $item
    $self layout

    $slot(parent) focus $item $slot(window.$item)
}

method ApptList unfocus {} {
    set slot(focus) ""
    $self layout
    $slot(parent) unfocus
}