Merge branch 'master' of git://factorcode.org/git/factor

core/grouping/grouping-tests.factor

@@ -10,3 +10,5 @@ IN: grouping.tests
     2 over set-length
     >array
 ] unit-test
+
+[ { { 1 2 } { 2 3 } } ] [ { 1 2 3 } 2 <sliced-clumps> [ >array ] map ] unit-test

core/grouping/grouping.factor

@@ -56,7 +56,7 @@ M: clumps set-length
 M: clumps group@
     [ n>> over + ] [ seq>> ] bi ;
 
-TUPLE: sliced-clumps < groups ;
+TUPLE: sliced-clumps < clumps ;
 
 : <sliced-clumps> ( seq n -- clumps )
     sliced-clumps new-groups ; inline

core/parser/parser-docs.factor

@@ -117,14 +117,18 @@ $nl
 { $subsection parse-tokens } ;
 
 ARTICLE: "parsing-words" "Parsing words"
-"The Factor parser is follows a simple recursive-descent design. The parser reads successive tokens from the input; if the token identifies a number or an ordinary word, it is added to an accumulator vector. Otherwise if the token identifies a parsing word, the parsing word is executed immediately."
+"The Factor parser follows a simple recursive-descent design. The parser reads successive tokens from the input; if the token identifies a number or an ordinary word, it is added to an accumulator vector. Otherwise if the token identifies a parsing word, the parsing word is executed immediately."
 $nl
 "Parsing words are marked by suffixing the definition with a " { $link POSTPONE: parsing } " declaration. Here is the simplest possible parsing word; it prints a greeting at parse time:"
 { $code ": hello \"Hello world\" print ; parsing" }
-"Parsing words must have stack effect " { $snippet "( accum -- accum )" } ", where " { $snippet "accum" } " is the accumulator vector supplied by the parser. Parsing words can read input, add word definitions to the dictionary, and do anything an ordinary word can."
+"Parsing words must not pop or push items from the stack; however, they are permitted to access the accumulator vector supplied by the parser at the top of the stack. That is, parsing words must have stack effect " { $snippet "( accum -- accum )" } ", where " { $snippet "accum" } " is the accumulator vector supplied by the parser."
+$nl
+"Parsing words can read input, add word definitions to the dictionary, and do anything an ordinary word can."
+$nl
+"Because of the stack restriction, parsing words cannot pass data to other words by leaving values on the stack; instead, use " { $link parsed } " to add the data to the parse tree so that it can be evaluated later."
 $nl
 "Parsing words cannot be called from the same source file where they are defined, because new definitions are only compiled at the end of the source file. An attempt to use a parsing word in its own source file raises an error:"
-{ $link staging-violation }
+{ $subsection staging-violation }
 "Tools for implementing parsing words:"
 { $subsection "reading-ahead" }
 { $subsection "parsing-word-nest" }

extra/dns/server/server.factor

@@ -39,18 +39,13 @@ IN: dns.server
   zones sort-largest-first [ name-in-domain? ] with find nip ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! fill-authority
+! name->authority
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: fill-authority ( message -- message )
+: name->authority ( name -- rrs-ns ) name->zone NS IN query boa matching-rrs ;
-  [ ]
-  [ message-query name>> name->zone NS IN query boa matching-rrs ]
-  [ answer-section>> ]
-  tri
-  diff >>authority-section ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! fill-additional
+! extract-names
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : rr->rdata-names ( rr -- names/f )
@@ -61,12 +56,33 @@ IN: dns.server
     }
   cond ;
 
+: extract-rdata-names ( message -- names )
+  [ answer-section>> ] [ authority-section>> ] bi append
+  [ rr->rdata-names ] map concat ;
+
+: extract-names ( message -- names )
+  [ message-query name>> ] [ extract-rdata-names ] bi prefix-on ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! fill-authority
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: fill-authority ( message -- message )
+  dup
+    extract-names [ name->authority ] map concat prune
+    over answer-section>> diff
+  >>authority-section ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! fill-additional
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: name->rrs-a ( name -- rrs-a ) A IN query boa matching-rrs ;
+
 : fill-additional ( message -- message )
   dup
-  [ answer-section>> ] [ authority-section>> ] bi append
+    extract-rdata-names [ name->rrs-a ] map concat prune
-  [ rr->rdata-names ] map concat
+    over answer-section>> diff
-  [ A IN query boa matching-rrs ] map concat prune
-  over answer-section>> diff
   >>additional-section ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -90,10 +106,6 @@ DEFER: query->rrs
 ! have-answers
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! : have-answers ( message -- message/f )
-!   dup message-query query->rrs        ! message rrs/f
-!   [ empty? ] [ 2drop f ] [ >>answer-section ] 1if ;
-
 : have-answers ( message -- message/f )
   dup message-query query->rrs
   [ empty? ]

extra/furnace/actions/actions.factor

@@ -29,14 +29,10 @@ SYMBOL: rest
 
 CHLOE: validation-messages drop render-validation-messages ;
 
-TUPLE: action rest init display validate submit ;
+TUPLE: action rest authorize init display validate submit ;
 
 : new-action ( class -- action )
-    new
+    new [ ] >>init [ ] >>validate [ ] >>authorize ; inline
-        [ ] >>init
-        [ <400> ] >>display
-        [ ] >>validate
-        [ <400> ] >>submit ;
 
 : <action> ( -- action )
     action new-action ;
@@ -46,18 +42,28 @@ TUPLE: action rest init display validate submit ;
 
 : handle-get ( action -- response )
     '[
-        ,
+        , dup display>> [
-        [ init>> call ]
+            {
-        [ drop flashed-variables restore-flash ]
+                [ init>> call ]
-        [ display>> call ]
+                [ authorize>> call ]
-        tri
+                [ drop flashed-variables restore-flash ]
+                [ display>> call ]
+            } cleave
+        ] [ drop <400> ] if
     ] with-exit-continuation ;
 
 : validation-failed ( -- * )
     request get method>> "POST" = [ f ] [ <400> ] if exit-with ;
 
 : (handle-post) ( action -- response )
-    [ validate>> call ] [ submit>> call ] bi ;
+    '[
+        , dup submit>> [
+            [ validate>> call ]
+            [ authorize>> call ]
+            [ submit>> call ]
+            tri
+        ] [ drop <400> ] if
+    ] with-exit-continuation ;
 
 : param ( name -- value )
     params get at ;

