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

extra/furnace/auth/basic/basic.factor

@@ -1,9 +1,9 @@
 ! Copyright (c) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors quotations assocs kernel splitting
-base64 html.elements io combinators http.server
+base64 html.elements io combinators sequences
-furnace.auth.providers furnace.auth.login
+http http.server.filters http.server.responses http.server
-http sequences ;
+furnace.auth.providers furnace.auth.login ;
 IN: furnace.auth.basic
 
 TUPLE: basic-auth < filter-responder realm provider ;

extra/html/components/components-tests.factor

@@ -1,7 +1,7 @@
 IN: html.components.tests
 USING: tools.test kernel io.streams.string
 io.streams.null accessors inspector html.streams
-html.components namespaces ;
+html.elements html.components namespaces ;
 
 [ ] [ blank-values ] unit-test
 

extra/html/parser/analyzer/analyzer.factor

@@ -1,6 +1,6 @@
 USING: assocs html.parser kernel math sequences strings ascii
 arrays shuffle unicode.case namespaces splitting http
-sequences.lib accessors io combinators http.client ;
+sequences.lib accessors io combinators http.client urls ;
 IN: html.parser.analyzer
 
 TUPLE: link attributes clickable ;

extra/html/templates/chloe/chloe-tests.factor

@@ -1,7 +1,7 @@
 USING: html.templates html.templates.chloe
 tools.test io.streams.string kernel sequences ascii boxes
 namespaces xml html.components
-splitting unicode.categories ;
+splitting unicode.categories furnace ;
 IN: html.templates.chloe.tests
 
 [ f ] [ f parse-query-attr ] unit-test
@@ -49,7 +49,7 @@ IN: html.templates.chloe.tests
     [
         [
             "test2" test-template call-template
-        ] [ "test3" test-template ] with-boilerplate
+        ] "test3" test-template with-boilerplate
     ] run-template
 ] unit-test
 
@@ -137,7 +137,7 @@ TUPLE: person first-name last-name ;
 
 [ "<table><tr><td>RBaxter</td><td>Unknown</td></tr><tr><td>Doug</td><td>Coleman</td></tr></table>" ] [
     [
-        "test9" test-template call-template
+        "test8" test-template call-template
     ] run-template [ blank? not ] filter
 ] unit-test
 
@@ -145,6 +145,6 @@ TUPLE: person first-name last-name ;
 
 [ "<a name=\"1\">Hello</a>" ] [
     [
-        "test10" test-template call-template
+        "test9" test-template call-template
     ] run-template
 ] unit-test

extra/http/server/cgi/cgi.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel assocs io.files io.streams.duplex
 combinators arrays io.launcher io http.server.static http.server
-http accessors sequences strings math.parser fry ;
+http accessors sequences strings math.parser fry urls ;
 IN: http.server.cgi
 
 : post? request get method>> "POST" = ;
@@ -28,7 +28,7 @@ IN: http.server.cgi
         "" "REMOTE_IDENT" set
 
         request get method>> "REQUEST_METHOD" set
-        request get query>> assoc>query "QUERY_STRING" set
+        request get url>> query>> assoc>query "QUERY_STRING" set
         request get "cookie" header "HTTP_COOKIE" set 
 
         request get "user-agent" header "HTTP_USER_AGENT" set

extra/http/server/server.factor

@@ -63,7 +63,8 @@ LOG: httpd-hit NOTICE
     url>> path>> split-path main-responder get call-responder ;
 
 : do-request ( request -- response )
