Widget Configure

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

Category Debugging | Category GUI