extra/furnace/auth/login/login.factor

@@ -49,6 +49,10 @@ TUPLE: login < dispatcher users checksum ;
 
 TUPLE: protected < filter-responder description capabilities ;
 
+: <protected> ( responder -- protected )
+    protected new
+        swap >>responder ;
+
 : users ( -- provider )
     login get users>> ;
 
@@ -85,13 +89,17 @@ M: user-saver dispose
     "invalid username or password" validation-error
     validation-failed ;
 
+SYMBOL: description
+SYMBOL: capabilities
+
+: flashed-variables { description capabilities } ;
+
 : <login-action> ( -- action )
     <page-action>
         [
-            protected fget [
+            flashed-variables restore-flash
-                [ description>> "description" set-value ]
+            description get "description" set-value
-                [ capabilities>> words>strings "capabilities" set-value ] bi
+            capabilities get words>strings "capabilities" set-value
-            ] when*
         ] >>init
 
         { login "login" } >>template
@@ -200,7 +208,10 @@ M: user-saver dispose
             drop
 
             URL" $login" end-aside
-        ] >>submit ;
+        ] >>submit
+
+    <protected>
+        "edit your profile" >>description ;
 
 ! ! ! Password recovery
 
@@ -316,32 +327,36 @@ SYMBOL: lost-password-from
         ] >>submit ;
 
 ! ! ! Authentication logic
-: <protected> ( responder -- protected )
-    protected new
-        swap >>responder ;
-
 : show-login-page ( -- response )
     begin-aside
-    URL" $login/login" { protected } <flash-redirect> ;
+    protected get description>> description set
+    protected get capabilities>> capabilities set
+    URL" $login/login" flashed-variables <flash-redirect> ;
 
-: check-capabilities ( responder user -- ? )
+: login-required ( -- * )
-    [ capabilities>> ] bi@ subset? ;
+    show-login-page exit-with ;
+
+: have-capability? ( capability -- ? )
+    logged-in-user get capabilities>> member? ;
+
+: check-capabilities ( responder user/f -- ? )
+    dup [ [ capabilities>> ] bi@ subset? ] [ 2drop f ] if ;
 
 M: protected call-responder* ( path responder -- response )
     dup protected set
-    uid dup [
+    dup logged-in-user get check-capabilities
-        users get-user 2dup check-capabilities [
+    [ call-next-method ] [ 2drop show-login-page ] if ;
-            [ logged-in-user set ] [ save-user-after ] bi
+
-            call-next-method
+: init-user ( -- )
-        ] [
+    uid [
-            3drop show-login-page
+        users get-user
-        ] if
+        [ logged-in-user set ]
-    ] [
+        [ save-user-after ] bi
-        3drop show-login-page
+    ] when* ;
-    ] if ;
 
 M: login call-responder* ( path responder -- response )
     dup login set
