Simple XML report writer

This is a bit of code I (Neil Madden) wrote recently to parse an XML report write up into a Tk canvas display, and then produce postscript from it. It uses Iwidgets scrolledcanvas, but you can achieve the same with a normal canvas and a couple of scrollbars - I'm just lazy. Before I give the code, here is an example XML document in this report markup (it contains all the elements allowed). You could extend the system to easily add support for new elements, and generalize to allow any XML language.

NEM 2008-04-16: This code was originally written around 2001. Here is an updated one to use snit and tdom, which is a little better constructed. The basic processing model is the same as before.

OK - here's a sample doc:

 <?xml version="1.0"?>
     <title>XML to Tk Canvas</title>
     <heading1>1. First Section</heading1>
     <heading2>1.1 Sub section</heading2>
     <text>This is some text. Here is a
     <heading2>1.2 Lists</heading2>
      This is a list:
          <item>Item one</item>
          <item>The second item</item>

And here is the code:

# report.tcl -
#       Simple XML Report Writer:
#       Updated to correct bugs, show better style.

package require Tcl     8.5
package require Tk      8.5
package require tdom    0.8
package require snit    2.2

snit::widget XMLReport {
    hulltype toplevel

    component menu 
    component canvas 

    delegate option * to hull

    # XML parser
    variable parser
    # Stack used to hold current display state during parsing
    variable stack [list]
    # Current configuration dictionary
    variable config {
        width       18c
        offset      1.3
        font        {"Times New Roman" 12}
        indent      1.0
        anchor      nw
        justify     left
    variable nextline 1.5c
    # Currently open document
    variable document ""

    constructor {} {
        install menu using menu $win.mb
        install canvas using canvas $win.c \
            -width 21c -height 15c \
            -background white -state normal \
            -cursor xterm -xscrollcommand [list $win.hsb set] \
            -yscrollcommand [list $win.vsb set]
        scrollbar $win.hsb -orient horizontal -command [list $win.c xview]
        scrollbar $win.vsb -orient vertical   -command [list $win.c yview]

        # Basic menu
        $self configure -menu $menu
        menu $menu.file -tearoff 0
        $menu add cascade -label File -menu $menu.file
        $menu.file add command -label "Open..." -command [mymethod open]
        $menu.file add command -label "Export..." -command [mymethod export]
        $menu.file add separator
        $menu.file add command -label "Exit" -underline 1 -command exit

        # Layout
        grid $canvas $win.vsb -sticky nsew
        grid $win.hsb         -sticky ew
        grid rowconfigure $win 0 -weight 1
        grid columnconfigure $win 0 -weight 1

        # Set up XML parser
        set parser [xml::parser -elementstartcommand [mymethod StartTag] \
                                -elementendcommand   [mymethod EndTag] \
                                -characterdatacommand [mymethod CData]]

    # Open a report to display
    method open {} {
        set file [tk_getOpenFile -defaultextension xml \
                                 -filetypes {{"XML Files" .xml}} \
                                 -parent $win]
        if {$file eq ""} { return }

        $canvas delete all
        $parser reset
        # Let tDOM read the file to handle XML encoding correctly
        $parser parse [tDOM::xmlReadFile $file]

        set document [file normalize $file]
        wm title $win [file tail $document]
        if {[tk windowingsystem] eq "aqua"} {
            wm attributes $win -titlepath $document
        $canvas yview moveto 0

    # Export the file to postscript
    method export {} {
        set file [tk_getSaveFile \
            -parent $win \
            -defaultextension eps \
            -filetypes {{"Encapsulated PostScript Files" .eps}} \
            -initialfile [file tail [file rootname $document]].eps]

        if {$file eq ""} { return }

        # Generate the postscript output
        $canvas postscript -colormode gray \
                           -x 0 -y 0 -width 21c -height $nextline \
                           -pageheight 29.7c -pagewidth 21c \
                           -file $file

    method push {newconfig} {
        lappend stack $config
        set config [dict merge $config $newconfig]

    method pop {} {
        set config [lindex $stack end]
        set stack  [lreplace $stack end end]

    method document {} {}

    method title {} {
        $self push {
            indent      9
            anchor      center
            font        {Arial 30 bold}
            justify     center

    method heading1 {} {
        $self push {
            indent      0
            anchor      nw
            font        {Arial 12 bold}
            justify     left

    method heading2 {} {
        $self push {
            indent      0.4
            anchor      nw
            font        {Arial 10 bold}
            justify     left

    method text {} {
        $self push {
            indent      1
            anchor      nw
            font        {"Times New Roman" 12}
            justify     left

    method quote {} {
        $self push {
            indent      1.3
            anchor      nw
            font        {"Times New Roman" 12 italic}
            justify     left

    method list {} {
        $self push {
            indent      1.4

    method item {} {
        $self push {}
        set pos [expr {$nextline + 6}]
        $canvas create oval 2.4c $pos 2.3c [expr {$pos + 5}] -fill black

    method br {} {
        incr nextline 14

    method StartTag {tag attrs args} {
        $self $tag

    method CData text {
        if {[string length $text] < 3} { return }
        set ntext ""
        foreach line [split $text \n] {
            append ntext [string trim $line]\n
        set t [$canvas create text \
            [expr {[dict get $config indent] + [dict get $config offset]}]c \
            $nextline -width [dict get $config width] \
            -font [dict get $config font] \
            -anchor [dict get $config anchor] \
            -text [string trim $ntext]]
        set nextline [lindex [$canvas bbox $t] 3]

    method EndTag args {
        if {[lindex $args 0] ne "br"} {
            $self pop

wm withdraw .
XMLReport .xml

Have fun! NEM Rolf says that the above works with the SAX interface in tDOM with trivial alterations.

RFox asks if:

 list Stack

isn't just a fancy no-op and whether maybe you intended:

 set Stack [list]

As what's there just creates a list with an entry "Stack" and then destroys it:

 % list Stack
 % puts $Stack
 can't read "Stack": no such variable

NEM: Yes, that is incorrect, as is the code that does [list [array get ...]]] and then has to use join elsewhere... It works as lappend will auto-create the list as needed. In my defense, this code is ancient and written in a hurry!