Getting rid of html.elements from most vocabs

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

@@ -66,16 +66,26 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
     tri
     [ =href a> ] [code] ;
 
-: a-end-tag ( tag -- )
+: process-attrs ( assoc -- newassoc )
-    drop [ </a> ] [code] ;
+    [ "@" ?head [ value present ] when ] assoc-map ;
+
+: non-chloe-attrs ( tag -- )
+    attrs>> non-chloe-attrs-only [ process-attrs ] [code-with] ;
+
+: a-attrs ( tag -- )
+    [ non-chloe-attrs ]
+    [ compile-link-attrs ]
+    [ compile-a-url ] tri
+    [ swap "href" swap set-at ] [code] ;
 
 CHLOE: a
-    [
+    [ a-attrs ]
-        [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri
+    [ compile-children>string ] bi
-    ] compile-with-scope ;
+    [ <unescaped> [XML <a><-></a> XML] swap >>attrs ]
+    [xml-code] ;
 
 CHLOE: base
-    compile-a-url [ <base =href base/> ] [code] ;
+    compile-a-url [ [XML <base href=<->/> XML] ] [xml-code] ;
 
 : compile-hidden-form-fields ( for -- )
     '[
@@ -121,13 +131,13 @@ CHLOE: form
         <t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
             <div style="display: inline;"><button type="submit"></button></div>
         </t:form>
-    XML> ;
+    XML> body>> clone ;
 
 : add-tag-attrs ( attrs tag -- )
     attrs>> swap update ;
 
 CHLOE: button
-    button-tag-markup body>>
+    button-tag-markup
     {
         [ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
         [ [ attrs>> non-chloe-attrs-only ] dip "button" deep-tag-named add-tag-attrs ]

basis/furnace/furnace-tests.factor

@@ -30,7 +30,7 @@ M: base-path-check-responder call-responder*
     "a/b/c" split-path main-responder get call-responder body>>
 ] unit-test
 
-[ "<input type='hidden' name='foo' value='&amp;&amp;&amp;'/>" ]
+[ "<input type=\"hidden\" value=\"&amp;&amp;&amp;\" name=\"foo\"/>" ]
 [ [ "&&&" "foo" hidden-form-field ] with-string-writer ]
 unit-test
 

basis/furnace/sessions/sessions.factor

@@ -5,7 +5,7 @@ strings random accessors quotations hashtables sequences
 continuations fry calendar combinators combinators.short-circuit
 destructors alarms io.sockets db db.tuples db.types
 http http.server http.server.dispatchers http.server.filters
-html.elements furnace.cache furnace.scopes furnace.utilities ;
+furnace.cache furnace.scopes furnace.utilities ;
 IN: furnace.sessions
 
 TUPLE: session < scope user-agent client ;

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 html.elements http http.server
+continuations present fry urls http http.server xml.literals xml.writer
 http.server.redirection http.server.remapping ;
 IN: furnace.utilities
 
@@ -83,11 +83,8 @@ M: object modify-form drop ;
 
 : hidden-form-field ( value name -- )
     over [
-        <input
+        [XML <input type="hidden" value=<-> name=<->/> XML]
-            "hidden" =type
+        write-xml
-            =name
-            present =value
-        input/>
     ] [ 2drop ] if ;
 
 : nested-forms-key "__n" ;

basis/html/templates/chloe/chloe-docs.factor

@@ -128,7 +128,7 @@ ARTICLE: "html.templates.chloe.tags.form" "Chloe link and form tags"
             "<a href=\"http://mysite.org/wiki/view/Factor\""
             "   class=\"small-link\">"
             "    View"
-            "s</a>"
+            "</a>"
         }
     } }
     { { $snippet "t:base" } { "Outputs an HTML " { $snippet "<base>" } " tag. The attributes are interpreted in the same manner as the attributes of " { $snippet "t:a" } "." } }
@@ -261,8 +261,8 @@ $nl
 ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custom Chloe component"
 "As an example, let's develop a custom Chloe component which renders an image stored in a form value. Since the component does not require any configuration, we can define a singleton class:"
 { $code "SINGLETON: image" }
