[EKB] I wrote this long before I knew about this wiki. It converts tags in a text canvas to and from XML (so you can write up an XML file, then load it into a text widget). It needs some work (such as entities and handling nested tags), but can do a few tricks, so I thought it was worth sharing.

The main file, ''xtt.tcl'':
======
    package require dom 2.0
    package require struct
    
    # xtt: The XML <--> Text Tag Translator
    # ver 1.0
    #
    # Copyright (c) 2003 Eric Kemp-Benedict
    # All Rights Reserved
    #
    # This code is freely distributable, but is provided as-is with
    # no waranty expressed or implied.
    #
    # Send comments to eric@kb-creative.net. If you make improvements,
    # please send them to me. I will give you credit and distribute the
    # improved code. Thanks!
    
    # == Description ==
    #
    # xtt offers an interface between a tk text widget's tags and
    # an XML document's tags.
    #
    # NOTE: It's pretty basic. In particular, it doesn't (yet) handle
    # nested tags or entities.
    #
    # To use it, just "source" xtt.tcl in your tcl script. Note
    # that xtt requires the dom and struct packages. Struct is
    # part of tcllib.
    #
    # Example:
    #
    # Step 1: Associate XML codes with text widget tags
    #
    #  set xtt::tagArray(i) italic      ;# "i" is the XML tag, "italic" is the text widget tag
    #  set xtt::tagArray(b) bold
    #  set xtt::tagArray(bi) boldital
    #  set xtt::tagArray(sup) super
    #  set xtt::tagArray(sub) sub
    #
    # Step 2: Specify a tag for a paragraph element (defaults to p, so this is optional)
    #
    #  set xtt::paraElem para
    #
    # Step 3: Start translating!
    #
    # From XML -> TextWidget
    #  xtt::XMLtoText .myTextWidget $parsedXMLdoc
    #
    # From Text Widget -> XML
    #  set XMLoutput [xtt::TextToXML .t]
    #
    # From Text Widget -> DOMnode
    #  set DOMnode [xtt::TextToDOM .t]
    #
    
    namespace eval xtt {
    
       #############################################
       ##
       ## Interface
       ##
       #############################################
    
       variable tagArray
       variable paraElem "p"
    
       proc XMLtoText {w DOMnode} {
          variable tagArray
          variable paraElem
    
          set paralist [dom::element getElementsByTagName $DOMnode $paraElem]
          foreach p [set $paralist] {
             xtt::expandNodes $w $p
             $w insert end "\n"
          }
       }
    
       proc TextToXML {w} {
          # NOTE: The stack is for future flexibility. At the moment nested tags are not
          # processed. In future versions I expect to process nested tags and that will
          # be easier with a stack.
    
          struct::stack tagStack
    
          set dump [$w dump -tag -text 1.0 end]
          set length [llength $dump]
    
          set retval "<p>"
    
          for {set i 0} {$i < $length} {incr i} {
             switch [lindex $dump $i] {
                text {
                   incr i
                   set retval $retval[lindex $dump $i]
                }
                tagon {
                   incr i
                   tagStack push [xtt::getTagCode [lindex $dump $i]]
                   set retval $retval<[tagStack peek]>
                }
                tagoff {
                   incr i
                   set retval $retval</[tagStack pop]>
                }
             }
          }
    
          set retval $retval</p>
    
          # Replace all newlines with "</p><p>"
          regsub -all -- "\\n" $retval "</p><p>" retval
    
          # Strip multiple newlines at the end
          regsub -- "(<p></p>)+$" $retval "" retval
    
          tagStack destroy
    
          return $retval
       }
    
       proc TextToDOM {w} {
          # Wrap the XML in a fake "document"
          set XMLtext "<document>[TextToXML $w]</document>"
    
          # Return the first child (which is all the contents)
          return [dom::node cget [dom::parse $XMLtext] -firstChild]
       }
    
       #############################################
       ##
       ## Supporting routines
       ##
       #############################################
    
       proc expandNodes {w paraNode} {
          variable tagArray
          variable paraElem
    
          set childList [dom::node children $paraNode]
          foreach child $childList {
             if {[dom::node cget $child -nodeType] != "textNode"} {
                # Recursively call expandNodes, to nest tags
                # Nested tags follow formatting rules for Tk text widget tags
                xtt::expandNodes $w $child
             }
             set type [dom::node cget [dom::node parent $child] -nodeName]
             set val [stripNewlines [dom::node cget $child -nodeValue]]
             if {$type == $paraElem} {
                $w insert end $val
             } else {
                $w insert end $val $tagArray($type)
             }
          }
    }
    
       proc stripNewlines {text} {
    
          # Loop through and remove any newlines from text. Replace with a space if adjacent characters are not spaces,
          #   or if not at beginning or end of string.
          while {[string first "\n" $text] != -1} {
             set newlinePos [string first "\n" $text]
             set charBefore [expr $newlinePos - 1]
             set charAfter [expr $newlinePos + 1]
             set alreadySpace false
             if {$newlinePos == 0 || $newlinePos == [expr [string length $text] - 1]} {set alreadySpace true}
             if {$newlinePos != 0} {
                if {[string range $text $charBefore $charBefore] == " "} {set alreadySpace true}
             }
             if {$newlinePos != [expr [string length $text] - 1]} {
                if {[string range $text $charAfter $charAfter] == " "} {set alreadySpace true}
             }
             if {$alreadySpace} {
                set replaceText ""
             } else {
                set replaceText " "
             }
             set text [string replace $text $newlinePos $newlinePos $replaceText]
          }
          return $text
       }
    
       proc getTagCode {code} {
          variable tagArray
    
          foreach name [array names tagArray] {
             if {$tagArray($name) == $code} {return $name}
          }
    
          error "Tag code does not exist"
       }
    
    
    }