+    init-user
     call-next-method ;
 
 : <login-boilerplate> ( responder -- responder' )
@@ -359,10 +374,7 @@ M: login call-responder* ( path responder -- response )
 ! ! ! Configuration
 
 : allow-edit-profile ( login -- login )
-    <edit-profile-action> <protected>
+    <edit-profile-action> <login-boilerplate> "edit-profile" add-responder ;
-        "edit your profile" >>description
-    <login-boilerplate>
-        "edit-profile" add-responder ;
 
 : allow-registration ( login -- login )
     <register-action> <login-boilerplate>

extra/furnace/furnace.factor

@@ -97,15 +97,22 @@ SYMBOL: exit-continuation
     dup empty?
     [ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ;
 
-CHLOE: atom
+: a-url-path ( tag -- string )
-    [ children>string ]
+    [ "href" required-attr ] [ "rest" optional-attr value ] bi
-    [ "href" required-attr ]
+    [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;
-    [ "query" optional-attr parse-query-attr ] tri
+
-    <url>
+: a-url ( tag -- url )
-        swap >>query
+    dup "value" optional-attr
-        swap >>path
+    [ value ] [
-    adjust-url relative-to-request
+        <url>
-    add-atom-feed ;
+            swap
+            [ a-url-path >>path ]
+            [ "query" optional-attr parse-query-attr >>query ]
+            bi
+        adjust-url relative-to-request
+    ] ?if ;
+
+CHLOE: atom [ children>string ] [ a-url ] bi add-atom-feed ;
 
 CHLOE: write-atom drop write-atom-feeds ;
 
@@ -114,23 +121,11 @@ GENERIC: link-attr ( tag responder -- )
 M: object link-attr 2drop ;
 
 : link-attrs ( tag -- )
+    #! Side-effects current namespace.
     '[ , _ link-attr ] each-responder ;
 
 : a-start-tag ( tag -- )
-    [
+    [ <a [ link-attrs ] [ a-url =href ] bi a> ] with-scope ;
-        <a
-            dup link-attrs
-            dup "value" optional-attr [ value f ] [
-                [ "href" required-attr ]
-                [ "query" optional-attr parse-query-attr ]
-                bi
-            ] ?if
-            <url>
-                swap >>query
-                swap >>path
-            adjust-url relative-to-request =href
-        a>
-    ] with-scope ;
 
 CHLOE: a
     [ a-start-tag ]
@@ -158,11 +153,12 @@ CHLOE: a
     [
         [
             <form
-                "POST" =method
+                {
-                [ link-attrs ]
+                    [ link-attrs ]
-                [ "action" required-attr resolve-base-path =action ]
+                    [ "method" optional-attr "post" or =method ]
-                [ tag-attrs non-chloe-attrs-only print-attrs ]
+                    [ "action" required-attr resolve-base-path =action ]
-                tri
+                    [ tag-attrs non-chloe-attrs-only print-attrs ]
+                } cleave
             form>
         ]
         [ form-magic ] bi

extra/http/http-tests.factor

@@ -7,7 +7,7 @@ IN: http.tests
 : lf>crlf "\n" split "\r\n" join ;
 
 STRING: read-request-test-1
-POST http://foo/bar HTTP/1.1
+POST /bar HTTP/1.1
 Some-Header: 1
 Some-Header: 2
 Content-Length: 4
@@ -18,7 +18,7 @@ blah
 
 [
     TUPLE{ request
-        url: TUPLE{ url protocol: "http" port: 80 path: "/bar" }
+        url: TUPLE{ url path: "/bar" }
         method: "POST"
         version: "1.1"
         header: H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } }
@@ -49,14 +49,14 @@ read-request-test-1' 1array [
 ] unit-test
 
 STRING: read-request-test-2
-HEAD  http://foo/bar   HTTP/1.1
+HEAD  /bar   HTTP/1.1
 Host: www.sex.com
 
 ;
 
 [
     TUPLE{ request
-        url: TUPLE{ url protocol: "http" port: 80 host: "www.sex.com" path: "/bar" }
+        url: TUPLE{ url host: "www.sex.com" path: "/bar" }
         method: "HEAD"
         version: "1.1"
         header: H{ { "host" "www.sex.com" } }

extra/http/http.factor

@@ -6,8 +6,7 @@ assocs sequences splitting sorting sets debugger
 strings vectors hashtables quotations arrays byte-arrays
 math.parser calendar calendar.format present
 
-io io.server io.sockets.secure
+io io.encodings.iana io.encodings.binary io.encodings.8-bit
-io.encodings.iana io.encodings.binary io.encodings.8-bit
 
 unicode.case unicode.categories qualified
 
@@ -142,7 +141,6 @@ cookies ;
     request new
         "1.1" >>version
         <url>
-            "http" >>protocol
             H{ } clone >>query
         >>url
         H{ } clone >>header
@@ -202,7 +200,6 @@ TUPLE: post-data raw content content-type ;
 : extract-host ( request -- request )
     [ ] [ url>> ] [ "host" header parse-host ] tri
     [ >>host ] [ >>port ] bi*
-    ensure-port
     drop ;
 
 : extract-cookies ( request -- request )
@@ -214,9 +211,6 @@ TUPLE: post-data raw content content-type ;
 : parse-content-type ( content-type -- type encoding )
     ";" split1 parse-content-type-attributes "charset" swap at ;
 
-: detect-protocol ( request -- request )
-    dup url>> remote-address get secure? "https" "http" ? >>protocol drop ;
-
 : read-request ( -- request )
     <request>
     read-method
@@ -224,7 +218,6 @@ TUPLE: post-data raw content content-type ;
     read-request-version
     read-request-header
     read-post-data
-    detect-protocol
     extract-host
     extract-cookies ;
 

extra/http/server/redirection/redirection.factor

@@ -1,10 +1,14 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors combinators namespaces
+USING: kernel accessors combinators namespaces strings
 logging urls http http.server http.server.responses ;
 IN: http.server.redirection
 
-: relative-to-request ( url -- url' )
+GENERIC: relative-to-request ( url -- url' )
+
+M: string relative-to-request ;
+
+M: url relative-to-request
     request get url>>
         clone
         f >>query

extra/http/server/server.factor

@@ -2,16 +2,18 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences arrays namespaces splitting
 vocabs.loader destructors assocs debugger continuations
-tools.vocabs math
+combinators tools.vocabs math
 io
 io.server
+io.sockets
+io.sockets.secure
 io.encodings
 io.encodings.utf8
 io.encodings.ascii
 io.encodings.binary
 io.streams.limited
 io.timeouts
-fry logging calendar
+fry logging calendar urls
 http
 http.server.responses
 html.elements
@@ -66,7 +68,7 @@ main-responder global [ <404> <trivial-responder> or ] change-at
             [
                 utf8 [
                     development-mode get
-                    [ http-error. ] [ drop "Response error" throw ] if
+                    [ http-error. ] [ drop "Response error" rethrow ] if
                 ] with-encoded-output
             ] recover
         ] if
@@ -88,12 +90,26 @@ LOG: httpd-hit NOTICE
 : dispatch-request ( request -- response )
     url>> path>> split-path main-responder get call-responder ;
 
+: prepare-request ( request -- request )
+    [
+        local-address get
+        [ secure? "https" "http" ? >>protocol ]
+        [ port>> '[ , or ] change-port ]
+        bi
+    ] change-url ;
+
+: valid-request? ( request -- ? )
+    url>> port>> local-address get port>> = ;
+
 : do-request ( request -- response )
     '[
         ,
-        [ init-request ]
+        {
-        [ log-request ]
+            [ init-request ]
-        [ dispatch-request ] tri
+            [ prepare-request ]
+            [ log-request ]
+            [ dup valid-request? [ dispatch-request ] [ drop <400> ] if ]
+        } cleave
     ] [ [ \ do-request log-error ] [ <500> ] bi ] recover ;
 
 : ?refresh-all ( -- )

extra/io/pools/pools.factor

@@ -10,7 +10,7 @@ TUPLE: pool connections disposed expired ;
     dup check-disposed
     dup expired>> expired? [
         ALIEN: 31337 >>expired
-        connections>> [ delete-all ] [ dispose-each ] bi
+        connections>> delete-all
     ] [ drop ] if ;
 
 : <pool> ( class -- pool )
@@ -34,6 +34,7 @@ GENERIC: make-connection ( pool -- conn )
     dup check-pool [ make-connection ] keep return-connection ;
 
 : acquire-connection ( pool -- conn )
+    dup check-pool
     [ dup connections>> empty? ] [ dup new-connection ] [ ] while
     connections>> pop ;
 

extra/io/server/server.factor

@@ -4,7 +4,7 @@ USING: io io.sockets io.sockets.secure io.files
 io.streams.duplex logging continuations destructors kernel math
 math.parser namespaces parser sequences strings prettyprint
 debugger quotations calendar threads concurrency.combinators
-assocs fry ;
+assocs fry accessors ;
 IN: io.server
 
 SYMBOL: servers
@@ -15,9 +15,10 @@ SYMBOL: remote-address
 
 LOG: accepted-connection NOTICE
 
-: with-connection ( client remote quot -- )
+: with-connection ( client remote local quot -- )
     '[
         , [ remote-address set ] [ accepted-connection ] bi
+        , local-address set
         @
     ] with-stream ; inline
 
@@ -25,7 +26,8 @@ LOG: accepted-connection NOTICE
 
 : accept-loop ( server quot -- )
     [
-        >r accept r> '[ , , , with-connection ] "Client" spawn drop
+        [ [ accept ] [ addr>> ] bi ] dip
+        '[ , , , , with-connection ] "Client" spawn drop
     ] 2keep accept-loop ; inline
 
 : server-loop ( addrspec encoding quot -- )
@@ -59,7 +61,7 @@ LOG: received-datagram NOTICE
 
 : datagram-loop ( quot datagram -- )
     [
-        [ receive dup received-datagram >r swap call r> ] keep
+        [ receive dup received-datagram [ swap call ] dip ] keep
         pick [ send ] [ 3drop ] if
     ] 2keep datagram-loop ; inline
 

extra/io/streams/duplex/duplex.factor

@@ -5,9 +5,6 @@ io.encodings.private io.timeouts debugger inspector listener
 accessors delegate delegate.protocols ;
 IN: io.streams.duplex
 
-! We ensure that the stream can only be closed once, to preserve
-! integrity of duplex I/O ports.
-
 TUPLE: duplex-stream in out ;
 
 C: <duplex-stream> duplex-stream

extra/webapps/blogs/blogs.factor

@@ -1,24 +1,33 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences sorting math.order math.parser
-urls validators html.components db.types db.tuples calendar
+urls validators html.components db db.types db.tuples calendar
-http.server.dispatchers
+present http.server.dispatchers
-furnace furnace.actions furnace.auth.login furnace.boilerplate
+furnace
-furnace.sessions furnace.syndication ;
+furnace.actions
+furnace.auth
+furnace.auth.login
+furnace.boilerplate
+furnace.sessions
+furnace.syndication ;
 IN: webapps.blogs
 
 TUPLE: blogs < dispatcher ;
 
+SYMBOL: can-administer-blogs?
+
+can-administer-blogs? define-capability
+
 : view-post-url ( id -- url )
-    number>string "$blogs/post/" prepend >url ;
+    present "$blogs/post/" prepend >url ;
 
 : view-comment-url ( parent id -- url )
     [ view-post-url ] dip >>anchor ;
 
 : list-posts-url ( -- url )
-    URL" $blogs/" ;
+    "$blogs/" >url ;
 
-: user-posts-url ( author -- url )
+: posts-by-url ( author -- url )
     "$blogs/by/" prepend >url ;
 
 TUPLE: entity id author date content ;
@@ -39,7 +48,7 @@ M: entity feed-entry-date date>> ;
 TUPLE: post < entity title comments ;
 
 M: post feed-entry-title
-    [ author>> ] [ drop ": " ] [ title>> ] tri 3append ;
+    [ author>> ] [ title>> ] bi ": " swap 3append ;
 
 M: post entity-url
     id>> view-post-url ;
@@ -79,19 +88,16 @@ M: comment entity-url
     [ [ date>> ] compare invert-comparison ] sort ;
 
 : validate-author ( -- )
-    { { "author" [ [ v-username ] v-optional ] } } validate-params ;
+    { { "author" [ v-username ] } } validate-params ;
 
 : list-posts ( -- posts )
     f <post> "author" value >>author
-    select-tuples [ dup id>> f <comment> count-tuples >>comments ] map
+    select-tuples [ dup id>> f <comment> f count-tuples >>comments ] map
     reverse-chronological-order ;
 
 : <list-posts-action> ( -- action )
     <page-action>
-        [
+        [ list-posts "posts" set-value ] >>init
-            list-posts "posts" set-value
-        ] >>init
-
         { blogs "list-posts" } >>template ;
 
 : <list-posts-feed-action> ( -- action )
@@ -100,21 +106,24 @@ M: comment entity-url
         [ list-posts ] >>entries
         [ list-posts-url ] >>url ;
 
-: <user-posts-action> ( -- action )
+: <posts-by-action> ( -- action )
     <page-action>
+
         "author" >>rest
+
         [
             validate-author
             list-posts "posts" set-value
         ] >>init
-        { blogs "user-posts" } >>template ;
 
-: <user-posts-feed-action> ( -- action )
+        { blogs "posts-by" } >>template ;
+
+: <posts-by-feed-action> ( -- action )
     <feed-action>
         [ validate-author ] >>init
         [ "Recent Posts by " "author" value append ] >>title
         [ list-posts ] >>entries
-        [ "author" value user-posts-url ] >>url ;
+        [ "author" value posts-by-url ] >>url ;
 
 : <post-feed-action> ( -- action )
     <feed-action>
@@ -125,6 +134,7 @@ M: comment entity-url
 
 : <view-post-action> ( -- action )
     <page-action>
+
         "id" >>rest
 
         [
@@ -147,6 +157,7 @@ M: comment entity-url
 
 : <new-post-action> ( -- action )
     <page-action>
+
         [
             validate-post
             uid "author" set-value
@@ -160,38 +171,76 @@ M: comment entity-url
             [ insert-tuple ] [ entity-url <redirect> ] bi
         ] >>submit
 
-        { blogs "new-post" } >>template ;
+        { blogs "new-post" } >>template
+
+     <protected>
+        "make a new blog post" >>description ;
+
+: authorize-author ( author -- )
+    uid = can-administer-blogs? have-capability? or
+    [ login-required ] unless ;
+
+: do-post-action ( -- )
+    validate-integer-id
+    "id" value <post> select-tuple from-object ;
 
 : <edit-post-action> ( -- action )
     <page-action>
-        [
+
-            validate-integer-id
+        "id" >>rest
-            "id" value <post> select-tuple from-object
+
-        ] >>init
+        [ do-post-action ] >>init
+
+        [ do-post-action validate-post ] >>validate
+
+        [ "author" value authorize-author ] >>authorize
 
         [
-            validate-integer-id
+            "id" value <post>
-            validate-post
+            dup { "title" "author" "date" "content" } deposit-slots
-        ] >>validate
-
-        [
-            "id" value <post> select-tuple
-                dup { "title" "content" } deposit-slots
             [ update-tuple ] [ entity-url <redirect> ] bi
         ] >>submit
 
-        { blogs "edit-post" } >>template ;
+        { blogs "edit-post" } >>template
-    
+
+    <protected>
+        "edit a blog post" >>description ;
+
+: delete-post ( id -- )
+    [ <post> delete-tuples ] [ f <comment> delete-tuples ] bi ;
+
 : <delete-post-action> ( -- action )
     <action>
+
+        [ do-post-action ] >>validate
+
+        [ "author" value authorize-author ] >>authorize
+
         [
-            validate-integer-id
+            [ "id" value delete-post ] with-transaction
-            { { "author" [ v-username ] } } validate-params
+            "author" value posts-by-url <redirect>
-        ] >>validate
+        ] >>submit
+
+     <protected>
+        "delete a blog post" >>description ;
+
+: <delete-author-action> ( -- action )
+    <action>
+
+        [ validate-author ] >>validate
+
+        [ "author" value authorize-author ] >>authorize
+
         [
-            "id" value <post> delete-tuples
+            [
-            "author" value user-posts-url <redirect>
+                f <post> "author" value >>author select-tuples [ id>> delete-post ] each
-        ] >>submit ;
+                f f <comment> "author" value >>author delete-tuples
+            ] with-transaction
+            "author" value posts-by-url <redirect>
+        ] >>submit
+
+     <protected>
+        "delete a blog post" >>description ;
 
 : validate-comment ( -- )
     {
@@ -213,41 +262,44 @@ M: comment entity-url
                 uid >>author
                 now >>date
             [ insert-tuple ] [ entity-url <redirect> ] bi
-        ] >>submit ;
+        ] >>submit
-    
+
+     <protected>
+        "make a comment" >>description ;
+
 : <delete-comment-action> ( -- action )
     <action>
+
         [
             validate-integer-id
             { { "parent" [ v-integer ] } } validate-params
         ] >>validate
+
+        [
+            "parent" value <post> select-tuple
+            author>> authorize-author
+        ] >>authorize
+
         [
             f "id" value <comment> delete-tuples
             "parent" value view-post-url <redirect>
-        ] >>submit ;
+        ] >>submit
-    
+
+        <protected>
+            "delete a comment" >>description ;
+
 : <blogs> ( -- dispatcher )
     blogs new-dispatcher
         <list-posts-action> "" add-responder
         <list-posts-feed-action> "posts.atom" add-responder
-        <user-posts-action> "by" add-responder
+        <posts-by-action> "by" add-responder
-        <user-posts-feed-action> "by.atom" add-responder
+        <posts-by-feed-action> "by.atom" add-responder
         <view-post-action> "post" add-responder
         <post-feed-action> "post.atom" add-responder
-        <new-post-action> <protected>
+        <new-post-action> "new-post" add-responder
-            "make a new blog post" >>description
+        <edit-post-action> "edit-post" add-responder
-            "new-post" add-responder
+        <delete-post-action> "delete-post" add-responder
-        <edit-post-action> <protected>
+        <new-comment-action> "new-comment" add-responder
-            "edit a blog post" >>description
+        <delete-comment-action> "delete-comment" add-responder
-            "edit-post" add-responder
-        <delete-post-action> <protected>
-            "delete a blog post" >>description
-            "delete-post" add-responder
-        <new-comment-action> <protected>
-            "make a comment" >>description
-            "new-comment" add-responder
-        <delete-comment-action> <protected>
-            "delete a comment" >>description
-            "delete-comment" add-responder
     <boilerplate>
         { blogs "blogs-common" } >>template ;

extra/webapps/blogs/edit-post.xml

@@ -15,13 +15,13 @@
 
 	<div class="posting-footer">
 		Post by
-		<t:a t:href="$blogs/" t:query="author">
+		<t:a t:href="$blogs/by" t:rest="author">
 			<t:label t:name="author" />
 		</t:a>
 		on
 		<t:label t:name="date" />
 		|
-		<t:a t:href="$blogs/post" t:for="id">View Post</t:a>
+		<t:a t:href="$blogs/post" t:rest="id">View Post</t:a>
 		|
 		<t:button t:action="$blogs/delete-post" t:for="id,author" class="link-button link">Delete Post</t:button>
 	</div>

extra/webapps/blogs/list-posts.xml

@@ -7,7 +7,7 @@
 	<t:bind-each t:name="posts">
 
 		<h2 class="post-title">
-			<t:a t:href="$blogs/post" t:query="id">
+			<t:a t:href="$blogs/post" t:rest="id">
 				<t:label t:name="title" />
 			</t:a>
 		</h2>
@@ -18,13 +18,13 @@
 
 		<div class="posting-footer">
 			Post by
-			<t:a t:href="$blogs/by" t:query="author">
+			<t:a t:href="$blogs/by" t:rest="author">
 				<t:label t:name="author" />
 			</t:a>
 			on
 			<t:label t:name="date" />
 			|
-			<t:a t:href="$blogs/post" t:query="id">
+			<t:a t:href="$blogs/post" t:rest="id">
 				<t:label t:name="comments" />
 				comments.
 			</t:a>

extra/webapps/blogs/posts-by.xml

@@ -2,7 +2,7 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:atom t:href="$blogs/by" t:query="author">
+	<t:atom t:href="$blogs/by" t:rest="author">
 		Recent Posts by <t:label t:name="author" />
 	</t:atom>
 
@@ -13,7 +13,7 @@
 	<t:bind-each t:name="posts">
 
 		<h2 class="post-title">
-			<t:a t:href="$blogs/post" t:query="id">
+			<t:a t:href="$blogs/post" t:rest="id">
 				<t:label t:name="title" />
 			</t:a>
 		</h2>
@@ -24,13 +24,13 @@
 
 		<div class="posting-footer">
 			Post by
-			<t:a t:href="$blogs/by" t:query="author">
+			<t:a t:href="$blogs/by" t:rest="author">
 				<t:label t:name="author" />
 			</t:a>
 			on
 			<t:label t:name="date" />
 			|
-			<t:a t:href="$blogs/post" t:query="id">
+			<t:a t:href="$blogs/post" t:rest="id">
 				<t:label t:name="comments" />
 				comments.
 			</t:a>

extra/webapps/blogs/view-post.xml

@@ -2,11 +2,11 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:atom t:href="$blogs/post.atom" t:query="id">
+	<t:atom t:href="$blogs/post.atom" t:rest="id">
 		<t:label t:name="author" />: <t:label t:name="title" />
 	</t:atom>
 
-	<t:atom t:href="$blogs/by.atom" t:query="author">
+	<t:atom t:href="$blogs/by.atom" t:rest="author">
 		Recent Posts by <t:label t:name="author" />
 	</t:atom>
 
@@ -18,13 +18,13 @@
 
 	<div class="posting-footer">
 		Post by
-		<t:a t:href="$blogs/" t:query="author">
+		<t:a t:href="$blogs/" t:rest="author">
 			<t:label t:name="author" />
 		</t:a>
 		on
 		<t:label t:name="date" />
 		|
-		<t:a t:href="$blogs/edit-post" t:query="id">Edit Post</t:a>
+		<t:a t:href="$blogs/edit-post" t:rest="id">Edit Post</t:a>
 		|
 		<t:button t:action="$blogs/delete-post" t:for="id,author" class="link-button link">Delete Post</t:button>
 	</div>
@@ -33,7 +33,7 @@
 		<hr/>
 
 		<p class="comment-header">
-			Comment by <t:label t:name="author" /> on <t:label t:name="date" />:
+			<a name="@id">Comment by <t:label t:name="author" /> on <t:label t:name="date" />:</a>
 		</p>
 
 		<p class="posting-body">

extra/webapps/pastebin/pastebin.factor

@@ -19,6 +19,10 @@ IN: webapps.pastebin
 
 TUPLE: pastebin < dispatcher ;
 
+SYMBOL: can-delete-pastes?
+
+can-delete-pastes? define-capability
+
 ! ! !
 ! DOMAIN MODEL
 ! ! !
@@ -170,13 +174,20 @@ M: annotation entity-url
 
 : <delete-paste-action> ( -- action )
     <action>
+
         [ validate-integer-id ] >>validate
 
         [
-            "id" value <paste> delete-tuples
+            [
-            "id" value f <annotation> delete-tuples
+                "id" value <paste> delete-tuples
+                "id" value f <annotation> delete-tuples
+            ] with-transaction
             URL" $pastebin/list" <redirect>
-        ] >>submit ;
+        ] >>submit
+
+        <protected>
+            "delete pastes" >>description
+            { can-delete-pastes? } >>capabilities ;
 
 ! ! !
 ! ANNOTATIONS
@@ -199,6 +210,7 @@ M: annotation entity-url
 
 : <delete-annotation-action> ( -- action )
     <action>
+
         [ { { "id" [ v-number ] } } validate-params ] >>validate
 
         [
@@ -206,11 +218,11 @@ M: annotation entity-url
             [ delete-tuples ]
             [ parent>> paste-url <redirect> ]
             bi
-        ] >>submit ;
+        ] >>submit
 
