CMcC 2011-01-10
Zencode is a terse little language for describing complex and nested structures (see [L1 ] for a description.) The enclosed Zen package implements it for Tcl. The latest version of the code below may always be found here [L2 ] as part of the Wub distribution.
The original implementation of zencode was as an editor plugin. This implementation is designed to compile a zencode descriptor into tcl nested lists of the form {cmd args} which can then be evaluated to generate the output forms required.
This implementation differs from the original zencode as follows:
The tests at the end provide examples of zencode as understood by this code.
The idea is that 'p+p' will produce <p></p><p></p>, head>link will produce <head><link></link></head> (so + and > represent sibling and child relations.) Subexpressions appear in (), although they only really make sense as part of the target of a child relation.
Attributes can be passed in {}s thus: span{title "Hello World" id fred} produces <span title="Hello World" id=fred></span> and so forth. # and . are used as shorthand for id and class attributes, so span#fred is the same as span{id fred}.
Iteration is supported with * (and here's where it gets interesting), thus: ul>li#id\$_*$list produces <ul><li id='id0'>a</li><li id='id1'>list</li><li id='id2'>of</li><li id='id3'>words</li></ul> ... where the identifier 'list' has been defined as {a list of words} in the invocation of the generator. Note, also, the special variable $_ containing the numeric index of the iteration.
Scripts and variables may form the content part of an element, and be used in the value part of attributes.
[zenobj generate HTML $zencode args...] will generate HTML from the $zencode in the presence of the variable binding context given by the $args alist.
The idea is that output from [Zen parse] is 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 term and child, and should inherit from ::ZenGen. Each such method must return a valid fragment of the target language.
child is passed a parent element, followed by a list of elements which are children of the parent element and siblings of each other.
term is passed a dict, the dict may contain elements -literal, -command or -variable indicating that the word's content is the literal, the value of a command evaluation, or the value of the variable, respectively. If the term has been defined with an *-operator (indicating iteration), a variable will be construed as a list, the command will be called once for each iteration (until it returns an error.)
# 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 </$tag>
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 </$tag>
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 "<p>\n</p>\n<p>\n</p>"
p$line+p "<p>\nthis is a line\n</p>\n<p>\n</p>"
{p "moop1" + p "moop2"} "<p>\nmoop1\n</p>\n<p>\nmoop2\n</p>"
head>link "<head>\n<link>\n</link>\n</head>"
{div>(ul>li)+p} "<div>\n<ul>\n<li>\n</li>\n</ul>\n<p>\n</p>\n</div>"
{div>(ul>li)+p "moop"} "<div>\n<ul>\n<li>\n</li>\n</ul>\n<p>\nmoop\n</p>\n</div>"
{div>(ul>li$list)+p "moop"} "<div>\n<ul>\n<li>\na list of words\n</li>\n</ul>\n<p>\nmoop\n</p>\n</div>"
{ul>li#id\$simple*3$simple} "<ul>\n<li id='id0'>\n0\n</li>\n<li id='id1'>\n1\n</li>\n<li id='id2'>\n2\n</li>\n</ul>"
{ul>li#id\$_*$list} "<ul>\n<li id='id0'>\na\n</li>\n<li id='id1'>\nlist\n</li>\n<li id='id2'>\nof\n</li>\n<li id='id3'>\nwords\n</li>\n</ul>"
{ul>li#id\$_*[upto 5 $_]} "<ul>\n<li id='id0'>\n5\n</li>\n<li id='id1'>\n4\n</li>\n<li id='id2'>\n3\n</li>\n<li id='id3'>\n2\n</li>\n<li id='id4'>\n1\n</li>\n<li id='id5'>\n0\n</li>\n</ul>"
} {
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
}