[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 [BWidget]'s 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 ;-) [WikiDbImage xmltree.jpg] The story continues with [StarDOM]. ---- ====== 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. Newlines are substituted by blanks, producing possibly very long lines, but that's what the x scrollbar was added for ;-) ---- [WikiDbImage 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] 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 useful. 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 would be all definitely not the short code pieces that are usual for the wiki. [Ro]: Maybe [TkTreeCtrl] (coded in C) or [Hugelist] (can do tree structure) can fix this problem. ---- ====== 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 [string map {\n " "} [$children nodeValue]] 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 } if {[$w parent $node] == "root"} { $w itemconfigure $node -open 1 ;# RS: added to auto-open } $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 ====== ---- On Windows, you might add the following [mousewheel] binding - note that .t.c is the real [canvas] underlying the Tree: ====== bind .t.c {%W yview scroll [expr {int(pow(%D/-120,3))}] units} ;# RS ====== ---- [MJ] - A version with simpletree (see [TkTreeCtrl]) is much faster. It performs quite acceptably with a 16 MB (!) [XML]-file. ====== package require simpletree 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 } set parent [$w add $parent $text] foreach child [$node childNodes] {recurseInsert $w $child $parent} } # without this line shutdown of the app takes very long (TkTreeCtrl cleanup maybe?) wm protocol . WM_DELETE_WINDOW {exit} set fp [open [file join [lindex $argv 0]]] dom parse -channel $fp doc close $fp $doc documentElement root simpletree .t pack .t -expand 1 -fill both after 5 recurseInsert .t $root root ====== ---- [RLE] Jan 30, 2011: A version of the second ("more compact") code above that uses the ttk::treeview widget instead of the BWidget tree: ====== package require tdom proc recurseInsert {w node parent} { set name [$node nodeName] set done 0 if {$name eq "#text" || $name eq "#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] eq "#text"} { append text [$children nodeValue] set done 1 } } $w insert $parent end -id $node -text $text if {$parent eq {}} {$w item $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 ttk::treeview .t -yscrollcommand ".y set" -xscrollcommand ".x set" 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 {}} ====== ---- Also see "[browser]". ---- '''[rattleCAD] - 2011-03-09 06:22:51''' "[simplify_SVG: path element ...]". using tdom and ttk::treeview, load svg-files, display xml as text and DOM, renders svg in a canvas <> A little XML parser | Arts and crafts of Tcl-Tk programming | XML | Application | File