#!/bin/sh
#
# \
exec tclkit $0 "$(1+$@)"
package require starkit
::starkit::startup
lappend auto_path [file join $::starkit::topdir lib]
package require Tcl 8.4
package require Tk 8.4
#################################################################################
#
# XSLT Toy
#
# (c) 2003 Michael Schlenker <schlenk at physnet.uni-oldenburg.de>
#
# Use under BSD License
#
# A little multi XSLT processor demo in Tcl/Tk
#
# This script is a simple demonstration how to use the following XSLT Processors
# from Tcl/Tk to transform XML files via XSLT.
#
# It is written for use with tclkit or ActiveStates distro.
# You have to set your auto_path before sourcing it, so
# it can find tDOM or TclXSLT packages.
#
# The following processors can be used:
# InstantSaxon 6.5.2 (Windows only) (http://saxon.sourceforge.net/)
# Saxon 7.x (with java available) (http://saxon.sourceforge.net/)
# tDOM (http://www.tdom.org)
# TclXSLT (http://tclxml.sourceforge.net/tclxslt.html)
#
#################################################################################
############################################################
#
# Copy the saxon7.jar out of the starkit if it is included
# (not included here, get it from above link,
# it is searched in the dir the starkit is in.)
#
############################################################
proc copySaxon2Disk {} {
if {[auto_execok java] ne ""} {
if {![file exists [file join $::starkit::topdir .. saxon7.jar]]} {
catch {file copy [file join $::starkit::topdir saxon7.jar] [file join $::starkit::topdir .. saxon7.jar]}
}
}
}
############################################################
#
# Find XSLT processors we can get
#
############################################################
proc discoverProcessors {} {
global processors
set saxon [auto_execok saxon]
if {$saxon eq ""} {
set processors(saxon) 0
} else {
set processors(saxon) 1
}
set java [auto_execok java]
set processors(saxon7) 0
if {$java ne ""} {
if {[file exist [file join $::starkit::topdir .. saxon7.jar]]} {
set processors(saxon7) 1
}
}
if {[catch {package require tdom} msg]} {
set processors(tdom) 0
} else {
set processors(tdom) 1
}
if {[catch {package require xslt} msg]} {
set processors(libxslt) 0
} else {
set processors(libxslt) 1
}
}
####################################################################
#
# Start the actual processors
#
####################################################################
proc startXSLT {} {
if {$::inputfiles eq ""} {
tk_messageBox -type ok -icon error -message "No Input files"
return
}
# basically the next test is there because i was lazy, saxon has a command line option
# to use the stylesheet information from the xml document
#
if {$::usePI && ($::processor ne "saxon") && ($::processor ne "saxon7") } {
tk_messageBox -type ok -icon error \
-message "Embedded stylesheets are not supported for $::processor in this version."
return
}
if {!$::usePI && ($::stylesheet eq "")} {
tk_messageBox -type ok -icon error -message "No Stylesheet given"
return
}
foreach file $::inputfiles {
if {![file readable $file]} {
tk_messageBox -type ok -icon error -message "\"$file\" does not exist or unreadable."
return
}
}
if {!$::usePI && ![file readable $::stylesheet]} {
tk_messageBox -type ok -icon error -message "Stylsheet \"$:.stylesheet\" does not exist or is unreadable."
return
}
# Now simply call the selected processor
${::processor}XSLT $::inputfiles $::namechange $::stylesheet
}
proc saxonXSLT {files transform stylesheet} {
foreach file $files {
set outfile [slashify [file nativename [transformFilename $file $transform]]]
set file [slashify [file nativename $file]]
if {$::usePI} {
if {[catch {exec [auto_execok saxon] -a -w1 -o $outfile $file} msg]} {
set tag error
} else {
set tag std
}
set file [deslashify $file]
set outfile [deslashify $outfile]
logProgress $file $outfile
log $msg $tag
} else {
if {[catch {exec [auto_execok saxon] -w1 -o $outfile $file $::stylesheet} msg]} {
set tag error
} else {
set tag std
}
set file [deslashify $file]
set outfile [deslashify $outfile]
logProgress $file $outfile [file nativename $::stylesheet]
log $msg $tag
}
}
}
proc saxon7XSLT {files transform stylesheet} {
set saxonjar [slashify [file nativename [file join $::starkit::topdir .. saxon7.jar]]]
foreach file $files {
set outfile [slashify [file nativename [file normalize [transformFilename $file $transform]]]]
set file [slashify [file nativename $file]]
if {$::usePI} {
if {[catch {exec [auto_execok java] -jar $saxonjar -a -w1 -o $outfile $file} msg]} {
set tag error
} else {
set tag std
}
set file [deslashify $file]
set outfile [deslashify $outfile]
logProgress $file $outfile
log $msg $tag
} else {
if {[catch {exec [auto_execok java] -jar $saxonjar -w1 -o $outfile $file $stylesheet} msg]} {
set tag error
} else {
set tag std
}
set file [deslashify $file]
set outfile [deslashify $outfile]
logProgress $file $outfile [file nativename $stylesheet]
log $msg $tag
}
}
}
proc tdomXSLT {files transform stylesheet} {
if {!$::usePI} {
# use tDOM's xmlReadFile proc to read the stylesheet in the correct encoding
if {[catch {dom parse [::tDOM::xmlReadFile $stylesheet]} ssheet]} {
log "Error loading stylesheet \"$::stylesheet\":\n"
log $ssheet error
return
}
# try to compile XSLT stylesheet (since tdom 0.7.7)
if {[catch {$ssheet toXSLTcmd} compss]} {
log "Could not compile XSLT Command, probably old tdom version (< 0.7.7).\n"
set compiled 0
} else {
set compiled 1
}
}
foreach file $files {
set outfile [transformFilename $file $transform]
logProgress $file $outfile [file nativename $::stylesheet]
if {[catch {dom parse [::tDOM::xmlReadFile $file]} xml_parsed]} {
log "\n$xml_parsed" error
continue
}
if {!$::usePI} {
if {$compiled} {
# use tDOM's OO style xslt command for compiled stylesheets
if {[catch {$compss $xml_parsed} result]} {
log "\n$result" error
}
} else {
# use the traditional xslt subcommand of the doc for uncompiled stylesheets
if {[catch {$xml_parsed xslt $ssheet} result]} {
log "\n$result" error
}
}
}
set xml_doc [$result asXML]
writeResultFile $outfile $xml_doc
$xml_parsed delete
$result delete
# compiled stylesheets replace their stylesheet document object
# so we either destroy the compiled stylesheet object by rename or
# we delete the stylesheet document object
if {$compiled} {
rename $compss ""
} else {
$ssheet delete
}
}
}
proc libxsltXSLT {files transform stylesheet} {
if {!$::usePI} {
#precompile stylesheet
set fid [open $::stylesheet]
set style [read $fid]
close $fid
if {[catch {::dom::libxml2::parse $style} style_doc]} {
log "Error loading stylesheet: \"$::stylesheet\":\n"
log $style_doc error
return
}
if {[catch {::xslt::compile $style_doc} ssheet]} {
log "Error loading stylesheet \"$::stylesheet\":\n"
log $ssheet error
return
}
::dom::libxml2::destroy $style_doc
}
foreach file $files {
set outfile [transformFilename $file $transform]
logProgress $file $outfile [file nativename $::stylesheet]
set fid [open $file]
set xml_doc [read $fid]
close $fid
set xml_parsed [::dom::libxml2::parse $xml_doc]
if {!$::usePI} {
set result [$ssheet transform $xml_parsed]
::dom::libxml2::destroy $xml_parsed
}
set xml_doc [::dom::libxml2::serialize $result]
::dom::libxml2::destroy $result
writeResultFile $outfile $xml_doc
}
# clean up
rename $ssheet {}
}
#############################################################################
#
# Helper procs
#
#############################################################################
# the filename is transformed for the output
proc transformFilename {file transform} {
return "[file rootname $file].${transform}"
}
# helpers for exec to double backslashes
proc slashify {filename} {
string map {\\ \\\\} $filename
}
proc deslashify {filename} {
string map {\\\\ \\} $filename
}
# logging support
proc log {msg {tag std}} {
global logwidget
$logwidget insert end $msg $tag
}
proc writeResultFile {outfile data} {
# probably should inspect the result if an encoding other than utf-8
# is requested, but for now just write the result as utf-8
set fid [open $outfile w+]
fconfigure $fid -encoding utf-8
puts $fid $data
close $fid
}
proc logProgress {input output {stylesheet "PI in Inputfile"}} {
log "-----------------------------------------------\n"
log "Inputfile:\t$input\n"
log "Outputfile:\t$output\n"
log "Stylesheet :\t$stylesheet\n"
log "-----------------------------------------------\n"
}
proc get_inputfiles {} {
set files [tk_getOpenFile -title "Select XML files for conversion" -multiple 1\
-defaultextension .xml -filetypes {{{XML File} {.xml .XML}} {{All Files} *}}]
set ::inputfiles [list]
foreach file $files {
lappend ::inputfiles [file nativename $file]
}
}
proc get_stylesheet {} {
set files [tk_getOpenFile -title "Select XSL(T) Stylesheet" \
-defaultextension .xsl -filetypes {{{XSL Stylesheet} {.xsl .XSL .xslt .XSLT}} {{All Files} *}}]
set ::stylesheet $files
}
proc showWindow {} {
global processors
set ::processor "None selected"
set ::usePI 1
set ::namechange html
toplevel .gui
wm title .gui "XSLT Transformer"
label .gui.inputlabel -text "XML Input files"
entry .gui.input -width 50 -background white -textvariable ::inputfiles
button .gui.inputsearch -text "Browse" -command get_inputfiles
label .gui.styllabel -text "XSL(T) Stylesheet"
checkbutton .gui.stylcheck -text "Use embedded PI" -variable ::usePI -offvalue 0 -onvalue 1
entry .gui.stylesheet -background white -textvariable ::stylesheet
button .gui.stylesearch -text "Browse" -command get_stylesheet
label .gui.ext -text "NameChange"
frame .gui.exts
radiobutton .gui.exts.ext1 -text ".xml > .html" -variable ::namechange -value html
radiobutton .gui.exts.ext2 -text ".xml > .xhtml" -variable ::namechange -value xhtml
radiobutton .gui.exts.ext3 -text ".xml > .txt" -variable ::namechange -value txt
label .gui.proclabel -text "XSL(T) Processor"
menubutton .gui.processor -textvariable ::processor -menu .gui.processor.menu -relief raised -width 30
menu .gui.processor.menu
if {$processors(saxon)} { set state normal
} else { set state disabled
}
.gui.processor.menu add radiobutton -variable ::processor -label "Michael Kay's InstantSAXON 6.5.2" -value saxon -state $state
if {$processors(saxon7)} { set state normal
} else { set state disabled
}
.gui.processor.menu add radiobutton -variable ::processor -label "Michael Kay's SAXON 7.x" -value saxon7 -state $state
if {$processors(tdom)} { set state normal
} else { set state disabled
}
.gui.processor.menu add radiobutton -variable ::processor -label "Jochen Loewers tDOM" -value tdom -state $state
if {$processors(libxslt)} { set state normal
} else { set state disabled
}
.gui.processor.menu add radiobutton -variable ::processor -label "Gnome libxslt" -value libxslt -state $state
button .gui.process -text "Start" -command startXSLT
button .gui.log -text "Protocol" -command showLog
button .gui.end -text "Exit" -command exit
grid .gui.inputlabel -sticky w -padx 5 -pady 5
grid .gui.input -row 0 -columnspan 2 -column 1 -padx 5 -pady 5
grid .gui.inputsearch -row 0 -column 3 -padx 5 -pady 5
grid .gui.styllabel .gui.stylcheck .gui.stylesheet .gui.stylesearch -padx 5 -pady 5
grid configure .gui.styllabel -sticky w
grid configure .gui.stylcheck -sticky w
grid configure .gui.stylesheet -sticky ew
grid .gui.ext .gui.exts -sticky w -padx 5 -pady 5
grid configure .gui.exts -columnspan 3
grid .gui.exts.ext1 .gui.exts.ext2 .gui.exts.ext3 -sticky w
grid .gui.proclabel .gui.processor -sticky w -padx 5 -pady 5
grid configure .gui.processor -columnspan 2
grid .gui.process .gui.log .gui.end -sticky ew -padx 5 -pady 5
bind .gui <Return> startXSLT
wm protocol .gui WM_DELETE_WINDOW exit
}
proc showLog {} {
if {[lsearch [winfo children .] .log] ==-1} {
toplevel .log
} else {
wm deiconify .log
return
}
wm title .log "Protocol"
wm protocol .log WM_DELETE_WINDOW saveProtocol
text .log.text -background white -width 80 -height 40 \
-yscrollcommand ".log.yscroll set" -xscrollcommand ".log.xscroll set"
scrollbar .log.yscroll -command ".log.text yview" -orient vertical
scrollbar .log.xscroll -command ".log.text xview" -orient horizontal
frame .log.cmds
button .log.cmds.save -text "Save Log" -command "saveLog .log.text"
button .log.cmds.clear -text "Delete Log" -command ".log.text delete 1.0 end"
button .log.cmds.close -text "Close Window" -command "wm withdraw .log"
set ::logwidget .log.text
.log.text tag configure error -foreground red
.log.text tag configure std -foreground black
grid .log.text .log.yscroll -sticky news -padx 2 -pady 2
grid .log.xscroll -sticky ew
grid .log.cmds -columnspan 2 -sticky news -pady 10
grid .log.cmds.save .log.cmds.clear .log.cmds.close -sticky ew -padx 10
grid columnconfigure .log 0 -weight 1
grid columnconfigure .log 1 -weight 0
grid rowconfigure .log 0 -weight 1
grid rowconfigure .log 1 -weight 0
grid rowconfigure .log 2 -weight 0
}
proc saveProtocol {} {
wm withdraw .log
}
proc saveLog {w} {
set text [$w dump -text 1.0 end]
set file [tk_getSaveFile -title "Save Logfile as..."]
if {$file ne ""} {
set fid [open $file w+]
puts $fid $text
close $fid
}
}
# main
wm withdraw .
copySaxon2Disk
discoverProcessors
showLog
wm withdraw .log
showWindowLES on July 23 2004, 358 days after this page's last edit: this is a great little app. But it's sad that no one seems to be using it, because there is a tiny silly bug that prevents it from running at all: Inputfile:\t$inputn , in line 315, actually should be Inputfile:\t$input\n.schlenk your right, fixed it but why didn't you fix the code in place? Its a wiki after all. :-)