-SYMBOL: can-delete-pastes?
+    <protected>
-
+        "delete annotations" >>description
-can-delete-pastes? define-capability
+        { can-delete-pastes? } >>capabilities ;
 
 : <pastebin> ( -- responder )
     pastebin new-dispatcher
@@ -219,13 +231,9 @@ can-delete-pastes? define-capability
         <paste-action> "paste" add-responder
         <paste-feed-action> "paste.atom" add-responder
         <new-paste-action> "new-paste" add-responder
-        <delete-paste-action> <protected>
+        <delete-paste-action> "delete-paste" add-responder
-            "delete pastes" >>description
-            { can-delete-pastes? } >>capabilities "delete-paste" add-responder
         <new-annotation-action> "new-annotation" add-responder
-        <delete-annotation-action> <protected>
+        <delete-annotation-action> "delete-annotation" add-responder
-            "delete annotations" >>description
-            { can-delete-pastes? } >>capabilities "delete-annotation" add-responder
     <boilerplate>
         { pastebin "pastebin-common" } >>template ;
 

extra/webapps/planet/planet.factor

@@ -18,6 +18,10 @@ IN: webapps.planet
 
 TUPLE: planet-factor < dispatcher ;
 
+SYMBOL: can-administer-planet-factor?
+
+can-administer-planet-factor? define-capability
+
 TUPLE: planet-factor-admin < dispatcher ;
 
 TUPLE: blog id name www-url feed-url ;
