[Arjen Markus] I took the script at the [starDOM] page and added menus and a little dialogue for editing ''existing'' attributes - I wanted this because it reduces the chance for errors.

It is not perfect yet:
   * Some work on the generated dialogue is needed (if you edit "DATA", you may want to have a proper text widget, not an entry widget at your disposal)
   * Checks are required to avoid inadvertent loss of work
   * Add the Gtk look for use on Linux/UNIX

----
    package require Tk
    package require BWidget
    package require tdom

    namespace eval ComboBox {#needed to extend BWidget functionality}
    proc ComboBox::enable {w what args} {
       switch -- $what {
           history {
               $w configure -values {{}} ;# always keep a blank on top
               foreach evt {<Return> <FocusOut>} {
                   $w bind $evt {+ ComboBox::_add %W [%W cget -text]}
               }
           }
           chooser {
               set values [$w cget -values]
               set width 0
               foreach i $values {
                   set sl [string length $i]
                   if {$sl > $width} {set width $sl}
               }
               set bg [[label .dummy] cget -bg]
               destroy .dummy
               $w setvalue first
               $w configure -width [expr {$width+1}]
               $w configure -editable 0 -relief flat -entrybg $bg
           }
       }
       if {$args != ""} {eval [list $w configure] $args}
    }
    proc ComboBox::_add {w item} {
       set w [winfo parent $w] ;# binding comes from entry
       set values [$w cget -values]
       if {[lsearch -exact $values $item] < 0} {
           $w configure -values [linsert $values 1 $item]
       }
    }
    namespace eval starDOM {
       set version 0.43
       set about "<about xmlns:foo=\"http://foo.bar/grill\">
             <!-- demo, self-test, rudimentary documentation -->
             <?Tcl toplevel .greeting; button .greeting.b -text \"Isn't it nice\" \
                     -command {destroy .greeting}; pack .greeting.b ?>
             <name       >starDOM</name>
             <version    >$version</version>
             <description lang=\"en\">A little XML browser - now equipped with a rather long description string to try out the popup feature</description>
             <uses>
               <pkg>Tk [package require Tk]</pkg>
               <pkg>BWidget [package require BWidget]</pkg>
               <pkg>tdom \[package require tdom\]</pkg>
             </uses>
             <authors foo:test=\"ok?\">
               <author>Rolf Ade</author>
               <author>Arjen Markus</author>
               <author>Richard Suchenwirth</author>
             </authors>
           </about>"

        namespace eval vars {
            # Private variables, when editing attributes
            variable save_node ""
        }
    }
    #------------------------------------------ PROCEDURE DIVISION.
    proc starDOM::attName att {
       if {[llength $att] != 3} {return $att}
       if {[lindex $att 2] == {}} {
          set attName "xmlns"
          if {[lindex $att 1] != {}} {
              append attName : [lindex $att 1]
          }
          return $attName
       } else {
          return [lindex $att 1]:[lindex $att 0]
       }
    }
    proc starDOM::Eval {query} {
       variable info
       catch {uplevel #0 $query} res ;# execute any Tcl command
       puts "% $query\n$res"
       if {[string length $res]>70} {set res [string range $res 0 69]...}
       set info $res
    }
    proc starDOM::formatNodeText {node} {
       switch [$node nodeType] {
           "ELEMENT_NODE" {
               set text "<[$node nodeName]"
               foreach att [$node attributes] {
                   if {[llength $att] == 3} { #(1)..
                       if {[lindex $att 2] == {}} {
                           set attName "xmlns"
                           if {[lindex $att 1] != {}} {
                               append attName ":[lindex $att 1]"
                           }
                       } else {
                           set attName "[lindex $att 1]:[lindex $att 0]"
                       }
                   } else {
                       set attName $att
                   } ;#..(1)
                   append text " $attName=\"[$node getAttribute $attName]\""
               }
               append text ">"
               if {[$node hasChildNodes]} {
                   set children [$node childNodes]
                   if {[llength $children]==1 && [$children nodeName]=="#text"} {
                       append text [string map {\n " "} [$children nodeValue]]
                   } else {
                       set drawcross "allways" ;# bad English, wanted by BWidget
                   }
               }
           }
           "TEXT_NODE" {
               set text [string map {\n " "} [$node nodeValue]]
           }
           "COMMENT_NODE" {
               set text "<!--[string map {\n " "} [$node nodeValue]]-->"
               set fill "grey50"
           }
           "PROCESSING_INSTRUCTION_NODE" {
               set text "<?[$node target] [string map {\n "" } [$node data]]?>"
               set fill "grey50"
           }
       }
       return $text
    }
    proc starDOM::insertNode {w parent node} {
       set drawcross "auto"
       set fill "black"
       set text [formatNodeText $node]
       switch [$node nodeType] {
           "ELEMENT_NODE" {
               set children [$node childNodes]
               if {[llength $children]!=1 || [$children nodeName]=="#text"} {
                   set drawcross "allways" ;# bad English, wanted by BWidget
               }
           }
           "COMMENT_NODE" -
           "PROCESSING_INSTRUCTION_NODE" {
               set fill "grey50"
           }
           default {
               set fill "black"
           }
       }
       $w insert end $parent $node -text $text -fill $fill -drawcross $drawcross
    }
    proc starDOM::nodeInfo {w node {prefix ""}} {
       variable info
       if {[info command $node]==""} return
       set info "$prefix$node: [$node toXPath]"
       append info " - [llength [$node childNodes]] child(ren)"
       catch {append info " - [string length [$node text]] text chars"}
    }
  # proc starDOM::nodeText {w node} {
  #    set text [$w itemcget n:$node -text]
  #    set w2 .[clock clicks]
  #    toplevel $w2
  #    wm title $w2 $node
  #    pack [text $w2.0 -width 50 -height 20 -wrap word -bg lightyellow]
  #    $w2.0 insert end $text
  # }

    proc starDOM::nodeText {w node} {
        if { $vars::save_node != "" } {
            raise .tnode
            return
        }

        set vars::save_node    $node

        $w itemconfigure $node -fill red

        set tag      [$node nodeName]

        #
        # Now create a toplevel window to edit the attribute values
        #
        toplevel .tnode
        frame    .tnode.f
        wm title .tnode "Attributes for: $tag"

        foreach att [$node attributes] {
            if {[llength $att] == 3} { #(1)..
                if {[lindex $att 2] == {}} {
                    set attrib "xmlns"
                    if {[lindex $att 1] != {}} {
                        append attrib ":[lindex $att 1]"
                    }
                } else {
                    set attrib "[lindex $att 1]:[lindex $att 0]"
                }
            } else {
                set attrib $att
            } ;#..(1)

            set vars::$attrib [$node getAttribute $attrib]
            label .tnode.f.l$attrib -text $attrib
            entry .tnode.f.e$attrib -textvariable ::starDOM::vars::$attrib
            grid  .tnode.f.l$attrib .tnode.f.e$attrib \
                -sticky nw -padx 3 -pady 2
        }

        set children [$node childNodes]
        if {[llength $children]==1 && [$children nodeName]=="#text"} {
           label .tnode.f.l_data -text "DATA:"
           entry .tnode.f.e_data -textvariable ::starDOM::vars::DATA
           grid  .tnode.f.l_data .tnode.f.e_data \
               -sticky nw -padx 3 -pady 2
           set vars::DATA [$children nodeValue]
        }

        button .tnode.ok     -text OK     \
            -command [list starDOM::closeNodeEdit $w 1] -width 6
        button .tnode.cancel -text Cancel \
            -command [list starDOM::closeNodeEdit $w 0] -width 6

        grid   .tnode.f -
        grid   .tnode.ok .tnode.cancel -padx 3 -pady 4
    }
    proc starDOM::closeNodeEdit {w save} {
       if { $save } {
           foreach att [$vars::save_node attributes] {
               if {[llength $att] == 3} { #(1)..
                   if {[lindex $att 2] == {}} {
                       set attrib "xmlns"
                       if {[lindex $att 1] != {}} {
                           append attrib ":[lindex $att 1]"
                       }
                   } else {
                       set attrib "[lindex $att 1]:[lindex $att 0]"
                   }
               } else {
                   set attrib $att
               } ;#..(1)
               $vars::save_node setAttribute $attrib [set vars::$attrib]
           }
           set children [$vars::save_node childNodes]
           if {[llength $children]==1 && [$children nodeName]=="#text"} {
              $children nodeValue [set vars::DATA]
           }
           # .t needed directly - $w is the canvas!
           .t itemconfigure $vars::save_node -text \
               [formatNodeText $vars::save_node]
       }

       destroy .tnode
       $w itemconfigure $vars::save_node -fill black
       set vars::save_node ""
    }
    proc starDOM::openCross {w {node ""}} {
       if {$node == ""} {set node [$w selection get]}
       if {[$w itemcget $node -drawcross] == "allways"} {
           foreach child [$node childNodes] {
               insertNode $w $node $child
           }
           $w itemconfigure $node -drawcross "auto"
       }
    }
    proc starDOM::openFile {w {filename ""}} {
       variable info
       if {$filename == ""} {
           set filename [tk_getOpenFile -filetypes {
             {{XML file} *.xml} {{HTML file} *.html} {{All files} *.*}}]
           }
       if {$filename != ""} {
           cd [file dir $filename] ;# so later opens will start here
           wm title . "$filename - starDOM"
           starDOM::showTree $w $filename
           set info "Loaded $filename - [file size $filename] bytes"
       }
    }
    proc starDOM::save {{filename ""}} {
       variable root; variable info
       if {$filename == ""} {set filename [lindex [wm title .] 0]}
       set filename [tk_getSaveFile -filetypes {
           {{XML file} *.xml} {{HTML file} *.html} {{All files} *.*}
           } -initialfile $filename -defaultextension .xml]
       if {$filename != ""} {
           set fp [open $filename w]
           $root asXML -channel $fp
           close $fp
           wm title . "$filename - starDOM"
           set info "Saved $filename - [file size $filename] bytes"
       }
    }
    proc starDOM::search {w} {
       variable mode; variable query; variable info;
       variable changed; variable next; variable root
       variable nodes
       if {$changed} {
           switch -- $mode {
               case   - case/all -
               XPath - XPath/all {
                   set q [expr {$mode=="case" || $mode == "case/all" ?
                       "descendant-or-self::text()\[contains(.,'$query')\]"
                       : $query}]
                   set t [time {set nodes [$root selectNodes $q]}]
               }
               nocase - nocase/all -
               regexp - regexp/all {
                   set nodes {}
                   if {$mode == "nocase" || $mode == "nocase/all"} {
                       set s [string tolower $query]
                       set cond {[string first $s [string tolo [$n nodeValue]]]>=0}
                   } else {
                       set cond {[regexp $query [$n nodeValue]]}
                   }
                   foreach n [$root selectNodes //text()] {
                       if $cond {lappend nodes $n}
                   }
               }
               eval {return [Eval $query]}
           }
           set changed 0
           set next [expr {[string first /all $mode] >= 0 ? -1: 0}]
       }
       if {[llength $nodes]} {
           showNode $w
       } else {set info "Not found."}
    }
    proc starDOM::showNode w {
       variable next; variable hilited; variable info; variable nodes
       foreach hinode $hilited {$w itemconfigure $hinode -fill black}
       set hilited {}
       set nrOfNodes [llength $nodes]
       if {$next == -1} {
           set nr 0; set nrmax [expr {$nrOfNodes - 1}]
       } else {
           set nr $next; set nrmax $next
           nodeInfo $w [lindex $nodes $nr] "[expr {$nr+1}]/$nrOfNodes - "
           if {($nr + 1) == $nrOfNodes} {
               set next 0
           } else {
               incr next
           }
       }
       while {$nr <= $nrmax} {
           set node [lindex $nodes $nr]
           if {$node==""} break
           foreach ancestor [$node selectNodes ancestor::*] {
               openCross $w $ancestor
           $w itemconfigure $ancestor -open 1
           }
           set parent [$node parentNode]
           set sibs [$parent childNodes]
               if {[llength $sibs]==1 && [$sibs nodeName]=="#text"} {
               set node $parent
           }
           $w itemconfigure $node -fill blue
           if {$next > -1} {$w see $node}
           lappend hilited $node
           incr nr
       }
    }
    proc starDOM::showTree {w string {isText 0}} {
       variable hilited {} root
       variable style
       raise [winfo toplevel $w]
       if {$root != ""} {
           [$root ownerDocument] delete
           set root "" ;# in case later parsing fails
       }
       $w delete [$w nodes root]
       $w selection clear
       if {!$isText && $style == ""} {
           set fd  [tDOM::xmlOpenFile $string]
           set doc [eval dom parse $style -channel $fd]
           close $fd
       } else {
           if {!$isText} {
               set fd [open $string]
               set string [read $fd]
               close $fd
           }
           set doc [eval dom parse $style [list $string]]
       }
       set root [$doc documentElement]
       insertNode $w root $root
       openCross $w $root   ;# Show children of root right after startup
       $w itemconfigure $root -open 1
    }
    proc starDOM::viewAbout {} {
       tk_messageBox -icon info -title starDOM -type ok -message \
 {starDOM:
 A simple XML file viewer/editor
 by Rolf Ade, Arjen Markus, and
 Richard Suchenwirth}
       destroy .vs
    }
    proc starDOM::closeWindow {} {
       # TODO: check if the contents have changed
       destroy .vs
    }
    proc starDOM::exitGUI {} {
       # TODO: check if this is really what the user wants
       destroy .
    }
    proc starDOM::viewSource {{fn ""}} {
       variable root
       if {$fn == ""} {set fn [lindex [wm title .] 0]}
       catch {destroy .vs}
       toplevel .vs
       wm title .vs "$fn - source"
       bind .vs <Control-space> {starDOM::showTree .t [.vs.t get 1.0 end] 1}
       text .vs.t -wrap word -yscrollcommand ".vs.y set"
       scrollbar .vs.y -ori vert -command ".vs.t yview"

       #
       # Set up the (simple) menu bar
       set  mw    .vs.menu
       menu       $mw
       menu       $mw.window  -tearoff false

       $mw add cascade -label Window -menu $mw.window

       .vs configure -menu $mw

       #
       # Set up the "Window" menu
       #
       $mw.window add command -label Save -underline 0 \
          -command {starDOM::showTree .t [.vs.t get 1.0 end] 1}
       $mw.window add separator
       $mw.window add command -label Close -underline 0 \
          -command {starDOM::closeWindow}

       pack .vs.y -side right -fill y
       pack .vs.t -fill both -expand 1
       if {[file exists $fn]} {
           set fp [open $fn]
           .vs.t insert 1.0 [read $fp]
           close $fp
       } elseif {$fn != "Untitled"} {.vs.t insert 1.0 [$root asXML]}
       if {0} {
           if {[.t selection get] != ""} {
               set node [.t selection get]
               set toPath [$node toXPath]
               dom setStoreLineColumn 1
               set tmpdoc [dom parse [.vs.t get 1.0 end]]
               dom setStoreLineColumn 0
               $tmpdoc documentElement tmproot
               set tmpnode [$tmproot selectNodes $toPath]
               set line [$tmpnode getLine]
               set col  [$tmpnode getColumn]
               $tmpdoc delete
               focus .vs.t
               .vs.t mark set insert $line.$col
               .vs.t see $line.$col
           }
       }
    }
    proc starDOM::UI {} {
       variable changed 0 mode "case" query "" info "" root "" style ""
       interp alias {} help {} DynamicHelp::register
       foreach i {file new open save} {
         set im($i) [image create photo \
           -file [file join $::BWIDGET::LIBRARY images $i.gif]]
       }

       #
       # Set up the (simple) menu bar
       set  mw    .menu
       menu       $mw
       menu       $mw.file  -tearoff false
       menu       $mw.edit  -tearoff false
       menu       $mw.help  -tearoff false

       $mw add cascade -label File   -menu $mw.file
       $mw add cascade -label Edit   -menu $mw.edit
       $mw add cascade -label Help   -menu $mw.help

       . configure -menu $mw

       #
       # Set up the "File" menu
       #
       $mw.file add command -label New -underline 0 \
           -command {starDOM::viewSource Untitled}
       $mw.file add command -label Open -underline 0 \
          -command {starDOM::openFile .t}
       $mw.file add separator
      # $mw.file add command -label Save -underline 0 \
      #    -command {starDOM::save}
        $mw.file add command -label "Save as ..." -underline 1 \
           -command {starDOM::save}
       $mw.file add separator
       $mw.file add command -label Exit -underline 1 \
          -command {starDOM::exitGUI}

       $mw.edit add command -label "Edit source" -underline 1 \
           -command {starDOM::viewSource}

       $mw.help add command -label "About ..." -underline 0 \
           -command {starDOM::viewAbout}

       frame  .f
       Button .f.new -image $im(new) -command {starDOM::viewSource Untitled} \
           -width 16
       help .f.new balloon "Create new XML document
           <Control-space> to parse"
       Button .f.open -image $im(open) -command {starDOM::openFile .t}
       help .f.open balloon "Open existing XML file"
       Button .f.view -image $im(file) -width 16 -command starDOM::viewSource
       help .f.view balloon "View document source
           <Control-space> to reparse after editing"
       Button .f.save -image $im(save) -command starDOM::save
       help .f.save balloon "Save current document to file"
       ComboBox .f.e -width 25 -textvariable starDOM::query
       .f.e enable history
       .f.e bind <Key>    {set starDOM::changed 1}
       .f.e bind <Return> {+ starDOM::search .t}
       help .f.e balloon "Enter search text/expression here.
           Hit <Return> to search (or eval).
           History: see pop-up, or use <Up>/<Down>"
       ComboBox .f.m -values {
           case case/all nocase nocase/all regexp regexp/all XPath XPath/all eval
           } -textvariable starDOM::mode
       .f.m enable chooser -relief ridge
       help .f.m balloon "Search mode (full text, except XPath)
           case:\tcase-sensitive
           nocase:\tcase-insensitive (A=a)
           regexp:\tregular expression
           XPath:\tDon't know? Don't bother!
           */all:\tthe same, all at once
           eval:\texecute Tcl command (to stdout)"
       ComboBox .f.style -values {{} -html -simple} \
           -textvariable starDOM::style
       .f.style enable chooser -relief ridge
       help .f.style balloon "Parsing style:
           (blank): regular = strict
           -html: tolerant for bad HTML
           -simple: fast, 7-bit only"
       eval pack [winfo children .f] -side left -fill y
       pack  .f.e -fill x -expand 1

       Tree .t -yscrollcommand ".y set" -xscrollcommand ".x set" -padx 0 \
               -opencmd "starDOM::openCross .t" -height 20
       bind .t <KeyPress-Right> "starDOM::openCross .t;Tree::_keynav right .t"
       .t bindText <1> {.t selection set}
       .t bindText <1> {+ starDOM::nodeInfo %W}
       .t bindText <Double-1> {starDOM::nodeText %W}
       scrollbar .x -ori hori -command ".t xview"
       scrollbar .y -ori vert -command ".t yview"
       Label .info -textvariable starDOM::info -anchor w -pady 0
       help .info balloon "Short info display
           3/5: 3rd of 5 instances highlighted
           Click on a node for its XPath and #children"
       grid .f   -  -sticky ew
       grid .t   .y -sticky news
       grid .x      -sticky news
       grid .info - -sticky ew
       grid rowconfig    . 1 -weight 1
       grid columnconfig . 0 -weight 1
       if {$::tcl_platform(platform)=="windows"} {
           catch {bind .t.c <MouseWheel> {
               %W yview scroll [expr {int(pow(%D/-120,3))}] units
           }}
           catch {focus .t.c}
       }
    }
    #---------------------------------------------------- "main"
    starDOM::UI
    set starDOM::info "Welcome to starDOM $starDOM::version!"
    if {[llength $argv] && [file exists [lindex $argv 0]]} {
       starDOM::showTree .t [lindex $argv 0]
    } else {
       starDOM::showTree .t $starDOM::about 1
    }
    bind . <Shift-Escape> {console show}
    bind . <Escape>       {exec wish $argv0 &; exit}
    trace variable starDOM::mode w {set starDOM::changed 1 ;#}

----
[jmn] 2004-09-30 
I found the presence of the #text data to the right of the nodes a little confusing seeing as it's duplicated once the node is opened.
Apply the following patch to make this text only appear to the right of a node when it's closed.
''[escargo] 26 Jul 2005'' - I tried to apply this patch (on [Cygwin] running on [Windows] XP Pro
Service Pack 2), but I got a "malformed patch at line 39: @@ -254,6 +261,11 @@" error message.
Could you be more explicit about how the patch was created and how it is supposed to be applied?

 --- stardom1.tcl	Thu Sep 30 06:27:31 2004
 +++ stardom2.tcl	Thu Sep 30 07:19:28 2004
 @@ -79,7 +79,7 @@
         if {[string length $res]>70} {set res [string range $res 0 69]...}
         set info $res
      }
 -    proc starDOM::formatNodeText {node} {
 +    proc starDOM::formatNodeText {node {isopen 0}} {
         switch [$node nodeType] {
             "ELEMENT_NODE" {
                 set text "<[$node nodeName]"
 @@ -102,7 +102,10 @@
                 if {[$node hasChildNodes]} {
                     set children [$node childNodes]
                     if {[llength $children]==1 && [$children nodeName]=="#text"} {
 -                       append text [string map {\n " "} [$children nodeValue]]
 +                       #show #text to right of closed node only
 +                       if {!$isopen} {
 +                           append text [string map {\n " "} [$children nodeValue]]
 +                       }
                     } else {
                         set drawcross "allways" ;# bad English, wanted by BWidget
                     }
 @@ -236,10 +239,14 @@
             set children [$vars::save_node childNodes]
             if {[llength $children]==1 && [$children nodeName]=="#text"} {
                $children nodeValue [set vars::DATA]
 +		  if {[llength [.t nodes $vars::save_node]]} {
 +                  .t itemconfigure [.t nodes $vars::save_node 0] -text [set vars::DATA]
 +              }
             }
            # .t needed directly - $w is the canvas!
 +	     set isopen [.t itemcget $vars::save_node -open]
             .t itemconfigure $vars::save_node -text \
 -               [formatNodeText $vars::save_node]
 +               [formatNodeText $vars::save_node $isopen]
         }
         destroy .tnode
 @@ -254,6 +261,11 @@
             }
             $w itemconfigure $node -drawcross "auto"
         }
 +      .t itemconfigure $node -text [formatNodeText $node 1]
 +    }
 +    proc starDOM::closeCross {w {node ""}} {
 +       if {$node == ""} {set node [$w selection get]}
 +       .t itemconfigure $node -text [formatNodeText $node]
      }
      proc starDOM::openFile {w {filename ""}} {
         variable info
 @@ -533,7 +545,7 @@
         pack  .f.e -fill x -expand 1
         Tree .t -yscrollcommand ".y set" -xscrollcommand ".x set" -padx 0 \
 -               -opencmd "starDOM::openCross .t" -height 20
 +               -opencmd "starDOM::openCross .t" -closecmd "starDOM::closeCross .t" -height 20
         bind .t <KeyPress-Right> "starDOM::openCross .t;Tree::_keynav right .t"
         .t bindText <1> {.t selection set}
         .t bindText <1> {+ starDOM::nodeInfo %W}
 

----


[[
[Category XML]
]]