CMcC 2011-01-10
Zencode is a terse little language for describing structures. See [L1 ]
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:
The tests at the end provide examples of zencode as understood by this code.
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
generate is passed elements which are siblings of one another.
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 is passed a dict, the dict may contain the attr element which is presumed to be a tcl expression yielding a list comprising a leading dict and one optional trailing element (the value or content). The dict may also contain elements literal and var indicating that the word's content is the literal, or the value of the variable, respectively.
Evaluation of the attr element of word dict is a matter of parsing tcl and arranging for relevant variable or command evaluation.
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} {}
} else {
Debug define zenparse 10
Debug define zengen 10
}
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]
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 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]} {
return [list mult $mult]
} else {
return [list 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 var $id]
}
\[ -
\{ {
# attribute
if {[my get_attr match rest $punct]} {
Debug.zenparse {compound attribute match:($match) '$rest'}
return [list attr $match]
} else {
error "attribute: no matching \} 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 word
Debug.zenparse {looking for id in: '$rest'}
my tokenize word rest
if {$word ne ""} {
Debug.zenparse {leading word: '$word'}
set result [list word $word {*}[my compounding rest $nesting]]
Debug.zenparse {term is: '$result' remaining: $rest}
return $result ;# return word+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 {nesting 0}} {
Debug.zenparse {compile $nesting: '$result'}
if {!$nesting} {
set cmd [list \[my generate]
set level 1
} else {
set cmd {}
set level 0
}
foreach {el op} $result {
set result [lrange $result 2 end]
Debug.zenparse {compiling el:($el) op:'$op'}
if {[lindex $el 0] eq "subexpr"} {
Debug.zenparse {compiling a subexpr ([lrange $el 1 end])}
foreach sub [lrange $el 1 end] {
set subexpr [my compile $sub [expr {$nesting+1}]]
lappend cmd $subexpr
}
} elseif {[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 \[my mult $mult \{[my compile [list $el $op {*}$result] [expr {$nesting+1}]]\}
incr level
break
} elseif {$op eq "child"} {
# 'child' operation
lappend cmd \[my child \[my $el\]
incr level
} else {
# 'sibling' operation
lappend cmd \[my $el\]
}
}
set cmd [join $cmd]
append cmd [string repeat \] $level]
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]
}
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-*
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 {[my generate [my word div id name]]}
div.class {[my generate [my word div class class]]}
div.one.two {[my generate [my word div class one class two]]}
div#name.one.two {[my generate [my word div id name class one class two]]}
head>link {[my generate [my child [my word head] [my word link]]]}
table>tr>td {[my generate [my child [my word table] [my child [my word tr] [my word td]]]]}
ul#name>li.item {[my generate [my child [my word ul id name] [my word li class item]]]}
p+p {[my generate [my word p] [my word p]]}
{div#page>div.logo+ul#navigation>li*5>a} {[my generate [my child [my word div id page] [my word div class logo] [my child [my word ul id navigation] [my mult 5 {[my child [my word li] [my word a]]}]]]]}
{div#page>div.logo+ul#navigation>li*>a{$list}} {[my generate [my child [my word div id page] [my word div class logo] [my child [my word ul id navigation] [my mult * {[my child [my word li] [my word a attr {$list}]]}]]]]}
div#name>p.one+p.two {[my generate [my child [my word div id name] [my word p class one] [my word p class two]]]}
p*3 {[my generate [my mult 3 {[my word p]}]]}
ul#name>li.item*3 {[my generate [my child [my word ul id name] [my mult 3 {[my word li class item]}]]]}
} {
incr count
test simple-$count {} -setup $SETUP -body [list zen parse $from] -cleanup $CLEANUP -result $to
}
set count 0
foreach {from to} {
{(div)>p} {[my generate [my word div] [my word p]]}
{div>(ul>li)+p} {[my generate [my child [my word div] [my child [my word ul] [my word li]] [my word p]]]}
{div>(title+ul>li)+p} {[my generate [my child [my word div] [my word title] [my child [my word ul] [my word li]] [my word p]]]}
p{title} {[my generate [my word p attr title]]}
td{colspan=2} {[my generate [my word td attr colspan=2]]}
{td{colspan 2}} {[my generate [my word td attr {colspan 2}]]}
{td{colspan 2 $content_var}} {[my generate [my word td attr {colspan 2 $content_var}]]}
{td{colspan 2 [command for content]}} {[my generate [my word td attr {colspan 2 [command for content]}]]}
{td[command for content]} {[my generate [my word td attr {[command for content]}]]}
{td$variable} {[my generate [my word td var variable]]}
{span{title="Hello" rel}} {[my generate [my word span attr {title="Hello" rel}]]}
{span"Moop Moop"} {[my generate [my word span literal {Moop Moop}]]}
{span "Moop Moop"} {[my generate [my word span literal {Moop Moop}]]}
} {
incr count
test extended-$count {} -setup $SETUP -body [list zen parse $from] -cleanup $CLEANUP -result $to
}
# To see test statistics (Total/Passed/Skipped/Failed), best put this line in the end:
cleanupTests
}