From 5f681d4f3399e7c2c3dac4f500c2ced83bab6a82 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 31 Jan 2009 17:29:04 -0600
Subject: [PATCH 01/12] add test cases to svg to cover recent breakage

---
 extra/svg/svg-tests.factor | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

diff --git a/extra/svg/svg-tests.factor b/extra/svg/svg-tests.factor
index 2e1f88b29b..3a28310d71 100644
--- a/extra/svg/svg-tests.factor
+++ b/extra/svg/svg-tests.factor
@@ -1,6 +1,6 @@
 ! (c)2009 Joe Groff, see BSD license
-USING: arrays literals math math.affine-transforms math.functions multiline
-svg tools.test ;
+USING: accessors arrays literals math math.affine-transforms
+math.functions multiline sequences svg tools.test xml xml.utilities ;
 IN: svg.tests
 
 { 1.0 2.25 } { -3.0 4.0 } { 5.5 0.000001 } <affine-transform> 1array [
@@ -94,3 +94,18 @@ IN: svg.tests
     A 5 6 7 1 0 8 9
     "> svg-path>array
 ] unit-test
+
+STRING: test-svg-string
+<svg xmlns="http://www.w3.org/2000/svg">
+        <path transform="translate(1 2)" d="M -1 -1 l 2 2" />
+</svg>
+;
+
+: test-svg-path
+    test-svg-string string>xml body>> children-tags first ;
+
+[ { T{ moveto f { -1.0 -1.0 } f } T{ lineto f { 2.0 2.0 } t } } ]
+[ test-svg-path tag-d ] unit-test
+
+[ T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 1.0 2.0 } } ]
+[ test-svg-path tag-transform ] unit-test

From 04087885184199ed8e3f018f39b605a4cb9c7d75 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 20:44:17 -0600
Subject: [PATCH 02/12] Rewrite html.streams to use xml.literals

---
 basis/html/components/components-docs.factor  |   4 +-
 basis/html/components/components-tests.factor |   7 +-
 basis/html/components/components.factor       |  13 +-
 basis/html/elements/elements-docs.factor      |   6 +-
 basis/html/elements/elements.factor           |   8 +
 basis/html/html.factor                        |  30 +--
 basis/html/streams/streams-docs.factor        |  34 ++--
 basis/html/streams/streams-tests.factor       |  36 ++--
 basis/html/streams/streams.factor             | 182 ++++++++----------
 basis/html/templates/fhtml/fhtml.factor       |  14 +-
 basis/html/templates/templates.factor         |   2 +-
 11 files changed, 145 insertions(+), 191 deletions(-)

diff --git a/basis/html/components/components-docs.factor b/basis/html/components/components-docs.factor
index 39c17a4708..ce4bddde6a 100644
--- a/basis/html/components/components-docs.factor
+++ b/basis/html/components/components-docs.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Your name.
+! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax io.streams.string kernel strings
 urls lcs inspector present io ;
@@ -100,6 +100,6 @@ $nl
 { $subsection farkup }
 "Creating custom components:"
 { $subsection render* }
-"Custom components can emit HTML using the " { $vocab-link "html.elements" } " vocabulary." ;
+"Custom components can emit HTML using the " { $vocab-link "xml.literals" } " vocabulary." ;
 
 ABOUT: "html.components"
diff --git a/basis/html/components/components-tests.factor b/basis/html/components/components-tests.factor
index 09bb5860ad..b3ea0319a8 100644
--- a/basis/html/components/components-tests.factor
+++ b/basis/html/components/components-tests.factor
@@ -1,7 +1,8 @@
 IN: html.components.tests
 USING: tools.test kernel io.streams.string
 io.streams.null accessors inspector html.streams
-html.elements html.components html.forms namespaces ;
+html.components html.forms namespaces
+xml.writer ;
 
 [ ] [ begin-form ] unit-test
 
@@ -163,9 +164,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
 
 [ t ] [
     [ "object" inspector render ] with-string-writer
-    USING: splitting sequences ;
-    "\"" split "'" join ! replace " with ' for now
-    [ "object" value [ describe ] with-html-writer ] with-string-writer
+    "object" value [ describe ] with-html-writer xml>string
     =
 ] unit-test
 
diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index be197d10e6..40621bc29f 100644
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@@ -22,13 +22,6 @@ GENERIC: render* ( value name renderer -- xml )
     render* write-xml
     [ render-error ] when* ;
 
-<PRIVATE
-
-: render-input ( value name type -- xml )
-    [XML <input value=<-> name=<-> type=<->/> XML] ;
-
-PRIVATE>
-
 SINGLETON: label
 
 M: label render*
@@ -37,7 +30,7 @@ M: label render*
 SINGLETON: hidden
 
 M: hidden render*
-    drop "hidden" render-input ;
+    drop [XML <input value=<-> name=<-> type="hidden"/> XML] ;
 
 : render-field ( value name size type -- xml )
     [XML <input value=<-> name=<-> size=<-> type=<->/> XML] ;
@@ -163,9 +156,7 @@ M: farkup render*
 SINGLETON: inspector
 
 M: inspector render*
-    2drop [
-        [ describe ] with-html-writer
-    ] with-string-writer <unescaped> ;
+    2drop [ describe ] with-html-writer ;
 
 ! Diff component
 SINGLETON: comparison
diff --git a/basis/html/elements/elements-docs.factor b/basis/html/elements/elements-docs.factor
index 05b202e08e..7f60eca93f 100644
--- a/basis/html/elements/elements-docs.factor
+++ b/basis/html/elements/elements-docs.factor
@@ -20,10 +20,6 @@ $nl
 $nl
 "Writing unescaped HTML to " { $vocab-link "html.streams" } ":"
 { $subsection write-html }
-{ $subsection print-html }
-"Writing some common HTML patterns:"
-{ $subsection xhtml-preamble }
-{ $subsection simple-page }
-{ $subsection render-error } ;
+{ $subsection print-html } ;
 
 ABOUT: "html.elements"
diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor
index b0e46984d7..e23d929d6d 100644
--- a/basis/html/elements/elements.factor
+++ b/basis/html/elements/elements.factor
@@ -6,6 +6,14 @@ xml.data xml.literals urls math math.parser combinators
 present fry io.streams.string xml.writer html ;
 IN: html.elements
 
+SYMBOL: html
+
+: write-html ( str -- )
+    H{ { html t } } format ;
+
+: print-html ( str -- )
+    write-html "\n" write-html ;
+
 <<
 
 : elements-vocab ( -- vocab-name ) "html.elements" ;
diff --git a/basis/html/html.factor b/basis/html/html.factor
index 5469941972..5e86add10e 100644
--- a/basis/html/html.factor
+++ b/basis/html/html.factor
@@ -1,23 +1,10 @@
-! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg.
+! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg,
+! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io kernel xml.data xml.writer io.streams.string
-xml.literals io.styles ;
+USING: kernel xml.data xml.writer xml.literals urls.encoding ;
 IN: html
 
-SYMBOL: html
-
-: write-html ( str -- )
-    H{ { html t } } format ;
-
-: print-html ( str -- )
-    write-html "\n" write-html ;
-
-: xhtml-preamble ( -- )
-    "<?xml version=\"1.0\"?>" write-html
-    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ;
-
-: simple-page ( title head-quot body-quot -- )
-    [ with-string-writer <unescaped> ] bi@
+: simple-page ( title head body -- xml )
     <XML
         <?xml version="1.0"?>
         <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
@@ -28,7 +15,10 @@ SYMBOL: html
             </head>
             <body><-></body>
         </html>
-    XML> write-xml ; inline
+    XML> ; inline
 
