Updated 2015-02-19 10:27:45 by PeterLewerin

Original code by Peter Lewerin (content disclaimer) some time in late 2003 probably, changes by [CyrilRoux] (added some categories to the page), RLE (fixed some strange typos), and Poor Yorick (fixed indentation) during PL's hiatus. Code substantially revised (no functionality changes, except that you no longer need to pack the snitscope widget yourself, and that it now does a basic check to see if it has actually been given a snit to work with) by Peter Lewerin in 2013-12-15.

A Snit object viewer, see Snit's not Incr Tcl. It displays the instance's name and type, and lists the options, instance variables, and type variables with name and value. Unset variables are listed, but their names are grayed out.

AK: This is IMHO a candidate for tklib now.

PL: Is it that generally useful?

LV Sure - tools which aid in programming/debugging and do a good job are generally useful.

TODO: There is still some unneccessary duplication of code in the showVariables and showTypevariables methods that I might take care of sometime.
package require Tk
package require snit

option add *background white

snit::widget snitPane {
    option -label
    option -command
    option -open 0
    onconfigure -open value {
        set options(-open) $value
        $self redraw
    }

    method open/close {} {
        $self configure -open [expr {![$self cget -open]}]
    }
    method setArrow {} {
        if {[info exists arrow]} {
            if {[$self cget -open]} {
                $arrow configure -image nav1downarrow16
            } else {
                $arrow configure -image nav1rightarrow16
            }
        }
    }
    method redraw {} {
        if {[info exists contents]} {
            if {[$self cget -open]} {
                grid x $contents -sticky ew
            } else {
                grid forget $contents
            }
        }
        $self setArrow
    }

    variable arrow
    variable contents

    constructor args {
        $self configurelist $args

        set arrow [button $win.arrow -anchor w -relief flat -width 20 -command [mymethod open/close]]
        label $win.label -anchor w -justify left -text [$self cget -label]
        set contents [frame $win.c]
        eval [$self cget -command] $contents
        grid $arrow $win.label -sticky ew
        grid columnconfigure $win 1 -weight 1
        $self redraw
    }
}

snit::widget snitscope {
    option -specimen

    method showOptions {w} {
        # set the qualified name of the snit's option name container
        set opts ${specimenNS}::options
        foreach o $specimenOpts {
            label $w.$o-name {*}$nameLabelOpts -text $o
            label $w.$o-value {*}$valueLabelOpts -textvariable [set opts]($o)
            grid $w.$o-name $w.$o-value -sticky news
            grid columnconfigure $w 1 -weight 1
        }
    }
    method showVariables {w} {
        foreach v $specimenVars {
            set varname [namespace tail $v]
            label $w.$varname-name {*}$nameLabelOpts -text $varname
            label $w.$varname-value {*}$valueLabelOpts
            if {[info exists $v]} {
                $w.$varname-value configure -textvariable $v
            } else {
                $w.$varname-name configure -fg gray50
            }
            grid $w.$varname-name $w.$varname-value -sticky news
            grid columnconfigure $w 1 -weight 1
        }
    }
    method showTypevariables {w} {
        foreach v $specimenTypeVars {
            set varname [namespace tail $v]
            label $w.$varname-name {*}$nameLabelOpts -text $varname
            label $w.$varname-value {*}$valueLabelOpts
            if {[info exists $v]} {
                $w.$varname-value configure -textvariable $v
            } else {
                $w.$varname-name configure -fg gray50
            }
            grid $w.$varname-name $w.$varname-value -sticky news
            grid columnconfigure $w 1 -weight 1
        }
    }

    variable specimen
    variable specimenOpts
    variable specimenVars
    variable specimenTypeVars
    variable specimenNS
    variable nameLabelOpts {-anchor w -padx 15 -font {helvetica 10 bold}}
    variable valueLabelOpts {-anchor w -relief sunken}

    constructor args {
        $self configurelist $args

        set specimen [$self cget -specimen]
        # did we get a snit at all?
        if {$specimen eq {}} {
            tk_messageBox -icon error -message "No snit provided"
            exit
        }
        # if it's a snit, it should be able to tell us its type
        if {[catch {$specimen info type} result]} {
            tk_messageBox -icon error -message "Not a snit? $result"
            exit
        }

        # now find out some details about the snit

        # does it have options?
        set specimenOpts [$specimen info options]

        # does it have instance variables?
        set specimenVars [$specimen info vars]

        # does it have type variables?
        set specimenTypeVars [$specimen info typevars]

        # if it has instance variables or options, we can know its namespace
        set specimenNS [if {[llength $specimenVars] > 0} {
            namespace qualifiers [lindex $specimenVars 0]
        }]

        # exclude the 'options' variable from the instance variables
        set specimenVars [lmap v $specimenVars {expr {[regexp {::options$} $v] ? [continue] : $v }}]

        set w [frame $win.heading]
        label $w.name -anchor w -font {helvetica 16 bold} -text $specimen
        label $w.class -anchor e -font {helvetica 14 italic} -text [$specimen info type]
        pack $w.name $w.class -expand yes -fill x -side left
        pack $w -expand yes -fill x

        snitPane $win.options -command [mymethod showOptions] -label Options -open true
        pack $win.options -expand yes -fill x
        snitPane $win.vars -command [mymethod showVariables] -label {Instance Variables}
        pack $win.vars -expand yes -fill x
        snitPane $win.tvars -command [mymethod showTypevariables] -label {Type Variables}
        pack $win.tvars -expand yes -fill x

        label $win.fill
        pack $win.fill -expand yes -fill both

        pack $win -expand yes -fill both -anchor nw
    }
}

