WISH Color Picker Plus megawidget
http://www.pa-mcclamrock.com/papenguinspacks.html
WISH Color Picker Plus is a fairly versatile megawidget for applying user-selected color schemes to Tk applications. It's included with all the applications you can download for free from
http://www.pa-mcclamrock.com/papenguinspacks.html. You'll find it (wishcolorplus.tcl) in the /usr/local/lib/wishes subdirectory of the directory the tarball is unpacked into.
WISH Color Picker Plus requires Tk 8.5, and will set colors for just about any combination of standard Tk widgets, Ttk themed widgets, or both. It comes with several newly designed or re-done color schemes; any other color schemes, created with a pre-2008 version of WISH Color Picker Plus, will need to be re-done for the newer version.
To use WISH Color Picker Plus in an application, include the following code snippets, with whatever reasonable modifications you see fit (and let me know if you run into any problems).
# Identify system directory ("$libdir") in which
# WISH Color Picker Plus (wishcolorplus.tcl) will be found:
set topdir /usr/local
set libdir [file join $topdir lib wishes]
# Identify user's subdirectory for color schemes:
set wishdir [file join $env(HOME) .wishes]
set colordir [file join $wishdir colorschemes]
if {[file isdirectory $colordir] == 0} {
file mkdir $colordir
}
# WISH Color Picker Plus isn't yet loaded:
set coloron 0
# Initialize lists of Tk widgets for color display
# (not all may be used by all programs;
# colors of Ttk widgets will be derived
# from window background color):
set buttlist [list] ; # Buttons
set texlist [list] ; # Text widgets
set entlist [list] ; # Entry widgets
set lublist [list] ; # Listboxes
set spinlist [list] ; # Spinboxes
set winlist [list] ; # Widgets to get window background color when disabled
set headlist [list] ; # Emphasized labels
set lightlist [list] ; # Light labels
set checklist [list] ; # Checkbuttons and radiobuttons
Add each Tk widget in the main program window to the appropriate widget list--for example:
foreach butt [list .help .run .autoadd .autosel .colodisp .add .edit \
.unlist .sort .deselect .kill .quit] {
lappend buttlist $butt
}
For subsidiary windows, frames, and whatnot, which won't appear when the main window is first opened, configure each Tk widget to use the appropriate foreground and background color, by way of the following global variables:
* winfore, winback (window foreground and background)
* selfore, selback (selection foreground and background)
* buttfore, buttback (buttons, spinbox arrows)
* textfore, textback (text, listbox, entry, spinbox value, "selectcolor" for checkbuttons and radiobuttons)
* inacback (inactive selection background)
* headfore, headback (emphasized labels)
* lightfore, lightback (light labels, alternate lines in "striped" list displays)
For example:
entry .fix.dispname -width 36 -bg $::textback -fg $::textfore
Create a button, menu item, or something to invoke a procedure that in turn will invoke WISH Color Picker Plus--for example:
button .colodisp -text "Color Display" -command colodisp
# Procedure to set up GUI box for configuring color display:
proc colodisp {} {
global color red green blue whatfig whatbutt colorlist colordir \
winback winfore selback selfore buttback buttfore textback \
textfore headback headfore lightback lightfore coloron wishdir \
libdir current_scheme bogomips
if {$coloron == 0} {
source [file join $libdir wishcolorplus.tcl]
set coloron 1
}
wishcolorplus ; # This does all the work--from WISH Color Picker Plus
wm title .colo "WISH Command Center : WISH Color Picker Plus"
}
Create procedures to save and retrieve the "current_scheme" setting and, if desired, other variable settings (the procedure to save settings must be called "savefig"--for example:
# Read configuration file, if there is one:
set comfig [file join $wishdir comfig.tcl]
if {[file readable $comfig]} {
source $comfig
}
# Procedure to save configuration:
proc savefig {} {
global comfig
set filid [open $comfig w]
set figlines "# WISH Command Center configuration file (comfig.tcl)\
\n\nset proglist \[list $::proglist\]\
\nset autolist \[list $::autolist\]\
\nset deleteds \[list $::deleteds\]\
\nset current_scheme $::current_scheme"
puts -nonewline $filid $figlines
close $filid
}