[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''

''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.

======
# 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
}

======

<<categories>>Enter Category Here