162 lines
4.0 KiB
Factor
162 lines
4.0 KiB
Factor
! Copyright (C) 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors kernel sequences combinators kernel namespaces
|
|
classes.tuple assocs splitting words arrays memoize
|
|
io io.files io.encodings.utf8 io.streams.string
|
|
unicode.case tuple-syntax mirrors fry math urls present
|
|
multiline xml xml.data xml.writer xml.utilities
|
|
html.elements
|
|
html.components
|
|
html.templates
|
|
html.templates.chloe.syntax ;
|
|
IN: html.templates.chloe
|
|
|
|
! Chloe is Ed's favorite web designer
|
|
SYMBOL: tag-stack
|
|
|
|
TUPLE: chloe path ;
|
|
|
|
C: <chloe> chloe
|
|
|
|
DEFER: process-template
|
|
|
|
: chloe-attrs-only ( assoc -- assoc' )
|
|
[ drop name-url chloe-ns = ] assoc-filter ;
|
|
|
|
: non-chloe-attrs-only ( assoc -- assoc' )
|
|
[ drop name-url chloe-ns = not ] assoc-filter ;
|
|
|
|
: chloe-tag? ( tag -- ? )
|
|
{
|
|
{ [ dup tag? not ] [ f ] }
|
|
{ [ dup url>> chloe-ns = not ] [ f ] }
|
|
[ t ]
|
|
} cond nip ;
|
|
|
|
: process-tag-children ( tag -- )
|
|
[ process-template ] each ;
|
|
|
|
CHLOE: chloe process-tag-children ;
|
|
|
|
: children>string ( tag -- string )
|
|
[ process-tag-children ] with-string-writer ;
|
|
|
|
CHLOE: title children>string set-title ;
|
|
|
|
CHLOE: write-title
|
|
drop
|
|
"head" tag-stack get member?
|
|
"title" tag-stack get member? not and
|
|
[ <title> write-title </title> ] [ write-title ] if ;
|
|
|
|
CHLOE: style
|
|
dup "include" optional-attr dup [
|
|
swap children>string empty? [
|
|
"style tag cannot have both an include attribute and a body" throw
|
|
] unless
|
|
utf8 file-contents
|
|
] [
|
|
drop children>string
|
|
] if add-style ;
|
|
|
|
CHLOE: write-style
|
|
drop <style> write-style </style> ;
|
|
|
|
CHLOE: even "index" value even? [ process-tag-children ] [ drop ] if ;
|
|
|
|
CHLOE: odd "index" value odd? [ process-tag-children ] [ drop ] if ;
|
|
|
|
: (bind-tag) ( tag quot -- )
|
|
[
|
|
[ "name" required-attr ] keep
|
|
'[ , process-tag-children ]
|
|
] dip call ; inline
|
|
|
|
CHLOE: each [ with-each-value ] (bind-tag) ;
|
|
|
|
CHLOE: bind-each [ with-each-object ] (bind-tag) ;
|
|
|
|
CHLOE: bind [ with-values ] (bind-tag) ;
|
|
|
|
: error-message-tag ( tag -- )
|
|
children>string render-error ;
|
|
|
|
CHLOE: comment drop ;
|
|
|
|
CHLOE: call-next-template drop call-next-template ;
|
|
|
|
: attr>word ( value -- word/f )
|
|
dup ":" split1 swap lookup
|
|
[ ] [ "No such word: " swap append throw ] ?if ;
|
|
|
|
: if-satisfied? ( tag -- ? )
|
|
[ "code" optional-attr [ attr>word execute ] [ t ] if* ]
|
|
[ "value" optional-attr [ value ] [ t ] if* ]
|
|
bi and ;
|
|
|
|
CHLOE: if dup if-satisfied? [ process-tag-children ] [ drop ] if ;
|
|
|
|
CHLOE-SINGLETON: label
|
|
CHLOE-SINGLETON: link
|
|
CHLOE-SINGLETON: farkup
|
|
CHLOE-SINGLETON: inspector
|
|
CHLOE-SINGLETON: comparison
|
|
CHLOE-SINGLETON: html
|
|
CHLOE-SINGLETON: hidden
|
|
|
|
CHLOE-TUPLE: field
|
|
CHLOE-TUPLE: textarea
|
|
CHLOE-TUPLE: password
|
|
CHLOE-TUPLE: choice
|
|
CHLOE-TUPLE: checkbox
|
|
CHLOE-TUPLE: code
|
|
|
|
: process-chloe-tag ( tag -- )
|
|
dup name-tag dup tags get at
|
|
[ call ] [ "Unknown chloe tag: " prepend throw ] ?if ;
|
|
|
|
: process-tag ( tag -- )
|
|
{
|
|
[ name-tag >lower tag-stack get push ]
|
|
[ write-start-tag ]
|
|
[ process-tag-children ]
|
|
[ write-end-tag ]
|
|
[ drop tag-stack get pop* ]
|
|
} cleave ;
|
|
|
|
: expand-attrs ( tag -- tag )
|
|
dup [ tag? ] is? [
|
|
clone [
|
|
[ "@" ?head [ value present ] when ] assoc-map
|
|
] change-attrs
|
|
] when ;
|
|
|
|
: process-template ( xml -- )
|
|
expand-attrs
|
|
{
|
|
{ [ dup [ chloe-tag? ] is? ] [ process-chloe-tag ] }
|
|
{ [ dup [ tag? ] is? ] [ process-tag ] }
|
|
{ [ t ] [ write-item ] }
|
|
} cond ;
|
|
|
|
: process-chloe ( xml -- )
|
|
[
|
|
V{ } clone tag-stack set
|
|
|
|
nested-template? get [
|
|
process-template
|
|
] [
|
|
{
|
|
[ xml-prolog write-prolog ]
|
|
[ xml-before write-chunk ]
|
|
[ process-template ]
|
|
[ xml-after write-chunk ]
|
|
} cleave
|
|
] if
|
|
] with-scope ;
|
|
|
|
M: chloe call-template*
|
|
path>> ".xml" append utf8 <file-reader> read-xml process-chloe ;
|
|
|
|
INSTANCE: chloe template
|