Initial revision

1 files changed, 935 insertions, 0 deletions

diff --git a/demo.tcl b/demo.tcl
new file mode 100644
index 0000000..d9c0f77
--- /dev/null
+++ b/demo.tcl
@@ -0,0 +1,935 @@
+#! D:/Programming/Tcl-8.4.1/bin/wish84.exe
+
+# Get full pathname to this file
+set ScriptDir [file normalize [file dirname [info script]]]
+
+# Command to create a full pathname in this file's directory
+proc Path {args} {
+	return [eval file join [list $::ScriptDir] $args]
+}
+
+# Create some photo images on demand
+proc InitPics {args} {
+	foreach pattern $args {
+		if {[lsearch [image names] $pattern] == -1} {
+			foreach file [glob -directory [Path pics] $pattern.gif] {
+				set imageName [file root [file tail $file]]
+				# I created an image called "file", which clobbered the
+				# original Tcl command "file". Then I got confused.
+				if {[llength [info commands $imageName]]} {
+					error "don't want to create image called \"$imageName\""
+				}
+				image create photo $imageName -file $file
+
+				# Hack -- Create a "selected" version too
+				image create photo ${imageName}Sel
+				${imageName}Sel copy $imageName
+				imagetint ${imageName}Sel $::SystemHighlight 128
+			}
+		}
+	}
+	return
+}
+
+if {[catch {
+	package require dbwin 1.0
+}]} {
+	proc dbwin s {puts -nonewline $s}
+}
+if {[file exists libtreectrl1.0[info sharedlibextension]} {
+	load libtreectrl1.0[info sharedlibextension]
+} else {
+	load Build/treectrl[info sharedlibextension]
+}
+
+# Default TreeCtrl bindings
+source [Path library treectrl.tcl]
+
+# Other useful bindings
+source [Path library filelist-bindings.tcl]
+
+# Demo sources
+foreach file [glob -directory [Path demos] *.tcl] {
+	source $file
+}
+
+# Get default colors
+set w [listbox .listbox]
+set SystemButtonFace [$w cget -highlightbackground]
+set SystemHighlight [$w cget -selectbackground]
+set SystemHighlightText [$w cget -selectforeground]
+destroy $w
+
+proc MakeMenuBar {} {
+	set m [menu .menubar]
+	. configure -menu $m
+	set m2 [menu $m.mFile -tearoff no]
+	if {$::tcl_platform(platform) ne "unix"} {
+		console eval {.console conf -height 8}
+		$m2 add command -label "Console" -command {
+			if {[console eval {winfo ismapped .}]} {
+				console hide
+			} else {
+				console show
+			}
+		}
+	}
+	$m2 add command -label "View Source" -command ToggleSourceWindow
+	$m2 add command -label Quit -command exit
+	$m add cascade -label File -menu $m2
+	return
+}
+
+proc MakeSourceWindow {} {
+	set w [toplevel .source]
+	set f [frame $w.f -borderwidth 0]
+	if {$::tcl_platform(platform) eq "unix"} {
+		set font {Courier 16}
+	} else {
+		set font {Courier 9}
+	}
+	text $f.t -font $font -tabs [font measure $font 1234] -wrap none \
+		-yscrollcommand "$f.sv set" -xscrollcommand "$f.sh set"
+	scrollbar $f.sv -orient vertical -command "$f.t yview"
+	scrollbar $f.sh -orient horizontal -command "$f.t xview"
+	pack $f -expand yes -fill both
+	grid columnconfigure $f 0 -weight 1
+	grid rowconfigure $f 0 -weight 1
+	grid configure $f.t -row 0 -column 0 -sticky news
+	grid configure $f.sh -row 1 -column 0 -sticky we
+	grid configure $f.sv -row 0 -column 1 -sticky ns
+
+	wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
+	wm geom $w -0+0
+	wm withdraw $w
+
+	return
+}
+proc ShowSource {file} {
+	wm title .source "Demo Source: $file"
+	set path [Path demos $file]
+	set t .source.f.t
+	set chan [open $path]
+	$t delete 1.0 end
+	$t insert end [read $chan]
+	$t mark set insert 1.0
+	close $chan
+	return
+}
+proc ToggleSourceWindow {} {
+	set w .source
+	if {[winfo ismapped $w]} {
+		wm withdraw $w
+	} else {
+		wm deiconify $w
+	}
+	return
+}
+
+MakeSourceWindow
+MakeMenuBar
+
+proc TreePlusScrollbarsInAFrame {f h v} {
+	frame $f -borderwidth 1 -relief sunken
+	if {$::tcl_platform(platform) eq "unix"} {
+		set font {Helvetica 16}
+	} else {
+		# There is a bug on my Win98 box with Tk_MeasureChars() and
+		# MS Sans Serif 8.
+		set font {{MS Sans} 8}
+	}
+	treectrl $f.t -highlightthickness 0 -borderwidth 0 -font $font
+	$f.t configure -xscrollincrement 20
+	$f.t debug configure -enable no -display no
+	if {$h} {
+		scrollbar $f.sh -orient horizontal -command "$f.t xview"
+#		$f.t configure -xscrollcommand "$f.sh set"
+		$f.t notify bind $f.sh <Scroll-x> { %W set %l %u }
+		bind $f.sh <ButtonPress-1> "focus $f.t"
+	}
+	if {$v} {
+		scrollbar $f.sv -orient vertical -command "$f.t yview"
+#		$f.t configure -yscrollcommand "$f.sv set"
+		$f.t notify bind $f.sv <Scroll-y> { %W set %l %u }
+		bind $f.sv <ButtonPress-1> "focus $f.t"
+	}
+	grid columnconfigure $f 0 -weight 1
+	grid rowconfigure $f 0 -weight 1
+	grid configure $f.t -row 0 -column 0 -sticky news
+	if {$h} {
+		grid configure $f.sh -row 1 -column 0 -sticky we
+	}
+	if {$v} {
+		grid configure $f.sv -row 0 -column 1 -sticky ns
+	}
+	return
+}
+
+proc MakeMainWindow {} {
+
+	wm title . "TkTreeCtrl Demo"
+	wm geometry . +0+0
+
+	panedwindow .pw2 -orient horizontal -borderwidth 0
+	panedwindow .pw1 -orient vertical -borderwidth 0
+
+	# Tree + scrollbar: demos
+	TreePlusScrollbarsInAFrame .f1 0 1
+	.f1.t configure -showbuttons no -showlines no -showroot no -height 100
+	.f1.t column configure 0 -text "List of Demos" -expand yes -button no
+
+	# Tree + scrollbar: styles + elements in list
+	TreePlusScrollbarsInAFrame .f4 0 1
+	.f4.t configure -showroot no -height 140
+	.f4.t column configure 0 -text "Elements and Styles" -expand yes -button no
+
+	# Tree + scrollbar: styles + elements in selected item
+	TreePlusScrollbarsInAFrame .f3 0 1
+	.f3.t configure -showroot no
+	.f3.t column configure 0 -text "Styles in Item" -expand yes -button no
+
+	.pw1 add .f1 .f4 .f3 -height 150
+
+	# Frame on right
+	frame .f2
+
+	# Tree + scrollbars
+	TreePlusScrollbarsInAFrame .f2.f1 1 1
+	.f2.f1.t configure -indent 19
+	.f2.f1.t debug configure -enable no -display yes -erasecolor pink -displaydelay 30
+
+	# Give it a big border to debug drawing
+	.f2.f1.t configure -borderwidth 6 -relief ridge -highlightthickness 3
+
+	grid columnconfigure .f2 0 -weight 1
+	grid rowconfigure .f2 0 -weight 1
+	grid configure .f2.f1 -row 0 -column 0 -sticky news -pady 0
+
+	.pw2 add .pw1 -width 200
+	.pw2 add .f2 -width 450
+
+	pack .pw2 -expand yes -fill both
+
+	###
+	.f2.f1.t notify install event Header
+	.f2.f1.t notify install detail Header invoke
+
+	.f2.f1.t notify install event Drag
+	.f2.f1.t notify install detail Drag begin
+	.f2.f1.t notify install detail Drag end
+	.f2.f1.t notify install detail Drag receive
+
+	.f2.f1.t notify install event Edit
+	.f2.f1.t notify install detail Edit accept
+	###
+
+	return
+}
+
+proc MakeListPopup {} {
+	set m [menu .f2.f1.t.mTree -tearoff no]
+
+	set m2 [menu $m.mCollapse -tearoff no]
+	$m add cascade -label Collapse -menu $m2
+
+	set m2 [menu $m.mExpand -tearoff no]
+	$m add cascade -label Expand -menu $m2
+
+	set m2 [menu $m.mDebug -tearoff no]
+	$m2 add checkbutton -label Data -variable Popup(debug,data) \
+		-command {.f2.f1.t debug configure -data $Popup(debug,data)}
+	$m2 add checkbutton -label Display -variable Popup(debug,display) \
+		-command {.f2.f1.t debug configure -display $Popup(debug,display)}
+	$m2 add checkbutton -label Enable -variable Popup(debug,enable) \
+		-command {.f2.f1.t debug configure -enable $Popup(debug,enable)}
+	$m add cascade -label Debug -menu $m2
+
+	set m2 [menu $m.mBuffer -tearoff no]
+	$m2 add radiobutton -label "none" -variable Popup(doublebuffer) -value none \
+		-command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
+	$m2 add radiobutton -label "item" -variable Popup(doublebuffer) -value item \
+		-command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
+	$m2 add radiobutton -label "window" -variable Popup(doublebuffer) -value window \
+		-command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)}
+	$m add cascade -label Buffering -menu $m2
+
+	set m2 [menu $m.mLineStyle -tearoff no]
+	$m2 add radiobutton -label "dot" -variable Popup(linestyle) -value dot \
+		-command {.f2.f1.t configure -linestyle $Popup(linestyle)}
+	$m2 add radiobutton -label "solid" -variable Popup(linestyle) -value solid \
+		-command {.f2.f1.t configure -linestyle $Popup(linestyle)}
+	$m add cascade -label "Line style" -menu $m2
+
+	set m2 [menu $m.mOrient -tearoff no]
+	$m2 add radiobutton -label "Horizontal" -variable Popup(orient) -value horizontal \
+		-command {.f2.f1.t configure -orient $Popup(orient)}
+	$m2 add radiobutton -label "Vertical" -variable Popup(orient) -value vertical \
+		-command {.f2.f1.t configure -orient $Popup(orient)}
+	$m add cascade -label Orient -menu $m2
+
+	set m2 [menu $m.mSelectMode -tearoff no]
+	foreach mode [list browse extended multiple single] {
+		$m2 add radiobutton -label $mode -variable Popup(selectmode) -value $mode \
+			-command {.f2.f1.t configure -selectmode $Popup(selectmode)}
+	}
+	$m add cascade -label Selectmode -menu $m2
+
+	set m2 [menu $m.mShow -tearoff no]
+	$m2 add checkbutton -label "Buttons" -variable Popup(showbuttons) \
+		-command {.f2.f1.t configure -showbuttons $Popup(showbuttons)}
+	$m2 add checkbutton -label "Header" -variable Popup(showheader) \
+		-command {.f2.f1.t configure -showheader $Popup(showheader)}
+	$m2 add checkbutton -label "Lines" -variable Popup(showlines) \
+		-command {.f2.f1.t configure -showlines $Popup(showlines)}
+	$m2 add checkbutton -label "Root" -variable Popup(showroot) \
+		-command {.f2.f1.t configure -showroot $Popup(showroot)}
+	$m2 add checkbutton -label "Root Button" -variable Popup(showrootbutton) \
+		-command {.f2.f1.t configure -showrootbutton $Popup(showrootbutton)}
+	$m add cascade -label Show -menu $m2
+
+	set m2 [menu $m.mVisible -tearoff no]
+	$m add cascade -label Visible -menu $m2
+	return
+}
+
+proc MakeHeaderPopup {} {
+	set m [menu .f2.f1.t.mHeader -tearoff no]
+
+	set m2 [menu $m.mArrow -tearoff no]
+	$m add cascade -label Arrow -menu $m2
+	$m2 add radiobutton -label "None" -variable Popup(arrow) -value none -command {.f2.f1.t column configure $Popup(column) -arrow none}
+	$m2 add radiobutton -label "Up" -variable Popup(arrow) -value up -command {.f2.f1.t column configure $Popup(column) -arrow up}
+	$m2 add radiobutton -label "Down" -variable Popup(arrow) -value down -command {.f2.f1.t column configure $Popup(column) -arrow down}
+	$m2 add separator
+	$m2 add radiobutton -label "Side Left" -variable Popup(arrow,side) -value left -command {.f2.f1.t column configure $Popup(column) -arrowside left}
+	$m2 add radiobutton -label "Side Right" -variable Popup(arrow,side) -value right -command {.f2.f1.t column configure $Popup(column) -arrowside right}
+	$m2 add separator
+	$m2 add radiobutton -label "Gravity Left" -variable Popup(arrow,gravity) -value left -command {.f2.f1.t column configure $Popup(column) -arrowgravity left}
+	$m2 add radiobutton -label "Gravity Right" -variable Popup(arrow,gravity) -value right -command {.f2.f1.t column configure $Popup(column) -arrowgravity right}
+
+	$m add checkbutton -label "Expand" -variable Popup(expand) -command {.f2.f1.t column configure $Popup(column) -expand $Popup(expand)}
+
+	set m2 [menu $m.mJustify -tearoff no]
+	$m add cascade -label Justify -menu $m2
+	$m2 add radiobutton -label "Left" -variable Popup(justify) -value left -command {.f2.f1.t column configure $Popup(column) -justify left}
+	$m2 add radiobutton -label "Center" -variable Popup(justify) -value center -command {.f2.f1.t column configure $Popup(column) -justify center}
+	$m2 add radiobutton -label "Right" -variable Popup(justify) -value right -command {.f2.f1.t column configure $Popup(column) -justify right}
+	return
+}
+
+MakeMainWindow
+MakeListPopup
+MakeHeaderPopup
+
+bind .f2.f1.t <ButtonPress-3> {
+	set id [%W identify %x %y]
+	if {$id ne ""} {
+		if {[lindex $id 0] eq "header"} {
+			set Popup(column) [lindex $id 1]
+			set Popup(arrow) [%W column cget $Popup(column) -arrow]
+			set Popup(arrow,side) [%W column cget $Popup(column) -arrowside]
+			set Popup(arrow,gravity) [%W column cget $Popup(column) -arrowgravity]
+			set Popup(expand) [%W column cget $Popup(column) -expand]
+			set Popup(justify) [%W column cget $Popup(column) -justify]
+			tk_popup %W.mHeader %X %Y
+			return
+		}
+	}
+	set m %W.mTree.mCollapse
+	$m delete 0 end
+	$m add command -label "All" -command {%W collapse all}
+	if {$id ne ""} {
+		if {[lindex $id 0] eq "item"} {
+			set item [lindex $id 1]
+			$m add command -label "Item $item" -command "%W collapse $item"
+			$m add command -label "Item $item (recurse)" -command "%W collapse -recurse $item"
+		}
+	}
+	set m %W.mTree.mExpand
+	$m delete 0 end
+	$m add command -label "All" -command {%W expand all}
+	if {$id ne ""} {
+		if {[lindex $id 0] eq "item"} {
+			set item [lindex $id 1]
+			$m add command -label "Item $item" -command "%W expand $item"
+			$m add command -label "Item $item (recurse)" -command "%W expand -recurse $item"
+		}
+	}
+	foreach option {data display enable} {
+		set Popup(debug,$option) [%W debug cget -$option]
+	}
+	set Popup(doublebuffer) [%W cget -doublebuffer]
+	set Popup(linestyle) [%W cget -linestyle]
+	set Popup(orient) [%W cget -orient]
+	set Popup(selectmode) [%W cget -selectmode]
+	set Popup(showbuttons) [%W cget -showbuttons]
+	set Popup(showheader) [%W cget -showheader]
+	set Popup(showlines) [%W cget -showlines]
+	set Popup(showroot) [%W cget -showroot]
+	set Popup(showrootbutton) [%W cget -showrootbutton]
+	set m %W.mTree.mVisible
+	$m delete 0 end
+	for {set i 0} {$i < [%W numcolumns]} {incr i} {
+		set Popup(visible,$i) [%W column cget $i -visible]
+		$m add checkbutton -label "Column $i \"[%W column cget $i -text]\" \[[%W column cget $i -image]\]" -variable Popup(visible,$i) \
+			-command "%W column configure $i -visible \$Popup(visible,$i)"
+	}
+	tk_popup %W.mTree %X %Y
+}
+
+bind TreeCtrlXXX <ButtonPress-1> {
+	focus %W
+	set id [%W identify %x %y]
+	puts "identify: $id"
+	if {$id ne "" && [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
+		}
+	}
+	TreeCtrl::ButtonPress1 %W %x %y
+}
+
+#
+# List of demos
+#
+proc InitDemoList {} {
+	global DemoCmd
+	global DemoFile
+
+	set t .f1.t
+	$t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
+	$t element create e2 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
+		-showfocus yes
+	$t style create s1
+	$t style elements s1 {e2 e1}
+	# Tk listbox has linespace + 1 height
+	$t style layout s1 e2 -union [list e1] -ipadw 2 -ipade 2 -ipads 1 -iexpand e
+
+	#	"Picture Catalog" DemoPictureCatalog
+	#	"Picture Catalog 2" DemoPictureCatalog2
+	#	"Folder Contents (Vertical)" DemoExplorerFilesV
+	foreach {label command file} [list \
+		"Random $::RandomN Items" DemoRandom random.tcl \
+		"Random $::RandomN Items, Button Images" DemoRandom2 random.tcl \
+		"Outlook Express (Folders)" DemoOutlookFolders outlook-folders.tcl \
+		"Outlook Express (Newsgroup)" DemoOutlookNewsgroup outlook-newgroup.tcl \
+		"Explorer (Details)" DemoExplorerDetails explorer.tcl \
+		"Explorer (List)" DemoExplorerList explorer.tcl \
+		"Explorer (Large icons)" DemoExplorerLargeIcons explorer.tcl \
+		"Explorer (Small icons)" DemoExplorerSmallIcons explorer.tcl \
+		"Internet Options" DemoInternetOptions www-options.tcl \
+		"Help Contents" DemoHelpContents help.tcl \
+		"Layout" DemoLayout layout.tcl \
+		"MailWasher" DemoMailWasher mailwasher.tcl \
+		"Bitmaps" DemoBitmaps bitmaps.tcl \
+		"iMovie" DemoIMovie imovie.tcl \
+	] {
+		set item [$t item create]
+		$t item lastchild root $item
+		$t item style set $item 0 s1
+		$t item text $item 0 $label
+		set DemoCmd($item) $command
+		set DemoFile($item) $file
+	}
+	$t yview moveto 0.0
+	return
+}
+
+InitDemoList
+
+proc ClicksToSeconds {clicks} {
+	return [format "%.2g" [expr {$clicks / 1000000.0}]]
+}
+
+proc DemoSet {cmd file} {
+	DemoClear
+	set clicks [clock clicks]
+	uplevel #0 $cmd
+	set clicks [expr {[clock clicks] - $clicks}]
+	puts "set list in [ClicksToSeconds $clicks] seconds ($clicks clicks)"
+	.f2.f1.t xview moveto 0
+	.f2.f1.t yview moveto 0
+	update
+	DisplayStylesInList
+	ShowSource $file
+}
+
+.f1.t notify bind .f1.t <Selection> {
+	if {%c == 1} {
+		set selection [%T selection get]
+		set item [lindex $selection 0]
+		DemoSet $DemoCmd($item) $DemoFile($item)
+	}
+}
+
+proc DisplayStylesInList {} {
+
+	set T .f2.f1.t
+	set t .f4.t
+
+	# Create elements and styles the first time this is called
+	if {[llength [$t style names]] == 0} {
+		$t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
+		$t element create e2 text -fill [list $::SystemHighlightText {selected focus} "" {selected !focus} blue {}]
+		$t element create e3 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
+			-showfocus yes
+
+		$t style create s1
+		$t style elements s1 {e3 e1}
+		$t style layout s1 e3 -union [list e1] -ipadw 1 -ipade 1 -ipadn 0 -ipads 1
+
+		$t style create s2
+		$t style elements s2 {e3 e1 e2}
+		$t style layout s2 e1 -pade 4
+		$t style layout s2 e3 -union [list e1 e2] -ipade 1 -ipadw 1 -ipadn 0 -ipads 1
+	}
+
+	# Clear the list
+	$t item delete all
+
+	# One item for each element in the demo list
+	foreach elem [lsort [$T element names]] {
+		set item [$t item create]
+		$t collapse $item
+		$t item hasbutton $item yes
+		$t item style set $item 0 s1
+		$t item text $item 0 "Element $elem ([$T element type $elem])"
+
+		# One item for each configuration option for this element
+		foreach list [$T element configure $elem] {
+			foreach {name x y default current} $list {}
+			set item2 [$t item create]
+			if {[string equal $default $current]} {
+				$t item style set $item2 0 s1
+				$t item complex $item2 [list [list e1 -text [list $name $current]]]
+			} else {
+				$t item style set $item2 0 s2
+				$t item complex $item2 [list [list e1 -text $name] [list e2 -text [list $current]]]
+			}
+			$t item lastchild $item $item2
+		}
+		$t item lastchild root $item
+	}
+
+	# One item for each style in the demo list
+	foreach style [lsort [$T style names]] {
+		set item [$t item create]
+		$t collapse $item
+		$t item hasbutton $item yes
+		$t item style set $item 0 s1
+		$t item text $item 0 "Style $style"
+
+		# One item for each element in the style
+		foreach elem [$T style elements $style] {
+			set item2 [$t item create]
+			$t collapse $item2
+			$t item hasbutton $item2 yes
+			$t item style set $item2 0 s1
+			$t item text $item2 0 "Element $elem ([$T element type $elem])"
+
+			# One item for each layout option for this element in this style
+			foreach {option value} [$T style layout $style $elem] {
+				set item3 [$t item create]
+				$t item hasbutton $item3 no
+				$t item style set $item3 0 s1
+				$t item text $item3 0 [list $option $value]
+				$t item lastchild $item2 $item3
+			}
+			$t item lastchild $item $item2
+		}
+		$t item lastchild root $item
+	}
+
+	$t xview moveto 0
+	$t yview moveto 0
+	return
+}
+
+proc DisplayStylesInItem {item} {
+
+	set T .f2.f1.t
+	set t .f3.t
+	$t column configure 0 -text "Styles in item [$T index $item]"
+
+	# Create elements and styles the first time this is called
+	if {[llength [$t style names]] == 0} {
+		$t element create e1 text -fill [list $::SystemHighlightText {selected focus}]
+		$t element create e2 text -fill [list $::SystemHighlightText {selected focus} "" {selected !focus} blue {}]
+		$t element create e3 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
+			-showfocus yes
+
+		$t style create s1
+		$t style elements s1 {e3 e1}
+		$t style layout s1 e3 -union [list e1] -ipade 1 -ipadw 2 -ipadn 0 -ipads 1
+
+		$t style create s2
+		$t style elements s2 {e3 e1 e2}
+		$t style layout s2 e1 -pade 4
+		$t style layout s2 e3 -union [list e1 e2] -ipadw 1 -ipade 1 -ipadn 0 -ipads 1
+	}
+
+	# Clear the list
+	$t item delete all
+
+	# One item for each item-column
+	set column 0
+	foreach style [$T item style set $item] {
+		set item2 [$t item create]
+		$t collapse $item2
+		$t item style set $item2 0 s1
+		$t item element configure $item2 0 e1 -text "Column $column: Style $style"
+		set button 0
+
+		# One item for each element in this style
+		if {[string length $style]} {
+			foreach elem [$T item style elements $item $column] {
+				set button 1
+				set item3 [$t item create]
+				$t collapse $item3
+				$t item hasbutton $item3 yes
+				$t item style set $item3 0 s1
+				$t item element configure $item3 0 e1 -text "Element $elem ([$T element type $elem])"
+
+				# One item for each configuration option in this element
+				foreach list [$T item element configure $item $column $elem] {
+					foreach {name x y default current} $list {}
+					set item4 [$t item create]
+					set masterDefault [$T element cget $elem $name]
+					set sameAsMaster [string equal $masterDefault $current]
+					if {!$sameAsMaster && ![string length $current]} {
+						set sameAsMaster 1
+						set current $masterDefault
+					}
+
+					if {$sameAsMaster} {
+						$t item style set $item4 0 s1
+						$t item complex $item4 [list [list e1 -text "$name [list $current]"]]
+					} else {
+						$t item style set $item4 0 s2
+						$t item complex $item4 [list [list e1 -text $name] [list e2 -text [list $current]]]
+					}
+					$t item lastchild $item3 $item4
+				}
+				$t item lastchild $item2 $item3
+			}
+			if {$button} {
+				$t item hasbutton $item2 yes
+			}
+		}
+		$t item lastchild root $item2
+		incr column
+	}
+	$t xview moveto 0
+	$t yview moveto 0
+
+	return
+}
+
+# When one item is selected in the demo list, display the styles in that item.
+# See DemoClear for why the tag "DontDelete" is used
+.f2.f1.t notify bind DontDelete <Selection> {
+	if {%c == 1} {
+		set selection [%T selection get]
+		DisplayStylesInItem [lindex $selection 0]
+	}
+}
+
+proc DemoClear {} {
+
+	set T .f2.f1.t
+
+	# Clear the demo list
+	$T item delete all
+
+	# Clear all bindings on the demo list added by the previous demo.
+	# This is why DontDelete it used for the <Selection> binding.
+	foreach pattern [$T notify bind $T] {
+		$T notify bind $T $pattern {}
+	}
+
+	# Clear all run-time states
+	foreach state [$T state names] {
+		$T state undefine $state
+	}
+
+	# Clear the styles-in-item list
+	.f3.t item delete all
+
+	# Delete columns in demo list
+	while {[$T numcolumns]} {
+		$T column delete 0
+	}
+
+	# Delete all styles in demo list
+	eval $T style delete [$T style names]
+
+	# Delete all elements in demo list
+	eval $T element delete [$T element names]
+
+	$T item hasbutton root no
+	$T expand root
+
+	# Restore some happy defaults to the demo list
+	$T configure -orient vertical -wrap "" -xscrollincrement 0 \
+		-yscrollincrement 0 -itemheight 0 -showheader yes \
+		-background white -scrollmargin 0 -xscrolldelay 50 -yscrolldelay 50 \
+		-openbuttonimage "" -closedbuttonimage "" -backgroundmode row
+
+	# Restore default bindings to the demo list
+	bindtags $T [list $T TreeCtrl [winfo toplevel $T] all]
+
+	catch {destroy $T.entry}
+	catch {destroy $T.text}
+
+	return
+}
+
+#
+# Demo: Picture catalog
+#
+proc DemoPictureCatalog {} {
+
+	set T .f2.f1.t
+
+	$T configure -showroot no -showbuttons no -showlines no \
+		-selectmode multiple -orient horizontal -wrap window \
+		-yscrollincrement 50 -showheader no
+
+	$T element create elemTxt text -fill {SystemHighlightText {selected focus}}
+	$T element create elemSelTxt rect -fill {SystemHighlight {selected focus}}
+	$T element create elemSelImg rect -outline {SystemHighlight {selected focus}} \
+		-outlinewidth 4
+	$T element create elemImg rect -fill gray -width 80 -height 120
+
+	set S [$T style create STYLE -orient vertical]
+	$T style elements $S {elemSelImg elemImg elemSelTxt elemTxt}
+	$T style layout $S elemSelImg -union elemImg -ipadn 6 -ipads 6 -ipadw 6 -ipade 6
+	$T style layout $S elemSelTxt -union elemTxt
+	$T style layout $S elemImg -pads 6
+
+	for {set i 1} {$i <= 10} {incr i} {
+		set I [$T item create]
+		$T item style set $I 0 $S
+		$T item text $I 0 "Picture #$i"
+		$T item lastchild root $I
+	}
+
+	return
+}
+
+#
+# Demo: Picture catalog
+#
+proc DemoPictureCatalog2 {} {
+
+	set T .f2.f1.t
+
+	$T configure -showroot no -showbuttons no -showlines no \
+		-selectmode multiple -orient horizontal -wrap window \
+		-yscrollincrement 50 -showheader no
+
+	$T element create elemTxt text -fill {SystemHighlightText {selected focus}} \
+		-justify left -wrap word -lines 2
+	$T element create elemSelTxt rect -fill {SystemHighlight {selected focus}}
+	$T element create elemSelImg rect -outline {SystemHighlight {selected focus}} \
+		-outlinewidth 4
+	$T element create elemImg rect -fill gray
+
+	set S [$T style create STYLE -orient vertical]
+	$T style elements $S {elemSelImg elemImg elemSelTxt elemTxt}
+	$T style layout $S elemSelImg -union elemImg \
+		-ipadn 6 -ipads 6 -ipadw 6 -ipade 6
+	$T style layout $S elemSelTxt -union elemTxt
+	$T style layout $S elemImg -pads 6
+	$T style layout $S elemImg -expand n
+	$T style layout $S elemTxt -expand s
+
+	for {set i 1} {$i <= 10} {incr i} {
+		set I [$T item create]
+		$T item style set $I 0 $S
+		$T item text $I 0 "This is\nPicture\n#$i"
+		$T item element configure $I 0 elemImg -width [expr int(20 + rand() * 80)] \
+			-height [expr int(20 + rand() * 120)]
+		$T item lastchild root $I
+	}
+
+	return
+}
+
+
+
+
+proc CursorWindow {} {
+	set w .cursors
+	if {[winfo exists $w]} {
+		destroy $w
+	}
+	toplevel $w
+	set c [canvas $w.canvas -background white -width [expr {50 * 10}] \
+		-highlightthickness 0 -borderwidth 0]
+	pack $c -expand yes -fill both
+	set cursors {
+		X_cursor
+		arrow
+		based_arrow_down
+		based_arrow_up
+		boat
+		bogosity
+		bottom_left_corner
+		bottom_right_corner
+		bottom_side
+		bottom_tee
+		box_spiral
+		center_ptr
+		circle
+		clock
+		coffee_mug
+		cross
+		cross_reverse
+		crosshair
+		diamond_cross
+		dot
+		dotbox
+		double_arrow
+		draft_large
+		draft_small
+		draped_box
+		exchange
+		fleur
+		gobbler
+		gumby
+		hand1
+		hand2
+		heart
+		icon
+		iron_cross
+		left_ptr
+		left_side
+		left_tee
+		leftbutton
+		ll_angle
+		lr_angle
+		man
+		middlebutton
+		mouse
+		pencil
+		pirate
+		plus
+		question_arrow
+		right_ptr
+		right_side
+		right_tee
+		rightbutton
+		rtl_logo
+		sailboat
+		sb_down_arrow
+		sb_h_double_arrow
+		sb_left_arrow
+		sb_right_arrow
+		sb_up_arrow
+		sb_v_double_arrow
+		shuttle
+		sizing
+		spider
+		spraycan
+		star
+		target
+		tcross
+		top_left_arrow
+		top_left_corner
+		top_right_corner
+		top_side
+		top_tee
+		trek
+		ul_angle
+		umbrella
+		ur_angle
+		watch
+		xterm
+	}
+	set col 0
+	set row 0
+	foreach cursor $cursors {
+		set x [expr {$col * 50}]
+		set y [expr {$row * 40}]
+		$c create rectangle $x $y [expr {$x + 50}] [expr {$y + 40}] \
+			-fill gray90 -outline black -width 2 -tags $cursor.rect
+		$c create text [expr {$x + 50 / 2}] [expr {$y + 4}] -text $cursor \
+			-anchor n -width 42 -tags $cursor.text
+		if {[incr col] == 10} {
+			set col 0
+			incr row
+		}
+		$c bind $cursor.rect <Enter> "
+			$c configure -cursor $cursor
+			$c itemconfigure $cursor.rect -fill linen
+		"
+		$c bind $cursor.rect <Leave> "
+			$c configure -cursor {}
+			$c itemconfigure $cursor.rect -fill gray90
+		"
+		$c bind $cursor.text <Enter> "
+			$c configure -cursor $cursor
+		"
+		$c bind $cursor.text <Leave> "
+			$c configure -cursor {}
+		"
+	}
+	$c configure -height [expr {($row + 1) * 40}]
+	return
+}
+
+proc compare {i1 i2} {
+	if {$i1 < $i2} { return -1 }
+	if {$i1 == $i2} { return 0 }
+	return 1
+}
+
+# A little screen magnifier for X11
+if {$::tcl_platform(platform) eq "unix"} {
+
+set Loupe(zoom) 3
+set Loupe(x) 0
+set Loupe(y) 0
+set Loupe(auto) 1
+
+proc LoupeAfter {} {
+
+	global Loupe
+
+	set x [winfo pointerx .]
+	set y [winfo pointery .]
+	if {$Loupe(auto) || ($Loupe(x) != $x) || ($Loupe(y) != $y)} {
+		set w [image width $Loupe(image)]
+		set h [image height $Loupe(image)]
+		loupe $Loupe(image) $x $y $w $h $::Loupe(zoom)
+		set Loupe(x) $x
+		set Loupe(y) $y
+	}
+	after $Loupe(delay) LoupeAfter
+	return
+}
+
+proc MakeLoupeWindow {} {
+
+	global Loupe
+
+	set w [toplevel .loupe]
+	wm geometry $w -0+0
+	image create photo ImageLoupe -width 150 -height 150
+	pack [label $w.label -image ImageLoupe]
+	set Loupe(image) ImageLoupe
+	set Loupe(delay) 500
+	after $Loupe(delay) LoupeAfter
+	return
+}
+MakeLoupeWindow
+
+# unix
+}
+