# Copyright (c) 1993 by Sanjay Ghemawat
##############################################################################
# ItemWindow
#
#	Displays item contents as canvas item.
#
# Description
# ===========
# An ItemWindow displays item contents and allows editing.
# The ItemWindow is always maintained in a canvas.
#
# An ItemWindow has various callback slots --
#
#	move_callback
#		Execute {move_callback $item <y-coord>} when dragging
#		an itemwindow around.  <y-coord> is coordinate for top
#		of window (within parent canvas).
#		When drag is finished, {move_callback $item done} is called.
#		If move_callback == "", dragging is not allowed.
#
#	resize_callback
#		Execute {resize_callback $item <top> <bot>} when resizing
#		an itemwindow with the mouse.  <top>/<bot> are coordinates
#		for the top and bottom of the window (within parent canvas).
#		When resize is finished, {resize_callback $item done done}
#		is called.
#		If resize_callback == "", resizing is not allowed.
#
#	focus_callback
#		Execute {focus_callback $item} when window gets focus.
#		If focus_callback == "", focus is not allowed.
#
#	unfocus_callback
#		Execute {unfocus_callback} when window loses focus.
#		If unfocus_callback == "", no callback is made.

set _item_focus ""

# Autoload support
proc ItemWindow {} {}

# effects - Create ItemWindow in canvas.
class ItemWindow {canvas item date} {
    set slot(canvas) $canvas
    set slot(item) $item
    set slot(date) $date
    set slot(x) -100
    set slot(y) -100
    set slot(width) 1
    set slot(height) 1
    set slot(focus) 0
    set slot(modify_allowed) 0

    set slot(move_callback) ""
    set slot(resize_callback) ""
    set slot(focus_callback) ""
    set slot(unfocus_callback) ""

    set slot(dragy) 0
    set slot(dragtop) 0
    set slot(dragbot) 0
    set slot(moving) 0
    set slot(resizing) 0

    $canvas create rectangle -100 -100 -101 -101\
	-fill [pref itemBg]\
	-width 0\
	-tags [list $self rect.$self]

    $canvas create text -100 -100\
	-anchor nw\
	-fill [pref itemFg]\
	-font [pref itemFont]\
	-width 0\
	-text ""\
	-tags [list $self text.$self]

    $canvas bind $self <Button-1> [list $self click %x %y]
    $canvas bind $self <B1-Motion> [list $self select_to %x %y]

    $self read
}

# effects - set move_callback
method ItemWindow set_move_callback {c} {
    set slot(move_callback) $c

    set canvas $slot(canvas)
    if {$c == ""} {
	$canvas bind $self <ButtonPress-2>	""
	$canvas bind $self <B2-Motion>	 	""
	$canvas bind $self <ButtonRelease-2>	""
    } else {
	$canvas bind $self <ButtonPress-2>	[list $self move_start %y]
	$canvas bind $self <B2-Motion>	 	[list $self move_continue %y]
	$canvas bind $self <ButtonRelease-2>	[list $self move_finish %y]
    }
}

# effects - set resize_callback
method ItemWindow set_resize_callback {c} {
    set slot(resize_callback) $c

    set canvas $slot(canvas)
    if {$c == ""} {
	$canvas bind $self <ButtonPress-3>	""
	$canvas bind $self <B3-Motion>	 	""
	$canvas bind $self <ButtonRelease-3>	""
    } else {
	$canvas bind $self <ButtonPress-3>	[list $self size_start %y]
	$canvas bind $self <B3-Motion>	 	[list $self size_continue %y]
	$canvas bind $self <ButtonRelease-3>	[list $self size_finish %y]
    }
}

# effects - set focus_callback
method ItemWindow set_focus_callback {c} {
    set slot(focus_callback) $c
}

# effects - set unfocus_callback
method ItemWindow set_unfocus_callback {c} {
    set slot(unfocus_callback) $c
}

# effects - Destroy item
method ItemWindow cleanup {} {
    $self unfocus
    $slot(canvas) delete $self
}

# effects - Set item geometry
method ItemWindow geometry {x y w h} {
    set slot(x) $x
    set slot(y) $y
    set slot(width) $w
    set slot(height) $h

    $self place
}

# effects - Raise associated window
method ItemWindow raise {} {
    $slot(canvas) raise $self
}

