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

diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor
index 2a6348929941947b4eee98bccf1cf44875e01332..7505b3c6126f7588be4bdfc0fac0db318cb71546 100755 (executable)
--- a/basis/furnace/actions/actions.factor
+++ b/basis/furnace/actions/actions.factor
@@ -79,7 +79,7 @@ TUPLE: action rest authorize init display validate submit ;
 \r
 : revalidate-url ( -- url/f )\r
     revalidate-url-key param\r
-    dup [ >url [ same-host? ] keep and ] when ;\r
+    dup [ >url ensure-port [ same-host? ] keep and ] when ;\r
 \r
 : validation-failed ( -- * )\r
     post-request? revalidate-url and [\r

diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index dafc9dd06bec88118344ddceafa12fa6ba81aefe..6f35ba5d975bd21af143347af6c39345422b3dbc 100644 (file)
--- 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? -- )
-    <option [ "true" =selected ] when option>
+    <option [ "selected" =selected ] when option>
         present escape-string write
     </option> ;
 

diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor
index 748c206cc044a4bdd235618e7066360ede96b4ee..3dfc17c08167418d2f2987d0e43650d4efe9dea4 100644 (file)
--- 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 ca7511f1affa1f6d37c78869d85adacf1d0c0a90..aca09b939c4e374d89d3cb02f711c968906ae5d8 100644 (file)
--- 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 c98802657bdd92ecf5195c05dc6faf9041d65a7f..cac206bf3cc8cfe44e39c2c84a5e5c232411127e 100644 (file)
--- 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 fb56e274da4f49215eb2b55ad4cf03adc7d0003c..5cc8c9693b50f7384a5ec566f13e652728324ef3 100644 (file)
--- 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 ) 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 905cd87903720e537f9f98fb6c14aa3506584f9e..2b7de36d562b8f0bfdd796e474af463092740305 100755 (executable)
--- 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 e9b6a4863480513f4132f1c64919f9f486321a91..c209fe222e6eb0fb13e30927828463894000adfd 100644 (file)
--- 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 f4262a6f6accc3d235cadb931f788af864368bf5..7718b10a2280836ec18572805272ae76d4850c1a 100644 (file)
--- a/extra/webapps/help/help.xml
+++ b/extra/webapps/help/help.xml
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
+<?xml version="1.0"?>
 <!DOCTYPE html 
      PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
      "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">

diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml
index 8335725ce5a070d27266f6c13dcb859b7acb46c3..e5fa5d3901a5128c34d4a2f1565b1f1fadba1581 100644 (file)
--- a/extra/webapps/help/search.xml
+++ b/extra/webapps/help/search.xml
@@ -23,10 +23,10 @@
 
                <p>This is the <a href="http://factorcode.org" target="_top">Factor</a>
                documentation, generated offline from a
-               <code>load-everything</code> image. The Factor UI also
-               includes a documentation browser tool.</p>
+               <code>load-everything</code> image. If you want, you can also browse the
+               documentation from within the <a href="http://factorcode.org" target="_top">Factor</a> UI.</p>
                
-               <p>You may search article titles below.</p>
+               <p>You may search article titles below; for example, try searching for "HTTP".</p>
                
                <t:form t:action="$help-webapp/search">
                        <t:field t:name="search" />

diff --git a/extra/webapps/pastebin/new-paste.xml b/extra/webapps/pastebin/new-paste.xml
index 6abae4895ba502f74415a6f7a9178c46ff41502b..96339b6cf86a0b77438e74e2176522aafe176a2e 100644 (file)
--- a/extra/webapps/pastebin/new-paste.xml
+++ b/extra/webapps/pastebin/new-paste.xml
@@ -18,6 +18,6 @@
                        </tr>
                </table>
 
-               <input type="SUBMIT" value="Submit" />
+               <p> <button>Submit</button> </p>
        </t:form>
 </t:chloe>

