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:closing {line {startIndex 0}} {
        string first "\}@" $line $startIndex
}

proc ctrans:parse {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 [list]
        set result [list]
        for {set i 0} {$i<[llength $lines]} {incr i} {
                set line [lindex $lines $i]\n
                set closing [ctrans:closing $line]
                # find @key patterns
                while {[set match [regexp $keypatt $line name]]|| $closing>=0} {
                        # get the location 
                        set location [expr {$match ?[string first $name $line]:-1}]
                        if {$closing>=0 && ($location<0 || $location>$closing)} {
                                # we are at the end of a subpattern
                                # push the rest of the pattern into templ
                                complete templ [string range $line 0 [expr {$closing-1}]]
                                # we can merge the last element of result with templ
                                set _temp [lindex $result end]
                                lappend _temp $templ
                                set templ $_temp
                                set result [lrange $result 0 end-1]
                                # parse the rest
                                set line [string range $line [expr {$closing+2}] end]
                                set closing [ctrans:closing $line]
                                continue
                        }
                        # get the key
                        set end [expr {$location+[string length $name]+1}]
                        set key [string range $name 1 end]
                        # inspect the syntax
                        if {[string index $line [expr {$end-1}]] ne "\{"} {
                                # @key syntax inside text
                                complete templ [string range $line 0 [expr {$location-1}]]
                                lappend templ [list key $key]
                                set line [string range $line [expr {$end-1}] end]
                        } else {
                                # recursive @key{...}@ syntax
                                # get the first part of the line, before the syntax expansion
                                complete templ [string range $line 0 [expr {$location-1}]]
                                # we open the subpattern
                                lappend result $templ
                                set templ [list sub $key]
                                set line [string range $line $end end]
                        }
                        set closing [ctrans:closing $line]
                }
                complete templ $line
        }
        
        if {[llength $result]!=0} {error "unclosed subpatterns"}
        lreplace $templ end end [string range [lindex $templ end] 0 end-1]
}

proc complete {listVar string} {
        upvar 1 $listVar list
        if {[llength $list] % 2 == 0} {lappend list $string; return}
        lset list end [lindex $list end]$string
}

proc ctrans {dict code} {
        ctrans:transform $dict [ctrans:parse $code]
}
        
proc ctrans:transform {dict code} {
        set result ""
        for {set i 0} {$i<[llength $code]} {incr i} {
                set codeelt [lindex $code $i]
                if {$i%2==0} {
                        append result $codeelt
                } else {
                        switch -- [lindex $codeelt 0] {
                                key {
                                        append result [dict get $dict [lindex $codeelt 1]]
                                }
                                sub {
                                        foreach d [dict get $dict [lindex $codeelt 1]] {
                                                append result [ctrans:transform $d [lrange $codeelt 2 end]]
                                        }
                                }
                        }
                }
        }
        set result
}
======

<<categories>> Dev. Tools