-: render-error ( message -- )
-    [XML <span class="error"><-></span> XML] write-xml ;
+: render-error ( message -- xml )
+    [XML <span class="error"><-></span> XML] ;
+
+: simple-link ( xml url -- xml' )
+    url-encode swap [XML <a href=<->><-></a> XML] ;
\ No newline at end of file
diff --git a/basis/html/streams/streams-docs.factor b/basis/html/streams/streams-docs.factor
index f05eeb30fc..c85ab739b8 100644
--- a/basis/html/streams/streams-docs.factor
+++ b/basis/html/streams/streams-docs.factor
@@ -1,33 +1,33 @@
 IN: html.streams
 USING: help.markup help.syntax kernel strings io io.styles
-quotations ;
+quotations xml.data ;
 
-HELP: browser-link-href
-{ $values { "presented" object } { "href" string } }
-{ $contract "Outputs a link to a page displaying a presentation of the given object. This word is called when " { $link write-object } " is called on " { $link html-stream } " instances." } ;
+HELP: url-of
+{ $values { "object" object } { "url" string } }
+{ $contract "Outputs a link to a page displaying a presentation of the given object. This word is called when " { $link write-object } " is called on " { $link html-writer } " instances." } ;
 
-HELP: html-stream
-{ $class-description "A formatted output stream which emits HTML markup." } ;
+HELP: html-writer
+{ $class-description "A formatted output stream which accumulates HTML markup as " { $vocab-link "xml.data" } " types. The " { $slot "data" } " slot contains a sequence with all markup so far." } ;
 
-HELP: <html-stream>
-{ $values { "stream" "an output stream" } { "html-stream" html-stream } }
-{ $description "Creates a new formatted output stream which emits HTML markup on " { $snippet "stream" } "." } ;
+HELP: <html-writer>
+{ $values { "html-writer" html-writer } }
+{ $description "Creates a new formatted output stream which accumulates HTML markup in its " { $snippet "data" } " slot." } ;
 
 HELP: with-html-writer
-{ $values { "quot" quotation } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an " { $link html-stream } " wrapping the current " { $link output-stream } "." }
+{ $values { "quot" quotation } { "xml" xml-chunk } }
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an " { $link html-writer } ". When the quotation returns, outputs the accumulated HTML markup." }
 { $examples
     { $example
-        "USING: io io.styles html.streams ;"
-        "[ \"Hello\" { { font-style bold } } format nl ] with-html-writer"
-        "<span style='font-style: normal; font-weight: bold; '>Hello</span><br/>"
+        "USING: io io.styles html.streams xml.writer ;"
+        "[ \"Hello\" { { font-style bold } } format nl ] with-html-writer write-xml"
+        "<span style=\"font-style: normal; font-weight: bold; \">Hello</span><br/>"
     }
 } ;
 
 ARTICLE: "html.streams" "HTML streams"
-"The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "styles" } " by writing HTML markup to the wrapped stream."
-{ $subsection html-stream }
-{ $subsection <html-stream> }
+"The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "io.styles" } " by constructing HTML markup in the form of " { $vocab-link "xml.data" } " types."
+{ $subsection html-writer }
+{ $subsection <html-writer> }
 { $subsection with-html-writer } ;
 
 ABOUT: "html.streams"
diff --git a/basis/html/streams/streams-tests.factor b/basis/html/streams/streams-tests.factor
index 94229b3aea..249861b12a 100644
--- a/basis/html/streams/streams-tests.factor
+++ b/basis/html/streams/streams-tests.factor
@@ -1,17 +1,14 @@
 USING: html.streams html.streams.private accessors io
 io.streams.string io.styles kernel namespaces tools.test
-xml.writer sbufs sequences inspector colors ;
+xml.writer sbufs sequences inspector colors xml.writer
+classes.predicate prettyprint ;
 IN: html.streams.tests
 
-: make-html-string
-    [ with-html-writer ] with-string-writer ; inline
+: make-html-string ( quot -- string )
+    [ with-html-writer write-xml ] with-string-writer ; inline
 
 [ [ ] make-html-string ] must-infer
 
-[ ] [
-    512 <sbuf> <html-stream> drop
-] unit-test
-
 [ "" ] [
     [ "" write ] make-html-string
 ] unit-test
@@ -24,31 +21,26 @@ IN: html.streams.tests
     [ "<" write ] make-html-string
 ] unit-test
 
-[ "<" ] [
-    [ "<" H{ } output-stream get format-html-span ] make-html-string
-] unit-test
-
 TUPLE: funky town ;
 
-M: funky browser-link-href
-    "http://www.funky-town.com/" swap town>> append ;
+M: funky url-of "http://www.funky-town.com/" swap town>> append ;
 
-[ "<a href='http://www.funky-town.com/austin'>&lt;</a>" ] [
+[ "<a href=\"http://www.funky-town.com/austin\">&lt;</a>" ] [
     [
         "<" "austin" funky boa write-object
     ] make-html-string
 ] unit-test
 
-[ "<span style='font-family: monospace; '>car</span>" ]
+[ "<span style=\"font-family: monospace; \">car</span>" ]
 [
     [
         "car"
-        H{ { font "monospace" } }
+        H{ { font-name "monospace" } }
         format
     ] make-html-string
 ] unit-test
 
-[ "<span style='color: #ff00ff; '>car</span>" ]
+[ "<span style=\"color: #ff00ff; \">car</span>" ]
 [
     [
         "car"
@@ -57,7 +49,7 @@ M: funky browser-link-href
     ] make-html-string
 ] unit-test
 
-[ "<div style='background-color: #ff00ff; white-space: pre; font-family: monospace; '>cdr</div>" ]
+[ "<div style=\"background-color: #ff00ff; white-space: pre; font-family: monospace;\">cdr</div>" ]
 [
     [
         H{ { page-color T{ rgba f 1 0 1 1 } } }
@@ -65,10 +57,10 @@ M: funky browser-link-href
     ] make-html-string
 ] unit-test
 
-[
-    "<div style='white-space: pre; font-family: monospace; '></div>"
-] [
+[ "<div style=\"white-space: pre; font-family: monospace;\"></div>" ] [
     [ H{ } [ ] with-nesting nl ] make-html-string
 ] unit-test
 
-[ ] [ [ { 1 2 3 } describe ] with-html-writer ] unit-test
+[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
+
+[ ] [ [ \ predicate-instance? def>> . ] with-html-writer drop ] unit-test
diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor
index 51eb37b83d..768f2bbaa8 100644
--- a/basis/html/streams/streams.factor
+++ b/basis/html/streams/streams.factor
@@ -1,17 +1,17 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators generic assocs io io.styles
-io.files continuations io.streams.string kernel math math.order
-math.parser namespaces make quotations assocs sequences strings
-words html.elements xml.entities sbufs continuations destructors
-accessors arrays urls.encoding html ;
+USING: accessors kernel assocs io io.styles math math.order math.parser
+sequences strings make words combinators macros xml.literals html fry
+destructors ;
 IN: html.streams
 
-GENERIC: browser-link-href ( presented -- href )
+GENERIC: url-of ( object -- url )
 
-M: object browser-link-href drop f ;
+M: object url-of drop f ;
 
-TUPLE: html-stream stream last-div ;
+TUPLE: html-writer data last-div ;
+
+<PRIVATE
 
 ! stream-nl after with-nesting or tabular-output is
 ! ignored, so that HTML stream output looks like
@@ -25,37 +25,28 @@ TUPLE: html-stream stream last-div ;
 : a-div ( stream -- stream )
     t >>last-div ; inline
 
-: <html-stream> ( stream -- html-stream )
-    f html-stream boa ;
+: new-html-writer ( class -- html-writer )
+    new V{ } clone >>data ; inline
 
-<PRIVATE
-
-TUPLE: html-sub-stream < html-stream style parent ;
+TUPLE: html-sub-stream < html-writer style parent ;
 
 : new-html-sub-stream ( style stream class -- stream )
-    new
-        512 <sbuf> >>stream
+    new-html-writer
         swap >>parent
         swap >>style ; inline
 
 : end-sub-stream ( substream -- string style stream )
-    [ stream>> >string ] [ style>> ] [ parent>> ] tri ;
+    [ data>> ] [ style>> ] [ parent>> ] tri ;
 
-: object-link-tag ( style quot -- )
-    presented pick at [
-        browser-link-href [
-            <a url-encode =href a> call </a>
-        ] [ call ] if*
-    ] [ call ] if* ; inline
+: object-link-tag ( xml style -- xml )
+    presented swap at [ url-of [ simple-link ] when* ] when* ;
 
-: href-link-tag ( style quot -- )
-    href pick at [
-        <a url-encode =href a> call </a>
-    ] [ call ] if* ; inline
+: href-link-tag ( xml style -- xml )
+    href swap at [ simple-link ] when* ;
 
 : hex-color, ( color -- )
     [ red>> ] [ green>> ] [ blue>> ] tri
-    [ 255 * >fixnum >hex 2 CHAR: 0 pad-head % ] tri@ ;
+    [ 255 * >integer >hex 2 CHAR: 0 pad-head % ] tri@ ;
 
 : fg-css, ( color -- )
     "color: #" % hex-color, "; " % ;
@@ -76,32 +67,29 @@ TUPLE: html-sub-stream < html-stream style parent ;
 : font-css, ( font -- )
     "font-family: " % % "; " % ;
 
-: apply-style ( style key quot -- style gadget )
-    [ over at ] dip when* ; inline
-
-: make-css ( style quot -- str )
-    "" make nip ; inline
+MACRO: make-css ( pairs -- str )
+    [ '[ _ swap at [ _ execute ] when* ] ] { } assoc>map
+    '[ [ _ cleave ] "" make ] ;
 
 : span-css-style ( style -- str )
-    [
-        foreground [ fg-css,    ] apply-style
-        background [ bg-css,    ] apply-style
-        font       [ font-css,  ] apply-style
-        font-style [ style-css, ] apply-style
-        font-size  [ size-css,  ] apply-style
-    ] make-css ;
+    {
+        { foreground fg-css, }
+        { background bg-css, }
+        { font-name font-css, }
+        { font-style style-css, }
+        { font-size size-css, }
+    } make-css ;
 
-: span-tag ( style quot -- )
-    over span-css-style [
-        call
-    ] [
-        <span =style span> call </span>
-    ] if-empty ; inline
+: span-tag ( xml style -- xml )
+    span-css-style
+    [ swap [XML <span style=<->><-></span> XML] ] unless-empty ; inline
+
+: emit-html ( quot stream -- )
+    dip data>> push ; inline
 
 : format-html-span ( string style stream -- )
-    stream>> [
-        [ [ [ drop write ] span-tag ] href-link-tag ] object-link-tag
-    ] with-output-stream* ;
+    [ [ span-tag ] [ href-link-tag ] [ object-link-tag ] tri ]
+    emit-html ;
 
 TUPLE: html-span-stream < html-sub-stream ;
 
@@ -113,28 +101,26 @@ M: html-span-stream dispose
 
 : padding-css, ( padding -- ) "padding: " % # "px; " % ;
 
-: pre-css, ( margin -- )
-    [ "white-space: pre; font-family: monospace; " % ] unless ;
+CONSTANT: pre-css "white-space: pre; font-family: monospace;"
 
 : div-css-style ( style -- str )
     [
-        page-color   [ bg-css,      ] apply-style
-        border-color [ border-css,  ] apply-style
-        border-width [ padding-css, ] apply-style
-        wrap-margin over at pre-css,
-    ] make-css ;
-
-: div-tag ( style quot -- )
-    swap div-css-style [
-        call
+        {
+            { page-color bg-css, }
+            { border-color border-css, }
+            { border-width padding-css, }
+        } make-css
     ] [
-        <div =style div> call </div>
-    ] if-empty ; inline
+        wrap-margin swap at
+        [ pre-css append ] unless
+    ] bi ;
+
+: div-tag ( xml style -- xml' )
+    div-css-style
+    [ swap [XML <div style=<->><-></div> XML] ] unless-empty ;
 
 : format-html-div ( string style stream -- )
-    stream>> [
-        [ [ write ] div-tag ] object-link-tag
-    ] with-output-stream* ;
+    [ [ div-tag ] [ object-link-tag ] bi ] emit-html ;
 
 TUPLE: html-block-stream < html-sub-stream ;
 
@@ -145,57 +131,51 @@ M: html-block-stream dispose ( quot style stream -- )
     "padding: " % first2 max 2 /i # "px; " % ;
 
 : table-style ( style -- str )
-    [
-        table-border [ border-css,         ] apply-style
-        table-gap    [ border-spacing-css, ] apply-style
-    ] make-css ;
-
-: table-attrs ( style -- )
-    table-style " border-collapse: collapse;" append =style ;
-
-: do-escaping ( string style -- string )
-    html swap at [ escape-string ] unless ;
+    {
+        { table-border border-css, }
+        { table-gap border-spacing-css, }
+    } make-css
+    " border-collapse: collapse;" append ;
 
 PRIVATE>
 
 ! Stream protocol
-M: html-stream stream-flush
-    stream>> stream-flush ;
+M: html-writer stream-flush drop ;
 
-M: html-stream stream-write1
-    [ 1string ] dip stream-write ;
+M: html-writer stream-write1
+    not-a-div [ 1string ] emit-html ;
 
-M: html-stream stream-write
-    not-a-div [ escape-string ] dip stream>> stream-write ;
+M: html-writer stream-write
+    not-a-div [ ] emit-html ;
 
-M: html-stream stream-format
-    [ html over at [ [ escape-string ] dip ] unless ] dip
+M: html-writer stream-format
     format-html-span ;
 
-M: html-stream stream-nl
-    dup last-div? [ drop ] [ [ <br/> ] with-output-stream* ] if ;
+M: html-writer stream-nl
+    dup last-div? [ drop ] [ [ [XML <br/> XML] ] emit-html ] if ;
 
-M: html-stream make-span-stream
+M: html-writer make-span-stream
     html-span-stream new-html-sub-stream ;
 
-M: html-stream make-block-stream
+M: html-writer make-block-stream
     html-block-stream new-html-sub-stream ;
 
-M: html-stream make-cell-stream
+M: html-writer make-cell-stream
     html-sub-stream new-html-sub-stream ;
 
-M: html-stream stream-write-table
-    a-div stream>> [
-        <table dup table-attrs table> swap [
-            <tr> [
-                <td "top" =valign swap table-style =style td>
-                    stream>> >string write
-                </td>
-            ] with each </tr>
-        ] with each </table>
-    ] with-output-stream* ;
+M: html-writer stream-write-table
+    a-div [
+        table-style swap [
+            [ data>> [XML <td valign="top" style=<->><-></td> XML] ] with map
+            [XML <tr><-></tr> XML]
+        ] with map
+        [XML <table><-></table> XML]
+    ] emit-html ;
 
-M: html-stream dispose stream>> dispose ;
+M: html-writer dispose drop ;
 
-: with-html-writer ( quot -- )
-    output-stream get <html-stream> swap with-output-stream* ; inline
+: <html-writer> ( -- html-writer )
+    html-writer new-html-writer ;
+
+: with-html-writer ( quot -- xml )
+    <html-writer> [ swap with-output-stream* ] keep data>> ; inline
diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor
index 23bb469627..c419c4a197 100644
--- a/basis/html/templates/fhtml/fhtml.factor
+++ b/basis/html/templates/fhtml/fhtml.factor
@@ -1,12 +1,10 @@
 ! Copyright (C) 2005 Alex Chapman
-! Copyright (C) 2006, 2008 Slava Pestov
+! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations sequences kernel namespaces debugger
-combinators math quotations generic strings splitting
-accessors assocs fry vocabs.parser
-parser lexer io io.files io.streams.string io.encodings.utf8
-html
-html.templates ;
+combinators math quotations generic strings splitting accessors
+assocs fry vocabs.parser parser lexer io io.files
+io.streams.string io.encodings.utf8 html.templates ;
 IN: html.templates.fhtml
 
 ! We use a custom lexer so that %> ends a token even if not
@@ -34,13 +32,13 @@ DEFER: <% delimiter
     [
         over line-text>>
         [ column>> ] 2dip subseq parsed
-        \ write-html parsed
+        \ write parsed
     ] 2keep 2 + >>column drop ;
 
 : still-looking ( accum lexer -- accum )
     [
         [ line-text>> ] [ column>> ] bi tail
-        parsed \ print-html parsed
+        parsed \ print parsed
     ] keep next-line ;
 
 : parse-%> ( accum lexer -- accum )
diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor
index 6951f09efe..efaf8d6a62 100644
--- a/basis/html/templates/templates.factor
+++ b/basis/html/templates/templates.factor
@@ -67,7 +67,7 @@ SYMBOL: nested-template?
 SYMBOL: next-template
 
 : call-next-template ( -- )
-    next-template get write-html ;
+    next-template get write ;
 
 M: f call-template* drop call-next-template ;
 

From 938d9c733e75644d1fe667265490f6fa9a81fcd3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 20:44:30 -0600
Subject: [PATCH 03/12] Fix help.html for Dan's recent changes

---
 basis/help/html/html-tests.factor |  5 ++---
 basis/help/html/html.factor       | 28 ++++++++++++++++------------
 2 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/basis/help/html/html-tests.factor b/basis/help/html/html-tests.factor
index 475b2114b3..61414cdfa2 100644
--- a/basis/help/html/html-tests.factor
+++ b/basis/help/html/html-tests.factor
@@ -1,5 +1,4 @@
 IN: help.html.tests
-USING: html.streams classes.predicate help.topics help.markup
-io.streams.string accessors prettyprint kernel tools.test ;
+USING: help.html tools.test help.topics kernel ;
 
-[ ] [ [ [ \ predicate-instance? def>> . ] with-html-writer ] with-string-writer drop ] unit-test
+[ ] [ "xml" >link help>html drop ] unit-test
diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor
index 820261dd32..26fc4e2637 100644
--- a/basis/help/html/html.factor
+++ b/basis/help/html/html.factor
@@ -1,11 +1,11 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
 io.files io.files.temp io.directories html.streams help kernel
 assocs sequences make words accessors arrays help.topics vocabs
 tools.vocabs tools.vocabs.browser namespaces prettyprint io
 vocabs.loader serialize fry memoize unicode.case math.order
-sorting debugger html.elements html ;
+sorting debugger html xml.literals xml.writer ;
 IN: help.html
 
 : escape-char ( ch -- )
@@ -51,17 +51,21 @@ M: f topic>filename* drop \ f topic>filename* ;
         ] "" make
     ] [ 2drop f ] if ;
 
-M: topic browser-link-href topic>filename ;
+M: topic url-of topic>filename ;
 
-: help-stylesheet ( -- )
-    "resource:basis/help/html/stylesheet.css" ascii file-contents write ;
+: help-stylesheet ( -- string )
+    "resource:basis/help/html/stylesheet.css" ascii file-contents
+    [XML <style><-></style> XML] ;
 
-: help>html ( topic -- )
-    dup topic>filename utf8 [
-        dup article-title
-        [ <style> help-stylesheet </style> ]
-        [ [ help ] with-html-writer ] simple-page
-    ] with-file-writer ;
+: help>html ( topic -- xml )
+    [ article-title ]
+    [ drop help-stylesheet ]
+    [ [ help ] with-html-writer ]
+    tri simple-page ;
+          
+: generate-help-file ( topic -- )
+    dup .
+    dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
 
 : all-vocabs-really ( -- seq )
     #! Hack.
@@ -87,7 +91,7 @@ M: topic browser-link-href topic>filename ;
     all-vocabs-really [ dup vocab-name ] { } map>assoc "vocabs.idx" serialize-index ;
 
 : generate-help-files ( -- )
-    all-topics [ '[ _ help>html ] try ] each ;
+    all-topics [ '[ _ generate-help-file ] try ] each ;
 
 : generate-help ( -- )
     "docs" temp-file

From 7a8dc804267988acd4293d0f7bc83bafd2f4d66b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 20:54:49 -0600
Subject: [PATCH 04/12] Fix some issues in http.server

---
 basis/http/http-tests.factor                    |  7 ++++---
 .../server/dispatchers/dispatchers-tests.factor |  1 -
 basis/http/server/server-tests.factor           |  2 ++
 basis/http/server/server.factor                 | 17 +++++++++--------
 basis/http/server/static/static-tests.factor    |  4 ++++
 basis/http/server/static/static.factor          | 17 ++++++++++-------
 6 files changed, 29 insertions(+), 19 deletions(-)
 create mode 100644 basis/http/server/static/static-tests.factor

diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor
index 6103fb622f..c4ea23ea0a 100644
--- a/basis/http/http-tests.factor
+++ b/basis/http/http-tests.factor
@@ -298,7 +298,7 @@ test-db [
 
 [ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
 
-USING: html.components html.elements html.forms
+USING: html.components html.forms
 xml xml.utilities validators
 furnace furnace.conversations ;
 
@@ -308,7 +308,7 @@ SYMBOL: a
     <dispatcher>
         <action>
             [ a get-global "a" set-value ] >>init
-            [ [ <html> "a" <field> render </html> ] "text/html" <content> ] >>display
+            [ [ "a" <field> render ] "text/html" <content> ] >>display
             [ { { "a" [ v-integer ] } } validate-params ] >>validate
             [ "a" value a set-global URL" " <redirect> ] >>submit
         <conversations>
@@ -322,7 +322,8 @@ SYMBOL: a
 
 3 a set-global
 
-: test-a string>xml "input" tag-named "value" attr ;
+: test-a ( xml -- value )
+    string>xml body>> "input" deep-tag-named "value" attr ;
 
 [ "3" ] [
     "http://localhost/" add-port http-get
diff --git a/basis/http/server/dispatchers/dispatchers-tests.factor b/basis/http/server/dispatchers/dispatchers-tests.factor
index 5b5b30adde..2c8db27259 100644
--- a/basis/http/server/dispatchers/dispatchers-tests.factor
+++ b/basis/http/server/dispatchers/dispatchers-tests.factor
@@ -4,7 +4,6 @@ assocs arrays classes words urls ;
 IN: http.server.dispatchers.tests
 
 \ find-responder must-infer
-\ http-error. must-infer
 
 TUPLE: mock-responder path ;
 
diff --git a/basis/http/server/server-tests.factor b/basis/http/server/server-tests.factor
index c29912b8c7..fdba9a63ef 100644
--- a/basis/http/server/server-tests.factor
+++ b/basis/http/server/server-tests.factor
@@ -2,3 +2,5 @@ USING: http http.server math sequences continuations tools.test ;
 IN: http.server.tests
 
 [ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test
+
+\ make-http-error must-infer
diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor
index 90a8ddb51a..97c14a6457 100755
--- a/basis/http/server/server.factor
+++ b/basis/http/server/server.factor
@@ -24,8 +24,9 @@ http.parsers
 http.server.responses
 http.server.remapping
 html.templates
+html.streams
 html
-html.streams ;
+xml.writer ;
 IN: http.server
 
 : check-absolute ( url -- url )
@@ -173,15 +174,14 @@ main-responder global [ <404> <trivial-responder> or ] change-at
 : call-responder ( path responder -- response )
     [ add-responder-nesting ] [ call-responder* ] 2bi ;
 
-: http-error. ( error -- )
-    ! TODO: get rid of rot
-    "Internal server error" [ ] rot '[
-        [ _ print-error nl :c ] with-html-writer
-    ] simple-page ;
+: make-http-error ( error -- xml )
+    [ "Internal server error" f ] dip
+    [ print-error nl :c ] with-html-writer
+    simple-page ;
 
 : <500> ( error -- response )
     500 "Internal server error" <trivial-response>
-    swap development? get [ '[ _ http-error. ] >>body ] [ drop ] if ;
+    swap development? get [ make-http-error >>body ] [ drop ] if ;
 
 : do-response ( response -- )
     [ request get swap write-full-response ]
@@ -190,7 +190,8 @@ main-responder global [ <404> <trivial-responder> or ] change-at
         [
             utf8 [
                 development? get
-                [ http-error. ] [ drop "Response error" write ] if
+                [ make-http-error ] [ drop "Response error" ] if
+                write-xml
             ] with-encoded-output
         ] bi
     ] recover ;
diff --git a/basis/http/server/static/static-tests.factor b/basis/http/server/static/static-tests.factor
new file mode 100644
index 0000000000..d54be03698
--- /dev/null
+++ b/basis/http/server/static/static-tests.factor
@@ -0,0 +1,4 @@
+IN: http.server.static.tests
+USING: http.server.static tools.test xml.writer ;
+
+[ ] [ "resource:basis" directory>html write-xml ] unit-test
\ No newline at end of file
diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor
index 67ce0237a4..2df8838061 100644
--- a/basis/http/server/static/static.factor
+++ b/basis/http/server/static/static.factor
@@ -56,19 +56,22 @@ TUPLE: file-responder root hook special allow-listings ;
 
 \ serve-file NOTICE add-input-logging
 
-: file. ( name -- xml )
+: file>html ( name -- xml )
     dup link-info directory? [ "/" append ] when
     dup [XML <li><a href=<->><-></a></li> XML] ;
 
-: directory. ( path -- )
-    dup file-name [ ] [
-        [ file-name ] [ directory-files [ file. ] map ] bi
-        [XML <h1><-></h1> <ul><-></ul> XML] write-xml
-    ] simple-page ;
+: directory>html ( path -- xml )
+    [ file-name ]
+    [ drop f ]
+    [
+        [ file-name ] [ [ [ file>html ] map ] with-directory-files ] bi
+        [XML <h1><-></h1> <ul><-></ul> XML]
+    ] tri
+    simple-page ;
 
 : list-directory ( directory -- response )
     file-responder get allow-listings>> [
-        '[ _ directory. ] "text/html" <content>
+        directory>html "text/html" <content>
     ] [
         drop <403>
     ] if ;

From 335f0d99bfe1609fdb72f6fe45db5a405bfe4a26 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 20:56:00 -0600
Subject: [PATCH 05/12] Add unit tests for msxml-to-csv

---
 extra/msxml-to-csv/msxml-to-csv-tests.factor | 10 ++++++++++
 extra/msxml-to-csv/test.csv                  |  2 ++
 extra/msxml-to-csv/test.xml                  |  1 +
 3 files changed, 13 insertions(+)
 create mode 100644 extra/msxml-to-csv/msxml-to-csv-tests.factor
 create mode 100644 extra/msxml-to-csv/test.csv
 create mode 100644 extra/msxml-to-csv/test.xml

diff --git a/extra/msxml-to-csv/msxml-to-csv-tests.factor b/extra/msxml-to-csv/msxml-to-csv-tests.factor
new file mode 100644
index 0000000000..57c2c775b0
--- /dev/null
+++ b/extra/msxml-to-csv/msxml-to-csv-tests.factor
@@ -0,0 +1,10 @@
+IN: msxml-to-csv.tests
+USING: msxml-to-csv tools.test csv io.encodings.utf8
+io.files.temp kernel ;
+
+[ t ] [
+    "test.csv" temp-file
+    "resource:extra/msxml-to-csv/test.xml" msxml>csv
+    "test.csv" temp-file utf8 file>csv
+    "resource:extra/msxml-to-csv/test.csv" utf8 file>csv =
+] unit-test
\ No newline at end of file
diff --git a/extra/msxml-to-csv/test.csv b/extra/msxml-to-csv/test.csv
new file mode 100644
index 0000000000..51880af275
--- /dev/null
+++ b/extra/msxml-to-csv/test.csv
@@ -0,0 +1,2 @@
+A,B
+C,D
\ No newline at end of file
diff --git a/extra/msxml-to-csv/test.xml b/extra/msxml-to-csv/test.xml
new file mode 100644
index 0000000000..2c4ca42448
--- /dev/null
+++ b/extra/msxml-to-csv/test.xml
@@ -0,0 +1 @@
+<Worksheet><Table><Row><Cell>A</Cell><Cell>B</Cell></Row><Row><Cell>C</Cell><Cell>D</Cell></Row></Table></Worksheet>

From 55bbbd0ff0f9c87cb2368dc1ec8199d33b34d1e8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 20:58:23 -0600
Subject: [PATCH 06/12] Fix msxml-to-csv

---
 extra/msxml-to-csv/msxml-to-csv.factor | 1 -
 extra/msxml-to-csv/test.xml            | 2 +-
 2 files changed, 1 insertion(+), 2 deletions(-)

diff --git a/extra/msxml-to-csv/msxml-to-csv.factor b/extra/msxml-to-csv/msxml-to-csv.factor
index 839fcaaf54..855275efcc 100644
--- a/extra/msxml-to-csv/msxml-to-csv.factor
+++ b/extra/msxml-to-csv/msxml-to-csv.factor
@@ -3,7 +3,6 @@ io.encodings.ascii kernel ;
 IN: msxml-to-csv
 
 : (msxml>csv) ( xml -- table )
-    "Worksheet" tag-named
     "Table" tag-named
     "Row" tags-named [
         "Cell" tags-named [
diff --git a/extra/msxml-to-csv/test.xml b/extra/msxml-to-csv/test.xml
index 2c4ca42448..cd97905e13 100644
--- a/extra/msxml-to-csv/test.xml
+++ b/extra/msxml-to-csv/test.xml
@@ -1 +1 @@
-<Worksheet><Table><Row><Cell>A</Cell><Cell>B</Cell></Row><Row><Cell>C</Cell><Cell>D</Cell></Row></Table></Worksheet>
+<Worksheet><Table><Row><Cell><Data>A</Data></Cell><Cell><Data>B</Data></Cell></Row><Row><Cell><Data>C</Data></Cell><Cell><Data>D</Data></Cell></Row></Table></Worksheet>

From 1194ce38aa979e60d694f953b41c89fe2fad014c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 21:01:55 -0600
Subject: [PATCH 07/12] Fix some bugs in xml.utilities and add new unit tests

---
 basis/xml/utilities/utilities-tests.factor | 10 +++++-
 basis/xml/utilities/utilities.factor       | 36 +++++++++++++---------
 2 files changed, 30 insertions(+), 16 deletions(-)

diff --git a/basis/xml/utilities/utilities-tests.factor b/basis/xml/utilities/utilities-tests.factor
index 7b0989611c..673bf47f6e 100644
--- a/basis/xml/utilities/utilities-tests.factor
+++ b/basis/xml/utilities/utilities-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: xml xml.utilities tools.test xml.data ;
+USING: xml xml.utilities tools.test xml.data sequences ;
 IN: xml.utilities.tests
 
 [ "bar" ] [ "<foo>bar</foo>" string>xml children>string ] unit-test
@@ -12,3 +12,11 @@ IN: xml.utilities.tests
 XML-NS: foo http://blah.com
 
 [ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
+
+[ "blah" ] [ "<foo attr='blah'/>" string>xml-chunk "foo" deep-tag-named "attr" attr ] unit-test
+
+[ { "blah" } ] [ "<foo attr='blah'/>" string>xml-chunk "foo" deep-tags-named [ "attr" attr ] map ] unit-test
+
+[ "blah" ] [ "<foo attr='blah'/>" string>xml "foo" deep-tag-named "attr" attr ] unit-test
+
+[ { "blah" } ] [ "<foo attr='blah'/>" string>xml "foo" deep-tags-named [ "attr" attr ] map ] unit-test
\ No newline at end of file
diff --git a/basis/xml/utilities/utilities.factor b/basis/xml/utilities/utilities.factor
index d286072be6..1249da8c36 100755
--- a/basis/xml/utilities/utilities.factor
+++ b/basis/xml/utilities/utilities.factor
@@ -8,8 +8,10 @@ IN: xml.utilities
 : children>string ( tag -- string )
     children>> {
         { [ dup empty? ] [ drop "" ] }
-        { [ dup [ string? not ] any? ]
-          [ "XML tag unexpectedly contains non-text children" throw ] }
+        {
+            [ dup [ string? not ] any? ]
+            [ "XML tag unexpectedly contains non-text children" throw ]
+        }
         [ concat ]
     } cond ;
 
@@ -22,20 +24,24 @@ IN: xml.utilities
 : tag-named? ( name elem -- ? )
     dup tag? [ names-match? ] [ 2drop f ] if ;
 
-: tags@ ( tag name -- children name )
-    [ { } like ] dip assure-name ;
-
-: deep-tag-named ( tag name/string -- matching-tag )
-    assure-name '[ _ swap tag-named? ] deep-find ;
-
-: deep-tags-named ( tag name/string -- tags-seq )
-    tags@ '[ _ swap tag-named? ] deep-filter ;
-
 : tag-named ( tag name/string -- matching-tag )
-    assure-name swap [ tag-named? ] with find nip ;
+    assure-name '[ _ swap tag-named? ] find nip ;
 
 : tags-named ( tag name/string -- tags-seq )
-    tags@ swap [ tag-named? ] with filter ;
+    assure-name '[ _ swap tag-named? ] filter { } like ;
+
+<PRIVATE
+
+: prepare-deep ( xml name/string -- tag name/string )
+    [ dup xml? [ body>> ] when ] [ assure-name ] bi* ;
+
+PRIVATE>
+
+: deep-tag-named ( tag name/string -- matching-tag )
+    prepare-deep '[ _ swap tag-named? ] deep-find ;
+
+: deep-tags-named ( tag name/string -- tags-seq )
+    prepare-deep '[ _ swap tag-named? ] deep-filter { } like ;
 
 : tag-with-attr? ( elem attr-value attr-name -- ? )
     rot dup tag? [ swap attr = ] [ 3drop f ] if ;
@@ -44,13 +50,13 @@ IN: xml.utilities
     assure-name '[ _ _ tag-with-attr? ] find nip ;
 
 : tags-with-attr ( tag attr-value attr-name -- tags-seq )
-    tags@ '[ _ _ tag-with-attr? ] filter children>> ;
+    assure-name '[ _ _ tag-with-attr? ] filter children>> ;
 
 : deep-tag-with-attr ( tag attr-value attr-name -- matching-tag )
     assure-name '[ _ _ tag-with-attr? ] deep-find ;
 
 : deep-tags-with-attr ( tag attr-value attr-name -- tags-seq )
-    tags@ '[ _ _ tag-with-attr? ] deep-filter ;
+    assure-name '[ _ _ tag-with-attr? ] deep-filter ;
 
 : get-id ( tag id -- elem )
     "id" deep-tag-with-attr ;

From 83116c64395f72408a0b0ca773ba10458ac7430e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 21:02:13 -0600
Subject: [PATCH 08/12] Change example to unchecked-example since on netbsd
 math functions return 0 instead of NaN on domain errors

---
 basis/math/libm/libm-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/math/libm/libm-docs.factor b/basis/math/libm/libm-docs.factor
index 72c114487b..bf4c608d77 100644
--- a/basis/math/libm/libm-docs.factor
+++ b/basis/math/libm/libm-docs.factor
@@ -6,7 +6,7 @@ ARTICLE: "math.libm" "C standard library math functions"
 $nl
 "They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
 { $example "USE: math.functions" "2 acos ." "C{ 0.0 1.316957896924817 }" }
-{ $example "USE: math.libm" "2 facos ." "0.0/0.0" }
+{ $unchecked-example "USE: math.libm" "2 facos ." "0.0/0.0" }
 "Trigonometric functions:"
 { $subsection fcos }
 { $subsection fsin }

From 4e779820b87e46e922406ad54493ea13e1404bbf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 21:23:56 -0600
Subject: [PATCH 09/12] Fix load error

---
 basis/html/streams/streams-tests.factor | 2 +-
 basis/html/streams/streams.factor       | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/html/streams/streams-tests.factor b/basis/html/streams/streams-tests.factor
index 249861b12a..18ab17218f 100644
--- a/basis/html/streams/streams-tests.factor
+++ b/basis/html/streams/streams-tests.factor
@@ -35,7 +35,7 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
 [
     [
         "car"
-        H{ { font-name "monospace" } }
+        H{ { font "monospace" } }
         format
     ] make-html-string
 ] unit-test
diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor
index 768f2bbaa8..0a4b8eddd4 100644
--- a/basis/html/streams/streams.factor
+++ b/basis/html/streams/streams.factor
@@ -75,7 +75,7 @@ MACRO: make-css ( pairs -- str )
     {
         { foreground fg-css, }
         { background bg-css, }
-        { font-name font-css, }
+        { font font-css, }
         { font-style style-css, }
         { font-size size-css, }
     } make-css ;

From fae0d8bac1e7301df59660b59953ec409449a4d7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 21:56:39 -0600
Subject: [PATCH 10/12] Fix validation error rendering

---
 basis/html/components/components-tests.factor | 11 +++++++++++
 basis/html/components/components.factor       |  6 +++---
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/basis/html/components/components-tests.factor b/basis/html/components/components-tests.factor
index b3ea0319a8..410c3ce223 100644
--- a/basis/html/components/components-tests.factor
+++ b/basis/html/components/components-tests.factor
@@ -32,6 +32,11 @@ TUPLE: color red green blue ;
     ] with-string-writer
 ] unit-test
 
+[ "<input value=\"&lt;jimmy>\" name=\"red\" type=\"hidden\"/>" ] [
+    [
+        "red" hidden render
+    ] with-string-writer
+] unit-test
 [ "<input value=\"&lt;jimmy>\" name=\"red\" type=\"hidden\"/>" ] [
     [
         "red" hidden render
@@ -184,3 +189,9 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
         }
     }
 ] [ values ] unit-test
+
+[ ] [ "error" "blah" <validation-error> "error" set-value ] unit-test
+
+[ ] [
+    "error" hidden render
+] unit-test
diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index 40621bc29f..f811343df2 100644
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@@ -15,12 +15,12 @@ GENERIC: render* ( value name renderer -- xml )
     prepare-value
     [
         dup validation-error?
-        [ [ message>> ] [ value>> ] bi ]
+        [ [ message>> render-error ] [ value>> ] bi ]
         [ f swap ]
         if
     ] 2dip
-    render* write-xml
-    [ render-error ] when* ;
+    render*
+    swap 2array write-xml ;
 
 SINGLETON: label
 

From 83cbe7c04fc9810c7bee10260451f6fac2c77ee5 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 31 Jan 2009 23:11:07 -0600
Subject: [PATCH 11/12] Fix lint

---
 extra/lint/lint.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor
index 60e3332ee4..849cc540a3 100755
--- a/extra/lint/lint.factor
+++ b/extra/lint/lint.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.accessors arrays assocs
-combinators.short-circuit fry hashtables html io
+combinators.short-circuit fry hashtables io
 kernel math namespaces prettyprint quotations sequences
 sequences.deep sets slots.private vectors vocabs words
 kernel.private ;
@@ -54,7 +54,7 @@ SYMBOL: def-hash-keys
         [ drop f ]
         [ "cdecl" ]
         [ first ] [ second ] [ third ] [ fourth ]
-        [ ">" write-html ] [ "/>" write-html ]
+        [ ">" write ] [ "/>" write ]
     } ;
 
 ! ! Add definitions

From e089ce6df0d1195103e69a33482aaba0811327a6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 1 Feb 2009 02:02:09 -0600
Subject: [PATCH 12/12] Fix http test

---
 basis/http/http-tests.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor
index c4ea23ea0a..f593980467 100644
--- a/basis/http/http-tests.factor
+++ b/basis/http/http-tests.factor
@@ -308,7 +308,7 @@ SYMBOL: a
     <dispatcher>
         <action>
             [ a get-global "a" set-value ] >>init
-            [ [ "a" <field> render ] "text/html" <content> ] >>display
+            [ [ "<html>" write "a" <field> render "</html>" write ] "text/html" <content> ] >>display
             [ { { "a" [ v-integer ] } } validate-params ] >>validate
             [ "a" value a set-global URL" " <redirect> ] >>submit
         <conversations>