Initial revision

2 files changed, 1613 insertions, 0 deletions

diff --git a/library/filelist-bindings.tcl b/library/filelist-bindings.tcl
new file mode 100644
index 0000000..f58ef82
--- /dev/null
+++ b/library/filelist-bindings.tcl
@@ -0,0 +1,788 @@
+bind TreeCtrlFileList <Double-ButtonPress-1> {
+	TreeCtrl::FileListEditCancel %W
+	TreeCtrl::DoubleButton1 %W %x %y
+}
+bind TreeCtrlFileList <Control-ButtonPress-1> {
+	set TreeCtrl::Priv(selectMode) toggle
+	TreeCtrl::FileListButton1 %W %x %y
+	break
+}
+bind TreeCtrlFileList <Shift-ButtonPress-1> {
+	set TreeCtrl::Priv(selectMode) add
+	TreeCtrl::FileListButton1 %W %x %y
+	break
+}
+bind TreeCtrlFileList <ButtonPress-1> {
+	set TreeCtrl::Priv(selectMode) set
+	TreeCtrl::FileListButton1 %W %x %y
+	break
+}
+bind TreeCtrlFileList <Button1-Motion> {
+	TreeCtrl::FileListMotion1 %W %x %y
+	break
+}
+bind TreeCtrlFileList <Button1-Leave> {
+	TreeCtrl::FileListLeave1 %W %x %y
+	break
+}
+bind TreeCtrlFileList <ButtonRelease-1> {
+	TreeCtrl::FileListRelease1 %W %x %y
+	break
+}
+
+proc TreeCtrl::FileListButton1 {T x y} {
+	variable Priv
+	focus $T
+	set id [$T identify $x $y]
+	set marquee 0
+	set Priv(buttonMode) ""
+	FileListEditCancel $T
+	# Click outside any item
+	if {$id eq ""} {
+		set marquee 1
+
+	# Click in header
+	} elseif {[lindex $id 0] eq "header"} {
+		ButtonPress1 $T $x $y
+
+	# Click in item
+	} else {
+		foreach {where item arg1 arg2 arg3 arg4} $id {}
+		switch $arg1 {
+			button -
+			line {
+				ButtonPress1 $T $x $y
+			}
+			column {
+				# Clicked in column zero
+				if {$arg2 eq 0} {
+					set ok 0
+					# Clicked an element
+					if {[llength $id] == 6} {
+						set E [lindex $id 5]
+						if {[lsearch -exact $Priv(sensitive,$T) $E] != -1} {
+							set ok 1
+						}
+					}
+					if {$ok} {
+						set Priv(drag,motion) 0
+						set Priv(drag,x) [$T canvasx $x]
+						set Priv(drag,y) [$T canvasy $y]
+						set Priv(drop) ""
+						set Priv(drag,wasSel) [$T selection includes $item]
+						set Priv(drag,E) $E
+						$T activate $item
+						if {$Priv(selectMode) eq "add"} {
+							BeginExtend $T $item
+						} elseif {$Priv(selectMode) eq "toggle"} {
+							BeginToggle $T $item
+						} elseif {![$T selection includes $item]} {
+							BeginSelect $T $item
+						}
+
+						# Changing the selection might change the list
+						if {[$T index $item] eq ""} return
+
+						# Click selected item to drag
+						if {[$T selection includes $item]} {
+							set Priv(buttonMode) drag
+						}
+					# Clicked inside item, but outside elements
+					} else {
+						set marquee 1
+					}
+				# Clicked column > 0
+				} else {
+					set marquee 1
+				}
+			}
+		}
+	}
+	if {$marquee} {
+		set Priv(buttonMode) marquee
+		if {$Priv(selectMode) ne "set"} {
+			set Priv(selection) [$T selection get]
+		} else {
+			$T selection clear
+			set Priv(selection) {}
+		}
+		MarqueeBegin $T $x $y
+	}
+	return
+}
+proc TreeCtrl::FileListMotion1 {T x y} {
+	variable Priv
+	switch $Priv(buttonMode) {
+		"resize" -
+		"header" {
+			Motion1 $T $x $y
+		}
+		"drag" -
+		"marquee" {
+			FileListAutoScanCheck $T $x $y
+			FileListMotion $T $x $y
+		}
+	}
+}
+proc TreeCtrl::FileListMotion {T x y} {
+	variable Priv
+	switch $Priv(buttonMode) {
+		"resize" -
+		"header" {
+			Motion1 $T $x $y
+		}
+		"marquee" {
+			MarqueeUpdate $T $x $y
+			set select $Priv(selection)
+			set deselect {}
+
+			# Check items covered by the marquee
+			foreach list [$T marque identify] {
+				set item [lindex $list 0]
+
+				# Check covered columns in this item
+				foreach sublist [lrange $list 1 end] {
+					set column [lindex $sublist 0]
+					set ok 0
+					foreach E [lrange $sublist 1 end] {
+						if {[lsearch -exact $Priv(sensitive,$T) $E] != -1} {
+							set ok 1
+							break
+						}
+					}
+					# Some elements in column zero are covered
+					if {($column == 0) && $ok} {
+
+						# Toggle selected status
+						if {$Priv(selectMode) eq "toggle"} {
+							set i [lsearch -exact $Priv(selection) $item]
+							if {$i == -1} {
+								lappend select $item
+							} else {
+								set i [lsearch -exact $select $item]
+								set select [lreplace $select $i $i]
+							}
+						} else {
+							lappend select $item
+						}
+					}
+					break
+				}
+			}
+			$T selection modify $select all
+		}
+		"drag" {
+			# Detect initial mouse movement
+			if {!$Priv(drag,motion)} {
+				set Priv(selection) [$T selection get]
+				set Priv(drop) ""
+				$T dragimage clear
+				# For each selected item, add some elements to the dragimage
+				foreach I $Priv(selection) {
+					foreach list $Priv(dragimage,$T) {
+						set C [lindex $list 0]
+						set S [lindex $list 1]
+						if {[$T item style set $I $C] eq $S} {
+							eval $T dragimage add $I $C [lrange $list 2 end]
+						}
+					}
+				}
+				set Priv(drag,motion) 1
+				$T notify generate <Drag-begin> -T $T
+			}
+
+			# Find the element under the cursor
+			set drop ""
+			set id [$T identify $x $y]
+			set ok 0
+			if {($id ne "") && ([lindex $id 0] eq "item") && ([llength $id] == 6)} {
+				set E [lindex $id 5]
+				if {[lsearch -exact $Priv(sensitive,$T) $E] != -1} {
+					set ok 1
+				}
+			}
+			if {$ok} {
+				set item [lindex $id 1]
+				set column [lindex $id 3]
+				if {$column == 0} {
+					# If the item is not in the pre-drag selection
+					# (i.e. not being dragged) and it is a directory,
+					# see if we can drop on it
+					if {[lsearch -exact $Priv(selection) $item] == -1} {
+						if {[lindex [$T item index $item] 1] < $Priv(DirCnt,$T)} {
+							set drop $item
+							# We can drop if dragged item isn't an ancestor
+							foreach item2 $Priv(selection) {
+								if {[$T item isancestor $item2 $item]} {
+									set drop ""
+									break
+								}
+							}
+						}
+					}
+				}
+			}
+
+			# Select the directory under the cursor (if any) and deselect
+			# the previous drop-directory (if any)
+			$T selection modify $drop $Priv(drop)
+			set Priv(drop) $drop
+
+			# Show the dragimage in its new position
+			set x [expr {[$T canvasx $x] - $Priv(drag,x)}]
+			set y [expr {[$T canvasy $y] - $Priv(drag,y)}]
+			$T dragimage offset $x $y
+			$T dragimage visible yes
+		}
+	}
+	return
+}
+proc TreeCtrl::FileListLeave1 {T x y} {
+	variable Priv
+# This gets called when I click the mouse on Unix, and buttonMode is unset
+if {![info exists Priv(buttonMode)]} return
+	switch $Priv(buttonMode) {
+		"header" {
+			Leave1 $T $x $y
+		}
+	}
+	return
+}
+proc TreeCtrl::FileListRelease1 {T x y} {
+	variable Priv
+	switch $Priv(buttonMode) {
+		"resize" -
+		"header" {
+			Release1 $T $x $y
+		}
+		"marquee" {
+			AutoScanCancel $T
+			MarqueeEnd $T $x $y
+		}
+		"drag" {
+			AutoScanCancel $T
+
+			# Some dragging occurred
+			if {$Priv(drag,motion)} {
+				$T dragimage visible no
+				if {$Priv(drop) ne ""} {
+					$T selection modify {} $Priv(drop)
+					$T notify generate <Drag-receive> -T $T -I $Priv(drop) \
+						-l $Priv(selection)
+				}
+				$T notify generate <Drag-end> -T $T
+
+			} elseif {$Priv(selectMode) eq "toggle"} {
+				# don't rename
+
+			# Clicked/released a selected item, but didn't drag
+			} elseif {$Priv(drag,wasSel)} {
+				set I [$T index active]
+				set E $Priv(drag,E)
+				set S [$T item style set $I 0]
+				if {[lsearch -exact $Priv(edit,$T) $E] != -1} {
+					FileListEditCancel $T
+					set Priv(editId,$T) [after 900 [list ::TreeCtrl::FileListEdit $T $I $S $E]]
+				}
+			}
+		}
+	}
+	set Priv(buttonMode) ""
+	return
+}
+proc TreeCtrl::FileListEdit {T I S E} {
+	variable Priv
+	array unset Priv editId,$T
+	set lines [$T item element cget $I 0 $E -lines]
+	if {$lines eq ""} {
+		set lines [$T element cget $E -lines]
+	}
+
+	# Scroll item into view
+	$T see $I ; update
+
+	# Multi-line edit
+	if {$lines ne "1"} {
+		scan [$T item bbox $I 0] "%d %d %d %d" x1 y1 x2 y2
+		set padw [$T style layout $S $E -padw]
+		set pade [$T style layout $S $E -pade]
+		TextExpanderOpen $T $I 0 $E [expr {$x2 - $x1 - $padw - $pade}]
+
+	# Single-line edit
+	} else {
+		EntryExpanderOpen $T $I 0 $E
+	}
+	return
+}
+proc TreeCtrl::FileListEditCancel {T} {
+	variable Priv
+	if {[info exists Priv(editId,$T)]} {
+		after cancel $Priv(editId,$T)
+		array unset Priv editId,$T
+	}
+	return
+}
+
+# Same as TreeCtrl::AutoScanCheck, but calls FileListMotion and
+# FileListAutoScanCheckAux
+proc TreeCtrl::FileListAutoScanCheck {T x y} {
+	variable Priv
+	scan [$T contentbox] "%d %d %d %d" x1 y1 x2 y2
+	set margin [winfo pixels $T [$T cget -scrollmargin]]
+	if {($x < $x1 + $margin) || ($x >= $x2 - $margin) ||
+		($y < $y1 + $margin) || ($y >= $y2 - $margin)} {
+		if {![info exists Priv(autoscan,afterId,$T)]} {
+			if {$y >= $y2 - $margin} {
+				$T yview scroll 1 units
+				set delay [$T cget -yscrolldelay]
+			} elseif {$y < $y1 + $margin} {
+				$T yview scroll -1 units
+				set delay [$T cget -yscrolldelay]
+			} elseif {$x >= $x2 - $margin} {
+				$T xview scroll 1 units
+				set delay [$T cget -xscrolldelay]
+			} elseif {$x < $x1 + $margin} {
+				$T xview scroll -1 units
+				set delay [$T cget -xscrolldelay]
+			}
+			set count [scan $delay "%d %d" d1 d2]
+			if {[info exists Priv(autoscan,scanning,$T)]} {
+				if {$count == 2} {
+					set delay $d2
+				}
+			} else {
+				if {$count == 2} {
+					set delay $d1
+				}
+				set Priv(autoscan,scanning,$T) 1
+			}
+			switch $Priv(buttonMode) {
+				"drag" -
+				"marquee" {
+					FileListMotion $T $x $y
+				}
+			}
+			set Priv(autoscan,afterId,$T) [after $delay [list TreeCtrl::FileListAutoScanCheckAux $T]]
+		}
+		return
+	}
+	AutoScanCancel $T
+	return
+}
+
+proc ::TreeCtrl::FileListAutoScanCheckAux {T} {
+	variable Priv
+	unset Priv(autoscan,afterId,$T)
+	set x [winfo pointerx $T]
+	set y [winfo pointery $T]
+	set x [expr {$x - [winfo rootx $T]}]
+	set y [expr {$y - [winfo rooty $T]}]
+	FileListAutoScanCheck $T $x $y
+	return
+}
+
+proc ::TreeCtrl::EntryOpen {T item column element} {
+
+	variable Priv
+
+	set Priv(entry,$T,item) $item
+	set Priv(entry,$T,column) $column
+	set Priv(entry,$T,element) $element
+	set Priv(entry,$T,focus) [focus]
+
+	# Get window coords of the Element
+	scan [$T item bbox $item $column $element] "%d %d" x y
+
+	# Get the font used by the Element
+	set font [$T item element actual $item $column $element -font]
+
+	# Get the text used by the Element. Could check master Element too.
+	set text [$T item element cget $item $column $element -text]
+
+	# Create the Entry widget if needed
+	if {[winfo exists $T.entry]} {
+		$T.entry delete 0 end
+	} else {
+		entry $T.entry -borderwidth 1 -highlightthickness 0 -relief solid
+
+		# Accept edit when we lose the focus
+		bind $T.entry <FocusOut> {
+			if {[winfo ismapped %W]} {
+				TreeCtrl::EntryClose [winfo parent %W] 1
+			}
+		}
+
+		# Accept edit on <Return>
+		bind $T.entry <KeyPress-Return> {
+			TreeCtrl::EntryClose [winfo parent %W] 1
+			focus $TreeCtrl::Priv(entry,[winfo parent %W],focus)
+		}
+
+		# Cancel edit on <Escape>
+		bind $T.entry <KeyPress-Escape> {
+			TreeCtrl::EntryClose [winfo parent %W] 0
+			focus $TreeCtrl::Priv(entry,[winfo parent %W],focus)
+		}
+	}
+
+	# Pesky MouseWheel
+	$T notify bind $T.entry <Scroll> {
+		TreeCtrl::EntryClose %T 0
+		focus $TreeCtrl::Priv(entry,%T,focus)
+	}
+
+	$T.entry configure -font $font
+	$T.entry insert end $text
+	$T.entry selection range 0 end
+
+	set ebw [$T.entry cget -borderwidth]
+	if 1 {
+		set ex [expr {$x - $ebw - 1}]
+		place $T.entry -x $ex -y [expr {$y - $ebw - 1}] \
+			-bordermode outside
+	} else {
+		set hw [$T cget -highlightthickness]
+		set bw [$T cget -borderwidth]
+		set ex [expr {$x - $bw - $hw - $ebw - 1}]
+		place $T.entry -x $ex -y [expr {$y - $bw - $hw - $ebw - 1}]
+	}
+
+	# Make the Entry as wide as the text plus "W" but keep it within the
+	# TreeCtrl borders
+	set width [font measure $font ${text}W]
+	set width [expr {$width + ($ebw + 1) * 2}]
+	scan [$T contentbox] "%d %d %d %d" left top right bottom
+	if {$ex + $width > $right} {
+		set width [expr {$right - $ex}]
+	}
+	scan [$T item bbox $item $column] "%d %d %d %d" left top right bottom
+	if {$ex + $width > $right} {
+		set width [expr {$right - $ex}]
+	}
+	place configure $T.entry -width $width
+
+	focus $T.entry
+
+	return
+}
+
+# Like EntryOpen, but Entry widget expands/shrinks during typing
+proc ::TreeCtrl::EntryExpanderOpen {T item column element} {
+
+	variable Priv
+
+	set Priv(entry,$T,item) $item
+	set Priv(entry,$T,column) $column
+	set Priv(entry,$T,element) $element
+	set Priv(entry,$T,focus) [focus]
+
+	# Get window coords of the Element
+	scan [$T item bbox $item $column $element] "%d %d" x y
+
+	# Get the font used by the Element
+	set font [$T item element actual $item $column $element -font]
+
+	set Priv(entry,$T,font) $font
+
+	# Get the text used by the Element. Could check master Element too.
+	set text [$T item element cget $item $column $element -text]
+
+	# Create the Entry widget if needed
+	if {[winfo exists $T.entry]} {
+		$T.entry delete 0 end
+	} else {
+		entry $T.entry -borderwidth 1 -highlightthickness 0 \
+			-selectborderwidth 0 -relief solid
+
+		# Accept edit when we lose the focus
+		bind $T.entry <FocusOut> {
+			if {[winfo ismapped %W]} {
+				TreeCtrl::EntryClose [winfo parent %W] 1
+			}
+		}
+
+		# Accept edit on <Return>
+		bind $T.entry <KeyPress-Return> {
+			TreeCtrl::EntryClose [winfo parent %W] 1
+			focus $TreeCtrl::Priv(entry,[winfo parent %W],focus)
+		}
+
+		# Cancel edit on <Escape>
+		bind $T.entry <KeyPress-Escape> {
+			TreeCtrl::EntryClose [winfo parent %W] 0
+			focus $TreeCtrl::Priv(entry,[winfo parent %W],focus)
+		}
+
+		# Resize as user types
+		bind $T.entry <KeyPress> {
+			after idle TreeCtrl::EntryExpanderKeypress [winfo parent %W]
+		}
+	}
+
+	# Pesky MouseWheel
+	$T notify bind $T.entry <Scroll> {
+		TreeCtrl::EntryClose %T 0
+		focus $TreeCtrl::Priv(entry,%T,focus)
+	}
+
+	$T.entry configure -font $font -background [$T cget -background]
+	$T.entry insert end $text
+	$T.entry selection range 0 end
+
+	set ebw [$T.entry cget -borderwidth]
+	set ex [expr {$x - $ebw - 1}]
+	place $T.entry -x $ex -y [expr {$y - $ebw - 1}] \
+		-bordermode outside
+
+	# Make the Entry as wide as the text plus "W" but keep it within the
+	# TreeCtrl borders
+	set width [font measure $font ${text}W]
+	set width [expr {$width + ($ebw + 1) * 2}]
+	scan [$T contentbox] "%d %d %d %d" left top right bottom
+	if {$ex + $width > $right} {
+		set width [expr {$right - $ex}]
+	}
+	place configure $T.entry -width $width
+
+	focus $T.entry
+
+	return
+}
+
+proc ::TreeCtrl::EntryClose {T accept} {
+
+	variable Priv
+
+	place forget $T.entry
+	update
+
+	if {$accept} {
+		$T notify generate <Edit-accept> -T $T -I $Priv(entry,$T,item) \
+			-C $Priv(entry,$T,column) -E $Priv(entry,$T,element) \
+			-t [$T.entry get]
+	}
+
+	$T notify bind $T.entry <Scroll> {}
+
+	return
+}
+
+proc ::TreeCtrl::EntryExpanderKeypress {T} {
+
+	variable Priv
+
+	set font $Priv(entry,$T,font)
+	set text [$T.entry get]
+	set ebw [$T.entry cget -borderwidth]
+	set ex [winfo x $T.entry]
+
+	set width [font measure $font ${text}W]
+	set width [expr {$width + ($ebw + 1) * 2}]
+
+	scan [$T contentbox] "%d %d %d %d" left top right bottom
+	if {$ex + $width > $right} {
+		set width [expr {$right - $ex}]
+	}
+
+	place configure $T.entry -width $width
+
+	return
+}
+
+proc ::TreeCtrl::TextOpen {T item column element {width 0} {height 0}} {
+
+	variable Priv
+
+	set Priv(text,$T,item) $item
+	set Priv(text,$T,column) $column
+	set Priv(text,$T,element) $element
+	set Priv(text,$T,focus) [focus]
+
+	# Get window coords of the Element
+	scan [$T item bbox $item $column $element] "%d %d %d %d" x1 y1 x2 y2
+
+	# Get the font used by the Element
+	set font [$T item element actual $item $column $element -font]
+
+	# Get the text used by the Element. Could check master Element too.
+	set text [$T item element cget $item $column $element -text]
+
+	# Create the Text widget if needed
+	if {[winfo exists $T.text]} {
+		$T.text delete 1.0 end
+	} else {
+		text $T.text -borderwidth 1 -highlightthickness 0 -relief solid
+
+		# Accept edit when we lose the focus
+		bind $T.text <FocusOut> {
+			if {[winfo ismapped %W]} {
+				TreeCtrl::TextClose [winfo parent %W] 1
+			}
+		}
+
+		# Accept edit on <Return>
+		bind $T.text <KeyPress-Return> {
+			TreeCtrl::TextClose [winfo parent %W] 1
+			focus $TreeCtrl::Priv(text,[winfo parent %W],focus)
+			break
+		}
+
+		# Cancel edit on <Escape>
+		bind $T.text <KeyPress-Escape> {
+			TreeCtrl::TextClose [winfo parent %W] 0
+			focus $TreeCtrl::Priv(text,[winfo parent %W],focus)
+		}
+	}
+
+	# Pesky MouseWheel
+	$T notify bind $T.text <Scroll> {
+		TreeCtrl::TextClose %T 0
+		focus $TreeCtrl::Priv(text,%T,focus)
+	}
+
+	$T.text tag configure TAG -justify [$T element cget $element -justify]
+	$T.text configure -font $font
+	$T.text insert end $text
+	$T.text tag add sel 1.0 end
+	$T.text tag add TAG 1.0 end
+
+	set tbw [$T.text cget -borderwidth]
+	set tx [expr {$x1 - $tbw - 1}]
+	place $T.text -x $tx -y [expr {$y1 - $tbw - 1}] \
+		-width [expr {$x2 - $x1 + ($tbw + 1) * 2}] \
+		-height [expr {$y2 - $y1 + ($tbw + 1) * 2}] \
+		-bordermode outside
+
+	focus $T.text
+
+	return
+}
+
+# Like TextOpen, but Text widget expands/shrinks during typing
+proc ::TreeCtrl::TextExpanderOpen {T item column element width} {
+
+	variable Priv
+
+	set Priv(text,$T,item) $item
+	set Priv(text,$T,column) $column
+	set Priv(text,$T,element) $element
+	set Priv(text,$T,focus) [focus]
+
+	# Get window coords of the Element
+	scan [$T item bbox $item $column $element] "%d %d %d %d" x1 y1 x2 y2
+
+	set Priv(text,$T,center) [expr {$x1 + ($x2 - $x1) / 2}]
+
+	# Get the font used by the Element
+	set font [$T item element actual $item $column $element -font]
+
+	# Get the text used by the Element. Could check master Element too.
+	set text [$T item element cget $item $column $element -text]
+
+	set justify [$T element cget $element -justify]
+
+	# Create the Text widget if needed
+	if {[winfo exists $T.text]} {
+		$T.text delete 1.0 end
+	} else {
+		text $T.text -borderwidth 1 -highlightthickness 0 \
+			-selectborderwidth 0 -relief solid
+
+		# Accept edit when we lose the focus
+		bind $T.text <FocusOut> {
+			if {[winfo ismapped %W]} {
+				TreeCtrl::TextClose [winfo parent %W] 1
+			}
+		}
+
+		# Accept edit on <Return>
+		bind $T.text <KeyPress-Return> {
+			TreeCtrl::TextClose [winfo parent %W] 1
+			focus $TreeCtrl::Priv(text,[winfo parent %W],focus)
+			break
+		}
+
+		# Cancel edit on <Escape>
+		bind $T.text <KeyPress-Escape> {
+			TreeCtrl::TextClose [winfo parent %W] 0
+			focus $TreeCtrl::Priv(text,[winfo parent %W],focus)
+		}
+
+		# Resize as user types
+		bind $T.text <KeyPress> {
+			after idle TreeCtrl::TextExpanderKeypress [winfo parent %W]
+		}
+	}
+
+	# Pesky MouseWheel
+	$T notify bind $T.text <Scroll> {
+		TreeCtrl::TextClose %T 0
+		focus $TreeCtrl::Priv(text,%T,focus)
+	}
+
+	$T.text tag configure TAG -justify $justify
+	$T.text configure -font $font -background [$T cget -background]
+	$T.text insert end $text
+	$T.text tag add sel 1.0 end
+	$T.text tag add TAG 1.0 end
+
+	set Priv(text,$T,font) $font
+	set Priv(text,$T,justify) $justify
+	set Priv(text,$T,width) $width
+
+	scan [textlayout $font $text -justify $justify -width $width] "%d %d" width height
+
+	set tbw [$T.text cget -borderwidth]
+	set tx [expr {$x1 - $tbw - 1}]
+	place $T.text -x $tx -y [expr {$y1 - $tbw - 1}] \
+		-width [expr {$width + ($tbw + 1) * 2}] \
+		-height [expr {$height + ($tbw + 1) * 2}] \
+		-bordermode outside
+
+	focus $T.text
+
+	return
+}
+
+proc ::TreeCtrl::TextClose {T accept} {
+
+	variable Priv
+
+	place forget $T.text
+	update
+
+	if {$accept} {
+		$T notify generate <Edit-accept> -T $T -I $Priv(text,$T,item) \
+			-C $Priv(text,$T,column) -E $Priv(text,$T,element) \
+			-t [$T.text get 1.0 end-1c]
+	}
+
+	$T notify bind $T.text <Scroll> {}
+
+	return
+}
+
+proc ::TreeCtrl::TextExpanderKeypress {T} {
+
+	variable Priv
+
+	set font $Priv(text,$T,font)
+	set justify $Priv(text,$T,justify)
+	set width $Priv(text,$T,width)
+	set center $Priv(text,$T,center)
+
+	set text [$T.text get 1.0 end-1c]
+
+	scan [textlayout $font $text -justify $justify -width $width] "%d %d" width height
+
+	set tbw [$T.text cget -borderwidth]
+	place configure $T.text \
+		-x [expr {$center - $width / 2 - $tbw - 1}] \
+		-width [expr {$width + ($tbw + 1) * 2}] \
+		-height [expr {$height + ($tbw + 1) * 2}]
+
+	$T.text tag add TAG 1.0 end
+
+	return
+}
+
diff --git a/library/treectrl.tcl b/library/treectrl.tcl
new file mode 100644
index 0000000..c973410
--- /dev/null
+++ b/library/treectrl.tcl
@@ -0,0 +1,825 @@
+bind TreeCtrl <Motion> {
+    TreeCtrl::CursorCheck %W %x %y
+}
+bind TreeCtrl <Leave> {
+    TreeCtrl::CursorCancel %W
+}
+
+bind TreeCtrl <ButtonPress-1> {
+	TreeCtrl::ButtonPress1 %W %x %y
+}
+
+bind TreeCtrl <Double-ButtonPress-1> {
+	TreeCtrl::DoubleButton1 %W %x %y
+}
+
+bind TreeCtrl <Button1-Motion> {
+    TreeCtrl::Motion1 %W %x %y
+}
+bind TreeCtrl <ButtonRelease-1> {
+    TreeCtrl::Release1 %W %x %y
+}
+bind TreeCtrl <Shift-ButtonPress-1> {
+	set TreeCtrl::Priv(buttonMode) normal
+    TreeCtrl::BeginExtend %W [%W index {nearest %x %y}]
+}
+bind TreeCtrl <Control-ButtonPress-1> {
+	set TreeCtrl::Priv(buttonMode) normal
+    TreeCtrl::BeginToggle %W [%W index {nearest %x %y}]
+}
+bind TreeCtrl <Button1-Leave> {
+	TreeCtrl::Leave1 %W %x %y
+}
+bind TreeCtrl <Button1-Enter> {}
+
+bind TreeCtrl <KeyPress-Up> {
+    TreeCtrl::SetActiveItem %W [TreeCtrl::UpDown %W -1]
+}
+bind TreeCtrl <Shift-KeyPress-Up> {
+    TreeCtrl::ExtendUpDown %W above
+}
+bind TreeCtrl <KeyPress-Down> {
+    TreeCtrl::SetActiveItem %W [TreeCtrl::UpDown %W 1]
+}
+bind TreeCtrl <Shift-KeyPress-Down> {
+    TreeCtrl::ExtendUpDown %W below
+}
+bind TreeCtrl <KeyPress-Left> {
+    TreeCtrl::SetActiveItem %W [TreeCtrl::LeftRight %W -1]
+}
+bind TreeCtrl <Shift-KeyPress-Left> {
+    TreeCtrl::ExtendUpDown %W left
+}
+bind TreeCtrl <Control-KeyPress-Left> {
+    %W xview scroll -1 pages
+}
+bind TreeCtrl <KeyPress-Right> {
+    TreeCtrl::SetActiveItem %W [TreeCtrl::LeftRight %W 1]
+}
+bind TreeCtrl <Shift-KeyPress-Right> {
+    TreeCtrl::ExtendUpDown %W right
+}
+bind TreeCtrl <Control-KeyPress-Right> {
+    %W xview scroll 1 pages
+}
+bind TreeCtrl <KeyPress-Prior> {
+    %W yview scroll -1 pages
+    %W activate {nearest 0 0}
+}
+bind TreeCtrl <KeyPress-Next> {
+    %W yview scroll 1 pages
+    %W activate {nearest 0 0}
+}
+bind TreeCtrl <Control-KeyPress-Prior> {
+    %W xview scroll -1 pages
+}
+bind TreeCtrl <Control-KeyPress-Next> {
+    %W xview scroll 1 pages
+}
+bind TreeCtrl <KeyPress-Home> {
+    %W xview moveto 0
+}
+bind TreeCtrl <KeyPress-End> {
+    %W xview moveto 1
+}
+bind TreeCtrl <Control-KeyPress-Home> {
+    %W activate {first visible}
+    %W see active
+    %W selection modify active all
+}
+bind TreeCtrl <Shift-Control-KeyPress-Home> {
+    TreeCtrl::DataExtend %W 0
+}
+bind TreeCtrl <Control-KeyPress-End> {
+    %W activate {last visible}
+    %W see active
+    %W selection modify active all
+}
+bind TreeCtrl <Shift-Control-KeyPress-End> {
+    TreeCtrl::DataExtend %W [%W index {last visible}]
+}
+bind TreeCtrl <<Copy>> {
+    if {[string equal [selection own -displayof %W] "%W"]} {
+	clipboard clear -displayof %W
+	clipboard append -displayof %W [selection get -displayof %W]
+    }
+}
+bind TreeCtrl <KeyPress-space> {
+    TreeCtrl::BeginSelect %W [%W index active]
+}
+bind TreeCtrl <KeyPress-Select> {
+    TreeCtrl::BeginSelect %W [%W index active]
+}
+bind TreeCtrl <Control-Shift-KeyPress-space> {
+    TreeCtrl::BeginExtend %W [%W index active]
+}
+bind TreeCtrl <Shift-KeyPress-Select> {
+    TreeCtrl::BeginExtend %W [%W index active]
+}
+bind TreeCtrl <KeyPress-Escape> {
+    TreeCtrl::Cancel %W
+}
+bind TreeCtrl <Control-KeyPress-slash> {
+    TreeCtrl::SelectAll %W
+}
+bind TreeCtrl <Control-KeyPress-backslash> {
+    if {[string compare [%W cget -selectmode] "browse"]} {
+	%W selection clear
+    }
+}
+
+bind TreeCtrl <KeyPress-plus> {
+	%W expand [%W index active]
+}
+bind TreeCtrl <KeyPress-minus> {
+	%W collapse [%W index active]
+}
+bind TreeCtrl <KeyPress-Return> {
+	%W toggle [%W index active]
+}
+
+
+# Additional Tk bindings that aren't part of the Motif look and feel:
+
+bind TreeCtrl <KeyPress-2> {
+    %W scan mark %x %y
+}
+bind TreeCtrl <Button2-Motion> {
+    %W scan dragto %x %y
+}
+
+# The MouseWheel will typically only fire on Windows.  However,
+# someone could use the "event generate" command to produce one
+# on other platforms.
+
+bind TreeCtrl <MouseWheel> {
+    %W yview scroll [expr {- (%D / 120) * 4}] units
+}
+
+if {[string equal "unix" $tcl_platform(platform)]} {
+    # Support for mousewheels on Linux/Unix commonly comes through mapping
+    # the wheel to the extended buttons.  If you have a mousewheel, find
+    # Linux configuration info at:
+    #	http://www.inria.fr/koala/colas/mouse-wheel-scroll/
+    bind TreeCtrl <4> {
+	if {!$tk_strictMotif} {
+	    %W yview scroll -5 units
+	}
+    }
+    bind TreeCtrl <5> {
+	if {!$tk_strictMotif} {
+	    %W yview scroll 5 units
+	}
+    }
+}
+
+namespace eval ::TreeCtrl {
+	variable Priv
+	array set Priv {
+		prev {}
+		rnc {}
+	}
+}
+
+proc ::TreeCtrl::CursorCheck {w x y} {
+	variable Priv
+	set id [$w identify $x $y]
+	if {([llength $id] == 3) && ([lindex $id 0] eq "header")} {
+		set column [lindex $id 1]
+		set side [lindex $id 2]
+		set visCount 0
+		for {set i 0} {$i < [$w numcolumns]} {incr i} {
+			if {[$w column cget $i -visible]} {
+				lappend visColumns $i
+				if {$i eq $column} {
+					set columnIndex $visCount
+				}
+				incr visCount
+			}
+		}
+		lappend visColumns tail
+		if {$column eq "tail"} {
+			set columnIndex $visCount
+		}
+		if {$side eq "left"} {
+			if {$column eq [lindex $visColumns 0]} {
+				return
+			}
+			set column [lindex $visColumns [expr {$columnIndex - 1}]]
+		}
+		if {![info exists Priv(cursor,$w)]} {
+			set Priv(cursor,$w) [$w cget -cursor]
+			$w configure -cursor sb_h_double_arrow
+			if {[info exists Priv(cursor,afterId,$w)]} {
+				after cancel $Priv(cursor,afterId,$w)
+			}
+			set Priv(cursor,afterId,$w) [after 150 [list TreeCtrl::CursorCheckAux $w]]
+		}
+		return
+	}
+	CursorCancel $w
+	return
+}
+
+proc ::TreeCtrl::CursorCheckAux {w} {
+	variable Priv
+	set x [winfo pointerx $w]
+	set y [winfo pointery $w]
+	if {[info exists Priv(cursor,$w)]} {
+		set x [expr {$x - [winfo rootx $w]}]
+		set y [expr {$y - [winfo rooty $w]}]
+		CursorCheck $w $x $y
+	}
+	return
+}
+
+proc ::TreeCtrl::CursorCancel {w} {
+	variable Priv
+	if {[info exists Priv(cursor,$w)]} {
+		$w configure -cursor $Priv(cursor,$w)
+		unset Priv(cursor,$w)
+	}
+	if {[info exists Priv(cursor,afterId,$w)]} {
+		after cancel $Priv(cursor,afterId,$w)
+		unset Priv(cursor,afterId,$w)
+	}
+	return
+}
+
+proc ::TreeCtrl::ButtonPress1 {w x y} {
+	variable Priv
+	focus $w
+	set id [$w identify $x $y]
+	if {$id eq ""} {
+		return
+	}
+	if {[lindex $id 0] eq "item"} {
+		foreach {where item arg1 arg2} $id {}
+		if {$arg1 eq "button"} {
+			$w toggle $item
+			return
+		} elseif {$arg1 eq "line"} {
+			$w toggle $arg2
+			return
+		}
+	}
+	set Priv(buttonMode) ""
+	if {[lindex $id 0] eq "header"} {
+		set column [lindex $id 1]
+		set visCount 0
+		for {set i 0} {$i < [$w numcolumns]} {incr i} {
+			if {[$w column cget $i -visible]} {
+				lappend visColumns $i
+				if {$i eq $column} {
+					set columnIndex $visCount
+				}
+				incr visCount
+			}
+		}
+		lappend visColumns tail
+		if {$column eq "tail"} {
+			set columnIndex $visCount
+		}
+		if {[llength $id] == 3} {
+			set side [lindex $id 2]
+			if {$side == "left"} {
+				if {$column eq [lindex $visColumns 0]} {
+					return
+				}
+				set column [lindex $visColumns [expr {$columnIndex - 1}]]
+			}
+			set Priv(buttonMode) resize
+			set Priv(column) $column
+			set Priv(x) $x
+			set Priv(y) $y
+			set Priv(width) [$w column width $column]
+			return
+		}
+		if {$column eq "tail"} return
+		if {![$w column cget $column -button]} return
+		set Priv(buttonMode) header
+		set Priv(column) $column
+		$w column configure $column -sunken yes
+		return
+	}
+	set Priv(buttonMode) normal
+	BeginSelect $w [lindex $id 1]
+	return
+}
+
+# Double-click between columns to set default column width
+proc ::TreeCtrl::DoubleButton1 {w x y} {
+	set id [$w identify $x $y]
+	if {$id eq ""} {
+		return
+	}
+	if {[lindex $id 0] eq "header"} {
+		set column [lindex $id 1]
+		set visCount 0
+		for {set i 0} {$i < [$w numcolumns]} {incr i} {
+			if {[$w column cget $i -visible]} {
+				lappend visColumns $i
+				if {$i eq $column} {
+					set columnIndex $visCount
+				}
+				incr visCount
+			}
+		}
+		lappend visColumns tail
+		if {$column eq "tail"} {
+			set columnIndex $visCount
+		}
+		if {[llength $id] == 3} {
+			set side [lindex $id 2]
+			if {$side == "left"} {
+				if {$column eq [lindex $visColumns 0]} {
+					return
+				}
+				set column [lindex $visColumns [expr {$columnIndex - 1}]]
+			}
+			if {$column eq "tail"} return
+			$w column configure $column -width ""
+		}
+	}
+	return
+}
+
+proc ::TreeCtrl::Motion1 {w x y} {
+	variable Priv
+	if {![info exists Priv(buttonMode)]} return
+	switch $Priv(buttonMode) {
+		header {
+			set id [$w identify $x $y]
+			if {![string match "header $Priv(column)*" $id]} {
+				if {[$w column cget $Priv(column) -sunken]} {
+					$w column configure $Priv(column) -sunken no
+				}
+			} else {
+				if {![$w column cget $Priv(column) -sunken]} {
+					$w column configure $Priv(column) -sunken yes
+				}
+			}
+		}
+		normal {
+			set Priv(x) $x
+			set Priv(y) $y
+			Motion $w [$w index [list nearest $x $y]]
+			AutoScanCheck $w $x $y
+		}
+		resize {
+			set width [expr {$Priv(width) + $x - $Priv(x)}]
+			set minWidth [$w column cget $Priv(column) -minwidth]
+			if {$minWidth eq ""} {
+				set minWidth 0
+			}
+			if {$width < $minWidth} {
+				set width $minWidth
+			}
+			if {$width == 0} {
+				incr width
+			}
+			scan [$w column bbox $Priv(column)] "%d %d %d %d" x1 y1 x2 y2
+			# Use "ne" because -columnproxy could be ""
+			if {($x1 + $width - 1) ne [$w cget -columnproxy]} {
+				$w configure -columnproxy [expr {$x1 + $width - 1}]
+			}
+		}
+	}
+	return
+}
+
+proc ::TreeCtrl::Leave1 {w x y} {
+	variable Priv
+	if {![info exists Priv(buttonMode)]} return
+	switch $Priv(buttonMode) {
+		header {
+			if {[$w column cget $Priv(column) -sunken]} {
+				$w column configure $Priv(column) -sunken no
+			}
+		}
+		normal {
+		}
+		resize {}
+	}
+	return
+}
+
+proc ::TreeCtrl::Release1 {w x y} {
+	variable Priv
+	if {![info exists Priv(buttonMode)]} return
+	switch $Priv(buttonMode) {
+		header {
+			if {[$w column cget $Priv(column) -sunken]} {
+				$w column configure $Priv(column) -sunken no
+				$w notify generate <Header-invoke> -T $w -C $Priv(column)
+			}
+		}
+		normal {
+			AutoScanCancel $w
+			$w activate [$w index [list nearest $x $y]]
+		}
+		resize {
+			if {[$w cget -columnproxy] ne ""} {
+				scan [$w column bbox $Priv(column)] "%d %d %d %d" x1 y1 x2 y2
+				set width [expr {[$w cget -columnproxy] - $x1 + 1}]
+				$w configure -columnproxy {}
+				$w column configure $Priv(column) -width $width
+				CursorCheck $w $x $y
+			}
+		}
+	}
+	unset Priv(buttonMode)
+	return
+}
+
+# ::TreeCtrl::BeginSelect --
+#
+# This procedure is typically invoked on button-1 presses.  It begins
+# the process of making a selection in the listbox.  Its exact behavior
+# depends on the selection mode currently in effect for the listbox;
+# see the Motif documentation for details.
+#
+# Arguments:
+# w -		The listbox widget.
+# el -		The element for the selection operation (typically the
+#		one under the pointer).  Must be in numerical form.
+
+proc ::TreeCtrl::BeginSelect {w el} {
+    variable Priv
+    if {$el eq ""} return
+    if {[string equal [$w cget -selectmode] "multiple"]} {
+	if {[$w selection includes $el]} {
+	    $w selection clear $el
+	} else {
+	    $w selection add $el
+	}
+    } else {
+	$w selection anchor $el
+	$w selection modify $el all
+	set Priv(selection) {}
+	set Priv(prev) $el
+    }
+}
+
+# ::TreeCtrl::Motion --
+#
+# This procedure is called to process mouse motion events while
+# button 1 is down.  It may move or extend the selection, depending
+# on the listbox's selection mode.
+#
+# Arguments:
+# w -		The listbox widget.
+# el -		The element under the pointer (must be a number).
+
+proc ::TreeCtrl::Motion {w el} {
+    variable Priv
+    if {$el eq $Priv(prev)} {
+	return
+    }
+    switch [$w cget -selectmode] {
+	browse {
+	    $w selection modify $el all
+	    set Priv(prev) $el
+	}
+	extended {
+	    set i $Priv(prev)
+	    if {$i eq ""} {
+		set i $el
+		$w selection add $el
+	    }
+	    if {[$w selection includes anchor]} {
+		$w selection clear $i $el
+		$w selection add anchor $el
+	    } else {
+		$w selection clear $i $el
+		$w selection clear anchor $el
+	    }
+	    if {![info exists Priv(selection)]} {
+		set Priv(selection) [$w selection get]
+	    }
+	    while {[$w compare $i < $el] && [$w compare $i < anchor]} {
+		if {[lsearch $Priv(selection) $i] >= 0} {
+		    $w selection add $i
+		}
+		set i [$w index "$i next visible"]
+	    }
+	    while {[$w compare $i > $el] && [$w compare $i > anchor]} {
+		if {[lsearch $Priv(selection) $i] >= 0} {
+		    $w selection add $i
+		}
+		set i [$w index "$i prev visible"]
+	    }
+	    set Priv(prev) $el
+	}
+    }
+}
+
+# ::TreeCtrl::BeginExtend --
+#
+# This procedure is typically invoked on shift-button-1 presses.  It
+# begins the process of extending a selection in the listbox.  Its
+# exact behavior depends on the selection mode currently in effect
+# for the listbox;  see the Motif documentation for details.
+#
+# Arguments:
+# w -		The listbox widget.
+# el -		The element for the selection operation (typically the
+#		one under the pointer).  Must be in numerical form.
+
+proc ::TreeCtrl::BeginExtend {w el} {
+    if {[string equal [$w cget -selectmode] "extended"]} {
+	if {[$w selection includes anchor]} {
+	    Motion $w $el
+	} else {
+	    # No selection yet; simulate the begin-select operation.
+	    BeginSelect $w $el
+	}
+    }
+}
+
+# ::TreeCtrl::BeginToggle --
+#
+# This procedure is typically invoked on control-button-1 presses.  It
+# begins the process of toggling a selection in the listbox.  Its
+# exact behavior depends on the selection mode currently in effect
+# for the listbox;  see the Motif documentation for details.
+#
+# Arguments:
+# w -		The listbox widget.
+# el -		The element for the selection operation (typically the
+#		one under the pointer).  Must be in numerical form.
+
+proc ::TreeCtrl::BeginToggle {w el} {
+    variable Priv
+    if {[string equal [$w cget -selectmode] "extended"]} {
+	set Priv(selection) [$w selection get]
+	set Priv(prev) $el
+	$w selection anchor $el
+	if {[$w selection includes $el]} {
+	    $w selection clear $el
+	} else {
+	    $w selection add $el
+	}
+    }
+}
+
+proc ::TreeCtrl::CancelRepeat {} {
+	variable Priv
+	if {[info exists Priv(afterId)]} {
+		after cancel $Priv(afterId)
+		unset Priv(afterId)
+	}
+}
+
+proc ::TreeCtrl::AutoScanCheck {w x y} {
+	variable Priv
+	scan [$w contentbox] "%d %d %d %d" x1 y1 x2 y2
+	set margin [winfo pixels $w [$w cget -scrollmargin]]
+	if {($x < $x1 + $margin) || ($x >= $x2 - $margin) ||
+		($y < $y1 + $margin) || ($y >= $y2 - $margin)} {
+		if {![info exists Priv(autoscan,afterId,$w)]} {
+			if {$y >= $y2 - $margin} {
+				$w yview scroll 1 units
+				set delay [$w cget -yscrolldelay]
+			} elseif {$y < $y1 + $margin} {
+				$w yview scroll -1 units
+				set delay [$w cget -yscrolldelay]
+			} elseif {$x >= $x2 - $margin} {
+				$w xview scroll 1 units
+				set delay [$w cget -xscrolldelay]
+			} elseif {$x < $x1 + $margin} {
+				$w xview scroll -1 units
+				set delay [$w cget -xscrolldelay]
+			}
+			set count [scan $delay "%d %d" d1 d2]
+			if {[info exists Priv(autoscan,scanning,$w)]} {
+				if {$count == 2} {
+					set delay $d2
+				}
+			} else {
+				if {$count == 2} {
+					set delay $d1
+				}
+				set Priv(autoscan,scanning,$w) 1
+			}
+			Motion $w [$w index "nearest $x $y"]
+			set Priv(autoscan,afterId,$w) [after $delay [list TreeCtrl::AutoScanCheckAux $w]]
+		}
+		return
+	}
+	AutoScanCancel $w
+	return
+}
+
+proc ::TreeCtrl::AutoScanCheckAux {w} {
+	variable Priv
+	unset Priv(autoscan,afterId,$w)
+	set x [winfo pointerx $w]
+	set y [winfo pointery $w]
+	set x [expr {$x - [winfo rootx $w]}]
+	set y [expr {$y - [winfo rooty $w]}]
+	AutoScanCheck $w $x $y
+	return
+}
+
+proc ::TreeCtrl::AutoScanCancel {w} {
+	variable Priv
+	if {[info exists Priv(autoscan,afterId,$w)]} {
+		after cancel $Priv(autoscan,afterId,$w)
+		unset Priv(autoscan,afterId,$w)
+	}
+	unset -nocomplain Priv(autoscan,scanning,$w)
+	return
+}
+
+# ::TreeCtrl::UpDown --
+#
+# Moves the location cursor (active element) up or down by one element,
+# and changes the selection if we're in browse or extended selection
+# mode.
+#
+# Arguments:
+# w -		The listbox widget.
+# amount -	+1 to move down one item, -1 to move back one item.
+
+proc ::TreeCtrl::UpDown {w n} {
+    variable Priv
+    set rnc [$w item rnc active]
+    # active item isn't visible
+    if {$rnc eq ""} {
+    	set rnc [$w item rnc first]
+    	if {$rnc eq ""} return
+    }
+    scan $rnc "%d %d" row col
+   	set Priv(row) [expr {$row + $n}]
+    if {$rnc ne $Priv(rnc)} {
+   	set Priv(col) $col
+    }
+    set index [$w index "rnc $Priv(row) $Priv(col)"]
+    if {[$w compare active == $index]} {
+    	set Priv(row) $row
+    } else {
+	    set Priv(rnc) [$w item rnc $index]
+	}
+    return $index
+}
+
+proc ::TreeCtrl::LeftRight {w n} {
+    variable Priv
+    set rnc [$w item rnc active]
+    if {$rnc eq ""} {
+    	set rnc [$w item rnc first]
+    	if {$rnc eq ""} return
+    }
+    scan $rnc "%d %d" row col
+    set Priv(col) [expr {$col + $n}]
+    if {$rnc ne $Priv(rnc)} {
+    	set Priv(row) $row
+    }
+    set index [$w index "rnc $Priv(row) $Priv(col)"]
+    if {[$w compare active == $index]} {
+    	set Priv(col) $col
+    } else {
+	    set Priv(rnc) [$w item rnc $index]
+	}
+    return $index
+}
+
+proc ::TreeCtrl::SetActiveItem {w index} {
+	if {$index eq ""} return
+    $w activate $index
+    $w see active
+    $w selection modify active all
+    switch [$w cget -selectmode] {
+	extended {
+	    $w selection anchor active
+	    set Priv(prev) [$w index active]
+	    set Priv(selection) {}
+	}
+    }
+}
+
+# ::TreeCtrl::ExtendUpDown --
+#
+# Does nothing unless we're in extended selection mode;  in this
+# case it moves the location cursor (active element) up or down by
+# one element, and extends the selection to that point.
+#
+# Arguments:
+# w -		The listbox widget.
+# amount -	+1 to move down one item, -1 to move back one item.
+
+proc ::TreeCtrl::ExtendUpDown {w amount} {
+    variable Priv
+    if {[string compare [$w cget -selectmode] "extended"]} {
+	return
+    }
+    set active [$w index active]
+    if {![info exists Priv(selection)]} {
+	$w selection add $active
+	set Priv(selection) [$w selection get]
+    }
+    set index [$w index "active $amount"]
+    if {$index eq ""} return
+    $w activate $index
+    $w see active
+    Motion $w [$w index active]
+}
+
+# ::TreeCtrl::DataExtend
+#
+# This procedure is called for key-presses such as Shift-KEndData.
+# If the selection mode isn't multiple or extend then it does nothing.
+# Otherwise it moves the active element to el and, if we're in
+# extended mode, extends the selection to that point.
+#
+# Arguments:
+# w -		The listbox widget.
+# el -		An integer element number.
+
+proc ::TreeCtrl::DataExtend {w el} {
+    set mode [$w cget -selectmode]
+    if {[string equal $mode "extended"]} {
+	$w activate $el
+	$w see $el
+        if {[$w selection includes anchor]} {
+	    Motion $w $el
+	}
+    } elseif {[string equal $mode "multiple"]} {
+	$w activate $el
+	$w see $el
+    }
+}
+
+# ::TreeCtrl::Cancel
+#
+# This procedure is invoked to cancel an extended selection in
+# progress.  If there is an extended selection in progress, it
+# restores all of the items between the active one and the anchor
+# to their previous selection state.
+#
+# Arguments:
+# w -		The listbox widget.
+
+proc ::TreeCtrl::Cancel w {
+    variable Priv
+    if {[string compare [$w cget -selectmode] "extended"]} {
+	return
+    }
+    set first [$w index anchor]
+    set last $Priv(prev)
+    if { [string equal $last ""] } {
+	# Not actually doing any selection right now
+	return
+    }
+    if {[$w compare $first > $last]} {
+	set tmp $first
+	set first $last
+	set last $tmp
+    }
+    $w selection clear $first $last
+    while {[$w compare $first <= $last]} {
+	if {[lsearch $Priv(selection) $first] >= 0} {
+	    $w selection add $first
+	}
+	set first [$w index "$first next visible"]
+    }
+}
+
+# ::TreeCtrl::SelectAll
+#
+# This procedure is invoked to handle the "select all" operation.
+# For single and browse mode, it just selects the active element.
+# Otherwise it selects everything in the widget.
+#
+# Arguments:
+# w -		The listbox widget.
+
+proc ::TreeCtrl::SelectAll w {
+    set mode [$w cget -selectmode]
+    if {[string equal $mode "single"] || [string equal $mode "browse"]} {
+	$w selection modify active all
+    } else {
+	$w selection add all
+    }
+}
+
+proc ::TreeCtrl::MarqueeBegin {w x y} {
+	set x [$w canvasx $x]
+	set y [$w canvasy $y]
+	$w marquee coords $x $y $x $y
+	$w marquee visible yes
+	return
+}
+
+proc ::TreeCtrl::MarqueeUpdate {w x y} {
+	set x [$w canvasx $x]
+	set y [$w canvasy $y]
+	$w marquee corner $x $y
+	return
+}
+proc ::TreeCtrl::MarqueeEnd {w x y} {
+	$w marquee visible no
+	return
+}
+