inspect

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 {title {}}} {
      return [xml::inspect $xml $title]
    }
    namespace eval xml {
      proc inspect {xml title} {
        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]]

        if {$title ne {}} {
          wm title $tl $title
        }

        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 {addNodes $tv {} $nodes } 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.
          puts stderr $result
          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 addNodes {tv parent nodes} {
        set index 0
        # puts stderr $parent-$nodes
        foreach node $nodes {
          set name [$node nodeName]
          if {$name eq "#text"} {
            continue
          }
          if [$tv exists $node] {
            $tv move $node $parent $index
          } else {
            $tv insert $parent $index -id $node -text $name
          }
          set children [$node childNodes]
          # puts stderr "Children -> $children"
          if {$children ne {}} {
            addNodes $tv $node $children 
          }
          incr index
        }
      }
    }
  }