[CMcC] 2011-01-10 *** zencode *** Zencode is a terse little language for describing structures. See [http://code.google.com/p/zen-coding/] The original implementation of zencode was as an editor plugin. This implementation is designed to compile a zencode descriptor into tcl code which can then be evaluated to generate the output forms required. This implementation differs as follows: * () can be used to group subexpressions - useful for > (child) operations which otherwise run to end of line. * {} are used to group attributes (which should be tcl lists) * [[]] are used to define a functional value for an element. * $ is used to define a variable value for an element * "" are used to define a literal value for an element. * unsupported: | (filters), the original $-syntax, trailing-+ The tests at the end provide examples of zencode as understood by this code. *** Generators *** I haven't yet written any generators. The idea is that output from [[Zen parse]] would be evaluated in an object to produce HTML, CSS, or similar structured output. To some extent, the use of Tcl obviates the original zencode filter facility. A generator must supply methods for ''generate'', ''child'', ''mult'' and ''word''. Each such method must return a valid fragment of the target language. **** generate **** ''generate'' is passed elements which are siblings of one another. **** child **** ''child'' is passed a parent element, followed by a list of elements which are children of the parent element and siblings of each other. **** word **** ''word'' is passed a dict, the dict may contain elements ''literal'', ''cmd' or ''var'' indicating that the word's content is the literal, the value of a command evaluation, or the value of the variable, respectively. **** mult **** ''mult'' is passed a multiplier and a single element (which is a quoted tcl script). If the multiplier is an integer, then the child is repeated that many times, each repetition being a sibling of the others. If the multiplier is '*', then the child determines how many repetitions it needs, in a manner which has not yet been determined :) The idea is to allow commands and variables passed to lower-level elements to determine the repetition behaviour of a [[mult]] expression. It is envisaged that the command will be used as a generator, and mult child expression repeated until the generator terminates. Similarly, a literal value will be treated (in the context of [[mult]]) as a list of values to be consumed by the mult elements. ====== # zen - parse and manipulate zencode # http://code.google.com/p/zen-coding/ package provide zen 1.0 if {[catch {package require Debug}]} { proc Debug.zenparse {args} {puts stderr zen@[uplevel subst $args]} proc Debug.zenparse {args} {} proc Debug.zengen {args} {puts stderr zengen@[uplevel subst $args]} #proc Debug.zengen {args} {} } else { Debug define zenparse 10 Debug define zengen 10 } oo::class create ::ZenGen { # find free -variables in children of an element method freevars {args} { Debug.zengen {freevars $args} set vars {} foreach arg $args { switch -- [lindex $arg 0] { term { if {[dict exists [lrange $arg 2 end] -variable]} { lappend vars [dict get [lrange $arg 2 end] -variable] } } mult { lappend vars {*}[my freevars {*}[lrange $arg 2 end]] } child { lappend vars {*}[my freevars [lindex $arg 1]] lappend vars {*}[my freevars {*}[lrange $arg 2 end]] } default {} } } Debug.zengen {freevars $args -> $vars} return $vars } method commands {args} { Debug.zengen {commands $args} set cmds {} foreach arg $args { switch -- [lindex $arg 0] { term { if {[dict exists [lrange $arg 2 end] -command]} { lappend cmds [dict get [lrange $arg 2 end] -command] } } mult { lappend cmds {*}[my commands {*}[lrange $arg 2 end]] } child { lappend cmds {*}[my commands [lindex $arg 1]] lappend cmds {*}[my commands {*}[lrange $arg 2 end]] } default {} } } Debug.zengen {commands $args -> $cmds} return $cmds } method mult {mult args} { variable context set result "" variable multiplying 1 if {$mult eq "*"} { Debug.zengen {mult '$mult' args:$args} # build map of vars per element set el2var {} ;# map from el to referenced vars set allvars {} ;# all bound vars set bvars {} ;# bound vars per element set fvars {} ;# free vars per element foreach arg $args { set freevars [my freevars $arg] dict set el2var $arg $freevars foreach v $freevars { if {[dict exists $context $v]} { # assumed to be a list lappend bvars $arg $v dict set allvars $v 1 } else { lappend fvars $arg $v } } } set cmds [my commands {*}$args] Debug.zengen {allvars: ($allvars) fvars: ($fvars) bvars: ($bvars)} # evaluate the contained args repeatedly until they error variable context set mcont $context set index 0 set processing [expr {[dict size $allvars] + [llength $cmds]}] while {$processing} { foreach v [dict keys $allvars] { set newval [lindex [dict get $mcont $v] $index] dict set context $v $newval if {$newval eq ""} { dict unset allvars $v } } set processing [expr {[dict size $allvars] + [llength $cmds]}] set line {} if {$processing} { dict set context _ $index foreach arg $args { if {[catch { lappend line [my {*}$arg] }]} { set processing 0 set line {} } } incr index } lappend result {*}$line } set context $mcont } else { set vars [my freevars {*}$args] Debug.zengen {mult '$mult' vars:($vars) args:$args} variable context set result {} for {set index 0} {$index < $mult} {incr index} { foreach var $vars {dict set context $var $index} foreach arg $args { lappend result [my {*}$arg] } } } set multiplying 0 Debug.zengen {mult result: $result} return [join $result \n] } method attr {args} { variable context set result "" foreach {n v} $args { if {![string match -* $n]} { lappend result $n [::apply [list [dict keys $context] [string map [list %V% $v] {subst %V%}]] {*}[dict values $context]] } } return $result } method value {args} { set result {} if {[dict exists $args -literal]} { # term has a literal value lappend result [dict get $args -literal] } elseif {[dict exists $args -command]} { # term's value is given by the generator Debug.zengen {value from command '[dict get $args -command]'} variable context set cmd [::apply [list [dict keys $context] [dict get $args -command]] {*}[dict values $context]] Debug.zengen {value from command '[dict get $args -command]' -> $cmd} lappend result $cmd } elseif {[dict exists $args -variable]} { # term's value is in $variable set variable [dict get $args -variable] if {[string match ::* $variable]} { lappend result [set $variable] } else { variable context Debug.zengen {gen term using variable '$variable' from ($context)} lappend result [dict get $context $variable] } } return $result } method generate {args} { Debug.zengen {generate: $args} set result {} foreach arg $args { lappend result [my {*}$arg] } return [join $result \n] } constructor {args} { variable multiplying 0 variable context $args } } oo::class create ::ZenHTML { method attr {args} { set result {} foreach {n v} [next {*}$args] { lappend result $n='$v' } return $result } method term {tag args} { lappend result "<[join [list $tag {*}[my attr {*}$args]]]>" lappend result {*}[my value {*}$args] lappend result return [join $result \n] } method child {parent args} { set attrs [lassign $parent -> tag] lappend result "<[join [list $tag {*}[my attr {*}$attrs]]]>" foreach arg $args { lappend result [my {*}$arg] } lappend result return [join $result \n] } superclass ::ZenGen constructor {args} { next {*}$args } } oo::class create Zen { method token {string {type wordchar}} { set failed 0 set match [string is $type -strict -failindex failed $string] Debug.zenparse {token: string is $type until: $failed over '$string'} if {$match} { return [list $string ""] ;# whole string matches } elseif {$failed} { return [list [string range $string 0 $failed-1] [string range $string $failed end]] } else { return [list "" $string] } } method tokenize {match_var rest_var {type wordchar}} { upvar 1 $match_var match upvar 1 $rest_var rest lassign [my token $rest $type] match rest set match [string trim $match] set rest [string trim $rest] if {[string range $rest 0 1] eq "\\\$"} { set rest [string range $rest 2 end] my tokenize submatch rest append match \$ $submatch } Debug.zenparse {tokenize $type: '$match' '[string range $rest 0 10]'} return [expr {$match ne ""}] } method punct {rest_var} { upvar 1 $rest_var rest set rest [string trim $rest] set punct [string index $rest 0] Debug.zenparse {is '$punct' punct?} if {$punct in {. # * \{ \[ | > + ( ) \$ \"}} { set rest [string range $rest 1 end] Debug.zenparse {punct '$punct' '[string range $rest 0 10]'} return $punct } else { Debug.zenparse {punct failed over '$rest'} return "" } } method literal {match_var rest_var} { upvar 1 $match_var match; set match "" upvar 1 $rest_var rest while {$rest ne ""} { set next [string index $rest 0] set rest [string range $rest 1 end] if {$next eq "\\"} { append match $next append match [string index $rest 0] set rest [string range $rest 1 end] } elseif {$next eq "\""} { break } else { append match $next } } return [expr {$match ne ""}] } method get_attr {match_var rest_var {brace "\{"}} { upvar 1 $match_var match; set match $brace upvar 1 $rest_var rest while {![info complete $match] && $rest ne "" } { append match [string index $rest 0] set rest [string range $rest 1 end] } if {$match eq $brace} { # no match Debug.zenparse {get_attr failed} return 0 } else { Debug.zenparse {get_attr match:($match) rest:'$rest'} set match [join $match] return 1 } } method split_attr {attr} { set attr [string trim $attr] Debug.zenparse {split_attr:($attr)} set el ""; set result {} while {[set attr [string trimleft $attr]] ne ""} { if {[string index $attr 0] eq "\""} { if {$el ne ""} { error "improperly formed literal $attr" } set attr [string range $attr 1 end] if {[my literal literal attr]} { Debug.zenparse {split_attr literal:($literal) ($attr)} lappend result $literal } else { error "unterminated literal in $attr" } continue } elseif {[set space [string first " " $attr]] == -1} { Debug.zenparse {split_attr spaces $space:($attr)/$el/$result} append el $attr lappend result $el set el "" break ;# no spaces left } else { append el [string range $attr 0 $space-1] " " set attr [string range $attr $space+1 end] Debug.zenparse {split_attr el: ($el) rest:($attr)} } if {[info complete $el]} { lappend result [string trim $el] set el "" } } if {$el ne ""} { error "improperly formed attributes - must be a valid tcl list" } if {[llength $result]%2} { set extra [lindex $result end] set result [lrange $result 0 end-1] switch -- [string index $extra 0] { \[ { lappend result -command [string trim $extra \[\]] } \" { lappend result -literal [string trim $extra \"] } \$ { lappend result -variable [string range $extra 1 end] } default { lappend result -attr [lindex $extra 0] } } } Debug.zenparse {split_attr result: ($result)} return $result } method compound {rest_var {nesting 0}} { upvar 1 $rest_var rest set $rest [string trim $rest] if {$rest eq ""} { return "" } Debug.zenparse {compound '$rest'} # look for leading punctuation set punct [my punct rest] Debug.zenparse {compound punct: '$punct'} switch -- $punct { "" { error "Can't parse '$rest' - no copula or compound punctuation" } . { # class if {![my tokenize class rest]} { error "trailing '.' with no identifier" } return [list class $class] } \# { # id if {![my tokenize id rest]} { error "trailing '#' with no identifier" } return [list id $id] } * { # multiplier if {![my tokenize mult rest integer]} { set mult * } return [list mult $mult] } \" { if {![my literal lit rest]} { error "failed string literal" } return [list -literal $lit] } \$ { # var if {![my tokenize id rest]} { error "trailing '#' with no identifier" } return [list -variable $id] } \[ - \{ { # attribute if {[my get_attr match rest $punct]} { Debug.zenparse {compound attribute match:($match) '$rest'} if {$punct eq "\["} { return [list -command [string trim $match \[\]]] } else { set attrs [my split_attr $match] return $attrs } } else { error "attribute: no close to match $punct parsing '$rest'" } } | - > - + { # connector - not compound set rest ${punct}$rest return "" } \( { error "misplaced '(' in $rest" } \) { # closed subexpr if {!$nesting} { error "misplaced ')' in $rest" } else { # how to close subexpr? set rest \)$rest ;# push back the close subexpr return "" } } } } method compounding {rest_var {nesting 0}} { upvar 1 $rest_var rest set rest [string trim $rest] if {$rest eq ""} { return "" } Debug.zenparse {compounding '$rest'} set result {} while {1} { set compound [my compound rest $nesting] if {$compound eq ""} { Debug.zenparse {complete compound '$compound' with '$rest' remaining} break } else { Debug.zenparse {compounded '$compound' with '$rest' remaining} } lappend result {*}$compound } Debug.zenparse {compounded '$result' remaining '$rest'} return $result } method term {rest_var {nesting 0}} { upvar 1 $rest_var rest set rest [string trim $rest] if {$rest eq ""} { return "" ;# return empty list for EOS } # look for leading term Debug.zenparse {looking for id in: '$rest'} my tokenize term rest if {$term ne ""} { Debug.zenparse {leading term: '$term'} set result [list term $term {*}[my compounding rest $nesting]] Debug.zenparse {term is: '$result' remaining: $rest} return $result ;# return term+compound dict } else { # look for leading term punctuation - treat it as defaults set punct [my punct rest] Debug.zenparse {term punct: '$punct'} switch -- $punct { . { return [list default . {*}[my compounding rest $nesting]] } \# { return [list default \# {*}[my compounding rest $nesting]] } * { return [list default * {*}[my compounding rest $nesting]] } \( { # start a new clause Debug.zenparse {new subexpr: '$rest'} #return [list subexpr [my parse_expr rest [incr nesting]]] return [list subexpr [my parser rest [incr nesting]]] } > - + - \{ - \[ - \$ - \| { error "naked '$punct' in '$rest'. Expecting an identifier" } default { error "unknown punctuation '$punct' in '$rest'" } } } } # copula - having found an term/subexpr on the left, # find a copula (+,>) and an term on the right method copula {rest_var} { upvar 1 $rest_var rest set rest [string trim $rest] Debug.zenparse {looking for copula in '$rest'} if {$rest eq ""} { return "" } # look for leading punctuation set punct [my punct rest] Debug.zenparse {copula punct: '$punct'} switch -- $punct { > { return child } + { return sib } "" - \) { return $punct } default { error "unknown punctuation '$punct' in '$rest'" } } } method parser {rest_var {nesting 0}} { upvar 1 $rest_var rest set rest [string trim $rest] if {$rest eq ""} { return "" } Debug.zenparse {parser $nesting over: '$rest'} # get lhs term set result [list [my term rest $nesting]] Debug.zenparse {parse lhs: '$result', rest: '$rest'} while {$rest ne ""} { Debug.zenparse {parse looking for copula in '$rest'} set copula [my copula rest] Debug.zenparse {parse copula: '$copula', rest: '$rest'} switch -- $copula { child - sib { # get rhs term/phrase set rhs [my term rest $nesting] Debug.zenparse {parsed $copula rhs: '$rhs', rest: '$rest'} lappend result $copula $rhs } \) { if {$nesting == 0} { error "Extraneous trailing \) in $rest" } return $result } "" { Debug.zenparse {parsed: $result} if {$nesting != 0} { error "No closing \) in $rest" } return $result } default { error "unknown copula '$copyla'" } } } Debug.zenparse {completed: $result} return $result } method compile {result} { Debug.zenparse {compile: '$result'} set cmd {} foreach {el op} $result { set result [lrange $result 2 end] Debug.zenparse {compiling el:($el) op:'$op'} if {[dict exists $el mult]} { # handle mult subexpr set mult [dict get $el mult] dict unset el mult Debug.zenparse {compiling a mult '$mult' ($el $op $result)} lappend cmd [list [list mult $mult {*}[my compile [list $el $op {*}$result]]]] break } if {$op eq "child"} { # 'child' operation Debug.zenparse {compile child '$el' and '$result'} if {[lindex $el 0] eq "subexpr"} { Debug.zenparse {compiling a subexpr ([lrange $el 1 end])} set se {} foreach sub [lrange $el 1 end] { lappend se {*}[my compile $sub] } set el [join $se] } lappend cmd [list [list child $el {*}[my compile $result]]] break } else { # 'sibling' operation if {[lindex $el 0] eq "subexpr"} { Debug.zenparse {compiling a subexpr ([lrange $el 1 end])} set se {} foreach sub [lrange $el 1 end] { lappend cmd [my compile $sub] } } else { lappend cmd [list $el] } } } Debug.zenparse {compile joining: '$cmd'} set cmd [join $cmd] Debug.zenparse {compiled: '$cmd'} return $cmd } method parse {rest} { set rest [string trim $rest] Debug.zenparse {parser over: '$rest'} if {$rest eq ""} { return "" } set result [my parser rest] return [my compile $result] } method generate {language rest args} { set generator [::Zen$language new {*}$args] set generated [$generator generate {*}[my parse $rest]] $generator destroy return $generated } destructor {} constructor {args} { variable {*}$args } } if {[info exists argv0] && ($argv0 eq [info script])} { package require tcltest namespace import ::tcltest::* variable SETUP {Zen create zen} variable CLEANUP {zen destroy} tcltest::skip unsupported-* proc upto {top index} { Debug.zengen {upto $top $index} if {$index > $top} {error done} return [expr {$top - $index}] } set count 0 foreach {from to} { p.title|e . p.name-$*3 . select>option#item-$*3 . ul+ . table+ . } { incr count test unsupported-$count {} -setup $SETUP -body [list zen parse $from] -cleanup $CLEANUP -result $to } set count 0 foreach {from to} { div#name {{term div id name}} div.class {{term div class class}} div.one.two {{term div class one class two}} div#name.one.two {{term div id name class one class two}} head>link {{child {term head} {term link}}} table>tr>td {{child {term table} {child {term tr} {term td}}}} ul#name>li.item {{child {term ul id name} {term li class item}}} p+p {{term p} {term p}} {div#page>div.logo+ul#navigation>li*5>a} {{child {term div id page} {term div class logo} {child {term ul id navigation} {mult 5 {child {term li} {term a}}}}}} {div#page>div.logo+ul#navigation>li*>a{$list}} {{child {term div id page} {term div class logo} {child {term ul id navigation} {mult * {child {term li} {term a -variable list}}}}}} div#name>p.one+p.two {{child {term div id name} {term p class one} {term p class two}}} p*3 {{mult 3 {term p}}} ul#name>li.item*3 {{child {term ul id name} {mult 3 {term li class item}}}} ul#name>li.item*3$var {{child {term ul id name} {mult 3 {term li class item -variable var}}}} } { incr count test simple-$count {} -setup $SETUP -body [list zen parse $from] -cleanup $CLEANUP -result $to } set count 0 foreach {from to} { {(div)>p} {{child {term div} {term p}}} {div>(ul>li)+p} {{child {term div} {child {term ul} {term li}} {term p}}} {div>(title+ul>li)+p} {{child {term div} {term title} {child {term ul} {term li}} {term p}}} p{title} {{term p -attr title}} td{colspan=2} {{term td -attr colspan=2}} {td{colspan 2}} {{term td colspan 2}} {td{colspan 2 $content_var}} {{term td colspan 2 -variable content_var}} {td{colspan 2 [content script]}} {{term td colspan 2 -command {content script}}} {td[content script; more script]} {{term td -command {content script; more script}}} {td$variable} {{term td -variable variable}} {span{title "Hello World" rel}} {{term span title {Hello World} -attr rel}} {span"Moop Moop"} {{term span -literal {Moop Moop}}} {span "Moop Moop"} {{term span -literal {Moop Moop}}} } { incr count test extended-$count {} -setup $SETUP -body [list zen parse $from] -cleanup $CLEANUP -result $to } set count 0 foreach {from to} { p+p "

\n

\n

\n

" p$line+p "

\nthis is a line\n

\n

\n

" {p "moop1" + p "moop2"} "

\nmoop1\n

\n

\nmoop2\n

" head>link "\n\n\n" {div>(ul>li)+p} "
\n\n

\n

\n
" {div>(ul>li)+p "moop"} "
\n\n

\nmoop\n

\n
" {div>(ul>li$list)+p "moop"} "
\n\n

\nmoop\n

\n
" {ul>li#id\$simple*3$simple} "" {ul>li#id\$_*$list} "" {ul>li#id\$_*[upto 5 $_]} "" } { incr count test generate-$count {} -setup $SETUP -body [list zen generate HTML $from line "this is a line" list {a list of words} simple simple] -cleanup $CLEANUP -result $to } # To see test statistics (Total/Passed/Skipped/Failed), best put this line in the end: cleanupTests } ====== <>Enter Category Here