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 rootThe 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 ;-)
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 rootRolf 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]] </$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
}
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 $rootOn Windows, you might add the following mousewheel binding - note that .t.c is the real canvas underlying the Tree:
bind .t.c <MouseWheel> {%W yview scroll [expr {int(pow(%D/-120,3))}] units} ;# RSMJ - 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 rootRLE 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] </$name>
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 {}}WJG (20-Sep-12) The same script implemented using Gnocl.
#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
package require Gnocl
package require tdom
set fp [open [file join [lindex $argv 0]]]
set xml [read $fp]
close $fp
dom parse $xml doc
$doc documentElement root
proc recurseInsert {w node {parent {} } } {
set name [$node nodeName]
if {$name=="#text" || $name=="cdata"} {
set text [$node nodeValue]
} else {
set text <$name
foreach att [$node attributes] {
catch {append text " $att=\"[$node getAttribute $att]\""}
}
append text >
}
set value [$node nodeValue]
set parent [$w addEnd [lindex $parent 0] [list [list $text] ] ]
foreach n [$node childNodes] {
recurseInsert $w $n $parent
}
return $parent
}
set tree [gnocl::tree -headersVisible 0 -ruleHint 1 -treeLines 1 -types {string} -titles [list "1" ]]
gnocl::window -child $tree -setSize 0.25
recurseInsert $tree $rootAlso 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
