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

Merge branch 'master' of git://factorcode.org/git/factor into c-type-words

db4
Joe Groff 2009-09-17 11:50:03 -05:00
parent d9c6230f43 ce97e7328b
commit cbebaada2f
14 changed files with 69 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
basis/furnace/chloe-tags/recaptcha/authors.txt → basis/furnace/recaptcha/authors.txt
View File

1
basis/furnace/recaptcha/example/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

31
basis/furnace/recaptcha/example/example.factor Normal file
View File

@ -0,0 +1,31 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors db.sqlite furnace.actions furnace.alloy
furnace.conversations furnace.recaptcha furnace.redirection
html.templates.chloe.compiler http.server
http.server.dispatchers http.server.responses io.streams.string
kernel urls xml.syntax ;
IN: furnace.recaptcha.example
TUPLE: recaptcha-app < dispatcher recaptcha ;
: recaptcha-db ( -- obj ) "recaptcha-example" <sqlite-db> ;
: <recaptcha-challenge> ( -- obj )
<page-action>
[
begin-conversation
validate-recaptcha
recaptcha-valid? cget
"?good" "?bad" ? >url <continue-conversation>
] >>submit
{ recaptcha-app "example" } >>template ;
: <recaptcha-app> ( -- obj )
\ recaptcha-app new-dispatcher
<recaptcha-challenge> "" add-responder
<recaptcha>
"concatenative.org" >>domain
"6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
"6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
recaptcha-db <alloy> ;

4
basis/furnace/recaptcha/example/example.xml Normal file
View File

@ -0,0 +1,4 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<html><body><form submit="" method="post"><t:recaptcha/></form></body></html>
</t:chloe>

50
basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor → basis/furnace/recaptcha/recaptcha-docs.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax http.server.filters kernel USING: help.markup help.syntax http.server.filters kernel
multiline furnace.actions ; multiline furnace.actions furnace.alloy furnace.conversations ;
IN: furnace.chloe-tags.recaptcha IN: furnace.recaptcha
HELP: <recaptcha> HELP: <recaptcha>
{ $values { $values
@ -24,43 +24,21 @@ ARTICLE: "recaptcha-example" "Recaptcha example"
"There are several steps to using the Recaptcha library." "There are several steps to using the Recaptcha library."
{ $list { $list
{ "Wrap the responder in a " { $link <recaptcha> } } { "Wrap the responder in a " { $link <recaptcha> } }
{ "Wrap the responder in a " { $link <conversations> } " if it is not already" }
{ "Ensure that there is a database connected, with the " { $link <alloy> } " word" }
{ "Start a conversation to move values between requests" }
{ "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } } { "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } }
{ "Put the chloe tag " { $snippet "<recaptcha/>" } " in the template for your " { $link action } } { "Pass the conversation from your submit action using " { $link <continue-conversation> } }
{ "Put the chloe tag " { $snippet "<recaptcha/>" } " inside a form tag in the template for your " { $link page-action } }
} }
"An example follows:" $nl
"Run this example vocabulary:"
{ $code { $code
HEREDOC: RECAPTCHA-TUTORIAL "USE: furnace.recaptcha.example"
TUPLE: recaptcha-app < dispatcher recaptcha ; "<recaptcha-app> main-responder set-global"
} ;
: <recaptcha-challenge> ( -- obj ) ARTICLE: "furnace.recaptcha" "Recaptcha"
<action>
[
validate-recaptcha
recaptcha-valid? get "?good" "?bad" ? <redirect>
] >>submit
[
<response>
{" <?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<html><body><t:recaptcha/></body></html>
</t:chloe>"} >>body
] >>display ;
: <recaptcha-app> ( -- obj )
\ recaptcha-app new-dispatcher
<recaptcha-challenge> "" add-responder
<recaptcha>
"concatenative.org" >>domain
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" >>public-key
"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" >>private-key ;
<recaptcha-app> main-responder set-global
RECAPTCHA-TUTORIAL
}
;
ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag"
"The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl "The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl "The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl
@ -74,4 +52,4 @@ ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag"
{ $subsection recaptcha-error } { $subsection recaptcha-error }
{ $subsection "recaptcha-example" } ; { $subsection "recaptcha-example" } ;
ABOUT: "furnace.chloe-tags.recaptcha" ABOUT: "furnace.recaptcha"

11
basis/furnace/chloe-tags/recaptcha/recaptcha.factor → basis/furnace/recaptcha/recaptcha.factor
View File

@ -4,8 +4,8 @@ USING: accessors furnace.actions furnace.redirection html.forms
html.templates.chloe.compiler html.templates.chloe.syntax html.templates.chloe.compiler html.templates.chloe.syntax
http.client http.server http.server.filters io.sockets kernel http.client http.server http.server.filters io.sockets kernel
locals namespaces sequences splitting urls validators locals namespaces sequences splitting urls validators
xml.syntax ; xml.syntax furnace.conversations ;
IN: furnace.chloe-tags.recaptcha IN: furnace.recaptcha
TUPLE: recaptcha < filter-responder domain public-key private-key ; TUPLE: recaptcha < filter-responder domain public-key private-key ;
@ -38,8 +38,9 @@ M: recaptcha call-responder*
XML] ; XML] ;
: recaptcha-url ( secure? -- ? ) : recaptcha-url ( secure? -- ? )
[ "https://api.recaptcha.net/challenge" >url ] [ "https://api.recaptcha.net/challenge" ]
[ "http://api.recaptcha.net/challenge" >url ] if ; [ "http://api.recaptcha.net/challenge" ] if
recaptcha-error cget [ "?error=" glue ] when* >url ;
: render-recaptcha ( -- xml ) : render-recaptcha ( -- xml )
secure-connection? recaptcha-url secure-connection? recaptcha-url
@ -72,4 +73,4 @@ PRIVATE>
"recaptcha_challenge_field" value "recaptcha_challenge_field" value
"recaptcha_response_field" value "recaptcha_response_field" value
\ recaptcha get (validate-recaptcha) \ recaptcha get (validate-recaptcha)
[ recaptcha-valid? set ] [ recaptcha-error set ] bi* ; [ recaptcha-valid? cset ] [ recaptcha-error cset ] bi* ;

