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. Supports multiple tree selection for viewing details of the xml and evaluating XPath expressions with automatic namespace prefixes.
namespace eval inspect {
proc xml {xml} {
package require Tk
package require tdom
# parse XML
set doc [dom parse $xml]
set nsprefixlist {}
foreach {item} [$doc selectNodes {//namespace::*}] {
lassign $item fullprefix uri
lassign [split $fullprefix :] _ prefix
lappend nsprefixlist $prefix $uri
}
# build ui
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 extended -show tree
bind $tl.tv <<TreeviewSelect>> [namespace code [list updateText $tl.txt %W]]
text $tl.txt
fillTree $tl.tv [list [$doc documentElement]]
$tl.pane add $tl.tv -weight 1
$tl.pane add $tl.txt -weight 2
entry $tl.entry
pack $tl.pane -expand 1 -fill both
pack $tl.entry -expand 1 -fill x
bind $tl.entry <Return> [namespace code [list evaluateXPath $doc $nsprefixlist %W $tl.tv]]
return $tl
}
proc evaluateXPath {doc nsprefixlist xpathWidget tv} {
set xpath [$xpathWidget get]
if {$xpath eq {} } {
set nodes [list [$doc documentElement]]
} else {
set nodes [$doc selectNodes -namespaces $nsprefixlist $xpath]
}
fillTree $tv $nodes
}
proc cleanup {doc tl} {
$doc delete
destroy $tl
}
proc fillTree {tv nodes} {
foreach item [$tv children {}] {
$tv detach $item
}
$tv selection remove [$tv selection]
if {[catch {addChildren $tv {} [lmap node $nodes {xmlStruct $node}]} result]} {
# Just add the text of the XPath result if it's not a list of nodes.
# Call it in a callback because the clearing of the selection will clear the txt view.
after 0 [list [winfo parent $tv].txt insert end [join $nodes \n]]
}
}
proc updateText {txt lv} {
$txt delete 1.0 end
foreach node [$lv selection] {
$txt insert end [$node asXML]
$txt insert end \n
}
}
proc addChildren {lv parent struct} {
set index 0
foreach element $struct {
lassign $element name node children
if [$lv exists $node] {
$lv move $node $parent $index
} else {
$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
}
}