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

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

db4
John Benediktsson 2008-09-30 08:07:35 -07:00
parent 4b5ed34f9e e438fe2a80
commit 387db4f849
14 changed files with 44 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/furnace/actions/actions.factor
View File

@ -79,7 +79,7 @@ TUPLE: action rest authorize init display validate submit ;
: revalidate-url ( -- url/f ) : revalidate-url ( -- url/f )
revalidate-url-key param revalidate-url-key param
dup [ >url [ same-host? ] keep and ] when ; dup [ >url ensure-port [ same-host? ] keep and ] when ;
: validation-failed ( -- * ) : validation-failed ( -- * )
post-request? revalidate-url and [ post-request? revalidate-url and [

2
basis/html/components/components.factor
View File

@ -83,7 +83,7 @@ TUPLE: choice size multiple choices ;
choice new ; choice new ;
: render-option ( text selected? -- ) : render-option ( text selected? -- )
<option [ "true" =selected ] when option> <option [ "selected" =selected ] when option>
present escape-string write present escape-string write
</option> ; </option> ;

2
basis/locals/locals-docs.factor
View File

@ -65,7 +65,7 @@ HELP: [wlet
HELP: :: HELP: ::
{ $syntax ":: word ( bindings... -- outputs... ) body... ;" } { $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." } { $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 } "." } ; { $examples "See " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " and " { $link POSTPONE: [wlet } "." } ;

6
basis/syndication/syndication.factor
View File

@ -69,11 +69,15 @@ TUPLE: entry title url description date ;
[ "item" tags-named [ rss2.0-entry ] map set-entries ] [ "item" tags-named [ rss2.0-entry ] map set-entries ]
tri ; 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 ) : atom1.0-entry ( tag -- entry )
entry new entry new
swap { swap {
[ "title" tag-named children>string >>title ] [ "title" tag-named children>string >>title ]
[ "link" tag-named "href" swap at >url >>url ] [ atom-entry-link >>url ]
[ [
{ "content" "summary" } any-tag-named { "content" "summary" } any-tag-named
dup children>> [ string? not ] contains? dup children>> [ string? not ] contains?

5
basis/urls/urls-tests.factor
View File

@ -10,7 +10,6 @@ arrays kernel assocs present accessors ;
{ host "www.apple.com" } { host "www.apple.com" }
{ port 1234 } { port 1234 }
{ path "/a/path" } { path "/a/path" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
{ anchor "foo" } { anchor "foo" }
} }
@ -21,7 +20,6 @@ arrays kernel assocs present accessors ;
{ protocol "http" } { protocol "http" }
{ host "www.apple.com" } { host "www.apple.com" }
{ path "/a/path" } { path "/a/path" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
{ anchor "foo" } { anchor "foo" }
} }
@ -59,7 +57,6 @@ arrays kernel assocs present accessors ;
{ {
T{ url T{ url
{ path "bar" } { path "bar" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
} }
"bar?a=b" "bar?a=b"
@ -213,7 +210,6 @@ urls [
T{ url T{ url
{ protocol "http" } { protocol "http" }
{ host "localhost" } { host "localhost" }
{ raw-query "foo=bar" }
{ query H{ { "foo" "bar" } } } { query H{ { "foo" "bar" } } }
{ path "/" } { path "/" }
} }
@ -224,7 +220,6 @@ urls [
T{ url T{ url
{ protocol "http" } { protocol "http" }
{ host "localhost" } { host "localhost" }
{ raw-query "foo=bar" }
{ query H{ { "foo" "bar" } } } { query H{ { "foo" "bar" } } }
{ path "/" } { path "/" }
} }

6
basis/urls/urls.factor
View File

@ -8,7 +8,7 @@ strings.parser lexer prettyprint.backend hashtables present
peg.ebnf urls.encoding ; peg.ebnf urls.encoding ;
IN: urls 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 ; : <url> ( -- url ) url new ;
@ -47,7 +47,7 @@ protocol = [a-z]+ => [[ url-decode ]]
username = [^/:@#?]+ => [[ url-decode ]] username = [^/:@#?]+ => [[ url-decode ]]
password = [^/:@#?]+ => [[ url-decode ]] password = [^/:@#?]+ => [[ url-decode ]]
pathname = [^#?]+ => [[ url-decode ]] pathname = [^#?]+ => [[ url-decode ]]
query = [^#]+ => [[ >string ]] query = [^#]+ => [[ query>assoc ]]
anchor = .+ => [[ url-decode ]] anchor = .+ => [[ url-decode ]]
hostname = [^/#?]+ => [[ url-decode ]] hostname = [^/#?]+ => [[ url-decode ]]
@ -80,7 +80,7 @@ M: string >url
] [ f f f f f ] if* ] [ f f f f f ] if*
] ]
[ second ] ! pathname [ second ] ! pathname
[ third dup query>assoc ] ! query [ third ] ! query
[ fourth ] ! anchor [ fourth ] ! anchor
} cleave url boa } cleave url boa
dup host>> [ [ "/" or ] change-path ] when ; dup host>> [ [ "/" or ] change-path ] when ;

4
core/syntax/syntax-docs.factor
View File

@ -573,12 +573,12 @@ $nl
} ; } ;
HELP: initial: HELP: initial:
{ $syntax "TUPLE: ... { \"slot\" initial: value } ... ;" } { $syntax "TUPLE: ... { slot initial: value } ... ;" }
{ $values { "slot" "a slot name" } { "value" "any literal" } } { $values { "slot" "a slot name" } { "value" "any literal" } }
{ $description "Specifies an initial value for a tuple slot." } ; { $description "Specifies an initial value for a tuple slot." } ;
HELP: read-only HELP: read-only
{ $syntax "TUPLE: ... { \"slot\" read-only } ... ;" } { $syntax "TUPLE: ... { slot read-only } ... ;" }
{ $values { "slot" "a slot name" } } { $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." } ; { $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." } ;

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

@ -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 } validate-params
help-dir set-current-directory help-dir set-current-directory

2
extra/webapps/help/help.xml
View File

@ -1,4 +1,4 @@
<?xml version="1.0" encoding="iso-8859-1"?> <?xml version="1.0"?>
<!DOCTYPE html <!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN" PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"> "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">

6
extra/webapps/help/search.xml
View File

@ -23,10 +23,10 @@
<p>This is the <a href="http://factorcode.org" target="_top">Factor</a> <p>This is the <a href="http://factorcode.org" target="_top">Factor</a>
documentation, generated offline from a documentation, generated offline from a
<code>load-everything</code> image. The Factor UI also <code>load-everything</code> image. If you want, you can also browse the
includes a documentation browser tool.</p> 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:form t:action="$help-webapp/search">
<t:field t:name="search" /> <t:field t:name="search" />

2
extra/webapps/pastebin/new-paste.xml
View File

@ -18,6 +18,6 @@
</tr> </tr>
</table> </table>
<input type="SUBMIT" value="Submit" /> <p> <button>Submit</button> </p>
</t:form> </t:form>
</t:chloe> </t:chloe>

4
extra/webapps/pastebin/paste.xml
View File

@ -20,7 +20,7 @@
<t:bind-each t:name="annotations"> <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> <table>
<tr><th class="field-label">Author: </th><td><t:label t:name="author" /></td></tr> <tr><th class="field-label">Author: </th><td><t:label t:name="author" /></td></tr>
@ -52,7 +52,7 @@
</tr> </tr>
</table> </table>
<input type="SUBMIT" value="Done" /> <p> <button>Done</button> </p>
</t:form> </t:form>

8
extra/webapps/planet/planet.factor
View File

@ -166,14 +166,14 @@ posting "POSTINGS"
[ [
f <blog> f <blog>
[ deposit-blog-slots ] [ deposit-blog-slots ]
[ "id" value >>id ]
[ update-tuple ] [ update-tuple ]
[ tri
<url> <url>
"$planet/admin" >>path "$planet/admin" >>path
swap id>> "id" set-query-param "id" value "id" set-query-param
<redirect> <redirect>
]
tri
] >>submit ; ] >>submit ;
: <planet-admin> ( -- responder ) : <planet-admin> ( -- responder )

20
extra/websites/concatenative/concatenative.factor
View File

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