image create photo nav1rightarrow16 -data {
    R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIdhI+pyxCt
    woNHTmpvy3rxnnwQh1mUI52o6rCu6hcAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ
    RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg
    cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
}

image create photo nav1downarrow16 -data {
    R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIYhI+py+0P
    UZi0zmTtypflV0VdRJbm6fgFACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJv
    IHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0
    cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
}

snit::type dog {
    option -breed mongrel
    option -color

    variable weight
    variable numLegs 4

    typevariable eats
    typevariable sound Woof!
}

dog Fido

snitscope .s -specimen Fido

after 1500 {Fido configure -color black}

Comments below this line refer to the 2004 version.

escargo 3 Jan 2004 - This new version of Snitscope no longer requires the BWidget tool kit. I did notice, after using wish-reaper to collect the code, that when running this code the variable weight and the typevariable eats are not displayed. This might be a Snit issue, since these variables might not yet exist, since they were declared but not assigned any values.

I also think the handling of the down and right arrow might not be handled the way you intended. When I click on an arrow, it does not change shape. The code provides two images, and there is some logic for selecting between them, but in fact the shape does not change. If they are supposed to change, then something is a little wrong somewhere.

PL: yes, undefined variables aren't displayed. Instance variables that haven't been assigned values don't even appear in the [$obj info vars] list. I'm still working (on and mostly off) on this, and I might do something clever about this some day: for now I just use this example to point out you won't see all that you get.

The arrow problem should be fixed now.

To think about:

  • Type variables can be listed even if they have no values; maybe I should include them in the viewer?
  • In theory, the snitscope could be used to edit option/variable values...

escargo 4 Jan 2003 - I noticed with this latest change that an uninitialized typevariable is listed (eats), but an unintialized instance variable (weight) is not. Is that due to a Snit limitation?

It might be appropriate to allow editing of variables only if the name begins with a lowercase letter (indicating a public, not private variable, at least according to the Tcl Style Guide). Or, perhaps when modifying such a private variable, an Are you sure? dialog box might be appropriate.

As an introspection mechanism this is very cool. I can see where another step along the same path might be useful: Serializing the values of a Snit type. (In a commercial application, sending the serialized values of objects over a network was a light-weight alternative to sending entire objects over a network. This required code for the objects to encode and decode serialized values, which had some limitations, but was very useful.)

Peter Lewerin (2004-01-03): the following comments were made on the previous version of the code.

escargo 8 Dec 2003 - The demo proc is defined, but never called in this code.

Peter Lewerin: yes, it's a "write-demo", not really a "run-demo".

Is defining a method named list a possible problem? Conceptually, it might clash with the normal Tcl list command.

PL: How? It's never used except as a subcommand to the object command. I use both in the internal code above. Anyway, the code is not very well-written, I should re-write it some time.

WHD: No, there's no problem defining methods or typemethods with the same name as standard Tcl commands. That's why the form "$self methodname" is used to call method "methodname" within another method.

escargo: I was not concerned with the software getting confused, only programmers. A too-casual reading of the source might lead to misunderstanding. (Or someone using grep or other searching tools might get a false hit looking for one list or the other.)

WHD: I can only speak for myself, of course, but I often find it convenient to have methods with names like "list" and "set", and in reading my own code after a lengthy interval I've not found it confusing--simply because the method name is never the first token in a command.