[Peter Lewerin]

A Snit object viewer, see [Snit's not Incr Tcl].

[http://home.swipnet.se/pelewin/images/snitscope.gif]
----

 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 arrow
 	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 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.

I don't know why the arrow doesn't change for you, it does for me.  I'll have another look. [[...]] Ouch!  I changed '''arrow''' from instance to local variable, and didn't notice that side-effect.  Should work now.
----
[Category GUI] |
[Category Object Orientation] |
[Category Application]