-    [
+    '[
+        ,
         [ init-request ]
         [ log-request ]
         [ dispatch-request ] tri

extra/unicode/collation/collation-docs.factor

@@ -1,7 +1,42 @@
-USING: help.syntax help.markup ;
+USING: help.syntax help.markup strings byte-arrays ;
 IN: unicode.collation
 
 ABOUT: "unicode.collation"
 
 ARTICLE: "unicode.collation" "Unicode collation algorithm"
-"The Unicode Collation Algorithm (UTS #10) forms a reasonable way to sort strings when accouting for all of the characters in Unicode." ;
+"The Unicode Collation Algorithm (UTS #10) forms a reasonable way to sort strings when accouting for all of the characters in Unicode. At the moment, only the default Unicode collation element table (DUCET) is used, but a more accurate collation would take locale into account. The following words are defined:"
+{ $subsection sort-strings }
+{ $subsection collation-key }
+{ $subsection string<=> }
+{ $subsection primary= }
+{ $subsection secondary= }
+{ $subsection tertiary= }
+{ $subsection quaternary= } ;
+
+HELP: sort-strings
+{ $values { "strings" "a sequence of strings" } { "sorted" "the strings in DUCET order" } }
+{ $description "This word takes a sequence of strings and sorts them according to the UCA, using code point order as a tie-breaker." } ;
+
+HELP: collation-key
+{ $values { "string" string } { "key" byte-array } }
+{ $description "This takes a string and gives a representation of the collation key, which can be compared with <=>" } ;
+
+HELP: string<=>
+{ $values { "str1" string } { "str2" string } { "<=>" "one of +lt+, +gt+ or +eq+" } }
+{ $description "This word takes two strings and compares them using the UCA with the DUCET, using code point order as a tie-breaker." } ;
+
+HELP: primary=
+{ $values { "str1" string } { "str2" string } { "?" "t or f" } }
+{ $description "This checks whether the first level of collation is identical. This is the least specific kind of equality test. In Latin script, it can be understood as ignoring case, punctuation and accent marks." } ;
+
+HELP: secondary=
+{ $values { "str1" string } { "str2" string } { "?" "t or f" } }
+{ $description "This checks whether the first two levels of collation are equal. For Latin script, this means accent marks are significant again, and it is otherwise similar to primary=." } ;
+
+HELP: tertiary=
+{ $values { "str1" string } { "str2" string } { "?" "t or f" } }
+{ $description "Along the same lines as secondary=, but case is significant." } ;
+
+HELP: quaternary=
+{ $values { "str1" string } { "str2" string } { "?" "t or f" } }
+{ $description "This is similar to tertiary= but it makes punctuation significant again, while still leaving out things like null bytes and Hebrew vowel marks, which mean absolutely nothing in collation." } ;

extra/unicode/collation/collation-tests.factor

@@ -24,6 +24,9 @@ IN: unicode.collation.tests
 [ t t f f ] [ "hello" "HELLO" test-equality ] unit-test
 [ t t t f ] [ "hello" "h e l l o." test-equality ] unit-test
 [ t t t t ] [ "hello" "\0hello\0" test-equality ] unit-test
+[ { "good bye" "goodbye" "hello" "HELLO" } ]
+[ { "HELLO" "goodbye" "good bye" "hello" } sort-strings ]
+unit-test
 
 parse-test 2 <clumps>
 [ [ test-two ] assoc-each ] with-null-writer

extra/unicode/collation/collation.factor

@@ -6,6 +6,7 @@ unicode.syntax macros sequences.deep words unicode.breaks
 quotations ;
 IN: unicode.collation
 
+<PRIVATE
 VALUE: ducet
 
 TUPLE: weight primary secondary tertiary ignorable? ;
@@ -115,6 +116,7 @@ ducet insert-helpers
             [ [ variable-weight ] each ]
         } cleave
     ] { } make ;
+PRIVATE>
 
 : completely-ignorable? ( weight -- ? )
     [ primary>> ] [ secondary>> ] [ tertiary>> ] tri
@@ -131,11 +133,13 @@ ducet insert-helpers
     nfd string>graphemes graphemes>weights
     filter-ignorable weights>bytes ;
 
+<PRIVATE
 : insensitive= ( str1 str2 levels-removed -- ? )
     [
         swap collation-key swap
         [ [ 0 = not ] right-trim but-last ] times
     ] curry bi@ = ;
+PRIVATE>
 
 : primary= ( str1 str2 -- ? )
     3 insensitive= ;
@@ -149,17 +153,14 @@ ducet insert-helpers
 : quaternary= ( str1 str2 -- ? )
     0 insensitive= ;
 
-: compare-collation ( {str1,key} {str2,key} -- <=> )
+<PRIVATE
-    2dup [ second ] bi@ <=> dup +eq+ =
-    [ drop <=> ] [ 2nip ] if ;
-
 : w/collation-key ( str -- {str,key} )
-    dup collation-key 2array ;
+    [ collation-key ] keep 2array ;
+PRIVATE>
 
 : sort-strings ( strings -- sorted )
     [ w/collation-key ] map
