diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2001-11-15 14:02:46 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2001-11-15 14:02:46 (GMT) |
| commit | 6101c7baf07340632b03eaf31da112dda8eb450b (patch) | |
| tree | a242ac4fd178dac42b26b2b6c76ea7b59ac2489b /library/palette.tcl | |
| parent | e10ad7411d1ec28dcfe30db1c03c8648af9b6020 (diff) | |
| download | tk-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.tcl | 21 |
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] |