method ItemWindow save {} {
    set item $slot(item)
    set new [lindex [$slot(canvas) itemconfig text.$self -text] 4]
    set old [$item text]

    if {[string compare $new $old] == 0} {return}

    if ![cal option AllowOverflow] {
	# Prevent text from overflowing appointment
	set lg [expr [string length $new] > [string length $old]]
	if {($slot(resize_callback) != "") && $lg} {
	    set bbox [$slot(canvas) bbox text.$self]
	    if {[lindex $bbox 3] > ($slot(y) + $slot(height))} {
		# Refuse to enlarge text if it does not fit
		$self read
		return
	    }
	}
    }

    $item text $new
    cal changed $item
    trigger fire text $item
}

method ItemWindow read {} {
    $slot(canvas) itemconfigure text.$self -text [$slot(item) text]
    $self place
}

method ItemWindow focus {} {
    if {$slot(focus_callback) == ""} {return}
    if $slot(focus) {return}

    global _item_focus
    if {$_item_focus != ""} {$_item_focus unfocus}
    set _item_focus $self

    set slot(focus) 1
    set slot(modify_allowed) 0

    focus_interest $slot(canvas)
    $slot(canvas) itemconfig text.$self -fill [pref itemSelectFg]
    $slot(canvas) itemconfig rect.$self\
	-fill [pref itemSelectBg]\
	-width [pref itemSelectWidth]

    $slot(canvas) focus text.$self
    $self raise

    eval $slot(focus_callback) $slot(item)
}

method ItemWindow unfocus {} {
    if !$slot(focus) {return}

    global _item_focus
    if {$_item_focus == $self} {set _item_focus ""}

    if {$slot(unfocus_callback) != ""} {
	eval $slot(unfocus_callback)
    }

    set slot(focus) 0
    set slot(moving) 0
    set slot(resizing) 0
    set slot(modify_allowed) 0

    focus_disinterest $slot(canvas)
    $slot(canvas) itemconfig text.$self -fill [pref itemFg]
    $slot(canvas) itemconfig rect.$self\
	-fill [pref itemBg]\
	-width 0

    $slot(canvas) focus ""
}

method ItemWindow click {x y} {
    $self focus
    if !$slot(focus) {return}

    set x [$slot(canvas) canvasx $x]
    set y [$slot(canvas) canvasy $y]
    $slot(canvas) icursor text.$self @$x,$y
    $slot(canvas) select from text.$self @$x,$y
}

method ItemWindow select_to {x y} {
    set x [$slot(canvas) canvasx $x]
    set y [$slot(canvas) canvasy $y]
    $slot(canvas) select to text.$self @$x,$y
}

# effects - Return bounding box for specified item
method ItemWindow bbox {} {
    return [$slot(canvas) bbox $self]
}

# Internal Operations

# effects - Place window at appropriate position in canvas
method ItemWindow place {} {
    $slot(canvas) coords text.$self [expr $slot(x)+2] [expr $slot(y)+1]
    $slot(canvas) itemconfig text.$self -width $slot(width)

    set x1 $slot(x)
    set y1 $slot(y)
    set x2 [expr $x1 + $slot(width)]
    set y2 [expr $y1 + $slot(height)]

    if {$slot(resize_callback) == ""} {
	# Auto size item.  Check for text overflow
	set bbox [$slot(canvas) bbox text.$self]
	set yt [lindex $bbox 3]
	if {$yt > $y2} {set y2 $yt}
    }

    $slot(canvas) coords rect.$self $x1 $y1 $x2 $y2
}

method ItemWindow move_start {y} {
    $self focus
    if [cal readonly [$slot(item) calendar]] {
	return
    }

    if {$slot(move_callback) == ""} {
	return
    }

    if {[$self repeat_modify_ok] != "unnecessary"} {
	return
    }

    set slot(moving) 1
    set slot(dragy) [expr $y-$slot(y)]
}

method ItemWindow move_continue {y} {
    if !$slot(moving) {return}

    set new_y [expr $y-$slot(dragy)]
    eval $slot(move_callback) $slot(item) $new_y
}

method ItemWindow move_finish {y} {
    if !$slot(moving) {return}
    $self move_continue $y
    set slot(moving) 0
    eval $slot(move_callback) $slot(item) done
}

