Keith Vetter 2003-09-24 -- Here's a debugging tool that I've found very helpful. It is a dialog with a table showing all of a widgets configuration options--name, default value and current value. You can change any of these options, press a button, and see the widget updated.
To bring up this dialog, first source in this code and then type: ::WConfig::Go <widgetname>.
Since I didn't put any help into this package, I'll explain some stuff here: refresh rereads the widget configuration, reset returns the widget to the state it was when you started, default returns the widget to the default settings and apply applies your changes to the widget. You select a new widget to configure by either entering a widget name in the entry and clicking Select Widget, or you can press and hold button-1 on Select Widget, drag the mouse to the widget you want to configure and release the mouse.
#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 8; -*- \
exec wish $0 ${1+"$@"}
##+##########################################################################
#
# WConfig.tcl -- a widget configuration editing tool
# by Keith Vetter
#
# Revisions:
# KPV Nov 27, 2001 - initial revision
# KPV Sep 24, 2003 - cleaned up for Wiki posting
#
##+##########################################################################
#############################################################################
package require Tk
package require Tktable
namespace eval WConfig {
variable TableData ;# Used by Tktable
variable TableData_org ;# So we can reset
variable W ;# The table widget
variable widget "" ;# Widget we're configuring
variable new "" ;# Display version of widget
variable rows ;# Rows of data
variable TOP ;# Toplevel for our display
}
##+##########################################################################
#
# ::WConfig::go -- main programming entry to this package. Puts up a dialog
# allowing you to view and edit the configuration properties of widget "w"
#
proc ::WConfig::go {w} {
variable W
variable widget $w
variable rows
variable new $w
variable TOP
set TOP .conf_conf
set TOPF "$TOP.top" ;# Various gridding frames
set TOPB "$TOP.bottom"
set TOPB2 "$TOP.bottom2"
set W $TOPF.t ;# The table widget
::WConfig::Refresh
set rows [llength [array names ::WConfig::TableData *,2]]
if {[winfo exists $TOP]} { ;# Already displayed
$W config -rows $rows
::WConfig::Colorize
wm title $TOP "[winfo class $w] $w Configuration"
return
}
toplevel $TOP
wm protocol $TOP WM_DELETE_WINDOW ::WConfig::Exit
set t [winfo toplevel $w]
wm geom $TOP "+[expr {[winfo x $t] + [winfo width $t] + 10}]+[winfo y $t]"
wm title $TOP "[winfo class $w] $w Configuration"
frame $TOPF
frame $TOPB -bd 2 -relief ridge
frame $TOPB2 -bd 2 -relief ridge
table $W -rows $rows \
-cols 3 \
-titlerows 1 \
-autoclear 1 \
-multiline 0 \
-yscrollcommand [list $TOPF.sy set] \
-xscrollcommand [list $TOPF.sx set] \
-colstretchmode all \
-rowstretchmode none \
-selectmode extended \
-sparsearray 0 \
-variable ::WConfig::TableData \
-colwidth 20 \
-validate 1 \
-vcmd [list ::WConfig::vcmd %r %S] \
-coltagcommand ::WConfig::colProc
$W tag configure active -fg black
$W tag configure col_0 -state disabled
$W tag configure col_1 -state disabled
$W tag configure ccell -bg red ;# Changed cell
$W tag configure mcell -bg green ;# Modified from default
$W tag configure ncell ;# Normal cell
$W tag raise ccell active
$W tag raise mcell active
$W tag raise ncell active
proc ::WConfig::colProc col { return "col_$col" }
scrollbar $TOPF.sy -command [list $W yview]
scrollbar $TOPF.sx -command [list $W xview] -orient horizontal
button $TOPB.d -text Default -command {::WConfig::Apply default} -width 10
button $TOPB.r -text Refresh -command ::WConfig::Refresh -width 10
button $TOPB.r0 -text Reset -command {::WConfig::Apply reset} -width 10
button $TOPB.a -text Apply -command {::WConfig::Apply apply} -width 10
button $TOPB2.select -text "Select Widget" -command ::WConfig::New
bind $TOPB2.select <ButtonRelease-1> [list ::WConfig::NewDrag %X %Y]
entry $TOPB2.swidget -textvariable ::WConfig::new
bind $TOPB2.swidget <Key-Return> ::WConfig::New
button $TOPB2.q -text Quit -width 10 -command ::WConfig::Exit
pack $TOPB2 -side bottom -fill both -ipady 5
pack $TOPB -side bottom -fill both -ipady 5
pack $TOPF -side top -fill both -expand 1
pack $TOPB2.select $TOPB2.swidget -side left -padx 5
pack $TOPB2.q -side right -padx 5
pack $TOPB.a $TOPB.d $TOPB.r0 $TOPB.r -side right -padx 5 -expand 1
grid $W $TOPF.sy -sticky news
grid $TOPF.sx -sticky ew
grid columnconfig $TOPF 0 -weight 1
grid rowconfig $TOPF 0 -weight 1
bind $W <Key-Return> "[bind Table <Down>];break"
bind $W <Key-Return> "[bind Table <Down>];break"
bind $W <Tab> "[bind Table <Down>];break"
bind $W <Shift-Tab> "[bind Table <Up>];break"
::WConfig::Colorize
}
##+##########################################################################
#
# ::WConfig::Refresh -- fills in the TableData array used by the table widget
#
proc ::WConfig::Refresh {} {
variable TableData ;# Used by Tktable
variable TableData_org ;# So we can reset
variable widget
catch {unset TableData}
catch {unset TableData_org}
array set TableData {
0,0 "Option Name" 0,1 "Default Value" 0,2 "Current Value"}
set row 1
foreach datum [$widget configure] {
if {[llength $datum] != 5} continue ;# Throw out shortcuts
foreach col [list 0 1 2] cdata [list 0 3 4] {
set d [lindex $datum $cdata]
if {$d == ""} {set d {{}}}
set TableData($row,$col) $d
}
incr row
}
array set TableData_org [array get TableData] ;# Make a backup of the data
::WConfig::Colorize
}
proc ::WConfig::vcmd {row newVal} {
::WConfig::ColorizeRow $row $newVal
return 1
}
##+##########################################################################
#
# ::WConfig::ColorizeRow -- marks row w/ appropriate colorized tag
#
proc ::WConfig::ColorizeRow {row {newVal {}}} {
variable TableData
variable TableData_org
variable W
set default $TableData($row,1)
set before $TableData_org($row,2)
if {$newVal == {}} {
set now $TableData($row,2)
} else {
set now $newVal
}
set rval 0 ;# Assume no change
set ctag ncell ;# Tag for the cell
if {$row > 0} {
if {! [string equal $before $now]} { ;# Changed by WConfig
set ctag ccell
set rval 1
} elseif {! [string equal $default $now]} { ;# Changed from default
set ctag mcell
set rval 2
}
}
$W tag cell $ctag $row,2
return 1
}
##+##########################################################################
#
# ::WConfig::Colorize -- colorizes all the rows
#
proc ::WConfig::Colorize {} {
if {! [winfo exists $::WConfig::W]} return
for {set row 1} {$row < $::WConfig::rows} {incr row} {
::WConfig::ColorizeRow $row
}
}
##+##########################################################################
#
# ::WConfig::Apply -- updates the widget w/ either 1) the new values,
# 2) the default values or 3) reset values
#
proc ::WConfig::Apply {{how "apply"}} {
variable TableData ;# Used by Tktable
variable TableData_org ;# So we can reset
variable W
variable widget
set errs ""
set rows [llength [array names TableData *,2]]
for {set row 1} {$row < $rows} {incr row} {
if {$how == "apply"} {
set now $TableData($row,2)
} elseif {$how == "default"} {
set now $TableData($row,1)
} elseif {$how == "reset"} {
set now $TableData_org($row,2)
} else continue
if {$now == "{}"} {set now {}}
set optname $TableData($row,0)
set n [catch {$widget configure $optname $now} err]
if {$n} {
append errs " $optname: $err\n"
}
}
::WConfig::Refresh
if {$errs != ""} {
tk_messageBox -title "Widget Configure" -message "ERRORS:\n$errs"
}
}
proc ::WConfig::New {} {
variable new
variable widget
if {$new == $widget || ! [winfo exists $new]} return
::WConfig::go $new
}
##+##########################################################################
#
# ::WConfig::NewDrag -- handles clicking down on select button, the moving
# and releasing mouse on top of a different widget.
#
proc ::WConfig::NewDrag {x y} {
set w [winfo containing $x $y]
if {$w == ""} return
if {[string match "$::WConfig::TOP*" $w]} return ;# Skip ourselves
::WConfig::go $w
}
proc ::WConfig::Exit {} {
destroy $::WConfig::TOP
catch {namespace delete ::WConfig}
}
###########################
#
# Testing
#
pack [button .b -text MyButton -command [list puts "hi"]]
::WConfig::go .b