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. Each such method must return a valid fragment of the target language.
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 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 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 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 $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 cmd $extra
}
\" {
lappend result lit $extra
}
\$ {
lappend result var $extra
}
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]} {
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'}
if {$punct eq "\["} {
return [list command $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 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 var {$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 colspan 2]]}
{td{colspan 2 $content_var}} {[my generate [my word td colspan 2 var {$content_var}]]}
{td{colspan 2 [command for content]}} {[my generate [my word td colspan 2 cmd {[commandforcontent]}]]}
{td[command for content]} {[my generate [my word td command {[command for content]}]]}
{td$variable} {[my generate [my word td var variable]]}
{span{title "Hello World" rel}} {[my generate [my word span title {Hello World} attr 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
}