diff --git a/extra/webapps/pastebin/paste.xml b/extra/webapps/pastebin/paste.xml
index 1c138fc8c0835ebd534fb77863d152e03b2b5633..8fe672049f07527188049e63fb05f5e3a127a5b4 100644 (file)
--- a/extra/webapps/pastebin/paste.xml
+++ b/extra/webapps/pastebin/paste.xml
@@ -20,7 +20,7 @@
 
        <t:bind-each t:name="annotations">
 
-               <a name="@id"><h2>Annotation: <t:label t:name="summary" /></h2></a>
+               <h2><a name="@id">Annotation: <t:label t:name="summary" /></a></h2>
 
                <table>
                        <tr><th class="field-label">Author: </th><td><t:label t:name="author" /></td></tr>
@@ -52,7 +52,7 @@
                                </tr>
                        </table>
 
-                       <input type="SUBMIT" value="Done" />
+                       <p> <button>Done</button> </p>
 
                </t:form>
 

diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor
index cd6e183d14f8acc575b9879f21d7456ba8eefa0f..00d843573cc0eba8a7498a4641dbbf98621ac131 100755 (executable)
--- a/extra/webapps/planet/planet.factor
+++ b/extra/webapps/planet/planet.factor
@@ -166,14 +166,14 @@ posting "POSTINGS"
         [
             f <blog>
             [ deposit-blog-slots ]
+            [ "id" value >>id ]
             [ update-tuple ]
-            [
-                <url>
-                    "$planet/admin" >>path
-                    swap id>> "id" set-query-param
-                <redirect>
-            ]
             tri
+
+            <url>
+                "$planet/admin" >>path
+                "id" value "id" set-query-param
+            <redirect>
         ] >>submit ;
 
 : <planet-admin> ( -- responder )

diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor
index 72eb48306653a2b89cee05ae472d10a76139b0d2..5553fda740cbd8174d8736bd00ed1cb6b490c265 100644 (file)
--- a/extra/websites/concatenative/concatenative.factor
+++ b/extra/websites/concatenative/concatenative.factor
@@ -45,14 +45,13 @@ TUPLE: factor-website < dispatcher ;
     <boilerplate>
         { factor-website "page" } >>template ;
 
-: <configuration> ( responder -- responder' )
+: <login-config> ( responder -- responder' )
     "Factor website" <login-realm>
         "Factor website" >>name
         allow-registration
         allow-password-recovery
         allow-edit-profile
-        allow-deactivation
-    test-db <alloy> ;
+        allow-deactivation ;
 
 : <factor-website> ( -- responder )
     factor-website new-dispatcher
@@ -77,11 +76,10 @@ SYMBOL: dh-file
     "password" key-password set-global
     common-configuration
     <factor-website>
-        <pastebin> "pastebin" add-responder
-        <planet> "planet" add-responder
+        <pastebin> <factor-boilerplate> <login-config> "pastebin" add-responder
+        <planet> <factor-boilerplate> <login-config> "planet" add-responder
         "/tmp/docs/" <help-webapp> "docs" add-responder
-    <factor-boilerplate>
-    <configuration>
+    test-db <alloy>
     main-responder set-global ;
 
 : <gitweb> ( path -- responder )
@@ -92,10 +90,10 @@ SYMBOL: dh-file
 : init-production ( -- )
     common-configuration
     <vhost-dispatcher>
-        <factor-website> <factor-boilerplate> <configuration> "concatenative.org" add-responder
-        <pastebin> <factor-boilerplate> <configuration> "paste.factorcode.org" add-responder
-        <planet> <factor-boilerplate> <configuration> "planet.factorcode.org" add-responder
-        home "docs" append-path <help-webapp> <configuration> "docs.factorcode.org" add-responder
+        <factor-website> <login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
+        <pastebin> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.org" add-responder
+        <planet> <login-config> <factor-boilerplate> test-db <alloy> "planet.factorcode.org" add-responder
+        home "docs" append-path <help-webapp> test-db <alloy> "docs.factorcode.org" add-responder
         home "cgi" append-path <gitweb> "gitweb.factorcode.org" add-responder
     main-responder set-global ;