scripted templates

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.

Description

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!

Example

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>

Code

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
}