Posted to tcl by evilotto at Tue Nov 04 21:58:08 GMT 2014view pretty
proc adp_parse {f} { set rf [file join [Doc_Root] $f] if {![info exists ::adp::${f}::lastmod] || [file mtime $rf] > [set ::adp::${f}::lastmod]} { catch {namespace delete ::adp::$f} namespace eval ::adp::$f {} set cns ::adp::${f}::code set rns ::adp::${f}::run namespace eval $cns {} namespace eval $rns {} set ::adp::${f}::lastmod [file mtime $rf] set sf [open $rf] set src [read $sf] close $sf set chunks {} set pos 0 set ci 0 while {$pos >= 0 && $pos < [string length $src]} { incr ci set cs [string first "<%" $src $pos] set ce [string first "%>" $src $pos] if {$cs >= 0} { lappend chunks [string range $src $pos [expr {$cs-1}]] } else { lappend chunks [string range $src $pos end] break; } if {$ce > 0} { set chunk [string trim [string range $src $cs $ce] {<>%}] if {[string match =* $chunk]} { set chunk "return [string range $chunk 1 end]" } else { set chunk "$chunk\nreturn" } set cn ${cns}::chunk_$ci proc $cn {} [namespace eval $rns [list namespace code $chunk]] lappend chunks $cn } set pos [expr {$ce+2}] } set ::adp::${f}::chunks $chunks } return [set ::adp::${f}::chunks] } proc adp_eval {f} { set _d "" set ci 0 set chunks [adp_parse $f] foreach {h t} $chunks { incr ci append _d $h if {$t == ""} break if {[catch $t err]} { puts stderr "error in chunk $ci: $err" } else { append _d $err } } return $_d } proc Doc_application/x-tcl-adp {path suffix sock {interp {}}} { upvar #0 Httpd$sock data # source .tml files as for templates foreach libfile [DocGetTemplates $sock $path] { if {[file exists $libfile]} { source $libfile } } Httpd_ReturnData $sock text/html [adp_eval $suffix] }