[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 '''. 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 [list ::WConfig::NewDrag %X %Y] entry $TOPB2.swidget -textvariable ::WConfig::new bind $TOPB2.swidget ::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 "[bind Table ];break" bind $W "[bind Table ];break" bind $W "[bind Table ];break" bind $W "[bind Table ];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 ====== [Category Debugging] | [Category GUI]