@@ -30,8 +34,8 @@ blog "BLOGS"
 {
     { "id" "ID" INTEGER +db-assigned-id+ }
     { "name" "NAME" { VARCHAR 256 } +not-null+ }
-    { "www-url" "WWWURL" { VARCHAR 256 } +not-null+ }
+    { "www-url" "WWWURL" URL +not-null+ }
-    { "feed-url" "FEEDURL" { VARCHAR 256 } +not-null+ }
+    { "feed-url" "FEEDURL" URL +not-null+ }
 } define-persistent
 
 TUPLE: posting < entry id ;
@@ -40,7 +44,7 @@ posting "POSTINGS"
 {
     { "id" "ID" INTEGER +db-assigned-id+ }
     { "title" "TITLE" { VARCHAR 256 } +not-null+ }
-    { "url" "LINK" { VARCHAR 256 } +not-null+ }
+    { "url" "LINK" URL +not-null+ }
     { "description" "DESCRIPTION" TEXT +not-null+ }
     { "date" "DATE" TIMESTAMP +not-null+ }
 } define-persistent
@@ -134,6 +138,7 @@ posting "POSTINGS"
 
 : <new-blog-action> ( -- action )
     <page-action>
+
         { planet-factor "new-blog" } >>template
 
         [ validate-blog ] >>validate
