Finishing getting rid of html.elements from basis

basis/furnace/chloe-tags/chloe-tags.factor

@@ -10,7 +10,6 @@ xml.writer
 xml.traversal
 xml.syntax
 html.components
-html.elements
 html.forms
 html.templates
 html.templates.chloe
@@ -58,14 +57,6 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
     #! Side-effects current namespace.
     '[ [ [ _ ] dip link-attr ] each-responder ] [code] ;
 
-: a-start-tag ( tag -- )
-    [ <a ] [code]
-    [ attrs>> non-chloe-attrs-only compile-attrs ]
-    [ compile-link-attrs ]
-    [ compile-a-url ]
-    tri
-    [ =href a> ] [code] ;
-
 : process-attrs ( assoc -- newassoc )
     [ "@" ?head [ value present ] when ] assoc-map ;
 
@@ -76,54 +67,61 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
     [ non-chloe-attrs ]
     [ compile-link-attrs ]
     [ compile-a-url ] tri
-    [ swap "href" swap set-at ] [code] ;
+    [ present swap "href" swap [ set-at ] keep ] [code] ;
 
 CHLOE: a
-    [ a-attrs ]
+    [
-    [ compile-children>string ] bi
+        [ a-attrs ]
-    [ <unescaped> [XML <a><-></a> XML] swap >>attrs ]
+        [ compile-children>string ] bi
-    [xml-code] ;
+        [ <unescaped> [XML <a><-></a> XML] second swap >>attrs ]
+        [xml-code]
+    ] compile-with-scope ;
 
 CHLOE: base
     compile-a-url [ [XML <base href=<->/> XML] ] [xml-code] ;
 
+USE: io.streams.string
+
 : compile-hidden-form-fields ( for -- )
     '[
-        <div "display: none;" =style div>
+        [
             _ [ "," split [ hidden render ] each ] when*
             nested-forms get " " join f like nested-forms-key hidden-form-field
             [ modify-form ] each-responder
-        </div>
+        ] with-string-writer <unescaped>
+        [XML <div style="display:none;"><-></div> XML]
     ] [code] ;
 
-: compile-form-attrs ( method action attrs -- )
+: (compile-form-attrs) ( method action -- )
-    [ <form ] [code]
+    ! Leaves an assoc on the stack at runtime
-    [ compile-attr [ =method ] [code] ]
+    [ compile-attr [ "method" pick set-at ] [code] ]
-    [ compile-attr [ resolve-base-path =action ] [code] ]
+    [ compile-attr [ resolve-base-path "action" pick set-at ] [code] ]
-    [ compile-attrs ]
+    bi* ;
-    tri*
-    [ form> ] [code] ;
 
-: form-start-tag ( tag -- )
+: compile-method/action ( tag -- )
-    [
+    ! generated code is ( assoc -- assoc )
-        [ "method" optional-attr "post" or ]
+    [ "method" optional-attr "post" or ]
-        [ "action" required-attr ]
+    [ "action" required-attr ] bi
-        [ attrs>> non-chloe-attrs-only ] tri
+    (compile-form-attrs) ;
-        compile-form-attrs
-    ]
-    [ "for" optional-attr compile-hidden-form-fields ] bi ;
 
-: form-end-tag ( tag -- )
+: compile-form-attrs ( tag -- )
-    drop [ </form> ] [code] ;
+    [ non-chloe-attrs ]
+    [ compile-link-attrs ]
+    [ compile-method/action ] tri ;
+
+: hidden-fields ( tag -- )
+    "for" optional-attr compile-hidden-form-fields ;
 
 CHLOE: form
     [
-        {
+        [ compile-form-attrs ]
-            [ compile-link-attrs ]
+        [ hidden-fields ]
-            [ form-start-tag ]
+        [ compile-children>string ] tri
-            [ compile-children ]
+        [
-            [ form-end-tag ]
+            <unescaped> [XML <form><-><-></form> XML] second
-        } cleave
+                swap >>attrs
+            write-xml
+        ] [code]
     ] compile-with-scope ;
 
 : button-tag-markup ( -- xml )

basis/furnace/utilities/utilities.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces make assocs sequences kernel classes splitting
 words vocabs.loader accessors strings combinators arrays
-continuations present fry urls http http.server xml.literals xml.writer
+continuations present fry urls http http.server xml.syntax xml.writer
 http.server.redirection http.server.remapping ;
 IN: furnace.utilities
 

basis/html/components/components.factor

@@ -11,7 +11,7 @@ IN: html.components
 
 GENERIC: render* ( value name renderer -- xml )
 
-: render ( name renderer -- )
+: render>xml ( name renderer -- xml )
     prepare-value
     [
         dup validation-error?
@@ -20,7 +20,10 @@ GENERIC: render* ( value name renderer -- xml )
         if
     ] 2dip
     render*
-    swap 2array write-xml ;
+    swap 2array ;
+
+: render ( name renderer -- )
+    render>xml write-xml ;
 
 SINGLETON: label