method ItemWindow size_start {y} {
    $self focus
    if [cal readonly [$slot(item) calendar]] {
	return
    }

    if {$slot(resize_callback) == ""} {
	return
    }

    if {[$self repeat_modify_ok] != "unnecessary"} {
	return
    }

    set slot(resizing) 1
    set slot(dragtop) 0
    set slot(dragbot) 0
}

method ItemWindow size_continue {y} {
    if !$slot(resizing) {return}

    set new_y [$slot(canvas) canvasy $y]
    set top $slot(y)
    set bot [expr $slot(y)+$slot(height)]

    if {$new_y < $top} {
	set slot(dragtop) 1
	set slot(dragbot) 0
	eval $slot(resize_callback) $slot(item) $new_y $bot
	return
    }

    if {$new_y > $bot} {
	set slot(dragtop) 0
	set slot(dragbot) 1
	eval $slot(resize_callback) $slot(item) $top $new_y
	return
    }

    if $slot(dragtop) {
	set top $new_y
    }

    if $slot(dragbot) {
	set bot $new_y
    }

    if ![cal option AllowOverflow] {
	# Make sure text does not overflow on resize
	set bbox [$slot(canvas) bbox text.$self]
	set ht [expr [lindex $bbox 3] - [lindex $bbox 1]]
	if {($bot - $top) >= $ht} {
	    eval $slot(resize_callback) $slot(item) $top $bot
	}
    } else {
	eval $slot(resize_callback) $slot(item) $top $bot
    }
}

method ItemWindow size_finish {y} {
    if !$slot(resizing) {return}
    $self size_continue $y
    set slot(resizing) 0
    eval $slot(resize_callback) $slot(item) done done
}

method ItemWindow key {{key ""}} {
    if {$key == ""} {
	return
    }

    if !$slot(focus) {return}
    if [cal readonly [$slot(item) calendar]] {return}

    $self canvas_handle $key
}

# Handle string input
method ItemWindow canvas_handle {{str ""}} {
    set w $slot(canvas)

    if {"x$str" == "x\002"} {
	# Control-b
	$w icursor text.$self [expr [$w index text.$self insert]-1]
	return
    }

    if {"x$str" == "x\004"} {
	# Control-d
	if {[$self repeat_modify_ok] == "cancel"} {return}
	if [catch {$w dchars text.$self sel.first sel.last}] {
	    # Delete next character
	    $w dchars text.$self insert
	}
	$self save
	return
    }

    if {"x$str" == "x\006"} {
	# Control-f
	$w icursor text.$self [expr [$w index text.$self insert]+1]
	return
    }

    if {("x$str" == "x\010") || ("x$str" == "x\177")} {
	# Control-h or Delete
	if {[$self repeat_modify_ok] == "cancel"} {return}
	$w dchars text.$self [expr [$w index text.$self insert]-1]
	$self save
	return
    }

    if {"x$str" == "x\015"} {
	# Control-m
	if {[$self repeat_modify_ok] == "cancel"} {return}
	$w insert text.$self insert "\n"
	$self save
	return
    }

    if {"x$str" == "x\031"} {
	# Control-y
	if ![catch {set str [selection get]}] {
	    if {[$self repeat_modify_ok] == "cancel"} {return}
	    $w insert text.$self insert [selection get]
	    $self save
	}
	return
    }

    if {[$self repeat_modify_ok] == "cancel"} {return}
    $w insert text.$self insert $str
    $self save
    return
}

# requires - item occurs on date and is the current focus
# effects -  If item does not repeat, return "unnecessary".
#
#	     If item repeats, but user interaction says it is ok to
#	     modify all items, return "ok".
#
#	     If item repeats, but user interaction says it is ok to
#	     modify this instance, split item up so that modifications
#	     will only happen to the instance on date, and return "instance".
#
#	     If item repeats, and user interaction cancels the current
#	     operation, return "cancel".

method ItemWindow repeat_modify_ok {} {
    if $slot(modify_allowed) {return "unnecessary"}

    set result [repeat_check [winfo toplevel $slot(canvas)]\
		$slot(item) $slot(date)]

    if {$result == "ok"} {
	# Record user response to prevent unnecessary interactions
	set slot(modify_allowed) 1
    }
    return $result
}