Version 16 of Snitscope
Updated 2004-01-03 21:52:39A Snit object viewer, see Snit's not Incr Tcl.
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
}
variable image [list nav1rightarrow16 nav1downarrow16]
variable contents
method toggleState {} {
if {[$self cget -open]} {
$self configure -open 0
} else {
$self configure -open 1
}
$self redraw
}
method redraw {} {
if {![info exists contents]} return
if {[$self cget -open]} {
grid x $contents -sticky ew
} else {
grid forget $contents
}
if {[info exists arrow]} {
if {[$self cget -open]} {
$arrow configure -image [lindex $image 1]
} else {
$arrow configure -image [lindex $image 0]
}
}
}
constructor args {
$self configurelist $args
set arrow [button $win.arrow -anchor w -relief flat -width 20 \
-image [lindex $image 0] -command [mymethod toggleState]]
set label [label $win.label -anchor w -justify left -text [$self cget -label]]
set contents [frame $win.c]
eval [$self cget -command] $contents
grid $arrow $label -sticky ew
grid columnconfigure $win 1 -weight 1
$self redraw
}
}
snit::widget snitscope {
option -specimen
method setname {{value {}}} {
if {$value eq {}} {
if {[$self cget -specimen] eq {}} {
return
} else {
set value [$self cget -specimen]
}
}
$win.heading.name configure -text $value
}
method setclass {{value {}}} {
if {$value eq {}} {
if {[$self cget -specimen] eq {}} {
return
} else {
set value [$self cget -specimen]
}
}
$win.heading.class configure -text [$value info type]
}
method showOptions {w} {
set object [$self cget -specimen]
foreach o [$object info vars] {
if {[regexp {::options$} $o]} {
set opts $o
}
}
foreach o [$object info options] {
grid [label $w.$o -anchor w -text $o -padx 15 -font {helvetica 10 bold}] \
[label $w.$o-value -anchor w -textvariable [set opts]($o) -relief sunken] -sticky news
grid columnconfigure $w 1 -weight 1
}
}
method showVariables {w} {
set object [$self cget -specimen]
foreach o [$object info vars] {
if {[regexp {::options$} $o]} continue
if {[array exists $o]} {
} else {
grid [label $w.$o -anchor w -text $o -padx 15 -font {helvetica 10 bold}] \
[label $w.$o-value -anchor w -textvariable $o -relief sunken] -sticky news
}
grid columnconfigure $w 1 -weight 1
}
}
method showTypevariables {w} {
set object [$self cget -specimen]
foreach o [$object info typevars] {
if {![info exists $o]} continue
if {[array exists $o]} {
} else {
grid [label $w.$o -anchor w -text $o -padx 15 -font {helvetica 10 bold}] \
[label $w.$o-value -anchor w -textvariable $o -relief sunken] -sticky news
}
grid columnconfigure $w 1 -weight 1
}
}
variable name
variable class
variable optionsPane
variable variablesPane
variable typevariablesPane
constructor args {
$self configurelist $args
set w [frame $win.heading]
set name [label $w.name -anchor w -font {helvetica 16 bold}]
set class [label $w.class -anchor e -font {helvetica 14 italic}]
pack $name $class -expand yes -fill both -side left
pack $w -expand yes -fill x
set optionsPane [snitPane $win.options -command [mymethod showOptions] -label Options -open true]
pack $win.options -expand yes -fill x
set variablesPane [snitPane $win.vars -command [mymethod showVariables] -label Variables]
pack $win.vars -expand yes -fill x
set typevariablesPane [snitPane $win.tvars -command [mymethod showTypevariables] -label {Type Variables}]
pack $win.tvars -expand yes -fill x
$self setname
$self setclass
}
}
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
pack .s -expand yes -fill x -anchor nw
after 1500 {Fido configure -color black}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.
escargo 3 Jan 2003 - 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.
Category GUI | Category Object Orientation | Category Application