-    [ compare-collation ] sort
+    natural-sort values ;
-    keys ;
 
 : string<=> ( str1 str2 -- <=> )
-    [ w/collation-key ] bi@ compare-collation ;
+    [ w/collation-key ] compare ;

extra/webapps/counter/counter.factor

@@ -1,5 +1,5 @@
 USING: math kernel accessors http.server http.server.dispatchers
-furnace.actions furnace.sessions
+furnace furnace.actions furnace.sessions
 html.components html.templates.chloe
 fry urls ;
 IN: webapps.counter

extra/webapps/wiki/diff.xml

@@ -2,9 +2,7 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:bind t:name="old">
+	<t:title>Diff: <t:label t:name="title" /></t:title>
-		<t:title>Diff: <t:label t:name="title" /></t:title>
-	</t:bind>
 
 	<table>
 		<tr>
@@ -23,11 +21,4 @@
 
 	<t:comparison t:name="diff" />
 
-	<div class="navbar">
-		<t:a t:href="$wiki/view" t:query="title">Latest</t:a>
-		| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
-		| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
-		| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
-	</div>
-
 </t:chloe>

extra/webapps/wiki/edit.xml

@@ -16,10 +16,4 @@
 
 	</t:form>
 
-	<div class="navbar">
-		<t:a t:href="$wiki/view" t:query="title">Latest</t:a>
-		| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
-		| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
-		| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
-	</div>
 </t:chloe>

extra/webapps/wiki/page-common.xml

@@ -0,0 +1,14 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+	<t:call-next-template />
+
+	<div class="navbar">
+		<t:a t:href="$wiki/view" t:query="title">Latest</t:a>
+		| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
+		| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
+		| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
+	</div>
+
+</t:chloe>

extra/webapps/wiki/revisions.xml

@@ -53,13 +53,4 @@
 		<input type="submit" value="View" />
 	</form>
 
-	<br/>
-
-	<div class="navbar">
-		<t:a t:href="$wiki/view" t:query="title">Latest</t:a>
-		| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
-		| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
-		| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
-	</div>
-
 </t:chloe>

extra/webapps/wiki/view.xml

@@ -10,11 +10,4 @@
 
 	<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>
 
-	<div class="navbar">
-		<t:a t:href="$wiki/view" t:query="title">Latest</t:a>
-		| <t:a t:href="$wiki/revisions" t:query="title">Revisions</t:a>
-		| <t:a t:href="$wiki/edit" t:query="title">Edit</t:a>
-		| <t:button t:action="$wiki/delete" t:for="title" class="link-button link">Delete</t:button>
-	</div>
-
 </t:chloe>

extra/webapps/wiki/wiki.css

@@ -2,6 +2,7 @@
     border-width: 1px;
     border-color: #666;
     border-style: solid;
