[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 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.
----
[Category GUI] |
[Category Object Orientation] |
[Category Application]