Updated 2008-02-12 17:27:52 by LV

This proc provides for preprocessing of source code before sourceing into a tcl interpreter.
# 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
 }

if 0 {
here's an example preprocessor:
}

 # 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"

if 0 {
Now to invoke a file using the new syntax just use:
}
 run foo.tcl xlate

if 0 {
Here's an example foo.tcl:
}

 # This is a real comment

 set x 1

 IF x <> 1 THEN
   puts "x is NOT 1"
 ELSE
   puts "x IS 1"
 END

if 0 {
This results in:
}

  x IS 1

AMG: Nifty.

Just a note... it's not strictly necessary to \-quote the braces inside your xlate(*) strings; they're already quoted by being between double quotes. Left bracket, on the other hand, requires a backslash when not quoted by braces.

Lars H: OTOH, it's typically still a good idea to \-escape braces, especially when they as here are heavily unbalanced. It's quite similar to the why can I not place unmatched braces in Tcl comments issue.

An alternative approach for macro processing of Tcl code is to replace proc and process each body separately. That is what Sugar does.