---- [http://tkfp.sourceforge.net/XML_DOM_Tk_Text_Browser_Editor.gif] ---- [Alex Caldwell] ---- # XML-tDOM-Browser-Editor # May 18, 2004 # Alex Caldwell M.D. # alcald2000@yahoo.com # derived from xmlbrowser.tcl # by Richard Suchenwirth http://mini.net/tcl/3884 # modified to allow real time editing of the XML DOM in memory via events in the Tk text # widget. # It seems the text widget is a lot faster than the BWidget Tree. I personally find # the table-like layout in the Tk text widget with the color coding is easier to read # and find your data than the Tree widget. # Purpose: # to get some XML data, parse it into an XML DOM tree in memory, and then # map the DOM structure into an editable display in a Tk text widget. A sort of "Map" is # generated in the text widget using marks and tags that corresponds to elements and # attributes in the DOM structure. Event bindings are used so that any changes to the data # in the text widget are updated in the DOM memory structure in parallel in real time. # The modified DOM can then be dumped as XML to a file, sent to another part of the # application, transmitted over the network, etc. It currently dumps the modified DOM # as XML to the console when any change is made to the data. So start it from a console. # This is similar to domtext widget in Swish and Waxml by Steve Ball http://waxml.sourceforge.net # I was using a similar technique with SAX and mapping the XML elements and attributes with # Tk text widget marks and tags. The problem with the SAX method is that it's sort of one-way # SAX works good for mapping the XML data to the text widget display, but when you want to # reverse that, and go back to XML from the Tk text widget display, you have to write a unique # Tcl script to collect your data and convert it back to XML. So the SAX method is not # generalizable. Each change in the XML schema means you have to re-write your script. # With the DOM model it is automatic in both directions and more generalizable to any XML data. # To do: # wrap it up in a namespace as a Tcl package and make it behave as a proper Tk widget with # options etc like the domtext widget. #BWidget not required since we are going to use a Tk text widget #package require BWidget # we do need the tDOM package package require tdom proc recurseInsert {w node parent} { global colorlist color name tag_list foreach one $tag_list { global $one } set name [$node nodeName] set done 0 if {$name=="#text" || $name=="#cdata"} { set text [string map {\n " "} [$node nodeValue]] } else { set text <$name set lineno [lindex [split [$w index current] "."] 0] $w mark set begin$name$lineno [$w index current] $w mark gravity begin$name$lineno left $w insert end $text set text "" foreach att [getAttributes $node] { $w mark set begin$att$lineno [$w index current] $w mark gravity begin$att$lineno left catch {set text " $att=\"[$node getAttribute $att]\"" $w insert end $text } $w mark set end$att$lineno [$w index current] $w mark gravity end$att$lineno left $w tag add $att$lineno "begin$att$lineno + 1 char" end$att$lineno } # this tests if the option to insert a newline to format the display in the text # widget is turned on for this element if {[set $name] == "1"} { set text ">\n" } else { set text > } set children [$node childNodes] # I think this is a test to see if the child is a text node if {[llength $children]==1 && [$children nodeName]=="#text"} { # this tests if the option is turned on for that element to break the data display with # a newline on that element. # You can format the display in various ways depending on which elements you choose # to use newlines on in the Tk text widget. if {[set $name] == "1"} { append text "[$children nodeValue]\n\n" } else { append text "[$children nodeValue]" } set done 1 } } $w insert end "$text" $w mark set end$name$lineno [$w index current] $w mark gravity end$name$lineno left $w tag add $name$lineno begin$name$lineno end$name$lineno # update the DOM Tree and dump it as XML to the standard output. In application, you would save it # or use it somewhere else. Here it's just to monitor the changes to the DOM tree. $w tag bind $name$lineno " set new_text \[$w get begin$name$lineno end$name$lineno\] regsub \"<${name}(.*?)>\" \$new_text \{\} new_text regsub \"\" \$new_text \{\} new_text \[$node firstChild\] nodeValue \$new_text puts \"\[\$root asXML\]\" " $w tag configure $name$lineno -background $color($name) -relief raised -borderwidth 1 foreach att [getAttributes $node] { $w tag configure $att$lineno -relief sunken -background $color($att) -borderwidth 1 $w tag raise $att$lineno # Update DOM tree in memory and dump as XML to the standard output. In application, you would save it # or use it somewhere else. Here it's just to monitor the changes to the DOM tree. $w tag bind $att$lineno " set new_attribute \[$w get \"begin$att$lineno + 1 char\" end$att$lineno\] regsub -all \{\"\} \$new_attribute \{\} new_attribute set new_attribute \[split \$new_attribute \"=\"\] $node setAttribute \[lindex \$new_attribute 0\] \"\[lindex \$new_attribute 1\]\" puts \"\[\$root asXML\]\" " } if !$done { foreach child [$node childNodes] { recurseInsert $w $child $node } $w mark set startend[lindex [$node nodeName] 0]$lineno current $w mark gravity startend[lindex [$node nodeName] 0]$lineno left if {[set [lindex [$node nodeName] 0]] == "1"} { $w insert end "\n\n" } else { $w insert end "" } $w mark set end[lindex [$node nodeName] 0]$lineno [$w index current] $w mark gravity end[lindex [$node nodeName] 0]$lineno left $w tag add [lindex [$node nodeName] 0]$lineno startend[lindex [$node nodeName] 0]$lineno \ end[lindex [$node nodeName] 0]$lineno $w tag configure [lindex [$node nodeName] 0]$lineno -background $color([lindex [$node nodeName] 0]) \ -relief raised -borderwidth 1 } } proc getAttributes node { if {![catch {$node attributes} res]} {set res} } # this is for generating a list of the unique element names and attribute names # in your XML data. This will be used for mapping a unique color to the text # corresponding to that data in the Tk text widget. It makes an array called color # indexed by the element and attribute names, with a value of a color name for the display proc recurse_names {node} { global tag_list color colorlist foreach child [$node childNodes] { if {![regexp [$child nodeName] $tag_list] && [$child nodeName] != "#text" } { lappend tag_list [$child nodeName] set color([$child nodeName]) [lindex $colorlist [llength $tag_list]] if {[getAttributes $child] != ""} { set match "" if {![regexp [getAttributes $child] $tag_list match]} { lappend tag_list [getAttributes $child] set color([getAttributes $child]) [lindex $colorlist [llength $tag_list]] } if {$match != "" && ![string compare [getAttributes $child] $match]} { lappend tag_list [getAttributes $child] set color([getAttributes $child]) [lindex $colorlist [llength $tag_list]] } } recurse_names $child } } } # Check for an XML file from the command line. If none, present user with a # tk_getOpenFile dialog. if {[lindex $argv 0] == ""} { set fp [open [tk_getOpenFile]] } else { 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 # BWidget Tree not needed as we are using the Tk text widget #Tree .t -yscrollcommand ".y set" -xscrollcommand ".x set" -padx 0 menubutton .m -text "Options... Add newline to choice of XML tags to format display" -menu .m.menu -indicatoron true grid .m -sticky news menu .m.menu text .t -yscrollcommand ".y set" -xscrollcommand ".x set" -wrap none 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 # this is a map of the colors to use for the various attributes and elements # you want to display - needs to be at least as long as the no. of unique elements and attributes # in your XML data set colorlist [list white bisque red green lightblue yellow pink #E4D0EC orange #FF3F3F wheat\ peachpuff lightgrey olivedrab2 white ivory bisque pink yellow skyblue3] # set up a map of colors for each unique element or attribute set tag_list "" set color([$root nodeName]) [lindex $colorlist 0] lappend tag_list "[$root nodeName]" recurse_names $root # add menuitems representing the element names to the options menu foreach one $tag_list { .m.menu add checkbutton -label $one -variable $one -onvalue 1 -offvalue 0 } .m.menu add separator .m.menu add command -label "Save Options" -command { set f [open xmlbrowser.options w] foreach one $tag_list { puts $f "set $one [set $one]" } close $f } if {[catch {source ./xmlbrowser.options} res]} { toplevel .res label .res.label -text "No options file Available...\nSet and save options\nto format display." grid .res.label button .res.ok -text "OK" -command { destroy .res } grid .res.ok } after 5 recurseInsert .t $root root --- proc getAttributes node { if {![catch {$node attributes} res]} {set res} } # this is for generating a list of the unique element names and attribute names # in your XML data. This will be used for mapping a unique color to the text # corresponding to that data in the Tk text widget. It makes an array called color # indexed by the element and attribute names, with a value of a color name for the display proc recurse_names {node} { global tag_list color colorlist foreach child [$node childNodes] { if {![regexp [$child nodeName] $tag_list] && [$child nodeName] != "#text" } { lappend tag_list [$child nodeName] set color([$child nodeName]) [lindex $colorlist [llength $tag_list]] if {[getAttributes $child] != ""} { set match "" if {![regexp [getAttributes $child] $tag_list match]} { lappend tag_list [getAttributes $child] set color([getAttributes $child]) [lindex $colorlist [llength $tag_list]] } if {$match != "" && ![string compare [getAttributes $child] $match]} { lappend tag_list [getAttributes $child] set color([getAttributes $child]) [lindex $colorlist [llength $tag_list]] } } recurse_names $child } } } # Check for an XML file from the command line. If none, present user with a # tk_getOpenFile dialog. if {[lindex $argv 0] == ""} { set fp [open [tk_getOpenFile]] } else { 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 # BWidget Tree not needed as we are using the Tk text widget #Tree .t -yscrollcommand ".y set" -xscrollcommand ".x set" -padx 0 menubutton .m -text "Options... Add newline to choice of XML tags to format display" -menu .m.menu -indicatoron true grid .m -sticky news menu .m.menu text .t -yscrollcommand ".y set" -xscrollcommand ".x set" -wrap none 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 # this is a map of the colors to use for the various attributes and elements # you want to display - needs to be at least as long as the no. of unique elements and attributes # in your XML data set colorlist [list white bisque red green lightblue yellow pink #E4D0EC orange #FF3F3F wheat peachpuff \ lightgrey olivedrab2 white ivory bisque pink yellow skblue3] # set up a map of colors for each unique element or attribute set tag_list "" set color([$root nodeName]) [lindex $colorlist 0] lappend tag_list "[$root nodeName]" recurse_names $root # add menuitems representing the element names to the options menu foreach one $tag_list { .m.menu add checkbutton -label $one -variable $one -onvalue 1 -offvalue 0 } .m.menu add separator .m.menu add command -label "Save Options" -command { set f [open xmlbrowser.options w] foreach one $tag_list { puts $f "set $one [set $one]" } close $f } if {[catch {source ./xmlbrowser.options} res]} { toplevel .res label .res.label -text "No options file Available...\nSet and save options\nto format display." grid .res.label button .res.ok -text "OK" -command { destroy .res } grid .res.ok } after 5 recurseInsert .t $root root ---- Also see "[browser]". ---- [A little XML parser] | [Arts and crafts of Tcl-Tk programming] ---- [[ [Category XML] | [Category Application] | ]]