From e8815e7bb2faefea760faccd3462b9f7298f3042 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 22 May 2008 22:41:23 -0500
Subject: [PATCH 01/39] Moving validators to their own vocabulary

---
 extra/validators/validators-tests.factor |  70 +++++++++++
 extra/validators/validators.factor       | 142 +++++++++++++++++++++++
 2 files changed, 212 insertions(+)
 create mode 100644 extra/validators/validators-tests.factor
 create mode 100644 extra/validators/validators.factor

diff --git a/extra/validators/validators-tests.factor b/extra/validators/validators-tests.factor
new file mode 100644
index 0000000000..6ed0e0363a
--- /dev/null
+++ b/extra/validators/validators-tests.factor
@@ -0,0 +1,70 @@
+IN: validators.tests
+USING: kernel sequences tools.test validators accessors ;
+
+[ "foo" v-number ] must-fail
+[ 123 ] [ "123" v-number ] unit-test
+
+[ "slava@factorcode.org" ] [
+    "slava@factorcode.org" v-email
+] unit-test
+
+[ "slava+foo@factorcode.org" ] [
+    "slava+foo@factorcode.org" v-email
+] unit-test
+
+[ "slava@factorcode.o" v-email ]
+[ "invalid e-mail" = ] must-fail-with
+
+[ "sla@@factorcode.o" v-email ]
+[ "invalid e-mail" = ] must-fail-with
+
+[ "slava@factorcodeorg" v-email ]
+[ "invalid e-mail" = ] must-fail-with
+
+[ "http://www.factorcode.org" ]
+[ "http://www.factorcode.org" v-url ] unit-test
+
+[ "http:/www.factorcode.org" v-url ]
+[ "invalid URL" = ] must-fail-with
+
+[ 14 V{ } ] [
+    [
+        "14" "age" [ drop v-number 13 v-min-value 100 v-max-value ] validate
+    ] with-validation
+] unit-test
+
+[ f t ] [
+    [
+        "140" "age" [ drop v-number 13 v-min-value 100 v-max-value ] validate
+    ] with-validation first
+    [ first "age" = ]
+    [ second validation-error? ]
+    [ second value>> "140" = ]
+    tri and and
+] unit-test
+
+TUPLE: person name age ;
+
+person {
+    { "name" [ v-required ] }
+    { "age" [ v-number 13 v-min-value 100 v-max-value ] }
+} define-validators
+
+[ 14 V{ } ] [
+    [
+        person new dup
+        { { "age" "14" } }
+        deposit-slots
+        age>>
+    ] with-validation
+] unit-test
+
+[ t ] [
+    [
+        { { "age" "" } } required-values
+    ] with-validation first
+    [ first "age" = ]
+    [ second validation-error? ]
+    [ second message>> "required" = ]
+    tri and and
+] unit-test
diff --git a/extra/validators/validators.factor b/extra/validators/validators.factor
new file mode 100644
index 0000000000..23bda8cb6c
--- /dev/null
+++ b/extra/validators/validators.factor
@@ -0,0 +1,142 @@
+! Copyright (C) 2006, 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel continuations sequences math namespaces sets
+math.parser assocs regexp fry unicode.categories sequences
+arrays hashtables words combinators mirrors classes quotations ;
+IN: validators
+
+: v-default ( str def -- str )
+    over empty? spin ? ;
+
+: v-required ( str -- str )
+    dup empty? [ "required" throw ] when ;
+
+: v-optional ( str quot -- str )
+    over empty? [ 2drop f ] [ call ] if ; inline
+
+: v-min-length ( str n -- str )
+    over length over < [
+        [ "must be at least " % # " characters" % ] "" make
+        throw
+    ] [
+        drop
+    ] if ;
+
+: v-max-length ( str n -- str )
+    over length over > [
+        [ "must be no more than " % # " characters" % ] "" make
+        throw
+    ] [
+        drop
+    ] if ;
+
+: v-number ( str -- n )
+    dup string>number [ ] [ "must be a number" throw ] ?if ;
+
+: v-integer ( n -- n )
+    dup integer? [ "must be an integer" throw ] unless ;
+
+: v-min-value ( x n -- x )
+    2dup < [
+        [ "must be at least " % # ] "" make throw
+    ] [
+        drop
+    ] if ;
+
+: v-max-value ( x n -- x )
+    2dup > [
+        [ "must be no more than " % # ] "" make throw
+    ] [
+        drop
+    ] if ;
+
+: v-regexp ( str what regexp -- str )
+    >r over r> matches?
+    [ drop ] [ "invalid " prepend throw ] if ;
+
+: v-email ( str -- str )
+    #! From http://www.regular-expressions.info/email.html
+    "e-mail"
+    R' [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}'i
+    v-regexp ;
+
+: v-url ( str -- str )
+    "URL"
+    R' (ftp|http|https)://(\w+:?\w*@)?(\S+)(:[0-9]+)?(/|/([\w#!:.?+=&%@!\-/]))?'
+    v-regexp ;
+
+: v-captcha ( str -- str )
+    dup empty? [ "must remain blank" throw ] unless ;
+
+: v-one-line ( str -- str )
+    dup "\r\n" intersect empty?
+    [ "must be a single line" throw ] unless ;
+
+: v-one-word ( str -- str )
+    dup [ alpha? ] all?
+    [ "must be a single word" throw ] unless ;
+
+SYMBOL: validation-messages
+
+: with-validation ( quot -- messages )
+    V{ } clone [
+        validation-messages rot with-variable
+    ] keep ; inline
+
+: (validation-message) ( obj -- )
+    validation-messages get push ;
+
+: (validation-message-for) ( obj name -- )
+    swap 2array (validation-message) ;
+
+TUPLE: validation-message message ;
+
+C: <validation-message> validation-message
+
+: validation-message ( string -- )
+    <validation-message> (validation-message) ;
+
+: validation-message-for ( string name -- )
+    [ <validation-message> ] dip (validation-message-for) ;
+
+TUPLE: validation-error value message ;
+
+C: <validation-error> validation-error
+
+: validation-error ( reason -- )
+    f <validation-error> (validation-message) ;
+
+: validation-error-for ( reason value name -- )
+    [ <validation-error> ] dip (validation-message-for) ;
+
+: validation-failed? ( -- ? )
+    validation-messages get [
+        dup pair? [ second ] when validation-error?
+    ] contains? ;
+
+: define-validators ( class validators -- )
+    >hashtable "validators" set-word-prop ;
+
+: validate ( value name quot -- result )
+    [ swap validation-error-for f ] recover ; inline
+
+: validate-value ( value name validators -- result )
+    '[
+        , at {
+            { [ dup pair? ] [ first ] }
+            { [ dup quotation? ] [ ] }
+        } cond call
+    ] validate ;
+
+: required-values ( assoc -- )
+    [ swap [ drop v-required ] validate drop ] assoc-each ;
+
+: validate-values ( assoc validators -- assoc' )
+    '[ over , validate-value ] assoc-map ;
+
+: deposit-values ( destination assoc validators -- )
+    validate-values update ;
+
+: deposit-slots ( tuple assoc -- )
+    [ [ <mirror> ] [ class "validators" word-prop ] bi ] dip
+    swap deposit-values ;

From 3ee56c3a68eea3570d0cb0cb61df30ff84ba2831 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 22 May 2008 22:41:48 -0500
Subject: [PATCH 02/39] Add extract-keys word

---
 core/assocs/assocs-tests.factor                    | 14 ++++++++++++++
 core/assocs/assocs.factor                          |  3 +++
 .../standard/engines/predicate/predicate.factor    |  3 +--
 core/inference/class/class.factor                  | 12 ++++++------
 4 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 30f2ec23c4..43a1bac82d 100755
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -104,3 +104,17 @@ unit-test
         2drop
     ] { } make
 ] unit-test
+
+[
+    H{
+        { "bangers" "mash" }
+        { "fries" "onion rings" }
+    }
+] [
+    { "bangers" "fries" } H{
+        { "fish" "chips" }
+        { "bangers" "mash" }
+        { "fries" "onion rings" }
+        { "nachos" "cheese" }
+    } extract-keys
+] unit-test
diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 92db38573a..6b0798f2e3 100755
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -150,6 +150,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
 : map>assoc ( seq quot exemplar -- assoc )
     >r [ 2array ] compose { } map-as r> assoc-like ; inline
 
+: extract-keys ( seq assoc -- subassoc )
+    [ [ dupd at ] curry ] keep map>assoc ;
+
 M: assoc >alist [ 2array ] { } assoc>map ;
 
 : value-at ( value assoc -- key/f )
diff --git a/core/generic/standard/engines/predicate/predicate.factor b/core/generic/standard/engines/predicate/predicate.factor
index b1bfc659df..9c810592a0 100644
--- a/core/generic/standard/engines/predicate/predicate.factor
+++ b/core/generic/standard/engines/predicate/predicate.factor
@@ -22,8 +22,7 @@ C: <predicate-dispatch-engine> predicate-dispatch-engine
     } cond ;
 
 : sort-methods ( assoc -- assoc' )
-    [ keys sort-classes ]
-    [ [ dupd at ] curry ] bi { } map>assoc ;
+    >alist [ keys sort-classes ] keep extract-keys ;
 
 M: predicate-dispatch-engine engine>quot
     methods>> clone
diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor
index 933710aaca..dc632425fe 100755
--- a/core/inference/class/class.factor
+++ b/core/inference/class/class.factor
@@ -152,16 +152,16 @@ M: pair apply-constraint
 M: pair constraint-satisfied?
     first constraint-satisfied? ;
 
-: extract-keys ( seq assoc -- newassoc )
-    [ dupd at ] curry H{ } map>assoc [ nip ] assoc-filter f assoc-like ;
+: valid-keys ( seq assoc -- newassoc )
+    extract-keys [ nip ] assoc-filter f assoc-like ;
 
 : annotate-node ( node -- )
     #! Annotate the node with the currently-inferred set of
     #! value classes.
     dup node-values {
-        [ value-intervals get extract-keys >>intervals ]
-        [ value-classes   get extract-keys >>classes   ]
-        [ value-literals  get extract-keys >>literals  ]
+        [ value-intervals get valid-keys >>intervals ]
+        [ value-classes   get valid-keys >>classes   ]
+        [ value-literals  get valid-keys >>literals  ]
         [ 2drop ]
     } cleave ;
 
@@ -330,7 +330,7 @@ M: #return infer-classes-around
             [ ] [ node-input-classes ] [ in-d>> [ value-class* ] map ] tri
             classes= not [
                 fixed-point? off
-                [ in-d>> value-classes get extract-keys ] keep
+                [ in-d>> value-classes get valid-keys ] keep
                 set-node-classes
             ] [ drop ] if
         ] [ call-next-method ] if

From f693c69c406a96ef03c33b821be9805d3bc51179 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 17:33:31 -0500
Subject: [PATCH 03/39] Move HTML components to html.components, refactor

---
 extra/html/components/components-tests.factor | 145 +++++++++++++++++
 extra/html/components/components.factor       | 150 ++++++++++++++++++
 extra/html/elements/elements-tests.factor     |   7 +-
 extra/html/elements/elements.factor           |  66 +++++---
 extra/html/{ => streams}/authors.txt          |   0
 .../streams-tests.factor}                     |   7 +-
 .../{html.factor => streams/streams.factor}   |  73 +--------
 extra/html/{ => streams}/summary.txt          |   0
 extra/html/{ => streams}/tags.txt             |   0
 extra/html/stylesheet.css                     |   4 -
 extra/validators/validators.factor            |   1 +
 11 files changed, 345 insertions(+), 108 deletions(-)
 create mode 100644 extra/html/components/components-tests.factor
 create mode 100644 extra/html/components/components.factor
 rename extra/html/{ => streams}/authors.txt (100%)
 rename extra/html/{html-tests.factor => streams/streams-tests.factor} (89%)
 rename extra/html/{html.factor => streams/streams.factor} (71%)
 rename extra/html/{ => streams}/summary.txt (100%)
 rename extra/html/{ => streams}/tags.txt (100%)
 delete mode 100644 extra/html/stylesheet.css

diff --git a/extra/html/components/components-tests.factor b/extra/html/components/components-tests.factor
new file mode 100644
index 0000000000..6ecd2b0fa6
--- /dev/null
+++ b/extra/html/components/components-tests.factor
@@ -0,0 +1,145 @@
+IN: html.components.tests
+USING: html.components tools.test kernel io.streams.string
+io.streams.null accessors ;
+
+[ ] [ blank-values ] unit-test
+
+[ ] [ 3 "hi" set-value ] unit-test
+
+[ 3 ] [ "hi" value ] unit-test
+
+TUPLE: color red green blue ;
+
+[ ] [ 1 2 3 color boa from-tuple ] unit-test
+
+[ 1 ] [ "red" value ] unit-test
+
+[ ] [ "jimmy" "red" set-value ] unit-test
+
+[ "123.5" ] [ 123.5 object>string ] unit-test
+
+[ "jimmy" ] [
+    [
+        "red" label render
+    ] with-string-writer
+] unit-test
+
+[ ] [ "<jimmy>" "red" set-value ] unit-test
+
+[ "&lt;jimmy&gt;" ] [
+    [
+        "red" label render
+    ] with-string-writer
+] unit-test
+
+[ "<input type='hidden' name='red' value='<jimmy>'/>" ] [
+    [
+        "red" hidden render
+    ] with-string-writer
+] unit-test
+
+[ ] [ "'jimmy'" "red" set-value ] unit-test
+
+[ "<input type='text' size='5' name='red' value='&apos;jimmy&apos;'/>" ] [
+    [
+        "red" <field> 5 >>size render
+    ] with-string-writer
+] unit-test
+
+[ "<input type='password' size='5' name='red' value=''/>" ] [
+    [
+        "red" <password> 5 >>size render
+    ] with-string-writer
+] unit-test
+
+[ ] [
+    [
+        "green" <textarea> render
+    ] with-null-writer
+] unit-test
+
+[ ] [
+    [
+        "green" <textarea> 25 >>rows 30 >>columns render
+    ] with-null-writer
+] unit-test
+
+[ ] [ blank-values ] unit-test
+
+[ ] [ "new york" "city1" set-value ] unit-test
+
+[ ] [
+    [
+        "city1"
+        <choice>
+            { "new york" "los angeles" "chicago" } >>choices
+        render
+    ] with-null-writer
+] unit-test
+
+[ ] [ { "los angeles" "new york" } "city2" set-value ] unit-test
+
+[ ] [
+    [
+        "city2"
+        <choice>
+            { "new york" "los angeles" "chicago" } >>choices
+            t >>multiple
+        render
+    ] with-null-writer
+] unit-test
+
+[ ] [
+    [
+        "city2"
+        <choice>
+            { "new york" "los angeles" "chicago" } >>choices
+            t >>multiple
+            5 >>size
+        render
+    ] with-null-writer
+] unit-test
+
+[ ] [ blank-values ] unit-test
+
+[ ] [ t "delivery" set-value ] unit-test
+
+[ "<input type='checkbox' name='delivery' selected='true'>Delivery</input>" ] [
+    [
+        "delivery"
+        <checkbox>
+            "Delivery" >>label
+        render
+    ] with-string-writer
+] unit-test
+
+[ ] [ f "delivery" set-value ] unit-test
+
+[ "<input type='checkbox' name='delivery'>Delivery</input>" ] [
+    [
+        "delivery"
+        <checkbox>
+            "Delivery" >>label
+        render
+    ] with-string-writer
+] unit-test
+
+SINGLETON: link-test
+
+M: link-test link-title drop "<Link Title>" ;
+
+M: link-test link-href drop "http://www.apple.com/foo&bar" ;
+
+[ ] [ link-test "link" set-value ] unit-test
+
+[ "<a href='http://www.apple.com/foo&amp;bar'>&lt;Link Title&gt;</a>" ] [
+    [ "link" link render ] with-string-writer
+] unit-test
+
+[ ] [
+    "<html>arbitrary <b>markup</b> for the win!</html>" "html" set-value
+] unit-test
+
+[ "<html>arbitrary <b>markup</b> for the win!</html>" ] [
+    [ "html" html render ] with-string-writer
+] unit-test
diff --git a/extra/html/components/components.factor b/extra/html/components/components.factor
new file mode 100644
index 0000000000..ef4def8ddb
--- /dev/null
+++ b/extra/html/components/components.factor
@@ -0,0 +1,150 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel namespaces io math.parser assocs classes
+classes.tuple words arrays sequences splitting mirrors
+hashtables combinators continuations math strings
+fry locals calendar calendar.format xml.entities validators
+html.elements ;
+IN: html.components
+
+SYMBOL: values
+
+: value values get at ;
+
+: set-value values get set-at ;
+
+: blank-values H{ } clone values set ;
+
+: from-tuple <mirror> values set ;
+
+: values-tuple values get object>> ;
+
+: object>string ( object -- string )
+    {
+        { [ dup real? ] [ number>string ] }
+        { [ dup timestamp? ] [ timestamp>string ] }
+        { [ dup string? ] [ ] }
+        { [ dup not ] [ drop "" ] }
+    } cond ;
+
+GENERIC: render* ( value name render -- )
+
+: render ( name renderer -- )
+    over validation-messages get at [
+        [ value>> ] [ message>> ] bi
+        [ -rot render* ] dip
+        render-error
+    ] [
+        [ [ value ] keep ] dip render*
+    ] if* ;
+
+<PRIVATE
+
+: render-input ( value name type -- )
+    <input =type =name object>string =value input/> ;
+
+PRIVATE>
+
+SINGLETON: label
+
+M: label render* 2drop object>string escape-string write ;
+
+SINGLETON: hidden
+
+M: hidden render* drop "hidden" render-input ;
+
+: render-field ( value name size type -- )
+    <input
+        =type
+        [ number>string =size ] when*
+        =name
+        object>string =value
+    input/> ;
+
+TUPLE: field size ;
+
+: <field> ( -- field )
+    field new ;
+
+M: field render* size>> "text" render-field ;
+
+TUPLE: password size ;
+
+: <password> ( -- password )
+    password new ;
+
+M: password render*
+    #! Don't send passwords back to the user
+    [ drop "" ] 2dip size>> "password" render-field ;
+
+! Text areas
+TUPLE: textarea rows columns ;
+
+: <textarea> ( -- renderer )
+    textarea new ;
+
+M: textarea render*
+    <textarea
+        [ rows>> [ number>string =rows ] when* ]
+        [ columns>> [ number>string =cols ] when* ] bi
+        =name
+    textarea>
+        object>string escape-string write
+    </textarea> ;
+
+! Choice
+TUPLE: choice size choices multiple ;
+
+: <choice> ( -- choice )
+    choice new ;
+
+: render-option ( text selected? -- )
+    <option [ "true" =selected ] when option>
+        escape-string write
+    </option> ;
+
+: render-options ( options selected -- )
+    '[ dup , member? render-option ] each ;
+
+M: choice render*
+    <select
+        swap =name
+        dup size>> [ number>string =size ] when*
+        dup multiple>> [ "true" =multiple ] when
+    select>
+        [ choices>> ] [ multiple>> ] bi
+        [ swap ] [ swap 1array ] if
+        render-options
+    </select> ;
+
+! Checkboxes
+TUPLE: checkbox label ;
+
+: <checkbox> ( -- checkbox )
+    checkbox new ;
+
+M: checkbox render*
+    <input
+        "checkbox" =type
+        swap =name
+        swap [ "true" =selected ] when
+    input>
+        label>> escape-string write
+    </input> ;
+
+! Link components
+GENERIC: link-title ( obj -- string )
+GENERIC: link-href ( obj -- url )
+
+SINGLETON: link
+
+M: link render*
+    2drop
+    <a dup link-href =href a>
+        link-title object>string escape-string write
+    </a> ;
+
+! HTML component
+SINGLETON: html
+
+M: html render* 2drop write ;
diff --git a/extra/html/elements/elements-tests.factor b/extra/html/elements/elements-tests.factor
index aa6a017540..1178deab38 100644
--- a/extra/html/elements/elements-tests.factor
+++ b/extra/html/elements/elements-tests.factor
@@ -1,8 +1,5 @@
 IN: html.elements.tests
-USING: tools.test html html.elements io.streams.string ;
-
-: make-html-string
-    [ with-html-stream ] with-string-writer ;
+USING: tools.test html.elements io.streams.string ;
 
 [ "<a href='h&amp;o'>" ]
-[ [ <a "h&o" =href a> ] make-html-string ] unit-test
+[ [ <a "h&o" =href a> ] with-string-writer ] unit-test
diff --git a/extra/html/elements/elements.factor b/extra/html/elements/elements.factor
index 49782fa305..e5377cedf8 100644
--- a/extra/html/elements/elements.factor
+++ b/extra/html/elements/elements.factor
@@ -57,6 +57,8 @@ SYMBOL: html
 : print-html ( str -- )
     write-html "\n" write-html ;
 
+<<
+
 : html-word ( name def effect -- )
     #! Define 'word creating' word to allow
     #! dynamically creating words.
@@ -137,30 +139,46 @@ SYMBOL: html
     dup "=" prepend swap
     [ write-attr ] curry attribute-effect html-word ;
 
+! Define some closed HTML tags
 [
-    ! Define some closed HTML tags
-    [
-        "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9"
-        "ol" "li" "form" "a" "p" "html" "head" "body" "title"
-        "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea"
-        "script" "div" "span" "select" "option" "style" "input"
-    ] [ define-closed-html-word ] each
+    "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9"
+    "ol" "li" "form" "a" "p" "html" "head" "body" "title"
+    "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea"
+    "script" "div" "span" "select" "option" "style" "input"
+] [ define-closed-html-word ] each
 
-    ! Define some open HTML tags
-    [
-        "input"
-        "br"
-        "link"
-        "img"
-    ] [ define-open-html-word ] each
+! Define some open HTML tags
+[
+    "input"
+    "br"
+    "link"
+    "img"
+] [ define-open-html-word ] each
 
-    ! Define some attributes
-    [
-        "method" "action" "type" "value" "name"
-        "size" "href" "class" "border" "rows" "cols"
-        "id" "onclick" "style" "valign" "accesskey"
-        "src" "language" "colspan" "onchange" "rel"
-        "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang"
-        "media" "title" "multiple"
-    ] [ define-attribute-word ] each
-] with-compilation-unit
+! Define some attributes
+[
+    "method" "action" "type" "value" "name"
+    "size" "href" "class" "border" "rows" "cols"
+    "id" "onclick" "style" "valign" "accesskey"
+    "src" "language" "colspan" "onchange" "rel"
+    "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang"
+    "media" "title" "multiple"
+] [ define-attribute-word ] each
+
+>>
+
+: xhtml-preamble ( -- )
+    "<?xml version=\"1.0\"?>" write-html
+    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" write-html ;
+
+: simple-page ( title quot -- )
+    #! Call the quotation, with all output going to the
+    #! body of an html page with the given title.
+    xhtml-preamble
+    <html "http://www.w3.org/1999/xhtml" =xmlns "en" =xml:lang "en" =lang html>
+        <head> <title> swap write </title> </head>
+        <body> call </body>
+    </html> ;
+
+: render-error ( message -- )
+    <span "error" =class span> escape-string write </span> ;
diff --git a/extra/html/authors.txt b/extra/html/streams/authors.txt
similarity index 100%
rename from extra/html/authors.txt
rename to extra/html/streams/authors.txt
diff --git a/extra/html/html-tests.factor b/extra/html/streams/streams-tests.factor
similarity index 89%
rename from extra/html/html-tests.factor
rename to extra/html/streams/streams-tests.factor
index 9f1ce6b689..2084c7db18 100644
--- a/extra/html/html-tests.factor
+++ b/extra/html/streams/streams-tests.factor
@@ -1,6 +1,7 @@
-USING: html http io io.streams.string io.styles kernel
-namespaces tools.test xml.writer sbufs sequences html.private ;
-IN: html.tests
+USING: html.streams html.streams.private
+io io.streams.string io.styles kernel
+namespaces tools.test xml.writer sbufs sequences ;
+IN: html.streams.tests
 
 : make-html-string
     [ with-html-stream ] with-string-writer ; inline
diff --git a/extra/html/html.factor b/extra/html/streams/streams.factor
similarity index 71%
rename from extra/html/html.factor
rename to extra/html/streams/streams.factor
index 71862b0d01..b35f383bdc 100755
--- a/extra/html/html.factor
+++ b/extra/html/streams/streams.factor
@@ -4,7 +4,7 @@ USING: generic assocs help http io io.styles io.files continuations
 io.streams.string kernel math math.order math.parser namespaces
 quotations assocs sequences strings words html.elements
 xml.entities sbufs continuations destructors ;
-IN: html
+IN: html.streams
 
 GENERIC: browser-link-href ( presented -- href )
 
@@ -192,76 +192,5 @@ M: html-stream make-cell-stream ( style stream -- stream' )
 M: html-stream stream-nl ( stream -- )
     dup test-last-div? [ drop ] [ [ <br/> ] with-output-stream* ] if ;
 
-! Utilities
 : with-html-stream ( quot -- )
     output-stream get <html-stream> swap with-output-stream* ; inline
-
-: xhtml-preamble
-    "<?xml version=\"1.0\"?>" write-html
-    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" write-html ;
-
-: html-document ( body-quot head-quot -- )
-    #! head-quot is called to produce output to go
-    #! in the html head portion of the document.
-    #! body-quot is called to produce output to go
-    #! in the html body portion of the document.
-    xhtml-preamble
-    <html "http://www.w3.org/1999/xhtml" =xmlns "en" =xml:lang "en" =lang html>
-        <head> call </head>
-        <body> call </body>
-    </html> ;
-
-: default-css ( -- )
-    <link
-    "stylesheet" =rel "text/css" =type
-    "/responder/resources/extra/html/stylesheet.css" =href
-    link/> ;
-
-: simple-html-document ( title quot -- )
-    swap [
-        <title> write </title>
-        default-css
-    ] html-document ;
-
-: vertical-layout ( list -- )
-    #! Given a list of HTML components, arrange them vertically.
-    <table>
-    [ <tr> <td> call </td> </tr> ] each
-    </table> ;
-
-: horizontal-layout ( list -- )
-    #! Given a list of HTML components, arrange them horizontally.
-    <table>
-     <tr "top" =valign tr> [ <td> call </td> ] each </tr>
-    </table> ;
-
-: button ( label -- )
-    #! Output an HTML submit button with the given label.
-    <input "submit" =type =value input/> ;
-
-: paragraph ( str -- )
-    #! Output the string as an html paragraph
-    <p> write </p> ;
-
-: simple-page ( title quot -- )
-    #! Call the quotation, with all output going to the
-    #! body of an html page with the given title.
-    <html>
-        <head> <title> swap write </title> </head>
-        <body> call </body>
-    </html> ;
-
-: styled-page ( title stylesheet-quot quot -- )
-    #! Call the quotation, with all output going to the
-    #! body of an html page with the given title. stylesheet-quot
-    #! is called to generate the required stylesheet.
-    <html>
-        <head>
-             <title> rot write </title>
-             swap call
-        </head>
-        <body> call </body>
-    </html> ;
-
-: render-error ( message -- )
-    <span "error" =class span> escape-string write </span> ;
diff --git a/extra/html/summary.txt b/extra/html/streams/summary.txt
similarity index 100%
rename from extra/html/summary.txt
rename to extra/html/streams/summary.txt
diff --git a/extra/html/tags.txt b/extra/html/streams/tags.txt
similarity index 100%
rename from extra/html/tags.txt
rename to extra/html/streams/tags.txt
diff --git a/extra/html/stylesheet.css b/extra/html/stylesheet.css
deleted file mode 100644
index a1afce7c9f..0000000000
--- a/extra/html/stylesheet.css
+++ /dev/null
@@ -1,4 +0,0 @@
-a:link { text-decoration: none; color: black; }
-a:visited { text-decoration: none; color: black; }
-a:active { text-decoration: none; color: black; }
-a:hover { text-decoration: underline; color: black; }
diff --git a/extra/validators/validators.factor b/extra/validators/validators.factor
index 23bda8cb6c..9d6c4bed90 100644
--- a/extra/validators/validators.factor
+++ b/extra/validators/validators.factor
@@ -56,6 +56,7 @@ IN: validators
 
 : v-email ( str -- str )
     #! From http://www.regular-expressions.info/email.html
+    60 v-max-length
     "e-mail"
     R' [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}'i
     v-regexp ;

From a251556024462da9e36135558f256649c4102b75 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 17:33:57 -0500
Subject: [PATCH 04/39] Add failing unit tests

---
 core/classes/classes-tests.factor | 9 +++++++++
 core/parser/parser-tests.factor   | 7 +++++++
 2 files changed, 16 insertions(+)

diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor
index bb9fbd0167..8d20da78b5 100755
--- a/core/classes/classes-tests.factor
+++ b/core/classes/classes-tests.factor
@@ -160,3 +160,12 @@ TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
 [ t ] [ 3 number instance? ] unit-test
 [ f ] [ 3 null instance? ] unit-test
 [ t ] [ "hi" \ hi-tag instance? ] unit-test
+
+! Regression
+GENERIC: method-forget-test
+TUPLE: method-forget-class ;
+M: method-forget-class method-forget-test ;
+
+[ f ] [ \ method-forget-test "methods" assoc-empty? ] unit-test
+[ ] [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test
+[ t ] [ \ method-forget-test "methods" assoc-empty? ] unit-test
diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index 3df9dc9cb2..6f31b0ad7c 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -460,3 +460,10 @@ must-fail-with
     "change-combination" "parser.tests" lookup
     "methods" word-prop assoc-size
 ] unit-test
+
+[ [ ] ] [
+    2 [
+        "IN: classes.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
+        <string-reader> "twice-fails-test" parse-stream
+    ] times
+] unit-test

From cee6ab6770f6aa90dbb085ba08c21e1139a0a8cf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 17:45:00 -0500
Subject: [PATCH 05/39] Add unit test to prevent future screwups

---
 core/prettyprint/prettyprint-tests.factor | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor
index ed6b2f3c3c..f5ec263f11 100755
--- a/core/prettyprint/prettyprint-tests.factor
+++ b/core/prettyprint/prettyprint-tests.factor
@@ -342,3 +342,5 @@ INTERSECTION: intersection-see-test sequence number ;
 
 [ ] [ \ compose see ] unit-test
 [ ] [ \ curry see ] unit-test
+
+[ "POSTPONE: [" ] [ \ [ unparse ] unit-test

From 3a6532a9f89e91a04389d885119de255780cc4f9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 17:45:14 -0500
Subject: [PATCH 06/39] Update html.streams usages

---
 extra/farkup/farkup-tests.factor       |  2 +-
 extra/farkup/farkup.factor             | 10 ++++------
 extra/xmode/code2html/code2html.factor |  8 ++++----
 3 files changed, 9 insertions(+), 11 deletions(-)

diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor
index 7176486f8e..4d235a054c 100755
--- a/extra/farkup/farkup-tests.factor
+++ b/extra/farkup/farkup-tests.factor
@@ -54,7 +54,7 @@ IN: farkup.tests
 [ "<p>=</p><h2>foo</h2>" ] [ "===foo==" convert-farkup ] unit-test
 [ "<h1>foo</h1><p>=</p>" ] [ "=foo==" convert-farkup ] unit-test
 
-[ "<div style='white-space: pre; font-family: monospace; '><span class='KEYWORD3'>int</span> <span class='FUNCTION'>main</span><span class='OPERATOR'>(</span><span class='OPERATOR'>)</span><br/></div>" ]
+[ "<pre><span class='KEYWORD3'>int</span> <span class='FUNCTION'>main</span><span class='OPERATOR'>(</span><span class='OPERATOR'>)</span>\n</pre>" ]
 [ "[c{int main()}]" convert-farkup ] unit-test
 
 [ "<p><img src=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
index 15b7b4b72c..860fdba3af 100755
--- a/extra/farkup/farkup.factor
+++ b/extra/farkup/farkup.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays io io.styles kernel memoize namespaces peg
 sequences strings html.elements xml.entities xmode.code2html
-splitting io.streams.string html peg.parsers html.elements
+splitting io.streams.string peg.parsers
 sequences.deep unicode.categories ;
 IN: farkup
 
@@ -56,11 +56,9 @@ MEMO: eq ( -- parser )
 : render-code ( string mode -- string' )
     >r string-lines r>
     [
-        [
-            H{ { wrap-margin f } } [
-                htmlize-lines
-            ] with-nesting
-        ] with-html-stream
+        <pre>
+            htmlize-lines
+        </pre>
     ] with-string-writer ;
 
 : check-url ( href -- href' )
diff --git a/extra/xmode/code2html/code2html.factor b/extra/xmode/code2html/code2html.factor
index 3977f4277c..a9384ad861 100755
--- a/extra/xmode/code2html/code2html.factor
+++ b/extra/xmode/code2html/code2html.factor
@@ -1,12 +1,12 @@
 USING: xmode.tokens xmode.marker xmode.catalog kernel html
 html.elements io io.files sequences words io.encodings.utf8
-namespaces ;
+namespaces xml.entities ;
 IN: xmode.code2html
 
 : htmlize-tokens ( tokens -- )
     [
         dup token-str swap token-id [
-            <span word-name =class span> write </span>
+            <span word-name =class span> escape-string write </span>
         ] [
             write
         ] if*
@@ -21,7 +21,7 @@ IN: xmode.code2html
 : default-stylesheet ( -- )
     <style>
         "resource:extra/xmode/code2html/stylesheet.css"
-        utf8 file-contents write
+        utf8 file-contents escape-string write
     </style> ;
 
 : htmlize-stream ( path stream -- )
@@ -29,7 +29,7 @@ IN: xmode.code2html
     <html>
         <head>
             default-stylesheet
-            <title> dup write </title>
+            <title> dup escape-string write </title>
         </head>
         <body>
             <pre>

From 23c0d0fc9324f91e449d096429248fcb432dce5b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 17:45:33 -0500
Subject: [PATCH 07/39] Another html.streasm usage

---
 extra/http/server/server.factor | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor
index 4e561220f9..c1684c4ed2 100755
--- a/extra/http/server/server.factor
+++ b/extra/http/server/server.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs kernel namespaces io io.timeouts strings splitting
-threads sequences prettyprint io.server logging calendar
-http html html.elements accessors math.parser combinators.lib
+threads sequences prettyprint io.server logging calendar http
+html.streams html.elements accessors math.parser combinators.lib
 tools.vocabs debugger continuations random combinators
-destructors io.encodings.8-bit fry classes words ;
+destructors io.encodings.8-bit fry classes words math ;
 IN: http.server
 
 ! path is a sequence of path component strings
@@ -274,9 +274,11 @@ SYMBOL: exit-continuation
     ] with-destructors ;
 
 : httpd ( port -- )
-    internet-server "http.server"
-    latin1 [ handle-client ] with-server ;
+    dup integer? [ internet-server ] when
+    "http.server" latin1
+    [ handle-client ] with-server ;
 
-: httpd-main ( -- ) 8888 httpd ;
+: httpd-main ( -- )
+    8888 httpd ;
 
 MAIN: httpd-main

From 8327449a65a95f95139cf3bd8eeeeddf637e1a72 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 19:16:21 -0500
Subject: [PATCH 08/39] Move templates to html vocabulary

---
 extra/html/components/components-tests.factor | 10 ++-
 extra/html/components/components.factor       |  8 +-
 .../templates}/chloe/chloe-tests.factor       | 10 +--
 .../templates}/chloe/chloe.factor             | 78 ++++++++++-------
 .../templates}/chloe/test/test1.xml           |  0
 .../templates}/chloe/test/test2.xml           |  0
 .../templates}/chloe/test/test3-aux.xml       |  0
 .../templates}/chloe/test/test3.xml           |  0
 .../templates}/chloe/test/test4.xml           |  2 +-
 .../templates}/chloe/test/test5.xml           |  2 +-
 .../templates}/chloe/test/test6.xml           |  2 +-
 .../templates}/chloe/test/test7.xml           |  2 +-
 .../templates}/fhtml/authors.txt              |  0
 .../templates}/fhtml/fhtml-tests.factor       |  6 +-
 .../templates}/fhtml/fhtml.factor             | 43 +++-------
 .../templates}/fhtml/test/bug.fhtml           |  0
 .../templates}/fhtml/test/bug.html            |  0
 .../templates}/fhtml/test/example.fhtml       |  0
 .../templates}/fhtml/test/example.html        |  0
 .../templates}/fhtml/test/stack.fhtml         |  0
 .../templates}/fhtml/test/stack.html          |  0
 extra/html/templates/templates.factor         | 85 +++++++++++++++++++
 .../http/server/templating/templating.factor  | 27 ------
 extra/validators/validators.factor            |  7 +-
 24 files changed, 169 insertions(+), 113 deletions(-)
 rename extra/{http/server/templating => html/templates}/chloe/chloe-tests.factor (84%)
 rename extra/{http/server/templating => html/templates}/chloe/chloe.factor (80%)
 rename extra/{http/server/templating => html/templates}/chloe/test/test1.xml (100%)
 rename extra/{http/server/templating => html/templates}/chloe/test/test2.xml (100%)
 rename extra/{http/server/templating => html/templates}/chloe/test/test3-aux.xml (100%)
 rename extra/{http/server/templating => html/templates}/chloe/test/test3.xml (100%)
 rename extra/{http/server/templating => html/templates}/chloe/test/test4.xml (62%)
 rename extra/{http/server/templating => html/templates}/chloe/test/test5.xml (62%)
 rename extra/{http/server/templating => html/templates}/chloe/test/test6.xml (62%)
 rename extra/{http/server/templating => html/templates}/chloe/test/test7.xml (62%)
 rename extra/{http/server/templating => html/templates}/fhtml/authors.txt (100%)
 rename extra/{http/server/templating => html/templates}/fhtml/fhtml-tests.factor (74%)
 rename extra/{http/server/templating => html/templates}/fhtml/fhtml.factor (62%)
 rename extra/{http/server/templating => html/templates}/fhtml/test/bug.fhtml (100%)
 rename extra/{http/server/templating => html/templates}/fhtml/test/bug.html (100%)
 rename extra/{http/server/templating => html/templates}/fhtml/test/example.fhtml (100%)
 rename extra/{http/server/templating => html/templates}/fhtml/test/example.html (100%)
 rename extra/{http/server/templating => html/templates}/fhtml/test/stack.fhtml (100%)
 rename extra/{http/server/templating => html/templates}/fhtml/test/stack.html (100%)
 create mode 100644 extra/html/templates/templates.factor
 delete mode 100644 extra/http/server/templating/templating.factor

diff --git a/extra/html/components/components-tests.factor b/extra/html/components/components-tests.factor
index 6ecd2b0fa6..0bd5410a3b 100644
--- a/extra/html/components/components-tests.factor
+++ b/extra/html/components/components-tests.factor
@@ -60,7 +60,7 @@ TUPLE: color red green blue ;
 
 [ ] [
     [
-        "green" <textarea> 25 >>rows 30 >>columns render
+        "green" <textarea> 25 >>rows 30 >>cols render
     ] with-null-writer
 ] unit-test
 
@@ -68,11 +68,13 @@ TUPLE: color red green blue ;
 
 [ ] [ "new york" "city1" set-value ] unit-test
 
+[ ] [ { "new york" "los angeles" "chicago" } "cities" set-value ] unit-test
+
 [ ] [
     [
         "city1"
         <choice>
-            { "new york" "los angeles" "chicago" } >>choices
+            "cities" >>choices
         render
     ] with-null-writer
 ] unit-test
@@ -83,7 +85,7 @@ TUPLE: color red green blue ;
     [
         "city2"
         <choice>
-            { "new york" "los angeles" "chicago" } >>choices
+            "cities" >>choices
             t >>multiple
         render
     ] with-null-writer
@@ -93,7 +95,7 @@ TUPLE: color red green blue ;
     [
         "city2"
         <choice>
-            { "new york" "los angeles" "chicago" } >>choices
+            "cities" >>choices
             t >>multiple
             5 >>size
         render
diff --git a/extra/html/components/components.factor b/extra/html/components/components.factor
index ef4def8ddb..df1d1faa72 100644
--- a/extra/html/components/components.factor
+++ b/extra/html/components/components.factor
@@ -78,7 +78,7 @@ M: password render*
     [ drop "" ] 2dip size>> "password" render-field ;
 
 ! Text areas
-TUPLE: textarea rows columns ;
+TUPLE: textarea rows cols ;
 
 : <textarea> ( -- renderer )
     textarea new ;
@@ -86,14 +86,14 @@ TUPLE: textarea rows columns ;
 M: textarea render*
     <textarea
         [ rows>> [ number>string =rows ] when* ]
-        [ columns>> [ number>string =cols ] when* ] bi
+        [ cols>> [ number>string =cols ] when* ] bi
         =name
     textarea>
         object>string escape-string write
     </textarea> ;
 
 ! Choice
-TUPLE: choice size choices multiple ;
+TUPLE: choice size multiple choices ;
 
 : <choice> ( -- choice )
     choice new ;
@@ -112,7 +112,7 @@ M: choice render*
         dup size>> [ number>string =size ] when*
         dup multiple>> [ "true" =multiple ] when
     select>
-        [ choices>> ] [ multiple>> ] bi
+        [ choices>> value ] [ multiple>> ] bi
         [ swap ] [ swap 1array ] if
         render-options
     </select> ;
diff --git a/extra/http/server/templating/chloe/chloe-tests.factor b/extra/html/templates/chloe/chloe-tests.factor
similarity index 84%
rename from extra/http/server/templating/chloe/chloe-tests.factor
rename to extra/html/templates/chloe/chloe-tests.factor
index 61f72a2f14..3c52153eee 100644
--- a/extra/http/server/templating/chloe/chloe-tests.factor
+++ b/extra/html/templates/chloe/chloe-tests.factor
@@ -1,8 +1,8 @@
-USING: http.server.templating http.server.templating.chloe
-http.server.components http.server.boilerplate tools.test
-io.streams.string kernel sequences ascii boxes namespaces xml
+USING: html.templates html.templates.chloe
+tools.test io.streams.string kernel sequences ascii boxes
+namespaces xml
 splitting ;
-IN: http.server.templating.chloe.tests
+IN: html.templates.chloe.tests
 
 [ f ] [ f parse-query-attr ] unit-test
 
@@ -26,7 +26,7 @@ IN: http.server.templating.chloe.tests
     "?>" split1 nip ; inline
 
 : test-template ( name -- template )
-    "resource:extra/http/server/templating/chloe/test/"
+    "resource:extra/html/templates/chloe/test/"
     swap
     ".xml" 3append <chloe> ;
 
diff --git a/extra/http/server/templating/chloe/chloe.factor b/extra/html/templates/chloe/chloe.factor
similarity index 80%
rename from extra/http/server/templating/chloe/chloe.factor
rename to extra/html/templates/chloe/chloe.factor
index c3d93f5909..a01d424eb9 100644
--- a/extra/http/server/templating/chloe/chloe.factor
+++ b/extra/html/templates/chloe/chloe.factor
@@ -3,13 +3,14 @@
 USING: accessors kernel sequences combinators kernel namespaces
 classes.tuple assocs splitting words arrays memoize
 io io.files io.encodings.utf8 io.streams.string
-unicode.case tuple-syntax html html.elements
+unicode.case tuple-syntax mirrors fry
 multiline xml xml.data xml.writer xml.utilities
+html.elements
+html.components
 http.server
 http.server.auth
 http.server.flows
 http.server.actions
-http.server.components
 http.server.sessions
 http.server.templating
 http.server.boilerplate ;
@@ -52,8 +53,11 @@ MEMO: chloe-name ( string -- name )
 : optional-attr ( tag name -- value )
     chloe-name swap at ;
 
+: process-tag-children ( tag -- )
+    [ process-template ] each ;
+
 : children>string ( tag -- string )
-    [ [ process-template ] each ] with-string-writer ;
+    [ process-tag-children ] with-string-writer ;
 
 : title-tag ( tag -- )
     children>string set-title ;
@@ -89,18 +93,6 @@ MEMO: chloe-name ( string -- name )
         atom-feed get value>> second write
     ] if ;
 
-: component-attr ( tag -- name )
-    "component" required-attr ;
-
-: view-tag ( tag -- )
-    component-attr component render-view ;
-
-: edit-tag ( tag -- )
-    component-attr component render-edit ;
-
-: summary-tag ( tag -- )
-    component-attr component render-summary ;
-
 : parse-query-attr ( string -- assoc )
     dup empty?
     [ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ;
@@ -133,9 +125,6 @@ MEMO: chloe-name ( string -- name )
         a>
     ] with-scope ;
 
-: process-tag-children ( tag -- )
-    [ process-template ] each ;
-
 : a-tag ( tag -- )
     [ a-start-tag ]
     [ process-tag-children ]
@@ -156,7 +145,7 @@ MEMO: chloe-name ( string -- name )
             form>
         ] [
             hidden-form-field
-            "for" optional-attr [ component render-edit ] when*
+            "for" optional-attr [ hidden render ] when*
         ] bi
     ] with-scope ;
 
@@ -180,9 +169,9 @@ STRING: button-tag-markup
 : button-tag ( tag -- )
     button-tag-markup string>xml delegate
     {
-        [ >r tag-attrs chloe-attrs-only r> add-tag-attrs ]
-        [ >r tag-attrs non-chloe-attrs-only r> "button" tag-named add-tag-attrs ]
-        [ >r children>string 1array r> "button" tag-named set-tag-children ]
+        [ [ tag-attrs chloe-attrs-only ] dip add-tag-attrs ]
+        [ [ tag-attrs non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
+        [ [ children>string 1array ] dip "button" tag-named set-tag-children ]
         [ nip ]
     } 2cleave process-chloe-tag ;
 
@@ -211,27 +200,58 @@ STRING: button-tag-markup
 : error-message-tag ( tag -- )
     children>string render-error ;
 
+: validation-messages-tag ( tag -- )
+    drop render-validation-messages ;
+
+: singleton-component-tag ( tag class -- )
+    [ "name" required-attr ] dip render ;
+
+: attrs>slots ( tag tuple -- )
+    [ attrs>> ] [ <mirror> ] bi* '[ swap tag>> , set-at ] assoc-each ;
+
+: tuple-component-tag ( tag class -- )
+    [ drop "name" required-attr ]
+    [ new [ attrs>slots ] keep ]
+    2bi render ;
+
 : process-chloe-tag ( tag -- )
     dup name-tag {
-        { "chloe" [ [ process-template ] each ] }
+        { "chloe" [ process-tag-children ] }
+
+        ! HTML head
         { "title" [ title-tag ] }
         { "write-title" [ write-title-tag ] }
         { "style" [ style-tag ] }
         { "write-style" [ write-style-tag ] }
         { "atom" [ atom-tag ] }
         { "write-atom" [ write-atom-tag ] }
-        { "view" [ view-tag ] }
-        { "edit" [ edit-tag ] }
-        { "summary" [ summary-tag ] }
+
+        ! HTML elements
         { "a" [ a-tag ] }
-        { "form" [ form-tag ] }
         { "button" [ button-tag ] }
+
+        ! Components
+        { "label" [ label singleton-component-tag ] }
+        { "link" [ link singleton-component-tag ] }
+        { "html" [ html singleton-component-tag ] }
+
+        ! Forms
+        { "form" [ form-tag ] }
         { "error-message" [ error-message-tag ] }
-        { "validation-message" [ drop render-validation-message ] }
+        { "validation-messages" [ validation-messages-tag ] }
+        { "hidden" [ hidden singleton-component-tag ] }
+        { "field" [ field tuple-component-tag ] }
+        { "password" [ password tuple-component-tag ] }
+        { "textarea" [ textarea tuple-component-tag ] }
+        { "choice" [ choice tuple-component-tag ] }
+        { "checkbox" [ checkbox tuple-component-tag ] }
+
+        ! Control flow
         { "if" [ if-tag ] }
         { "comment" [ drop ] }
         { "call-next-template" [ drop call-next-template ] }
-        [ "Unknown chloe tag: " swap append throw ]
+
+        [ "Unknown chloe tag: " prepend throw ]
     } case ;
 
 : process-tag ( tag -- )
diff --git a/extra/http/server/templating/chloe/test/test1.xml b/extra/html/templates/chloe/test/test1.xml
similarity index 100%
rename from extra/http/server/templating/chloe/test/test1.xml
rename to extra/html/templates/chloe/test/test1.xml
diff --git a/extra/http/server/templating/chloe/test/test2.xml b/extra/html/templates/chloe/test/test2.xml
similarity index 100%
rename from extra/http/server/templating/chloe/test/test2.xml
rename to extra/html/templates/chloe/test/test2.xml
diff --git a/extra/http/server/templating/chloe/test/test3-aux.xml b/extra/html/templates/chloe/test/test3-aux.xml
similarity index 100%
rename from extra/http/server/templating/chloe/test/test3-aux.xml
rename to extra/html/templates/chloe/test/test3-aux.xml
diff --git a/extra/http/server/templating/chloe/test/test3.xml b/extra/html/templates/chloe/test/test3.xml
similarity index 100%
rename from extra/http/server/templating/chloe/test/test3.xml
rename to extra/html/templates/chloe/test/test3.xml
diff --git a/extra/http/server/templating/chloe/test/test4.xml b/extra/html/templates/chloe/test/test4.xml
similarity index 62%
rename from extra/http/server/templating/chloe/test/test4.xml
rename to extra/html/templates/chloe/test/test4.xml
index dd9b232d73..55612360a5 100644
--- a/extra/http/server/templating/chloe/test/test4.xml
+++ b/extra/html/templates/chloe/test/test4.xml
@@ -2,7 +2,7 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:if t:code="http.server.templating.chloe.tests:test4-aux?">
+	<t:if t:code="html.templates.chloe.tests:test4-aux?">
 		True
 	</t:if>
 
diff --git a/extra/http/server/templating/chloe/test/test5.xml b/extra/html/templates/chloe/test/test5.xml
similarity index 62%
rename from extra/http/server/templating/chloe/test/test5.xml
rename to extra/html/templates/chloe/test/test5.xml
index 3bd39e45bd..edcbe8f3b1 100644
--- a/extra/http/server/templating/chloe/test/test5.xml
+++ b/extra/html/templates/chloe/test/test5.xml
@@ -2,7 +2,7 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:if t:code="http.server.templating.chloe.tests:test5-aux?">
+	<t:if t:code="html.templates.chloe.tests:test5-aux?">
 		True
 	</t:if>
 
diff --git a/extra/http/server/templating/chloe/test/test6.xml b/extra/html/templates/chloe/test/test6.xml
similarity index 62%
rename from extra/http/server/templating/chloe/test/test6.xml
rename to extra/html/templates/chloe/test/test6.xml
index 56234a5f0d..b3f649333f 100644
--- a/extra/http/server/templating/chloe/test/test6.xml
+++ b/extra/html/templates/chloe/test/test6.xml
@@ -2,7 +2,7 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:if t:var="http.server.templating.chloe.tests:test6-aux?">
+	<t:if t:var="html.templates.chloe.tests:test6-aux?">
 		True
 	</t:if>
 
diff --git a/extra/http/server/templating/chloe/test/test7.xml b/extra/html/templates/chloe/test/test7.xml
similarity index 62%
rename from extra/http/server/templating/chloe/test/test7.xml
rename to extra/html/templates/chloe/test/test7.xml
index a4f8e06e7d..338595e556 100644
--- a/extra/http/server/templating/chloe/test/test7.xml
+++ b/extra/html/templates/chloe/test/test7.xml
@@ -2,7 +2,7 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:if t:var="http.server.templating.chloe.tests:test7-aux?">
+	<t:if t:var="html.templates.chloe.tests:test7-aux?">
 		True
 	</t:if>
 
diff --git a/extra/http/server/templating/fhtml/authors.txt b/extra/html/templates/fhtml/authors.txt
similarity index 100%
rename from extra/http/server/templating/fhtml/authors.txt
rename to extra/html/templates/fhtml/authors.txt
diff --git a/extra/http/server/templating/fhtml/fhtml-tests.factor b/extra/html/templates/fhtml/fhtml-tests.factor
similarity index 74%
rename from extra/http/server/templating/fhtml/fhtml-tests.factor
rename to extra/html/templates/fhtml/fhtml-tests.factor
index 42bec43570..43ea28fa55 100755
--- a/extra/http/server/templating/fhtml/fhtml-tests.factor
+++ b/extra/html/templates/fhtml/fhtml-tests.factor
@@ -1,10 +1,10 @@
 USING: io io.files io.streams.string io.encodings.utf8
-http.server.templating http.server.templating.fhtml kernel
+html.templates html.templates.fhtml kernel
 tools.test sequences parser ;
-IN: http.server.templating.fhtml.tests
+IN: html.templates.fhtml.tests
 
 : test-template ( path -- ? )
-    "resource:extra/http/server/templating/fhtml/test/"
+    "resource:extra/html/templates/fhtml/test/"
     prepend
     [
         ".fhtml" append <fhtml> [ call-template ] with-string-writer
diff --git a/extra/http/server/templating/fhtml/fhtml.factor b/extra/html/templates/fhtml/fhtml.factor
similarity index 62%
rename from extra/http/server/templating/fhtml/fhtml.factor
rename to extra/html/templates/fhtml/fhtml.factor
index 2cc053a0ca..74e5c37ef1 100755
--- a/extra/http/server/templating/fhtml/fhtml.factor
+++ b/extra/html/templates/fhtml/fhtml.factor
@@ -4,12 +4,10 @@
 USING: continuations sequences kernel namespaces debugger
 combinators math quotations generic strings splitting
 accessors assocs fry
-parser io io.files io.streams.string io.encodings.utf8 source-files
-html html.elements
-http.server.static http.server http.server.templating ;
-IN: http.server.templating.fhtml
-
-: templating-vocab ( -- vocab-name ) "http.server.templating.fhtml" ;
+parser io io.files io.streams.string io.encodings.utf8
+html.elements
+html.templates ;
+IN: html.templates.fhtml
 
 ! We use a custom lexer so that %> ends a token even if not
 ! followed by whitespace
@@ -35,7 +33,7 @@ DEFER: <% delimiter
 : found-<% ( accum lexer col -- accum )
     [
         over line-text>>
-        >r >r column>> r> r> subseq parsed
+        [ column>> ] 2dip subseq parsed
         \ write-html parsed
     ] 2keep 2 + >>column drop ;
 
@@ -62,37 +60,20 @@ DEFER: <% delimiter
 
 : parse-template ( string -- quot )
     [
-        use [ clone ] change
-        templating-vocab use+
+        "quiet" on
+        parser-notes off
+        "html.templates.fhtml" use+
         string-lines parse-template-lines
-    ] with-scope ;
+    ] with-file-vocabs ;
 
-: eval-template ( string -- ) parse-template call ;
-
-: html-error. ( error -- )
-    <pre> error. </pre> ;
+: eval-template ( string -- )
+    parse-template call ;
 
 TUPLE: fhtml path ;
 
 C: <fhtml> fhtml
 
 M: fhtml call-template* ( filename -- )
-    '[
-        , path>> [
-            "quiet" on
-            parser-notes off
-            templating-vocab use+
-            ! so that reload works properly
-            dup source-file file set
-            utf8 file-contents
-            [ eval-template ] [ html-error. drop ] recover
-        ] with-file-vocabs
-    ] assert-depth ;
-
-! file responder integration
-: enable-fhtml ( responder -- responder )
-    [ <fhtml> serve-template ]
-    "application/x-factor-server-page"
-    pick special>> set-at ;
+    '[ , path>> utf8 file-contents eval-template ] assert-depth ;
 
 INSTANCE: fhtml template
diff --git a/extra/http/server/templating/fhtml/test/bug.fhtml b/extra/html/templates/fhtml/test/bug.fhtml
similarity index 100%
rename from extra/http/server/templating/fhtml/test/bug.fhtml
rename to extra/html/templates/fhtml/test/bug.fhtml
diff --git a/extra/http/server/templating/fhtml/test/bug.html b/extra/html/templates/fhtml/test/bug.html
similarity index 100%
rename from extra/http/server/templating/fhtml/test/bug.html
rename to extra/html/templates/fhtml/test/bug.html
diff --git a/extra/http/server/templating/fhtml/test/example.fhtml b/extra/html/templates/fhtml/test/example.fhtml
similarity index 100%
rename from extra/http/server/templating/fhtml/test/example.fhtml
rename to extra/html/templates/fhtml/test/example.fhtml
diff --git a/extra/http/server/templating/fhtml/test/example.html b/extra/html/templates/fhtml/test/example.html
similarity index 100%
rename from extra/http/server/templating/fhtml/test/example.html
rename to extra/html/templates/fhtml/test/example.html
diff --git a/extra/http/server/templating/fhtml/test/stack.fhtml b/extra/html/templates/fhtml/test/stack.fhtml
similarity index 100%
rename from extra/http/server/templating/fhtml/test/stack.fhtml
rename to extra/html/templates/fhtml/test/stack.fhtml
diff --git a/extra/http/server/templating/fhtml/test/stack.html b/extra/html/templates/fhtml/test/stack.html
similarity index 100%
rename from extra/http/server/templating/fhtml/test/stack.html
rename to extra/html/templates/fhtml/test/stack.html
diff --git a/extra/html/templates/templates.factor b/extra/html/templates/templates.factor
new file mode 100644
index 0000000000..ed26c9b531
--- /dev/null
+++ b/extra/html/templates/templates.factor
@@ -0,0 +1,85 @@
+! Copyright (C) 2008 Slava Pestov.
+! 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.elements io.streams.string quotations ;
+IN: html.templates
+
+MIXIN: template
+
+GENERIC: call-template* ( template -- )
+
+M: string call-template* write ;
+
+M: callable call-template* call ;
+
+M: object call-template* output-stream get stream-copy ;
+
+ERROR: template-error template error ;
+
+M: template-error error.
+    "Error while processing template " write
+    [ template>> pprint ":" print nl ]
+    [ error>> error. ]
+    bi ;
+
+: call-template ( template -- )
+    [ call-template* ] [ template-error ] recover ;
+
+SYMBOL: title
+
+: set-title ( string -- )
+    title get >box ;
+
+: write-title ( -- )
+    title get value>> write ;
+
+SYMBOL: style
+
+: add-style ( string -- )
+    "\n" style get push-all
+         style get push-all ;
+
+: write-style ( -- )
+    style get >string write ;
+
+SYMBOL: atom-feed
+
+: set-atom-feed ( title url -- )
+    2array atom-feed get >box ;
+
+: write-atom-feed ( -- )
+    atom-feed get value>> [
+        <link "alternate" =rel "application/atom+xml" =type
+        [ first =title ] [ second =href ] bi
+        link/>
+    ] when* ;
+
+SYMBOL: nested-template?
+
+SYMBOL: next-template
+
+: call-next-template ( -- )
+    next-template get write-html ;
+
+M: f call-template* drop call-next-template ;
+
+: with-boilerplate ( body template -- )
+    [
+        title get [ <box> title set ] unless
+        atom-feed get [ <box> atom-feed set ] unless
+        style get [ SBUF" " clone style set ] unless
+
+        [
+            [
+                nested-template? on
+                call-template
+            ] with-string-writer
+            next-template set
+        ]
+        [ call-template ]
+        bi*
+    ] with-scope ; inline
+
+: template-convert ( template output -- )
+    utf8 [ call-template ] with-file-writer ;
diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor
deleted file mode 100644
index 73f6095eae..0000000000
--- a/extra/http/server/templating/templating.factor
+++ /dev/null
@@ -1,27 +0,0 @@
-USING: accessors kernel fry io io.encodings.utf8 io.files
-http http.server debugger prettyprint continuations ;
-IN: http.server.templating
-
-MIXIN: template
-
-GENERIC: call-template* ( template -- )
-
-ERROR: template-error template error ;
-
-M: template-error error.
-    "Error while processing template " write
-    [ template>> pprint ":" print nl ]
-    [ error>> error. ]
-    bi ;
-
-: call-template ( template -- )
-    [ call-template* ] [ template-error ] recover ;
-
-M: template write-response-body* call-template ;
-
-: template-convert ( template output -- )
-    utf8 [ call-template ] with-file-writer ;
-
-! responder integration
-: serve-template ( template -- response )
-    '[ , call-template ] <html-content> ;
diff --git a/extra/validators/validators.factor b/extra/validators/validators.factor
index 9d6c4bed90..b03cc76444 100644
--- a/extra/validators/validators.factor
+++ b/extra/validators/validators.factor
@@ -122,12 +122,7 @@ C: <validation-error> validation-error
     [ swap validation-error-for f ] recover ; inline
 
 : validate-value ( value name validators -- result )
-    '[
-        , at {
-            { [ dup pair? ] [ first ] }
-            { [ dup quotation? ] [ ] }
-        } cond call
-    ] validate ;
+    '[ , at call ] validate ;
 
 : required-values ( assoc -- )
     [ swap [ drop v-required ] validate drop ] assoc-each ;

From 73a25d847167120165db844b3d28f8696f4d0328 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 19:22:31 -0500
Subject: [PATCH 09/39] Remove obsolete vocabularies

---
 extra/http/server/components/code/code.factor |  20 -
 .../server/components/components-tests.factor | 133 ------
 .../http/server/components/components.factor  | 401 ------------------
 .../server/components/farkup/farkup.factor    |  17 -
 .../components/inspector/inspector.factor     |  17 -
 extra/http/server/components/test/form.fhtml  |   1 -
 extra/http/server/forms/forms.factor          |  79 ----
 .../server/validators/validators-tests.factor |  29 --
 .../http/server/validators/validators.factor  |  85 ----
 9 files changed, 782 deletions(-)
 delete mode 100644 extra/http/server/components/code/code.factor
 delete mode 100755 extra/http/server/components/components-tests.factor
 delete mode 100755 extra/http/server/components/components.factor
 delete mode 100755 extra/http/server/components/farkup/farkup.factor
 delete mode 100644 extra/http/server/components/inspector/inspector.factor
 delete mode 100755 extra/http/server/components/test/form.fhtml
 delete mode 100644 extra/http/server/forms/forms.factor
 delete mode 100755 extra/http/server/validators/validators-tests.factor
 delete mode 100755 extra/http/server/validators/validators.factor

diff --git a/extra/http/server/components/code/code.factor b/extra/http/server/components/code/code.factor
deleted file mode 100644
index 19fc8c5ca8..0000000000
--- a/extra/http/server/components/code/code.factor
+++ /dev/null
@@ -1,20 +0,0 @@
-! Copyright (C) 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: splitting kernel io sequences xmode.code2html accessors
-http.server.components html xml.entities ;
-IN: http.server.components.code
-
-TUPLE: code-renderer < text-renderer mode ;
-
-: <code-renderer> ( mode -- renderer )
-    code-renderer new-text-renderer
-        swap >>mode ;
-
-M: code-renderer render-view*
-    [
-        [ string-lines ] [ mode>> value ] bi* htmlize-lines
-    ] with-html-stream ;
-
-: <code> ( id mode -- component )
-    swap <text>
-        swap <code-renderer> >>renderer ;
diff --git a/extra/http/server/components/components-tests.factor b/extra/http/server/components/components-tests.factor
deleted file mode 100755
index ff87bb71fb..0000000000
--- a/extra/http/server/components/components-tests.factor
+++ /dev/null
@@ -1,133 +0,0 @@
-IN: http.server.components.tests
-USING: http.server.components http.server.forms
-http.server.validators namespaces tools.test kernel accessors
-tuple-syntax mirrors
-http http.server.actions http.server.templating.fhtml
-io.streams.string io.streams.null ;
-
-validation-failed? off
-
-[ 3 ] [ "3" "n" <number> validate ] unit-test
-
-[ 123 ] [
-    ""
-    "n" <number>
-        123 >>default
-    validate
-] unit-test
-
-[ f ] [ validation-failed? get ] unit-test
-
-[ t ] [ "3x" "n" <number> validate validation-error? ] unit-test
-
-[ t ] [ validation-failed? get ] unit-test
-
-[ "" ] [ "" "email" <email> validate ] unit-test
-
-[ "slava@jedit.org" ] [ "slava@jedit.org" "email" <email> validate ] unit-test
-
-[ "slava@jedit.org" ] [
-    "slava@jedit.org"
-    "email" <email>
-        t >>required
-    validate
-] unit-test
-
-[ t ] [
-    "a"
-    "email" <email>
-        t >>required
-    validate validation-error?
-] unit-test
-
-[ t ] [ "a" "email" <email> validate validation-error? ] unit-test
-
-TUPLE: test-tuple text number more-text ;
-
-: <test-tuple> test-tuple new ;
-
-: <test-form> ( -- form )
-    "test" <form>
-        "resource:extra/http/server/components/test/form.fhtml" <fhtml> >>view-template
-        "resource:extra/http/server/components/test/form.fhtml" <fhtml> >>edit-template
-        "text" <string>
-            t >>required
-            add-field
-        "number" <number>
-            123 >>default
-            t >>required
-            0 >>min-value
-            10 >>max-value
-            add-field
-        "more-text" <text>
-            "hi" >>default
-            add-field ;
-
-[ ] [ <test-tuple> <mirror> values set <test-form> view-form write-response-body drop ] unit-test
-
-[ ] [ <test-tuple> <mirror> values set <test-form> edit-form write-response-body drop ] unit-test
-
-[ TUPLE{ test-tuple number: 123 more-text: "hi" } ] [
-    <test-tuple> from-tuple
-    <test-form> set-defaults
-    values-tuple
-] unit-test
-
-[
-    H{
-        { "text" "fdafsa" }
-        { "number" "xxx" }
-        { "more-text" "" }
-    } params set
-
-    H{ } clone values set
-
-    [ t ] [ <test-form> (validate-form) ] unit-test
-
-    [ "fdafsa" ] [ "text" value ] unit-test
-
-    [ t ] [ "number" value validation-error? ] unit-test
-] with-scope
-
-[
-    [ ] [
-        "n" <number>
-            0 >>min-value
-            10 >>max-value
-        "n" set
-    ] unit-test
-
-    [ "123" ] [
-        "123" "n" get validate value>>
-    ] unit-test
-    
-    [ ] [ "i" <integer> "i" set ] unit-test
-
-    [ 3 ] [
-        "3" "i" get validate
-    ] unit-test
-    
-    [ t ] [
-        "3.9" "i" get validate validation-error?
-    ] unit-test
-
-    H{ } clone values set
-
-    [ ] [ 3 "i" set-value ] unit-test
-
-    [ "3" ] [ [ "i" get render-view ] with-string-writer ] unit-test
-
-    [ ] [ [ "i" get render-edit ] with-null-stream ] unit-test
-
-    [ ] [ "t" <text> "t" set ] unit-test
-
-    [ ] [ "hello world" "t" set-value ] unit-test
-
-    [ ] [ [ "t" get render-edit ] with-null-stream ] unit-test
-] with-scope
-
-[ t ] [ "wake up sheeple" dup "n" <text> validate = ] unit-test
-
-[ ] [ "password" <password> "p" set ] unit-test
-
-[ ] [ "pub-date" <date> "d" set ] unit-test
diff --git a/extra/http/server/components/components.factor b/extra/http/server/components/components.factor
deleted file mode 100755
index 7f2a5a9ce1..0000000000
--- a/extra/http/server/components/components.factor
+++ /dev/null
@@ -1,401 +0,0 @@
-! Copyright (C) 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors namespaces kernel io math.parser assocs classes
-words classes.tuple arrays sequences splitting mirrors
-hashtables fry locals combinators continuations math
-calendar.format html html.elements xml.entities
-http.server.validators ;
-IN: http.server.components
-
-! Renderer protocol
-GENERIC: render-summary* ( value renderer -- )
-GENERIC: render-view* ( value renderer -- )
-GENERIC: render-edit* ( value id renderer -- )
-
-M: object render-summary* render-view* ;
-
-TUPLE: field type ;
-
-C: <field> field
-
-M: field render-view*
-    drop escape-string write ;
-
-M: field render-edit*
-    <input type>> =type =name =value input/> ;
-
-TUPLE: hidden < field ;
-
-: hidden ( -- renderer ) T{ hidden f "hidden" } ; inline
-
-! Component protocol
-SYMBOL: components
-
-TUPLE: component id required default renderer ;
-
-: component ( name -- component )
-    dup components get at
-    [ ] [ "No such component: " prepend throw ] ?if ;
-
-GENERIC: init ( component -- component )
-
-M: component init ;
-
-GENERIC: validate* ( value component -- result )
-GENERIC: component-string ( value component -- string )
-
-SYMBOL: values
-
-: value values get at ;
-
-: set-value values get set-at ;
-
-: blank-values H{ } clone values set ;
-
-: from-tuple <mirror> values set ;
-
-: values-tuple values get mirror-object ;
-
-: render-view-or-summary ( component -- value renderer )
-    [ id>> value ] [ component-string ] [ renderer>> ] tri ;
-
-: render-view ( component -- )
-    render-view-or-summary render-view* ;
-
-: render-summary ( component -- )
-    render-view-or-summary render-summary* ;
-
-<PRIVATE
-
-: render-edit-string ( string component -- )
-    [ id>> ] [ renderer>> ] bi render-edit* ;
-
-: render-edit-error ( component -- )
-    [ id>> value ] keep
-    [ [ value>> ] dip render-edit-string ]
-    [ drop reason>> render-error ] 2bi ;
-
-: value-or-default ( component -- value )
-    [ id>> value ] [ default>> ] bi or ;
-
-: render-edit-value ( component -- )
-    [ value-or-default ]
-    [ component-string ]
-    [ render-edit-string ]
-    tri ;
-
-PRIVATE>
-
-: render-edit ( component -- )
-    dup id>> value validation-error?
-    [ render-edit-error ] [ render-edit-value ] if ;
-
-: validate ( value component -- result )
-    '[
-        ,
-        over empty? [
-            [ default>> [ v-default ] when* ]
-            [ required>> [ v-required ] when ]
-            bi
-        ] [ validate* ] if
-    ] with-validator ;
-
-: new-component ( id class renderer -- component )
-    swap new
-        swap >>renderer
-        swap >>id
-        init ; inline
-
-! String input fields
-TUPLE: string < component one-line min-length max-length ;
-
-: new-string ( id class -- component )
-    "text" <field> new-component
-        t >>one-line ; inline
-
-: <string> ( id -- component )
-    string new-string ;
-
-M: string validate*
-    [   one-line>> [ v-one-line   ] when  ]
-    [ min-length>> [ v-min-length ] when* ]
-    [ max-length>> [ v-max-length ] when* ]
-    tri ;
-
-M: string component-string
-    drop ;
-
-! Username fields
-TUPLE: username < string ;
-
-M: username init
-    2 >>min-length
-    20 >>max-length ;
-
-: <username> ( id -- component )
-    username new-string ;
-
-M: username validate*
-    call-next-method v-one-word ;
-
-! E-mail fields
-TUPLE: email < string ;
-
-: <email> ( id -- component )
-    email new-string
-        5 >>min-length
-        60 >>max-length ;
-
-M: email validate*
-    call-next-method dup empty? [ v-email ] unless ;
-
-! URL fields
-TUPLE: url < string ;
-
-: <url> ( id -- component )
-    url new-string
-        5 >>min-length
-        60 >>max-length ;
-
-M: url validate*
-    call-next-method dup empty? [ v-url ] unless ;
-
-! Don't send passwords back to the user
-TUPLE: password-renderer < field ;
-
-: password-renderer T{ password-renderer f "password" } ;
-
-: blank-password >r >r drop "" r> r> ;
-
-M: password-renderer render-edit*
-    blank-password call-next-method ;
-
-! Password fields
-TUPLE: password < string ;
-
-M: password init
-    6 >>min-length
-    60 >>max-length ;
-
-: <password> ( id -- component )
-    password new-string
-        password-renderer >>renderer ;
-
-M: password validate*
-    call-next-method v-one-word ;
-
-! Number fields
-TUPLE: number < string min-value max-value ;
-
-: <number> ( id -- component )
-    number new-string ;
-
-M: number validate*
-    [ v-number ] [
-        [ min-value>> [ v-min-value ] when* ]
-        [ max-value>> [ v-max-value ] when* ]
-        bi
-    ] bi* ;
-
-M: number component-string
-    drop dup [ number>string ] when ;
-
-! Integer fields
-TUPLE: integer < number ;
-
-: <integer> ( id -- component )
-    integer new-string ;
-
-M: integer validate*
-    call-next-method v-integer ;
-
-! Simple captchas
-TUPLE: captcha < string ;
-
-: <captcha> ( id -- component )
-    captcha new-string ;
-
-M: captcha validate*
-    drop v-captcha ;
-
-! Text areas
-TUPLE: text-renderer rows cols ;
-
-: new-text-renderer ( class -- renderer )
-    new
-        60 >>cols
-        20 >>rows ;
-
-: <text-renderer> ( -- renderer )
-    text-renderer new-text-renderer ;
-
-M: text-renderer render-view*
-    drop escape-string write ;
-
-M: text-renderer render-edit*
-    <textarea
-        [ rows>> [ number>string =rows ] when* ]
-        [ cols>> [ number>string =cols ] when* ] bi
-        [ =id   ]
-        [ =name ] bi
-    textarea>
-        escape-string write
-    </textarea> ;
-
-TUPLE: text < string ;
-
-: new-text ( id class -- component )
-    new-string
-        f >>one-line
-        <text-renderer> >>renderer ;
-
-: <text> ( id -- component )
-    text new-text ;
-
-! HTML text component
-TUPLE: html-text-renderer < text-renderer ;
-
-: <html-text-renderer> ( -- renderer )
-    html-text-renderer new-text-renderer ;
-
-M: html-text-renderer render-view*
-    drop escape-string write ;
-
-TUPLE: html-text < text ;
-
-: <html-text> ( id -- component )
-    html-text new-text
-        <html-text-renderer> >>renderer ;
-
-! Date component
-TUPLE: date < string ;
-
-: <date> ( id -- component )
-    date new-string ;
-
-M: date component-string
-    drop timestamp>string ;
-
-! Link components
-
-GENERIC: link-title ( obj -- string )
-GENERIC: link-href ( obj -- url )
-
-SINGLETON: link-renderer
-
-M: link-renderer render-view*
-    drop <a dup link-href =href a> link-title escape-string write </a> ;
-
-TUPLE: link < string ;
-
-: <link> ( id -- component )
-    link new-string
-        link-renderer >>renderer ;
-
-! List components
-SYMBOL: +plain+
-SYMBOL: +ordered+
-SYMBOL: +unordered+
-
-TUPLE: list-renderer component type ;
-
-C: <list-renderer> list-renderer
-
-: render-plain-list ( seq component quot -- )
-    '[ , component>> renderer>> @ ] each ; inline
-
-: render-li-list ( seq component quot -- )
-    '[ <li> @ </li> ] render-plain-list ; inline
-
-: render-ordered-list ( seq quot component -- )
-    <ol> render-li-list </ol> ; inline
-
-: render-unordered-list ( seq quot component -- )
-    <ul> render-li-list </ul> ; inline
-
-: render-list ( value renderer quot -- )
-    over type>> {
-        { +plain+     [ render-plain-list ] }
-        { +ordered+   [ render-ordered-list ] }
-        { +unordered+ [ render-unordered-list ] }
-    } case ; inline
-
-M: list-renderer render-view*
-    [ render-view* ] render-list ;
-
-M: list-renderer render-summary*
-    [ render-summary* ] render-list ;
-
-TUPLE: list < component ;
-
-: <list> ( id component type -- list )
-    <list-renderer> list swap new-component ;
-
-M: list component-string drop ;
-
-! Choice
-TUPLE: choice-renderer choices ;
-
-C: <choice-renderer> choice-renderer
-
-M: choice-renderer render-view*
-    drop escape-string write ;
-
-: render-option ( text selected? -- )
-    <option [ "true" =selected ] when option>
-        escape-string write
-    </option> ;
-
-: render-options ( options selected -- )
-    '[ dup , member? render-option ] each ;
-
-M: choice-renderer render-edit*
-    <select swap =name select>
-        choices>> swap 1array render-options
-    </select> ;
-
-TUPLE: choice < string ;
-
-: <choice> ( id choices -- component )
-    swap choice new-string
-        swap <choice-renderer> >>renderer ;
-
-! Menu
-TUPLE: menu-renderer choices size ;
-
-: <menu-renderer> ( choices -- renderer )
-    5 menu-renderer boa ;
-
-M:: menu-renderer render-edit* ( value id renderer -- )
-    <select
-        renderer size>> [ number>string =size ] when*
-        id =name
-        "true" =multiple
-    select>
-        renderer choices>> value render-options
-    </select> ;
-
-TUPLE: menu < string ;
-
-: <menu> ( id choices -- component )
-    swap menu new-string
-        swap <menu-renderer> >>renderer ;
-
-! Checkboxes
-TUPLE: checkbox-renderer label ;
-
-C: <checkbox-renderer> checkbox-renderer
-
-M: checkbox-renderer render-edit*
-    <input
-        "checkbox" =type
-        swap =id
-        swap [ "true" =selected ] when
-    input>
-        label>> escape-string write
-    </input> ;
-
-TUPLE: checkbox < string ;
-
-: <checkbox> ( id label -- component )
-    checkbox swap <checkbox-renderer> new-component ;
diff --git a/extra/http/server/components/farkup/farkup.factor b/extra/http/server/components/farkup/farkup.factor
deleted file mode 100755
index 87b7170bbf..0000000000
--- a/extra/http/server/components/farkup/farkup.factor
+++ /dev/null
@@ -1,17 +0,0 @@
-! Copyright (C) 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: splitting kernel io sequences farkup accessors
-http.server.components xml.entities ;
-IN: http.server.components.farkup
-
-TUPLE: farkup-renderer < text-renderer ;
-
-: <farkup-renderer> ( -- renderer )
-    farkup-renderer new-text-renderer ;
-
-M: farkup-renderer render-view*
-    drop string-lines "\n" join convert-farkup write ;
-
-: <farkup> ( id -- component )
-    <text>
-        <farkup-renderer> >>renderer ;
diff --git a/extra/http/server/components/inspector/inspector.factor b/extra/http/server/components/inspector/inspector.factor
deleted file mode 100644
index 42366b57e4..0000000000
--- a/extra/http/server/components/inspector/inspector.factor
+++ /dev/null
@@ -1,17 +0,0 @@
-! Copyright (C) 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: splitting kernel io sequences inspector accessors
-http.server.components xml.entities html ;
-IN: http.server.components.inspector
-
-SINGLETON: inspector-renderer
-
-M: inspector-renderer render-view*
-    drop [ describe ] with-html-stream ;
-
-TUPLE: inspector < component ;
-
-M: inspector component-string drop ;
-
-: <inspector> ( id -- component )
-    inspector inspector-renderer new-component ;
diff --git a/extra/http/server/components/test/form.fhtml b/extra/http/server/components/test/form.fhtml
deleted file mode 100755
index d3f5a12faa..0000000000
--- a/extra/http/server/components/test/form.fhtml
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/extra/http/server/forms/forms.factor b/extra/http/server/forms/forms.factor
deleted file mode 100644
index 92fb25bb16..0000000000
--- a/extra/http/server/forms/forms.factor
+++ /dev/null
@@ -1,79 +0,0 @@
-! Copyright (C) 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors assocs namespaces io.files sequences fry
-http.server
-http.server.actions
-http.server.components
-http.server.validators
-http.server.templating ;
-IN: http.server.forms
-
-TUPLE: form < component
-view-template edit-template summary-template
-components ;
-
-M: form init V{ } clone >>components ;
-
-: <form> ( id -- form )
-    form f new-component
-        dup >>renderer ;
-
-: add-field ( form component -- form )
-    dup id>> pick components>> set-at ;
-
-: set-components ( form -- )
-    components>> components set ;
-
-: with-form ( form quot -- )
-    [ [ set-components ] [ call ] bi* ] with-scope ; inline
-
-: set-defaults ( form -- )
-    [
-        components get [
-            swap values get [
-                swap default>> or
-            ] change-at
-        ] assoc-each
-    ] with-form ;
-
-: <form-response> ( form template -- response )
-    [ components>> components set ] [ <html-content> ] bi* ;
-
-: view-form ( form -- response )
-    dup view-template>> <form-response> ;
-
-: edit-form ( form -- response )
-    dup edit-template>> <form-response> ;
-
-: validate-param ( id component -- )
-    [ [ params get at ] [ validate ] bi* ]
-    [ drop set-value ] 2bi ;
-
-: (validate-form) ( form -- error? )
-    [
-        validation-failed? off
-        components get [ validate-param ] assoc-each
-        validation-failed? get
-    ] with-form ;
-
-: validate-form ( form -- )
-    (validate-form) [ validation-failed ] when ;
-
-: render-form ( value form template -- )
-    [
-        [ from-tuple ]
-        [ set-components ]
-        [ call-template ]
-        tri*
-    ] with-scope ;
-
-M: form component-string drop ;
-
-M: form render-summary*
-    dup summary-template>> render-form ;
-
-M: form render-view*
-    dup view-template>> render-form ;
-
-M: form render-edit*
-    nip dup edit-template>> render-form ;
diff --git a/extra/http/server/validators/validators-tests.factor b/extra/http/server/validators/validators-tests.factor
deleted file mode 100755
index 5e845705ab..0000000000
--- a/extra/http/server/validators/validators-tests.factor
+++ /dev/null
@@ -1,29 +0,0 @@
-IN: http.server.validators.tests
-USING: kernel sequences tools.test http.server.validators
-accessors ;
-
-[ "foo" v-number ] must-fail
-[ 123 ] [ "123" v-number ] unit-test
-
-[ "slava@factorcode.org" ] [
-    "slava@factorcode.org" v-email
-] unit-test
-
-[ "slava+foo@factorcode.org" ] [
-    "slava+foo@factorcode.org" v-email
-] unit-test
-
-[ "slava@factorcode.o" v-email ]
-[ "invalid e-mail" = ] must-fail-with
-
-[ "sla@@factorcode.o" v-email ]
-[ "invalid e-mail" = ] must-fail-with
-
-[ "slava@factorcodeorg" v-email ]
-[ "invalid e-mail" = ] must-fail-with
-
-[ "http://www.factorcode.org" ]
-[ "http://www.factorcode.org" v-url ] unit-test
-
-[ "http:/www.factorcode.org" v-url ]
-[ "invalid URL" = ] must-fail-with
diff --git a/extra/http/server/validators/validators.factor b/extra/http/server/validators/validators.factor
deleted file mode 100755
index 7415787c79..0000000000
--- a/extra/http/server/validators/validators.factor
+++ /dev/null
@@ -1,85 +0,0 @@
-! Copyright (C) 2006, 2008 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations sequences math namespaces sets
-math.parser assocs regexp fry unicode.categories sequences ;
-IN: http.server.validators
-
-SYMBOL: validation-failed?
-
-TUPLE: validation-error value reason ;
-
-C: <validation-error> validation-error
-
-: with-validator ( value quot -- result )
-    [ validation-failed? on <validation-error> ] recover ; inline
-
-: v-default ( str def -- str )
-    over empty? spin ? ;
-
-: v-required ( str -- str )
-    dup empty? [ "required" throw ] when ;
-
-: v-optional ( str quot -- str )
-    over empty? [ 2drop f ] [ call ] if ; inline
-
-: v-min-length ( str n -- str )
-    over length over < [
-        [ "must be at least " % # " characters" % ] "" make
-        throw
-    ] [
-        drop
-    ] if ;
-
-: v-max-length ( str n -- str )
-    over length over > [
-        [ "must be no more than " % # " characters" % ] "" make
-        throw
-    ] [
-        drop
-    ] if ;
-
-: v-number ( str -- n )
-    dup string>number [ ] [ "must be a number" throw ] ?if ;
-
-: v-integer ( n -- n )
-    dup integer? [ "must be an integer" throw ] unless ;
-
-: v-min-value ( x n -- x )
-    2dup < [
-        [ "must be at least " % # ] "" make throw
-    ] [
-        drop
-    ] if ;
-
-: v-max-value ( x n -- x )
-    2dup > [
-        [ "must be no more than " % # ] "" make throw
-    ] [
-        drop
-    ] if ;
-
-: v-regexp ( str what regexp -- str )
-    >r over r> matches?
-    [ drop ] [ "invalid " prepend throw ] if ;
-
-: v-email ( str -- str )
-    #! From http://www.regular-expressions.info/email.html
-    "e-mail"
-    R' [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}'i
-    v-regexp ;
-
-: v-url ( str -- str )
-    "URL"
-    R' (ftp|http|https)://(\w+:?\w*@)?(\S+)(:[0-9]+)?(/|/([\w#!:.?+=&%@!\-/]))?'
-    v-regexp ;
-
-: v-captcha ( str -- str )
-    dup empty? [ "must remain blank" throw ] unless ;
-
-: v-one-line ( str -- str )
-    dup "\r\n" intersect empty?
-    [ "must be a single line" throw ] unless ;
-
-: v-one-word ( str -- str )
-    dup [ alpha? ] all?
-    [ "must be a single word" throw ] unless ;

From 376c73c7c86e69ec84ecab4fd212f342ef16b7d5 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 22:20:27 -0500
Subject: [PATCH 10/39] Convert HTML streams to use inheritance and new
 accessors, fix a bug

---
 extra/html/streams/streams-tests.factor |  4 +-
 extra/html/streams/streams.factor       | 93 ++++++++++++-------------
 2 files changed, 49 insertions(+), 48 deletions(-)

diff --git a/extra/html/streams/streams-tests.factor b/extra/html/streams/streams-tests.factor
index 2084c7db18..14f1621346 100644
--- a/extra/html/streams/streams-tests.factor
+++ b/extra/html/streams/streams-tests.factor
@@ -1,6 +1,6 @@
 USING: html.streams html.streams.private
 io io.streams.string io.styles kernel
-namespaces tools.test xml.writer sbufs sequences ;
+namespaces tools.test xml.writer sbufs sequences inspector ;
 IN: html.streams.tests
 
 : make-html-string
@@ -70,3 +70,5 @@ M: funky browser-link-href
 ] [
     [ H{ } [ ] with-nesting nl ] make-html-string
 ] unit-test
+
+[ ] [ [ { 1 2 3 } describe ] with-html-stream ] unit-test
diff --git a/extra/html/streams/streams.factor b/extra/html/streams/streams.factor
index b35f383bdc..e3f45e4c25 100755
--- a/extra/html/streams/streams.factor
+++ b/extra/html/streams/streams.factor
@@ -1,50 +1,44 @@
-! Copyright (C) 2004, 2006 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: generic assocs help http io io.styles io.files continuations
 io.streams.string kernel math math.order math.parser namespaces
 quotations assocs sequences strings words html.elements
-xml.entities sbufs continuations destructors ;
+xml.entities sbufs continuations destructors accessors ;
 IN: html.streams
 
 GENERIC: browser-link-href ( presented -- href )
 
 M: object browser-link-href drop f ;
 
-TUPLE: html-stream last-div? ;
+TUPLE: html-stream stream last-div ;
 
-! A hack: stream-nl after with-nesting or tabular-output is
-! ignored, so that HTML stream output looks like UI pane output
-: test-last-div? ( stream -- ? )
-    dup html-stream-last-div?
-    f rot set-html-stream-last-div? ;
+! stream-nl after with-nesting or tabular-output is
+! ignored, so that HTML stream output looks like
+! UI pane output
+: last-div? ( stream -- ? )
+    [ f ] change-last-div drop ;
 
 : not-a-div ( stream -- stream )
-    dup test-last-div? drop ; inline
+    f >>last-div ; inline
 
 : a-div ( stream -- straem )
-    t over set-html-stream-last-div? ; inline
+    t >>last-div ; inline
 
 : <html-stream> ( stream -- stream )
-    html-stream construct-delegate ;
+    f html-stream boa ;
 
 <PRIVATE
 
-TUPLE: html-sub-stream style stream ;
+TUPLE: html-sub-stream < html-stream style parent ;
 
-: (html-sub-stream) ( style stream -- stream )
-    html-sub-stream boa
-    512 <sbuf> <html-stream> over set-delegate ;
-
-: <html-sub-stream> ( style stream class -- stream )
-    >r (html-sub-stream) r> construct-delegate ; inline
+: new-html-sub-stream ( style stream class -- stream )
+    new
+        512 <sbuf> >>stream
+        swap >>parent
+        swap >>style ; inline
 
 : end-sub-stream ( substream -- string style stream )
-    dup delegate >string
-    over html-sub-stream-style
-    rot html-sub-stream-stream ;
-
-: delegate-write ( string -- )
-    output-stream get delegate stream-write ;
+    [ stream>> >string ] [ style>> ] [ parent>> ] tri ;
 
 : object-link-tag ( style quot -- )
     presented pick at [
@@ -99,11 +93,11 @@ TUPLE: html-sub-stream style stream ;
     ] if ; inline
 
 : format-html-span ( string style stream -- )
-    [
-        [ [ drop delegate-write ] span-tag ] object-link-tag
+    stream>> [
+        [ [ drop write ] span-tag ] object-link-tag
     ] with-output-stream* ;
 
-TUPLE: html-span-stream ;
+TUPLE: html-span-stream < html-sub-stream ;
 
 M: html-span-stream dispose
     end-sub-stream not-a-div format-html-span ;
@@ -132,11 +126,11 @@ M: html-span-stream dispose
     ] if ; inline
 
 : format-html-div ( string style stream -- )
-    [
-        [ [ delegate-write ] div-tag ] object-link-tag
+    stream>> [
+        [ [ write ] div-tag ] object-link-tag
     ] with-output-stream* ;
 
-TUPLE: html-block-stream ;
+TUPLE: html-block-stream < html-sub-stream ;
 
 M: html-block-stream dispose ( quot style stream -- )
     end-sub-stream a-div format-html-div ;
@@ -159,38 +153,43 @@ M: html-block-stream dispose ( quot style stream -- )
 PRIVATE>
 
 ! Stream protocol
-M: html-stream stream-write1 ( char stream -- )
+M: html-stream stream-flush
+    stream>> stream-flush ;
+
+M: html-stream stream-write1
     >r 1string r> stream-write ;
 
-M: html-stream stream-write ( str stream -- )
-    not-a-div >r escape-string r> delegate stream-write ;
+M: html-stream stream-write
+    not-a-div >r escape-string r> stream>> stream-write ;
 
-M: html-stream make-span-stream ( style stream -- stream' )
-    html-span-stream <html-sub-stream> ;
-
-M: html-stream stream-format ( str style stream -- )
+M: html-stream stream-format
     >r html over at [ >r escape-string r> ] unless r>
     format-html-span ;
 
-M: html-stream make-block-stream ( style stream -- stream' )
-    html-block-stream <html-sub-stream> ;
+M: html-stream stream-nl
+    dup last-div? [ drop ] [ [ <br/> ] with-output-stream* ] if ;
 
-M: html-stream stream-write-table ( grid style stream -- )
-    a-div [
+M: html-stream make-span-stream
+    html-span-stream new-html-sub-stream ;
+
+M: html-stream make-block-stream
+    html-block-stream new-html-sub-stream ;
+
+M: html-stream 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>
-                    >string write-html
+                    stream>> >string write
                 </td>
             ] with each </tr>
         ] with each </table>
     ] with-output-stream* ;
 
-M: html-stream make-cell-stream ( style stream -- stream' )
-    (html-sub-stream) ;
-
-M: html-stream stream-nl ( stream -- )
-    dup test-last-div? [ drop ] [ [ <br/> ] with-output-stream* ] if ;
+M: html-stream dispose stream>> dispose ;
 
 : with-html-stream ( quot -- )
     output-stream get <html-stream> swap with-output-stream* ; inline

From 53857fdfee998019c90d8d8b1d126f2a0db17cc8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 22:32:39 -0500
Subject: [PATCH 11/39] Move farkup, code, inspector components to
 html.components

---
 extra/html/components/components-tests.factor | 27 +++++++++++++++++--
 extra/html/components/components.factor       | 23 +++++++++++++++-
 2 files changed, 47 insertions(+), 3 deletions(-)

diff --git a/extra/html/components/components-tests.factor b/extra/html/components/components-tests.factor
index 0bd5410a3b..d09f8b6b42 100644
--- a/extra/html/components/components-tests.factor
+++ b/extra/html/components/components-tests.factor
@@ -1,6 +1,7 @@
 IN: html.components.tests
-USING: html.components tools.test kernel io.streams.string
-io.streams.null accessors ;
+USING: tools.test kernel io.streams.string
+io.streams.null accessors inspector html.streams
+html.components ;
 
 [ ] [ blank-values ] unit-test
 
@@ -145,3 +146,25 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
 [ "<html>arbitrary <b>markup</b> for the win!</html>" ] [
     [ "html" html render ] with-string-writer
 ] unit-test
+
+[ ] [ "int x = 4;" "code" set-value ] unit-test
+
+[ ] [ "java" "mode" set-value ] unit-test
+
+[ "<span class='KEYWORD3'>int</span> x <span class='OPERATOR'>=</span> <span class='DIGIT'>4</span>;\n" ] [
+    [ "code" <code> "mode" >>mode render ] with-string-writer
+] unit-test
+
+[ ] [ "-foo\n-bar" "farkup" set-value ] unit-test
+
+[ "<ul><li>foo</li><li>bar</li></ul>" ] [
+    [ "farkup" farkup render ] with-string-writer
+] unit-test
+
+[ ] [ { 1 2 3 } "object" set-value ] unit-test
+
+[ t ] [
+    [ "object" inspector render ] with-string-writer
+    [ "object" value [ describe ] with-html-stream ] with-string-writer
+    =
+] unit-test
diff --git a/extra/html/components/components.factor b/extra/html/components/components.factor
index df1d1faa72..9c762eaa3a 100644
--- a/extra/html/components/components.factor
+++ b/extra/html/components/components.factor
@@ -4,7 +4,7 @@ USING: accessors kernel namespaces io math.parser assocs classes
 classes.tuple words arrays sequences splitting mirrors
 hashtables combinators continuations math strings
 fry locals calendar calendar.format xml.entities validators
-html.elements ;
+html.elements html.streams xmode.code2html farkup inspector ;
 IN: html.components
 
 SYMBOL: values
@@ -144,6 +144,27 @@ M: link render*
         link-title object>string escape-string write
     </a> ;
 
+! XMode code component
+TUPLE: code mode ;
+
+: <code> ( -- code )
+    code new ;
+
+M: code render*
+    [ string-lines ] [ drop ] [ mode>> value ] tri* htmlize-lines ;
+
+! Farkup component
+SINGLETON: farkup
+
+M: farkup render*
+    2drop string-lines "\n" join convert-farkup write ;
+
+! Inspector component
+SINGLETON: inspector
+
+M: inspector render*
+    2drop [ describe ] with-html-stream ;
+
 ! HTML component
 SINGLETON: html
 

From 6a1f38581692af69731eeefd7f4be570f0a94364 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 May 2008 22:37:55 -0500
Subject: [PATCH 12/39] Add failing unit test

---
 extra/locals/locals-tests.factor | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/extra/locals/locals-tests.factor b/extra/locals/locals-tests.factor
index c5adaa5e5e..87bc49f366 100755
--- a/extra/locals/locals-tests.factor
+++ b/extra/locals/locals-tests.factor
@@ -254,3 +254,14 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
 [ 3 ] [ 1 [let | a [ ] | 3 ] ] unit-test
 
 [ ] [ 1 2 [let | a [ ] b [ ] | ] ] unit-test
+
+:: a-word-with-locals ( a b -- ) ;
+
+: new-definition "IN: locals.tests\nUSING: math ;\n: a-word-with-locals ( -- x ) 2 3 + ;\n" ;
+
+[ ] [ new-definition eval ] unit-test
+
+[ t ] [
+    [ \ a-word-with-locals see ] with-string-writer
+    new-definition =
+] unit-test

From 9100398adfb1343506a4762dc7ec993d3c4e4e75 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 24 May 2008 01:28:48 -0500
Subject: [PATCH 13/39] Add more chloe tags, and tests

---
 extra/html/components/components.factor       | 13 ++++---
 extra/html/templates/chloe/chloe-tests.factor | 38 ++++++++++++++++++-
 extra/html/templates/chloe/chloe.factor       | 16 +++++---
 extra/html/templates/chloe/test/test8.xml     | 27 +++++++++++++
 4 files changed, 83 insertions(+), 11 deletions(-)
 create mode 100644 extra/html/templates/chloe/test/test8.xml

diff --git a/extra/html/components/components.factor b/extra/html/components/components.factor
index 9c762eaa3a..faef9ca1b5 100644
--- a/extra/html/components/components.factor
+++ b/extra/html/components/components.factor
@@ -15,6 +15,9 @@ SYMBOL: values
 
 : blank-values H{ } clone values set ;
 
+: prepare-value ( name object -- value name object )
+    [ [ value ] keep ] dip ; inline
+
 : from-tuple <mirror> values set ;
 
 : values-tuple values get object>> ;
@@ -35,7 +38,7 @@ GENERIC: render* ( value name render -- )
         [ -rot render* ] dip
         render-error
     ] [
-        [ [ value ] keep ] dip render*
+        prepare-value render*
     ] if* ;
 
 <PRIVATE
@@ -56,7 +59,7 @@ M: hidden render* drop "hidden" render-input ;
 : render-field ( value name size type -- )
     <input
         =type
-        [ number>string =size ] when*
+        [ object>string =size ] when*
         =name
         object>string =value
     input/> ;
@@ -85,8 +88,8 @@ TUPLE: textarea rows cols ;
 
 M: textarea render*
     <textarea
-        [ rows>> [ number>string =rows ] when* ]
-        [ cols>> [ number>string =cols ] when* ] bi
+        [ rows>> [ object>string =rows ] when* ]
+        [ cols>> [ object>string =cols ] when* ] bi
         =name
     textarea>
         object>string escape-string write
@@ -109,7 +112,7 @@ TUPLE: choice size multiple choices ;
 M: choice render*
     <select
         swap =name
-        dup size>> [ number>string =size ] when*
+        dup size>> [ object>string =size ] when*
         dup multiple>> [ "true" =multiple ] when
     select>
         [ choices>> value ] [ multiple>> ] bi
diff --git a/extra/html/templates/chloe/chloe-tests.factor b/extra/html/templates/chloe/chloe-tests.factor
index 3c52153eee..4d8d15c581 100644
--- a/extra/html/templates/chloe/chloe-tests.factor
+++ b/extra/html/templates/chloe/chloe-tests.factor
@@ -1,6 +1,6 @@
 USING: html.templates html.templates.chloe
 tools.test io.streams.string kernel sequences ascii boxes
-namespaces xml
+namespaces xml html.components
 splitting ;
 IN: html.templates.chloe.tests
 
@@ -87,3 +87,39 @@ SYMBOL: test7-aux?
         "test7" test-template call-template
     ] run-template
 ] unit-test
+
+[ ] [ blank-values ] unit-test
+
+[ ] [ "A label" "label" set-value ] unit-test
+
+SINGLETON: link-test
+
+M: link-test link-title drop "<Link Title>" ;
+
+M: link-test link-href drop "http://www.apple.com/foo&bar" ;
+
+[ ] [ link-test "link" set-value ] unit-test
+
+[ ] [ "int x = 5;" "code" set-value ] unit-test
+
+[ ] [ "c" "mode" set-value ] unit-test
+
+[ ] [ { 1 2 3 } "inspector" set-value ] unit-test
+
+[ ] [ "<p>a paragraph</p>" "html" set-value ] unit-test
+
+[ ] [ "sheeple" "field" set-value ] unit-test
+
+[ ] [ "a password" "password" set-value ] unit-test
+
+[ ] [ "a\nb\nc" "textarea" set-value ] unit-test
+
+[ ] [ "new york" "choice" set-value ] unit-test
+
+[ ] [ { "new york" "detroit" "minneapolis" } "choices" set-value ] unit-test
+    
+[ ] [
+    [
+        "test8" test-template call-template
+    ] run-template drop
+] unit-test
diff --git a/extra/html/templates/chloe/chloe.factor b/extra/html/templates/chloe/chloe.factor
index a01d424eb9..43834f896e 100644
--- a/extra/html/templates/chloe/chloe.factor
+++ b/extra/html/templates/chloe/chloe.factor
@@ -7,14 +7,13 @@ unicode.case tuple-syntax mirrors fry
 multiline xml xml.data xml.writer xml.utilities
 html.elements
 html.components
+html.templates
 http.server
 http.server.auth
 http.server.flows
 http.server.actions
-http.server.sessions
-http.server.templating
-http.server.boilerplate ;
-IN: http.server.templating.chloe
+http.server.sessions ;
+IN: html.templates.chloe
 
 ! Chloe is Ed's favorite web designer
 
@@ -207,7 +206,11 @@ STRING: button-tag-markup
     [ "name" required-attr ] dip render ;
 
 : attrs>slots ( tag tuple -- )
-    [ attrs>> ] [ <mirror> ] bi* '[ swap tag>> , set-at ] assoc-each ;
+    [ attrs>> ] [ <mirror> ] bi*
+    '[
+        swap tag>> dup "name" =
+        [ 2drop ] [ , set-at ] if
+    ] assoc-each ;
 
 : tuple-component-tag ( tag class -- )
     [ drop "name" required-attr ]
@@ -233,6 +236,9 @@ STRING: button-tag-markup
         ! Components
         { "label" [ label singleton-component-tag ] }
         { "link" [ link singleton-component-tag ] }
+        { "code" [ code tuple-component-tag ] }
+        { "farkup" [ farkup singleton-component-tag ] }
+        { "inspector" [ inspector singleton-component-tag ] }
         { "html" [ html singleton-component-tag ] }
 
         ! Forms
diff --git a/extra/html/templates/chloe/test/test8.xml b/extra/html/templates/chloe/test/test8.xml
new file mode 100644
index 0000000000..8e2ff2e8ad
--- /dev/null
+++ b/extra/html/templates/chloe/test/test8.xml
@@ -0,0 +1,27 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:label t:name="label" />
+
+	<t:link t:name="link" />
+
+	<t:code t:name="code" mode="mode" />
+
+	<t:farkup t:name="farkup" />
+
+	<t:inspector t:name="inspector" />
+
+	<t:html t:name="html" />
+
+	<t:field t:name="field" t:size="13" />
+
+	<t:password t:name="password" t:size="10" />
+
+	<t:textarea t:name="textarea" t:rows="5" t:cols="10" />
+
+	<t:choice t:name="choice" t:choices="choices" />
+
+	<t:checkbox t:name="checkbox">Checkbox</t:checkbox>
+
+</t:chloe>

From 3104cdb511537f6ba1f37925534520b6c6a0d92b Mon Sep 17 00:00:00 2001
From: Matthew Willis <matthew.willis@mac.com>
Date: Sat, 17 May 2008 17:07:40 -0700
Subject: [PATCH 14/39] Changed the unicode cairo sample to use actual unicode
 instead of a byte array.

---
 extra/cairo/samples/samples.factor | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/extra/cairo/samples/samples.factor b/extra/cairo/samples/samples.factor
index 402c3881f4..0805cd41c1 100644
--- a/extra/cairo/samples/samples.factor
+++ b/extra/cairo/samples/samples.factor
@@ -116,11 +116,11 @@ IN: cairo.samples
     cr cairo_fill ;
 
 : utf8 ( -- )
-    cr "Serif" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL
-    cairo_select_font_face
+    ! cr "kochi" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL
+    ! cairo_select_font_face
     cr 50 cairo_set_font_size
     "cairo_text_extents_t" malloc-object
-    cr B{ 230 151 165 230 156 172 232 170 158 } pick cairo_text_extents
+    cr "日本語" pick cairo_text_extents
     cr over
     [ cairo_text_extents_t-width 2 / ]
     [ cairo_text_extents_t-x_bearing ] bi +
@@ -129,7 +129,7 @@ IN: cairo.samples
     [ cairo_text_extents_t-y_bearing ] bi +
     128 swap - cairo_move_to
     free
-    cr B{ 230 151 165 230 156 172 232 170 158 } cairo_show_text
+    cr "日本語" cairo_show_text
     
     cr 1 0.2 0.2 0.6 cairo_set_source_rgba
     cr 6 cairo_set_line_width

From 06843caee91a4c9ee0a0d068e9fe024199c47d66 Mon Sep 17 00:00:00 2001
From: Matthew Willis <matthew.willis@mac.com>
Date: Sun, 18 May 2008 01:59:11 -0700
Subject: [PATCH 15/39] Fixed mistake introduced in the last patch.

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

diff --git a/extra/cairo/samples/samples.factor b/extra/cairo/samples/samples.factor
index 0805cd41c1..3cc63922f8 100644
--- a/extra/cairo/samples/samples.factor
+++ b/extra/cairo/samples/samples.factor
@@ -116,8 +116,8 @@ IN: cairo.samples
     cr cairo_fill ;
 
 : utf8 ( -- )
-    ! cr "kochi" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL
-    ! cairo_select_font_face
+    cr "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL
+    cairo_select_font_face
     cr 50 cairo_set_font_size
     "cairo_text_extents_t" malloc-object
     cr "日本語" pick cairo_text_extents

From c64de056fbd9f7f060b17ffacb56755cbfe6dd47 Mon Sep 17 00:00:00 2001
From: Matthew Willis <matthew.willis@mac.com>
Date: Sat, 24 May 2008 12:06:59 -0700
Subject: [PATCH 16/39] First crack at pango.  Try "cairo.pango.gadgets" run

---
 extra/cairo/pango/gadgets/gadgets.factor |  20 +++
 extra/cairo/pango/pango.factor           | 175 +++++++++++++++++++++++
 2 files changed, 195 insertions(+)
 create mode 100644 extra/cairo/pango/gadgets/gadgets.factor
 create mode 100644 extra/cairo/pango/pango.factor

diff --git a/extra/cairo/pango/gadgets/gadgets.factor b/extra/cairo/pango/gadgets/gadgets.factor
new file mode 100644
index 0000000000..780881e872
--- /dev/null
+++ b/extra/cairo/pango/gadgets/gadgets.factor
@@ -0,0 +1,20 @@
+USING: cairo.pango cairo cairo.ffi cairo.gadgets
+alien.c-types kernel math ;
+IN: cairo.pango.gadgets
+
+: (pango-gadget) ( setup show -- gadget )
+    [ drop layout-size ]
+    [ compose [ with-pango ] curry <cached-cairo> ] 2bi ;
+
+: <pango-gadget> ( quot -- gadget )
+    [ cr layout pango_cairo_show_layout ] (pango-gadget) ;
+
+USING: prettyprint sequences ui.gadgets.panes ;
+: hello-pango ( -- )
+    50 [ 6 + ] map [
+        "Sans Bold " swap unparse append
+        [ layout-font "Hello, Pango!" layout-text ] curry
+        <pango-gadget> gadget.
+    ] each ;
+
+MAIN: hello-pango
diff --git a/extra/cairo/pango/pango.factor b/extra/cairo/pango/pango.factor
new file mode 100644
index 0000000000..789044f6e1
--- /dev/null
+++ b/extra/cairo/pango/pango.factor
@@ -0,0 +1,175 @@
+! Copyright (C) 2008 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+!
+! pangocairo bindings, from pango/pangocairo.h
+
+USING: cairo.ffi alien.c-types math
+alien.syntax system combinators alien ;
+IN: cairo.pango
+
+<< "pangocairo" {
+!    { [ os winnt? ] [ "libpangocairo-1.dll" ] }
+!    { [ os macosx? ] [ "libpangocairo.dylib" ] }
+    { [ os unix? ] [ "libpangocairo-1.0.so" ] }
+} cond "cdecl" add-library >>
+
+LIBRARY: pangocairo
+
+TYPEDEF: void* PangoCairoFont
+TYPEDEF: void* PangoCairoFontMap
+TYPEDEF: void* PangoFontMap
+
+FUNCTION: PangoFontMap*
+pango_cairo_font_map_new  ( ) ;
+
+FUNCTION: PangoFontMap*
+pango_cairo_font_map_new_for_font_type ( cairo_font_type_t fonttype ) ;
+
+FUNCTION: PangoFontMap*
+pango_cairo_font_map_get_default ( ) ;
+
+FUNCTION: cairo_font_type_t
+pango_cairo_font_map_get_font_type ( PangoCairoFontMap* fontmap ) ;
+
+FUNCTION: void
+pango_cairo_font_map_set_resolution ( PangoCairoFontMap* fontmap, double dpi ) ;
+
+FUNCTION: double
+pango_cairo_font_map_get_resolution ( PangoCairoFontMap* fontmap ) ;
+
+FUNCTION: PangoContext*
+pango_cairo_font_map_create_context ( PangoCairoFontMap* fontmap ) ;
+
+FUNCTION: cairo_scaled_font_t*
+pango_cairo_font_get_scaled_font ( PangoCairoFont* font ) ;
+
+! Update a Pango context for the current state of a cairo context
+FUNCTION: void
+pango_cairo_update_context ( cairo_t* cr, PangoContext* context ) ;
+
+FUNCTION: void
+pango_cairo_context_set_font_options ( PangoContext* context, cairo_font_options_t* options ) ;
+
+FUNCTION: cairo_font_options_t*
+pango_cairo_context_get_font_options ( PangoContext* context ) ;
+
+FUNCTION: void
+pango_cairo_context_set_resolution ( PangoContext* context, double dpi ) ;
+
+FUNCTION: double
+pango_cairo_context_get_resolution ( PangoContext* context ) ;
+
+! Convenience
+FUNCTION: PangoLayout*
+pango_cairo_create_layout ( cairo_t* cr ) ;
+
+FUNCTION: void
+pango_cairo_update_layout ( cairo_t* cr, PangoLayout* layout ) ;
+
+! Rendering
+FUNCTION: void
+pango_cairo_show_glyph_string ( cairo_t* cr, PangoFont* font, PangoGlyphString* glyphs ) ;
+
+FUNCTION: void
+pango_cairo_show_layout_line ( cairo_t* cr, PangoLayoutLine* line ) ;
+
+FUNCTION: void
+pango_cairo_show_layout ( cairo_t* cr, PangoLayout* layout ) ;
+
+FUNCTION: void
+pango_cairo_show_error_underline ( cairo_t* cr, double x, double y, double width, double height ) ;
+
+! Rendering to a path
+FUNCTION: void
+pango_cairo_glyph_string_path ( cairo_t* cr, PangoFont* font, PangoGlyphString* glyphs ) ;
+
+FUNCTION: void
+pango_cairo_layout_line_path  ( cairo_t* cr, PangoLayoutLine* line ) ;
+
+FUNCTION: void
+pango_cairo_layout_path ( cairo_t* cr, PangoLayout* layout ) ;
+
+FUNCTION: void
+pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Helpful functions from other parts of pango
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: PANGO_SCALE 1024 ;
+
+FUNCTION: void
+pango_layout_set_text ( PangoLayout* layout, char* text, int length ) ;
+
+FUNCTION: char*
+pango_layout_get_text ( PangoLayout* layout ) ;
+
+FUNCTION: void
+pango_layout_get_size ( PangoLayout* layout, int* width, int* height ) ;
+
+TYPEDEF: void* PangoFontDescription
+
+FUNCTION: PangoFontDescription*
+pango_font_description_from_string ( char* str ) ;
+
+FUNCTION: char*
+pango_font_description_to_string ( PangoFontDescription* desc ) ;
+
+FUNCTION: char*
+pango_font_description_to_filename ( PangoFontDescription* desc ) ;
+
+FUNCTION: void
+pango_layout_set_font_description ( PangoLayout* layout, PangoFontDescription* desc ) ;
+
+FUNCTION: PangoFontDescription*
+pango_layout_get_font_description ( PangoLayout* layout ) ;
+
+FUNCTION: void
+pango_layout_get_pixel_size ( PangoLayout* layout, int* width, int* height ) ;
+
+FUNCTION: void
+pango_font_description_free ( PangoFontDescription* desc ) ;
+
+TYPEDEF: void* gpointer
+
+FUNCTION: void
+g_object_unref ( gpointer object ) ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Higher level words and combinators
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USING: destructors accessors namespaces kernel cairo ;
+
+TUPLE: pango-layout alien ;
+C: <pango-layout> pango-layout
+M: pango-layout dispose ( alien -- ) alien>> g_object_unref ;
+
+: layout ( -- pango-layout ) pango-layout get ;
+
+: (with-pango) ( layout quot -- )
+    >r alien>> pango-layout r> with-variable ; inline
+
+: with-pango ( quot -- )
+    cr pango_cairo_create_layout <pango-layout> swap
+    [ (with-pango) ] curry with-disposal ; inline
+
+: pango-layout-get-pixel-size ( layout -- width height )
+    0 <int> 0 <int> [ pango_layout_get_pixel_size ] 2keep
+    [ *int ] bi@ ;
+
+: dummy-pango ( quot -- )
+    >r CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
+    r> [ with-pango ] curry with-cairo-from-surface ; inline
+
+: layout-size ( quot -- width height )
+    [ layout pango-layout-get-pixel-size ] compose dummy-pango ; inline
+
+: layout-font ( str -- )
+    pango_font_description_from_string
+    dup zero? [ "pango: not a valid font." throw ] when
+    layout over pango_layout_set_font_description
+    pango_font_description_free ;
+
+: layout-text ( str -- )
+    layout swap -1 pango_layout_set_text ;

From dc1a423f88025e46ded88abe1db54f47e1786e87 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 24 May 2008 21:49:48 -0500
Subject: [PATCH 17/39] Document clumps

---
 core/sequences/sequences.factor               |   2 +-
 core/splitting/splitting-docs.factor          |  82 ++++++--
 core/splitting/splitting.factor               |   4 +-
 extra/http/server/auth/admin/admin.factor     | 179 ------------------
 extra/http/server/auth/admin/user-list.xml    |   9 -
 extra/http/server/auth/admin/user-summary.xml |   9 -
 extra/webapps/pastebin/paste-list.xml         |  15 --
 extra/webapps/pastebin/pastebin-common.xml    |  31 +++
 extra/webapps/pastebin/pastebin.xml           |  35 ++--
 .../user-admin}/edit-user.xml                 |   0
 .../admin => webapps/user-admin}/new-user.xml |   0
 extra/webapps/user-admin/user-admin.factor    | 160 ++++++++++++++++
 .../user-admin/user-admin.xml}                |   0
 extra/webapps/user-admin/user-list.xml        |  13 ++
 14 files changed, 289 insertions(+), 250 deletions(-)
 delete mode 100644 extra/http/server/auth/admin/admin.factor
 delete mode 100644 extra/http/server/auth/admin/user-list.xml
 delete mode 100644 extra/http/server/auth/admin/user-summary.xml
 delete mode 100644 extra/webapps/pastebin/paste-list.xml
 create mode 100644 extra/webapps/pastebin/pastebin-common.xml
 rename extra/{http/server/auth/admin => webapps/user-admin}/edit-user.xml (100%)
 rename extra/{http/server/auth/admin => webapps/user-admin}/new-user.xml (100%)
 create mode 100644 extra/webapps/user-admin/user-admin.factor
 rename extra/{http/server/auth/admin/admin.xml => webapps/user-admin/user-admin.xml} (100%)
 create mode 100644 extra/webapps/user-admin/user-list.xml

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index cbddfa7d28..4153430514 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -680,7 +680,7 @@ PRIVATE>
 : unclip ( seq -- rest first )
     [ rest ] [ first ] bi ;
 
-: unclip-last ( seq -- butfirst last )
+: unclip-last ( seq -- butlast last )
     [ but-last ] [ peek ] bi ;
 
 : unclip-slice ( seq -- rest first )
diff --git a/core/splitting/splitting-docs.factor b/core/splitting/splitting-docs.factor
index 5000dbf5fd..1beafc710a 100644
--- a/core/splitting/splitting-docs.factor
+++ b/core/splitting/splitting-docs.factor
@@ -1,6 +1,25 @@
 USING: help.markup help.syntax sequences strings ;
 IN: splitting
 
+ARTICLE: "groups-clumps" "Groups and clumps"
+"A virtual sequence for splitting a sequence into disjoint, fixed-length subsequences:"
+{ $subsection groups }
+{ $subsection <groups> }
+{ $subsection <sliced-groups> }
+"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
+{ $subsection clumps }
+{ $subsection <clumps> }
+{ $subsection <sliced-clumps> }
+"The difference can be summarized as the following:"
+{ $list
+    { "With groups, the subsequences form the original sequence when concatenated:"
+        { $unchecked-example "dup n groups concat sequence= ." "t" }
+    }
+    { "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:"
+        { $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" }
+    }
+} ;
+
 ARTICLE: "sequences-split" "Splitting sequences"
 "Splitting sequences at occurrences of subsequences:"
 { $subsection ?head }
@@ -9,14 +28,9 @@ ARTICLE: "sequences-split" "Splitting sequences"
 { $subsection ?tail-slice }
 { $subsection split1 }
 { $subsection split }
-"Grouping elements:"
-{ $subsection group }
-"A virtual sequence for grouping elements:"
-{ $subsection groups }
-{ $subsection <groups> }
-{ $subsection <sliced-groups> }
 "Splitting a string into lines:"
-{ $subsection string-lines } ;
+{ $subsection string-lines }
+{ $subsection "groups-clumps" } ;
 
 ABOUT: "sequences-split"
 
@@ -36,19 +50,22 @@ HELP: split
 { $examples { $example "USING: prettyprint splitting ;" "\"hello world-how are you?\" \" -\" split ." "{ \"hello\" \"world\" \"how\" \"are\" \"you?\" }" } } ;
 
 HELP: groups
-{ $class-description "Instances are virtual sequences whose elements are fixed-length subsequences or slices of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
+{ $class-description "Instances are virtual sequences whose elements are disjoint fixed-length subsequences of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
 $nl
 "New groups are created by calling " { $link <groups> } " and " { $link <sliced-groups> } "." }
 { $see-also group } ;
 
 HELP: group
 { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
-{ $description "Splits the sequence into groups of " { $snippet "n" } " elements and collects the groups into a new array." }
-{ $notes "If the sequence length is not a multiple of " { $snippet "n" } ", the final subsequence in the list will be shorter than " { $snippet "n" } " elements." } ;
+{ $description "Splits the sequence into disjoint groups of " { $snippet "n" } " elements and collects the groups into a new array." }
+{ $notes "If the sequence length is not a multiple of " { $snippet "n" } ", the final subsequence in the list will be shorter than " { $snippet "n" } " elements." }
+{ $examples
+    { $example "USING: splitting prettyprint ;" "{ 3 1 3 3 7 } 2 group ." "{ { 3 1 } { 3 3 } { 7 } }" }
+} ;
 
 HELP: <groups>
 { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
-{ $description "Outputs a virtual sequence whose elements are subsequences consisting of groups of " { $snippet "n" } " elements from the underlying sequence." }
+{ $description "Outputs a virtual sequence whose elements are disjoint subsequences of " { $snippet "n" } " elements from the underlying sequence." }
 { $examples
     { $example
         "USING: arrays kernel prettyprint sequences splitting ;"
@@ -58,7 +75,7 @@ HELP: <groups>
 
 HELP: <sliced-groups>
 { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
-{ $description "Outputs a virtual sequence whose elements are slices consisting of groups of " { $snippet "n" } " elements from the underlying sequence." }
+{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
 { $examples
     { $example
         "USING: arrays kernel prettyprint sequences splitting ;"
@@ -68,7 +85,46 @@ HELP: <sliced-groups>
     }
 } ;
 
-{ group <groups> <sliced-groups> } related-words
+HELP: clumps
+{ $class-description "Instances are virtual sequences whose elements are overlapping fixed-length subsequences o an underlying sequence. Clumps are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
+$nl
+"New clumps are created by calling " { $link <clumps> } " and " { $link <sliced-clumps> } "." } ;
+
+HELP: clump
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
+{ $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements and collects the clumps into a new array." }
+{ $errors "Throws an error if " { $snippet "n" } " is smaller than the length of the sequence." }
+{ $examples
+    { $example "USING: splitting prettyprint ;" "{ 3 1 3 3 7 } 2 clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } }" }
+} ;
+
+HELP: <clumps>
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
+{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
+{ $examples
+    "Running averages:"
+    { $example
+        "USING: splitting sequences math prettyprint kernel ;"
+        "IN: scratchpad"
+        ": share-price"
+        "    { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;"
+        ""
+        "share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."
+        "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }"
+    }
+} ;
+
+HELP: <sliced-clumps>
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
+{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } ;
+
+{ clumps groups } related-words
+
+{ clump group } related-words
+
+{ <clumps> <groups> } related-words
+
+{ <sliced-clumps> <sliced-groups> } related-words
 
 HELP: ?head
 { $values { "seq" "a sequence" } { "begin" "a sequence" } { "newseq" "a new sequence" } { "?" "a boolean" } }
diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor
index 9f6ae75d32..62e7ef3782 100755
--- a/core/splitting/splitting.factor
+++ b/core/splitting/splitting.factor
@@ -44,7 +44,7 @@ M: sliced-groups nth group@ <slice> ;
 
 TUPLE: clumps < abstract-groups ;
 
-: <clumps> ( seq n -- groups )
+: <clumps> ( seq n -- clumps )
     clumps construct-groups ; inline
 
 M: clumps length
@@ -58,7 +58,7 @@ M: clumps group@
 
 TUPLE: sliced-clumps < groups ;
 
-: <sliced-clumps> ( seq n -- groups )
+: <sliced-clumps> ( seq n -- clumps )
     sliced-clumps construct-groups ; inline
 
 M: sliced-clumps nth group@ <slice> ;
diff --git a/extra/http/server/auth/admin/admin.factor b/extra/http/server/auth/admin/admin.factor
deleted file mode 100644
index 21e1a6181b..0000000000
--- a/extra/http/server/auth/admin/admin.factor
+++ /dev/null
@@ -1,179 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences accessors namespaces combinators words
-assocs locals db.tuples arrays splitting strings qualified
-
-http.server.templating.chloe
-http.server.boilerplate
-http.server.auth.providers
-http.server.auth.providers.db
-http.server.auth.login
-http.server.auth
-http.server.forms
-http.server.components.inspector
-http.server.validators
-http.server.sessions
-http.server.actions
-http.server.crud
-http.server ;
-EXCLUDE: http.server.components => string? number? ;
-IN: http.server.auth.admin
-
-: admin-template ( name -- template )
-    "resource:extra/http/server/auth/admin/" swap ".xml" 3append <chloe> ;
-
-: words>strings ( seq -- seq' )
-    [ [ word-vocabulary ] [ drop ":" ] [ word-name ] tri 3append ] map ;
-
-: strings>words ( seq -- seq' )
-    [ ":" split1 swap lookup ] map ;
-
-: <capabilities> ( id -- component )
-    capabilities get words>strings <menu> ;
-
-: <new-user-form> ( -- form )
-    "user" <form>
-        "new-user" admin-template >>edit-template
-        "username" <string> add-field
-        "realname" <string> add-field
-        "new-password" <password> t >>required add-field
-        "verify-password" <password> t >>required add-field
-        "email" <email> add-field
-        "capabilities" <capabilities> add-field ;
-
-: <edit-user-form> ( -- form )
-    "user" <form>
-        "edit-user" admin-template >>edit-template
-        "user-summary" admin-template >>summary-template
-        "username" <string> hidden >>renderer add-field
-        "realname" <string> add-field
-        "new-password" <password> add-field
-        "verify-password" <password> add-field
-        "email" <email> add-field
-        "profile" <inspector> add-field
-        "capabilities" <capabilities> add-field ;
-
-: <user-list-form> ( -- form )
-    "user-list" <form>
-        "user-list" admin-template >>view-template
-        "list" <edit-user-form> +unordered+ <list> add-field ;
-
-:: <new-user-action> ( form ctor next -- action )
-    <action>
-        [
-            blank-values
-
-            "username" get ctor call
-
-            {
-                [ username>> "username" set-value ]
-                [ realname>> "realname" set-value ]
-                [ email>> "email" set-value ]
-                [ profile>> "profile" set-value ]
-            } cleave
-        ] >>init
-
-        [ form edit-form ] >>display
-
-        [
-            blank-values
-
-            form validate-form
-
-            same-password-twice
-
-            user new "username" value >>username select-tuple
-            [ user-exists ] when
-
-            "username" value <user>
-                "realname" value >>realname
-                "email" value >>email
-                "new-password" value >>encoded-password
-                H{ } clone >>profile
-
-            insert-tuple
-
-            next f <standard-redirect>
-        ] >>submit ;
-    
-:: <edit-user-action> ( form ctor next -- action )
-    <action>
-        { { "username" [ v-required ] } } >>get-params
-
-        [
-            blank-values
-
-            "username" get ctor call select-tuple
-
-            {
-                [ username>> "username" set-value ]
-                [ realname>> "realname" set-value ]
-                [ email>> "email" set-value ]
-                [ profile>> "profile" set-value ]
-                [ capabilities>> words>strings "capabilities" set-value ]
-            } cleave
-        ] >>init
-
-        [ form edit-form ] >>display
-
-        [
-            blank-values
-
-            form validate-form
-
-            "username" value <user> select-tuple
-                "realname" value >>realname
-                "email" value >>email
-
-            { "new-password" "verify-password" }
-            [ value empty? ] all? [
-                same-password-twice
-                "new-password" value >>encoded-password
-            ] unless
-
-            "capabilities" value {
-                { [ dup string? ] [ 1array ] }
-                { [ dup array? ] [ ] }
-            } cond strings>words >>capabilities
-
-            update-tuple
-
-            next f <standard-redirect>
-        ] >>submit ;
-
-:: <delete-user-action> ( ctor next -- action )
-    <action>
-        { { "username" [ ] } } >>post-params
-
-        [
-            "username" get
-            [ <user> select-tuple 1 >>deleted update-tuple ]
-            [ logout-all-sessions ]
-            bi
-
-            next f <standard-redirect>
-        ] >>submit ;
-
-TUPLE: user-admin < dispatcher ;
-
-SYMBOL: can-administer-users?
-
-can-administer-users? define-capability
-
-:: <user-admin> ( -- responder )
-    [let | ctor [ [ <user> ] ] |
-        user-admin new-dispatcher
-            <user-list-form> ctor <list-action> "" add-responder
-            <new-user-form> ctor "$user-admin" <new-user-action> "new" add-responder
-            <edit-user-form> ctor "$user-admin" <edit-user-action> "edit" add-responder
-            ctor "$user-admin" <delete-user-action> "delete" add-responder
-        <boilerplate>
-            "admin" admin-template >>template
-        { can-administer-users? } <protected>
-    ] ;
-
-: make-admin ( username -- )
-    <user>
-    select-tuple
-    [ can-administer-users? suffix ] change-capabilities
-    update-tuple ;
diff --git a/extra/http/server/auth/admin/user-list.xml b/extra/http/server/auth/admin/user-list.xml
deleted file mode 100644
index 520b7f2512..0000000000
--- a/extra/http/server/auth/admin/user-list.xml
+++ /dev/null
@@ -1,9 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<t:title>Users</t:title>
-
-	<t:summary t:component="list" />
-
-</t:chloe>
diff --git a/extra/http/server/auth/admin/user-summary.xml b/extra/http/server/auth/admin/user-summary.xml
deleted file mode 100644
index c426e7c072..0000000000
--- a/extra/http/server/auth/admin/user-summary.xml
+++ /dev/null
@@ -1,9 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<t:a t:href="$user-admin/edit" t:query="username">
-		<t:view t:component="username" />
-	</t:a>
-
-</t:chloe>
diff --git a/extra/webapps/pastebin/paste-list.xml b/extra/webapps/pastebin/paste-list.xml
deleted file mode 100644
index c91aa6fc42..0000000000
--- a/extra/webapps/pastebin/paste-list.xml
+++ /dev/null
@@ -1,15 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<t:title>Pastebin</t:title>
-
-	<table width="100%">
-		<th align="left" width="50%">Summary:</th>
-		<th align="left" width="100">Paste by:</th>
-		<th align="left" width="200">Date:</th>
-
-		<t:summary t:component="pastes" />
-	</table>
-
-</t:chloe>
diff --git a/extra/webapps/pastebin/pastebin-common.xml b/extra/webapps/pastebin/pastebin-common.xml
new file mode 100644
index 0000000000..b99cf28753
--- /dev/null
+++ b/extra/webapps/pastebin/pastebin-common.xml
@@ -0,0 +1,31 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:atom t:title="Pastebin - Atom" t:href="$pastebin/feed.xml" />
+
+	<t:style t:include="resource:extra/webapps/pastebin/pastebin.css" />
+
+	<div class="navbar">
+
+		  <t:a t:href="$pastebin/list">Pastes</t:a>
+		| <t:a t:href="$pastebin/new-paste">New Paste</t:a>
+		| <t:a t:href="$pastebin/feed.xml">Atom Feed</t:a>
+
+		<t:if t:code="http.server.sessions:uid">
+
+			<t:if t:code="http.server.auth.login:allow-edit-profile?">
+				| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
+			</t:if>
+
+			| <t:button t:action="$login/logout" t:flow="begin" class="link-button link">Logout</t:button>
+
+		</t:if>
+
+	</div>
+
+	<h1><t:write-title /></h1>
+
+        <t:call-next-template />
+
+</t:chloe>
diff --git a/extra/webapps/pastebin/pastebin.xml b/extra/webapps/pastebin/pastebin.xml
index 7ca4c95f8e..46604598ce 100644
--- a/extra/webapps/pastebin/pastebin.xml
+++ b/extra/webapps/pastebin/pastebin.xml
@@ -2,29 +2,20 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:atom t:title="Pastebin - Atom" t:href="$pastebin/feed.xml" />
+	<t:title>Pastebin</t:title>
 
-	<t:style t:include="resource:extra/webapps/pastebin/pastebin.css" />
+	<table width="100%">
+		<th align="left" width="50%">Summary:</th>
+		<th align="left" width="100">Paste by:</th>
+		<th align="left" width="200">Date:</th>
 
-	<div class="navbar">
-		  <t:a t:href="$pastebin/list">Pastes</t:a>
-		| <t:a t:href="$pastebin/new-paste">New Paste</t:a>
-		| <t:a t:href="$pastebin/feed.xml">Atom Feed</t:a>
-
-		<t:if t:code="http.server.sessions:uid">
-
-			<t:if t:code="http.server.auth.login:allow-edit-profile?">
-				| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
-			</t:if>
-
-			| <t:button t:action="$login/logout" t:flow="begin" class="link-button link">Logout</t:button>
-
-		</t:if>
-
-	</div>
-
-	<h1><t:write-title /></h1>
-
-        <t:call-next-template />
+		<t:each-tuple t:values="pastes">
+			<tr>
+				<td><t:a t:href="$pastebin/view-paste" t:query="id"><t:field t:name="summary" /></t:a></td>
+				<td><t:field t:name="author" /></td>
+				<td><t:field t:name="date" /></td>
+			</tr>
+		</t:each-tuple>
+	</table>
 
 </t:chloe>
diff --git a/extra/http/server/auth/admin/edit-user.xml b/extra/webapps/user-admin/edit-user.xml
similarity index 100%
rename from extra/http/server/auth/admin/edit-user.xml
rename to extra/webapps/user-admin/edit-user.xml
diff --git a/extra/http/server/auth/admin/new-user.xml b/extra/webapps/user-admin/new-user.xml
similarity index 100%
rename from extra/http/server/auth/admin/new-user.xml
rename to extra/webapps/user-admin/new-user.xml
diff --git a/extra/webapps/user-admin/user-admin.factor b/extra/webapps/user-admin/user-admin.factor
new file mode 100644
index 0000000000..172ab62c50
--- /dev/null
+++ b/extra/webapps/user-admin/user-admin.factor
@@ -0,0 +1,160 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences accessors namespaces combinators words
+assocs db.tuples arrays splitting strings validators
+html.elements
+html.components
+html.templates.chloe
+http.server.boilerplate
+http.server.auth.providers
+http.server.auth.providers.db
+http.server.auth.login
+http.server.auth
+http.server.sessions
+http.server.actions
+http.server.crud
+http.server ;
+IN: webapps.user-admin
+
+: admin-template ( name -- template )
+    "resource:extra/webapps/user-admin/" swap ".xml" 3append <chloe> ;
+
+: words>strings ( seq -- seq' )
+    [ [ word-vocabulary ] [ drop ":" ] [ word-name ] tri 3append ] map ;
+
+: strings>words ( seq -- seq' )
+    [ ":" split1 swap lookup ] map ;
+
+: <user-list-action> ( -- action )
+    <action>
+        [ f <user> select-tuples "users" set-value ] >>init
+        [ "user-list" admin-template <html-content> ] >>display ;
+
+: <new-user-action> ( -- action )
+    <action>
+        [
+            "username" param <user> {
+                [ username>> "username" set-value ]
+                [ realname>> "realname" set-value ]
+                [ email>> "email" set-value ]
+                [ profile>> "profile" set-value ]
+            } cleave
+
+            capabilities get "all-capabilities" set-value
+        ] >>init
+
+        [ "new-user" admin-template <html-content> ] >>display
+
+        [
+            {
+                { "username" [ v-username ] }
+                { "realname" [ v-one-line ] }
+                { "new-password" [ v-password ] }
+                { "verify-password" [ v-password ] }
+                { "email" [ [ v-email ] v-optional ] }
+                { "capabilities" [ ] }
+            } validate-params
+
+            same-password-twice
+
+            user new "username" value >>username select-tuple
+            [ user-exists ] when
+        ] >>validate
+
+        [
+            "username" value <user>
+                "realname" value >>realname
+                "email" value >>email
+                "new-password" value >>encoded-password
+                H{ } clone >>profile
+
+            insert-tuple
+
+            "$user-admin" f <standard-redirect>
+        ] >>submit ;
+    
+: <edit-user-action> ( -- action )
+    <action>
+        [
+            { { "username" [ v-username ] } } validate-params
+
+            "username" value <user> select-tuple {
+                [ username>> "username" set-value ]
+                [ realname>> "realname" set-value ]
+                [ email>> "email" set-value ]
+                [ profile>> "profile" set-value ]
+                [ capabilities>> words>strings "capabilities" set-value ]
+            } cleave
+
+            capabilities get "all-capabilities" set-value
+        ] >>init
+
+        [ "edit-user" admin-template <html-content> ] >>display
+
+        [
+            {
+                { "username" [ v-username ] }
+                { "realname" [ v-one-line ] }
+                { "new-password" [ [ v-password ] v-optional ] }
+                { "verify-password" [ [ v-password ] v-optional ] }
+                { "email" [ [ v-email ] v-optional ] }
+                { "capabilities" [ ] }
+            } validate-params
+
+            "new-password" "verify-password"
+            [ value empty? ] both? [
+                same-password-twice
+            ] unless
+        ] >>validate
+
+        [
+            "username" value <user> select-tuple
+                "realname" value >>realname
+                "email" value >>email
+
+            "new-password" value empty? [ drop ] [
+                "new-password" value >>encoded-password
+            ] if
+
+            "capabilities" value {
+                { [ dup string? ] [ 1array ] }
+                { [ dup array? ] [ ] }
+            } cond strings>words >>capabilities
+
+            update-tuple
+
+            "$user-admin" f <standard-redirect>
+        ] >>submit ;
+
+: <delete-user-action> ( -- action )
+    <action>
+        [
+            { { "username" [ v-username ] } } validate-params
+            [ <user> select-tuple 1 >>deleted update-tuple ]
+            [ logout-all-sessions ]
+            bi
+
+            "$user-admin" f <standard-redirect>
+        ] >>submit ;
+
+TUPLE: user-admin < dispatcher ;
+
+SYMBOL: can-administer-users?
+
+can-administer-users? define-capability
+
+: <user-admin> ( -- responder )
+    user-admin new-dispatcher
+        <user-list-action> "" add-responder
+        <new-user-action> "new" add-responder
+        <edit-user-action> "edit" add-responder
+        <delete-user-action> "delete" add-responder
+    <boilerplate>
+        "admin" admin-template >>template
+    { can-administer-users? } <protected> ;
+
+: make-admin ( username -- )
+    <user>
+    select-tuple
+    [ can-administer-users? suffix ] change-capabilities
+    update-tuple ;
diff --git a/extra/http/server/auth/admin/admin.xml b/extra/webapps/user-admin/user-admin.xml
similarity index 100%
rename from extra/http/server/auth/admin/admin.xml
rename to extra/webapps/user-admin/user-admin.xml
diff --git a/extra/webapps/user-admin/user-list.xml b/extra/webapps/user-admin/user-list.xml
new file mode 100644
index 0000000000..6887308754
--- /dev/null
+++ b/extra/webapps/user-admin/user-list.xml
@@ -0,0 +1,13 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>Users</t:title>
+
+	<t:each-tuple t:values="users">
+		<t:a t:href="$user-admin/edit" t:query="username">
+			<t:label t:name="username" />
+		</t:a>
+	</t:each-tuple>
+
+</t:chloe>

From 5cb13132af08a2615889fdaf0b01404905f96377 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 25 May 2008 19:44:37 -0500
Subject: [PATCH 18/39] adjoin and conjoin words added

---
 core/combinators/combinators.factor         |  4 ++--
 core/compiler/units/units.factor            |  2 +-
 core/generator/fixup/fixup.factor           |  4 ++--
 core/sequences/sequences-docs.factor        | 18 +-----------------
 core/sequences/sequences-tests.factor       |  4 ++--
 core/sequences/sequences.factor             |  2 --
 core/sets/sets-docs.factor                  | 18 ++++++++++++++++++
 core/sets/sets.factor                       | 12 ++++++++----
 extra/multi-methods/multi-methods.factor    |  2 +-
 extra/trees/splay/splay-tests.factor        |  2 +-
 extra/ui/tools/interactor/interactor.factor |  2 +-
 11 files changed, 37 insertions(+), 33 deletions(-)

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index d33edfab30..f6873429fe 100755
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -95,10 +95,10 @@ M: hashtable hashcode*
 
 : (distribute-buckets) ( buckets pair keys -- )
     dup t eq? [
-        drop [ swap push-new ] curry each
+        drop [ swap adjoin ] curry each
     ] [
         [
-            >r 2dup r> hashcode pick length rem rot nth push-new
+            >r 2dup r> hashcode pick length rem rot nth adjoin
         ] each 2drop
     ] if ;
 
diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index a31cd8de16..11c81f4097 100755
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -14,7 +14,7 @@ TUPLE: redefine-error def ;
     { { "Continue" t } } throw-restarts drop ;
 
 : add-once ( key assoc -- )
-    2dup key? [ over redefine-error ] when dupd set-at ;
+    2dup key? [ over redefine-error ] when conjoin ;
 
 : (remember-definition) ( definition loc assoc -- )
     >r over set-where r> add-once ;
diff --git a/core/generator/fixup/fixup.factor b/core/generator/fixup/fixup.factor
index 06895cd8ac..b38d70fb80 100755
--- a/core/generator/fixup/fixup.factor
+++ b/core/generator/fixup/fixup.factor
@@ -102,13 +102,13 @@ M: frame-required fixup* drop ;
 
 M: integer fixup* , ;
 
-: push-new* ( obj table -- n )
+: adjoin* ( obj table -- n )
     2dup swap [ eq? ] curry find drop
     [ 2nip ] [ dup length >r push r> ] if* ;
 
 SYMBOL: literal-table
 
-: add-literal ( obj -- n ) literal-table get push-new* ;
+: add-literal ( obj -- n ) literal-table get adjoin* ;
 
 : add-dlsym-literals ( symbol dll -- )
     >r string>symbol r> 2array literal-table get push-all ;
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 351ba89692..2c1a3b8ab9 100755
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -191,7 +191,6 @@ $nl
 "Other destructive words:"
 { $subsection move }
 { $subsection exchange }
-{ $subsection push-new }
 { $subsection copy }
 { $subsection replace-slice }
 { $see-also set-nth push pop "sequences-stacks" } ;
@@ -624,22 +623,7 @@ HELP: replace-slice
 { $errors "Throws an error if " { $snippet "new" } " contains elements whose types are not permissible in " { $snippet "seq" } "." }
 { $side-effects "seq" } ;
 
-HELP: push-new
-{ $values { "elt" object } { "seq" "a resizable mutable sequence" } }
-{ $description "Removes all elements equal to " { $snippet "elt" } ", and adds " { $snippet "elt" } " at the end of the sequence." }
-{ $examples
-    { $example
-        "USING: namespaces prettyprint sequences ;"
-        "V{ \"beans\" \"salsa\" \"cheese\" } \"v\" set"
-        "\"nachos\" \"v\" get push-new"
-        "\"salsa\" \"v\" get push-new"
-        "\"v\" get ."
-        "V{ \"beans\" \"cheese\" \"nachos\" \"salsa\" }"
-    }
-}
-{ $side-effects "seq" } ;
-
-{ push push-new prefix suffix } related-words
+{ push prefix suffix } related-words
 
 HELP: suffix
 { $values { "seq" sequence } { "elt" object } { "newseq" sequence } }
diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 2479c125a2..0511721c18 100755
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -216,10 +216,10 @@ unit-test
 ] unit-test
 
 [ V{ 1 2 3 } ]
-[ 3 V{ 1 2 } clone [ push-new ] keep ] unit-test
+[ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test
 
 [ V{ 1 2 3 } ]
-[ 3 V{ 1 3 2 } clone [ push-new ] keep ] unit-test
+[ 3 V{ 1 3 2 } clone [ adjoin ] keep ] unit-test
 
 ! erg's random tester found this one
 [ SBUF" 12341234" ] [
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 4153430514..4854ff8001 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -499,8 +499,6 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
 
 : delete ( elt seq -- ) 0 0 rot (delete) nip set-length drop ;
 
-: push-new ( elt seq -- ) [ delete ] 2keep push ;
-
 : prefix ( seq elt -- newseq )
     over >r over length 1+ r> [
         [ 0 swap set-nth-unsafe ] keep
diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor
index f4e2557a71..97fbc973f0 100644
--- a/core/sets/sets-docs.factor
+++ b/core/sets/sets-docs.factor
@@ -16,10 +16,28 @@ $nl
 { $subsection set= }
 "A word used to implement the above:"
 { $subsection unique }
+"Adding elements to sets:"
+{ $subsection adjoin }
+{ $subsection conjoin }
 { $see-also member? memq? contains? all? "assocs-sets" } ;
 
 ABOUT: "sets"
 
+HELP: adjoin
+{ $values { "elt" object } { "seq" "a resizable mutable sequence" } }
+{ $description "Removes all elements equal to " { $snippet "elt" } ", and adds " { $snippet "elt" } " at the end of the sequence." }
+{ $examples
+    { $example
+        "USING: namespaces prettyprint sequences ;"
+        "V{ \"beans\" \"salsa\" \"cheese\" } \"v\" set"
+        "\"nachos\" \"v\" get adjoin"
+        "\"salsa\" \"v\" get adjoin"
+        "\"v\" get ."
+        "V{ \"beans\" \"cheese\" \"nachos\" \"salsa\" }"
+    }
+}
+{ $side-effects "seq" } ;
+
 HELP: unique
 { $values { "seq" "a sequence" } { "assoc" "an assoc" } }
 { $description "Outputs a new assoc where the keys and values are equal." }
diff --git a/core/sets/sets.factor b/core/sets/sets.factor
index b0d26e0f30..5fbec9a7c8 100644
--- a/core/sets/sets.factor
+++ b/core/sets/sets.factor
@@ -3,10 +3,14 @@
 USING: assocs hashtables kernel sequences vectors ;
 IN: sets
 
+: adjoin ( elt seq -- ) [ delete ] [ push ] 2bi ;
+
+: conjoin ( elt assoc -- ) dupd set-at ;
+
 : (prune) ( elt hash vec -- )
-    3dup drop key?
-    [ [ drop dupd set-at ] [ nip push ] [ ] 3tri ] unless
-    3drop ; inline
+    3dup drop key? [ 3drop ] [
+        [ drop conjoin ] [ nip push ] 3bi
+    ] if ; inline
 
 : prune ( seq -- newseq )
     [ ] [ length <hashtable> ] [ length <vector> ] tri
@@ -16,7 +20,7 @@ IN: sets
     [ dup ] H{ } map>assoc ;
 
 : (all-unique?) ( elt hash -- ? )
-    2dup key? [ 2drop f ] [ dupd set-at t ] if ;
+    2dup key? [ 2drop f ] [ conjoin t ] if ;
 
 : all-unique? ( seq -- ? )
     dup length <hashtable> [ (all-unique?) ] curry all? ;
diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor
index 59e8049232..b1073c116d 100755
--- a/extra/multi-methods/multi-methods.factor
+++ b/extra/multi-methods/multi-methods.factor
@@ -25,7 +25,7 @@ SYMBOL: total
     ]
     [
         [ pair? ] filter
-        [ keys [ hooks get push-new ] each ] keep
+        [ keys [ hooks get adjoin ] each ] keep
     ] bi append ;
 
 : canonicalize-specializer-2 ( specializer -- specializer' )
diff --git a/extra/trees/splay/splay-tests.factor b/extra/trees/splay/splay-tests.factor
index 29ea2eee2d..29bc153030 100644
--- a/extra/trees/splay/splay-tests.factor
+++ b/extra/trees/splay/splay-tests.factor
@@ -8,7 +8,7 @@ IN: trees.splay.tests
     100 [ drop 100 random swap at drop ] with each ;
 
 : make-numeric-splay-tree ( n -- splay-tree )
-    <splay> [ [ dupd set-at ] curry each ] keep ;
+    <splay> [ [ conjoin ] curry each ] keep ;
 
 [ t ] [
     100 make-numeric-splay-tree dup randomize-numeric-splay-tree
diff --git a/extra/ui/tools/interactor/interactor.factor b/extra/ui/tools/interactor/interactor.factor
index 2e59363531..c28e8aec7c 100755
--- a/extra/ui/tools/interactor/interactor.factor
+++ b/extra/ui/tools/interactor/interactor.factor
@@ -76,7 +76,7 @@ M: interactor model-changed
     ] with-output-stream* ;
 
 : add-interactor-history ( str interactor -- )
-    over empty? [ 2drop ] [ interactor-history push-new ] if ;
+    over empty? [ 2drop ] [ interactor-history adjoin ] if ;
 
 : interactor-continue ( obj interactor -- )
     mailbox>> mailbox-put ;

From a84880d770b5e5b18c26a649bdea078e8b074ff9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 25 May 2008 19:45:21 -0500
Subject: [PATCH 19/39] Fix parameter ordering

---
 extra/db/db.factor          | 2 +-
 extra/db/pools/pools.factor | 8 ++++----
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/extra/db/db.factor b/extra/db/db.factor
index 9514f62cf0..4b98612069 100755
--- a/extra/db/db.factor
+++ b/extra/db/db.factor
@@ -127,7 +127,7 @@ M: nonthrowable execute-statement* ( statement type -- )
 : query-map ( statement quot -- seq )
     accumulator >r query-each r> { } like ; inline
 
-: with-db ( db seq quot -- )
+: with-db ( seq class quot -- )
     >r make-db db-open db r>
     [ db get swap [ drop ] prepose with-disposal ] curry with-variable ;
     inline
diff --git a/extra/db/pools/pools.factor b/extra/db/pools/pools.factor
index 4d201c2edf..63153c451e 100644
--- a/extra/db/pools/pools.factor
+++ b/extra/db/pools/pools.factor
@@ -6,16 +6,16 @@ IN: db.pools
 
 TUPLE: db-pool < pool db params ;
 
-: <db-pool> ( db params -- pool )
+: <db-pool> ( params db -- pool )
     db-pool <pool>
-        swap >>params
-        swap >>db ;
+        swap >>db
+        swap >>params ;
 
 : with-db-pool ( db params quot -- )
     >r <db-pool> r> with-pool ; inline
 
 M: db-pool make-connection ( pool -- )
-    [ db>> ] [ params>> ] bi make-db db-open ;
+    [ params>> ] [ db>> ] bi make-db db-open ;
 
 : with-pooled-db ( pool quot -- )
     [ db swap with-variable ] curry with-pooled-connection ; inline

From d589ac19dd1f3b95f4fb31f6224fde66d99169d6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 00:47:27 -0500
Subject: [PATCH 20/39] Reworking validation

---
 extra/html/components/components-tests.factor |  10 +
 extra/html/components/components.factor       |  42 ++-
 extra/html/templates/chloe/chloe-tests.factor |  40 ++-
 extra/html/templates/chloe/chloe.factor       |  28 +-
 extra/html/templates/chloe/test/test10.xml    |  14 +
 extra/html/templates/chloe/test/test11.xml    |  14 +
 extra/html/templates/chloe/test/test9.xml     |  11 +
 extra/html/templates/templates.factor         |   4 +-
 extra/http/client/client.factor               |   2 +-
 extra/http/http-tests.factor                  |   2 +-
 extra/http/http.factor                        |  32 +-
 .../http/server/actions/actions-tests.factor  |  10 +-
 extra/http/server/actions/actions.factor      | 122 ++++---
 extra/http/server/auth/auth.factor            |   4 +-
 extra/http/server/auth/login/edit-profile.xml |  14 +-
 extra/http/server/auth/login/login.factor     | 329 +++++++----------
 extra/http/server/auth/login/login.xml        |   6 +-
 extra/http/server/auth/login/recover-1.xml    |  32 +-
 extra/http/server/auth/login/recover-3.xml    |  18 +-
 extra/http/server/auth/login/register.xml     |  80 ++---
 .../server/auth/providers/assoc/assoc.factor  |   4 +-
 .../server/boilerplate/boilerplate.factor     |  64 +---
 extra/http/server/callbacks/callbacks.factor  |   4 +-
 extra/http/server/crud/crud.factor            |   7 +-
 extra/http/server/db/db.factor                |   2 +-
 extra/http/server/server-tests.factor         |   6 +-
 extra/http/server/server.factor               |  38 +-
 .../server/sessions/sessions-tests.factor     |   8 +-
 extra/http/server/static/static.factor        |  29 +-
 extra/webapps/counter/counter.factor          |  23 +-
 extra/webapps/counter/counter.xml             |  13 +
 .../factor-website/factor-website.factor      |  12 +-
 extra/webapps/factor-website/page.css         |  20 ++
 extra/webapps/pastebin/new-paste.xml          |  10 +-
 extra/webapps/pastebin/paste.xml              |  52 ++-
 extra/webapps/pastebin/pastebin-common.xml    |   3 -
 extra/webapps/pastebin/pastebin.factor        | 332 +++++++++---------
 extra/webapps/pastebin/pastebin.xml           |   2 +
 extra/webapps/planet/admin.xml                |  14 +-
 extra/webapps/planet/edit-blog.xml            |   7 +-
 extra/webapps/planet/mini-planet.xml          |  14 +
 extra/webapps/planet/new-blog.xml             |  32 ++
 extra/webapps/planet/planet-common.xml        |  25 ++
 extra/webapps/planet/planet.factor            | 235 +++++++------
 extra/webapps/planet/planet.xml               |  50 ++-
 extra/webapps/planet/postings-summary.xml     |   7 -
 extra/webapps/planet/postings.xml             |  19 -
 extra/webapps/todo/edit-todo.xml              |   6 +-
 extra/webapps/todo/todo-list.xml              |  29 +-
 extra/webapps/todo/todo.factor                | 127 ++++---
 extra/webapps/todo/todo.xml                   |   2 +-
 extra/webapps/todo/view-todo.xml              |   6 +-
 extra/webapps/user-admin/edit-user.xml        |  16 +-
 extra/webapps/user-admin/new-user.xml         |  14 +-
 extra/webapps/user-admin/user-admin.factor    |  59 ++--
 extra/webapps/user-admin/user-list.xml        |  16 +-
 extra/xmode/catalog/catalog.factor            |  12 +-
 .../code2html/responder/responder.factor      |  13 +-
 58 files changed, 1197 insertions(+), 949 deletions(-)
 create mode 100644 extra/html/templates/chloe/test/test10.xml
 create mode 100644 extra/html/templates/chloe/test/test11.xml
 create mode 100644 extra/html/templates/chloe/test/test9.xml
 create mode 100644 extra/webapps/counter/counter.xml
 create mode 100644 extra/webapps/planet/mini-planet.xml
 create mode 100644 extra/webapps/planet/new-blog.xml
 create mode 100644 extra/webapps/planet/planet-common.xml
 delete mode 100644 extra/webapps/planet/postings-summary.xml
 delete mode 100644 extra/webapps/planet/postings.xml

diff --git a/extra/html/components/components-tests.factor b/extra/html/components/components-tests.factor
index d09f8b6b42..f2b0049a8e 100644
--- a/extra/html/components/components-tests.factor
+++ b/extra/html/components/components-tests.factor
@@ -168,3 +168,13 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
     [ "object" value [ describe ] with-html-stream ] with-string-writer
     =
 ] unit-test
+
+[ ] [ blank-values ] unit-test
+
+[ ] [
+    "factor" [
+        "concatenative" "model" set-value
+    ] nest-values
+] unit-test
+
+[ H{ { "factor" H{ { "model" "concatenative" } } } } ] [ values get ] unit-test
diff --git a/extra/html/components/components.factor b/extra/html/components/components.factor
index faef9ca1b5..e6df343161 100644
--- a/extra/html/components/components.factor
+++ b/extra/html/components/components.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces io math.parser assocs classes
-classes.tuple words arrays sequences splitting mirrors
-hashtables combinators continuations math strings
+classes.tuple words arrays sequences sequences.lib splitting
+mirrors hashtables combinators continuations math strings
 fry locals calendar calendar.format xml.entities validators
 html.elements html.streams xmode.code2html farkup inspector ;
 IN: html.components
@@ -18,22 +18,52 @@ SYMBOL: values
 : prepare-value ( name object -- value name object )
     [ [ value ] keep ] dip ; inline
 
-: from-tuple <mirror> values set ;
+: from-assoc ( assoc -- ) values get swap update ;
 
-: values-tuple values get object>> ;
+: from-tuple ( tuple -- ) <mirror> from-assoc ;
+
+: deposit-values ( destination names -- )
+    [ dup value ] H{ } map>assoc update ;
+
+: deposit-slots ( destination names -- )
+    [ <mirror> ] dip deposit-values ;
+
+: with-each-index ( seq quot -- )
+    '[
+        [
+            blank-values 1+ "index" set-value @
+        ] with-scope
+    ] each-index ; inline
+
+: with-each-value ( seq quot -- )
+    '[ "value" set-value @ ] with-each-index ; inline
+
+: with-each-assoc ( seq quot -- )
+    '[ from-assoc @ ] with-each-index ; inline
+
+: with-each-tuple ( seq quot -- )
+    '[ from-tuple @ ] with-each-index ; inline
+
+: nest-values ( name quot -- )
+    swap [
+        [
+            H{ } clone [ values set call ] keep
+        ] with-scope
+    ] dip set-value ; inline
 
 : object>string ( object -- string )
     {
         { [ dup real? ] [ number>string ] }
         { [ dup timestamp? ] [ timestamp>string ] }
         { [ dup string? ] [ ] }
+        { [ dup word? ] [ word-name ] }
         { [ dup not ] [ drop "" ] }
     } cond ;
 
 GENERIC: render* ( value name render -- )
 
 : render ( name renderer -- )
-    over validation-messages get at [
+    over named-validation-messages get at [
         [ value>> ] [ message>> ] bi
         [ -rot render* ] dip
         render-error
@@ -103,7 +133,7 @@ TUPLE: choice size multiple choices ;
 
 : render-option ( text selected? -- )
     <option [ "true" =selected ] when option>
-        escape-string write
+        object>string escape-string write
     </option> ;
 
 : render-options ( options selected -- )
diff --git a/extra/html/templates/chloe/chloe-tests.factor b/extra/html/templates/chloe/chloe-tests.factor
index 4d8d15c581..eaa0f0dc3d 100644
--- a/extra/html/templates/chloe/chloe-tests.factor
+++ b/extra/html/templates/chloe/chloe-tests.factor
@@ -1,7 +1,7 @@
 USING: html.templates html.templates.chloe
 tools.test io.streams.string kernel sequences ascii boxes
 namespaces xml html.components
-splitting ;
+splitting unicode.categories ;
 IN: html.templates.chloe.tests
 
 [ f ] [ f parse-query-attr ] unit-test
@@ -117,9 +117,45 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
 [ ] [ "new york" "choice" set-value ] unit-test
 
 [ ] [ { "new york" "detroit" "minneapolis" } "choices" set-value ] unit-test
-    
+
 [ ] [
     [
         "test8" test-template call-template
     ] run-template drop
 ] unit-test
+
+[ ] [ { 1 2 3 } "numbers" set-value ] unit-test
+
+[ "<ul><li>1</li><li>2</li><li>3</li></ul>" ] [
+    [
+        "test9" test-template call-template
+    ] run-template [ blank? not ] filter
+] unit-test
+
+TUPLE: person first-name last-name ;
+
+[ ] [
+    {
+        T{ person f "RBaxter" "Unknown" }
+        T{ person f "Doug" "Coleman" }
+    } "people" set-value
+] unit-test
+
+[ "<table><tr><td>RBaxter</td><td>Unknown</td></tr><tr><td>Doug</td><td>Coleman</td></tr></table>" ] [
+    [
+        "test10" test-template call-template
+    ] run-template [ blank? not ] filter
+] unit-test
+
+[ ] [
+    {
+        H{ { "first-name" "RBaxter" } { "last-name" "Unknown" } }
+        H{ { "first-name" "Doug"    } { "last-name" "Coleman" } }
+    } "people" set-value
+] unit-test
+
+[ "<table><tr><td>RBaxter</td><td>Unknown</td></tr><tr><td>Doug</td><td>Coleman</td></tr></table>" ] [
+    [
+        "test11" test-template call-template
+    ] run-template [ blank? not ] filter
+] unit-test
diff --git a/extra/html/templates/chloe/chloe.factor b/extra/html/templates/chloe/chloe.factor
index 43834f896e..4430e69336 100644
--- a/extra/html/templates/chloe/chloe.factor
+++ b/extra/html/templates/chloe/chloe.factor
@@ -3,7 +3,7 @@
 USING: accessors kernel sequences combinators kernel namespaces
 classes.tuple assocs splitting words arrays memoize
 io io.files io.encodings.utf8 io.streams.string
-unicode.case tuple-syntax mirrors fry
+unicode.case tuple-syntax mirrors fry math
 multiline xml xml.data xml.writer xml.utilities
 html.elements
 html.components
@@ -196,6 +196,27 @@ STRING: button-tag-markup
 : if-tag ( tag -- )
     dup if-satisfied? [ process-tag-children ] [ drop ] if ;
 
+: even-tag ( tag -- )
+    "index" value even? [ process-tag-children ] [ drop ] if ;
+
+: odd-tag ( tag -- )
+    "index" value odd? [ process-tag-children ] [ drop ] if ;
+
+: (each-tag) ( tag quot -- )
+    [
+        [ "values" required-attr value ] keep
+        '[ , process-tag-children ]
+    ] dip call ; inline
+
+: each-tag ( tag -- )
+    [ with-each-value ] (each-tag) ;
+
+: each-tuple-tag ( tag -- )
+    [ with-each-tuple ] (each-tag) ;
+
+: each-assoc-tag ( tag -- )
+    [ with-each-assoc ] (each-tag) ;
+
 : error-message-tag ( tag -- )
     children>string render-error ;
 
@@ -254,6 +275,11 @@ STRING: button-tag-markup
 
         ! Control flow
         { "if" [ if-tag ] }
+        { "even" [ even-tag ] }
+        { "odd" [ odd-tag ] }
+        { "each" [ each-tag ] }
+        { "each-assoc" [ each-assoc-tag ] }
+        { "each-tuple" [ each-tuple-tag ] }
         { "comment" [ drop ] }
         { "call-next-template" [ drop call-next-template ] }
 
diff --git a/extra/html/templates/chloe/test/test10.xml b/extra/html/templates/chloe/test/test10.xml
new file mode 100644
index 0000000000..afded9366f
--- /dev/null
+++ b/extra/html/templates/chloe/test/test10.xml
@@ -0,0 +1,14 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<table>
+		<t:each-tuple t:values="people">
+			<tr>
+				<td><t:label t:name="first-name"/></td>
+				<td><t:label t:name="last-name"/></td>
+			</tr>
+		</t:each-tuple>
+	</table>
+
+</t:chloe>
diff --git a/extra/html/templates/chloe/test/test11.xml b/extra/html/templates/chloe/test/test11.xml
new file mode 100644
index 0000000000..17e31b1a59
--- /dev/null
+++ b/extra/html/templates/chloe/test/test11.xml
@@ -0,0 +1,14 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<table>
+		<t:each-assoc t:values="people">
+			<tr>
+				<td><t:label t:name="first-name"/></td>
+				<td><t:label t:name="last-name"/></td>
+			</tr>
+		</t:each-assoc>
+	</table>
+
+</t:chloe>
diff --git a/extra/html/templates/chloe/test/test9.xml b/extra/html/templates/chloe/test/test9.xml
new file mode 100644
index 0000000000..bcfc468738
--- /dev/null
+++ b/extra/html/templates/chloe/test/test9.xml
@@ -0,0 +1,11 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<ul>
+		<t:each t:values="numbers">
+			<li><t:label t:name="value"/></li>
+		</t:each>
+	</ul>
+
+</t:chloe>
diff --git a/extra/html/templates/templates.factor b/extra/html/templates/templates.factor
index ed26c9b531..580af58ecc 100644
--- a/extra/html/templates/templates.factor
+++ b/extra/html/templates/templates.factor
@@ -19,12 +19,12 @@ ERROR: template-error template error ;
 
 M: template-error error.
     "Error while processing template " write
-    [ template>> pprint ":" print nl ]
+    [ template>> short. ":" print nl ]
     [ error>> error. ]
     bi ;
 
 : call-template ( template -- )
-    [ call-template* ] [ template-error ] recover ;
+    [ call-template* ] [ \ template-error boa rethrow ] recover ;
 
 SYMBOL: title
 
diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor
index c455c8c5f1..7b156a4b9b 100755
--- a/extra/http/client/client.factor
+++ b/extra/http/client/client.factor
@@ -93,7 +93,7 @@ M: download-failed error.
 
 : download-to ( url file -- )
     #! Downloads the contents of a URL to a file.
-    >r http-get r> latin1 [ write ] with-file-writer ;
+    [ http-get ] dip latin1 [ write ] with-file-writer ;
 
 : download ( url -- )
     dup download-name download-to ;
diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor
index 89480b43ba..151d1ce84f 100755
--- a/extra/http/http-tests.factor
+++ b/extra/http/http-tests.factor
@@ -237,7 +237,7 @@ test-db [
 [ ] [
     [
         <dispatcher>
-            <action> [ "text/plain" <content> [ "Hi" write ] >>body ] >>display
+            <action> [ [ "Hi" write ] <text-content> ] >>display
             <login>
             <sessions>
             "" add-responder
diff --git a/extra/http/http.factor b/extra/http/http.factor
index 7587cb0fe9..89c8f62d5c 100755
--- a/extra/http/http.factor
+++ b/extra/http/http.factor
@@ -9,7 +9,9 @@ math.parser calendar calendar.format
 io io.streams.string io.encodings.utf8 io.encodings.string
 io.sockets io.sockets.secure
 
-unicode.case unicode.categories qualified ;
+unicode.case unicode.categories qualified
+
+html.templates ;
 
 EXCLUDE: fry => , ;
 
@@ -65,14 +67,14 @@ M: https protocol>string drop "https" ;
     2dup length 2 - >= [
         2drop
     ] [
-        >r 1+ dup 2 + r> subseq  hex> [ , ] when*
+        [ 1+ dup 2 + ] dip subseq  hex> [ , ] when*
     ] if ;
 
 : url-decode-% ( index str -- index str )
-    2dup url-decode-hex >r 3 + r> ;
+    2dup url-decode-hex [ 3 + ] dip ;
 
 : url-decode-+-or-other ( index str ch -- index str )
-    dup CHAR: + = [ drop CHAR: \s ] when , >r 1+ r> ;
+    dup CHAR: + = [ drop CHAR: \s ] when , [ 1+ ] dip ;
 
 : url-decode-iter ( index str -- )
     2dup length >= [
@@ -158,7 +160,7 @@ M: https protocol>string drop "https" ;
     dup [
         "&" split H{ } clone [
             [
-                >r "=" split1 [ dup [ url-decode ] when ] bi@ swap r>
+                [ "=" split1 [ dup [ url-decode ] when ] bi@ swap ] dip
                 add-query-param
             ] curry each
         ] keep
@@ -174,7 +176,7 @@ M: https protocol>string drop "https" ;
     ] assoc-map
     [
         [
-            >r url-encode r>
+            [ url-encode ] dip
             [ url-encode "=" swap 3append , ] with each
         ] assoc-each
     ] { } make "&" join ;
@@ -342,7 +344,7 @@ SYMBOL: max-post-request
     dup "cookie" header [ parse-cookies >>cookies ] when* ;
 
 : parse-content-type-attributes ( string -- attributes )
-    " " split harvest [ "=" split1 >r >lower r> ] { } map>assoc ;
+    " " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
 
 : parse-content-type ( content-type -- type encoding )
     ";" split1 parse-content-type-attributes "charset" swap at ;
@@ -521,18 +523,8 @@ body ;
     over unparse-content-type "content-type" pick set-at
     write-header ;
 
-GENERIC: write-response-body* ( body -- )
-
-M: f write-response-body* drop ;
-
-M: string write-response-body* write ;
-
-M: callable write-response-body* call ;
-
-M: object write-response-body* output-stream get stream-copy ;
-
 : write-response-body ( response -- response )
-    dup body>> write-response-body* ;
+    dup body>> call-template ;
 
 M: response write-response ( respose -- )
     write-response-version
@@ -547,10 +539,10 @@ M: response write-full-response ( request response -- )
     swap method>> "HEAD" = [ write-response-body ] unless ;
 
 : get-cookie ( request/response name -- cookie/f )
-    >r cookies>> r> '[ , _ name>> = ] find nip ;
+    [ cookies>> ] dip '[ , _ name>> = ] find nip ;
 
 : delete-cookie ( request/response name -- )
-    over cookies>> >r get-cookie r> delete ;
+    over cookies>> [ get-cookie ] dip delete ;
 
 : put-cookie ( request/response cookie -- request/response )
     [ name>> dupd get-cookie [ dupd delete-cookie ] when* ] keep
diff --git a/extra/http/server/actions/actions-tests.factor b/extra/http/server/actions/actions-tests.factor
index 5aa761603f..480cbc8e96 100755
--- a/extra/http/server/actions/actions-tests.factor
+++ b/extra/http/server/actions/actions-tests.factor
@@ -1,16 +1,10 @@
-USING: http.server.actions http.server.validators
+USING: kernel http.server.actions validators
 tools.test math math.parser multiline namespaces http
 io.streams.string http.server sequences splitting accessors ;
 IN: http.server.actions.tests
 
-[
-    "a" [ v-number ] { { "a" "123" } } validate-param
-    [ 123 ] [ "a" get ] unit-test
-] with-scope
-
 <action>
-    [ "a" get "b" get + ] >>display
-    { { "a" [ v-number ] } { "b" [ v-number ] } } >>get-params
+    [ "a" param "b" param [ string>number ] bi@ + ] >>display
 "action-1" set
 
 : lf>crlf "\n" split "\r\n" join ;
diff --git a/extra/http/server/actions/actions.factor b/extra/http/server/actions/actions.factor
index 2d73cb46a7..bcd2cbd585 100755
--- a/extra/http/server/actions/actions.factor
+++ b/extra/http/server/actions/actions.factor
@@ -1,68 +1,84 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors sequences kernel assocs combinators
-http.server http.server.validators http hashtables namespaces
-fry continuations locals boxes xml.entities html.elements io ;
+USING: accessors sequences kernel assocs combinators http.server
+validators http hashtables namespaces fry continuations locals
+boxes xml.entities html.elements html.components io arrays ;
 IN: http.server.actions
 
 SYMBOL: params
 
-SYMBOL: validation-message
-
-: render-validation-message ( -- )
-    validation-message get value>> [
-        <span "error" =class span>
-            escape-string write
-        </span>
-    ] when* ;
-
-TUPLE: action init display submit get-params post-params ;
-
-: <action>
-    action new
-        [ ] >>init
-        [ <400> ] >>display
-        [ <400> ] >>submit ;
-
-:: validate-param ( name validator assoc -- )
-    name assoc at validator with-validator name set ; inline
-
-: action-params ( validators -- error? )
-    validation-failed? off
-    params get '[ , validate-param ] assoc-each
-    validation-failed? get ;
-
-: handle-get ( -- response )
-    action get get-params>> action-params [ <400> ] [
-        action get [ init>> call ] [ display>> call ] bi
+: render-validation-messages ( -- )
+    validation-messages get
+    dup empty? [ drop ] [
+        <ul "errors" =class ul>
+            [ <li> message>> escape-string write </li> ] each
+        </ul>
     ] if ;
 
-: handle-post ( -- response )
-    action get post-params>> action-params
-    [ <400> ] [ action get submit>> call ] if ;
+TUPLE: action init display validate submit ;
+
+: new-action ( class -- action )
+    new
+        [ ] >>init
+        [ <400> ] >>display
+        [ ] >>validate
+        [ <400> ] >>submit ;
+
+: <action> ( -- action )
+    action new-action ;
+
+: handle-get ( action -- response )
+    blank-values
+    [ init>> call ]
+    [ display>> call ]
+    bi ;
 
 : validation-failed ( -- * )
-    action get display>> call exit-with ;
+    request get method>> "POST" =
+    [ action get display>> call ] [ <400> ] if exit-with ;
 
-: validation-failed-with ( string -- * )
-    validation-message get >box
-    validation-failed ;
+: handle-post ( action -- response )
+    init-validation
+    blank-values
+    [ validate>> call ]
+    [ submit>> call ] bi ;
 
 M: action call-responder* ( path action -- response )
+    dup action set
     '[
-        , [ CHAR: / = ] right-trim empty? [
-            , action set
-            request get
-            <box> validation-message set
-            [ request-params params set ]
-            [
-                method>> {
-                    { "GET" [ handle-get ] }
-                    { "HEAD" [ handle-get ] }
-                    { "POST" [ handle-post ] }
-                } case
-            ] bi
-        ] [
-            <404>
-        ] if
+        , empty? [
+            init-validation
+            ,
+            request get [ request-params params set ] [ method>> ] bi
+            {
+                { "GET" [ handle-get ] }
+                { "HEAD" [ handle-get ] }
+                { "POST" [ handle-post ] }
+            } case
+        ] [ <404> ] if
     ] with-exit-continuation ;
+
+: param ( name -- value )
+    params get at ;
+
+: check-validation ( -- )
+    validation-failed? [ validation-failed ] when ;
+
+: validate-params ( validators -- )
+    params get swap validate-values from-assoc
+    check-validation ;
+
+: validate-integer-id ( -- )
+    { { "id" [ v-number ] } } validate-params ;
+
+TUPLE: page-action < action template ;
+
+: <page-action> ( -- page )
+    page-action new-action
+        dup '[ , template>> <html-content> ] >>display ;
+
+TUPLE: feed-action < action feed ;
+
+: <feed-action> ( -- feed )
+    feed-action new
+        dup '[ , feed>> call <feed-content> ] >>display ;
diff --git a/extra/http/server/auth/auth.factor b/extra/http/server/auth/auth.factor
index 36fcff4b2e..4b34fbe804 100755
--- a/extra/http/server/auth/auth.factor
+++ b/extra/http/server/auth/auth.factor
@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs namespaces kernel sequences
+USING: accessors assocs namespaces kernel sequences sets
 http.server
 http.server.sessions
 http.server.auth.providers ;
@@ -38,4 +38,4 @@ SYMBOL: capabilities
 
 V{ } clone capabilities set-global
 
-: define-capability ( word -- ) capabilities get push-new ;
+: define-capability ( word -- ) capabilities get adjoin ;
diff --git a/extra/http/server/auth/login/edit-profile.xml b/extra/http/server/auth/login/edit-profile.xml
index 1eaf65fa07..855dfa8469 100644
--- a/extra/http/server/auth/login/edit-profile.xml
+++ b/extra/http/server/auth/login/edit-profile.xml
@@ -10,12 +10,12 @@
 	
 	<tr>
 		<th class="field-label">User name:</th>
-		<td><t:view t:component="username" /></td>
+		<td><t:field t:name="username" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Real name:</th>
-		<td><t:edit t:component="realname" /></td>
+		<td><t:field t:name="realname" /></td>
 	</tr>
 	
 	<tr>
@@ -25,7 +25,7 @@
 	
 	<tr>
 		<th class="field-label">Current password:</th>
-		<td><t:edit t:component="password" /></td>
+		<td><t:password t:name="password" /></td>
 	</tr>
 	
 	<tr>
@@ -35,12 +35,12 @@
 	
 	<tr>
 		<th class="field-label">New password:</th>
-		<td><t:edit t:component="new-password" /></td>
+		<td><t:password t:name="new-password" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Verify:</th>
-		<td><t:edit t:component="verify-password" /></td>
+		<td><t:password t:name="verify-password" /></td>
 	</tr>
 	
 	<tr>
@@ -50,7 +50,7 @@
 	
 	<tr>
 		<th class="field-label">E-mail:</th>
-		<td><t:edit t:component="email" /></td>
+		<td><t:field t:name="email" /></td>
 	</tr>
 	
 	<tr>
@@ -62,7 +62,7 @@
 
 	<p>
 		<input type="submit" value="Update" />
-		<t:validation-message />
+		<t:validation-messages />
 	</p>
 
 	</t:form>
diff --git a/extra/http/server/auth/login/login.factor b/extra/http/server/auth/login/login.factor
index bb77532a22..e8c9bf8608 100755
--- a/extra/http/server/auth/login/login.factor
+++ b/extra/http/server/auth/login/login.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors quotations assocs kernel splitting
 combinators sequences namespaces hashtables sets
-fry arrays threads locals qualified random
+fry arrays threads qualified random validators
 io
 io.sockets
 io.encodings.utf8
@@ -12,23 +12,22 @@ continuations
 destructors
 checksums
 checksums.sha2
+validators
+html.components
 html.elements
+html.templates
+html.templates.chloe
 http
 http.server
 http.server.auth
 http.server.auth.providers
 http.server.auth.providers.db
 http.server.actions
-http.server.components
 http.server.flows
-http.server.forms
 http.server.sessions
-http.server.boilerplate
-http.server.templating
-http.server.templating.chloe
-http.server.validators ;
-IN: http.server.auth.login
+http.server.boilerplate ;
 QUALIFIED: smtp
+IN: http.server.auth.login
 
 TUPLE: login < dispatcher users checksum ;
 
@@ -65,149 +64,124 @@ M: user-saver dispose
     3append <chloe> ;
 
 ! ! ! Login
+: successful-login ( user -- )
+    username>> set-uid ;
 
-: <login-form>
-    "login" <form>
-        "login" login-template >>edit-template
-        "username" <username>
-            t >>required
-            add-field
-        "password" <password>
-            t >>required
-            add-field ;
+: login-failed ( -- * )
+    "invalid username or password" validation-error
+    validation-failed ;
 
-: successful-login ( user -- response )
-    username>> set-uid
-    "$login" end-flow ;
+: <login-action> ( -- action )
+    <action>
+        [ "login" login-template <html-content> ] >>display
 
-: login-failed "invalid username or password" validation-failed-with ;
+        [
+            {
+                { "username" [ v-required ] }
+                { "password" [ v-required ] }
+            } validate-params
 
-:: <login-action> ( -- action )
-    [let | form [ <login-form> ] |
-        <action>
-            [ blank-values ] >>init
+            "password" value
+            "username" value check-login
+            [ successful-login ] [ login-failed ] if*
+        ] >>validate
 
-            [ form edit-form ] >>display
-
-            [
-                blank-values
-
-                form validate-form
-
-                "password" value "username" value check-login
-                [ successful-login ] [ login-failed ] if*
-            ] >>submit
-    ] ;
+        [ "$login" end-flow ] >>submit ;
 
 ! ! ! New user registration
 
-: <register-form> ( -- form )
-    "register" <form>
-        "register" login-template >>edit-template
-        "username" <username>
-            t >>required
-            add-field
-        "realname" <string> add-field
-        "new-password" <password>
-            t >>required
-            add-field
-        "verify-password" <password>
-            t >>required
-            add-field
-        "email" <email> add-field
-        "captcha" <captcha> add-field ;
+: user-exists ( -- * )
+    "username taken" validation-error
+    validation-failed ;
 
-: password-mismatch "passwords do not match" validation-failed-with ;
-
-: user-exists "username taken" validation-failed-with ;
+: password-mismatch ( -- * )
+    "passwords do not match" validation-error
+    validation-failed ;
 
 : same-password-twice ( -- )
     "new-password" value "verify-password" value =
     [ password-mismatch ] unless ;
 
-:: <register-action> ( -- action )
-    [let | form [ <register-form> ] |
-        <action>
-            [ blank-values ] >>init
+: <register-action> ( -- action )
+    <page-action>
+        "register" login-template >>template
 
-            [ form edit-form ] >>display
+        [
+            {
+                { "username" [ v-username ] }
+                { "realname" [ [ v-one-line ] v-optional ] }
+                { "new-password" [ v-password ] }
+                { "verify-password" [ v-password ] }
+                { "email" [ [ v-email ] v-optional ] }
+                { "captcha" [ v-captcha ] }
+            } validate-params
 
-            [
-                blank-values
+            same-password-twice
+        ] >>validate
 
-                form validate-form
+        [
+            "username" value <user>
+                "realname" value >>realname
+                "new-password" value >>encoded-password
+                "email" value >>email
+                H{ } clone >>profile
 
-                same-password-twice
+            users new-user [ user-exists ] unless*
 
-                "username" value <user>
-                    "realname" value >>realname
-                    "new-password" value >>encoded-password
-                    "email" value >>email
-                    H{ } clone >>profile
+            login get init-user-profile
 
-                users new-user [ user-exists ] unless*
-
-                successful-login
-
-                login get init-user-profile
-            ] >>submit
-    ] ;
+            successful-login
+        ] >>submit ;
 
 ! ! ! Editing user profile
 
-: <edit-profile-form> ( -- form )
-    "edit-profile" <form>
-        "edit-profile" login-template >>edit-template
-        "username" <username> add-field
-        "realname" <string> add-field
-        "password" <password> add-field
-        "new-password" <password> add-field
-        "verify-password" <password> add-field
-        "email" <email> add-field ;
+: <edit-profile-action> ( -- action )
+    <action>
+        [
+            logged-in-user get
+            [ username>> "username" set-value ]
+            [ realname>> "realname" set-value ]
+            [ email>> "email" set-value ]
+            tri
+        ] >>init
 
-:: <edit-profile-action> ( -- action )
-    [let | form [ <edit-profile-form> ] |
-        <action>
-            [
-                blank-values
+        [ "edit-profile" login-template <html-content> ] >>display
 
-                logged-in-user get
-                [ username>> "username" set-value ]
-                [ realname>> "realname" set-value ]
-                [ email>> "email" set-value ]
-                tri
-            ] >>init
+        [
+            uid "username" set-value
 
-            [ form edit-form ] >>display
+            {
+                { "realname" [ [ v-one-line ] v-optional ] }
+                { "password" [ ] }
+                { "new-password" [ [ v-password ] v-optional ] }
+                { "verify-password" [ [ v-password ] v-optional ] } 
+                { "email" [ [ v-email ] v-optional ] }
+            } validate-params
 
-            [
-                blank-values
-                uid "username" set-value
+            { "password" "new-password" "verify-password" }
+            [ value empty? not ] contains? [
+                "password" value uid check-login
+                [ "incorrect password" validation-error ] unless
 
-                form validate-form
+                same-password-twice
+            ] when
+        ] >>validate
 
-                logged-in-user get
+        [
+            logged-in-user get
 
-                { "password" "new-password" "verify-password" }
-                [ value empty? ] all? [
-                    same-password-twice
+            "new-password" value dup empty?
+            [ drop ] [ >>encoded-password ] if
 
-                    "password" value uid check-login
-                    [ login-failed ] unless
+            "realname" value >>realname
+            "email" value >>email
 
-                    "new-password" value >>encoded-password
-                ] unless
+            t >>changed?
 
-                "realname" value >>realname
-                "email" value >>email
+            drop
 
-                t >>changed?
-
-                drop
-
-                "$login" end-flow
-            ] >>submit
-    ] ;
+            "$login" end-flow
+        ] >>submit ;
 
 ! ! ! Password recovery
 
@@ -250,92 +224,61 @@ SYMBOL: lost-password-from
     '[ , password-email smtp:send-email ]
     "E-mail send thread" spawn drop ;
 
-: <recover-form-1> ( -- form )
-    "register" <form>
-        "recover-1" login-template >>edit-template
-        "username" <username>
-            t >>required
-            add-field
-        "email" <email>
-            t >>required
-            add-field
-        "captcha" <captcha> add-field ;
+: <recover-action-1> ( -- action )
+    <action>
+        [ "recover-1" login-template <html-content> ] >>display
 
-:: <recover-action-1> ( -- action )
-    [let | form [ <recover-form-1> ] |
-        <action>
-            [ blank-values ] >>init
+        [
+            {
+                { "username" [ v-username ] }
+                { "email" [ v-email ] }
+                { "captcha" [ v-captcha ] }
+            } validate-params
+        ] >>validate
 
-            [ form edit-form ] >>display
+        [
+            "email" value "username" value
+            users issue-ticket [
+                send-password-email
+            ] when*
 
-            [
-                blank-values
+            "recover-2" login-template <html-content>
+        ] >>submit ;
 
-                form validate-form
-
-                "email" value "username" value
-                users issue-ticket [
-                    send-password-email
-                ] when*
-
-                "recover-2" login-template serve-template
-            ] >>submit
-    ] ;
-
-: <recover-form-3>
-    "new-password" <form>
-        "recover-3" login-template >>edit-template
-        "username" <username>
-            hidden >>renderer
-            t >>required
-            add-field
-        "new-password" <password>
-            t >>required
-            add-field
-        "verify-password" <password>
-            t >>required
-            add-field
-        "ticket" <string>
-            hidden >>renderer
-            t >>required
-            add-field ;
-
-:: <recover-action-3> ( -- action )
-    [let | form [ <recover-form-3> ] |
-        <action>
-            [
-                { "username" [ v-required ] }
+: <recover-action-3> ( -- action )
+    <action>
+        [
+            {
+                { "username" [ v-username ] }
                 { "ticket" [ v-required ] }
-            ] >>get-params
+            } validate-params
+        ] >>init
 
-            [
-                [
-                    "username" [ get ] keep set
-                    "ticket" [ get ] keep set
-                ] H{ } make-assoc values set
-            ] >>init
+        [ "recover-3" login-template <html-content> ] >>display
 
-            [ <recover-form-3> edit-form ] >>display
+        [
+            {
+                { "username" [ v-username ] }
+                { "ticket" [ v-required ] }
+                { "new-password" [ v-password ] }
+                { "verify-password" [ v-password ] }
+            } validate-params
 
-            [
-                blank-values
+            same-password-twice
+        ] >>validate
 
-                form validate-form
+        [
+            "ticket" value
+            "username" value
+            users claim-ticket [
+                "new-password" value >>encoded-password
+                users update-user
 
-                same-password-twice
-
-                "ticket" value
-                "username" value
-                users claim-ticket [
-                    "new-password" value >>encoded-password
-                    users update-user
-
-                    "recover-4" login-template serve-template
-                ] [
-                    <400>
-                ] if*
-            ] >>submit
-    ] ;
+                "recover-4" login-template <html-content>
+            ] [
+                <400>
+            ] if*
+        ] >>submit ;
 
 ! ! ! Logout
 : <logout-action> ( -- action )
diff --git a/extra/http/server/auth/login/login.xml b/extra/http/server/auth/login/login.xml
index d0a73a4d8b..545d7e0990 100644
--- a/extra/http/server/auth/login/login.xml
+++ b/extra/http/server/auth/login/login.xml
@@ -10,12 +10,12 @@
 
 			<tr>
 				<th class="field-label">User name:</th>
-				<td><t:edit t:component="username" /></td>
+				<td><t:field t:name="username" /></td>
 			</tr>
 
 			<tr>
 				<th class="field-label">Password:</th>
-				<td><t:edit t:component="password" /></td>
+				<td><t:password t:name="password" /></td>
 			</tr>
 
 		</table>
@@ -23,7 +23,7 @@
 		<p>
 
 			<input type="submit" value="Log in" />
-			<t:validation-message />
+			<t:validation-messages />
 
 		</p>
 
diff --git a/extra/http/server/auth/login/recover-1.xml b/extra/http/server/auth/login/recover-1.xml
index 7c72181c10..21fbe6fd39 100644
--- a/extra/http/server/auth/login/recover-1.xml
+++ b/extra/http/server/auth/login/recover-1.xml
@@ -10,25 +10,25 @@
 
 		<table>
 
-		<tr>
-		<th class="field-label">User name:</th>
-		<td><t:edit t:component="username" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">User name:</th>
+				<td><t:field t:name="username" /></td>
+			</tr>
 
-		<tr>
-		<th class="field-label">E-mail:</th>
-		<td><t:edit t:component="email" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">E-mail:</th>
+				<td><t:field t:name="email" /></td>
+			</tr>
 
-		<tr>
-		<th class="field-label">Captcha:</th>
-		<td><t:edit t:component="captcha" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">Captcha:</th>
+				<td><t:field t:name="captcha" /></td>
+			</tr>
 
-		<tr>
-		<td></td>
-		<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to e-mail you will be blocked.</td>
-		</tr>
+			<tr>
+				<td></td>
+				<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to e-mail you will be blocked.</td>
+			</tr>
 
 		</table>
 
diff --git a/extra/http/server/auth/login/recover-3.xml b/extra/http/server/auth/login/recover-3.xml
index 6c60b257a8..2e412d1f18 100644
--- a/extra/http/server/auth/login/recover-3.xml
+++ b/extra/http/server/auth/login/recover-3.xml
@@ -10,29 +10,29 @@
 
 		<table>
 
-			<t:edit t:component="username" />
-			<t:edit t:component="ticket" />
+			<t:hidden t:name="username" />
+			<t:hidden t:name="ticket" />
 
 			<tr>
-			<th class="field-label">Password:</th>
-			<td><t:edit t:component="new-password" /></td>
+				<th class="field-label">Password:</th>
+				<td><t:password t:name="new-password" /></td>
 			</tr>
 
 			<tr>
-			<th class="field-label">Verify password:</th>
-			<td><t:edit t:component="verify-password" /></td>
+				<th class="field-label">Verify password:</th>
+				<td><t:password t:name="verify-password" /></td>
 			</tr>
 
 			<tr>
-			<td></td>
-			<td>Enter your password twice to ensure it is correct.</td>
+				<td></td>
+				<td>Enter your password twice to ensure it is correct.</td>
 			</tr>
 
 		</table>
 
 		<p>
 			<input type="submit" value="Set password" />
-			<t:validation-message />
+			<t:validation-messages />
 		</p>
 
 	</t:form>
diff --git a/extra/http/server/auth/login/register.xml b/extra/http/server/auth/login/register.xml
index 9b45a7f087..4804410dde 100644
--- a/extra/http/server/auth/login/register.xml
+++ b/extra/http/server/auth/login/register.xml
@@ -8,55 +8,55 @@
 
 		<table>
 
-		<tr>
-		<th class="field-label">User name:</th>
-		<td><t:edit t:component="username" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">User name:</th>
+				<td><t:field t:name="username" /></td>
+			</tr>
 
-		<tr>
-		<th class="field-label">Real name:</th>
-		<td><t:edit t:component="realname" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">Real name:</th>
+				<td><t:field t:name="realname" /></td>
+			</tr>
 
-		<tr>
-		<td></td>
-		<td>Specifying a real name is optional.</td>
-		</tr>
+			<tr>
+				<td></td>
+				<td>Specifying a real name is optional.</td>
+			</tr>
 
-		<tr>
-		<th class="field-label">Password:</th>
-		<td><t:edit t:component="new-password" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">Password:</th>
+				<td><t:password t:name="new-password" /></td>
+			</tr>
 
-		<tr>
-		<th class="field-label">Verify:</th>
-		<td><t:edit t:component="verify-password" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">Verify:</th>
+				<td><t:password t:name="verify-password" /></td>
+			</tr>
 
-		<tr>
-		<td></td>
-		<td>Enter your password twice to ensure it is correct.</td>
-		</tr>
+			<tr>
+				<td></td>
+				<td>Enter your password twice to ensure it is correct.</td>
+			</tr>
 
-		<tr>
-		<th class="field-label">E-mail:</th>
-		<td><t:edit t:component="email" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">E-mail:</th>
+				<td><t:field t:name="email" /></td>
+			</tr>
 
-		<tr>
-		<td></td>
-		<td>Specifying an e-mail address is optional. It enables the "recover password" feature.</td>
-		</tr>
+			<tr>
+				<td></td>
+				<td>Specifying an e-mail address is optional. It enables the "recover password" feature.</td>
+			</tr>
 
-		<tr>
-		<th class="field-label">Captcha:</th>
-		<td><t:edit t:component="captcha" /></td>
-		</tr>
+			<tr>
+				<th class="field-label">Captcha:</th>
+				<td><t:field t:name="captcha" /></td>
+			</tr>
 
-		<tr>
-		<td></td>
-		<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
-		</tr>
+			<tr>
+				<td></td>
+				<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
+			</tr>
 
 		</table>
 
diff --git a/extra/http/server/auth/providers/assoc/assoc.factor b/extra/http/server/auth/providers/assoc/assoc.factor
index 54f96480bc..d6ba587aa0 100755
--- a/extra/http/server/auth/providers/assoc/assoc.factor
+++ b/extra/http/server/auth/providers/assoc/assoc.factor
@@ -15,5 +15,5 @@ M: users-in-memory get-user ( username provider -- user/f )
 M: users-in-memory update-user ( user provider -- ) 2drop ;
 
 M: users-in-memory new-user ( user provider -- user/f )
-    >r dup username>> r> assoc>>
-    2dup key? [ 3drop f ] [ pick >r set-at r> ] if ;
+    [ dup username>> ] dip assoc>>
+    2dup key? [ 3drop f ] [ pick [ set-at ] dip ] if ;
diff --git a/extra/http/server/boilerplate/boilerplate.factor b/extra/http/server/boilerplate/boilerplate.factor
index e0a4037e31..96c59edd10 100644
--- a/extra/http/server/boilerplate/boilerplate.factor
+++ b/extra/http/server/boilerplate/boilerplate.factor
@@ -1,73 +1,13 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces boxes sequences strings
-io io.streams.string arrays locals
-html.elements
-http
-http.server
-http.server.sessions
-http.server.templating ;
+USING: accessors kernel namespaces http.server html.templates
+locals ;
 IN: http.server.boilerplate
 
 TUPLE: boilerplate < filter-responder template ;
 
 : <boilerplate> f boilerplate boa ;
 
-SYMBOL: title
-
-: set-title ( string -- )
-    title get >box ;
-
-: write-title ( -- )
-    title get value>> write ;
-
-SYMBOL: style
-
-: add-style ( string -- )
-    "\n" style get push-all
-         style get push-all ;
-
-: write-style ( -- )
-    style get >string write ;
-
-SYMBOL: atom-feed
-
-: set-atom-feed ( title url -- )
-    2array atom-feed get >box ;
-
-: write-atom-feed ( -- )
-    atom-feed get value>> [
-        <link "alternate" =rel "application/atom+xml" =type
-        [ first =title ] [ second =href ] bi
-        link/>
-    ] when* ;
-
-SYMBOL: nested-template?
-
-SYMBOL: next-template
-
-: call-next-template ( -- )
-    next-template get write-html ;
-
-M: f call-template* drop call-next-template ;
-
-: with-boilerplate ( body template -- )
-    [
-        title get [ <box> title set ] unless
-        atom-feed get [ <box> atom-feed set ] unless
-        style get [ SBUF" " clone style set ] unless
-
-        [
-            [
-                nested-template? on
-                write-response-body*
-            ] with-string-writer
-            next-template set
-        ]
-        [ call-template ]
-        bi*
-    ] with-scope ; inline
-
 M:: boilerplate call-responder* ( path responder -- )
     path responder call-next-method
     dup content-type>> "text/html" = [
diff --git a/extra/http/server/callbacks/callbacks.factor b/extra/http/server/callbacks/callbacks.factor
index 5325ee3b55..40ba540ac6 100755
--- a/extra/http/server/callbacks/callbacks.factor
+++ b/extra/http/server/callbacks/callbacks.factor
@@ -90,7 +90,7 @@ SYMBOL: current-show
     [ restore-request store-current-show ] when* ;
 
 : show-final ( quot -- * )
-    >r redirect-to-here store-current-show r>
+    [ redirect-to-here store-current-show ] dip
     call exit-with ; inline
 
 : resuming-callback ( responder request -- id )
@@ -111,7 +111,7 @@ M: callback-responder call-responder* ( path responder -- response )
     ] with-exit-continuation ;
 
 : show-page ( quot -- )
-    >r redirect-to-here store-current-show r>
+    [ redirect-to-here store-current-show ] dip
     [
         [ ] t register-callback swap call exit-with
     ] callcc1 restore-request ; inline
diff --git a/extra/http/server/crud/crud.factor b/extra/http/server/crud/crud.factor
index 28c1b02005..5fb7c15019 100755
--- a/extra/http/server/crud/crud.factor
+++ b/extra/http/server/crud/crud.factor
@@ -1,12 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces db.tuples math.parser
-accessors fry locals hashtables
+accessors fry locals hashtables validators
 http.server
 http.server.actions
 http.server.components
-http.server.forms
-http.server.validators ;
+http.server.forms ;
 IN: http.server.crud
 
 :: <view-action> ( form ctor -- action )
@@ -18,7 +17,7 @@ IN: http.server.crud
         [ form view-form ] >>display ;
 
 : <id-redirect> ( id next -- response )
-    swap number>string "id" associate <standard-redirect> ;
+    swap "id" associate <standard-redirect> ;
 
 :: <edit-action> ( form ctor next -- action )
     <action>
diff --git a/extra/http/server/db/db.factor b/extra/http/server/db/db.factor
index d0bd449457..73d4c35e2c 100755
--- a/extra/http/server/db/db.factor
+++ b/extra/http/server/db/db.factor
@@ -6,7 +6,7 @@ IN: http.server.db
 
 TUPLE: db-persistence < filter-responder pool ;
 
-: <db-persistence> ( responder db params -- responder' )
+: <db-persistence> ( responder params db -- responder' )
     <db-pool> db-persistence boa ;
 
 M: db-persistence call-responder*
diff --git a/extra/http/server/server-tests.factor b/extra/http/server/server-tests.factor
index af27eda527..0aed425ade 100755
--- a/extra/http/server/server-tests.factor
+++ b/extra/http/server/server-tests.factor
@@ -31,7 +31,7 @@ C: <mock-responder> mock-responder
 M: mock-responder call-responder*
     nip
     path>> on
-    "text/plain" <content> ;
+    [ ] <text-content> ;
 
 : check-dispatch ( tag path -- ? )
     H{ } clone base-paths set
@@ -84,7 +84,7 @@ C: <path-check-responder> path-check-responder
 
 M: path-check-responder call-responder*
     drop
-    "text/plain" <content> swap >array >>body ;
+    >array <text-content> ;
 
 [ { "c" } ] [
     H{ } clone base-paths set
@@ -125,7 +125,7 @@ C: <base-path-check-responder> base-path-check-responder
 M: base-path-check-responder call-responder*
     2drop
     "$funny-dispatcher" resolve-base-path
-    "text/plain" <content> swap >>body ;
+    <text-content> ;
 
 [ ] [
     <dispatcher>
diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor
index c1684c4ed2..d68c66b829 100755
--- a/extra/http/server/server.factor
+++ b/extra/http/server/server.factor
@@ -2,9 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs kernel namespaces io io.timeouts strings splitting
 threads sequences prettyprint io.server logging calendar http
-html.streams html.elements accessors math.parser combinators.lib
-tools.vocabs debugger continuations random combinators
-destructors io.encodings.8-bit fry classes words math ;
+html.streams html.elements accessors math.parser
+combinators.lib tools.vocabs debugger continuations random
+combinators destructors io.encodings.8-bit fry classes words
+math rss json.writer ;
 IN: http.server
 
 ! path is a sequence of path component strings
@@ -18,14 +19,27 @@ GENERIC: call-responder* ( path responder -- response )
         { "POST" [ post-data>> ] }
     } case ;
 
-: <content> ( content-type -- response )
+: <content> ( body content-type -- response )
     <response>
         200 >>code
         "Document follows" >>message
-        swap >>content-type ;
+        swap >>content-type
+        swap >>body ;
 
-: <html-content> ( quot -- response )
-    "text/html" <content> swap >>body ;
+: <text-content> ( body -- response )
+    "text/plain" <content> ;
+
+: <html-content> ( body -- response )
+    "text/html" <content> ;
+
+: <xml-content> ( body -- response )
+    "text/xml" <content> ;
+
+: <feed-content> ( feed -- response )
+    '[ , feed>xml ] "text/xml" <content> ;
+
+: <json-content> ( obj -- response )
+    '[ , >json ] "application/json" <content> ;
 
 TUPLE: trivial-responder response ;
 
@@ -86,9 +100,7 @@ SYMBOL: link-hook
 : resolve-base-path ( string -- string' )
     "$" ?head [
         [
-            "/" split1 >r
-            base-path [ "/" % % ] each "/" %
-            r> %
+            "/" split1 [ base-path [ "/" % % ] each "/" % ] dip %
         ] "" make
     ] when ;
 
@@ -115,7 +127,7 @@ SYMBOL: form-hook
     request-url ;
 
 : replace-last-component ( path with -- path' )
-    >r "/" last-split1 drop "/" r> 3append ;
+    [ "/" last-split1 drop "/" ] dip 3append ;
 
 : relative-redirect ( to query -- url )
     request get clone
@@ -128,7 +140,7 @@ SYMBOL: form-hook
     {
         { [ over "http://" head? ] [ link>string ] }
         { [ over "/" head? ] [ absolute-redirect ] }
-        { [ over "$" head? ] [ >r resolve-base-path r> derive-url ] }
+        { [ over "$" head? ] [ [ resolve-base-path ] dip derive-url ] }
         [ relative-redirect ]
     } cond ;
 
@@ -163,7 +175,7 @@ TUPLE: dispatcher default responders ;
         [ nip ] [ drop default>> ] if
     ] [
         over first over responders>> at*
-        [ >r drop rest-slice r> ] [ drop default>> ] if
+        [ [ drop rest-slice ] dip ] [ drop default>> ] if
     ] if ;
 
 M: dispatcher call-responder* ( path dispatcher -- response )
diff --git a/extra/http/server/sessions/sessions-tests.factor b/extra/http/server/sessions/sessions-tests.factor
index 0d98bf2150..8ea312dcb5 100755
--- a/extra/http/server/sessions/sessions-tests.factor
+++ b/extra/http/server/sessions/sessions-tests.factor
@@ -6,7 +6,7 @@ sequences db db.sqlite continuations ;
 
 : with-session
     [
-        >r [ save-session-after ] [ session set ] bi r> call
+        [ [ save-session-after ] [ session set ] bi ] dip call
     ] with-destructors ; inline
 
 TUPLE: foo ;
@@ -18,7 +18,7 @@ M: foo init-session* drop 0 "x" sset ;
 M: foo call-responder*
     2drop
     "x" [ 1+ ] schange
-    "text/html" <content> [ "x" sget pprint ] >>body ;
+    [ "x" sget pprint ] <html-content> ;
 
 : url-responder-mock-test
     [
@@ -44,9 +44,7 @@ M: foo call-responder*
 
 : <exiting-action>
     <action>
-        [
-            "text/plain" <content> exit-with
-        ] >>display ;
+        [ [ ] <text-content> exit-with ] >>display ;
 
 [ "auth-test.db" temp-file sqlite-db delete-file ] ignore-errors
 
diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor
index 2f7a6eb221..8c0e255e21 100755
--- a/extra/http/server/static/static.factor
+++ b/extra/http/server/static/static.factor
@@ -3,7 +3,8 @@
 USING: calendar html io io.files kernel math math.order
 math.parser http http.server namespaces parser sequences strings
 assocs hashtables debugger http.mime sorting html.elements
-logging calendar.format accessors io.encodings.binary fry ;
+html.templates.fhtml logging calendar.format accessors
+io.encodings.binary fry ;
 IN: http.server.static
 
 ! special maps mime types to quots with effect ( path -- )
@@ -60,15 +61,17 @@ TUPLE: file-responder root hook special allow-listings ;
     dup <a =href a> write </a> ;
 
 : directory. ( path -- )
-    dup file-name [
-        [ <h1> file-name write </h1> ]
-        [
-            <ul>
-                directory sort-keys
-                [ <li> file. </li> ] assoc-each
-            </ul>
-        ] bi
-    ] simple-html-document ;
+    [
+        dup file-name [
+            [ <h1> file-name write </h1> ]
+            [
+                <ul>
+                    directory sort-keys
+                    [ <li> file. </li> ] assoc-each
+                </ul>
+            ] bi
+        ] simple-page
+    ] with-html-stream ;
 
 : list-directory ( directory -- response )
     file-responder get allow-listings>> [
@@ -99,3 +102,9 @@ M: file-responder call-responder* ( path responder -- response )
     file-responder set
     ".." over member?
     [ drop <400> ] [ "/" join serve-object ] if ;
+
+! file responder integration
+: enable-fhtml ( responder -- responder )
+    [ <fhtml> <html-content> ]
+    "application/x-factor-server-page"
+    pick special>> set-at ;
diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor
index 3cc1eb567b..04194adb29 100644
--- a/extra/webapps/counter/counter.factor
+++ b/extra/webapps/counter/counter.factor
@@ -1,26 +1,25 @@
-USING: math kernel accessors http.server http.server.actions
-http.server.sessions http.server.templating
-http.server.templating.fhtml locals ;
+USING: math kernel accessors html.components
+http.server http.server.actions
+http.server.sessions html.templates.chloe fry ;
 IN: webapps.counter
 
 SYMBOL: count
 
 TUPLE: counter-app < dispatcher ;
 
-M: counter-app init-session*
-    drop 0 count sset ;
+M: counter-app init-session* drop 0 count sset ;
 
-:: <counter-action> ( quot -- action )
-    <action> [
-        count quot schange
-        "" f <standard-redirect>
-    ] >>display ;
+: <counter-action> ( quot -- action )
+    <action>
+        swap '[ count , schange "" f <standard-redirect> ] >>submit ;
 
 : counter-template ( -- template )
-    "resource:extra/webapps/counter/counter.fhtml" <fhtml> ;
+    "resource:extra/webapps/counter/counter.xml" <chloe> ;
 
 : <display-action> ( -- action )
-    <action> [ counter-template serve-template ] >>display ;
+    <page-action>
+        [ count sget "counter" set-value ] >>init
+        counter-template >>template ;
 
 : <counter-app> ( -- responder )
     counter-app new-dispatcher
diff --git a/extra/webapps/counter/counter.xml b/extra/webapps/counter/counter.xml
new file mode 100644
index 0000000000..75e7cf3c4b
--- /dev/null
+++ b/extra/webapps/counter/counter.xml
@@ -0,0 +1,13 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+
+	<body>
+		<h1><t:label t:name="counter" /></h1>
+
+		<t:button t:action="$counter-app/inc">++</t:button>
+		<t:button t:action="$counter-app/dec">--</t:button>
+	</body>
+
+</t:chloe>
diff --git a/extra/webapps/factor-website/factor-website.factor b/extra/webapps/factor-website/factor-website.factor
index 9b3ce57d02..1fb5d4c1a6 100644
--- a/extra/webapps/factor-website/factor-website.factor
+++ b/extra/webapps/factor-website/factor-website.factor
@@ -1,16 +1,17 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences assocs io.files io.sockets
+io.server
 namespaces db db.sqlite smtp
 http.server
 http.server.db
 http.server.flows
 http.server.sessions
-http.server.auth.admin
 http.server.auth.login
 http.server.auth.providers.db
 http.server.boilerplate
-http.server.templating.chloe
+html.templates.chloe
+webapps.user-admin
 webapps.pastebin
 webapps.planet
 webapps.todo ;
@@ -30,12 +31,13 @@ IN: webapps.factor-website
         init-annotations-table
 
         init-blog-table
+        init-postings-table
 
         init-todo-table
     ] with-db ;
 
 : <factor-website> ( -- responder )
-    <dispatcher>
+    <dispatcher> 
         <todo-list> "todo" add-responder
         <pastebin> "pastebin" add-responder
         <planet-factor> "planet" add-responder
@@ -59,7 +61,7 @@ IN: webapps.factor-website
 
     <factor-website> main-responder set-global ;
 
-: start-factor-website
+: start-factor-website ( -- )
     test-db start-expiring-sessions
-    "planet" main-responder get responders>> at test-db start-update-task
+    test-db start-update-task
     8812 httpd ;
diff --git a/extra/webapps/factor-website/page.css b/extra/webapps/factor-website/page.css
index 55721d7bef..606d574618 100644
--- a/extra/webapps/factor-website/page.css
+++ b/extra/webapps/factor-website/page.css
@@ -21,6 +21,8 @@ a:hover, .link:hover {
 
 .error { color: #a00; }
 
+.errors li { color: #a00; }
+
 .field-label {
 	text-align: right;
 }
@@ -53,3 +55,21 @@ a:hover, .link:hover {
 .description p:last-child {
 	margin-bottom: 0px;
 }
+
+.description table, .description td {
+    border-color: #666;
+    border-style: solid;
+}
+
+.description table {
+    border-width: 0 0 1px 1px;
+    border-spacing: 0;
+    border-collapse: collapse;
+}
+
+.description td {
+    margin: 0;
+    padding: 4px;
+    border-width: 1px 1px 0 0;
+}
+
diff --git a/extra/webapps/pastebin/new-paste.xml b/extra/webapps/pastebin/new-paste.xml
index 86daf09aeb..1abd4d494b 100644
--- a/extra/webapps/pastebin/new-paste.xml
+++ b/extra/webapps/pastebin/new-paste.xml
@@ -7,11 +7,11 @@
 	<t:form t:action="$pastebin/new-paste">
 
 		<table>
-			<tr><th class="field-label">Summary: </th><td><t:edit t:component="summary" /></td></tr>
-			<tr><th class="field-label">Author: </th><td><t:edit t:component="author" /></td></tr>
-			<tr><th class="field-label">Mode: </th><td><t:edit t:component="mode" /></td></tr>
-			<tr><th class="field-label big-field-label">Description: </th><td><t:edit t:component="contents" /></td></tr>
-			<tr><th class="field-label">Captcha: </th><td><t:edit t:component="captcha" /></td></tr>
+			<tr><th class="field-label">Summary: </th><td><t:field t:name="summary" /></td></tr>
+			<tr><th class="field-label">Author: </th><td><t:field t:name="author" /></td></tr>
+			<tr><th class="field-label">Mode: </th><td><t:choice t:name="mode" t:choices="modes" /></td></tr>
+			<tr><th class="field-label big-field-label">Description: </th><td><t:textarea t:name="contents" /></td></tr>
+			<tr><th class="field-label">Captcha: </th><td><t:captcha t:name="captcha" /></td></tr>
 			<tr>
 			<td></td>
 			<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
diff --git a/extra/webapps/pastebin/paste.xml b/extra/webapps/pastebin/paste.xml
index 9141ee4ef1..1f65ff6765 100644
--- a/extra/webapps/pastebin/paste.xml
+++ b/extra/webapps/pastebin/paste.xml
@@ -2,19 +2,59 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:title>Paste: <t:view t:component="summary" /></t:title>
+	<t:atom t:title="Paste - Atom" t:href="$pastebin/paste.atom" t:query="id" />
+
+	<t:title>Paste: <t:label t:name="summary" /></t:title>
 
 	<table>
-		<tr><th class="field-label">Author:  </th><td><t:view t:component="author"  /></td></tr>
-		<tr><th class="field-label">Mode:    </th><td><t:view t:component="mode"    /></td></tr>
-		<tr><th class="field-label">Date:    </th><td><t:view t:component="date"    /></td></tr>
+		<tr><th class="field-label">Author: </th><td><t:label t:name="author" /></td></tr>
+		<tr><th class="field-label">Mode: </th><td><t:label t:name="mode" /></td></tr>
+		<tr><th class="field-label">Date: </th><td><t:label t:name="date" /></td></tr>
 	</table>
 
-	<pre class="description"><t:view t:component="contents" /></pre>
+	<pre class="description"><t:code t:name="contents" t:mode="modes" /></pre>
 
 	<t:button t:action="$pastebin/delete-paste" t:for="id" class="link-button link">Delete Paste</t:button>
 	|
 	<t:a t:href="$pastebin/annotate" t:query="id">Annotate</t:a>
 
-	<t:view t:component="annotations" />
+	<t:each-tuple t:values="annotations">
+
+		<h2>Annotation: <t:label t:name="summary" /></h2>
+
+		<table>
+			<tr><th class="field-label">Author: </th><td><t:label t:name="author" /></td></tr>
+			<tr><th class="field-label">Mode: </th><td><t:label t:name="mode" /></td></tr>
+			<tr><th class="field-label">Date: </th><td><t:label t:name="date" /></td></tr>
+		</table>
+
+		<pre class="description"><t:code t:name="contents" t:mode="mode"/></pre>
+
+		<t:button t:action="$pastebin/delete-annotation" t:for="aid" class="link-button link">Delete Annotation</t:button>
+
+	</t:each-tuple>
+
+	<t:bind-assoc t:name="new-annotation">
+
+		<h2>New Annotation</h2>
+
+		<t:form t:action="$pastebin/new-annotation" t:for="id">
+
+			<table>
+				<tr><th class="field-label">Summary: </th><td><t:field t:name="summary" /></td></tr>
+				<tr><th class="field-label">Author: </th><td><t:field t:name="author" /></td></tr>
+				<tr><th class="field-label">Mode: </th><td><t:choice t:name="mode" t:choices="modes" /></td></tr>
+				<tr><th class="field-label big-field-label">Description:</th><td><t:textarea t:name="contents" /></td></tr>
+				<tr><th class="field-label">Captcha: </th><td><t:captcha t:name="captcha" /></td></tr>
+				<tr>
+				<td></td>
+				<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
+				</tr>
+			</table>
+
+			<input type="SUBMIT" value="Done" />
+		</t:form>
+
+	</t:bind-assoc>
+
 </t:chloe>
diff --git a/extra/webapps/pastebin/pastebin-common.xml b/extra/webapps/pastebin/pastebin-common.xml
index b99cf28753..f785fceb6b 100644
--- a/extra/webapps/pastebin/pastebin-common.xml
+++ b/extra/webapps/pastebin/pastebin-common.xml
@@ -2,15 +2,12 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:atom t:title="Pastebin - Atom" t:href="$pastebin/feed.xml" />
-
 	<t:style t:include="resource:extra/webapps/pastebin/pastebin.css" />
 
 	<div class="navbar">
 
 		  <t:a t:href="$pastebin/list">Pastes</t:a>
 		| <t:a t:href="$pastebin/new-paste">New Paste</t:a>
-		| <t:a t:href="$pastebin/feed.xml">Atom Feed</t:a>
 
 		<t:if t:code="http.server.sessions:uid">
 
diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor
index 273b250695..0772181b00 100644
--- a/extra/webapps/pastebin/pastebin.factor
+++ b/extra/webapps/pastebin/pastebin.factor
@@ -1,46 +1,40 @@
+! Copyright (C) 2007, 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces assocs sorting sequences kernel accessors
-hashtables sequences.lib locals db.types db.tuples db
-calendar calendar.format rss xml.writer
-xmode.catalog
+hashtables sequences.lib db.types db.tuples db
+calendar calendar.format math.parser rss xml.writer
+xmode.catalog validators html.components html.templates.chloe
 http.server
-http.server.crud
 http.server.actions
-http.server.components
-http.server.components.code
-http.server.templating.chloe
 http.server.auth
 http.server.auth.login
-http.server.boilerplate
-http.server.validators
-http.server.forms ;
+http.server.boilerplate ;
 IN: webapps.pastebin
 
-: <mode> ( id -- component )
-    modes keys natural-sort <choice> ;
+! ! !
+! DOMAIN MODEL
+! ! !
 
-: pastebin-template ( name -- template )
-    "resource:extra/webapps/pastebin/" swap ".xml" 3append <chloe> ;
+TUPLE: paste id summary author mode date contents annotations ;
 
-TUPLE: paste id summary author mode date contents annotations captcha ;
-
-paste "PASTE"
+\ paste "PASTE"
 {
     { "id" "ID" INTEGER +db-assigned-id+ }
     { "summary" "SUMMARY" { VARCHAR 256 } +not-null+ }
     { "author" "AUTHOR" { VARCHAR 256 } +not-null+ }
     { "mode" "MODE" { VARCHAR 256 } +not-null+ }
-    { "date" "DATE" DATETIME +not-null+ }
+    { "date" "DATE" DATETIME +not-null+ , }
     { "contents" "CONTENTS" TEXT +not-null+ }
 } define-persistent
 
 : <paste> ( id -- paste )
-    paste new
+    \ paste new
         swap >>id ;
 
 : pastes ( -- pastes )
     f <paste> select-tuples ;
 
-TUPLE: annotation aid id summary author mode contents date captcha ;
+TUPLE: annotation aid id summary author mode contents date ;
 
 annotation "ANNOTATION"
 {
@@ -63,175 +57,165 @@ annotation "ANNOTATION"
         dup id>> f <annotation> select-tuples >>annotations
     ] unless ;
 
-: <annotation-form> ( -- form )
-    "annotation" <form>
-        "annotation" pastebin-template >>view-template
-        "id" <integer>
-            hidden >>renderer
-            add-field
-        "aid" <integer>
-            hidden >>renderer
-            add-field
-        "summary" <string> add-field
-        "author" <string> add-field
-        "mode" <mode> add-field
-        "contents" "mode" <code> add-field
-        "date" <date> add-field ;
+: paste ( id -- paste )
+    <paste> select-tuple fetch-annotations ;
 
-: <new-annotation-form> ( -- form )
-    "annotation" <form>
-        "new-annotation" pastebin-template >>edit-template
-        "id" <integer>
-            hidden >>renderer
-            t >>required add-field
-        "summary" <string>
-            t >>required add-field
-        "author" <string>
-            t >>required
-            add-field
-        "mode" <mode>
-            "factor" >>default
-            t >>required
-            add-field
-        "contents" "mode" <code>
-            t >>required add-field
-        "captcha" <captcha> add-field ;
+: <id-redirect> ( id next -- response )
+    swap "id" associate <standard-redirect> ;
 
-: <paste-form> ( -- form )
-    "paste" <form>
-        "paste" pastebin-template >>view-template
-        "paste-summary" pastebin-template >>summary-template
-        "id" <integer>
-            hidden >>renderer add-field
-        "summary" <string> add-field
-        "author" <string> add-field
-        "mode" <mode> add-field
-        "date" <date> add-field
-        "contents" "mode" <code> add-field
-        "annotations" <annotation-form> +plain+ <list> add-field ;
+! ! !
+! LINKS, ETC
+! ! !
 
-: <new-paste-form> ( -- form )
-    "paste" <form>
-        "new-paste" pastebin-template >>edit-template
-        "summary" <string>
-            t >>required add-field
-        "author" <string>
-            t >>required add-field
-        "mode" <mode>
-            "factor" >>default
-            t >>required
-            add-field
-        "contents" "mode" <code>
-            t >>required add-field
-        "captcha" <captcha> add-field ;
+: pastebin-link ( -- url )
+    "$pastebin/list" f link>string ;
 
-: <paste-list-form> ( -- form )
-    "pastebin" <form>
-        "paste-list" pastebin-template >>view-template
-        "pastes" <paste-form> +plain+ <list> add-field ;
+GENERIC: entity-link ( entity -- url )
 
-:: <paste-list-action> ( -- action )
-    [let | form [ <paste-list-form> ] |
-        <action>
-            [
-                blank-values
+M: paste entity-link
+    id>> "id" associate "$pastebin/paste" swap link>string ;
 
-                pastes "pastes" set-value
+M: annotation entity-link
+    [ id>> "id" associate "$pastebin/paste" swap link>string ]
+    [ aid>> number>string "#" prepend ] bi
+    append ;
 
-                form view-form
-            ] >>display
-    ] ;
+: pastebin-template ( name -- template )
+    "resource:extra/webapps/pastebin/" swap ".xml" 3append <chloe> ;
 
-:: <annotate-action> ( form ctor next -- action )
-    <action>
-        { { "id" [ v-number ] } } >>get-params
+! ! !
+! PASTE LIST
+! ! !
 
-        [
-            "id" get f ctor call
+: <pastebin-action> ( -- action )
+    <page-action>
+        [ pastes "pastes" set-value ] >>init
+        "pastebin" pastebin-template >>template ;
 
-            from-tuple form set-defaults
-        ] >>init
-
-        [ form edit-form ] >>display
-
-        [
-            f f ctor call from-tuple
-
-            form validate-form
-
-            values-tuple insert-tuple
-
-            "id" value next <id-redirect>
-        ] >>submit ;
-
-: pastebin-feed-entries ( -- entries )
-    pastes <reversed> 20 short head [
-        [ summary>> ]
-        [ "$pastebin/view-paste" swap id>> "id" associate link>string ]
-        [ date>> ] tri
-        f swap <entry>
+: pastebin-feed-entries ( seq -- entries )
+    <reversed> 20 short head [
+        entry new
+            swap
+            [ summary>> >>title ]
+            [ date>> >>pub-date ]
+            [ entity-link >>link ]
+            tri
     ] map ;
 
 : pastebin-feed ( -- feed )
     feed new
         "Factor Pastebin" >>title
-        "http://paste.factorcode.org" >>link
-        pastebin-feed-entries >>entries ;
+        pastebin-link >>link
+        pastes pastebin-feed-entries >>entries ;
 
-: <feed-action> ( -- action )
-    <action>
+: <pastebin-feed-action> ( -- action )
+    <feed-action> [ pastebin-feed ] >>feed ;
+
+! ! !
+! PASTES
+! ! !
+
+: <paste-action> ( -- action )
+    <page-action>
         [
-            "text/xml" <content>
-            [ pastebin-feed feed>xml write-xml ] >>body
-        ] >>display ;
+            validate-integer-id
+            "id" value paste from-tuple
 
-:: <view-paste-action> ( form ctor -- action )
-    <action>
-        { { "id" [ v-number ] } } >>get-params
-
-        [ "id" get ctor call select-tuple fetch-annotations from-tuple ] >>init
-
-        [ form view-form ] >>display ;
-
-:: <delete-paste-action> ( ctor next -- action )
-    <action>
-        { { "id" [ v-number ] } } >>post-params
-
-        [
-            "id" get ctor call delete-tuples
-
-            "id" get f <annotation> delete-tuples
-
-            next f <permanent-redirect>
-        ] >>submit ;
-
-:: <delete-annotation-action> ( ctor next -- action )
-    <action>
-        { { "aid" [ v-number ] } } >>post-params
-
-        [
-            f "aid" get ctor call select-tuple
-            [ delete-tuples ] [ id>> next <id-redirect> ] bi
-        ] >>submit ;
-
-:: <new-paste-action> ( form ctor next -- action )
-    <action>
-        [
-            f ctor call from-tuple
-
-            form set-defaults
+            "new-annotation" [
+                mode-names "modes" set-value
+                "factor" "mode" set-value
+            ] nest-values
         ] >>init
 
-        [ form edit-form ] >>display
+        "paste" pastebin-template >>template ;
+
+: paste-feed-entries ( paste -- entries )
+    fetch-annotations annotations>> pastebin-feed-entries ;
+
+: paste-feed ( paste -- feed )
+    feed new
+        swap
+        [ "Paste #" swap id>> number>string append >>title ]
+        [ entity-link >>link ]
+        [ paste-feed-entries >>entries ]
+        tri ;
+
+: <paste-feed-action> ( -- action )
+    <feed-action>
+        [ validate-integer-id ] >>init
+        [ "id" value paste annotations>> paste-feed ] >>feed ;
+
+: <new-paste-action> ( -- action )
+    <page-action>
+        [
+            "factor" "mode" set-value
+            mode-names "modes" set-value
+        ] >>init
+
+        "new-paste" pastebin-template >>template
 
         [
-            f ctor call from-tuple
+            {
+                { "summary" [ v-one-line ] }
+                { "author" [ v-one-line ] }
+                { "mode" [ v-mode ] }
+                { "contents" [ v-required ] }
+                { "captcha" [ v-captcha ] }
+            } validate-params
 
-            form validate-form
+            f <paste>
+                now >>date
+                dup { "summary" "author" "mode" "contents" } deposit-slots
+            [ insert-tuple ]
+            [ id>> "$pastebin/paste" <id-redirect> ] bi
+        ] >>submit ;
 
-            values-tuple insert-tuple
+: <delete-paste-action> ( -- action )
+    <action>
+        [ validate-integer-id ] >>validate
 
-            "id" value next <id-redirect>
+        [
+            "id" value <paste> delete-tuples
+            "id" value f <annotation> delete-tuples
+            "$pastebin/list" f <permanent-redirect>
+        ] >>submit ;
+
+! ! !
+! ANNOTATIONS
+! ! !
+
+: <new-annotation-action> ( -- action )
+    <action>
+        [
+            {
+                { "summary" [ v-one-line ] }
+                { "author" [ v-one-line ] }
+                { "mode" [ v-mode ] }
+                { "contents" [ v-required ] }
+                { "captcha" [ v-captcha ] }
+            } validate-params
+        ] >>validate
+
+        [
+            f f <annotation>
+                now >>date
+                dup { "summary" "author" "mode" "contents" } deposit-slots
+            [ insert-tuple ]
+            [
+                ! Add anchor here
+                "id" value "$pastebin/paste" <id-redirect>
+            ] bi
+        ] >>submit ;
+
+: <delete-annotation-action> ( -- action )
+    <action>
+        [ { { "aid" [ v-number ] } } validate-params ] >>validate
+
+        [
+            f "aid" value <annotation> select-tuple
+            [ delete-tuples ]
+            [ id>> "$pastebin/paste" <id-redirect> ]
+            bi
         ] >>submit ;
 
 TUPLE: pastebin < dispatcher ;
@@ -242,17 +226,17 @@ can-delete-pastes? define-capability
 
 : <pastebin> ( -- responder )
     pastebin new-dispatcher
-        <paste-list-action> "list" add-main-responder
-        <feed-action> "feed.xml" add-responder
-        <paste-form> [ <paste> ] <view-paste-action> "view-paste" add-responder
-        [ <paste> ] "$pastebin/list" <delete-paste-action> { can-delete-pastes? } <protected> "delete-paste" add-responder
-        [ <annotation> ] "$pastebin/view-paste" <delete-annotation-action> { can-delete-pastes? } <protected> "delete-annotation" add-responder
-        <paste-form> [ <paste> ]    <view-paste-action>     "$pastebin/view-paste"   add-responder
-        <new-paste-form> [ <paste> now >>date ] "$pastebin/view-paste" <new-paste-action>     "new-paste"    add-responder
-        <new-annotation-form> [ <annotation> now >>date ] "$pastebin/view-paste" <annotate-action> "annotate" add-responder
+        <pastebin-action> "list" add-main-responder
+        <pastebin-feed-action> "list.atom" add-responder
+        <paste-action> "paste" add-responder
+        <paste-feed-action> "paste.atom" add-responder
+        <new-paste-action> "new-paste" add-responder
+        <delete-paste-action> { can-delete-pastes? } <protected> "delete-paste" add-responder
+        <new-annotation-action> "new-annotation" add-responder
+        <delete-annotation-action> { can-delete-pastes? } <protected> "delete-annotation" add-responder
     <boilerplate>
-        "pastebin" pastebin-template >>template ;
+        "pastebin-common" pastebin-template >>template ;
 
-: init-pastes-table paste ensure-table ;
+: init-pastes-table \ paste ensure-table ;
 
 : init-annotations-table annotation ensure-table ;
diff --git a/extra/webapps/pastebin/pastebin.xml b/extra/webapps/pastebin/pastebin.xml
index 46604598ce..f0abd97c63 100644
--- a/extra/webapps/pastebin/pastebin.xml
+++ b/extra/webapps/pastebin/pastebin.xml
@@ -2,6 +2,8 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
+	<t:atom t:title="Pastebin - Atom" t:href="$pastebin/list.atom" />
+
 	<t:title>Pastebin</t:title>
 
 	<table width="100%">
diff --git a/extra/webapps/planet/admin.xml b/extra/webapps/planet/admin.xml
index c79fe2efd1..4711ca4716 100644
--- a/extra/webapps/planet/admin.xml
+++ b/extra/webapps/planet/admin.xml
@@ -4,11 +4,19 @@
 
 	<t:title>Planet Factor Administration</t:title>
 
-	<t:summary t:component="blogroll" />
+	<ul>
+		<t:each-tuple t:values="blogroll">
+			<li>
+				<t:a t:href="$planet-factor/admin/edit-blog" t:query="id">
+					<t:label t:name="name" />
+				</t:a>
+			</li>
+		</t:each-tuple>
+	</ul>
 
 	<p>
-		<t:a t:href="$planet-factor/admin/edit-blog">Add Blog</t:a>
-		| <t:a t:href="$planet-factor/admin/update">Update</t:a>
+		<t:a t:href="$planet-factor/admin/new-blog">Add Blog</t:a>
+		| <t:button t:action="$planet-factor/admin/update" class="link-button link">Update</t:button>
 	</p>
 
 </t:chloe>
diff --git a/extra/webapps/planet/edit-blog.xml b/extra/webapps/planet/edit-blog.xml
index ebfccc47de..fd9c659f59 100644
--- a/extra/webapps/planet/edit-blog.xml
+++ b/extra/webapps/planet/edit-blog.xml
@@ -10,17 +10,17 @@
 
 			<tr>
 				<th class="field-label">Blog name:</th>
-				<td><t:edit t:component="name" /></td>
+				<td><t:field t:name="name" /></td>
 			</tr>
 
 			<tr>
 				<th class="field-label">Home page:</th>
-				<td><t:edit t:component="www-url" /></td>
+				<td><t:field t:name="www-url" /></td>
 			</tr>
 
 			<tr>
 				<th class="field-label">Feed:</th>
-				<td><t:edit t:component="feed-url" /></td>
+				<td><t:field t:name="feed-url" /></td>
 			</tr>
 
 		</table>
@@ -30,4 +30,5 @@
 	</t:form>
 
 	<t:button t:action="$planet-factor/admin/delete-blog" t:for="id" class="link-button link">Delete</t:button>
+
 </t:chloe>
diff --git a/extra/webapps/planet/mini-planet.xml b/extra/webapps/planet/mini-planet.xml
new file mode 100644
index 0000000000..1338463bcf
--- /dev/null
+++ b/extra/webapps/planet/mini-planet.xml
@@ -0,0 +1,14 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:each-tuple t:values="postings">
+
+		<p class="news">
+			<strong><t:view t:component="title" /></strong> <br/>
+			<t:a value="link" t:session="none" class="more">Read More...</t:a>
+		</p>
+
+	</t:each-tuple>
+
+</t:chloe>
diff --git a/extra/webapps/planet/new-blog.xml b/extra/webapps/planet/new-blog.xml
new file mode 100644
index 0000000000..4a9638da03
--- /dev/null
+++ b/extra/webapps/planet/new-blog.xml
@@ -0,0 +1,32 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>Edit Blog</t:title>
+
+	<t:form t:action="$planet-factor/admin/new-blog">
+
+		<table>
+
+			<tr>
+				<th class="field-label">Blog name:</th>
+				<td><t:field t:name="name" /></td>
+			</tr>
+
+			<tr>
+				<th class="field-label">Home page:</th>
+				<td><t:field t:name="www-url" /></td>
+			</tr>
+
+			<tr>
+				<th class="field-label">Feed:</th>
+				<td><t:field t:name="feed-url" /></td>
+			</tr>
+
+		</table>
+
+		<input type="SUBMIT" value="Done" />
+
+	</t:form>
+
+</t:chloe>
diff --git a/extra/webapps/planet/planet-common.xml b/extra/webapps/planet/planet-common.xml
new file mode 100644
index 0000000000..29609e12ba
--- /dev/null
+++ b/extra/webapps/planet/planet-common.xml
@@ -0,0 +1,25 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:style t:include="resource:extra/webapps/planet/planet.css" />
+
+	<div class="navbar">
+		  <t:a t:href="$planet-factor/list">Front Page</t:a>
+		| <t:a t:href="$planet-factor/feed.xml">Atom Feed</t:a>
+		| <t:a t:href="$planet-factor/admin">Admin</t:a>
+
+		<t:if t:code="http.server.sessions:uid">
+			<t:if t:code="http.server.auth.login:allow-edit-profile?">
+				| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
+			</t:if>
+	
+			| <t:button t:action="$login/logout" t:flow="begin" class="link-button link">Logout</t:button>
+		</t:if>
+	</div>
+
+	<h1><t:write-title /></h1>
+
+        <t:call-next-template />
+
+</t:chloe>
diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor
index c8aeab35a8..e3b5b17a32 100755
--- a/extra/webapps/planet/planet.factor
+++ b/extra/webapps/planet/planet.factor
@@ -1,22 +1,18 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences sorting locals math math.order
+USING: kernel accessors sequences sorting math math.order
 calendar alarms logging concurrency.combinators namespaces
-sequences.lib db.types db.tuples db fry
+sequences.lib db.types db.tuples db fry locals hashtables
+html.components html.templates.chloe
 rss xml.writer
+validators
 http.server
-http.server.crud
-http.server.forms
 http.server.actions
 http.server.boilerplate
-http.server.templating.chloe
-http.server.components
 http.server.auth.login
 http.server.auth ;
 IN: webapps.planet
 
-TUPLE: planet-factor < dispatcher postings ;
-
 : planet-template ( name -- template )
     "resource:extra/webapps/planet/" swap ".xml" 3append <chloe> ;
 
@@ -34,92 +30,63 @@ blog "BLOGS"
     { "feed-url" "FEEDURL" { VARCHAR 256 } +not-null+ }
 } define-persistent
 
+! TUPLE: posting < entry id ;
+TUPLE: posting id title link description pub-date ;
+
+posting "POSTINGS"
+{
+    { "id" "ID" INTEGER +db-assigned-id+ }
+    { "title" "TITLE" { VARCHAR 256 } +not-null+ }
+    { "link" "LINK" { VARCHAR 256 } +not-null+ }
+    { "description" "DESCRIPTION" TEXT +not-null+ }
+    { "pub-date" "DATE" TIMESTAMP +not-null+ }
+} define-persistent
+
 : init-blog-table blog ensure-table ;
 
+: init-postings-table posting ensure-table ;
+
 : <blog> ( id -- todo )
     blog new
         swap >>id ;
 
 : blogroll ( -- seq )
-    f <blog> select-tuples [ [ name>> ] compare ] sort ;
+    f <blog> select-tuples
+    [ [ name>> ] compare ] sort ;
 
-: <entry-form> ( -- form )
-    "entry" <form>
-        "entry" planet-template >>view-template
-        "entry-summary" planet-template >>summary-template
-        "title" <string> add-field
-        "description" <html-text> add-field
-        "pub-date" <date> add-field ;
+: postings ( -- seq )
+    posting new select-tuples
+    [ [ pub-date>> ] compare invert-comparison ] sort ;
 
-: <blog-form> ( -- form )
-    "blog" <form>
-        "edit-blog" planet-template >>edit-template
-        "blog-admin-link" planet-template >>summary-template
-        "id" <integer>
-            hidden >>renderer
-            add-field
-        "name" <string>
-            t >>required
-            add-field
-        "www-url" <url>
-            t >>required
-            add-field
-        "feed-url" <url>
-            t >>required
-            add-field ;
+: <edit-blogroll-action> ( -- action )
+    <page-action>
+        [ blogroll "blogroll" set-value ] >>init
+        "admin" planet-template >>template ;
 
-: <planet-factor-form> ( -- form )
-    "planet-factor" <form>
-        "postings" planet-template >>view-template
-        "postings-summary" planet-template >>summary-template
-        "postings" <entry-form> +plain+ <list> add-field
-        "blogroll" "blog" <link> +unordered+ <list> add-field ;
+: <planet-action> ( -- action )
+    <page-action>
+        [
+            blogroll "blogroll" set-value
+            postings "postings" set-value
+        ] >>init
 
-: <admin-form> ( -- form )
-    "admin" <form>
-        "admin" planet-template >>view-template
-        "blogroll" <blog-form> +unordered+ <list> add-field ;
+        "planet" planet-template >>template ;
 
-:: <edit-blogroll-action> ( planet -- action )
-    [let | form [ <admin-form> ] |
-        <action>
-            [
-                blank-values
-
-                blogroll "blogroll" set-value
-
-                form view-form
-            ] >>display
-    ] ;
-
-:: <planet-action> ( planet -- action )
-    [let | form [ <planet-factor-form> ] |
-        <action>
-            [
-                blank-values
-
-                planet postings>> "postings" set-value
-                blogroll "blogroll" set-value
-
-                form view-form
-            ] >>display
-    ] ;
-
-:: planet-feed ( planet -- feed )
+: planet-feed ( -- feed )
     feed new
         "Planet Factor" >>title
         "http://planet.factorcode.org" >>link
-        planet postings>> 16 short head >>entries ;
+        postings >>entries ;
 
-:: <feed-action> ( planet -- action )
-    <action>
-        [
-            "text/xml" <content>
-            [ planet planet-feed feed>xml write-xml ] >>body
-        ] >>display ;
+: <planet-feed-action> ( -- action )
+    <feed-action> [ planet-feed ] >>feed ;
 
-: <posting> ( name entry -- entry' )
-    clone [ ": " swap 3append ] change-title ;
+:: <posting> ( entry name -- entry' )
+    posting new
+        name ": " entry title>> 3append >>title
+        entry link>> >>link
+        entry description>> >>description
+        entry pub-date>> >>pub-date ;
 
 : fetch-feed ( url -- feed )
     download-feed entries>> ;
@@ -127,55 +94,101 @@ blog "BLOGS"
 \ fetch-feed DEBUG add-error-logging
 
 : fetch-blogroll ( blogroll -- entries )
-    dup
-    [ feed-url>> fetch-feed ] parallel-map
-    [ >r name>> r> [ <posting> ] with map ] 2map concat ;
+    [ [ feed-url>> fetch-feed ] parallel-map ] [ [ name>> ] map ] bi
+    [ '[ , <posting> ] map ] 2map concat ;
 
 : sort-entries ( entries -- entries' )
-    [ [ pub-date>> ] compare ] sort <reversed> ;
+    [ [ pub-date>> ] compare invert-comparison ] sort ;
 
-: update-cached-postings ( planet -- )
-    "webapps.planet" [
-        blogroll fetch-blogroll sort-entries 8 short head
-        >>postings drop
-    ] with-logging ;
+: update-cached-postings ( -- )
+    blogroll fetch-blogroll sort-entries 8 short head [
+        posting new delete-tuples
+        [ insert-tuple ] each
+    ] with-transaction ;
 
-:: <update-action> ( planet -- action )
+: <update-action> ( -- action )
     <action>
         [
-            planet update-cached-postings
-            "" f <temporary-redirect>
-        ] >>display ;
+            update-cached-postings
+            "" f <permanent-redirect>
+        ] >>submit ;
 
-:: <planet-factor-admin> ( planet-factor -- responder )
-    [let | blog-form [ <blog-form> ]
-           blog-ctor [ [ <blog> ] ] |
-        <dispatcher>
-            planet-factor <edit-blogroll-action> >>default
+: <delete-blog-action> ( -- action )
+    <action>
+        [ validate-integer-id ] >>validate
 
-            planet-factor <update-action> "update" add-responder
+        [
+            "id" value <blog> delete-tuples
+            "$planet-factor/admin" f <standard-redirect>
+        ] >>submit ;
 
-            ! Administrative CRUD
-                      blog-ctor "$planet-factor/admin"          <delete-action> "delete-blog" add-responder
-            blog-form blog-ctor "$planet-factor/admin" <edit-action>   "edit-blog"   add-responder
-    ] ;
+: validate-blog ( -- )
+    {
+        { "name" [ v-one-line ] }
+        { "www-url" [ v-url ] }
+        { "feed-url" [ v-url ] }
+    } validate-params ;
+
+: <id-redirect> ( id next -- response )
+    swap "id" associate <standard-redirect> ;
+
+: <new-blog-action> ( -- action )
+    <page-action>
+        "new-blog" planet-template >>template
+
+        [ validate-blog ] >>validate
+
+        [
+            f <blog>
+                dup { "name" "www-url" "feed-url" } deposit-slots
+            [ insert-tuple ]
+            [ id>> "$planet-factor/admin/edit-blog" <id-redirect> ] bi
+        ] >>submit ;
+    
+: <edit-blog-action> ( -- action )
+    <page-action>
+        [
+            validate-integer-id
+            "id" value <blog> select-tuple from-tuple
+        ] >>init
+
+        "edit-blog" planet-template >>template
+
+        [
+            validate-integer-id
+            validate-blog
+        ] >>validate
+
+        [
+            f <blog>
+                dup { "id" "name" "www-url" "feed-url" } deposit-slots
+            [ update-tuple ]
+            [ id>> "$planet-factor/admin" <id-redirect> ] bi
+        ] >>submit ;
+
+TUPLE: planet-factor-admin < dispatcher ;
+
+: <planet-factor-admin> ( -- responder )
+    planet-factor-admin new-dispatcher
+        <edit-blogroll-action> "blogroll" add-main-responder
+        <update-action> "update" add-responder
+        <new-blog-action> "new-blog" add-responder
+        <edit-blog-action> "edit-blog" add-responder
+        <delete-blog-action> "delete-blog" add-responder ;
 
 SYMBOL: can-administer-planet-factor?
 
 can-administer-planet-factor? define-capability
 
+TUPLE: planet-factor < dispatcher ;
+
 : <planet-factor> ( -- responder )
     planet-factor new-dispatcher
-        dup <planet-action> "list" add-main-responder
-        dup <feed-action> "feed.xml" add-responder
-        dup <planet-factor-admin> { can-administer-planet-factor? } <protected> "admin" add-responder
+        <planet-action> "list" add-main-responder
+        <feed-action> "feed.xml" add-responder
+        <planet-factor-admin> { can-administer-planet-factor? } <protected> "admin" add-responder
     <boilerplate>
-        "planet" planet-template >>template ;
+        "planet-common" planet-template >>template ;
 
-: start-update-task ( planet db seq -- )
-    '[
-        , , , [
-            dup filter-responder? [ responder>> ] when
-            update-cached-postings
-        ] with-db
-    ] 10 minutes every drop ;
+: start-update-task ( db params -- )
+    '[ , , [ update-cached-postings ] with-db ] 10 minutes every drop ;
diff --git a/extra/webapps/planet/planet.xml b/extra/webapps/planet/planet.xml
index 29609e12ba..526a9b306b 100644
--- a/extra/webapps/planet/planet.xml
+++ b/extra/webapps/planet/planet.xml
@@ -2,24 +2,44 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:style t:include="resource:extra/webapps/planet/planet.css" />
+	<t:title>Planet Factor</t:title>
 
-	<div class="navbar">
-		  <t:a t:href="$planet-factor/list">Front Page</t:a>
-		| <t:a t:href="$planet-factor/feed.xml">Atom Feed</t:a>
-		| <t:a t:href="$planet-factor/admin">Admin</t:a>
+	<table width="100%" cellpadding="10">
+		<tr>
+			<td>
 
-		<t:if t:code="http.server.sessions:uid">
-			<t:if t:code="http.server.auth.login:allow-edit-profile?">
-				| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
-			</t:if>
-	
-			| <t:button t:action="$login/logout" t:flow="begin" class="link-button link">Logout</t:button>
-		</t:if>
-	</div>
+				<t:each-tuple t:values="postings">
 
-	<h1><t:write-title /></h1>
+					<h2 class="posting-title">
+						<t:a t:value="link" t:session="none"><t:label t:name="title" /></t:a>
+					</h2>
 
-        <t:call-next-template />
+					<p class="posting-body">
+						<t:html t:name="description" />
+					</p>
+
+					<p class="posting-date">
+						<t:a t:value="link" t:session="none"><t:label t:name="pub-date" /></t:a>
+					</p>
+
+				</t:each-tuple>
+
+			</td>
+
+			<td valign="top" width="25%" class="infobox">
+
+				<h2>Blogroll</h2>
+
+				<ul>
+					<t:each t:values="blogroll">
+						<li>
+							<t:link t:name="value"/>
+						</li>
+					</t:each>
+				</ul>
+
+			</td>
+		</tr>
+	</table>
 
 </t:chloe>
diff --git a/extra/webapps/planet/postings-summary.xml b/extra/webapps/planet/postings-summary.xml
deleted file mode 100644
index 765c3a8006..0000000000
--- a/extra/webapps/planet/postings-summary.xml
+++ /dev/null
@@ -1,7 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<t:summary t:component="postings" />
-
-</t:chloe>
diff --git a/extra/webapps/planet/postings.xml b/extra/webapps/planet/postings.xml
deleted file mode 100644
index c2c73d7e89..0000000000
--- a/extra/webapps/planet/postings.xml
+++ /dev/null
@@ -1,19 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<t:title>Planet Factor</t:title>
-
-	<table width="100%" cellpadding="10">
-                <tr>
-                        <td> <t:view t:component="postings" /> </td>
-  
-                        <td valign="top" width="25%" class="infobox">
-                                <h2>Blogroll</h2>
-  
-                                <t:summary t:component="blogroll" />
-                        </td>
-                </tr>
-        </table>
-
-</t:chloe>
diff --git a/extra/webapps/todo/edit-todo.xml b/extra/webapps/todo/edit-todo.xml
index e1d4c40e23..0974c8ce1b 100644
--- a/extra/webapps/todo/edit-todo.xml
+++ b/extra/webapps/todo/edit-todo.xml
@@ -6,9 +6,9 @@
 
 	<t:form t:action="$todo-list/edit" t:for="id">
 		<table>
-			<tr><th class="field-label">Summary: </th><td><t:edit t:component="summary" /></td></tr>
-			<tr><th class="field-label">Priority: </th><td><t:edit t:component="priority" /></td></tr>
-			<tr><th class="field-label big-field-label">Description:</th><td><t:edit t:component="description" /></td></tr>
+			<tr><th class="field-label">Summary: </th><td><t:field t:name="summary" /></td></tr>
+			<tr><th class="field-label">Priority: </th><td><t:field t:name="priority" /></td></tr>
+			<tr><th class="field-label big-field-label">Description:</th><td><t:textarea t:name="description" t:rows="20" t:cols="60" /></td></tr>
 		</table>
 
 		<input type="SUBMIT" value="Done" />
diff --git a/extra/webapps/todo/todo-list.xml b/extra/webapps/todo/todo-list.xml
index 66abeafc86..845c38dbf7 100644
--- a/extra/webapps/todo/todo-list.xml
+++ b/extra/webapps/todo/todo-list.xml
@@ -5,8 +5,33 @@
 	<t:title>My Todo List</t:title>
 
 	<table class="todo-list">
-		<tr><th>Summary</th><th>Priority</th><th>View</th><th>Edit</th></tr>
-		<t:summary t:component="list" />
+
+		<tr>
+			<th>Summary</th>
+			<th>Priority</th>
+			<th>View</th>
+			<th>Edit</th>
+		</tr>
+
+		<t:each-tuple t:values="items">
+
+			<tr>
+				<td>
+					<t:label t:name="summary" />
+				</td>
+				<td>
+					<t:label t:name="priority" />
+				</td>
+				<td>
+					<t:a t:href="$todo-list/view" t:query="id">View</t:a>
+				</td>
+				<td>
+					<t:a t:href="$todo-list/edit" t:query="id">Edit</t:a>
+				</td>
+			</tr>
+
+		</t:each-tuple>
+
 	</table>
 
 </t:chloe>
diff --git a/extra/webapps/todo/todo.factor b/extra/webapps/todo/todo.factor
index 8bfda1aad5..e3b174eaea 100755
--- a/extra/webapps/todo/todo.factor
+++ b/extra/webapps/todo/todo.factor
@@ -1,14 +1,11 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel locals sequences namespaces
-db db.types db.tuples
+USING: accessors kernel sequences namespaces
+db db.types db.tuples validators hashtables
+html.components
+html.templates.chloe
 http.server.sessions
-http.server.components
-http.server.components.farkup
-http.server.forms
-http.server.templating.chloe
 http.server.boilerplate
-http.server.crud
 http.server.auth
 http.server.actions
 http.server.db
@@ -37,44 +34,86 @@ todo "TODO"
 : todo-template ( name -- template )
     "resource:extra/webapps/todo/" swap ".xml" 3append <chloe> ;
 
-: <todo-form> ( -- form )
-    "todo" <form>
-        "view-todo" todo-template >>view-template
-        "edit-todo" todo-template >>edit-template
-        "todo-summary" todo-template >>summary-template
-        "id" <integer>
-            hidden >>renderer
-            add-field
-        "summary" <string>
-            t >>required
-            add-field
-        "priority" <integer>
-            t >>required
-            0 >>default
-            0 >>min-value
-            10 >>max-value
-            add-field
-        "description" <farkup>
-            add-field ;
+: <view-action> ( -- action )
+    <page-action>
+        [
+            validate-integer-id
+            "id" value <todo> select-tuple from-tuple
+        ] >>init
+        
+        "view-todo" todo-template >>template ;
 
-: <todo-list-form> ( -- form )
-    "todo-list" <form>
-        "todo-list" todo-template >>view-template
-        "list" <todo-form> +plain+ <list>
-        add-field ;
+: <id-redirect> ( id next -- response )
+    swap "id" associate <standard-redirect> ;
+
+: validate-todo ( -- )
+    {
+        { "summary" [ v-one-line ] }
+        { "priority" [ v-integer 0 v-min-value 10 v-max-value ] }
+        { "description" [ v-required ] }
+    } validate-params ;
+
+: <new-action> ( -- action )
+    <page-action>
+        [ 0 "priority" set-value ] >>init
+
+        "edit-todo" todo-template >>template
+
+        [ validate-todo ] >>validate
+
+        [
+            f <todo>
+                dup { "summary" "description" } deposit-slots
+            [ insert-tuple ]
+            [ id>> "$todo-list/view" <id-redirect> ]
+            bi
+        ] >>submit ;
+
+: <edit-action> ( -- action )
+    <page-action>
+        [
+            validate-integer-id
+            "id" value <todo> select-tuple from-tuple
+        ] >>init
+
+        "edit-todo" todo-template >>template
+
+        [
+            validate-integer-id
+            validate-todo
+        ] >>validate
+
+        [
+            f <todo>
+                dup { "id" "summary" "priority" "description" } deposit-slots
+            [ update-tuple ]
+            [ id>> "$todo-list/view" <id-redirect> ]
+            bi
+        ] >>submit ;
+
+: <delete-action> ( -- action )
+    <action>
+        [ validate-integer-id ] >>validate
+
+        [
+            "id" get <todo> delete-tuples
+            "$todo-list/list" f <standard-redirect>
+        ] >>submit ;
+
+: <list-action> ( -- action )
+    <page-action>
+        [ f <todo> select-tuples "items" set-value ] >>init
+        "todo-list" todo-template >>template ;
 
 TUPLE: todo-list < dispatcher ;
 
-:: <todo-list> ( -- responder )
-    [let | todo-form [ <todo-form> ]
-           list-form [ <todo-list-form> ]
-           ctor [ [ <todo> ] ] |
-        todo-list new-dispatcher
-            list-form ctor        <list-action>   "list"   add-main-responder
-            todo-form ctor        <view-action>   "view"   add-responder
-            todo-form ctor "$todo-list/view" <edit-action>   "edit"   add-responder
-                      ctor "$todo-list/list" <delete-action> "delete" add-responder
-        <boilerplate>
-            "todo" todo-template >>template
-        f <protected>
-    ] ;
+: <todo-list> ( -- responder )
+    todo-list new-dispatcher
+        <list-action>   "list"   add-main-responder
+        <view-action>   "view"   add-responder
+        <new-action>    "new"    add-responder
+        <edit-action>   "edit"   add-responder
+        <delete-action> "delete" add-responder
+    <boilerplate>
+        "todo" todo-template >>template
+    f <protected> ;
diff --git a/extra/webapps/todo/todo.xml b/extra/webapps/todo/todo.xml
index 651e29d867..39ab5cda8b 100644
--- a/extra/webapps/todo/todo.xml
+++ b/extra/webapps/todo/todo.xml
@@ -12,7 +12,7 @@
 			| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
 		</t:if>
 
-		<t:button t:action="$login/logout" t:flow="begin" class="link-button link">Logout</t:button>
+		| <t:button t:action="$login/logout" t:flow="begin" class="link-button link">Logout</t:button>
 	</div>
 
 	<h1><t:write-title /></h1>
diff --git a/extra/webapps/todo/view-todo.xml b/extra/webapps/todo/view-todo.xml
index 8c90ba9056..a443528bac 100644
--- a/extra/webapps/todo/view-todo.xml
+++ b/extra/webapps/todo/view-todo.xml
@@ -5,12 +5,12 @@
 	<t:title>View Item</t:title>
 
 	<table>
-		<tr><th class="field-label">Summary:    </th><td><t:view t:component="summary"     /></td></tr>
-		<tr><th class="field-label">Priority:   </th><td><t:view t:component="priority"    /></td></tr>
+		<tr><th class="field-label">Summary: </th><td><t:label t:name="summary" /></td></tr>
+		<tr><th class="field-label">Priority: </th><td><t:label t:name="priority" /></td></tr>
 	</table>
 
 	<div class="description">
-		<t:view t:component="description" />
+		<t:farkup t:name="description" />
 	</div>
 
 	<t:a t:href="$todo-list/edit" t:query="id">Edit</t:a>
diff --git a/extra/webapps/user-admin/edit-user.xml b/extra/webapps/user-admin/edit-user.xml
index 9c0fe702bb..3f9ac8d690 100644
--- a/extra/webapps/user-admin/edit-user.xml
+++ b/extra/webapps/user-admin/edit-user.xml
@@ -10,44 +10,44 @@
 	
 	<tr>
 		<th class="field-label">User name:</th>
-		<td><t:view t:component="username" /></td>
+		<td><t:label t:name="username" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Real name:</th>
-		<td><t:edit t:component="realname" /></td>
+		<td><t:field t:name="realname" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">New password:</th>
-		<td><t:edit t:component="new-password" /></td>
+		<td><t:password t:name="new-password" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Verify:</th>
-		<td><t:edit t:component="verify-password" /></td>
+		<td><t:password t:name="verify-password" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">E-mail:</th>
-		<td><t:edit t:component="email" /></td>
+		<td><t:field t:name="email" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label big-field-label">Capabilities:</th>
-		<td><t:edit t:component="capabilities" /></td>
+		<td><t:choice t:name="capabilities" t:choices="all-capabilities" t:multiple="true" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Profile:</th>
-		<td><t:view t:component="profile" /></td>
+		<td><t:inspector t:name="profile" /></td>
 	</tr>
 
 	</table>
 	
 	<p>
 		<button type="submit" class="link-button link">Update</button>
-		<t:validation-message />
+		<t:validation-messages />
 	</p>
 
 	</t:form>
diff --git a/extra/webapps/user-admin/new-user.xml b/extra/webapps/user-admin/new-user.xml
index 2d67639985..881dca9c16 100644
--- a/extra/webapps/user-admin/new-user.xml
+++ b/extra/webapps/user-admin/new-user.xml
@@ -10,39 +10,39 @@
 	
 	<tr>
 		<th class="field-label">User name:</th>
-		<td><t:edit t:component="username" /></td>
+		<td><t:field t:name="username" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Real name:</th>
-		<td><t:edit t:component="realname" /></td>
+		<td><t:field t:name="realname" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">New password:</th>
-		<td><t:edit t:component="new-password" /></td>
+		<td><t:password t:name="new-password" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Verify:</th>
-		<td><t:edit t:component="verify-password" /></td>
+		<td><t:password t:name="verify-password" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">E-mail:</th>
-		<td><t:edit t:component="email" /></td>
+		<td><t:field t:name="email" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label big-field-label">Capabilities:</th>
-		<td><t:edit t:component="capabilities" /></td>
+		<td><t:choice t:name="capabilities" t:choices="all-capabilities" t:multiple="true" /></td>
 	</tr>
 
 	</table>
 	
 	<p>
 		<button type="submit" class="link-button link">Create</button>
-		<t:validation-message />
+		<t:validation-messages />
 	</p>
 
 	</t:form>
diff --git a/extra/webapps/user-admin/user-admin.factor b/extra/webapps/user-admin/user-admin.factor
index 172ab62c50..728d5215f0 100644
--- a/extra/webapps/user-admin/user-admin.factor
+++ b/extra/webapps/user-admin/user-admin.factor
@@ -26,26 +26,22 @@ IN: webapps.user-admin
     [ ":" split1 swap lookup ] map ;
 
 : <user-list-action> ( -- action )
-    <action>
+    <page-action>
         [ f <user> select-tuples "users" set-value ] >>init
-        [ "user-list" admin-template <html-content> ] >>display ;
+        "user-list" admin-template >>template ;
 
 : <new-user-action> ( -- action )
-    <action>
+    <page-action>
         [
-            "username" param <user> {
-                [ username>> "username" set-value ]
-                [ realname>> "realname" set-value ]
-                [ email>> "email" set-value ]
-                [ profile>> "profile" set-value ]
-            } cleave
-
-            capabilities get "all-capabilities" set-value
+            "username" param <user> from-tuple
+            capabilities get words>strings "all-capabilities" set-value
         ] >>init
 
-        [ "new-user" admin-template <html-content> ] >>display
+        "new-user" admin-template >>template
 
         [
+            capabilities get words>strings "all-capabilities" set-value
+
             {
                 { "username" [ v-username ] }
                 { "realname" [ v-one-line ] }
@@ -72,26 +68,26 @@ IN: webapps.user-admin
 
             "$user-admin" f <standard-redirect>
         ] >>submit ;
-    
+
+: validate-username ( -- )
+    { { "username" [ v-username ] } } validate-params ;
+
 : <edit-user-action> ( -- action )
-    <action>
+    <page-action>
         [
-            { { "username" [ v-username ] } } validate-params
+            validate-username
 
-            "username" value <user> select-tuple {
-                [ username>> "username" set-value ]
-                [ realname>> "realname" set-value ]
-                [ email>> "email" set-value ]
-                [ profile>> "profile" set-value ]
-                [ capabilities>> words>strings "capabilities" set-value ]
-            } cleave
+            "username" value <user> select-tuple
+            [ from-tuple ] [ capabilities>> words>strings "capabilities" set-value ] bi
 
-            capabilities get "all-capabilities" set-value
+            capabilities get words>strings "all-capabilities" set-value
         ] >>init
 
-        [ "edit-user" admin-template <html-content> ] >>display
+        "edit-user" admin-template >>template
 
         [
+            capabilities get words>strings "all-capabilities" set-value
+
             {
                 { "username" [ v-username ] }
                 { "realname" [ v-one-line ] }
@@ -102,9 +98,9 @@ IN: webapps.user-admin
             } validate-params
 
             "new-password" "verify-password"
-            [ value empty? ] both? [
+            [ value empty? not ] either? [
                 same-password-twice
-            ] unless
+            ] when
         ] >>validate
 
         [
@@ -112,9 +108,9 @@ IN: webapps.user-admin
                 "realname" value >>realname
                 "email" value >>email
 
-            "new-password" value empty? [ drop ] [
+            "new-password" value empty? [
                 "new-password" value >>encoded-password
-            ] if
+            ] unless
 
             "capabilities" value {
                 { [ dup string? ] [ 1array ] }
@@ -129,7 +125,8 @@ IN: webapps.user-admin
 : <delete-user-action> ( -- action )
     <action>
         [
-            { { "username" [ v-username ] } } validate-params
+            validate-username
+
             [ <user> select-tuple 1 >>deleted update-tuple ]
             [ logout-all-sessions ]
             bi
@@ -145,12 +142,12 @@ can-administer-users? define-capability
 
 : <user-admin> ( -- responder )
     user-admin new-dispatcher
-        <user-list-action> "" add-responder
+        <user-list-action> "list" add-main-responder
         <new-user-action> "new" add-responder
         <edit-user-action> "edit" add-responder
         <delete-user-action> "delete" add-responder
     <boilerplate>
-        "admin" admin-template >>template
+        "user-admin" admin-template >>template
     { can-administer-users? } <protected> ;
 
 : make-admin ( username -- )
diff --git a/extra/webapps/user-admin/user-list.xml b/extra/webapps/user-admin/user-list.xml
index 6887308754..020d053e03 100644
--- a/extra/webapps/user-admin/user-list.xml
+++ b/extra/webapps/user-admin/user-list.xml
@@ -4,10 +4,16 @@
 
 	<t:title>Users</t:title>
 
-	<t:each-tuple t:values="users">
-		<t:a t:href="$user-admin/edit" t:query="username">
-			<t:label t:name="username" />
-		</t:a>
-	</t:each-tuple>
+	<ul>
+
+		<t:each-tuple t:values="users">
+			<li>
+				<t:a t:href="$user-admin/edit" t:query="username">
+					<t:label t:name="username" />
+				</t:a>
+			</li>
+		</t:each-tuple>
+
+	</ul>
 
 </t:chloe>
diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor
index 277439c0cd..8c6025f726 100755
--- a/extra/xmode/catalog/catalog.factor
+++ b/extra/xmode/catalog/catalog.factor
@@ -1,6 +1,6 @@
 USING: xmode.loader xmode.utilities xmode.rules namespaces
 strings splitting assocs sequences kernel io.files xml memoize
-words globs combinators io.encodings.utf8 ;
+words globs combinators io.encodings.utf8 sorting ;
 IN: xmode.catalog
 
 TUPLE: mode file file-name-glob first-line-glob ;
@@ -23,17 +23,15 @@ TAGS>
         swap child-tags [ parse-mode-tag ] with each
     ] keep ;
 
-: load-catalog ( -- modes )
+MEMO: modes ( -- modes )
     "resource:extra/xmode/modes/catalog"
     file>xml parse-modes-tag ;
 
-: modes ( -- assoc )
-    \ modes get-global [
-        load-catalog dup \ modes set-global
-    ] unless* ;
+MEMO: mode-names ( -- modes )
+    modes keys natural-sort ;
 
 : reset-catalog ( -- )
-    f \ modes set-global ;
+    \ modes reset-memoized ;
 
 MEMO: (load-mode) ( name -- rule-sets )
     modes at [
diff --git a/extra/xmode/code2html/responder/responder.factor b/extra/xmode/code2html/responder/responder.factor
index 7b2bdd992a..e059aeb7ff 100755
--- a/extra/xmode/code2html/responder/responder.factor
+++ b/extra/xmode/code2html/responder/responder.factor
@@ -8,14 +8,9 @@ IN: xmode.code2html.responder
 : <sources> ( root -- responder )
     [
         drop
-        "text/html" <content> swap
-        [ "last-modified" set-header ]
-        [
-            '[
-                ,
-                dup file-name swap utf8
-                <file-reader>
+         '[
+            , [ file-name ] keep utf8 [
                 [ htmlize-stream ] with-html-stream
-            ] >>body
-        ] bi
+            ] with-file-reader
+        ] <html-content>
     ] <file-responder> ;

From 8d8cb11e2a4bbbdf14458d7aea8fd451c9494b09 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 00:48:02 -0500
Subject: [PATCH 21/39] More stuff

---
 extra/tangle/tangle.factor                | 14 ++----
 extra/validators/validators-tests.factor  | 61 +++++++++++++++++------
 extra/validators/validators.factor        | 60 +++++++++++-----------
 extra/webapps/counter/counter.fhtml       | 10 ----
 extra/webapps/pastebin/annotation.xml     | 17 -------
 extra/webapps/pastebin/new-annotation.xml | 24 ---------
 extra/webapps/pastebin/paste-summary.xml  | 11 ----
 extra/webapps/planet/blog-admin-link.xml  |  7 ---
 extra/webapps/todo/todo-summary.xml       | 20 --------
 9 files changed, 83 insertions(+), 141 deletions(-)
 delete mode 100644 extra/webapps/counter/counter.fhtml
 delete mode 100644 extra/webapps/pastebin/annotation.xml
 delete mode 100644 extra/webapps/pastebin/new-annotation.xml
 delete mode 100644 extra/webapps/pastebin/paste-summary.xml
 delete mode 100644 extra/webapps/planet/blog-admin-link.xml
 delete mode 100644 extra/webapps/todo/todo-summary.xml

diff --git a/extra/tangle/tangle.factor b/extra/tangle/tangle.factor
index 52c454f97f..8a4c6146de 100644
--- a/extra/tangle/tangle.factor
+++ b/extra/tangle/tangle.factor
@@ -19,11 +19,8 @@ C: <tangle> tangle
 : with-tangle ( tangle quot -- )
     [ [ db>> ] [ seq>> ] bi ] dip with-db ;
 
-: <text-response> ( text -- response )
-    "text/plain" <content> swap >>body ;
-
 : node-response ( id -- response )
-    load-node [ node-content <text-response> ] [ <404> ] if* ;
+    load-node [ node-content <text-content> ] [ <404> ] if* ;
 
 : display-node ( params -- response )
     [
@@ -39,7 +36,7 @@ C: <tangle> tangle
 : submit-node ( params -- response )
     [
         "node_content" swap at* [
-            create-node id>> number>string <text-response>
+            create-node id>> number>string <text-content>
         ] [
             drop <400>
         ] if
@@ -55,10 +52,7 @@ TUPLE: path-responder ;
 C: <path-responder> path-responder
 
 M: path-responder call-responder* ( path responder -- response )
-    drop path>file [ node-content <text-response> ] [ <404> ] if* ;
-
-: <json-response> ( obj -- response )
-    "application/json" <content> swap >json >>body ;
+    drop path>file [ node-content <text-content> ] [ <404> ] if* ;
 
 TUPLE: tangle-dispatcher < dispatcher tangle ;
 
@@ -67,7 +61,7 @@ TUPLE: tangle-dispatcher < dispatcher tangle ;
     <path-responder> >>default
     "resource:extra/tangle/resources" <static> "resources" add-responder
     <node-responder> "node" add-responder
-    <action> [ all-node-ids <json-response> ] >>display "all" add-responder ;
+    <action> [ all-node-ids <json-content> ] >>display "all" add-responder ;
 
 M: tangle-dispatcher call-responder* ( path dispatcher -- response )
     dup tangle>> [
diff --git a/extra/validators/validators-tests.factor b/extra/validators/validators-tests.factor
index 6ed0e0363a..a981f782d3 100644
--- a/extra/validators/validators-tests.factor
+++ b/extra/validators/validators-tests.factor
@@ -1,8 +1,28 @@
 IN: validators.tests
-USING: kernel sequences tools.test validators accessors ;
+USING: kernel sequences tools.test validators accessors
+namespaces assocs ;
+
+: with-validation ( quot -- messages )
+    [
+        init-validation
+        call
+        validation-messages get
+        named-validation-messages get >alist append
+    ] with-scope ; inline
+
+[ "" v-one-line ] must-fail
+[ "hello world" ] [ "hello world" v-one-line ] unit-test
+[ "hello\nworld" v-one-line ] must-fail
+
+[ "" v-one-word ] must-fail
+[ "hello" ] [ "hello" v-one-word ] unit-test
+[ "hello world" v-one-word ] must-fail
 
 [ "foo" v-number ] must-fail
 [ 123 ] [ "123" v-number ] unit-test
+[ 123 ] [ "123" v-integer ] unit-test
+
+[ "1.0" v-integer ] [ "must be an integer" = ] must-fail-with
 
 [ "slava@factorcode.org" ] [
     "slava@factorcode.org" v-email
@@ -29,13 +49,13 @@ USING: kernel sequences tools.test validators accessors ;
 
 [ 14 V{ } ] [
     [
-        "14" "age" [ drop v-number 13 v-min-value 100 v-max-value ] validate
+        "14" "age" [ v-number 13 v-min-value 100 v-max-value ] validate
     ] with-validation
 ] unit-test
 
 [ f t ] [
     [
-        "140" "age" [ drop v-number 13 v-min-value 100 v-max-value ] validate
+        "140" "age" [ v-number 13 v-min-value 100 v-max-value ] validate
     ] with-validation first
     [ first "age" = ]
     [ second validation-error? ]
@@ -46,25 +66,38 @@ USING: kernel sequences tools.test validators accessors ;
 TUPLE: person name age ;
 
 person {
-    { "name" [ v-required ] }
+    { "name" [ ] }
     { "age" [ v-number 13 v-min-value 100 v-max-value ] }
 } define-validators
 
-[ 14 V{ } ] [
-    [
-        person new dup
-        { { "age" "14" } }
-        deposit-slots
-        age>>
-    ] with-validation
-] unit-test
-
-[ t ] [
+[ t t ] [
     [
         { { "age" "" } } required-values
+        validation-failed?
     ] with-validation first
     [ first "age" = ]
     [ second validation-error? ]
     [ second message>> "required" = ]
     tri and and
 ] unit-test
+
+[ H{ { "a" 123 } } f V{ } ] [
+    [
+        H{
+            { "a" "123" }
+            { "b" "c" }
+            { "c" "d" }
+        }
+        H{
+            { "a" [ v-integer ] }
+        } validate-values
+        validation-failed?
+    ] with-validation
+] unit-test
+
+[ t "foo" ] [
+    [
+        "foo" validation-error
+        validation-failed?
+    ] with-validation first message>>
+] unit-test
diff --git a/extra/validators/validators.factor b/extra/validators/validators.factor
index b03cc76444..2dcc2c04f9 100644
--- a/extra/validators/validators.factor
+++ b/extra/validators/validators.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel continuations sequences math namespaces sets
 math.parser assocs regexp fry unicode.categories sequences
-arrays hashtables words combinators mirrors classes quotations ;
+arrays hashtables words combinators mirrors classes quotations
+xmode.catalog ;
 IN: validators
 
 : v-default ( str def -- str )
@@ -33,8 +34,8 @@ IN: validators
 : v-number ( str -- n )
     dup string>number [ ] [ "must be a number" throw ] ?if ;
 
-: v-integer ( n -- n )
-    dup integer? [ "must be an integer" throw ] unless ;
+: v-integer ( str -- n )
+    v-number dup integer? [ "must be an integer" throw ] unless ;
 
 : v-min-value ( x n -- x )
     2dup < [
@@ -70,25 +71,38 @@ IN: validators
     dup empty? [ "must remain blank" throw ] unless ;
 
 : v-one-line ( str -- str )
+    v-required
     dup "\r\n" intersect empty?
     [ "must be a single line" throw ] unless ;
 
 : v-one-word ( str -- str )
+    v-required
     dup [ alpha? ] all?
     [ "must be a single word" throw ] unless ;
 
-SYMBOL: validation-messages
+: v-username ( str -- str )
+    2 v-min-length 16 v-max-length v-one-word ;
 
-: with-validation ( quot -- messages )
-    V{ } clone [
-        validation-messages rot with-variable
-    ] keep ; inline
+: v-password ( str -- str )
+    6 v-min-length 40 v-max-length v-one-line ;
+
+: v-mode ( str -- str )
+    dup mode-names member? [
+        "not a valid syntax mode" throw 
+    ] unless ;
+
+SYMBOL: validation-messages
+SYMBOL: named-validation-messages
+
+: init-validation ( -- )
+    V{ } clone validation-messages set
+    H{ } clone named-validation-messages set ;
 
 : (validation-message) ( obj -- )
     validation-messages get push ;
 
 : (validation-message-for) ( obj name -- )
-    swap 2array (validation-message) ;
+    named-validation-messages get set-at ;
 
 TUPLE: validation-message message ;
 
@@ -100,39 +114,29 @@ C: <validation-message> validation-message
 : validation-message-for ( string name -- )
     [ <validation-message> ] dip (validation-message-for) ;
 
-TUPLE: validation-error value message ;
+TUPLE: validation-error message value ;
 
 C: <validation-error> validation-error
 
-: validation-error ( reason -- )
+: validation-error ( message -- )
     f <validation-error> (validation-message) ;
 
-: validation-error-for ( reason value name -- )
+: validation-error-for ( message value name -- )
     [ <validation-error> ] dip (validation-message-for) ;
 
 : validation-failed? ( -- ? )
-    validation-messages get [
-        dup pair? [ second ] when validation-error?
-    ] contains? ;
+    validation-messages get [ validation-error? ] contains?
+    named-validation-messages get [ nip validation-error? ] assoc-contains?
+    or ;
 
 : define-validators ( class validators -- )
     >hashtable "validators" set-word-prop ;
 
 : validate ( value name quot -- result )
-    [ swap validation-error-for f ] recover ; inline
-
-: validate-value ( value name validators -- result )
-    '[ , at call ] validate ;
+    '[ drop @ ] [ -rot validation-error-for f ] recover ; inline
 
 : required-values ( assoc -- )
-    [ swap [ drop v-required ] validate drop ] assoc-each ;
+    [ swap [ v-required ] validate drop ] assoc-each ;
 
 : validate-values ( assoc validators -- assoc' )
-    '[ over , validate-value ] assoc-map ;
-
-: deposit-values ( destination assoc validators -- )
-    validate-values update ;
-
-: deposit-slots ( tuple assoc -- )
-    [ [ <mirror> ] [ class "validators" word-prop ] bi ] dip
-    swap deposit-values ;
+    swap '[ [ [ dup , at ] keep ] dip validate ] assoc-map ;
diff --git a/extra/webapps/counter/counter.fhtml b/extra/webapps/counter/counter.fhtml
deleted file mode 100644
index 521096f105..0000000000
--- a/extra/webapps/counter/counter.fhtml
+++ /dev/null
@@ -1,10 +0,0 @@
-<% USING: io math.parser http.server.sessions webapps.counter ; %>
-
-<html>
-    <body>
-        <h1><% count sget number>string write %></h1>
-
-        <a href="inc">++</a>
-        <a href="dec">--</a>
-    </body>
-</html>
diff --git a/extra/webapps/pastebin/annotation.xml b/extra/webapps/pastebin/annotation.xml
deleted file mode 100644
index d5b4ea8d3a..0000000000
--- a/extra/webapps/pastebin/annotation.xml
+++ /dev/null
@@ -1,17 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<h2>Annotation: <t:view t:component="summary" /></h2>
-
-	<table>
-		<tr><th class="field-label">Author:  </th><td><t:view t:component="author"  /></td></tr>
-		<tr><th class="field-label">Mode:    </th><td><t:view t:component="mode"    /></td></tr>
-		<tr><th class="field-label">Date:    </th><td><t:view t:component="date"    /></td></tr>
-	</table>
-
-	<pre class="description"><t:view t:component="contents" /></pre>
-
-	<t:button t:action="$pastebin/delete-annotation" t:for="aid" class="link-button link">Delete Annotation</t:button>
-
-</t:chloe>
diff --git a/extra/webapps/pastebin/new-annotation.xml b/extra/webapps/pastebin/new-annotation.xml
deleted file mode 100644
index 5d18860977..0000000000
--- a/extra/webapps/pastebin/new-annotation.xml
+++ /dev/null
@@ -1,24 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<t:title>New Annotation</t:title>
-
-	<t:form t:action="$pastebin/annotate" t:for="id">
-
-		<table>
-			<tr><th class="field-label">Summary: </th><td><t:edit t:component="summary" /></td></tr>
-			<tr><th class="field-label">Author: </th><td><t:edit t:component="author" /></td></tr>
-			<tr><th class="field-label">Mode: </th><td><t:edit t:component="mode" /></td></tr>
-			<tr><th class="field-label big-field-label">Description:</th><td><t:edit t:component="contents" /></td></tr>
-			<tr><th class="field-label">Captcha: </th><td><t:edit t:component="captcha" /></td></tr>
-			<tr>
-			<td></td>
-			<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
-			</tr>
-		</table>
-
-		<input type="SUBMIT" value="Done" />
-	</t:form>
-
-</t:chloe>
diff --git a/extra/webapps/pastebin/paste-summary.xml b/extra/webapps/pastebin/paste-summary.xml
deleted file mode 100644
index c751b110c0..0000000000
--- a/extra/webapps/pastebin/paste-summary.xml
+++ /dev/null
@@ -1,11 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<tr>
-		<td><t:a t:href="$pastebin/view-paste" t:query="id"><t:view t:component="summary" /></t:a></td>
-		<td><t:view t:component="author" /></td>
-		<td><t:view t:component="date" /></td>
-	</tr>
-
-</t:chloe>
diff --git a/extra/webapps/planet/blog-admin-link.xml b/extra/webapps/planet/blog-admin-link.xml
deleted file mode 100644
index 8d6c890643..0000000000
--- a/extra/webapps/planet/blog-admin-link.xml
+++ /dev/null
@@ -1,7 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<t:a t:href="$planet-factor/admin/edit-blog" t:query="id"><t:view t:component="name" /></t:a>
-
-</t:chloe>
diff --git a/extra/webapps/todo/todo-summary.xml b/extra/webapps/todo/todo-summary.xml
deleted file mode 100644
index 056c9cab0a..0000000000
--- a/extra/webapps/todo/todo-summary.xml
+++ /dev/null
@@ -1,20 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
-	<tr>
-		<td>
-			<t:view t:component="summary" />
-		</td>
-		<td>
-			<t:view t:component="priority" />
-		</td>
-		<td>
-			<t:a t:href="$todo-list/view" t:query="id">View</t:a>
-		</td>
-		<td>
-			<t:a t:href="$todo-list/edit" t:query="id">Edit</t:a>
-		</td>
-	</tr>
-
-</t:chloe>

From 1c10cb0ff155b3cbad9c6186a92b7fcfd8920eeb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 00:48:10 -0500
Subject: [PATCH 22/39] Update for word renaming

---
 core/compiler/units/units.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index 11c81f4097..729cfcd179 100755
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel continuations assocs namespaces sequences words
-vocabs definitions hashtables init ;
+vocabs definitions hashtables init sets ;
 IN: compiler.units
 
 SYMBOL: old-definitions

From b91a314f0e503de7b9a256f32506dac7b0e1fe19 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 00:48:18 -0500
Subject: [PATCH 23/39] Another recursive fry fi

---
 extra/fry/fry-tests.factor | 10 ++++++++++
 extra/fry/fry.factor       | 17 ++++++++++++-----
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/extra/fry/fry-tests.factor b/extra/fry/fry-tests.factor
index eb59ffae4e..6d6abba23c 100755
--- a/extra/fry/fry-tests.factor
+++ b/extra/fry/fry-tests.factor
@@ -52,3 +52,13 @@ sequences ;
 [ { 1 { 2 { 3 } } } ] [
     1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
 ] unit-test
+
+{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as
+
+[ { { { 3 } } } ] [
+    3 '[ [ [ , 1array ] call 1array ] call 1array ] call
+] unit-test
+
+[ { { { 3 } } } ] [
+    3 '[ [ [ , 1array ] call 1array ] call 1array ] call
+] unit-test
diff --git a/extra/fry/fry.factor b/extra/fry/fry.factor
index 27a321ed92..4581c048fd 100755
--- a/extra/fry/fry.factor
+++ b/extra/fry/fry.factor
@@ -46,15 +46,22 @@ DEFER: (shallow-fry)
         shallow-fry
     ] if* ;
 
+: fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ;
+
+: count-inputs ( quot -- n )
+    [
+        {
+            { [ dup callable? ] [ count-inputs ] }
+            { [ dup fry-specifier? ] [ drop 1 ] }
+            [ drop 0 ]
+        } cond
+    ] map sum ;
+
 : fry ( quot -- quot' )
     [
         [
             dup callable? [
-                [
-                    [ { , namespaces:, @ } member? ] filter length
-                    \ , <repetition> %
-                ]
-                [ fry % ] bi
+                [ count-inputs \ , <repetition> % ] [ fry % ] bi
             ] [ namespaces:, ] if
         ] each
     ] [ ] make deep-fry ;

From 9d04629d4c304abb8d68803325042ec8283664a2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 00:48:28 -0500
Subject: [PATCH 24/39] We can now parse reddit's RSS feed

---
 extra/calendar/format/format-tests.factor | 12 ++++
 extra/calendar/format/format.factor       |  8 ++-
 extra/rss/rss.factor                      | 78 ++++++++++++++---------
 3 files changed, 65 insertions(+), 33 deletions(-)

diff --git a/extra/calendar/format/format-tests.factor b/extra/calendar/format/format-tests.factor
index f4e1669178..3efe33e265 100755
--- a/extra/calendar/format/format-tests.factor
+++ b/extra/calendar/format/format-tests.factor
@@ -50,3 +50,15 @@ IN: calendar.format.tests
     "Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
     timestamp>string
 ] unit-test
+
+[
+    T{ timestamp f
+        2008
+        5
+        26
+        0
+        37
+        42.12345
+        T{ duration f 0 0 0 -5 0 0 }
+    }
+] [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
diff --git a/extra/calendar/format/format.factor b/extra/calendar/format/format.factor
index 91a034f8bd..ff1811e9d5 100755
--- a/extra/calendar/format/format.factor
+++ b/extra/calendar/format/format.factor
@@ -1,4 +1,4 @@
-USING: math math.order math.parser kernel sequences io
+USING: math math.order math.parser math.functions kernel sequences io
 accessors arrays io.streams.string splitting
 combinators accessors debugger
 calendar calendar.format.macros ;
@@ -151,11 +151,15 @@ M: timestamp year. ( timestamp -- )
 : read-hms ( -- h m s )
     read-00 ":" expect read-00 ":" expect read-00 ;
 
+: read-rfc3339-seconds ( s -- s' ch )
+    "+-Z" read-until >r
+    [ string>number ] [ length 10 swap ^ ] bi / + r> ;
+
 : (rfc3339>timestamp) ( -- timestamp )
     read-ymd
     "Tt" expect
     read-hms
-    read1 { { CHAR: . [ read-000 1000 / + read1 ] } [ ] } case
+    read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case
     read-rfc3339-gmt-offset
     <timestamp> ;
 
diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor
index 6e616e51a9..364c24b91f 100644
--- a/extra/rss/rss.factor
+++ b/extra/rss/rss.factor
@@ -18,51 +18,67 @@ TUPLE: entry title link description pub-date ;
 
 C: <entry> entry
 
+: try-parsing-timestamp ( string -- timestamp )
+    [ rfc822>timestamp ] [ drop rfc3339>timestamp ] recover ;
+
 : rss1.0-entry ( tag -- entry )
-    [ "title" tag-named children>string ] keep   
-    [ "link" tag-named children>string ] keep
-    [ "description" tag-named children>string ] keep
-    f "date" "http://purl.org/dc/elements/1.1/" <name>
-    tag-named dup [ children>string rfc822>timestamp ] when
-    <entry> ;
+    {
+        [ "title" tag-named children>string ]
+        [ "link" tag-named children>string ]
+        [ "description" tag-named children>string ]
+        [
+            f "date" "http://purl.org/dc/elements/1.1/" <name>
+            tag-named dup [ children>string try-parsing-timestamp ] when
+        ]
+    } cleave <entry> ;
 
 : rss1.0 ( xml -- feed )
     [
         "channel" tag-named
-        [ "title" tag-named children>string ] keep
-        "link" tag-named children>string
-    ] keep
-    "item" tags-named [ rss1.0-entry ] map <feed> ;
+        [ "title" tag-named children>string ]
+        [ "link" tag-named children>string ] bi
+    ] [ "item" tags-named [ rss1.0-entry ] map ] bi
+    <feed> ;
 
 : rss2.0-entry ( tag -- entry )
-    [ "title" tag-named children>string ] keep
-    [ "link" tag-named ] keep
-    [ "guid" tag-named dupd ? children>string ] keep
-    [ "description" tag-named children>string ] keep
-    "pubDate" tag-named children>string rfc822>timestamp <entry> ;
+    {
+        [ "title" tag-named children>string ]
+        [ { "link" "guid" } any-tag-named children>string ]
+        [ "description" tag-named children>string ]
+        [
+            { "date" "pubDate" } any-tag-named
+            children>string try-parsing-timestamp
+        ]
+    } cleave <entry> ;
 
 : rss2.0 ( xml -- feed )
     "channel" tag-named 
-    [ "title" tag-named children>string ] keep
-    [ "link" tag-named children>string ] keep
-    "item" tags-named [ rss2.0-entry ] map <feed> ;
+    [ "title" tag-named children>string ]
+    [ "link" tag-named children>string ]
+    [ "item" tags-named [ rss2.0-entry ] map ]
+    tri <feed> ;
 
 : atom1.0-entry ( tag -- entry )
-    [ "title" tag-named children>string ] keep
-    [ "link" tag-named "href" swap at ] keep
-    [
-        { "content" "summary" } any-tag-named
-        dup tag-children [ string? not ] contains?
-        [ tag-children [ write-chunk ] with-string-writer ]
-        [ children>string ] if
-    ] keep
-    { "published" "updated" "issued" "modified" } any-tag-named
-    children>string rfc3339>timestamp <entry> ;
+    {
+        [ "title" tag-named children>string ]
+        [ "link" tag-named "href" swap at ]
+        [
+            { "content" "summary" } any-tag-named
+            dup tag-children [ string? not ] contains?
+            [ tag-children [ write-chunk ] with-string-writer ]
+            [ children>string ] if
+        ]
+        [
+            { "published" "updated" "issued" "modified" } 
+            any-tag-named children>string try-parsing-timestamp
+        ]
+    } cleave <entry> ;
 
 : atom1.0 ( xml -- feed )
-    [ "title" tag-named children>string ] keep
-    [ "link" tag-named "href" swap at ] keep
-    "entry" tags-named [ atom1.0-entry ] map <feed> ;
+    [ "title" tag-named children>string ]
+    [ "link" tag-named "href" swap at ]
+    [ "entry" tags-named [ atom1.0-entry ] map ]
+    tri <feed> ;
 
 : xml>feed ( xml -- feed )
     dup name-tag {

From dc6af2f7bb7a1e65dcda9edd88a2019058df7b50 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 00:48:37 -0500
Subject: [PATCH 25/39] Fix USING

---
 extra/ui/tools/interactor/interactor.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/tools/interactor/interactor.factor b/extra/ui/tools/interactor/interactor.factor
index c28e8aec7c..400169908b 100755
--- a/extra/ui/tools/interactor/interactor.factor
+++ b/extra/ui/tools/interactor/interactor.factor
@@ -6,7 +6,7 @@ models namespaces parser prettyprint quotations sequences
 strings threads listener classes.tuple ui.commands ui.gadgets
 ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds
 ui.gestures definitions calendar concurrency.flags
-concurrency.mailboxes ui.tools.workspace accessors ;
+concurrency.mailboxes ui.tools.workspace accessors sets ;
 IN: ui.tools.interactor
 
 ! If waiting is t, we're waiting for user input, and invoking

From be0d85180ff4fb40dba659b7f898d9b6f14c3d4c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 02:54:53 -0500
Subject: [PATCH 26/39] Debugging validation

---
 extra/html/components/components.factor | 13 ++++++
 extra/html/templates/chloe/chloe.factor | 14 ++++++
 extra/webapps/pastebin/new-paste.xml    |  4 +-
 extra/webapps/pastebin/paste.xml        |  4 +-
 extra/webapps/pastebin/pastebin.factor  | 61 +++++++++++++------------
 extra/webapps/pastebin/pastebin.xml     |  6 +--
 extra/webapps/planet/planet.factor      | 13 ++++--
 7 files changed, 76 insertions(+), 39 deletions(-)

diff --git a/extra/html/components/components.factor b/extra/html/components/components.factor
index e6df343161..382636d952 100644
--- a/extra/html/components/components.factor
+++ b/extra/html/components/components.factor
@@ -44,6 +44,12 @@ SYMBOL: values
 : with-each-tuple ( seq quot -- )
     '[ from-tuple @ ] with-each-index ; inline
 
+: with-assoc-values ( assoc quot -- )
+    '[ blank-values , from-assoc @ ] with-scope ; inline
+
+: with-tuple-values ( assoc quot -- )
+    '[ blank-values , from-tuple @ ] with-scope ; inline
+
 : nest-values ( name quot -- )
     swap [
         [
@@ -51,6 +57,13 @@ SYMBOL: values
         ] with-scope
     ] dip set-value ; inline
 
+: nest-tuple ( name quot -- )
+    swap [
+        [
+            H{ } clone [ <mirror> values set call ] keep
+        ] with-scope
+    ] dip set-value ; inline
+
 : object>string ( object -- string )
     {
         { [ dup real? ] [ number>string ] }
diff --git a/extra/html/templates/chloe/chloe.factor b/extra/html/templates/chloe/chloe.factor
index 4430e69336..6790a9f666 100644
--- a/extra/html/templates/chloe/chloe.factor
+++ b/extra/html/templates/chloe/chloe.factor
@@ -217,6 +217,18 @@ STRING: button-tag-markup
 : each-assoc-tag ( tag -- )
     [ with-each-assoc ] (each-tag) ;
 
+: (bind-tag) ( tag quot -- )
+    [
+        [ "name" required-attr value ] keep
+        '[ , process-tag-children ]
+    ] dip call ; inline
+
+: bind-tuple-tag ( tag -- )
+    [ with-tuple-values ] (bind-tag) ;
+
+: bind-assoc-tag ( tag -- )
+    [ with-assoc-values ] (bind-tag) ;
+
 : error-message-tag ( tag -- )
     children>string render-error ;
 
@@ -280,6 +292,8 @@ STRING: button-tag-markup
         { "each" [ each-tag ] }
         { "each-assoc" [ each-assoc-tag ] }
         { "each-tuple" [ each-tuple-tag ] }
+        { "bind-assoc" [ bind-assoc-tag ] }
+        { "bind-tuple" [ bind-tuple-tag ] }
         { "comment" [ drop ] }
         { "call-next-template" [ drop call-next-template ] }
 
diff --git a/extra/webapps/pastebin/new-paste.xml b/extra/webapps/pastebin/new-paste.xml
index 1abd4d494b..6abae4895b 100644
--- a/extra/webapps/pastebin/new-paste.xml
+++ b/extra/webapps/pastebin/new-paste.xml
@@ -10,8 +10,8 @@
 			<tr><th class="field-label">Summary: </th><td><t:field t:name="summary" /></td></tr>
 			<tr><th class="field-label">Author: </th><td><t:field t:name="author" /></td></tr>
 			<tr><th class="field-label">Mode: </th><td><t:choice t:name="mode" t:choices="modes" /></td></tr>
-			<tr><th class="field-label big-field-label">Description: </th><td><t:textarea t:name="contents" /></td></tr>
-			<tr><th class="field-label">Captcha: </th><td><t:captcha t:name="captcha" /></td></tr>
+			<tr><th class="field-label big-field-label">Body: </th><td><t:textarea t:name="contents" t:rows="20" t:cols="60" /></td></tr>
+			<tr><th class="field-label">Captcha: </th><td><t:field t:name="captcha" /></td></tr>
 			<tr>
 			<td></td>
 			<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
diff --git a/extra/webapps/pastebin/paste.xml b/extra/webapps/pastebin/paste.xml
index 1f65ff6765..57c2fdb7c2 100644
--- a/extra/webapps/pastebin/paste.xml
+++ b/extra/webapps/pastebin/paste.xml
@@ -44,8 +44,8 @@
 				<tr><th class="field-label">Summary: </th><td><t:field t:name="summary" /></td></tr>
 				<tr><th class="field-label">Author: </th><td><t:field t:name="author" /></td></tr>
 				<tr><th class="field-label">Mode: </th><td><t:choice t:name="mode" t:choices="modes" /></td></tr>
-				<tr><th class="field-label big-field-label">Description:</th><td><t:textarea t:name="contents" /></td></tr>
-				<tr><th class="field-label">Captcha: </th><td><t:captcha t:name="captcha" /></td></tr>
+				<tr><th class="field-label big-field-label">Body:</th><td><t:textarea t:name="contents" t:rows="20" t:cols="60" /></td></tr>
+				<tr><th class="field-label">Captcha: </th><td><t:field t:name="captcha" /></td></tr>
 				<tr>
 				<td></td>
 				<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor
index 0772181b00..9852bf47cb 100644
--- a/extra/webapps/pastebin/pastebin.factor
+++ b/extra/webapps/pastebin/pastebin.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces assocs sorting sequences kernel accessors
-hashtables sequences.lib db.types db.tuples db
+hashtables sequences.lib db.types db.tuples db combinators
 calendar calendar.format math.parser rss xml.writer
 xmode.catalog validators html.components html.templates.chloe
 http.server
@@ -121,7 +121,9 @@ M: annotation entity-link
             validate-integer-id
             "id" value paste from-tuple
 
+            "id" value
             "new-annotation" [
+                "id" set-value
                 mode-names "modes" set-value
                 "factor" "mode" set-value
             ] nest-values
@@ -145,6 +147,19 @@ M: annotation entity-link
         [ validate-integer-id ] >>init
         [ "id" value paste annotations>> paste-feed ] >>feed ;
 
+: validate-paste ( -- )
+    {
+        { "summary" [ v-one-line ] }
+        { "author" [ v-one-line ] }
+        { "mode" [ v-mode ] }
+        { "contents" [ v-required ] }
+        { "captcha" [ v-captcha ] }
+    } validate-params ;
+
+: deposit-paste-slots ( tuple -- )
+    now >>date
+    { "summary" "author" "mode" "contents" } deposit-slots ;
+
 : <new-paste-action> ( -- action )
     <page-action>
         [
@@ -155,19 +170,13 @@ M: annotation entity-link
         "new-paste" pastebin-template >>template
 
         [
-            {
-                { "summary" [ v-one-line ] }
-                { "author" [ v-one-line ] }
-                { "mode" [ v-mode ] }
-                { "contents" [ v-required ] }
-                { "captcha" [ v-captcha ] }
-            } validate-params
+            validate-paste
 
             f <paste>
-                now >>date
-                dup { "summary" "author" "mode" "contents" } deposit-slots
+            [ deposit-paste-slots ]
             [ insert-tuple ]
-            [ id>> "$pastebin/paste" <id-redirect> ] bi
+            [ id>> "$pastebin/paste" <id-redirect> ]
+            tri
         ] >>submit ;
 
 : <delete-paste-action> ( -- action )
@@ -185,26 +194,22 @@ M: annotation entity-link
 ! ! !
 
 : <new-annotation-action> ( -- action )
-    <action>
-        [
-            {
-                { "summary" [ v-one-line ] }
-                { "author" [ v-one-line ] }
-                { "mode" [ v-mode ] }
-                { "contents" [ v-required ] }
-                { "captcha" [ v-captcha ] }
-            } validate-params
-        ] >>validate
+    <page-action>
+        [ validate-paste ] >>validate
+
+        [ "id" param "$pastebin/paste" <id-redirect> ] >>display
 
         [
             f f <annotation>
-                now >>date
-                dup { "summary" "author" "mode" "contents" } deposit-slots
-            [ insert-tuple ]
-            [
-                ! Add anchor here
-                "id" value "$pastebin/paste" <id-redirect>
-            ] bi
+            {
+                [ deposit-paste-slots ]
+                [ { "id" } deposit-slots ]
+                [ insert-tuple ]
+                [
+                    ! Add anchor here
+                    id>> "$pastebin/paste" <id-redirect>
+                ]
+            } cleave
         ] >>submit ;
 
 : <delete-annotation-action> ( -- action )
diff --git a/extra/webapps/pastebin/pastebin.xml b/extra/webapps/pastebin/pastebin.xml
index f0abd97c63..9ec2cb7976 100644
--- a/extra/webapps/pastebin/pastebin.xml
+++ b/extra/webapps/pastebin/pastebin.xml
@@ -13,9 +13,9 @@
 
 		<t:each-tuple t:values="pastes">
 			<tr>
-				<td><t:a t:href="$pastebin/view-paste" t:query="id"><t:field t:name="summary" /></t:a></td>
-				<td><t:field t:name="author" /></td>
-				<td><t:field t:name="date" /></td>
+				<td><t:a t:href="$pastebin/paste" t:query="id"><t:label t:name="summary" /></t:a></td>
+				<td><t:label t:name="author" /></td>
+				<td><t:label t:name="date" /></td>
 			</tr>
 		</t:each-tuple>
 	</table>
diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor
index e3b5b17a32..414a59f3b2 100755
--- a/extra/webapps/planet/planet.factor
+++ b/extra/webapps/planet/planet.factor
@@ -132,6 +132,9 @@ posting "POSTINGS"
 : <id-redirect> ( id next -- response )
     swap "id" associate <standard-redirect> ;
 
+: deposit-blog-slots ( blog -- )
+    { "name" "www-url" "feed-url" } deposit-slots ;
+
 : <new-blog-action> ( -- action )
     <page-action>
         "new-blog" planet-template >>template
@@ -140,9 +143,10 @@ posting "POSTINGS"
 
         [
             f <blog>
-                dup { "name" "www-url" "feed-url" } deposit-slots
+            [ deposit-blog-slots ]
             [ insert-tuple ]
-            [ id>> "$planet-factor/admin/edit-blog" <id-redirect> ] bi
+            [ id>> "$planet-factor/admin/edit-blog" <id-redirect> ]
+            tri
         ] >>submit ;
     
 : <edit-blog-action> ( -- action )
@@ -161,9 +165,10 @@ posting "POSTINGS"
 
         [
             f <blog>
-                dup { "id" "name" "www-url" "feed-url" } deposit-slots
+            [ deposit-blog-slots ]
             [ update-tuple ]
-            [ id>> "$planet-factor/admin" <id-redirect> ] bi
+            [ id>> "$planet-factor/admin" <id-redirect> ]
+            tri
         ] >>submit ;
 
 TUPLE: planet-factor-admin < dispatcher ;

From 79d1570b35588de0e895a561b25a1e99fad1e75e Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Mon, 26 May 2008 04:35:18 -0400
Subject: [PATCH 27/39] Refactoring, cleaning up code

---
 extra/lisp/lisp-tests.factor |  2 +-
 extra/lisp/lisp.factor       | 91 ++++++++++++++++++------------------
 2 files changed, 47 insertions(+), 46 deletions(-)

diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor
index f1db203a78..0312080907 100644
--- a/extra/lisp/lisp-tests.factor
+++ b/extra/lisp/lisp-tests.factor
@@ -7,7 +7,7 @@ IN: lisp.test
 [
     init-env
     
-    "#f" [ f ] lisp-define 
+    "#f" [ f ] lisp-define
     "#t" [ t ] lisp-define
     
     "+" "math" "+" define-primitve
diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor
index 0f5e4b4d2e..82a331f2ca 100644
--- a/extra/lisp/lisp.factor
+++ b/extra/lisp/lisp.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel peg sequences arrays strings combinators.lib
 namespaces combinators math bake locals locals.private accessors
-vectors syntax lisp.parser assocs parser sequences.lib words quotations ;
+vectors syntax lisp.parser assocs parser sequences.lib words quotations
+fry ;
 IN: lisp
 
 DEFER: convert-form
@@ -12,52 +13,52 @@ DEFER: lookup-var
 ! Functions to convert s-exps to quotations
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 : convert-body ( s-exp -- quot )
-  [ convert-form ] map [ ] [ compose ] reduce ; inline
+    [ ] [ convert-form compose ] reduce ; inline
   
 : convert-if ( s-exp -- quot )
-  rest [ convert-form ] map reverse first3  [ % , , if ] bake ;
-  
+    rest first3 [ convert-form ] tri@ '[ @ , , if ] ;
+    
 : convert-begin ( s-exp -- quot )  
-  rest [ convert-form ] map >quotation [ , [ funcall ] each ] bake ;
-  
+    rest [ convert-form ] [ ] map-as '[ , [ funcall ] each ] ;
+    
 : convert-cond ( s-exp -- quot )  
-  rest [ body>> >array [ convert-form ] map first2 swap `{ [ % funcall ] , } bake ]
-  map >array [ , cond ] bake ;
-  
+    rest [ body>> first2 [ convert-form ] bi@ [ '[ @ funcall ] ] dip 2array ]
+    { } map-as '[ , cond ]  ;
+    
 : convert-general-form ( s-exp -- quot )
-  unclip convert-form swap convert-body [ , % funcall ] bake ;
+    unclip convert-form swap convert-body swap '[ , @ funcall ] ;
 
 ! words for convert-lambda  
 <PRIVATE  
 : localize-body ( assoc body -- assoc newbody )  
-  [ dup lisp-symbol? [ over dupd [ name>> ] dip at swap or ]
+    [ dup lisp-symbol? [ over dupd [ name>> ] dip at swap or ]
                      [ dup s-exp? [ body>> localize-body <s-exp> ] when ] if
                    ] map ;
-  
+    
 : localize-lambda ( body vars -- newbody newvars )
-  make-locals dup push-locals swap
-  [ swap localize-body <s-exp> convert-form swap pop-locals ] dip swap ;
+    make-locals dup push-locals swap
+    [ swap localize-body <s-exp> convert-form swap pop-locals ] dip swap ;
                    
 : split-lambda ( s-exp -- body vars )                   
-  first3 -rot nip [ body>> ] bi@ [ name>> ] map ; inline
-  
+    first3 -rot nip [ body>> ] bi@ [ name>> ] map ; inline
+    
 : rest-lambda ( body vars -- quot )  
-  "&rest" swap [ remove ] [ index ] 2bi
-  [ localize-lambda <lambda> ] dip
-  [ , cut swap [ % , ] bake , compose ] bake ;
-  
+    "&rest" swap [ index ] [ remove ] 2bi
+    localize-lambda <lambda>
+    '[ , cut '[ @ , ] , compose ] ;
+    
 : normal-lambda ( body vars -- quot )
-  localize-lambda <lambda> [ , compose ] bake ;
+    localize-lambda <lambda> '[ , compose ] ;
 PRIVATE>
-  
+    
 : convert-lambda ( s-exp -- quot )  
-  split-lambda dup "&rest"  swap member? [ rest-lambda ] [ normal-lambda ] if ;
-  
+    split-lambda "&rest" over member? [ rest-lambda ] [ normal-lambda ] if ;
+    
 : convert-quoted ( s-exp -- quot )  
-  second [ , ] bake ;
-  
+    second 1quotation ;
+    
 : convert-list-form ( s-exp -- quot )  
-  dup first dup lisp-symbol?
+    dup first dup lisp-symbol?
     [ name>>
       { { "lambda" [ convert-lambda ] }
         { "quote" [ convert-quoted ] }
@@ -67,35 +68,35 @@ PRIVATE>
        [ drop convert-general-form ]
       } case ]
     [ drop convert-general-form ] if ;
-  
+    
 : convert-form ( lisp-form -- quot )
-  { { [ dup s-exp? ] [ body>> convert-list-form ] }
-    { [ dup lisp-symbol? ] [ [ , lookup-var ] bake ] }
-    [ [ , ] bake ]
-  } cond ;
-                
+    { { [ dup s-exp? ] [ body>> convert-list-form ] }
+    { [ dup lisp-symbol? ] [ '[ , lookup-var ] ] }
+    [ 1quotation ]
+    } cond ;
+    
 : lisp-string>factor ( str -- quot )
-  lisp-expr parse-result-ast convert-form lambda-rewrite call ;
-  
+    lisp-expr parse-result-ast convert-form lambda-rewrite call ;
+    
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 SYMBOL: lisp-env
 ERROR: no-such-var var ;
 
 : init-env ( -- )
-  H{ } clone lisp-env set ;
+    H{ } clone lisp-env set ;
 
 : lisp-define ( name quot -- )
-  swap lisp-env get set-at ;
-  
+    swap lisp-env get set-at ;
+    
 : lisp-get ( name -- word )
-  dup lisp-env get at [ ] [ no-such-var throw ] ?if ;
-  
+    dup lisp-env get at [ ] [ no-such-var throw ] ?if ;
+    
 : lookup-var ( lisp-symbol -- quot )
-  name>> lisp-get ;
-  
+    name>> lisp-get ;
+    
 : funcall ( quot sym -- * )
-  dup lisp-symbol?  [ lookup-var ] when call ; inline
-  
+    dup lisp-symbol?  [ lookup-var ] when call ; inline
+    
 : define-primitve ( name vocab word -- )  
-  swap lookup [ [ , ] compose call ] bake lisp-define ;
\ No newline at end of file
+    swap lookup 1quotation '[ , compose call ] lisp-define ;
\ No newline at end of file

From a77bbfc28e8a34c804970e416a025bf3bbaed80d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 05:44:33 -0500
Subject: [PATCH 28/39] Fix unit test failure

---
 core/parser/parser-tests.factor | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index 6f31b0ad7c..e8199d3520 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -463,7 +463,25 @@ must-fail-with
 
 [ [ ] ] [
     2 [
-        "IN: classes.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
+        "IN: parser.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
         <string-reader> "twice-fails-test" parse-stream
     ] times
 ] unit-test
+
+[ [ ] ] [
+    "IN: parser.tests : staging-problem-test-1 1 ; : staging-problem-test-2 staging-problem-test-1 ;"
+    <string-reader> "staging-problem-test" parse-stream
+] unit-test
+
+[ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test
+
+[ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
+
+[ [ ] ] [
+    "IN: parser.tests << : staging-problem-test-1 1 ; >> : staging-problem-test-2 staging-problem-test-1 ;"
+    <string-reader> "staging-problem-test" parse-stream
+] unit-test
+
+[ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test
+
+[ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test

From 8af320a2c00133718b1e6a23684e382c5cc1442b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 17:15:54 -0500
Subject: [PATCH 29/39] Improve math.functions

---
 extra/math/functions/functions-tests.factor |  6 ++
 extra/math/functions/functions.factor       | 66 +++++++++++++--------
 extra/math/libm/libm.factor                 | 20 +++++++
 3 files changed, 67 insertions(+), 25 deletions(-)

diff --git a/extra/math/functions/functions-tests.factor b/extra/math/functions/functions-tests.factor
index c9215d8de7..51879fc6c6 100755
--- a/extra/math/functions/functions-tests.factor
+++ b/extra/math/functions/functions-tests.factor
@@ -39,6 +39,12 @@ IN: math.functions.tests
 [ 0.0 ] [ 0 sin ] unit-test
 [ 0.0 ] [ 0 asin ] unit-test
 
+[ t ] [ 10 atan real? ] unit-test
+[ f ] [ 10 atanh real? ] unit-test
+
+[ t ] [ 10 asin sin 10 1.e-10 ~ ] unit-test
+[ t ] [ -1 sqrt neg dup acos cos 1.e-10 ~ ] unit-test
+
 [ 100 ] [ 100 100 gcd nip ] unit-test
 [ 100 ] [ 1000 100 gcd nip ] unit-test
 [ 100 ] [ 100 1000 gcd nip ] unit-test
diff --git a/extra/math/functions/functions.factor b/extra/math/functions/functions.factor
index bce93fbb11..bb43e4a721 100755
--- a/extra/math/functions/functions.factor
+++ b/extra/math/functions/functions.factor
@@ -125,74 +125,90 @@ M: real absq sq ;
 M: number (^)
     swap >polar 3dup ^theta >r ^mag r> polar> ;
 
+: [-1,1]? ( x -- ? )
+    dup complex? [ drop f ] [ abs 1 <= ] if ; inline
+
+: >=1? ( x -- ? )
+    dup complex? [ drop f ] [ 1 >= ] if ; inline
+
 : exp ( x -- y ) >rect swap fexp swap polar> ; inline
 
 : log ( x -- y ) >polar swap flog swap rect> ; inline
 
 : cos ( x -- y )
-    >float-rect 2dup
-    fcosh swap fcos * -rot
-    fsinh swap fsin neg * rect> ; foldable
+    dup complex? [
+        >float-rect 2dup
+        fcosh swap fcos * -rot
+        fsinh swap fsin neg * rect>
+    ] [ fcos ] if ; foldable
 
 : sec ( x -- y ) cos recip ; inline
 
 : cosh ( x -- y )
-    >float-rect 2dup
-    fcos swap fcosh * -rot
-    fsin swap fsinh * rect> ; foldable
+    dup complex? [
+        >float-rect 2dup
+        fcos swap fcosh * -rot
+        fsin swap fsinh * rect>
+    ] [ fcosh ] if ; foldable
 
 : sech ( x -- y ) cosh recip ; inline
 
 : sin ( x -- y )
-    >float-rect 2dup
-    fcosh swap fsin * -rot
-    fsinh swap fcos * rect> ; foldable
+    dup complex? [
+        >float-rect 2dup
+        fcosh swap fsin * -rot
+        fsinh swap fcos * rect>
+    ] [ fsin ] if ; foldable
 
 : cosec ( x -- y ) sin recip ; inline
 
 : sinh ( x -- y )
-    >float-rect 2dup
-    fcos swap fsinh * -rot
-    fsin swap fcosh * rect> ; foldable
+    dup complex? [
+        >float-rect 2dup
+        fcos swap fsinh * -rot
+        fsin swap fcosh * rect>
+    ] [ fsinh ] if ; foldable
 
 : cosech ( x -- y ) sinh recip ; inline
 
-: tan ( x -- y ) dup sin swap cos / ; inline
+: tan ( x -- y )
+    dup complex? [ dup sin swap cos / ] [ ftan ] if ; inline
 
-: tanh ( x -- y ) dup sinh swap cosh / ; inline
+: tanh ( x -- y )
+    dup complex? [ dup sinh swap cosh / ] [ ftanh ] if ; inline
 
-: cot ( x -- y ) dup cos swap sin / ; inline
+: cot ( x -- y ) tan recip ; inline
 
-: coth ( x -- y ) dup cosh swap sinh / ; inline
+: coth ( x -- y ) tanh recip ; inline
 
-: acosh ( x -- y ) dup sq 1- sqrt + log ; inline
+: acosh ( x -- y )
+    dup >=1? [ facosh ] [ dup sq 1- sqrt + log ] if ; inline
 
 : asech ( x -- y ) recip acosh ; inline
 
-: asinh ( x -- y ) dup sq 1+ sqrt + log ; inline
+: asinh ( x -- y )
+    dup complex? [ dup sq 1+ sqrt + log ] [ fasinh ] if ; inline
 
 : acosech ( x -- y ) recip asinh ; inline
 
-: atanh ( x -- y ) dup 1+ swap 1- neg / log 2 / ; inline
+: atanh ( x -- y )
+    dup [-1,1]? [ fatanh ] [ dup 1+ swap 1- neg / log 2 / ] if ; inline
 
 : acoth ( x -- y ) recip atanh ; inline
 
-: [-1,1]? ( x -- ? )
-    dup complex? [ drop f ] [ abs 1 <= ] if ; inline
-
 : i* ( x -- y ) >rect neg swap rect> ;
 
 : -i* ( x -- y ) >rect swap neg rect> ;
 
 : asin ( x -- y )
-    dup [-1,1]? [ >float fasin ] [ i* asinh -i* ] if ; inline
+    dup [-1,1]? [ fasin ] [ i* asinh -i* ] if ; inline
 
 : acos ( x -- y )
-    dup [-1,1]? [ >float facos ] [ asin pi 2 / swap - ] if ;
+    dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ;
     inline
 
 : atan ( x -- y )
-    dup [-1,1]? [ >float fatan ] [ i* atanh i* ] if ; inline
+    dup complex? [ i* atanh i* ] [ fatan ] if ; inline
 
 : asec ( x -- y ) recip acos ; inline
 
diff --git a/extra/math/libm/libm.factor b/extra/math/libm/libm.factor
index 0cc402e6e5..f70c8d2a77 100644
--- a/extra/math/libm/libm.factor
+++ b/extra/math/libm/libm.factor
@@ -15,6 +15,18 @@ IN: math.libm
     "double" "libm" "atan" { "double" } alien-invoke ;
     foldable
 
+: facosh ( x -- y )
+    "double" "libm" "acosh" { "double" } alien-invoke ;
+    foldable
+
+: fasinh ( x -- y )
+    "double" "libm" "asinh" { "double" } alien-invoke ;
+    foldable
+
+: fatanh ( x -- y )
+    "double" "libm" "atanh" { "double" } alien-invoke ;
+    foldable
+
 : fatan2 ( x y -- z )
     "double" "libm" "atan2" { "double" "double" } alien-invoke ;
     foldable
@@ -27,6 +39,10 @@ IN: math.libm
     "double" "libm" "sin" { "double" } alien-invoke ;
     foldable
 
+: ftan ( x -- y )
+    "double" "libm" "tan" { "double" } alien-invoke ;
+    foldable
+
 : fcosh ( x -- y )
     "double" "libm" "cosh" { "double" } alien-invoke ;
     foldable
@@ -35,6 +51,10 @@ IN: math.libm
     "double" "libm" "sinh" { "double" } alien-invoke ;
     foldable
 
+: ftanh ( x -- y )
+    "double" "libm" "tanh" { "double" } alien-invoke ;
+    foldable
+
 : fexp ( x -- y )
     "double" "libm" "exp" { "double" } alien-invoke ;
     foldable

From c3aa938869ae9f6e0b10b55ebc88c0a84ba2a249 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 May 2008 17:21:51 -0500
Subject: [PATCH 30/39] Another unit test

---
 extra/math/functions/functions-tests.factor | 1 +
 1 file changed, 1 insertion(+)

diff --git a/extra/math/functions/functions-tests.factor b/extra/math/functions/functions-tests.factor
index 51879fc6c6..6176c12d21 100755
--- a/extra/math/functions/functions-tests.factor
+++ b/extra/math/functions/functions-tests.factor
@@ -44,6 +44,7 @@ IN: math.functions.tests
 
 [ t ] [ 10 asin sin 10 1.e-10 ~ ] unit-test
 [ t ] [ -1 sqrt neg dup acos cos 1.e-10 ~ ] unit-test
+[ t ] [ 10 asinh sinh 10 1.e-10 ~ ] unit-test
 
 [ 100 ] [ 100 100 gcd nip ] unit-test
 [ 100 ] [ 1000 100 gcd nip ] unit-test

From 8f69fd5aa89d087c01a4c5561be8d4623053d7ed Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 27 May 2008 00:01:04 -0500
Subject: [PATCH 31/39] Fix simple links

---
 extra/farkup/farkup-tests.factor | 2 +-
 extra/farkup/farkup.factor       | 8 ++++++--
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor
index 043502cd24..4abd655d62 100755
--- a/extra/farkup/farkup-tests.factor
+++ b/extra/farkup/farkup-tests.factor
@@ -67,7 +67,7 @@ IN: farkup.tests
 
 [ "<p><img src=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
 [ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
-[ "<p><a href=\"lol.com\"></a></p>" ] [ "[[lol.com]]" convert-farkup ] unit-test
+[ "<p><a href=\"lol.com\">lol.com</a></p>" ] [ "[[lol.com]]" convert-farkup ] unit-test
 [ "<p><a href=\"lol.com\">haha</a></p>" ] [ "[[lol.com|haha]]" convert-farkup ] unit-test
 
 [ ] [ "[{}]" convert-farkup drop ] unit-test
diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
index fad237635f..5dcfa7528e 100755
--- a/extra/farkup/farkup.factor
+++ b/extra/farkup/farkup.factor
@@ -6,6 +6,8 @@ splitting io.streams.string peg.parsers
 sequences.deep unicode.categories ;
 IN: farkup
 
+SYMBOL: relative-link-prefix
+
 <PRIVATE
 
 : delimiters ( -- string )
@@ -68,7 +70,9 @@ MEMO: eq ( -- parser )
     CHAR: : over member? [
         dup { "http://" "https://" "ftp://" } [ head? ] with contains?
         [ drop "/" ] unless
-    ] when ;
+    ] [
+        relative-link-prefix get prepend
+    ] if ;
 
 : escape-link ( href text -- href-esc text-esc )
     >r check-url escape-quoted-string r> escape-string ;
@@ -100,7 +104,7 @@ MEMO: simple-link ( -- parser )
         "[[" token hide ,
         [ "|]" member? not ] satisfy repeat1 ,
         "]]" token hide ,
-    ] seq* [ first f make-link ] action ;
+    ] seq* [ first dup make-link ] action ;
 
 MEMO: labelled-link ( -- parser )
     [

From 91d7adcbf1274971e16f53f94aa6915b70cb71b7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 27 May 2008 00:01:27 -0500
Subject: [PATCH 32/39] Comparison component

---
 extra/html/components/components.factor | 9 ++++++++-
 extra/html/templates/chloe/chloe.factor | 1 +
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/extra/html/components/components.factor b/extra/html/components/components.factor
index 382636d952..efac730af6 100644
--- a/extra/html/components/components.factor
+++ b/extra/html/components/components.factor
@@ -4,7 +4,8 @@ USING: accessors kernel namespaces io math.parser assocs classes
 classes.tuple words arrays sequences sequences.lib splitting
 mirrors hashtables combinators continuations math strings
 fry locals calendar calendar.format xml.entities validators
-html.elements html.streams xmode.code2html farkup inspector ;
+html.elements html.streams xmode.code2html farkup inspector
+lcs.diff2html ;
 IN: html.components
 
 SYMBOL: values
@@ -211,6 +212,12 @@ SINGLETON: inspector
 M: inspector render*
     2drop [ describe ] with-html-stream ;
 
+! Diff component
+SINGLETON: comparison
+
+M: comparison render*
+    2drop htmlize-diff ;
+
 ! HTML component
 SINGLETON: html
 
diff --git a/extra/html/templates/chloe/chloe.factor b/extra/html/templates/chloe/chloe.factor
index 6790a9f666..092f79bb36 100644
--- a/extra/html/templates/chloe/chloe.factor
+++ b/extra/html/templates/chloe/chloe.factor
@@ -272,6 +272,7 @@ STRING: button-tag-markup
         { "code" [ code tuple-component-tag ] }
         { "farkup" [ farkup singleton-component-tag ] }
         { "inspector" [ inspector singleton-component-tag ] }
+        { "comparison" [ comparison singleton-component-tag ] }
         { "html" [ html singleton-component-tag ] }
 
         ! Forms

From e7438f4ab6f08456994bb932e10110f0cf5ecd84 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 27 May 2008 00:01:57 -0500
Subject: [PATCH 33/39] Add support for rest urls

---
 extra/http/server/actions/actions.factor | 34 +++++++++++++++---------
 1 file changed, 22 insertions(+), 12 deletions(-)

diff --git a/extra/http/server/actions/actions.factor b/extra/http/server/actions/actions.factor
index bcd2cbd585..eb5b8bfe68 100755
--- a/extra/http/server/actions/actions.factor
+++ b/extra/http/server/actions/actions.factor
@@ -2,11 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors sequences kernel assocs combinators http.server
 validators http hashtables namespaces fry continuations locals
-boxes xml.entities html.elements html.components io arrays ;
+boxes xml.entities html.elements html.components io arrays math ;
 IN: http.server.actions
 
 SYMBOL: params
 
+SYMBOL: rest-param
+
 : render-validation-messages ( -- )
     validation-messages get
     dup empty? [ drop ] [
@@ -15,7 +17,7 @@ SYMBOL: params
         </ul>
     ] if ;
 
-TUPLE: action init display validate submit ;
+TUPLE: action rest-param init display validate submit ;
 
 : new-action ( class -- action )
     new
@@ -43,19 +45,27 @@ TUPLE: action init display validate submit ;
     [ validate>> call ]
     [ submit>> call ] bi ;
 
+: handle-rest-param ( arg -- )
+    dup length 1 > action get rest-param>> not or
+    [ <404> exit-with ] [
+        action get rest-param>> associate rest-param set
+    ] if ;
+
 M: action call-responder* ( path action -- response )
     dup action set
     '[
-        , empty? [
-            init-validation
-            ,
-            request get [ request-params params set ] [ method>> ] bi
-            {
-                { "GET" [ handle-get ] }
-                { "HEAD" [ handle-get ] }
-                { "POST" [ handle-post ] }
-            } case
-        ] [ <404> ] if
+        , dup empty? [ drop ] [ handle-rest-param ] if
+
+        init-validation
+        ,
+        request get
+        [ request-params rest-param get assoc-union params set ]
+        [ method>> ] bi
+        {
+            { "GET" [ handle-get ] }
+            { "HEAD" [ handle-get ] }
+            { "POST" [ handle-post ] }
+        } case
     ] with-exit-continuation ;
 
 : param ( name -- value )

From 5f4ffa998fed0594d3529efdb339da86a3f88985 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 27 May 2008 00:02:16 -0500
Subject: [PATCH 34/39] Wiki

---
 extra/lcs/diff2html/diff2html.factor          |  44 +++++
 .../factor-website/factor-website.factor      |   9 +-
 extra/webapps/factor-website/page.css         |   7 +-
 extra/webapps/wiki/articles.xml               |  15 ++
 extra/webapps/wiki/diff.xml                   |  35 ++++
 extra/webapps/wiki/edit.xml                   |  20 ++
 extra/webapps/wiki/revisions.xml              |  48 +++++
 extra/webapps/wiki/view.xml                   |  19 ++
 extra/webapps/wiki/wiki-common.xml            |  28 +++
 extra/webapps/wiki/wiki.css                   |  25 +++
 extra/webapps/wiki/wiki.factor                | 175 ++++++++++++++++++
 11 files changed, 421 insertions(+), 4 deletions(-)
 create mode 100644 extra/lcs/diff2html/diff2html.factor
 create mode 100644 extra/webapps/wiki/articles.xml
 create mode 100644 extra/webapps/wiki/diff.xml
 create mode 100644 extra/webapps/wiki/edit.xml
 create mode 100644 extra/webapps/wiki/revisions.xml
 create mode 100644 extra/webapps/wiki/view.xml
 create mode 100644 extra/webapps/wiki/wiki-common.xml
 create mode 100644 extra/webapps/wiki/wiki.css
 create mode 100644 extra/webapps/wiki/wiki.factor

diff --git a/extra/lcs/diff2html/diff2html.factor b/extra/lcs/diff2html/diff2html.factor
new file mode 100644
index 0000000000..a8f649e2c9
--- /dev/null
+++ b/extra/lcs/diff2html/diff2html.factor
@@ -0,0 +1,44 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: lcs html.elements kernel qualified ;
+FROM: accessors => item>> ;
+FROM: io => write ;
+FROM: sequences => each empty? ;
+FROM: xml.entities => escape-string ;
+IN: lcs.diff2html
+
+GENERIC: diff-line ( obj -- )
+
+: write-item ( item -- )
+    item>> dup empty? [ drop "&nbsp;" ] [ escape-string ] if write ;
+
+M: retain diff-line
+    <tr>
+        dup [
+            <td "retain" =class td>
+                write-item
+            </td>
+        ] bi@
+    </tr> ;
+
+M: insert diff-line
+    <tr>
+        <td> </td>
+        <td "insert" =class td>
+            write-item
+        </td>
+    </tr> ;
+
+M: delete diff-line
+    <tr>
+        <td "delete" =class td>
+            write-item
+        </td>
+        <td> </td>
+    </tr> ;
+
+: htmlize-diff ( diff -- )
+    <table "comparison" =class table>
+        <tr> <th> "Old" write </th> <th> "New" write </th> </tr>
+        [ diff-line ] each
+    </table> ;
diff --git a/extra/webapps/factor-website/factor-website.factor b/extra/webapps/factor-website/factor-website.factor
index 1fb5d4c1a6..9ad4a05492 100644
--- a/extra/webapps/factor-website/factor-website.factor
+++ b/extra/webapps/factor-website/factor-website.factor
@@ -11,10 +11,11 @@ http.server.auth.login
 http.server.auth.providers.db
 http.server.boilerplate
 html.templates.chloe
-webapps.user-admin
 webapps.pastebin
 webapps.planet
-webapps.todo ;
+webapps.todo
+webapps.wiki
+webapps.user-admin ;
 IN: webapps.factor-website
 
 : test-db "resource:test.db" sqlite-db ;
@@ -34,6 +35,9 @@ IN: webapps.factor-website
         init-postings-table
 
         init-todo-table
+
+        init-articles-table
+        init-revisions-table
     ] with-db ;
 
 : <factor-website> ( -- responder )
@@ -41,6 +45,7 @@ IN: webapps.factor-website
         <todo-list> "todo" add-responder
         <pastebin> "pastebin" add-responder
         <planet-factor> "planet" add-responder
+        <wiki> "wiki" add-responder
         <user-admin> "user-admin" add-responder
     <login>
         users-in-db >>users
diff --git a/extra/webapps/factor-website/page.css b/extra/webapps/factor-website/page.css
index 606d574618..49e26883ad 100644
--- a/extra/webapps/factor-website/page.css
+++ b/extra/webapps/factor-website/page.css
@@ -42,12 +42,15 @@ a:hover, .link:hover {
 }
 
 .description {
-	border: 1px dashed #ccc;
-	background-color: #f5f5f5;
 	padding: 5px;
 	color: #000;
 }
 
+.description pre {
+	border: 1px dashed #ccc;
+	background-color: #f5f5f5;
+}
+
 .description p:first-child {
 	margin-top: 0px;
 }
diff --git a/extra/webapps/wiki/articles.xml b/extra/webapps/wiki/articles.xml
new file mode 100644
index 0000000000..a552c2618f
--- /dev/null
+++ b/extra/webapps/wiki/articles.xml
@@ -0,0 +1,15 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>All Articles</t:title>
+
+	<ul>
+		<t:each-tuple t:values="articles">
+			<li>
+				<t:a t:href="view" t:query="title"><t:label t:name="title"/></t:a>
+			</li>
+		</t:each-tuple>
+	</ul>
+
+</t:chloe>
diff --git a/extra/webapps/wiki/diff.xml b/extra/webapps/wiki/diff.xml
new file mode 100644
index 0000000000..378466f0bb
--- /dev/null
+++ b/extra/webapps/wiki/diff.xml
@@ -0,0 +1,35 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:bind-tuple t:name="old">
+		<t:title>Diff: <t:label t:name="title" /></t:title>
+	</t:bind-tuple>
+
+	<table>
+		<tr>
+			<th class="field-label">Old revision:</th>
+			<t:bind-tuple t:name="old">
+				<td>Created on <t:label t:name="date" /> by <t:label t:name="author" />.</td>
+			</t:bind-tuple>
+		</tr>
+		<tr>
+			<th class="field-label">New revision:</th>
+			<t:bind-tuple t:name="old">
+				<td>Created on <t:label t:name="date" /> by <t:label t:name="author" />.</td>
+			</t:bind-tuple>
+		</tr>
+	</table>
+
+	<t:comparison t:name="diff" />
+
+	<t:bind-tuple t:name="old">
+		<div class="navbar">
+			<t:a t:href="$wiki/view" t:query="title">Latest</t:a>
+			| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
+			| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
+			| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
+		</div>
+	</t:bind-tuple>
+
+</t:chloe>
diff --git a/extra/webapps/wiki/edit.xml b/extra/webapps/wiki/edit.xml
new file mode 100644
index 0000000000..85c8490c5d
--- /dev/null
+++ b/extra/webapps/wiki/edit.xml
@@ -0,0 +1,20 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>Edit: <t:label t:name="title" /></t:title>
+
+	<t:form t:action="$wiki/edit" t:for="title">
+
+		<p>
+			<t:textarea t:name="content" t:rows="30" t:cols="80" />
+		</p>
+
+		<p>
+			<input type="submit" value="Save" />
+		</p>
+
+	</t:form>
+
+	<t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
+</t:chloe>
diff --git a/extra/webapps/wiki/revisions.xml b/extra/webapps/wiki/revisions.xml
new file mode 100644
index 0000000000..fe74191773
--- /dev/null
+++ b/extra/webapps/wiki/revisions.xml
@@ -0,0 +1,48 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>Revisions of <t:label t:name="title" /></t:title>
+
+	<ul>
+		<t:each-tuple t:values="revisions">
+			<li>
+				<t:a t:href="revision" t:query="id">
+					<t:label t:name="date" /> by <t:label t:name="author" />
+				</t:a>
+			</li>
+		</t:each-tuple>
+	</ul>
+
+	<h2>View Differences</h2>
+
+	<form action="diff" method="get">
+		<table>
+			<tr>
+				<th class="field-label">Old revision:</th>
+				
+				<td>
+					<select name="old-id">
+						<t:each-tuple t:values="revisions">
+							<option> <t:label t:name="id" /> </option>
+						</t:each-tuple>
+					</select>
+				</td>
+			</tr>
+			<tr>
+				<th class="field-label">New revision:</th>
+				
+				<td>
+					<select name="new-id">
+						<t:each-tuple t:values="revisions">
+							<option> <t:label t:name="id" /> </option>
+						</t:each-tuple>
+					</select>
+				</td>
+			</tr>
+		</table>
+
+		<input type="submit" value="View" />
+	</form>
+
+</t:chloe>
diff --git a/extra/webapps/wiki/view.xml b/extra/webapps/wiki/view.xml
new file mode 100644
index 0000000000..c3536f374d
--- /dev/null
+++ b/extra/webapps/wiki/view.xml
@@ -0,0 +1,19 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title><t:label t:name="title" /></t:title>
+
+	<div class="description">
+		<t:farkup t:name="content" />
+	</div>
+
+	<div class="navbar">
+		<t:a t:href="$wiki/view" t:query="title">Latest</t:a>
+		| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
+		| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
+		| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
+		| This revision created on <t:label t:name="date" /> by <t:label t:name="author" />.
+	</div>
+
+</t:chloe>
diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml
new file mode 100644
index 0000000000..d241f910ca
--- /dev/null
+++ b/extra/webapps/wiki/wiki-common.xml
@@ -0,0 +1,28 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:style t:include="resource:extra/webapps/wiki/wiki.css" />
+
+	<div class="navbar">
+
+		<t:a t:href="$wiki">Front Page</t:a>
+		| <t:a t:href="$wiki/articles">All Articles</t:a>
+
+		<t:if t:code="http.server.sessions:uid">
+
+			<t:if t:code="http.server.auth.login:allow-edit-profile?">
+				| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
+			</t:if>
+
+			| <t:button t:action="$login/logout" t:flow="begin" class="link-button link">Logout</t:button>
+
+		</t:if>
+
+	</div>
+
+	<h1><t:write-title /></h1>
+
+        <t:call-next-template />
+
+</t:chloe>
diff --git a/extra/webapps/wiki/wiki.css b/extra/webapps/wiki/wiki.css
new file mode 100644
index 0000000000..e737cdd898
--- /dev/null
+++ b/extra/webapps/wiki/wiki.css
@@ -0,0 +1,25 @@
+.comparison table, {
+    border-color: #666;
+    border-style: solid;
+}
+
+.comparison th {
+    border-width: 1px;
+    border-color: #666;
+    border-style: solid;
+}
+
+.comparison table {
+    border-width: 1px;
+    border-spacing: 0;
+    border-collapse: collapse;
+}
+
+
+.insert {
+    background-color: #9f9;
+}
+
+.delete {
+    background-color: #f99;
+}
diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
new file mode 100644
index 0000000000..2f281866c5
--- /dev/null
+++ b/extra/webapps/wiki/wiki.factor
@@ -0,0 +1,175 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel hashtables calendar
+namespaces splitting sequences sorting math.order
+html.components
+html.templates.chloe
+http.server
+http.server.actions
+http.server.auth
+http.server.auth.login
+http.server.boilerplate
+validators
+db.types db.tuples lcs farkup ;
+IN: webapps.wiki
+
+TUPLE: article title revision ;
+
+article "ARTICLES" {
+    { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
+    ! { "AUTHOR" INTEGER +not-null+ } ! uid
+    ! { "PROTECTED" BOOLEAN +not-null+ }
+    { "revision" "REVISION" INTEGER +not-null+ } ! revision id
+} define-persistent
+
+: <article> ( title -- article ) article new swap >>title ;
+
+: init-articles-table article ensure-table ;
+
+TUPLE: revision id title author date content ;
+
+revision "REVISIONS" {
+    { "id" "ID" INTEGER +db-assigned-id+ }
+    { "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id
+    { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
+    { "date" "DATE" TIMESTAMP +not-null+ }
+    { "content" "CONTENT" TEXT +not-null+ }
+} define-persistent
+
+: <revision> ( id -- revision )
+    revision new swap >>id ;
+
+: init-revisions-table revision ensure-table ;
+
+: wiki-template ( name -- template )
+    "resource:extra/webapps/wiki/" swap ".xml" 3append <chloe> ;
+
+: <title-redirect> ( title next -- response )
+    swap "title" associate <standard-redirect> ;
+
+: validate-title ( -- )
+    { { "title" [ v-one-line ] } } validate-params ;
+
+: <main-article-action> ( -- action )
+    <action>
+        [ "Front Page" "$wiki/view" <title-redirect> ] >>display ;
+
+: <view-article-action> ( -- action )
+    <action>
+        "title" >>rest-param
+
+        [
+            validate-title
+            "view?title=" relative-link-prefix set
+        ] >>init
+
+        [
+            "title" value dup <article> select-tuple [
+                revision>> <revision> select-tuple from-tuple
+                "view" wiki-template <html-content>
+            ] [
+                "$wiki/edit" <title-redirect>
+            ] ?if
+        ] >>display ;
+
+: <view-revision-action> ( -- action )
+    <page-action>
+        [
+            { { "id" [ v-integer ] } } validate-params
+            "id" value <revision>
+            select-tuple from-tuple
+        ] >>init
+
+        "view" wiki-template >>template ;
+
+: add-revision ( revision -- )
+    [ insert-tuple ]
+    [
+        dup title>> <article> select-tuple [
+            swap id>> >>revision update-tuple
+        ] [
+            [ title>> ] [ id>> ] bi article boa insert-tuple
+        ] if*
+    ] bi ;
+
+: <edit-article-action> ( -- action )
+    <page-action>
+        [
+            validate-title
+            "title" value <article> select-tuple [
+                revision>> <revision> select-tuple from-tuple
+            ] when*
+        ] >>init
+
+        "edit" wiki-template >>template
+        
+        [
+            validate-title
+            { { "content" [ v-required ] } } validate-params
+
+            f <revision>
+                "title" value >>title
+                now >>date
+                logged-in-user get username>> >>author
+                "content" value >>content
+            [ add-revision ]
+            [ title>> "$wiki/view" <title-redirect> ] bi
+        ] >>submit ;
+
+: <list-revisions-action> ( -- action )
+    <page-action>
+        [
+            validate-title
+            f <revision> "title" value >>title select-tuples
+            [ [ date>> ] compare invert-comparison ] sort
+            "revisions" set-value
+        ] >>init
+
+        "revisions" wiki-template >>template ;
+
+: <delete-action> ( -- action )
+    <action>
+        [ validate-title ] >>validate
+
+        [
+            "title" value <article> delete-tuples
+            f <revision> "title" value >>title delete-tuples
+            "" f <standard-redirect>
+        ] >>submit ;
+
+: <diff-action> ( -- action )
+    <page-action>
+        [
+            {
+                { "old-id" [ v-integer ] }
+                { "new-id" [ v-integer ] }
+            } validate-params
+
+            "old-id" "new-id"
+            [ value <revision> select-tuple ] bi@
+            [ [ "old" set-value ] [ "new" set-value ] bi* ]
+            [ [ content>> string-lines ] bi@ diff "diff" set-value ]
+            2bi
+        ] >>init
+
+        "diff" wiki-template >>template ;
+
+: <list-articles-action> ( -- action )
+    <page-action>
+        [ f <article> select-tuples "articles" set-value ] >>init
+        "articles" wiki-template >>template ;
+
+TUPLE: wiki < dispatcher ;
+
+: <wiki> ( -- dispatcher )
+    wiki new-dispatcher
+        <main-article-action> "" add-responder
+        <view-article-action> "view" add-responder
+        <view-revision-action> "revision" add-responder
+        <edit-article-action> { } <protected> "edit" add-responder
+        <list-revisions-action> "revisions" add-responder
+        <delete-action> "delete" add-responder
+        <diff-action> "diff" add-responder
+        <list-articles-action> "articles" add-responder
+    <boilerplate>
+        "wiki-common" wiki-template >>template ;

From 8278ac5b28ac80438bc8e7be2be385d30ed727bd Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 27 May 2008 01:18:38 -0500
Subject: [PATCH 35/39] Various fixes

---
 extra/http/server/auth/login/edit-profile.xml |  2 +-
 extra/http/server/auth/login/register.xml     |  2 +-
 extra/validators/validators-tests.factor      | 15 +++++++++++
 extra/validators/validators.factor            | 25 ++++++++++++++++---
 extra/webapps/user-admin/user-admin.factor    |  1 -
 extra/webapps/wiki/wiki.factor                |  4 +--
 extra/xmode/code2html/code2html.factor        |  2 +-
 7 files changed, 41 insertions(+), 10 deletions(-)

diff --git a/extra/http/server/auth/login/edit-profile.xml b/extra/http/server/auth/login/edit-profile.xml
index 855dfa8469..6beaf5de6d 100644
--- a/extra/http/server/auth/login/edit-profile.xml
+++ b/extra/http/server/auth/login/edit-profile.xml
@@ -10,7 +10,7 @@
 	
 	<tr>
 		<th class="field-label">User name:</th>
-		<td><t:field t:name="username" /></td>
+		<td><t:label t:name="username" /></td>
 	</tr>
 	
 	<tr>
diff --git a/extra/http/server/auth/login/register.xml b/extra/http/server/auth/login/register.xml
index 4804410dde..9815f21945 100644
--- a/extra/http/server/auth/login/register.xml
+++ b/extra/http/server/auth/login/register.xml
@@ -63,7 +63,7 @@
 		<p>
 
 			<input type="submit" value="Register" />
-			<t:validation-message />
+			<t:validation-messages />
 
 		</p>
 
diff --git a/extra/validators/validators-tests.factor b/extra/validators/validators-tests.factor
index a981f782d3..7d4325cbb6 100644
--- a/extra/validators/validators-tests.factor
+++ b/extra/validators/validators-tests.factor
@@ -47,6 +47,21 @@ namespaces assocs ;
 [ "http:/www.factorcode.org" v-url ]
 [ "invalid URL" = ] must-fail-with
 
+[ 4561261212345467 ] [ "4561261212345467" v-credit-card ] unit-test
+
+[ 4561261212345467 ] [ "4561-2612-1234-5467" v-credit-card ] unit-test
+
+[ 0 ] [ "0000000000000000" v-credit-card ] unit-test
+
+[ "000000000" v-credit-card ] must-fail
+
+[ "0000000000000000000000000" v-credit-card ] must-fail
+
+[ "4561_2612_1234_5467" v-credit-card ] must-fail
+
+[ "4561-2621-1234-5467" v-credit-card ] must-fail
+
+
 [ 14 V{ } ] [
     [
         "14" "age" [ v-number 13 v-min-value 100 v-max-value ] validate
diff --git a/extra/validators/validators.factor b/extra/validators/validators.factor
index 2dcc2c04f9..aeb2dc2f80 100644
--- a/extra/validators/validators.factor
+++ b/extra/validators/validators.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations sequences math namespaces sets
-math.parser assocs regexp fry unicode.categories sequences
-arrays hashtables words combinators mirrors classes quotations
-xmode.catalog ;
+USING: kernel continuations sequences sequences.lib math
+namespaces sets math.parser math.ranges assocs regexp fry
+unicode.categories arrays hashtables words combinators mirrors
+classes quotations xmode.catalog ;
 IN: validators
 
 : v-default ( str def -- str )
@@ -91,6 +91,23 @@ IN: validators
         "not a valid syntax mode" throw 
     ] unless ;
 
+: luhn? ( n -- ? )
+    string>digits <reversed>
+    [ odd? [ 2 * 10 /mod + ] when ] map-index
+    sum 10 mod 0 = ;
+
+: v-credit-card ( str -- n )
+    "- " diff
+    dup CHAR: 0 CHAR: 9 [a,b] diff empty? [
+        13 v-min-length
+        16 v-max-length
+        dup luhn? [ string>number ] [
+            "card number check failed" throw
+        ] if
+    ] [
+        "invalid credit card number format" throw
+    ] if ;
+
 SYMBOL: validation-messages
 SYMBOL: named-validation-messages
 
diff --git a/extra/webapps/user-admin/user-admin.factor b/extra/webapps/user-admin/user-admin.factor
index 728d5215f0..cdaf3f5ea9 100644
--- a/extra/webapps/user-admin/user-admin.factor
+++ b/extra/webapps/user-admin/user-admin.factor
@@ -12,7 +12,6 @@ http.server.auth.login
 http.server.auth
 http.server.sessions
 http.server.actions
-http.server.crud
 http.server ;
 IN: webapps.user-admin
 
diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index 2f281866c5..d0e1aed7ce 100644
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -166,10 +166,10 @@ TUPLE: wiki < dispatcher ;
         <main-article-action> "" add-responder
         <view-article-action> "view" add-responder
         <view-revision-action> "revision" add-responder
-        <edit-article-action> { } <protected> "edit" add-responder
         <list-revisions-action> "revisions" add-responder
-        <delete-action> "delete" add-responder
         <diff-action> "diff" add-responder
         <list-articles-action> "articles" add-responder
+        <edit-article-action> { } <protected> "edit" add-responder
+        <delete-action> { } <protected> "delete" add-responder
     <boilerplate>
         "wiki-common" wiki-template >>template ;
diff --git a/extra/xmode/code2html/code2html.factor b/extra/xmode/code2html/code2html.factor
index a9384ad861..6eccddc94a 100755
--- a/extra/xmode/code2html/code2html.factor
+++ b/extra/xmode/code2html/code2html.factor
@@ -1,4 +1,4 @@
-USING: xmode.tokens xmode.marker xmode.catalog kernel html
+USING: xmode.tokens xmode.marker xmode.catalog kernel
 html.elements io io.files sequences words io.encodings.utf8
 namespaces xml.entities ;
 IN: xmode.code2html

From 6edcd94b62a5d1e419a4c73cea9aeecdf33515db Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 27 May 2008 02:28:48 -0500
Subject: [PATCH 36/39] Fixes

---
 extra/http/server/crud/crud.factor | 66 ------------------------------
 1 file changed, 66 deletions(-)
 delete mode 100755 extra/http/server/crud/crud.factor

diff --git a/extra/http/server/crud/crud.factor b/extra/http/server/crud/crud.factor
deleted file mode 100755
index 5fb7c15019..0000000000
--- a/extra/http/server/crud/crud.factor
+++ /dev/null
@@ -1,66 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces db.tuples math.parser
-accessors fry locals hashtables validators
-http.server
-http.server.actions
-http.server.components
-http.server.forms ;
-IN: http.server.crud
-
-:: <view-action> ( form ctor -- action )
-    <action>
-        { { "id" [ v-number ] } } >>get-params
-
-        [ "id" get ctor call select-tuple from-tuple ] >>init
-
-        [ form view-form ] >>display ;
-
-: <id-redirect> ( id next -- response )
-    swap "id" associate <standard-redirect> ;
-
-:: <edit-action> ( form ctor next -- action )
-    <action>
-        { { "id" [ [ v-number ] v-optional ] } } >>get-params
-
-        [
-            "id" get ctor call
-
-            "id" get
-            [ select-tuple from-tuple ]
-            [ from-tuple form set-defaults ]
-            if
-        ] >>init
-
-        [ form edit-form ] >>display
-
-        [
-            f ctor call from-tuple
-
-            form validate-form
-
-            values-tuple
-            "id" value [ update-tuple ] [ insert-tuple ] if
-
-            "id" value next <id-redirect>
-        ] >>submit ;
-
-:: <delete-action> ( ctor next -- action )
-    <action>
-        { { "id" [ v-number ] } } >>post-params
-
-        [
-            "id" get ctor call delete-tuples
-
-            next f <standard-redirect>
-        ] >>submit ;
-
-:: <list-action> ( form ctor -- action )
-    <action>
-        [
-            blank-values
-
-            f ctor call select-tuples "list" set-value
-
-            form view-form
-        ] >>display ;

From fa3ab3a8b83d5aef562850c5eded83d439795190 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 27 May 2008 02:42:13 -0500
Subject: [PATCH 37/39] More fixes

---
 extra/http/server/auth/login/login.factor |  8 +++----
 extra/http/server/static/static.factor    | 26 +++++++++++------------
 2 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/extra/http/server/auth/login/login.factor b/extra/http/server/auth/login/login.factor
index e8c9bf8608..fd4fbab8e8 100755
--- a/extra/http/server/auth/login/login.factor
+++ b/extra/http/server/auth/login/login.factor
@@ -64,8 +64,8 @@ M: user-saver dispose
     3append <chloe> ;
 
 ! ! ! Login
-: successful-login ( user -- )
-    username>> set-uid ;
+: successful-login ( user -- response )
+    username>> set-uid "$login" end-flow ;
 
 : login-failed ( -- * )
     "invalid username or password" validation-error
@@ -84,9 +84,7 @@ M: user-saver dispose
             "password" value
             "username" value check-login
             [ successful-login ] [ login-failed ] if*
-        ] >>validate
-
-        [ "$login" end-flow ] >>submit ;
+        ] >>submit ;
 
 ! ! ! New user registration
 
diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor
index 8c0e255e21..0e799fd3ad 100755
--- a/extra/http/server/static/static.factor
+++ b/extra/http/server/static/static.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: calendar html io io.files kernel math math.order
+USING: calendar io io.files kernel math math.order
 math.parser http http.server namespaces parser sequences strings
 assocs hashtables debugger http.mime sorting html.elements
 html.templates.fhtml logging calendar.format accessors
-io.encodings.binary fry ;
+io.encodings.binary fry xml.entities ;
 IN: http.server.static
 
 ! special maps mime types to quots with effect ( path -- )
@@ -58,20 +58,18 @@ TUPLE: file-responder root hook special allow-listings ;
 
 : file. ( name dirp -- )
     [ "/" append ] when
-    dup <a =href a> write </a> ;
+    dup <a =href a> escape-string write </a> ;
 
 : directory. ( path -- )
-    [
-        dup file-name [
-            [ <h1> file-name write </h1> ]
-            [
-                <ul>
-                    directory sort-keys
-                    [ <li> file. </li> ] assoc-each
-                </ul>
-            ] bi
-        ] simple-page
-    ] with-html-stream ;
+    dup file-name [
+        [ <h1> file-name escape-string write </h1> ]
+        [
+            <ul>
+                directory sort-keys
+                [ <li> file. </li> ] assoc-each
+            </ul>
+        ] bi
+    ] simple-page ;
 
 : list-directory ( directory -- response )
     file-responder get allow-listings>> [

From 83e9a717f71a5113e3ddb98d9ac19760d65609c0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 27 May 2008 02:42:21 -0500
Subject: [PATCH 38/39] More wiki features

---
 extra/webapps/wiki/changes.xml     | 19 +++++++++++++++++++
 extra/webapps/wiki/diff.xml        |  4 ++--
 extra/webapps/wiki/revisions.xml   |  6 +++---
 extra/webapps/wiki/user-edits.xml  | 17 +++++++++++++++++
 extra/webapps/wiki/view.xml        |  2 +-
 extra/webapps/wiki/wiki-common.xml |  1 +
 extra/webapps/wiki/wiki.factor     | 29 ++++++++++++++++++++++++++++-
 7 files changed, 71 insertions(+), 7 deletions(-)
 create mode 100644 extra/webapps/wiki/changes.xml
 create mode 100644 extra/webapps/wiki/user-edits.xml

diff --git a/extra/webapps/wiki/changes.xml b/extra/webapps/wiki/changes.xml
new file mode 100644
index 0000000000..5efa0c045a
--- /dev/null
+++ b/extra/webapps/wiki/changes.xml
@@ -0,0 +1,19 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>Recent Changes</t:title>
+
+	<ul>
+		<t:each-tuple t:values="changes">
+			<li>
+				<t:a t:href="title" t:query="title"><t:label t:name="title" /></t:a>
+				on
+				<t:a t:href="revision" t:query="id"><t:label t:name="date" /></t:a>
+				by
+				<t:a t:href="user-edits" t:query="author"><t:label t:name="author" /></t:a>
+			</li>
+		</t:each-tuple>
+	</ul>
+
+</t:chloe>
diff --git a/extra/webapps/wiki/diff.xml b/extra/webapps/wiki/diff.xml
index 378466f0bb..0fb0d6bae6 100644
--- a/extra/webapps/wiki/diff.xml
+++ b/extra/webapps/wiki/diff.xml
@@ -10,13 +10,13 @@
 		<tr>
 			<th class="field-label">Old revision:</th>
 			<t:bind-tuple t:name="old">
-				<td>Created on <t:label t:name="date" /> by <t:label t:name="author" />.</td>
+				<td>Created on <t:label t:name="date" /> by <t:a t:href="user-edits" t:query="author"><t:label t:name="author" /></t:a>.</td>
 			</t:bind-tuple>
 		</tr>
 		<tr>
 			<th class="field-label">New revision:</th>
 			<t:bind-tuple t:name="old">
-				<td>Created on <t:label t:name="date" /> by <t:label t:name="author" />.</td>
+				<td>Created on <t:label t:name="date" /> by <t:a t:href="user-edits" t:query="author"><t:label t:name="author" /></t:a>.</td>
 			</t:bind-tuple>
 		</tr>
 	</table>
diff --git a/extra/webapps/wiki/revisions.xml b/extra/webapps/wiki/revisions.xml
index fe74191773..4b7bdadf50 100644
--- a/extra/webapps/wiki/revisions.xml
+++ b/extra/webapps/wiki/revisions.xml
@@ -7,9 +7,9 @@
 	<ul>
 		<t:each-tuple t:values="revisions">
 			<li>
-				<t:a t:href="revision" t:query="id">
-					<t:label t:name="date" /> by <t:label t:name="author" />
-				</t:a>
+				<t:a t:href="revision" t:query="id"><t:label t:name="date" /></t:a>
+				by
+				<t:a t:href="user-edits" t:query="author"><t:label t:name="author" /></t:a>
 			</li>
 		</t:each-tuple>
 	</ul>
diff --git a/extra/webapps/wiki/user-edits.xml b/extra/webapps/wiki/user-edits.xml
new file mode 100644
index 0000000000..cf19a38370
--- /dev/null
+++ b/extra/webapps/wiki/user-edits.xml
@@ -0,0 +1,17 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:title>Edits by <t:label t:name="author" /></t:title>
+
+	<ul>
+		<t:each-tuple t:values="user-edits">
+			<li>
+				<t:a t:href="view" t:query="title"><t:label t:name="title" /></t:a>
+				on
+				<t:a t:href="revision" t:query="id"><t:label t:name="date" /></t:a>
+			</li>
+		</t:each-tuple>
+	</ul>
+
+</t:chloe>
diff --git a/extra/webapps/wiki/view.xml b/extra/webapps/wiki/view.xml
index c3536f374d..56c8b37a1d 100644
--- a/extra/webapps/wiki/view.xml
+++ b/extra/webapps/wiki/view.xml
@@ -13,7 +13,7 @@
 		| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
 		| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
 		| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
-		| This revision created on <t:label t:name="date" /> by <t:label t:name="author" />.
+		| This revision created on <t:label t:name="date" /> by <t:a t:href="user-edits" t:query="author"><t:label t:name="author" /></t:a>.
 	</div>
 
 </t:chloe>
diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml
index d241f910ca..23e61e55fe 100644
--- a/extra/webapps/wiki/wiki-common.xml
+++ b/extra/webapps/wiki/wiki-common.xml
@@ -8,6 +8,7 @@
 
 		<t:a t:href="$wiki">Front Page</t:a>
 		| <t:a t:href="$wiki/articles">All Articles</t:a>
+		| <t:a t:href="$wiki/changes">Recent Changes</t:a>
 
 		<t:if t:code="http.server.sessions:uid">
 
diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index d0e1aed7ce..344a3d40bd 100644
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -127,6 +127,16 @@ revision "REVISIONS" {
 
         "revisions" wiki-template >>template ;
 
+: <list-changes-action> ( -- action )
+    <page-action>
+        [
+            f <revision> select-tuples
+            [ [ date>> ] compare invert-comparison ] sort
+            "changes" set-value
+        ] >>init
+
+        "changes" wiki-template >>template ;
+
 : <delete-action> ( -- action )
     <action>
         [ validate-title ] >>validate
@@ -156,9 +166,24 @@ revision "REVISIONS" {
 
 : <list-articles-action> ( -- action )
     <page-action>
-        [ f <article> select-tuples "articles" set-value ] >>init
+        [
+            f <article> select-tuples
+            [ [ title>> ] compare ] sort
+            "articles" set-value
+        ] >>init
+
         "articles" wiki-template >>template ;
 
+: <user-edits-action> ( -- action )
+    <page-action>
+        [
+            { { "author" [ v-username ] } } validate-params
+            f <revision> "author" value >>author
+            select-tuples "user-edits" set-value
+        ] >>init
+
+        "user-edits" wiki-template >>template ;
+
 TUPLE: wiki < dispatcher ;
 
 : <wiki> ( -- dispatcher )
@@ -167,8 +192,10 @@ TUPLE: wiki < dispatcher ;
         <view-article-action> "view" add-responder
         <view-revision-action> "revision" add-responder
         <list-revisions-action> "revisions" add-responder
+        <user-edits-action> "user-edits" add-responder
         <diff-action> "diff" add-responder
         <list-articles-action> "articles" add-responder
+        <list-changes-action> "changes" add-responder
         <edit-article-action> { } <protected> "edit" add-responder
         <delete-action> { } <protected> "delete" add-responder
     <boilerplate>

From b7a6e117ec2997501b756e455509cb5915b869bb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 28 May 2008 17:04:59 -0500
Subject: [PATCH 39/39] Add no-follow option

---
 extra/farkup/farkup.factor | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor
index 5dcfa7528e..d58b54af37 100755
--- a/extra/farkup/farkup.factor
+++ b/extra/farkup/farkup.factor
@@ -7,6 +7,7 @@ sequences.deep unicode.categories ;
 IN: farkup
 
 SYMBOL: relative-link-prefix
+SYMBOL: link-no-follow?
 
 <PRIVATE
 
@@ -79,7 +80,12 @@ MEMO: eq ( -- parser )
 
 : make-link ( href text -- seq )
     escape-link
-    [ "<a href=\"" , >r , r> "\">" , [ , ] when* "</a>" , ] { } make ;
+    [
+        "<a" ,
+        " href=\"" , >r , r>
+        link-no-follow? get [ " nofollow=\"true\"" , ] when
+        "\">" , , "</a>" ,
+    ] { } make ;
 
 : make-image-link ( href alt -- seq )
     escape-link