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/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/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/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? 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' ) 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." } ; 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/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 @@ - + diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index 8335725ce5..e5fa5d3901 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".

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 @@ - +

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:
- +

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 ) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 72eb483066..5553fda740 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -45,14 +45,13 @@ TUPLE: factor-website < dispatcher ; { factor-website "page" } >>template ; -: ( responder -- responder' ) +: ( responder -- responder' ) "Factor website" "Factor website" >>name allow-registration allow-password-recovery allow-edit-profile - allow-deactivation - test-db ; + allow-deactivation ; : ( -- responder ) factor-website new-dispatcher @@ -77,11 +76,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 ) @@ -92,10 +90,10 @@ 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 main-responder set-global ;