Debugging validation

diff --git a/extra/html/components/components.factor b/extra/html/components/components.factor
index e6df3431617dbb07b0ab02ac35fc32da03dd318f..382636d95221725dab9bcd4ce5c1027e9a7a2acb 100644 (file)
--- 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 4430e693364b7a973a910e35bb82d3c9e99ae3a3..6790a9f666fd10f4db3f013eb4b7c7af0d0e9a63 100644 (file)
--- 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 1abd4d494b3456c07c72d1c26a21b553814d99b7..6abae4895ba502f74415a6f7a9178c46ff41502b 100644 (file)
--- 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 1f65ff67653cb5a7c2ab91b4aea8560d7281f973..57c2fdb7c2b27418dab789eb7efc817a012e60e8 100644 (file)
--- 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 0772181b00001c5d1af649d8e158e5768c14abf9..9852bf47cbc35129b8de8cf18eb050e9bfcdef6b 100644 (file)
--- 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 f0abd97c63818a0116185108f1813a46cd8059f8..9ec2cb7976dca830ec746ab3a059a5e25a5bc8f4 100644 (file)
--- 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 e3b5b17a3245b736a8715faa8a6025b647298dc6..414a59f3b2a1aa97b0c78a04f0f69cdd20b3edf3 100755 (executable)
--- 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 ;