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. I'm considering implementing a Formatting Objects Processor FOP in Tcl, and when I do I'll write a proper TkCanvas driver for it so you can convert XML documents into TkCanvas displays using just XSLT/FOP.
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:
package require Tk
package require Iwidgets
package require xml
# Menus
menu .mb
. configure -menu .mb
menu .mb.file -tearoff 0
.mb add cascade -label File -menu .mb.file
.mb.file add command -label "Open" -command {openFile}
.mb.file add command -label "2EPS" -command {createPS}
iwidgets::scrolledcanvas .c -width 21c -height 15c
[.c childsite] configure -bg white -state normal -cursor xterm
pack .c -fill both -expand 1
update idletasks
set parser [xml::parser -elementstartcommand StartTag \
-elementendcommand EndTag \
-characterdatacommand CData]
list Stack
proc push {} {
global Stack options
lappend Stack [list [array get options]]
}
proc pop {} {
global Stack options
array set options [join [lindex $Stack end]]
set Stack [lreplace $Stack end end]
}
set nextline 1.5c
array set options {
width 18c
offset 1.3
font {{Times New Roman} 12}
indent 1.0
anchor nw
justify left
}
proc Title {} {
global options
push
array set options {
indent 9
anchor center
font {Arial 30 bold}
justify center
}
}
proc Heading1 {} {
global options
push
array set options {
indent 0
anchor nw
font {Arial 12 bold}
justify left
}
}
proc Heading2 {} {
global options
push
array set options {
indent 0.4
anchor nw
font {Arial 10 bold}
justify left
}
}
proc Default {} {
global options
push
array set options {
indent 1
anchor nw
font {{Times New Roman} 12}
justify left
}
}
proc Quote {} {
global options
push
array set options {
indent 1.3
anchor nw
font {{Times New Roman} 12 italic}
justify left
}
}
proc List {} {
global options
push
array set options {
indent 1.4
}
}
proc Item {} {
push
global nextline
set position [expr {$nextline + 6}]
.c create oval 2.4c $position 2.3c [expr {$position + 5}] -fill black
}
proc br {} {
global nextline
incr nextline 14
}
proc StartTag {tag attrs args} {
switch -exact -- $tag {
document { # Do nothing }
title {Title}
heading1 {Heading1}
heading2 {Heading2}
text {Default}
quote {Quote}
list {List}
item {Item}
br {br}
default {puts "Unknown tag: $tag"}
}
}
proc CData {text} {
if {[string length $text]<3} {return}
global options nextline
set ntext ""
foreach line [split $text \n] {
append ntext [string trim $line]\n
}
set t [.c create text [expr {$options(indent) + $options(offset)}]c\
$nextline -width $options(width)\
-font $options(font) -anchor $options(anchor)\
-text [string trim $ntext]]
update idletasks
set nextline [lindex [.c bbox $t] 3]
}
proc EndTag {args} {
if {[lindex $args 0] != "br"} {
pop
}
}
proc openFile {} {
global parser env options nextline Stack
set filename [tk_getOpenFile -defaultextension xml \
-filetypes {{{XML Files} .xml}} \
-initialdir $env(HOME) \
-initialfile input.xml]
if {$filename == ""} {return}
.c delete all
set fid [open $filename]
set xml [read $fid]
close $fid
$parser parse $xml
# Bug fix by Rolf Ade:
$parser reset
.c yview moveto 0
}
proc createPS {} {
global nextline env
set ps [.c postscript -colormode gray \
-x 0 -y 0 -width 21c -height $nextline \
-pageheight 29.7c -pagewidth 21c]
set filename [tk_getSaveFile -defaultextension eps \
-filetypes {{{Encapsulated PostScript files} .ps}} \
-initialdir $env(HOME) \
-initialfile output.eps]
if {$filename == ""} {return}
set fid [open $filename w]
puts $fid $ps
close $fid
update idletasks
}
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 Stack % puts $Stack can't read "Stack": no such variable %
[ Category XML | Category Application | ]