package require Tk
package require snit
package require BWidget
option add *Label*relief raised
option add *Label*anchor w
option add *Label*justify left
option add *Label*activeForeground blue
snit::widget snitscope {
option -object
onconfigure -object value {
set options(-object) $value
set object $value
$self redraw
}
variable object
variable frame
method list {w label option} {
grid [label $w.$option-label -state active -text $label] - -sticky ew
foreach o [$object info $option] {
if {[array exists $o]} {
if {$option eq "vars" && [regexp {::options$} $o]} {
grid [label $w.$option-$o -text $o] \
[label $w.$option-$o-value -text {(see Options)}] -sticky ew
} else {
pack [frame $w.f] -fill both -expand yes
grid [label $w.$option-$o -text $o] \
[$self listArray $w.f $o] -sticky ew
}
} else {
if {$option eq "options"} {
set value [$object cget $o]
} else {
set value [set $o]
}
grid [label $w.$option-$o -text $o] \
[label $w.$option-$o-value -text $value] -sticky ew
}
}
}
method listArray {w a} {
foreach {k v} [array get $a] {
grid [label $w.k$k -text $k] [label $w.v$k -text $v] -sticky ew
}
return $w
}
method redraw {} {
set w $frame
eval destroy [winfo children $w]
foreach label {name type} value [list $object [$object info type]] {
grid [label $w.$label-label -state active -text [string totitle $label]] \
[label $w.$label-value -text $value] -sticky ew
}
$self list $w Options options
$self list $w {Instance variables} vars
$self list $w {Type variables} typevars
}
constructor args {
set sw [ScrolledWindow .sw]
set sf [ScrollableFrame $sw.sf]
$sw setwidget $sf
set frame [$sf getframe]
pack $sw -fill both -expand yes
$self configurelist $args
}
}
proc demo {} {
snitscope .sc
pack .sc -fill both -expand yes
.sc configure -object .sc
}