steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Doug Coleman 2008-06-03 10:12:00 -05:00
parent 9bac6e5852 5127a587ea
commit afd6c9089c
22 changed files with 135 additions and 80 deletions

6
extra/furnace/auth/basic/basic.factor
View File

@ -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
furnace.auth.providers furnace.auth.login
http sequences ;
base64 html.elements io combinators sequences
http http.server.filters http.server.responses http.server
furnace.auth.providers furnace.auth.login ;
IN: furnace.auth.basic
TUPLE: basic-auth < filter-responder realm provider ;

2
extra/html/components/components-tests.factor
View File

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

2
extra/html/parser/analyzer/analyzer.factor
View File

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

8
extra/html/templates/chloe/chloe-tests.factor
View File

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

4
extra/http/server/cgi/cgi.factor
View File

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

3
extra/http/server/server.factor
View File

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

39
extra/unicode/collation/collation-docs.factor
View File

@ -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." } ;

3
extra/unicode/collation/collation-tests.factor
View File

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

17
extra/unicode/collation/collation.factor
View File

@ -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} -- <=> )
2dup [ second ] bi@ <=> dup +eq+ =
[ drop <=> ] [ 2nip ] if ;
<PRIVATE
: 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
keys ;
natural-sort values ;
: string<=> ( str1 str2 -- <=> )
[ w/collation-key ] bi@ compare-collation ;
[ w/collation-key ] compare ;

2
extra/webapps/counter/counter.factor
View File

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

11
extra/webapps/wiki/diff.xml
View File

@ -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:bind>
<t:title>Diff: <t:label t:name="title" /></t:title>
<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>

6
extra/webapps/wiki/edit.xml
View File

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

14
extra/webapps/wiki/page-common.xml Normal file
View File

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

9
extra/webapps/wiki/revisions.xml
View File

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

7
extra/webapps/wiki/view.xml
View File

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

1
extra/webapps/wiki/wiki.css
View File

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

16
extra/webapps/wiki/wiki.factor
View File

@ -216,16 +216,20 @@ revision "REVISIONS" {
: <wiki> ( -- dispatcher )
wiki new-dispatcher
<main-article-action> "" add-responder
<view-article-action> "view" add-responder
<view-revision-action> "revision" add-responder
<list-revisions-action> "revisions" add-responder
<dispatcher>
<main-article-action> "" add-responder
<view-article-action> "view" 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 ;

4
extra/xmode/code2html/responder/responder.factor
View File

@ -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
accessors fry ;
http.server.responses http.server.static http xmode.code2html
kernel sequences accessors fry ;
IN: xmode.code2html.responder
: <sources> ( root -- responder )

1
extra/yahoo/authors.txt
View File

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

2
extra/yahoo/summary.txt
View File

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

4
extra/yahoo/yahoo-tests.factor
View File

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

54
extra/yahoo/yahoo.factor
View File

@ -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 )
[
yahoo-url %
"?appid=" % appid %
"&query=" % search url-encode %
"&results=" % num #
] "" make ;
:: param ( search url name quot -- search url )
search url search quot call
[ name set-query-param ] when* ; inline
: num-param ( search str quot -- search )
[ dup [ number>string ] when ] compose param ; inline
: 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 )
query http-get string>xml parse-yahoo ;
: <search> ( query -- search )
search new
factor-id >>appid
10 >>results
swap >>query ;
: search-yahoo ( search num -- seq )
factor-id search-yahoo/id ;
: search-yahoo ( search -- seq )
query http-get string>xml parse-yahoo ;