Proposed TIP #645 implementation

3 files changed, 80 insertions, 11 deletions

diff --git a/library/iconlist.tcl b/library/iconlist.tcl
index 0c46a59..0b65464 100644
--- a/library/iconlist.tcl
+++ b/library/iconlist.tcl
@@ -377,7 +377,7 @@ package require tk
 
     method DrawSelection {} {
 	$canvas delete selection
-	$canvas itemconfigure selectionText -fill black
+	$canvas itemconfigure selectionText -fill $fill
 	$canvas dtag selectionText
 	set cbg [ttk::style lookup TEntry -selectbackground focus]
 	set cfg [ttk::style lookup TEntry -selectforeground focus]
@@ -405,7 +405,8 @@ package require tk
 	set sbar [ttk::scrollbar $hull.sbar -orient horizontal -takefocus 0]
 	catch {$sbar configure -highlightthickness 0}
 	set canvas [canvas $hull.canvas -highlightthick 0 -takefocus 1 \
-			-width 400 -height 120 -background white]
+			-width 400 -height 120\
+			-background [ttk::style lookup Treeview -background {} white]]
 	pack $sbar -side bottom -fill x -padx 2 -pady {0 2}
 	pack $canvas -expand yes -fill both -padx 2 -pady {2 0}
 
@@ -422,12 +423,7 @@ package require tk
 	set noScroll 1
 	set selection {}
 	set index(anchor) ""
-	set fg [option get $canvas foreground Foreground]
-	if {$fg eq ""} {
-	    set fill black
-	} else {
-	    set fill $fg
-	}
+	set fill [ttk::style lookup Treeview -foreground {} black]
 
 	# Creates the event bindings.
 	#
diff --git a/library/palette.tcl b/library/palette.tcl
index e658067..c2ba4e0 100644
--- a/library/palette.tcl
+++ b/library/palette.tcl
@@ -139,6 +139,18 @@ proc ::tk_setPalette {args} {
     # next time we change the options.
 
     array set ::tk::Palette [array get new]
+
+    # Update the 'default' ttk theme in order to apply the
+    # new palette to the ttk widgets.
+
+    foreach option [array names new] {
+	if {[info exists ttk::theme::default::colorOptionLookup($option)]} {
+	    foreach colorName $ttk::theme::default::colorOptionLookup($option) {
+		set ttk::theme::default::colors($colorName) $new($option)
+	    }
+	}
+    }
+    ttk::theme::default::reconfigureDefaultTheme
 }
 
 # ::tk::RecolorTree --
diff --git a/library/ttk/defaults.tcl b/library/ttk/defaults.tcl
index a85ed53..90ab379 100644
--- a/library/ttk/defaults.tcl
+++ b/library/ttk/defaults.tcl
@@ -19,7 +19,66 @@ namespace eval ttk::theme::default {
 	-disabledindicator	"#a3a3a3"
 	-altindicator		"#9fbdd8"
 	-disabledaltindicator	"#c0c0c0"
+    # On X11, if the user specifies their own choice of colour scheme via X resources,
+    # then set the colour palette based on the user's choice.
+    if {[tk windowingsystem] eq "x11"} {
+	foreach\
+	    xResourceName\
+                 { {	background		Background		}
+                 {	foreground		Foreground		}
+                 {	background		Background		}
+                 {	foreground		Foreground		}
+                 {	activeBackground	ActiveBackground	}
+                 {	selectBackground	SelectBackground	}
+                 {	selectForeground	SelectForeground	}
+                 {	troughColor		TroughColor		}
+                 {	disabledForeground	DisabledForeground	}
+                 {	selectBackground	SelectBackground	}
+                 {	disabledForeground	DisabledForeground	}
+                 {	selectBackground	SelectBackground	}
+                 {	troughColor		TroughColor		} }\
+	    colorName\
+                 { -frame -foreground -window -text
+                 -activebg -selectbg -selectfg
+                 -darker -disabledfg -indicator
+                 -disabledindicator -altindicator
+                 -disabledaltindicator }\
+	{
+	    set color [eval option get . $xResourceName]
+	    if {$color ne ""} {
+                 set colors($colorName) $color
+	    }
+	}
+    }
+    # This array is used to match up the tk widget options with the
+    # corresponding values in the 'colors' array.
+    # This is used by tk_setPalette to apply the new palette
+    # to the ttk widgets.
+    variable colorOptionLookup
+    array set colorOptionLookup {
+	background		{-frame -window}
+	foreground		{-foreground -text}
+	activeBackground	-activebg
+	selectBackground	{-selectbg -indicator -altindicator}
+	selectForeground	-selectfg
+	troughColor		{-darker -disabledaltindicator}
+	disabledForeground	{-disabledfg -disabledindicator}
     }
+}
+
+    }
+# ttk::theme::default::reconfigureDefaultTheme --
+# This procedure contains the definition of the 'default' theme itself.
+# The theme definition is in a procedure, so it can be re-called
+# when required, enabling tk_setPalette to set the colours
+# of the ttk widgets.
+#
+# Arguments:
+# None.
+
+proc ttk::theme::default::reconfigureDefaultTheme {} {
+    upvar ttk::theme::default::colors colors
+    # The definition of the 'default' theme.
 
     ttk::style theme settings default {
 
@@ -47,7 +106,7 @@ namespace eval ttk::theme::default {
 	ttk::style map TButton -relief [list {!disabled pressed} sunken]
 
 	ttk::style configure TCheckbutton \
-	    -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
+	    -indicatorcolor $colors(-window) -indicatorrelief sunken -padding 1
 	ttk::style map TCheckbutton -indicatorcolor \
 	    [list pressed $colors(-activebg)  \
 			{!disabled alternate} $colors(-altindicator) \
@@ -58,7 +117,7 @@ namespace eval ttk::theme::default {
 	    [list alternate raised]
 
 	ttk::style configure TRadiobutton \
-	    -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
+	    -indicatorcolor $colors(-window) -indicatorrelief sunken -padding 1
 	ttk::style map TRadiobutton -indicatorcolor \
 	    [list pressed $colors(-activebg)  \
 			{!disabled alternate} $colors(-altindicator) \
@@ -72,7 +131,7 @@ namespace eval ttk::theme::default {
 	    -relief raised -padding "10 3"
 
 	ttk::style configure TEntry \
-	    -relief sunken -fieldbackground white -padding 1
+	    -relief sunken -fieldbackground $colors(-window) -padding 1
 	ttk::style map TEntry -fieldbackground \
 	    [list readonly $colors(-frame) disabled $colors(-frame)]
 
@@ -142,6 +201,8 @@ namespace eval ttk::theme::default {
 	ttk::style map Toolbutton -relief \
 	    [list disabled flat selected sunken pressed sunken active raised]
 	ttk::style map Toolbutton -background \
+
+ttk::theme::default::reconfigureDefaultTheme
 	    [list pressed $colors(-darker)  active $colors(-activebg)]
     }
 }