0
basis/furnace/chloe-tags/recaptcha/recaptcha.xml → basis/furnace/recaptcha/recaptcha.xml
View File

0
basis/furnace/chloe-tags/recaptcha/summary.txt → basis/furnace/recaptcha/summary.txt
View File

0
basis/furnace/chloe-tags/recaptcha/tags.txt → basis/furnace/recaptcha/tags.txt
View File

2
basis/html/templates/chloe/chloe-docs.factor
View File

@ -24,7 +24,7 @@ HELP: compile-attr
{ $description "Compiles code which pushes an attribute value previously extracted by " { $link required-attr } " or " { $link optional-attr } " on the stack. If the attribute value begins with " { $snippet "@" } ", compiles into code which pushes the a form value." } ; { $description "Compiles code which pushes an attribute value previously extracted by " { $link required-attr } " or " { $link optional-attr } " on the stack. If the attribute value begins with " { $snippet "@" } ", compiles into code which pushes the a form value." } ;
HELP: CHLOE: HELP: CHLOE:
{ $syntax "name definition... ;" } { $syntax "CHLOE: name definition... ;" }
{ $values { "name" "the tag name" } { "definition" { $quotation "( tag -- )" } } } { $values { "name" "the tag name" } { "definition" { $quotation "( tag -- )" } } }
{ $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ; { $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ;

2
core/bootstrap/stage1.factor
View File

@ -40,7 +40,7 @@ load-help? off
"bootstrap.layouts" require "bootstrap.layouts" require
[ [
"vocab:bootstrap/stage2.factor" "resource:basis/bootstrap/stage2.factor"
dup exists? [ dup exists? [
run-file run-file
] [ ] [

7
extra/benchmark/spectral-norm/spectral-norm.factor
View File

@ -1,8 +1,7 @@
! Factor port of ! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all ! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
USING: specialized-arrays kernel math math.functions USING: specialized-arrays kernel math math.functions
math.vectors sequences sequences.private prettyprint words hints math.vectors sequences prettyprint words hints locals ;
locals ;
SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: double
IN: benchmark.spectral-norm IN: benchmark.spectral-norm
@ -19,13 +18,13 @@ IN: benchmark.spectral-norm
+ 1 + recip ; inline + 1 + recip ; inline
: (eval-A-times-u) ( u i j -- x ) : (eval-A-times-u) ( u i j -- x )
tuck [ swap nth-unsafe ] [ eval-A ] 2bi* * ; inline [ swap nth ] [ eval-A ] bi-curry bi* * ; inline
: eval-A-times-u ( n u -- seq ) : eval-A-times-u ( n u -- seq )
[ (eval-A-times-u) ] inner-loop ; inline [ (eval-A-times-u) ] inner-loop ; inline
: (eval-At-times-u) ( u i j -- x ) : (eval-At-times-u) ( u i j -- x )
tuck [ swap nth-unsafe ] [ swap eval-A ] 2bi* * ; inline [ swap nth ] [ swap eval-A ] bi-curry bi* * ; inline
: eval-At-times-u ( u n -- seq ) : eval-At-times-u ( u n -- seq )
[ (eval-At-times-u) ] inner-loop ; inline [ (eval-At-times-u) ] inner-loop ; inline

8
extra/irc/client/internals/internals-tests.factor
View File

@ -99,7 +99,13 @@ M: mb-writer dispose drop ;
! Test join ! Test join
[ { "JOIN #factortest" } [ [ { "JOIN #factortest" } [
"#factortest" %join %pop-output-line "#factortest" %join %pop-output-line
] unit-test
] spawning-irc
[ { "PART #factortest" } [
"#factortest" %join %pop-output-line drop
"#factortest" chat> remove-chat %pop-output-line
] unit-test ] unit-test
] spawning-irc ] spawning-irc

2
extra/irc/client/internals/internals.factor
View File

@ -172,7 +172,7 @@ M: irc-nick-chat remove-chat name>> unregister-chat ;
M: irc-server-chat remove-chat drop +server-chat+ unregister-chat ; M: irc-server-chat remove-chat drop +server-chat+ unregister-chat ;
M: irc-channel-chat remove-chat M: irc-channel-chat remove-chat
[ part new annotate-message irc-send ] [ name>> "PART " prepend string>irc-message irc-send ]
[ name>> unregister-chat ] bi ; [ name>> unregister-chat ] bi ;
: (speak) ( message irc-chat -- ) swap annotate-message irc-send ; : (speak) ( message irc-chat -- ) swap annotate-message irc-send ;