# run.tcl # Copyright 2001 by Larry Smith # Wild Open Source, Inc # For license terms see "COPYING" # # replacement for "source" but expands macros # and allows a preprocessing pass for commands # delimited by <<< and >>>
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 $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
}
}puts $src
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) "\] \} \{"
run foo.tcl xlate
# foo.tcl is:
set x 1
IF x <> 1 THEN
puts "x is NOT 1"
ELSE
puts "x IS 1"
END