***Simple Template*** ====== if { [info commands lassign] == "" } { proc lassign {L args} { uplevel 1 [list foreach $args [linsert $L end {}] break] lrange $L [llength $args] end } } interp alias {} nosubst {} subst -nobackslashes -nocommands -novariables proc template {name vars body} { set outvar [lindex $vars 0] lset vars 0 ${outvar}_var proc $name $vars [concat upvar 1 \$${outvar}_var $outvar \; [genrender $body $outvar]] } proc render {args} { uplevel 1 [eval {genrender} $args] } proc genrender {template {var OUT} {sub subst}} { set a "append $var \[$sub {" set b "}]\n\\1\n" set c [regsub -all -line {$\s*%\s(.*)} $template $b$a ] return $a$c\}\] } set v 3 set mjd "Mark J. Dominus" set mjdweb "http://perl.plover.com/" set L [split "ABCD" ""] template example {OUTPUT v L} { % global env You can access variables: $v or environment variables: $env(HOME) You can call functions and evaluate code inline. The list [join $L ", "] has [llength $L] elements. [string repeat = [llength $L]] [join $L ""] [string repeat = [llength $L]] Loop % for {set i 0} { $i < [llength $L] } {incr i} { elem L\[$i\] = [lindex $L $i] % } Append to output % for {set i 0} { $i < [llength $L] } {incr i} { % append OUTPUT " L\[$i\] = " ' [lindex $L $i] ' % } % global mjd mjdweb This example is from $mjd at ${mjdweb} % set len [llength $L] The Lord High Chamberlain has gotten $len things for me this year. % set diff [expr { $len - 5 }] % set more "more" % if { $diff == 0 } { % set more "no" % } elseif { $diff < 0 } { % set diff [expr {-$diff}] % set more "fewer" % } That is $diff $more than he gave me last year. } set OUT "For example" puts [example OUT $v $L] array set structs { a long c float } template render_struct {out n t} { struct $n { struct $n *next; $t data; }; } foreach {n t} [array get structs] { render_struct output $n $t } puts $output ====== '''Produces the following output''' ====== For example You can access variables: 3 or environment variables: /home/pshook You can call functions and evaluate code inline. The list A, B, C, D has 4 elements. ==== ABCD ==== Loop elem L[0] = A elem L[1] = B elem L[2] = C elem L[3] = D Append to output L[0] = 'A' L[1] = 'B' L[2] = 'C' L[3] = 'D' This example is from Mark J. Dominus at http://perl.plover.com/ The Lord High Chamberlain has gotten 4 things for me this year. That is 1 fewer than he gave me last year. ====== ---- ***Simple Class*** ====== proc class {classname} { set template { global @classname@.num set @classname@.num 0 proc @classname@_new {args} { global @classname@.num set self @classname@.[incr @classname@.num] # puts "@classname@_new $self" if [llength $args] { eval @classname@_set $self $args } return $self } proc @classname@_set {self args} { upvar #0 $self members # puts [info level 0] if { [string trimright $self .0123456789] != "@classname@" } { error "invalid self: [info level 0]" } array set members $args } proc @classname@_get {self name} { upvar #0 $self members # puts [info level 0] if { [string trimright $self .0123456789] != "@classname@" } { error "invalid self: [info level 0]" } if [catch { set val $members($name) }] { error "no such member: [info level 0]" } return $val } } regsub -all @classname@ $template $classname template eval $template } class apple proc apple_byte {self} { puts "Taking a byte from apple $self" apple_set $self -size [expr [apple_get $self -size] - 1] if { [apple_get $self -size] <= 0 } { puts "Apple $self now completely eaten!" } } class fridge proc fridge_open {self} { if { [fridge_get $self -state] == "open" } { puts "Fridge $self already open." } else { puts "Opening fridge $self..." fridge_set $self -state "open" } } proc fridge_close {self} { if { [fridge_get $self -state] == "closed" } { puts "Fridge $self already closed." } else { puts "Closing fridge $self..." fridge_set $self -state "closed" } } set a1 [apple_new -size 3] set a2 [apple_new -color yellow -size 3] foreach i {1 2 3} { apple_byte $a1 apple_byte $a2 } set f1 [fridge_new -state open] fridge_close $f1 fridge_close $f1 fridge_open $f1 fridge_open $f1 fridge_close $f1 proc fridge_paint {self color} { puts "Painting fridge $self $color ..." fridge_set $self -color $color } catch { puts "$f1 is [fridge_get $f1 -color]" } msg puts $msg fridge_paint $f1 green puts "The fridge $f1 is [fridge_get $f1 -color]" fridge_open $f1 fridge_paint $f1 blue puts "The fridge $f1 is [fridge_get $f1 -color]" fridge_close $f1 ====== ---- !!!!!! %| [Category Person] |% !!!!!!