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:
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
}