@@ -150,9 +155,10 @@ posting "POSTINGS"
             ]
             tri
         ] >>submit ;
-    
+
 : <edit-blog-action> ( -- action )
     <page-action>
+
         [
             validate-integer-id
             "id" value <blog> select-tuple from-object
@@ -184,20 +190,16 @@ posting "POSTINGS"
         <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 ;
+        <delete-blog-action> "delete-blog" add-responder
-
+    <protected>
-SYMBOL: can-administer-planet-factor?
+        "administer Planet Factor" >>description
-
+        { can-administer-planet-factor? } >>capabilities ;
-can-administer-planet-factor? define-capability
 
 : <planet-factor> ( -- responder )
     planet-factor new-dispatcher
         <planet-action> "list" add-main-responder
         <planet-feed-action> "feed.xml" add-responder
-        <planet-factor-admin> <protected>
+        <planet-factor-admin> "admin" add-responder
-            "administer Planet Factor" >>description
-            { can-administer-planet-factor? } >>capabilities
-        "admin" add-responder
     <boilerplate>
         { planet-factor "planet-common" } >>template ;
 

extra/webapps/wiki/articles.xml

@@ -7,7 +7,7 @@
 	<ul>
 		<t:bind-each t:name="articles">
 			<li>
-				<t:a t:href="view" t:query="title"><t:label t:name="title"/></t:a>
+				<t:a t:href="$wiki/view" t:rest="title"><t:label t:name="title"/></t:a>
 			</li>
 		</t:bind-each>
 	</ul>

extra/webapps/wiki/changes.xml

@@ -4,16 +4,26 @@
 
 	<t:title>Recent Changes</t:title>
 
-	<ul>
+	<div class="revisions">
-		<t:bind-each t:name="changes">
+
-			<li>
+		<table>
-				<t:a t:href="view" t:query="title"><t:label t:name="title" /></t:a>
+
-				on
+			<tr>
-				<t:a t:href="revision" t:query="id"><t:label t:name="date" /></t:a>
+				<th>Article</th>
-				by
+				<th>Date</th>
-				<t:a t:href="user-edits" t:query="author"><t:label t:name="author" /></t:a>
+				<th>By</th>
-			</li>
+			</tr>
-		</t:bind-each>
+
-	</ul>
+			<t:bind-each t:name="changes">
+				<tr>
+					<td><t:a t:href="$wiki/view" t:rest="title"><t:label t:name="title" /></t:a></td>
+					<td><t:a t:href="$wiki/revision" t:rest="id"><t:label t:name="date" /></t:a></td>
+					<td><t:a t:href="$wiki/user-edits" t:rest="author"><t:label t:name="author" /></t:a></td>
+				</tr>
+			</t:bind-each>
+
+		</table>
+
+	</div>
 
 </t:chloe>

extra/webapps/wiki/diff.xml

@@ -8,13 +8,13 @@
 		<tr>
 			<th class="field-label">Old revision:</th>
 			<t:bind t:name="old">
-				<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>
+				<td>Created on <t:label t:name="date" /> by <t:a t:href="user-edits" t:rest="author"><t:label t:name="author" /></t:a>.</td>
 			</t:bind>
 		</tr>
 		<tr>
 			<th class="field-label">New revision:</th>
 			<t:bind t:name="old">
-				<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>
+				<td>Created on <t:label t:name="date" /> by <t:a t:href="user-edits" t:rest="author"><t:label t:name="author" /></t:a>.</td>
 			</t:bind>
 		</tr>
 	</table>

extra/webapps/wiki/page-common.xml

@@ -2,16 +2,16 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:atom t:href="$wiki/revisions.atom" t:query="title">
+	<t:atom t:href="$wiki/revisions.atom" t:rest="title">
 		Revisions of <t:label t:name="title" />
 	</t:atom>
 
 	<t:call-next-template />
 
 	<div class="navbar">
-		<t:a t:href="$wiki/view" t:query="title">Latest</t:a>
+		<t:a t:href="$wiki/view" t:rest="title">Latest</t:a>
-		| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
+		| <t:a t:href="$wiki/revisions" t:rest="title">Revisions</t:a>
-		| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
+		| <t:a t:href="$wiki/edit" t:rest="title">Edit</t:a>
 		| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
 	</div>
 

extra/webapps/wiki/revisions.xml

@@ -8,14 +8,14 @@
 		<table>
 			<tr>
 				<th>Revision</th>
-				<th>Author</th>
+				<th>By</th>
 				<th>Rollback</th>
 			</tr>
 
 			<t:bind-each t:name="revisions">
 				<tr>
-					<td> <t:a t:href="revision" t:query="id"><t:label t:name="date" /></t:a> </td>
+					<td> <t:a t:href="$wiki/revision" t:rest="id"><t:label t:name="date" /></t:a> </td>
-					<td> <t:a t:href="user-edits" t:query="author"><t:label t:name="author" /></t:a> </td>
+					<td> <t:a t:href="$wiki/user-edits" t:rest="author"><t:label t:name="author" /></t:a> </td>
 					<td> <t:button t:action="rollback" t:for="id" class="link link-button">Rollback</t:button> </td>
 				</tr>
 			</t:bind-each>
@@ -24,7 +24,7 @@
 
 	<h2>View Differences</h2>
 
-	<form action="diff" method="get">
+	<t:form t:action="$wiki/diff" t:method="get">
 		<table>
 			<tr>
 				<th class="field-label">Old revision:</th>
@@ -51,6 +51,6 @@
 		</table>
 
 		<input type="submit" value="View" />
-	</form>
+	</t:form>
 
 </t:chloe>

extra/webapps/wiki/user-edits.xml

@@ -2,7 +2,7 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:atom t:href="$wiki/user-edits.atom" t:query="author">
+	<t:atom t:href="$wiki/user-edits.atom" t:rest="author">
 		Edits by <t:label t:name="author" />
 	</t:atom>
 
@@ -11,9 +11,9 @@
 	<ul>
 		<t:bind-each t:name="user-edits">
 			<li>
-				<t:a t:href="view" t:query="title"><t:label t:name="title" /></t:a>
+				<t:a t:href="$wiki/view" t:rest="title"><t:label t:name="title" /></t:a>
 				on
-				<t:a t:href="revision" t:query="id"><t:label t:name="date" /></t:a>
+				<t:a t:href="$wiki/revision" t:rest="id"><t:label t:name="date" /></t:a>
 			</li>
 		</t:bind-each>
 	</ul>

extra/webapps/wiki/view.xml

@@ -8,6 +8,6 @@
 		<t:farkup t:name="content" />
 	</div>
 
-	<p><em>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>.</em></p>
+	<p><em>This revision created on <t:label t:name="date" /> by <t:a t:href="$wiki/user-edits" t:rest="author"><t:label t:name="author" /></t:a>.</em></p>
 
 </t:chloe>

extra/webapps/wiki/wiki.factor

@@ -1,7 +1,7 @@
 ! 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
+namespaces splitting sequences sorting math.order present
 html.components syndication
 http.server
 http.server.dispatchers
@@ -15,23 +15,26 @@ validators
 db.types db.tuples lcs farkup urls ;
 IN: webapps.wiki
 
-: view-url ( title -- url )
+: wiki-url ( rest path -- url )
-    "$wiki/view/" prepend >url ;
+    [ "$wiki/" % % "/" % % ] "" make
+    <url> swap >>path ;
 
-: edit-url ( title -- url )
+: view-url ( title -- url ) "view" wiki-url ;
-    "$wiki/edit" >url swap "title" set-query-param ;
 
-: revisions-url ( title -- url )
+: edit-url ( title -- url ) "edit" wiki-url ;
-    "$wiki/revisions" >url swap "title" set-query-param ;
 
-: revision-url ( id -- url )
+: revisions-url ( title -- url ) "revisions" wiki-url ;
-    "$wiki/revision" >url swap "id" set-query-param ;
 
-: user-edits-url ( author -- url )
+: revision-url ( id -- url ) "revision" wiki-url ;
-    "$wiki/user-edits" >url swap "author" set-query-param ;
+
+: user-edits-url ( author -- url ) "user-edits" wiki-url ;
 
 TUPLE: wiki < dispatcher ;
 
+SYMBOL: can-delete-wiki-articles?
+
+can-delete-wiki-articles? define-capability
+
 TUPLE: article title revision ;
 
 article "ARTICLES" {
@@ -82,11 +85,11 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <view-article-action> ( -- action )
     <action>
+
         "title" >>rest
 
         [
             validate-title
-            "view?title=" relative-link-prefix set
         ] >>init
 
         [
@@ -100,11 +103,14 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <view-revision-action> ( -- action )
     <page-action>
+
+        "id" >>rest
+
         [
             validate-integer-id
             "id" value <revision>
             select-tuple from-object
-            "view?title=" relative-link-prefix set
+            URL" $wiki/view/" adjust-url present relative-link-prefix set
         ] >>init
 
         { wiki "view" } >>template ;
@@ -121,6 +127,9 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <edit-article-action> ( -- action )
     <page-action>
+
+        "title" >>rest
+
         [
             validate-title
             "title" value <article> select-tuple [
@@ -129,7 +138,7 @@ M: revision feed-entry-url id>> revision-url ;
         ] >>init
 
         { wiki "edit" } >>template
-        
+
         [
             validate-title
             { { "content" [ v-required ] } } validate-params
@@ -140,7 +149,10 @@ M: revision feed-entry-url id>> revision-url ;
                 logged-in-user get username>> >>author
                 "content" value >>content
             [ add-revision ] [ title>> view-url <redirect> ] bi
-        ] >>submit ;
+        ] >>submit
+
+    <protected>
+        "edit wiki articles" >>description ;
 
 : list-revisions ( -- seq )
     f <revision> "title" value >>title select-tuples
@@ -148,21 +160,32 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <list-revisions-action> ( -- action )
     <page-action>
+
+        "title" >>rest
+
         [
             validate-title
             list-revisions "revisions" set-value
         ] >>init
+
         { wiki "revisions" } >>template ;
 
 : <list-revisions-feed-action> ( -- action )
     <feed-action>
+
+        "title" >>rest
+
         [ validate-title ] >>init
+
         [ "Revisions of " "title" value append ] >>title
+
         [ "title" value revisions-url ] >>url
+
         [ list-revisions ] >>entries ;
 
 : <rollback-action> ( -- action )
     <action>
+
         [ validate-integer-id ] >>validate
 
         [
@@ -171,13 +194,12 @@ M: revision feed-entry-url id>> revision-url ;
         ] >>submit ;
 
 : list-changes ( -- seq )
-    "id" value <revision> select-tuples
+    f <revision> select-tuples
     reverse-chronological-order ;
 
 : <list-changes-action> ( -- action )
     <page-action>
         [ list-changes "changes" set-value ] >>init
-
         { wiki "changes" } >>template ;
 
 : <list-changes-feed-action> ( -- action )
@@ -188,13 +210,18 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <delete-action> ( -- action )
     <action>
+
         [ validate-title ] >>validate
 
         [
             "title" value <article> delete-tuples
             f <revision> "title" value >>title delete-tuples
             URL" $wiki" <redirect>
-        ] >>submit ;
+        ] >>submit
+
+     <protected>
+        "delete wiki articles" >>description
+        { can-delete-wiki-articles? } >>capabilities ;
 
 : <diff-action> ( -- action )
     <page-action>
@@ -218,6 +245,7 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <list-articles-action> ( -- action )
     <page-action>
+
         [
             f <article> select-tuples
             [ [ title>> ] compare ] sort
@@ -232,23 +260,24 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <user-edits-action> ( -- action )
     <page-action>
+
+        "author" >>rest
+
         [
             validate-author
             list-user-edits "user-edits" set-value
         ] >>init
+
         { wiki "user-edits" } >>template ;
 
 : <user-edits-feed-action> ( -- action )
     <feed-action>
+        "author" >>rest
         [ validate-author ] >>init
         [ "Edits by " "author" value append ] >>title
         [ "author" value user-edits-url ] >>url
         [ list-user-edits ] >>entries ;
 
-SYMBOL: can-delete-wiki-articles?
-
-can-delete-wiki-articles? define-capability
-
 : <article-boilerplate> ( responder -- responder' )
     <boilerplate>
         { wiki "page-common" } >>template ;
@@ -261,18 +290,13 @@ can-delete-wiki-articles? define-capability
         <list-revisions-action> <article-boilerplate> "revisions" add-responder
         <list-revisions-feed-action> "revisions.atom" add-responder
         <diff-action> <article-boilerplate> "diff" add-responder
-        <edit-article-action> <article-boilerplate> <protected>
+        <edit-article-action> <article-boilerplate> "edit" add-responder
-            "edit wiki articles" >>description
-            "edit" add-responder
         <rollback-action> "rollback" add-responder
         <user-edits-action> "user-edits" add-responder
         <list-articles-action> "articles" add-responder
         <list-changes-action> "changes" add-responder
         <user-edits-feed-action> "user-edits.atom" add-responder
         <list-changes-feed-action> "changes.atom" add-responder
-        <delete-action> <protected>
+        <delete-action> "delete" add-responder
-            "delete wiki articles" >>description
-            { can-delete-wiki-articles? } >>capabilities
-        "delete" add-responder
     <boilerplate>
         { wiki "wiki-common" } >>template ;