diff --git a/basis/furnace/chloe-tags/recaptcha/authors.txt b/basis/furnace/recaptcha/authors.txt similarity index 100% rename from basis/furnace/chloe-tags/recaptcha/authors.txt rename to basis/furnace/recaptcha/authors.txt diff --git a/basis/furnace/recaptcha/example/authors.txt b/basis/furnace/recaptcha/example/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/furnace/recaptcha/example/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/furnace/recaptcha/example/example.factor b/basis/furnace/recaptcha/example/example.factor new file mode 100644 index 0000000000..264be678ae --- /dev/null +++ b/basis/furnace/recaptcha/example/example.factor @@ -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" ; + +: ( -- obj ) + + [ + begin-conversation + validate-recaptcha + recaptcha-valid? cget + "?good" "?bad" ? >url + ] >>submit + { recaptcha-app "example" } >>template ; + +: ( -- obj ) + \ recaptcha-app new-dispatcher + "" add-responder + + "concatenative.org" >>domain + "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key + "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key + recaptcha-db ; diff --git a/basis/furnace/recaptcha/example/example.xml b/basis/furnace/recaptcha/example/example.xml new file mode 100644 index 0000000000..e59f441f7f --- /dev/null +++ b/basis/furnace/recaptcha/example/example.xml @@ -0,0 +1,4 @@ + + +
+
 diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor b/basis/furnace/recaptcha/recaptcha-docs.factor similarity index 63% rename from basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor rename to basis/furnace/recaptcha/recaptcha-docs.factor index 0d93949f53..d416dd9474 100644 --- a/basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor +++ b/basis/furnace/recaptcha/recaptcha-docs.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax http.server.filters kernel -multiline furnace.actions ; -IN: furnace.chloe-tags.recaptcha +multiline furnace.actions furnace.alloy furnace.conversations ; +IN: furnace.recaptcha HELP: { $values @@ -24,43 +24,21 @@ ARTICLE: "recaptcha-example" "Recaptcha example" "There are several steps to using the Recaptcha library." { $list { "Wrap the responder in a " { $link } } + { "Wrap the responder in a " { $link } " if it is not already" } + { "Ensure that there is a database connected, with the " { $link } " 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 } } - { "Put the chloe tag " { $snippet "" } " in the template for your " { $link action } } + { "Pass the conversation from your submit action using " { $link } } + { "Put the chloe tag " { $snippet "" } " inside a form tag in the template for your " { $link page-action } } } -"An example follows:" +$nl +"Run this example vocabulary:" { $code -HEREDOC: RECAPTCHA-TUTORIAL -TUPLE: recaptcha-app < dispatcher recaptcha ; + "USE: furnace.recaptcha.example" + " main-responder set-global" +} ; -: ( -- obj ) - - [ - validate-recaptcha - recaptcha-valid? get "?good" "?bad" ? - ] >>submit - [ - -{" - - -"} >>body - ] >>display ; - -: ( -- obj ) - \ recaptcha-app new-dispatcher - "" add-responder - - "concatenative.org" >>domain - "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" >>public-key - "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" >>private-key ; - - main-responder set-global -RECAPTCHA-TUTORIAL -} - -; - -ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag" +ARTICLE: "furnace.recaptcha" "Recaptcha" "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 @@ -74,4 +52,4 @@ ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag" { $subsection recaptcha-error } { $subsection "recaptcha-example" } ; -ABOUT: "furnace.chloe-tags.recaptcha" +ABOUT: "furnace.recaptcha" diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha.factor b/basis/furnace/recaptcha/recaptcha.factor similarity index 88% rename from basis/furnace/chloe-tags/recaptcha/recaptcha.factor rename to basis/furnace/recaptcha/recaptcha.factor index 81744dc0e0..99b223b8e3 100644 --- a/basis/furnace/chloe-tags/recaptcha/recaptcha.factor +++ b/basis/furnace/recaptcha/recaptcha.factor @@ -4,8 +4,8 @@ USING: accessors furnace.actions furnace.redirection html.forms html.templates.chloe.compiler html.templates.chloe.syntax http.client http.server http.server.filters io.sockets kernel locals namespaces sequences splitting urls validators -xml.syntax ; -IN: furnace.chloe-tags.recaptcha +xml.syntax furnace.conversations ; +IN: furnace.recaptcha TUPLE: recaptcha < filter-responder domain public-key private-key ; @@ -38,8 +38,9 @@ M: recaptcha call-responder* XML] ; : recaptcha-url ( secure? -- ? ) - [ "https://api.recaptcha.net/challenge" >url ] - [ "http://api.recaptcha.net/challenge" >url ] if ; + [ "https://api.recaptcha.net/challenge" ] + [ "http://api.recaptcha.net/challenge" ] if + recaptcha-error cget [ "?error=" glue ] when* >url ; : render-recaptcha ( -- xml ) secure-connection? recaptcha-url @@ -72,4 +73,4 @@ PRIVATE> "recaptcha_challenge_field" value "recaptcha_response_field" value \ recaptcha get (validate-recaptcha) - [ recaptcha-valid? set ] [ recaptcha-error set ] bi* ; + [ recaptcha-valid? cset ] [ recaptcha-error cset ] bi* ; diff --git a/basis/furnace/chloe-tags/recaptcha/recaptcha.xml b/basis/furnace/recaptcha/recaptcha.xml similarity index 100% rename from basis/furnace/chloe-tags/recaptcha/recaptcha.xml rename to basis/furnace/recaptcha/recaptcha.xml diff --git a/basis/furnace/chloe-tags/recaptcha/summary.txt b/basis/furnace/recaptcha/summary.txt similarity index 100% rename from basis/furnace/chloe-tags/recaptcha/summary.txt rename to basis/furnace/recaptcha/summary.txt diff --git a/basis/furnace/chloe-tags/recaptcha/tags.txt b/basis/furnace/recaptcha/tags.txt similarity index 100% rename from basis/furnace/chloe-tags/recaptcha/tags.txt rename to basis/furnace/recaptcha/tags.txt diff --git a/basis/html/templates/chloe/chloe-docs.factor b/basis/html/templates/chloe/chloe-docs.factor index 9716407de8..61121bd769 100644 --- a/basis/html/templates/chloe/chloe-docs.factor +++ b/basis/html/templates/chloe/chloe-docs.factor @@ -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." } ; HELP: CHLOE: -{ $syntax "name definition... ;" } +{ $syntax "CHLOE: name definition... ;" } { $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." } ; diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor index c7be17e38d..9c84904ff7 100644 --- a/core/bootstrap/stage1.factor +++ b/core/bootstrap/stage1.factor @@ -40,7 +40,7 @@ load-help? off "bootstrap.layouts" require [ - "vocab:bootstrap/stage2.factor" + "resource:basis/bootstrap/stage2.factor" dup exists? [ run-file ] [ diff --git a/extra/benchmark/spectral-norm/spectral-norm.factor b/extra/benchmark/spectral-norm/spectral-norm.factor index 4f93367b8a..41ae5b3578 100644 --- a/extra/benchmark/spectral-norm/spectral-norm.factor +++ b/extra/benchmark/spectral-norm/spectral-norm.factor @@ -1,8 +1,7 @@ ! Factor port of ! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all USING: specialized-arrays kernel math math.functions -math.vectors sequences sequences.private prettyprint words hints -locals ; +math.vectors sequences prettyprint words hints locals ; SPECIALIZED-ARRAY: double IN: benchmark.spectral-norm @@ -19,13 +18,13 @@ IN: benchmark.spectral-norm + 1 + recip ; inline : (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) ] inner-loop ; inline : (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) ] inner-loop ; inline diff --git a/extra/irc/client/internals/internals-tests.factor b/extra/irc/client/internals/internals-tests.factor index a591fe9ce0..84510fb67e 100644 --- a/extra/irc/client/internals/internals-tests.factor +++ b/extra/irc/client/internals/internals-tests.factor @@ -99,7 +99,13 @@ M: mb-writer dispose drop ; ! Test join [ { "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 ] spawning-irc diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor index 6ce851e7dd..ef1695f563 100644 --- a/extra/irc/client/internals/internals.factor +++ b/extra/irc/client/internals/internals.factor @@ -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-channel-chat remove-chat - [ part new annotate-message irc-send ] + [ name>> "PART " prepend string>irc-message irc-send ] [ name>> unregister-chat ] bi ; : (speak) ( message irc-chat -- ) swap annotate-message irc-send ;