From 4b219373a5b4ed1fc7ca82fde1c8d36f2965cde8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:33:06 -0500 Subject: [PATCH 01/13] Tweaks --- basis/furnace/actions/actions.factor | 2 +- extra/webapps/help/help.factor | 2 +- extra/websites/concatenative/concatenative.factor | 5 ++--- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 2a63489299..7505b3c612 100755 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -79,7 +79,7 @@ TUPLE: action rest authorize init display validate submit ; : revalidate-url ( -- url/f ) revalidate-url-key param - dup [ >url [ same-host? ] keep and ] when ; + dup [ >url ensure-port [ same-host? ] keep and ] when ; : validation-failed ( -- * ) post-request? revalidate-url and [ diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index e9b6a48634..c209fe222e 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -13,7 +13,7 @@ TUPLE: help-webapp < dispatcher ; [ { - { "search" [ 2 v-min-length 50 v-max-length v-one-line ] } + { "search" [ 1 v-min-length 50 v-max-length v-one-line ] } } validate-params help-dir set-current-directory diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 72eb483066..0af8eb31d7 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -77,10 +77,9 @@ SYMBOL: dh-file "password" key-password set-global common-configuration - "pastebin" add-responder - "planet" add-responder + "pastebin" add-responder + "planet" add-responder "/tmp/docs/" "docs" add-responder - main-responder set-global ; From e84dec38ef2c40f185368f7c9790503d89013e87 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:39:53 -0500 Subject: [PATCH 02/13] Doc fixes --- basis/locals/locals-docs.factor | 2 +- core/syntax/syntax-docs.factor | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index 748c206cc0..3dfc17c081 100644 --- a/basis/locals/locals-docs.factor +++ b/basis/locals/locals-docs.factor @@ -65,7 +65,7 @@ HELP: [wlet HELP: :: { $syntax ":: word ( bindings... -- outputs... ) body... ;" } -{ $description "Defines a word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope. Any " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " or " { $link POSTPONE: [wlet } " forms used in the body of the word definition are automatically closure-converted." } +{ $description "Defines a word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope." } { $notes "The output names do not affect the word's behavior, however the compiler attempts to check the stack effect as with other definitions." } { $examples "See " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " and " { $link POSTPONE: [wlet } "." } ; diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 905cd87903..2b7de36d56 100755 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -573,12 +573,12 @@ $nl } ; HELP: initial: -{ $syntax "TUPLE: ... { \"slot\" initial: value } ... ;" } +{ $syntax "TUPLE: ... { slot initial: value } ... ;" } { $values { "slot" "a slot name" } { "value" "any literal" } } { $description "Specifies an initial value for a tuple slot." } ; HELP: read-only -{ $syntax "TUPLE: ... { \"slot\" read-only } ... ;" } +{ $syntax "TUPLE: ... { slot read-only } ... ;" } { $values { "slot" "a slot name" } } { $description "Defines a tuple slot to be read-only. If a tuple has read-only slots, instances of the tuple should only be created by calling " { $link boa } ", instead of " { $link new } ". Using " { $link boa } " is the only way to set the value of a read-only slot." } ; From a5f9e0eb23ff01c94a51da57e557bcd94fbf2f92 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:40:00 -0500 Subject: [PATCH 03/13] Template tweak --- extra/webapps/help/search.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index 8335725ce5..324dc028e1 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -23,10 +23,10 @@

This is the Factor documentation, generated offline from a - load-everything image. The Factor UI also - includes a documentation browser tool.

+ load-everything image. If you want, you can also browse the + documentation from within the Factor UI.

-

You may search article titles below.

+

You may search article titles below; for example, try searching for "HTTP".

From 304e069af22a835009481855c9352bbfd0f375ce Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:40:41 -0500 Subject: [PATCH 04/13] Template tweak --- extra/webapps/help/search.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index 324dc028e1..e5fa5d3901 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -24,7 +24,7 @@

This is the Factor documentation, generated offline from a load-everything image. If you want, you can also browse the - documentation from within the Factor UI.

+ documentation from within the Factor UI.

You may search article titles below; for example, try searching for "HTTP".

From 81bd2eb175824fba470ea11a235b8173080db48e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:54:10 -0500 Subject: [PATCH 05/13] Remove raw-query stuff, its a pain --- basis/urls/urls-tests.factor | 5 ----- basis/urls/urls.factor | 22 +++++++++++----------- 2 files changed, 11 insertions(+), 16 deletions(-) diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index c98802657b..cac206bf3c 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -10,7 +10,6 @@ arrays kernel assocs present accessors ; { host "www.apple.com" } { port 1234 } { path "/a/path" } - { raw-query "a=b" } { query H{ { "a" "b" } } } { anchor "foo" } } @@ -21,7 +20,6 @@ arrays kernel assocs present accessors ; { protocol "http" } { host "www.apple.com" } { path "/a/path" } - { raw-query "a=b" } { query H{ { "a" "b" } } } { anchor "foo" } } @@ -59,7 +57,6 @@ arrays kernel assocs present accessors ; { T{ url { path "bar" } - { raw-query "a=b" } { query H{ { "a" "b" } } } } "bar?a=b" @@ -213,7 +210,6 @@ urls [ T{ url { protocol "http" } { host "localhost" } - { raw-query "foo=bar" } { query H{ { "foo" "bar" } } } { path "/" } } @@ -224,7 +220,6 @@ urls [ T{ url { protocol "http" } { host "localhost" } - { raw-query "foo=bar" } { query H{ { "foo" "bar" } } } { path "/" } } diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index fb56e274da..5cc8c9693b 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -8,7 +8,7 @@ strings.parser lexer prettyprint.backend hashtables present peg.ebnf urls.encoding ; IN: urls -TUPLE: url protocol username password host port path raw-query query anchor ; +TUPLE: url protocol username password host port path query anchor ; : ( -- url ) url new ; @@ -47,7 +47,7 @@ protocol = [a-z]+ => [[ url-decode ]] username = [^/:@#?]+ => [[ url-decode ]] password = [^/:@#?]+ => [[ url-decode ]] pathname = [^#?]+ => [[ url-decode ]] -query = [^#]+ => [[ >string ]] +query = [^#]+ => [[ query>assoc ]] anchor = .+ => [[ url-decode ]] hostname = [^/#?]+ => [[ url-decode ]] @@ -80,7 +80,7 @@ M: string >url ] [ f f f f f ] if* ] [ second ] ! pathname - [ third dup query>assoc ] ! query + [ third ] ! query [ fourth ] ! anchor } cleave url boa dup host>> [ [ "/" or ] change-path ] when ; @@ -139,14 +139,14 @@ PRIVATE> : derive-url ( base url -- url' ) [ clone ] dip over { - [ [ protocol>> ] either? >>protocol ] - [ [ username>> ] either? >>username ] - [ [ password>> ] either? >>password ] - [ [ host>> ] either? >>host ] - [ [ port>> ] either? >>port ] - [ [ path>> ] bi@ swap url-append-path >>path ] - [ [ query>> ] either? >>query ] - [ [ anchor>> ] either? >>anchor ] + [ [ protocol>> ] either? >>protocol ] + [ [ username>> ] either? >>username ] + [ [ password>> ] either? >>password ] + [ [ host>> ] either? >>host ] + [ [ port>> ] either? >>port ] + [ [ path>> ] bi@ swap url-append-path >>path ] + [ [ query>> ] either? >>query ] + [ [ anchor>> ] either? >>anchor ] } 2cleave ; : relative-url ( url -- url' ) From 25df1f96145768c374918e17f79359ec6a81d03b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:04:14 -0500 Subject: [PATCH 06/13] Tweak config --- .../websites/concatenative/concatenative.factor | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 0af8eb31d7..0fec239743 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -45,7 +45,7 @@ TUPLE: factor-website < dispatcher ; { factor-website "page" } >>template ; -: ( responder -- responder' ) +: ( responder -- responder' ) "Factor website" "Factor website" >>name allow-registration @@ -77,10 +77,10 @@ SYMBOL: dh-file "password" key-password set-global common-configuration - "pastebin" add-responder - "planet" add-responder + "pastebin" add-responder + "planet" add-responder "/tmp/docs/" "docs" add-responder - + test-db main-responder set-global ; : ( path -- responder ) @@ -91,11 +91,12 @@ SYMBOL: dh-file : init-production ( -- ) common-configuration - "concatenative.org" add-responder - "paste.factorcode.org" add-responder - "planet.factorcode.org" add-responder - home "docs" append-path "docs.factorcode.org" add-responder + "concatenative.org" add-responder + "paste.factorcode.org" add-responder + "planet.factorcode.org" add-responder + home "docs" append-path "docs.factorcode.org" add-responder home "cgi" append-path "gitweb.factorcode.org" add-responder + test-db main-responder set-global ; : ( -- config ) From 9b05fe003254a98fca5c7e0eeaa3162a2d90df1a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:05:21 -0500 Subject: [PATCH 07/13] Oops --- extra/websites/concatenative/concatenative.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 0fec239743..527b0507ba 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -51,8 +51,7 @@ TUPLE: factor-website < dispatcher ; allow-registration allow-password-recovery allow-edit-profile - allow-deactivation - test-db ; + allow-deactivation ; : ( -- responder ) factor-website new-dispatcher From 2b10a154ced6986da042c4b8912218401b0efb9f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:08:37 -0500 Subject: [PATCH 08/13] Broke gitweb oops --- extra/websites/concatenative/concatenative.factor | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 527b0507ba..5553fda740 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -90,12 +90,11 @@ SYMBOL: dh-file : init-production ( -- ) common-configuration - "concatenative.org" add-responder - "paste.factorcode.org" add-responder - "planet.factorcode.org" add-responder - home "docs" append-path "docs.factorcode.org" add-responder + test-db "concatenative.org" add-responder + test-db "paste.factorcode.org" add-responder + test-db "planet.factorcode.org" add-responder + home "docs" append-path test-db "docs.factorcode.org" add-responder home "cgi" append-path "gitweb.factorcode.org" add-responder - test-db main-responder set-global ; : ( -- config ) From 1bd36b3d879cf91733211c2c77c0900d8655db4d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:13:46 -0500 Subject: [PATCH 09/13] Working on XHTML 1.1 validation --- basis/html/components/components.factor | 2 +- extra/webapps/pastebin/new-paste.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor index dafc9dd06b..6f35ba5d97 100644 --- a/basis/html/components/components.factor +++ b/basis/html/components/components.factor @@ -83,7 +83,7 @@ TUPLE: choice size multiple choices ; choice new ; : render-option ( text selected? -- ) - ; diff --git a/extra/webapps/pastebin/new-paste.xml b/extra/webapps/pastebin/new-paste.xml index 6abae4895b..96339b6cf8 100644 --- a/extra/webapps/pastebin/new-paste.xml +++ b/extra/webapps/pastebin/new-paste.xml @@ -18,6 +18,6 @@ - +

From 00f3c256d97d9dfed71277b68ce3a8605ca0ae6e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:16:14 -0500 Subject: [PATCH 10/13] Working on XHTML 1.1 validation --- extra/webapps/pastebin/paste.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/webapps/pastebin/paste.xml b/extra/webapps/pastebin/paste.xml index 1c138fc8c0..8fe672049f 100644 --- a/extra/webapps/pastebin/paste.xml +++ b/extra/webapps/pastebin/paste.xml @@ -20,7 +20,7 @@ -

Annotation:

+

Annotation:

@@ -52,7 +52,7 @@
Author:
- +

From 0dff27507dec3bfceeb13c3aa9327e3c035c7498 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:20:12 -0500 Subject: [PATCH 11/13] Fix validation warning --- extra/webapps/help/help.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/help/help.xml b/extra/webapps/help/help.xml index f4262a6f6a..7718b10a22 100644 --- a/extra/webapps/help/help.xml +++ b/extra/webapps/help/help.xml @@ -1,4 +1,4 @@ - + From 94872bd43a851f9cb1c00aed217ec8dbc5325851 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:29:51 -0500 Subject: [PATCH 12/13] Fix edit-blog action --- extra/webapps/planet/planet.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index cd6e183d14..00d843573c 100755 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -166,14 +166,14 @@ posting "POSTINGS" [ f [ deposit-blog-slots ] + [ "id" value >>id ] [ update-tuple ] - [ - - "$planet/admin" >>path - swap id>> "id" set-query-param - - ] tri + + + "$planet/admin" >>path + "id" value "id" set-query-param + ] >>submit ; : ( -- responder ) From e438fe2a80ae19d158678b284eb3f491bcdcdd65 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:36:40 -0500 Subject: [PATCH 13/13] Handle Atom feeds with multiple entry links --- basis/syndication/syndication.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index ca7511f1af..aca09b939c 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -69,11 +69,15 @@ TUPLE: entry title url description date ; [ "item" tags-named [ rss2.0-entry ] map set-entries ] tri ; +: atom-entry-link ( tag -- url/f ) + "link" tags-named [ "rel" swap at "alternate" = ] find nip + dup [ "href" swap at >url ] when ; + : atom1.0-entry ( tag -- entry ) entry new swap { [ "title" tag-named children>string >>title ] - [ "link" tag-named "href" swap at >url >>url ] + [ atom-entry-link >>url ] [ { "content" "summary" } any-tag-named dup children>> [ string? not ] contains?