[http://mini.net/files/xmltree.jpg]
----
[Richard Suchenwirth] 2002-08-13 - Here is a quick shot of glueing together [tDOM] (which parses an XML document into a tree structure in memory) and [BWidgets]' Tree widget for display of the same. Still far from perfect, especially multi-line text portions come out ugly, but take it and play with it ;-)
----
 package require BWidget
 package require tdom

 proc recurseInsert {w node parent} {
    set name [$node nodeName]
    if {$name=="#text" || $name=="cdata"} {
	set text [$node nodeValue]
	set fill black
    } else {
	set text <$name
	foreach att [$node attributes] {
	    catch {append text " $att=\"[$node getAttribute $att]\""}
	}
	append text >
	set fill blue
    }
    $w insert end $parent $node -text $text -fill $fill
    foreach child [$node childNodes] {recurseInsert $w $child $node}
 }
 set            fp [open [file join [lindex $argv 0]]]
 set xml [read $fp]
 close         $fp

 dom parse  $xml doc
 $doc documentElement root

 Tree .t -yscrollcommand ".y set"
 scrollbar .y -ori vert -command ".t yview"
 pack .y  -side right -fill y
 pack .t -side right -fill both -expand 1

 after 5 recurseInsert .t $root root
----
The following variation is more compact, since it packs "simple" elements (with only one #text child) into one line:
----
[http://mini.net/files/xmltree2.jpg]
 package require BWidget
 package require tdom

 proc recurseInsert {w node parent} {
    set name [$node nodeName]
    set done 0
    if {$name=="#text" || $name=="#cdata"} {
	set text [string map {\n " "} [$node nodeValue]]
    } else {
	set text <$name
	foreach att [getAttributes $node] {
	    catch {append text " $att=\"[$node getAttribute $att]\""}
	}
	append text >
	set children [$node childNodes]
	if {[llength $children]==1 && [$children nodeName]=="#text"} {
	    append text [$children nodeValue] </$name>
	    set done 1
	}
    }
    $w insert end $parent $node -text $text
    if {$parent=="root"} {$w itemconfigure $node -open 1}
    if !$done {
	foreach child [$node childNodes] {
	    recurseInsert $w $child $node
	}
    }
 }
 proc getAttributes node {
    if {![catch {$node attributes} res]} {set res}
 }

 set            fp [open [file join [lindex $argv 0]]]
 fconfigure    $fp -encoding utf-8 
 set xml [read $fp]
 close         $fp

 dom parse  $xml doc
 $doc documentElement root

 Tree .t -yscrollcommand ".y set" -xscrollcommand ".x set" -padx 0
 scrollbar .x -ori hori -command ".t xview"
 scrollbar .y -ori vert -command ".t yview"
 grid .t .y  -sticky news
 grid .x    -sticky news
 grid rowconfig    . 0 -weight 1
 grid columnconfig . 0 -weight 1

 after 5 recurseInsert .t $root root
----
[Rolf Ade] Very nice work, Richard. Short, but nevertheless usefull. Unfortunately, this nice little viewer is only usable for small XML files. The problem is both the time, it needs, to fill all the nodes into the tree widget and the memory demand of the tree widget with lots of nodes. The following variant tries to do it a little bit better. It does not fill all the nodes into the tree widget at startup, but adds child nodes 'at demand'. Of course, if your XML document has nodes with thousands and thousands of child nodes, you'll be stuck again - then you simply hit the limits of a tcl-coded meta widget. I could think of ways around this limit - even ways without C code - but they are all definitely to the short code pieces, that are usual for the wiki.

 package require BWidget
 package require tdom
 
 proc insertNode {w parent node} {
     if {[$node nodeType] != "ELEMENT_NODE"} {
         # text, cdata, comment and PI nodes
         set text [string map {\n " "} [$node nodeValue]]
         set drawcross "auto"
     } else {
         set name "[$node nodeName]"
         set text "<$name"
         foreach att [getAttributes $node] {
             catch {append text " $att=\"[$node getAttribute $att]\""}
         }
         append text >
         if {![$node hasChildNodes]} {
             set drawcross "auto"
         } else {
             set children [$node childNodes]
             if {[llength $children]==1 && [$children nodeName]=="#text"} {
                 append text [$children nodeValue] </$name>
                 set drawcross "auto"
             } else {
                 set drawcross "allways"
             }
         }
     }
     $w insert end $parent $node -text $text -drawcross $drawcross
 }    
 
 proc getAttributes node {
     if {![catch {$node attributes} res]} {set res}
 }
 
 proc openClose {w node} {
     if {[$w itemcget $node -drawcross] == "allways"} {
         foreach child [$node childNodes] {
             insertNode $w $node $child
         }
         $w itemconfigure $node -drawcross "auto"
     }
 }    
 
 set fd [tDOM::xmlOpenFile [file join [lindex $argv 0]]]
 
 set doc [dom parse -channel $fd]
 close $fd
 $doc documentElement root
 
 Tree .t -yscrollcommand ".y set" -xscrollcommand ".x set" -padx 0 \
         -opencmd "openClose .t"
 
 scrollbar .x -ori hori -command ".t xview"
 scrollbar .y -ori vert -command ".t yview"
 grid .t .y  -sticky news
 grid .x    -sticky news
 grid rowconfig    . 0 -weight 1
 grid columnconfig . 0 -weight 1
 
 insertNode .t root $root
 # Show the childs of the root right after startup
 openClose .t $root


----
[Arts and crafts of Tcl-Tk programming]