A little XML browser

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] </$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 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 $root

On 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} ;# 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] </$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 $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

Category XML

Category Application

Category File