Version 3 of A little XML browser

Updated 2002-08-13 16:12:35

---

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:

---

 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

---

Arts and crafts of Tcl-Tk programming