Simple templating routine (Tcl recipe) by Chui Tey

ActiveState Code (http://code.activestate.com/recipes/66450/)

#---------------------------------------------------------------------------
# 
# adp_compile --
#
# Parameters:
#     sourcetype -source|-filename
#     source 
# Returns:
#     Code to generate templated output
#
#---------------------------------------------------------------------------
proc adp_compile {sourcetype source} {

  # process parameters
  switch -exact -- $sourcetype {
    -source   { 
              set contents $source
              }

    -filename {
              
              set fileid [open $source r]
              set contents [read $fileid]
              close $fileid
              }
 
    default  { 
              return 
              }
  } 

  # really simple logic. 
  # 1. look for <%  %>
  # 2.   dump out contents preceeding <%
  # 3.   script contents preceeding %>
  # 4. repeat until run out of <% %> pairs
  # 5. dump contents after the last %> found.

  set outbuf {}

  set position 0
  set pstart [string first <% $contents $position]
  set pend   [string first %> $contents $pstart]

  while {[expr $pstart != -1 && $pend != -1 && $pstart < $pend]} {
     
      # Prevent script from adding unexpected blank lines to output:
      # if script is on a stand-alone line then 
      # don't add a newline to output
      set last_newline [string last \n $contents $pstart]
      zdebug "position=$position last_newline=$last_newline pstart=$pstart pend=$pend"
      if {[expr $last_newline != -1]} {
          set first_chars [string range $contents $last_newline [expr $pstart-1]]
          set last_char [string index $contents [expr $pend + 2]]      
          if {[string equal $last_char \n] && [string is space $first_chars]} {
              #
              # Replace <% %> tags with spaces
              #
              set contents [string replace $contents $pstart [expr $pstart + 1] {  }]
              set contents [string replace $contents $pend   [expr $pend   + 1] {  }]
              set pstart $last_newline+1
              incr pend
          }
      }

      # dump out contents preceeding <%
      adp_dump [string range $contents $position [expr $pstart-1]]

      # script out contents within the <% %>
      adp_script [string range $contents [expr $pstart+2] [expr $pend-1]]

      # if the next character is \n chomp it
      #if {[string equal [string index $contents [expr $pend + 2]] \n]} {
      #   incr pend 1 
      #}

      # search again
      set position [expr $pend + 2]
      set pstart [string first <% $contents $position]
      set pend   [string first %> $contents $pstart]
     
  }

  # dump out contents after %>
  adp_dump [string range $contents [expr $position] end]

  # insert pre and post conditions
  set precond "set __adp_output {}\n"
  set postcond ""
  set final ""
  append final $precond
  append final $outbuf
  append final $postcond
  return $final
}

#---------------------------------------------------------------------------
#
# adp_dump --
#
# Remarks:
#    generate code to output text to the output buffer
#
#---------------------------------------------------------------------------
proc adp_dump { text } {
  upvar outbuf outbuf

  # Protect double quotes, dollar signs, escapes
  regsub -all {[\]\[""\\$]} $text {\\&} quoted
  append outbuf "append __adp_output \"$quoted\""
}

#---------------------------------------------------------------------------
# 
# adp_eval --
#
# Parameters:
#     sourcetype -source|-filename
#     source 
#
# Returns:
#     Templated output
#
#---------------------------------------------------------------------------

proc adp_eval { sourcetype source } {

  set code [adp_compile $sourcetype $source]
  return [eval $code] 
}

#---------------------------------------------------------------------------
#
# adp_script --
#
# Remarks:
#   if <%= > tag, print the contents
#   else, dumps as tcl source
#
#---------------------------------------------------------------------------

proc adp_script { script } {

  # Protect double quotes, dollar signs, escapes
  # regsub -all {[\]\[""\\$]} $text {\\&} quoted

  upvar outbuf outbuf
  if {[string equal [string index $script 0] =]} {
     #
     # first character is equal sign:
     # handle the remainder as an expression
     #
     append outbuf "\n"
     set script [string range $script 1 end]
     append outbuf "append __adp_output $script"
     append outbuf "\n"
  } else {
     append outbuf "\n"
     append outbuf "  $script"
     append outbuf "\n"
  }
}

proc zdebug text { 
 #puts $text
}

#---------------------------------------------------------------------------
# 
#  test --
#
#  Remarks:
#     demonstration
#
#---------------------------------------------------------------------------

proc test {} {

  # If you have testhello.adp in current directory
  # set code [adp_compile -filename testhello.adp]
 
  set source [testprepare]
  set code [adp_compile -source $source]

  puts "--------------------------------------------"
  puts "The source"
  puts "--------------------------------------------"
  puts $source
  puts "--------------------------------------------"
  puts "The code generated"
  puts "--------------------------------------------"
  puts $code
  puts "--------------------------------------------"
  puts  "The result"
  puts "--------------------------------------------"
  eval $code
  puts $__adp_output
}

proc testprepare {} {

  return "
<html>
  <body>
    <h2>Hello World</h2>
       <% set name \"Peter\" %>
       Hello <%=\$name%> <br>
       Goodbye <%=\$name%>

       <% set mylist \[list Tom Dick Harry\]
          foreach name \$mylist {%>
          <p>Welcome <%=\$name%></p>
       <% }%>

       <a href=\"logoff\">log off</a>

  </body>
</html> "
}

# 1. Straight test --
#  test

# 2. Test for incorporation into subroutine
#  set source [testprepare]
#  set code [adp_compile -source $source]
#  return [eval $code]