#
# tmg.tcl - a very small macroprocessor in TCL
#
# The syntax is a bit stricter than the older TMG, in particular
# @$! must occur in the first column. See the wiki for a description.
#
# performance is not too bad, e.g.
# to process 5712 lines, 174819 bytes using tkCanvas.c is around 24ms
# on an old laptop. 
#
# Copyright (c) 2020, Phil Maker
# 
# No rights reserved.
#

package provide tmg 0.1

proc tmg {s filename} {
  set prog {}
  set ::_out {}

  set lines [split $s \n]
  set nlines [llength $lines]
  set lineno 0
  set default_first "="
  
  foreach line $lines {
    incr lineno
    
    if {$lineno < $nlines} {
      set sep "\\n"
    } else {
      set sep ""
    }
    
    set first [string index $line 0] ;# a command character or not
    set rest [string range $line 1 end]

    if {$first eq "="} {
      set default_first [string range $line 1 1]
    } elseif {$default_first eq "@"} { ;# plain old code
      append prog $line \n
    } elseif {$default_first eq "$"} { ;# $ only
      append prog "append _out \[subst -nocommands -nobackslashes [list $line]\] $sep" \n
    } elseif {$default_first eq "!"} { 
      append prog "append _out \[subst [list $rest]\] $sep" \n
    } elseif {$first eq "@"} {
      append prog $rest \n
    } elseif {$first eq "$" || $default_first eq "$"} { ;# $ subst only
      append prog "append _out \[subst -nocommands -nobackslashes [list $rest]\] $sep" \n
    } elseif {$first eq "!" || $default_first eq "!"} { ;# $ and commands
      append prog "append _out \[subst [list $rest]\] $sep" \n
    } else {                                            ;# literal
      append prog "append _out [list $line] $sep" \n
    }
  }

  # TODO: maybe add in frink style checking or tclCheck

  if {[catch [list uplevel #0 $prog] r opt]} {
    array set a $opt
    set lineno $a(-errorline)
    if {0} {
      puts stderr $prog 
      puts stderr "$$$"
    }
    %failed "tmg failed with error $r at $filename:$lineno [_file_line $filename $lineno]"
    return ""
  } else {
    return $r
  }
}