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"?>
<document>
<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
<quote>quote</quote>
</text>
<heading2>1.2 Lists</heading2>
<text>
This is a list:
<list>
<item>Item one</item>
<item>The second item</item>
</list>
</text>
</document>And here is the code:
# report.tcl -
#
# Simple XML Report Writer: https://wiki.tcl-lang.org/2741
# 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 .xmlHave 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 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!