- Added a Tcl template processing facility to SICS

tcl/tjxp

@@ -0,0 +1,73 @@
+#!/usr/bin/tclsh
+#----------------------------------------------------------------------
+# This is a Tcl template processor in the style of JSP tags. Unmarked 
+# text is left alone. But there is special markup:
+# <% script %> execute Tcl script and output result
+# <%=var%>     print The Tcl variable var
+# <%! script%> execute the script and print nothing
+#
+# copyright: GPL
+#
+# Mark Koennecke, November 2006
+#----------------------------------------------------------------------
+proc loadTemplate {input} {
+	return [read $input]	
+}
+#---------------------------------------------------------------------
+proc processScript {script} {
+	set startChar [string index $script 0]
+	if {[string equal $startChar =] == 1  } {
+		set varName [string trim [string range $script 1 end]]
+		set cmd [format "return \$%s" $varName]
+		return [uplevel #0 $cmd]
+        } elseif {[string equal $startChar !] == 1} {
+		set script [string range $script 1 end]
+		uplevel #0 $script
+        } else {
+		return [uplevel #0 $script]
+        }
+	return ""
+}
+#----------------------------------------------------------------------
+# process The template: read template from input, 
+# write to output channel
+#----------------------------------------------------------------------
+proc processTemplate {input output} {
+	set template [loadTemplate $input]
+	set current 0
+	set start [string first "<%" $template]
+	set end   [string first "%>" $template $start]
+	while {$start >= 0} {
+		if {$end < 0} {
+			error "Found start tag but no end in $template"
+                }
+		puts -nonewline $output [string range $template $current \
+			[expr $start -1]]
+		set script [string range $template [expr $start +2] \
+			[expr $end -1]]
+		set txt [processScript $script]
+		if {[string length $txt] >= 1} {
+			puts -nonewline $output $txt
+                }
+		set template [string range $template [expr $end +2] end]
+		set start [string first "<%" $template]
+		set end   [string first "%>" $template $start]
+		
+        }
+	puts -nonewline $output $template
+}
+#================ MAIN ================================================
+if {$argc < 2} {
+	puts stdout "Usage:\n\ttjxp infile outfile"
+        puts stdout "\t  Outfile can be - for stdout"
+	exit 1
+}
+set in [open [lindex $argv 0] r]
+set outfile [lindex $argv 1]
+if {[string equal [string trim $outfile] -] == 1} {
+	set out stdout
+} else {
+	set out [open $outfile w]
+}
+processTemplate $in $out
+exit 0