Preprocessing of source code
----
# 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.

----
[[
[Category Application] | [Category Dev. Tools] | [Category File] | [Category String Processing]
]]