scripted templates are templates that are also syntactically valid Tcl scripts. They are evaluated as described for scripted lists. This characteristic differentiates scripted templates from the other available templating systems.
PYK 2014-04-06: After playing with scripted lists for a while, I thought I'd try modifying the procedure to preserve lines and leading whitespace, forming a templating engine. The majority of the additional code deals with getting the proper indention of each line, given recursive calls to st. To this end, state was added, and then the code was modified to operate on a stateful value instead of returning its results directly.
The template is evaluated in the scope of the caller.
If the Tcl command substitution or variable substitution operators ever became programmable (is there any reason that they shouldn't?), scripted templates would naturally benefit from that functionality.
Anyone is so inclined to improve this code, please feel free to jump in!
proc books {statevar books} { upvar $statevar state variable t_book set res {} if {[llength $books]} { st state { <table> [st state { [foreach book $books { book state $book }] }] </table> } } return $res } proc book {statevar book} { upvar $statevar state variable t_book dict with book {} st state $t_book } variable t_doc { <html> <head> </head> <body> <p> A list of good $genre books </p> [books booklist $books] <span> <b>that's all, folks!</b> </span> </body> </html> } variable t_book { <tr><td>$name</td> <td>$author</td></tr> } set genre {science fiction} set books {} for {set i 0} {$i < 5} {incr i} { lappend books [dict create name "book $i" author "author $i"] } st booklist $t_doc puts [join $booklist(doc) {}]
output:
<html> <head> </head> <body> <p> A list of good science fiction books </p> <table> <tr><td>book 0</td> <td>author 0</td></tr> <tr><td>book 1</td> <td>author 1</td></tr> <tr><td>book 2</td> <td>author 2</td></tr> <tr><td>book 3</td> <td>author 3</td></tr> <tr><td>book 4</td> <td>author 4</td></tr> <span> <b>that's all, folks!</b> </span> </table> </body> </html>
proc st {statevar script} { upvar $statevar state foreach varname {level ws doc} { upvar 0 state($varname) $varname } incr level foreach varname {ws doc} { append $varname {} } set state($level,start) [llength $doc] set offset [string length $ws] set res {} set parts {} foreach part [split $script \n] { lappend parts $part set part [join $parts \n] #add the newline that was stripped because it can make a difference if {[info complete $part\n]} { set parts {} set oldpart $part set part [string trim $part] if {$part eq {}} { continue } if {[string index $part 0] eq {#}} { continue } set idx [string first [string index $part 0] $oldpart] set oldpart1 $oldpart set newws [string range $oldpart[set oldpart {}] 0+$offset $idx-1] if {![info exists dedent] || [string length $dedent] > [string length $newws]} { set dedent $newws } append ws $newws #the double-substitution here via uplevel is intended! set content [join [uplevel list $part]] if {$content ne {}} { if {$doc ne {}} { lappend doc \n } lappend doc $ws$content } set ws [string range $ws 0 end-[expr {[string length $newws]}]] } } if {$parts ne {}} { error [list {incomplete parts} [join $parts]] } for {set i $state($level,start)} {$i < [llength $doc]} {incr i} { set content [lindex $doc $i] if {[string length $dedent] && [string length $content] > [string length $dedent]} { lset doc $i {} set content [string range $content[set content {}] [ string length $dedent] end] lset doc $i $content } } array unset state $level,* incr state(level) -1 return }