summaryrefslogtreecommitdiffstats
path: root/library/palette.tcl
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2001-11-15 14:02:46 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2001-11-15 14:02:46 (GMT)
commit6101c7baf07340632b03eaf31da112dda8eb450b (patch)
treea242ac4fd178dac42b26b2b6c76ea7b59ac2489b /library/palette.tcl
parente10ad7411d1ec28dcfe30db1c03c8648af9b6020 (diff)
downloadtk-6101c7baf07340632b03eaf31da112dda8eb450b.zip
tk-6101c7baf07340632b03eaf31da112dda8eb450b.tar.gz
tk-6101c7baf07340632b03eaf31da112dda8eb450b.tar.bz2
tk_setPalette now works correctly under CDE, + an image demo update
Diffstat (limited to 'library/palette.tcl')
-rw-r--r--library/palette.tcl21
1 files changed, 16 insertions, 5 deletions
diff --git a/library/palette.tcl b/library/palette.tcl
index f278268..7542ef5 100644
--- a/library/palette.tcl
+++ b/library/palette.tcl
@@ -3,7 +3,7 @@
# This file contains procedures that change the color palette used
# by Tk.
#
-# RCS: @(#) $Id: palette.tcl,v 1.6 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: palette.tcl,v 1.7 2001/11/15 14:02:47 dkf Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
@@ -98,8 +98,11 @@ proc ::tk_setPalette {args} {
# defaults are currently for this platform.
toplevel .___tk_set_palette
wm withdraw .___tk_set_palette
- foreach q {button canvas checkbutton entry frame label listbox \
- menubutton menu message radiobutton scale scrollbar text} {
+ foreach q {
+ button canvas checkbutton entry frame label labelframe
+ listbox menubutton menu message radiobutton scale scrollbar
+ spinbox text
+ } {
$q .___tk_set_palette.$q
}
@@ -150,14 +153,22 @@ proc ::tk_setPalette {args} {
proc ::tk::RecolorTree {w colors} {
upvar $colors c
set result {}
+ set prototype .___tk_set_palette.[string tolower [winfo class $w]]
+ if {![winfo exists $prototype]} {
+ unset prototype
+ }
foreach dbOption [array names c] {
set option -[string tolower $dbOption]
+ set class [string replace $dbOption 0 0 [string toupper \
+ [string index $dbOption 0]]]
if {![catch {$w config $option} value]} {
# if the option database has a preference for this
# dbOption, then use it, otherwise use the defaults
# for the widget.
- set defaultcolor [option get $w $dbOption widgetDefault]
- if {[string match {} $defaultcolor]} {
+ set defaultcolor [option get $w $dbOption $class]
+ if {[string match {} $defaultcolor] || \
+ ([info exists prototype] && \
+ [$prototype cget $option] ne "$defaultcolor")} {
set defaultcolor [winfo rgb . [lindex $value 3]]
} else {
set defaultcolor [winfo rgb . $defaultcolor]