1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel sequences combinators kernel fry
4 namespaces classes.tuple assocs splitting words arrays memoize
5 io io.files io.encodings.utf8 io.streams.string unicode.case
6 mirrors math urls present multiline quotations xml xml.data
11 html.templates.chloe.compiler
12 html.templates.chloe.components
13 html.templates.chloe.syntax ;
14 IN: html.templates.chloe
16 ! Chloe is Ed's favorite web designer
21 CHLOE: chloe compile-children ;
23 CHLOE: title compile-children>string [ set-title ] [code] ;
27 "head" tag-stack get member?
28 "title" tag-stack get member? not and
29 [ <title> write-title </title> ] [ write-title ] ? [code] ;
32 dup "include" optional-attr [
33 utf8 file-contents [ add-style ] [code-with]
35 compile-children>string [ add-style ] [code]
39 drop [ <style> write-style </style> ] [code] ;
42 [ "index" value even? swap when ] process-children ;
45 [ "index" value odd? swap when ] process-children ;
47 : (bind-tag) ( tag quot -- )
49 [ "name" required-attr compile-attr ] keep
50 ] dip process-children ; inline
52 CHLOE: each [ with-each-value ] (bind-tag) ;
54 CHLOE: bind-each [ with-each-object ] (bind-tag) ;
56 CHLOE: bind [ with-form ] (bind-tag) ;
60 CHLOE: call-next-template
61 drop reset-buffer \ call-next-template , ;
63 : attr>word ( value -- word/f )
64 ":" split1 swap lookup ;
66 : if>quot ( tag -- quot )
68 [ "code" optional-attr [ attr>word [ , ] [ f , ] if* ] [ t , ] if* ]
69 [ "value" optional-attr [ , \ value , ] [ t , ] if* ]
74 CHLOE: if dup if>quot [ swap when ] append process-children ;
76 CHLOE-SINGLETON: label
78 CHLOE-SINGLETON: inspector
79 CHLOE-SINGLETON: comparison
81 CHLOE-SINGLETON: hidden
91 : read-template ( chloe -- xml )
92 path>> ".xml" append utf8 <file-reader> read-xml ;
94 MEMO: template-quot ( chloe -- quot )
95 read-template compile-template ;
97 MEMO: nested-template-quot ( chloe -- quot )
98 read-template compile-nested-template ;
100 : reset-templates ( -- )
101 { template-quot nested-template-quot } [ reset-memoized ] each ;
103 M: chloe call-template*
105 [ nested-template-quot ] [ template-quot ] if
108 INSTANCE: chloe template