+    width: 50%;
 }
 
 .comparison table {

extra/webapps/wiki/wiki.factor

@@ -216,16 +216,20 @@ revision "REVISIONS" {
 
 : <wiki> ( -- dispatcher )
     wiki new-dispatcher
-        <main-article-action> "" add-responder
+        <dispatcher>
-        <view-article-action> "view" add-responder
+            <main-article-action> "" add-responder
-        <view-revision-action> "revision" add-responder
+            <view-article-action> "view" add-responder
-        <list-revisions-action> "revisions" add-responder
+            <view-revision-action> "revision" add-responder
+            <list-revisions-action> "revisions" add-responder
+            <diff-action> "diff" add-responder
+            <edit-article-action> { } <protected> "edit" add-responder
+        <boilerplate>
+            { wiki "page-common" } >>template
+        >>default
         <rollback-action> "rollback" add-responder
         <user-edits-action> "user-edits" add-responder
-        <diff-action> "diff" add-responder
         <list-articles-action> "articles" add-responder
         <list-changes-action> "changes" add-responder
-        <edit-article-action> { } <protected> "edit" add-responder
         <delete-action> { } <protected> "delete" add-responder
     <boilerplate>
         { wiki "wiki-common" } >>template ;

extra/xmode/code2html/responder/responder.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.files io.encodings.utf8 namespaces http.server
-http.server.static http xmode.code2html kernel sequences
+http.server.responses http.server.static http xmode.code2html
-accessors fry ;
+kernel sequences accessors fry ;
 IN: xmode.code2html.responder
 
 : <sources> ( root -- responder )

extra/yahoo/authors.txt

@@ -1 +1,2 @@
 Daniel Ehrenberg
+Walton Chan

extra/yahoo/summary.txt

@@ -1 +1 @@
-Yahoo! search example using XML-RPC
+Yahoo! search example using XML

extra/yahoo/yahoo-tests.factor

@@ -1,4 +1,4 @@
-USING: tools.test yahoo kernel io.files xml sequences ;
+USING: tools.test yahoo kernel io.files xml sequences accessors urls ;
 
 [ T{
     result
@@ -8,4 +8,4 @@ USING: tools.test yahoo kernel io.files xml sequences ;
     "Official site with news, tour dates, discography, store, community, and more."
 } ] [ "resource:extra/yahoo/test-results.xml" file>xml parse-yahoo first ] unit-test
 
-[ "http://search.yahooapis.com/WebSearchService/V1/webSearch?appid=Factor-search&query=hi&results=1" ] [ "hi" 1 "Factor-search" query ] unit-test
+[ URL" http://search.yahooapis.com/WebSearchService/V1/webSearch?appid=Factor-search&query=hi&results=2&similar_ok=1" ] [ "hi" <search> "Factor-search" >>appid 2 >>results t >>similar-ok query ] unit-test

extra/yahoo/yahoo.factor

@@ -1,13 +1,16 @@
-! Copyright (C) 2006 Daniel Ehrenberg
+! Copyright (C) 2006 Daniel Ehrenberg, Walton Chan
 ! See http://factorcode.org/license.txt for BSD license.
 USING: http.client xml xml.utilities kernel sequences
-namespaces http math.parser help math.order locals ;
+math.parser urls accessors locals ;
 IN: yahoo
 
 TUPLE: result title url summary ;
 
 C: <result> result
 
+TUPLE: search query results adult-ok start appid region type
+format similar-ok language country site subscription license ;
+
 : parse-yahoo ( xml -- seq )
     "Result" deep-tags-named [
         { "Title" "Url" "Summary" }
@@ -16,21 +19,44 @@ C: <result> result
     ] map ;
 
 : yahoo-url ( -- str )
-    "http://search.yahooapis.com/WebSearchService/V1/webSearch" ;
+    URL" http://search.yahooapis.com/WebSearchService/V1/webSearch" ;
 
-:: query ( search num appid -- url )
+:: param ( search url name quot -- search url )
-    [
+    search url search quot call
-        yahoo-url %
+    [ name set-query-param ] when* ; inline
-        "?appid=" % appid %
+
-        "&query=" % search url-encode %
+: num-param ( search str quot -- search )
-        "&results=" % num #
+    [ dup [ number>string ] when ] compose param ; inline
-    ] "" make ;
+
+: bool-param ( search str quot -- search )
+    [ "1" and ] compose param ; inline
+
+: query ( search -- url )
+    yahoo-url clone
+    "appid" [ appid>> ] param
+    "query" [ query>> ] param
+    "region" [ region>> ] param
+    "type" [ type>> ] param
+    "format" [ format>> ] param
+    "language" [ language>> ] param
+    "country" [ country>> ] param
+    "site" [ site>> ] param
+    "subscription" [ subscription>> ] param
+    "license" [ license>> ] param
+    "results" [ results>> ] num-param
+    "start" [ start>> ] num-param
+    "adult_ok" [ adult-ok>> ] bool-param
+    "similar_ok" [ similar-ok>> ] bool-param
+    nip ;
 
 : factor-id
     "fRrVAKzV34GDyeRw6bUHDhEWHRedwfOC7e61wwXZLgGF80E67spxdQXuugBe2pgIevMmKwA-" ;
 
-: search-yahoo/id ( search num id -- seq )
+: <search> ( query -- search )
-    query http-get string>xml parse-yahoo ;
+    search new
+        factor-id >>appid
+        10 >>results
+        swap >>query ;
 
-: search-yahoo ( search num -- seq )
+: search-yahoo ( search -- seq )
-    factor-id search-yahoo/id ;
+    query http-get string>xml parse-yahoo ;