1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays kernel combinators assocs
4 namespaces sequences splitting words
5 fry urls multiline present qualified
16 html.templates.chloe.compiler
17 html.templates.chloe.syntax
20 http.server.redirection
23 QUALIFIED-WITH: assocs a
24 IN: furnace.chloe-tags
27 : parse-query-attr ( string -- assoc )
28 [ f ] [ "," split [ dup value ] H{ } map>assoc ] if-empty ;
30 : a-url-path ( href rest -- string )
32 [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;
34 : a-url ( href rest query value-name -- url )
35 dup [ >r 3drop r> value ] [
38 swap parse-query-attr >>query
39 -rot a-url-path >>path
40 adjust-url relative-to-request
43 : compile-a-url ( tag -- )
45 [ "href" required-attr compile-attr ]
46 [ "rest" optional-attr compile-attr ]
47 [ "query" optional-attr compile-attr ]
48 [ "value" optional-attr compile-attr ]
49 } cleave [ a-url ] [code] ;
52 [ compile-children>string ] [ compile-a-url ] bi
53 [ add-atom-feed ] [code] ;
55 CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
57 : compile-link-attrs ( tag -- )
58 #! Side-effects current namespace.
59 attrs>> '[ [ [ _ ] dip link-attr ] each-responder ] [code] ;
61 : a-start-tag ( tag -- )
62 [ compile-link-attrs ] [ compile-a-url ] bi
63 [ <a =href a> ] [code] ;
65 : a-end-tag ( tag -- )
66 drop [ </a> ] [code] ;
70 [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri
71 ] compile-with-scope ;
73 : compile-hidden-form-fields ( for -- )
75 _ [ "," split [ hidden render ] each ] when*
76 nested-forms get " " join f like nested-forms-key hidden-form-field
77 [ modify-form ] each-responder
80 : compile-form-attrs ( method action attrs -- )
82 [ compile-attr [ =method ] [code] ]
83 [ compile-attr [ resolve-base-path =action ] [code] ]
88 : form-start-tag ( tag -- )
90 [ "method" optional-attr "post" or ]
91 [ "action" required-attr ]
92 [ attrs>> non-chloe-attrs-only ] tri
95 [ "for" optional-attr compile-hidden-form-fields ] bi ;
97 : form-end-tag ( tag -- )
98 drop [ </form> ] [code] ;
103 [ compile-link-attrs ]
108 ] compile-with-scope ;
110 STRING: button-tag-markup
111 <t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
112 <button type="submit"></button>
116 : add-tag-attrs ( attrs tag -- )
117 attrs>> swap update ;
120 button-tag-markup string>xml body>>
122 [ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
123 [ [ attrs>> non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
124 [ [ children>> ] dip "button" tag-named (>>children) ]
126 } 2cleave compile-chloe-tag ;