# run.tcl
# Copyright 2001 by Larry Smith
# Wild Open Source, Inc
# For license terms GPL
#
# replacement for "source" but expands macros
# and allows a preprocessing pass for commands
# delimited by <<< and >>>. It even provides
# for "real" comments #...<eol> that are removed
# before processing.
proc run { filename { macrolist "" } } {
if { "$macrolist" != "" } {
upvar $macrolist macros
}
if [catch { set f [ open $filename r ] } err ] { return -code $err }
set src [ read $f ]
foreach key [array names macros] {
regsub -all -linestop $key $src $macros($key) src
}
set exp ""
while 1 {
if [regexp "(.*)(<<<.*>>>)(.*)" $src -> head exp tail] {
regsub <<< $exp "" exp
regsub >>> $exp "" exp
set result [ uplevel eval $exp ]
set src "$head$result$tail"
} else {
break
}
}
uplevel eval $src
}
# here's an example:
# source run.tcl
proc compute { args } {
set exp ""
set id ""
regsub "''" [ string trim $args ] "@@@" args
while 1 {
regexp "(\[^a-zA-Z_'\]*)(\[a-zA-Z0-9_'\]*)(.*)" $args -> head id tail
if ![ string length $id ] {
set exp "$exp$head"
break
}
set dollar ""
if ![ string equal [ string index $id 0 ] "'" ] {
if ![ string equal [info commands $id] "" ] {
set id "\[ $id"
regexp {[^\(]*\(([^\)]*)\)(.*)} $tail -> params tail
set tail " $params \]$tail"
} else { set dollar "\$" }
}
append exp "$head$dollar$id"
set args $tail
}
regsub -all "'" $exp "\"" exp
set map "@@@ ' and && or || not ! <> != true 1 false 0 on 1 off 0 yes 1 no 0 pi 3.1415926535"
foreach { from to } $map {
regsub $from $exp $to exp
}
set exp [ uplevel subst -novariable \{$exp\} ]
return "\{ $exp \}"
}
set xlate(IF) "if <<< compute "
set xlate(THEN) ">>> \{"
set xlate(ELSE) "\} else \{"
set xlate(ELSIF) "\} elseif \[ compute "
set xlate(END) "\}"
set xlate(WHILE) "while \{ \[ compute "
set xlate(DO) "\] \} \{"
set xlate(#.*\\n) "\\n"
run foo.tcl xlate
# foo.tcl is:
# This is a real comment
set x 1
IF x <> 1 THEN
puts "x is NOT 1"
ELSE
puts "x IS 1"
ENDif 0 {
results in: x IS 1
}