Version 0 of ctrans

Updated 2009-03-20 16:41:05 by sarnold

ctrans is a command that might be considered as a template system, aimed to code generation.

 ctrans valdict template

ctrans searches for two kinds of patterns in the template string:

  • @key which is replaced by the key in the dictionary
  • @key{...body...}@ where the body might split on several lines, which is repeatedly iterated on a list found in the valdict dictionary, recursively matching subpatterns in body

Example: [ctrans {tel 387} @tel] returns 387, whereas [ctrans {list {{age 37} {age 43}}} "@list{@age --}@ end"] returns "37 --43 -- end".

Here is the code:

package require Tcl 8.5;# we need [dict]

proc ctrans {dict code} {
        # splitting lines (regardless what eol encoding is, CRLF/CR/LF)
        set lines [split [string map {\r \n} [string map {\r\n \n} $code]] \n]
        # the global pattern
        set keypatt "@\[a-zA-Z_0-9\]+"
        set templ ""
        for {set i 0} {$i<[llength $lines]} {incr i} {
                set line [lindex $lines $i]
                # find @key patterns, non recursive
                while {[regexp $keypatt $line name]} {
                        # get the location and the key
                        set location [string first $name $line]
                        set end [expr {$location+[string length $name]+1}]
                        set key [string range $name 1 end]
                        if {[string index $line [expr {$end-1}]] ne "\{"} {
                                # replace @key by its value
                                set line [string range $line 0 [expr {$location-1}]][dict get $dict $key][string range $line [expr {$end-1}] end]
                        } else {
                                # recursive @key{...}@
                                # get the first part of the line, before the syntax expansion
                                append templ [string range $line 0 [expr {$location-1}]]
                                # search for \}@ in the same line
                                if {[set closing [string first "\}@" $line $end]]>=0} {
                                        # recursive call
                                        set body [string range $line $end [expr {$closing-1}]]
                                        foreach sub [dict get $dict $key] {
                                                append templ [ctrans $sub $body]
                                        }
                                        set line [string range $line [expr {$closing+2}] end]\n
                                } else {
                                        # template is split across multiple lines
                                        # search for \}@, end of the body of the sub-template
                                        set body [string range $line $end end]
                                        # iterate lines
                                        incr i
                                        while 1 {
                                                if {$i>=[llength $lines]} {error "no closing \}@ for pattern"}
                                                set line [lindex $lines $i]
                                                if {[set closing [string first "\}@" $line]]>0} {
                                                        append body \n[string range $line 0 [expr {$closing-1}]]
                                                        # recursive call to ctrans
                                                        foreach sub [dict get $dict $key] {
                                                                append templ [ctrans $sub $body]
                                                        }
                                                        set line [string range $line [expr {$closing+2}] end]
                                                        break
                                                }
                                                append body \n$line
                                                incr i
                                        }
                                }
                        }
                }
                append templ $line\n
        }
        # trim the last \n
        string range $templ 0 end-1
}