-"Now we define a method on the " { $link render* } " generic word which renders the image using " { $vocab-link "html.elements" } ":"
+"Now we define a method on the " { $link render* } " generic word which renders the image using " { $vocab-link "xml.literals" } ":"
-{ $code "M: image render* 2drop <img =src img/> ;" }
+{ $code "M: image render* 2drop [XML <img src=<-> /> XML] ;" }
 "Finally, we can define a Chloe component:"
 { $code "COMPONENT: image" }
 "We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":"

basis/html/templates/chloe/chloe-tests.factor

@@ -135,7 +135,7 @@ TUPLE: person first-name last-name ;
 
 [ ] [ H{ { "a" H{ { "b" "c" } } } } values set ] unit-test
 
-[ "<form method='post' action='foo'><div style='display: none;'><input type='hidden' name='__n' value='a'/></div></form>" ] [
+[ "<form method='post' action='foo'><div style='display: none;'><input type=\"hidden\" value=\"a\" name=\"__n\"/></div></form>" ] [
     [
         "test10" test-template call-template
     ] run-template

basis/html/templates/chloe/chloe.factor

@@ -8,7 +8,6 @@ logging continuations
 xml.data xml.writer xml.literals strings
 html.forms
 html
-html.elements
 html.components
 html.templates
 html.templates.chloe.compiler
@@ -28,7 +27,9 @@ CHLOE: write-title
     drop
     "head" tag-stack get member?
     "title" tag-stack get member? not and
-    [ <title> write-title </title> ] [ write-title ] ? [code] ;
+    [ get-title [XML <title><-></title> XML] ]
+    [ get-title ] ?
+    [xml-code] ;
 
 CHLOE: style
     dup "include" optional-attr [
@@ -39,10 +40,9 @@ CHLOE: style
 
 CHLOE: write-style
     drop [
-        <style "text/css" =type style>
+        get-style
-            write-style
+        [XML <style type="text/css"> <-> </style> XML]
-        </style>
+    ] [xml-code] ;
-    ] [code] ;
 
 CHLOE: even
     [ "index" value even? swap when ] process-children ;

basis/html/templates/chloe/compiler/compiler.factor

@@ -42,6 +42,9 @@ DEFER: compile-element
 : [code-with] ( obj quot -- )
     reset-buffer [ , ] [ % ] bi* ;
 
+: [xml-code] ( quot -- )
+    [ write-xml ] compose [code] ;
+
 : expand-attr ( value -- )
     [ value present write ] [code-with] ;
 

basis/html/templates/templates.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel fry io io.encodings.utf8 io.files
 debugger prettyprint continuations namespaces boxes sequences
-arrays strings html io.streams.string
+arrays strings html io.streams.string assocs
 quotations xml.data xml.writer xml.literals ;
 IN: html.templates
 
@@ -34,8 +34,11 @@ SYMBOL: title
 : set-title ( string -- )
     title get >box ;
 
+: get-title ( -- string )
+    title get value>> ;
+
 : write-title ( -- )
-    title get value>> write ;
+    get-title write ;
 
 SYMBOL: style
 
@@ -43,24 +46,30 @@ SYMBOL: style
     "\n" style get push-all
          style get push-all ;
 
+: get-style ( -- string )
+    style get >string ;
+
 : write-style ( -- )
-    style get >string write ;
+    get-style write ;
 
 SYMBOL: atom-feeds
 
 : add-atom-feed ( title url -- )
     2array atom-feeds get push ;
 
-: write-atom-feeds ( -- )
+: get-atom-feeds ( -- xml )
     atom-feeds get [
-        first2 [XML
+        [XML
             <link
                 rel="alternate"
                 type="application/atom+xml"
                 title=<->
                 href=<->/>
-        XML] write-xml
+        XML]
-    ] each ;
+    ] { } assoc>map ;
+
+: write-atom-feeds ( -- )
+    get-atom-feeds write-xml ;
 
 SYMBOL: nested-template?
 

extra/webapps/user-admin/user-admin.factor

@@ -3,7 +3,6 @@
 USING: kernel sequences accessors namespaces combinators words
 assocs db.tuples arrays splitting strings validators urls
 html.forms
-html.elements
 html.components
 furnace
 furnace.boilerplate