Theme-related changes.

3 files changed, 209 insertions, 53 deletions

diff --git a/demos/biglist.tcl b/demos/biglist.tcl
index e1e606d..de01e05 100644
--- a/demos/biglist.tcl
+++ b/demos/biglist.tcl
@@ -1,4 +1,4 @@
-# RCS: @(#) $Id: biglist.tcl,v 1.9 2006/10/28 01:24:13 treectrl Exp $
+# RCS: @(#) $Id: biglist.tcl,v 1.10 2006/11/13 04:45:09 treectrl Exp $
 
 set ::clip 1
 proc DemoBigList {} {
@@ -126,19 +126,15 @@ if {$::clip} {
 	set BigList(nextWindowId) 0
 	set BigList(prev) ""
 
-	# Create a new window just to get the requested size. This will be the
-	# value of the item -height option for some items.
-	set w [BigListNewWindow $T root]
-	update idletasks
-if {$::clip} {
-	set height [winfo reqheight [lindex [winfo children $w] 0]]
-} else {
-	set height [winfo reqheight $w]
-}
-	# Add 1 pixel for the border
-	incr height
-	set BigList(windowHeight) $height
-	BigListFreeWindow $T $w
+	BigListGetWindowHeight $T
+	if {$::tile} {
+		bind DemoBigList <<ThemeChanged>> {
+			BigListGetWindowHeight .f2.f1.t
+			if {[.f2.f1.t item id {first visible tag info}] ne ""} {
+				.f2.f1.t item conf {tag info} -height $BigList(windowHeight)
+			}
+		}
+	}
 
 	bind DemoBigList <Double-ButtonPress-1> {
 		if {[lindex [%W identify %x %y] 0] eq "header"} {
@@ -167,6 +163,24 @@ if {$::clip} {
 	return
 }
 
+proc BigListGetWindowHeight {T} {
+	global BigList
+	# Create a new window just to get the requested size. This will be the
+	# value of the item -height option for some items.
+	set w [BigListNewWindow $T root]
+	update idletasks
+if {$::clip} {
+	set height [winfo reqheight [lindex [winfo children $w] 0]]
+} else {
+	set height [winfo reqheight $w]
+}
+	# Add 1 pixel for the border
+	incr height
+	set BigList(windowHeight) $height
+	BigListFreeWindow $T $w
+	return
+}
+
 proc BigListExpandBefore {T I} {
 
 	global BigList
@@ -315,7 +329,7 @@ if {$::clip} {
 		if {$::thisPlatform ne "windows"} {
 			set message [string map {\n ""} $message]
 		}
-		button $w.b3 -text "Anal Probe Wizard..." -command [list tk_messageBox \
+		$::buttonCmd $w.b3 -text "Anal Probe Wizard..." -command [list tk_messageBox \
 			-parent . -message $message -title "Anal Probe 2.0"]
 
 		grid $w.label1 -row 0 -column 0 -sticky w -padx {0 8}
diff --git a/demos/demo.tcl b/demos/demo.tcl
index c4b761c..6ca6729 100644
--- a/demos/demo.tcl
+++ b/demos/demo.tcl
@@ -1,6 +1,6 @@
 #!/bin/wish84.exe
 
-# RCS: @(#) $Id: demo.tcl,v 1.50 2006/11/12 05:49:18 treectrl Exp $
+# RCS: @(#) $Id: demo.tcl,v 1.51 2006/11/13 04:45:09 treectrl Exp $
 
 set VERSION 2.1.1
 
@@ -56,16 +56,33 @@ if {[catch {
 }
 
 set tile 0
-set entryCmd ::entry
 catch {
-	package require tile 0.6
-	namespace import -force ::ttk::button ::ttk::checkbutton \
-		ttk::radiobutton
-	# Don't import this, it messes up our edit bindings, and I'm not
-	# sure how to get/set the equivalent -borderwidth, -selectborderwidth
-	# etc options of a TEntry.
-	set ::entryCmd ::ttk::entry
-	set tile 1
+    package require tile 0.7.8
+    namespace export style
+    namespace eval ::tile {
+	namespace export setTheme
+    }
+    namespace eval ::ttk {
+	namespace import ::style
+	namespace import ::tile::setTheme
+    }
+    set tile 1
+}
+if {$tile} {
+    # Don't import ttk::entry, it messes up the edit bindings, and I'm not
+    # sure how to get/set the equivalent -borderwidth, -selectborderwidth
+    # etc options of a TEntry.
+    set entryCmd ::ttk::entry
+    set buttonCmd ::ttk::button
+    set checkbuttonCmd ::ttk::checkbutton
+    set radiobuttonCmd ttk::radiobutton
+    set scrollbarCmd ::ttk::scrollbar
+} else {
+    set entryCmd ::entry
+    set buttonCmd ::button
+    set checkbuttonCmd ::checkbutton
+    set radiobuttonCmd ::radiobutton
+    set scrollbarCmd ::scrollbar
 }
 
 # This gets called if 'package require' won't work during development.
@@ -136,9 +153,9 @@ foreach list [info loaded] {
     break
 }
 if {[info exists env(TREECTRL_LIBRARY)]} {
-	puts "demo.tcl: TREECTRL_LIBRARY=$env(TREECTRL_LIBRARY)"
+    puts "demo.tcl: TREECTRL_LIBRARY=$env(TREECTRL_LIBRARY)"
 } else {
-	puts "demo.tcl: TREECTRL_LIBRARY undefined"
+    puts "demo.tcl: TREECTRL_LIBRARY undefined"
 }
 puts "demo.tcl: treectrl_library=$treectrl_library"
 
@@ -219,8 +236,20 @@ proc MakeMenuBar {} {
     $m2 add command -label "Style Editor" -command ToggleStyleEditorWindow
     $m2 add command -label "View Source" -command ToggleSourceWindow
     $m2 add command -label "Magnifier" -command ToggleLoupeWindow
-    $m2 add command -label Quit -command exit
-    $m add cascade -label File -menu $m2
+    $m2 add command -label "Quit" -command exit
+    $m add cascade -label "File" -menu $m2
+
+	if {$::tile} {
+	    set m2 [menu $m.mTheme -tearoff no]
+	    $m add cascade -label "Theme" -menu $m2
+	    foreach theme [lsort -dictionary [ttk::style theme names]] {
+		$m2 add radiobutton -label $theme -command [list ttk::setTheme $theme] \
+		    -variable ::DemoTheme -value $theme
+	    }
+	    $m2 add separator
+	    $m2 add command -label "Inspector" -command ToggleThemeWindow
+    }
+    
     return
 }
 
@@ -453,8 +482,8 @@ proc MakeSourceWindow {} {
     }
     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"
+    $::scrollbarCmd $f.sv -orient vertical -command "$f.t yview"
+    $::scrollbarCmd $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
@@ -511,6 +540,107 @@ proc ToggleStyleEditorWindow {} {
     return
 }
 
+proc MakeThemeWindow {} {
+    set w [toplevel .theme]
+    wm withdraw $w
+#    wm transient $w .
+    wm title $w "TkTreeCtrl Themes"
+
+    set m [menu $w.menubar]
+    $w configure -menu $m
+    set m1 [menu $m.m1 -tearoff 0]
+    $m1 add command -label "Set List" -command SetThemeWindow
+    $m add cascade -label "Theme" -menu $m1
+
+    TreePlusScrollbarsInAFrame $w.f 1 1
+    pack $w.f -expand yes -fill both
+
+    set T $w.f.t
+
+    $T configure -showheader no -showroot no -showrootlines no -height 300
+    $T column create -tags C0
+    $T configure -treecolumn C0
+
+    $T element create e1 text -fill [list $::SystemHighlightText {selected focus}]
+    $T element create e3 rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \
+	-showfocus yes
+
+    set S [$T style create s1]
+    $T style elements $S {e3 e1}
+    $T style layout $S e3 -union [list e1] -ipadx 1 -ipady {0 1}
+
+    $T column configure C0 -itemstyle s1
+
+    SetThemeWindow
+
+    wm protocol $w WM_DELETE_WINDOW "ToggleThemeWindow"
+
+    return
+}
+proc ToggleThemeWindow {} {
+    set w .theme
+    if {![winfo exists $w]} {
+	MakeThemeWindow
+    }
+    if {[winfo ismapped $w]} {
+	wm withdraw $w
+    } else {
+	wm deiconify $w
+    }
+    return
+}
+proc SetThemeWindow {} {
+    set w .theme
+    set T $w.f.t
+
+    $T item delete all
+    #
+    # Themes
+    #
+    foreach theme [lsort -dictionary [ttk::style theme names]] {
+	set I [$T item create -button yes -open no -tags theme -parent root]
+	$T item text $I C0 $theme
+	ttk::style theme settings $theme {
+	    set I2 [$T item create -button yes -open no -parent $I]
+	    $T item text $I2 C0 ELEMENTS
+	    #
+	    # Elements
+	    #
+	    foreach element [lsort -dictionary [ttk::style element names]] {
+		#
+		# Element options
+		#
+		set options [ttk::style element options $element]
+		set I3 [$T item create -button [llength $options] -open no -tags element -parent $I2]
+		$T item text $I3 C0 $element
+		foreach option [lsort -dictionary $options] {
+		    set I4 [$T item create -open no -tags {element option} -parent $I3]
+		    $T item text $I4 C0 $option
+		}
+	    }
+	    #
+	    # Styles
+	    #
+	    set I2 [$T item create -button yes -open no -parent $I]
+	    $T item text $I2 C0 STYLES
+	    set styles [list "."] ; # [ttk::style names] please!
+	    foreach style [lsort -dictionary $styles] {
+		#
+		# Style options
+		#
+		set cfg [ttk::style configure $style]
+		set I3 [$T item create -button [llength $cfg] -open no -tags style -parent $I2]
+		$T item text $I3 C0 $style
+		foreach {option value} $cfg {
+		    set I4 [$T item create -open no -tags {style option} -parent $I3]
+		    $T item text $I4 C0 "$option $value"
+		}
+	    }
+	}
+    }
+    return
+}
+
 MakeSourceWindow
 MakeMenuBar
 
@@ -526,7 +656,11 @@ proc sbset {sb first last} {
 }
 
 proc TreePlusScrollbarsInAFrame {f h v} {
-    frame $f -borderwidth 1 -relief sunken
+	if {$::tile} {
+	    frame $f -borderwidth 0
+	} else {
+		frame $f -borderwidth 1 -relief sunken
+    }
     switch -- $::thisPlatform {
 	macintosh {
 	    set font {Geneva 9}
@@ -545,15 +679,16 @@ proc TreePlusScrollbarsInAFrame {f h v} {
     }
     treectrl $f.t -highlightthickness 0 -borderwidth 0 -font $font
     $f.t configure -xscrollincrement 20
-    $f.t debug configure -enable no -display no
+    $f.t debug configure -enable no -display yes -erasecolor pink \
+	-drawcolor orange -displaydelay 30 -textlayout 0 -data 0
     if {$h} {
-	scrollbar $f.sh -orient horizontal -command "$f.t xview"
+	$::scrollbarCmd $f.sh -orient horizontal -command "$f.t xview"
 	#		$f.t configure -xscrollcommand "$f.sh set"
 	$f.t notify bind $f.sh <Scroll-x> { sbset %W %l %u }
 	bind $f.sh <ButtonPress-1> "focus $f.t"
     }
     if {$v} {
-	scrollbar $f.sv -orient vertical -command "$f.t yview"
+	$::scrollbarCmd $f.sv -orient vertical -command "$f.t yview"
 	#		$f.t configure -yscrollcommand "$f.sv set"
 	$f.t notify bind $f.sv <Scroll-y> { sbset %W %l %u }
 	bind $f.sv <ButtonPress-1> "focus $f.t"
@@ -644,11 +779,11 @@ proc MakeMainWindow {} {
     # Tree + scrollbars
     TreePlusScrollbarsInAFrame .f2.f1 1 1
     .f2.f1.t configure -indent 19
-    .f2.f1.t debug configure -enable no -display yes -erasecolor pink \
-	-drawcolor orange -displaydelay 30
 
     # Give it a big border to debug drawing
-    .f2.f1.t configure -borderwidth 6 -relief ridge -highlightthickness 3
+    if {!$::tile} {
+	.f2.f1.t configure -borderwidth 6 -relief ridge -highlightthickness 3
+    }
 
     grid columnconfigure .f2 0 -weight 1
     grid rowconfigure .f2 0 -weight 1
@@ -1275,8 +1410,8 @@ proc DemoClear {} {
 	-background white -scrollmargin 0 -xscrolldelay 50 -yscrolldelay 50 \
 	-buttonbitmap "" -buttonimage "" -backgroundmode row \
 	-indent 19 -defaultstyle {} -backgroundimage "" \
-	-showrootlines yes -minitemheight 0 -borderwidth 6 \
-	-highlightthickness 3 -usetheme yes -cursor {} \
+	-showrootlines yes -minitemheight 0 -borderwidth [expr {$::tile ? 0 : 6}] \
+	-highlightthickness [expr {$::tile ? 0 : 3}] -usetheme yes -cursor {} \
 	-itemwidth 0 -itemwidthequal no -itemwidthmultiple 0 \
 	-font [.f4.t cget -font]
 
diff --git a/demos/firefox.tcl b/demos/firefox.tcl
index 136bed6..2a8fe87 100644
--- a/demos/firefox.tcl
+++ b/demos/firefox.tcl
@@ -1,4 +1,4 @@
-# RCS: @(#) $Id: firefox.tcl,v 1.15 2006/10/28 01:24:13 treectrl Exp $
+# RCS: @(#) $Id: firefox.tcl,v 1.16 2006/11/13 04:45:09 treectrl Exp $
 
 proc DemoFirefoxPrivacy {} {
 
@@ -107,10 +107,10 @@ if {$::clip} { $T element configure eWindow -clip yes }
 		$T item element configure $I C0 eText1 -text $category
 if {$::clip} {
 		set wClip [frame $T.clip$I -background red]
-		set b [button $wClip.b$I -text "Clear" -command "" -width 11]
+		set b [$::buttonCmd $wClip.b$I -text "Clear" -command "" -width 11]
 		$T item element configure $I C0 eWindow -window $wClip
 } else {
-		set b [button $T.b$I -text "Clear" -command "" -width 11]
+		set b [$::buttonCmd $T.b$I -text "Clear" -command "" -width 11]
 		$T item element configure $I C0 eWindow -window $b
 }
 		$T item lastchild root $I
@@ -120,8 +120,8 @@ if {$::clip} {
 	set textBg $bg
 
 	if {$::tile} {
-		style configure DemoCheckbutton -background $bg
-		style layout DemoCheckbutton [style layout TCheckbutton]
+		ttk::style configure DemoCheckbutton -background $bg
+		ttk::style layout DemoCheckbutton [ttk::style layout TCheckbutton]
 	}
 
 	# History
@@ -162,7 +162,7 @@ if {$::clip} {
 		Bar is saved to make filling out forms and searching faster."
 	bindtags $f.t1 TextWrapBindTag
 	if {$::tile} {
-		checkbutton $f.cb1 -text "Save information I enter in web page forms and the Search Bar" \
+		$::checkbuttonCmd $f.cb1 -text "Save information I enter in web page forms and the Search Bar" \
 			-variable ::cbvar($f.cb1) -style DemoCheckbutton
 	} else {
 		checkbutton $f.cb1 -background $bg -highlightthickness 0 -text "Save\
@@ -197,7 +197,7 @@ if {$::clip} {
 		details every time you visit."
 	bindtags $fLeft.t1 TextWrapBindTag
 	if {$::tile} {
-		checkbutton $fLeft.cb1 -text "Remember Passwords" \
+		$::checkbuttonCmd $fLeft.cb1 -text "Remember Passwords" \
 			-variable ::cbvar($fLeft.cb1) -style DemoCheckbutton
 	} else {
 		checkbutton $fLeft.cb1 -background $bg -highlightthickness 0 \
@@ -208,8 +208,8 @@ if {$::clip} {
 	pack $fLeft.cb1 -side top -anchor w
 
 	set fRight [frame $f.fRight -borderwidth 0 -background $bg]
-	button $fRight.b1 -text "View Saved Passwords"
-	button $fRight.b2 -text "Change Master Password..."
+	$::buttonCmd $fRight.b1 -text "View Saved Passwords"
+	$::buttonCmd $fRight.b2 -text "Change Master Password..."
 	pack $fRight.b1 -side top -expand yes -fill x
 	pack $fRight.b2 -side top -expand yes -fill x -pady {8 0}
 	pack $fLeft -side left -expand yes -fill x
@@ -285,7 +285,7 @@ if {$::clip} {
 
 	set fLeft [frame $f.fLeft -borderwidth 0 -background $bg]
 	if {$::tile} {
-		checkbutton $fLeft.cb1  -style DemoCheckbutton \
+		$::checkbuttonCmd $fLeft.cb1  -style DemoCheckbutton \
 			-text "Allow sites to set cookies" -variable ::cbvar($fLeft.cb1)
 	} else {
 		checkbutton $fLeft.cb1 -background $bg -highlightthickness 0 \
@@ -293,7 +293,7 @@ if {$::clip} {
 	}
 	set ::cbvar($fLeft.cb1) 1
 	if {$::tile} {
-		checkbutton $fLeft.cb2  -style DemoCheckbutton \
+		$::checkbuttonCmd $fLeft.cb2  -style DemoCheckbutton \
 			-text "for the originating web site only" \
 			-variable ::cbar($fLeft.cb2)
 	} else {
@@ -306,8 +306,8 @@ if {$::clip} {
 	pack $fLeft.cb2 -side top -anchor w -padx {20 0}
 
 	set fRight [frame $f.fRight -borderwidth 0 -background $bg]
-	button $fRight.b1 -text "Exceptions"
-	button $fRight.b2 -text "View Cookies"
+	$::buttonCmd $fRight.b1 -text "Exceptions"
+	$::buttonCmd $fRight.b2 -text "View Cookies"
 	pack $fRight.b1 -side left -padx {0 10}
 	pack $fRight.b2 -side left
 
@@ -422,6 +422,13 @@ if {$::clip} {
 		DemoFirefoxPrivacyMotion %W %x %y
 	}
 
+	if {$::tile} {
+		bind DemoFirefoxPrivacy <<ThemeChanged>> {
+			ttk::style configure DemoCheckbutton -background #FFFFCC
+			ttk::style layout DemoCheckbutton [ttk::style layout TCheckbutton]
+		}
+	}
+
 	set FirefoxPrivacy(prev) ""
 	bindtags $T [list $T DemoFirefoxPrivacy TreeCtrl [winfo toplevel $T] all]