RS - Soon to come: a packlet of routines for introspecting your Tcl/Tk interpreter. Here's just a starter... (note also the documentation format used with, but not requiring, htext).
namespace eval inspect {}set docu(inspect::value) { This routine searches all global variables (scalar or array) for the specified value. Returns the list of variable names whose value matches. }
proc inspect::value value {
set res {}
foreach i [info globals] {
upvar #0 $i name
if [array exists name] {
foreach j [array names name] {
if [string equal $name($j)$value] {
lappend res ${i}($j)
}
} elseif [string equal $name $value] {
lappend res $i
}
}
}LV have you ever seen tkinspect - lots of neat features relating to introspection...
See also the updated version of tkinspect: TixInspect
RS admits he never looked at tkinspect, and even less at Tix at all... and that the promise in the first sentence was never kept... but anyway, here's another little inspection tool that searches all defined procs for a given string:
proc xref string {
set res {}
foreach proc [info procs] {
if {[string first $string [info body $proc]]>=0} {lappend res $proc}
}
set res
}MJ - Inspect an XML string using Tk and tdom, call as inspect::xml $xml
namespace eval inspect {
proc xml {xml} {
package require Tk
package require tdom
set doc [dom parse $xml]
set tl [toplevel .$doc]
wm protocol $tl WM_DELETE_WINDOW [namespace code [list cleanup $doc $tl]]
ttk::panedwindow $tl.pane -orient horizontal
ttk::treeview $tl.tv -selectmode browse -show tree
bind $tl.tv <<TreeviewSelect>> [namespace code [list updateText $tl.txt %W]]
text $tl.txt
set struct [xmlStruct [$doc documentElement]]
addChildren $tl.tv {} [list $struct]
$tl.pane add $tl.tv -weight 1
$tl.pane add $tl.txt -weight 2
pack $tl.pane -expand 1 -fill both
}
proc cleanup {doc tl} {
$doc delete
destroy $tl
}
proc updateText {txt lv} {
set node [lindex [$lv selection] 0]
$txt delete 1.0 end
$txt insert end [$node asXML]
}
proc addChildren {lv parent struct} {
set index 0
foreach element $struct {
lassign $element name node children
$lv insert $parent $index -id $node -text $name
if {$children ne {}} {
addChildren $lv $node $children
}
incr index
}
}
proc xmlStruct {node} {
set name [$node nodeName]
if {$name eq "#text"} {
return {}
}
set result [list $name $node]
set nested {}
foreach child [$node childNodes] {
lappend nested [xmlStruct $child]
}
if {$nested ne {{}}} {
lappend result $nested
}
return $result
}
}