======

A demo script:
======
    source "xtt.tcl"
    
    ##
    ## Set up the text widget
    ##
    set font(normal) "Times 12"
    set font(ital) "$font(normal) italic"
    set font(bold) "$font(normal) bold"
    set font(boldital) "$font(normal) bold italic"
    set font(small) "Times 8"
    
    text .t -font $font(normal) -wrap word -spacing3 18p -spacing2 6p -width 70 -height 10
    
    # Add the ".proc" window to look at the processed XML
    text .proc -font $font(normal) -wrap word -width 70 -height 10
    
    pack .t -fill both -expand yes -side top
    pack .proc -fill both -expand yes
    
    .t tag config italic -font $font(ital)
    .t tag config bold -font $font(bold)
    .t tag config boldital -font $font(boldital)
    .t tag config super -offset 6 -font $font(small)
    .t tag config sub -offset -6 -font $font(small)
    
    ##
    ## Load the xml source
    ##
    set xmlFile [open "TestDoc.xml" r]
    set document [read $xmlFile]
    close $xmlFile
    
    ##
    ## Process the xml source
    ##
    # Move from "document" down to the main node
    set parsedDoc [dom::node cget [dom::parse $document] -firstChild]
    
    ########################################################
    ##
    ## This is the interface between text widget and XML
    ##
    ########################################################
    
    ##
    ## Associate XML codes with text widget tags
    ##
    set xtt::tagArray(i) italic
    set xtt::tagArray(b) bold
    set xtt::tagArray(bi) boldital
    set xtt::tagArray(sup) super
    set xtt::tagArray(sub) sub
    
    xtt::XMLtoText .t $parsedDoc
    
    .proc insert end [xtt::TextToXML .t]
    
    ########################################################
    ##
    ## End of interface
    ##
    ########################################################
======
    

The sample file, ''TestDoc.xml'' used by the demo script:
    <body>
    <p>
    This is text, <i>this is italicized</i>, this is normal. Here's a subscript: CO<sub>2</sub>. The rest of the paragraph is pretty long,
    allowing it to be wrapped in the window. It just keeps going and going and there isn't much you can do about it. What would you do about it, anyway? Just make sure it wraps
    properly and also that any newlines in the XML file are properly
    stripped out before putting them in the text widget. Only text marked
    off with paragraph tags should receive newlines.
    </p>
    <p>
    This is another paragraph, with <b>bold</b> text in it. Later in this paragraph I will add some other
    special text, but first I want a long enough run of text that there may be some wrapping. Otherwise,
    I'm curious to see what a superscript<sup>1</sup> might look like.
    </p>
    <p>Unfortunately, xtt doesn't (yet) handle nested tags, so I have to
    make up a new tag to do <bi>bold italic</bi>. To have some bold text inside
    an italicized block, I have to do this: <i>This is </i><bi>so</bi> <i>italic!</i></p>
    </body>

======
if you prefer working with tdom replace these rows:
in xtt.tcl

line 1: package require tdom
line 70: set paralist [$DOMnode getElementsByTagName $paraElem]
line 71: foreach p $paralist {
line 124: return [dom parse $XMLtext]
line 137: set childList [$paraNode childNodes]
line 145: set type [[$child parentNode] nodeName]

in test.tcl
    set parsedDoc [dom  parse $document]

<<categories>> XML