From 834031b10d58a6d374960193ae8794587e2731de Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 16 Sep 2009 19:58:45 -0300 Subject: [PATCH 1/6] irc.client: Fix detach chat (wasn't sending a PART message) --- extra/irc/client/internals/internals-tests.factor | 8 +++++++- extra/irc/client/internals/internals.factor | 2 +- 2 files changed, 8 insertions(+), 2 deletions(-) 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 ; From 21e8e2d42b4bff1e77f9b61d3825422f33dd06ab Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 16 Sep 2009 16:11:05 -0700 Subject: [PATCH 2/6] html.templates.chloe: minor doc fix --- basis/html/templates/chloe/chloe-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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." } ; From 2410c8a17a90ce81184ebcf0e5c1d8299e1ff27c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 16 Sep 2009 16:13:55 -0700 Subject: [PATCH 3/6] benchmark.spectral-norm: take out unsafe sequence access since it doesn't make it faster, and replace tuck/2bi* with bi-curry bi* --- extra/benchmark/spectral-norm/spectral-norm.factor | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) 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 From bc895f84b4e13cd8dc5781c7e7b0e287313245a2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 17 Sep 2009 09:13:33 -0700 Subject: [PATCH 4/6] fix recaptcha, move to furnace.recaptcha --- .../{chloe-tags => }/recaptcha/authors.txt | 0 .../recaptcha/recaptcha-docs.factor | 32 ++++++++++++------- .../recaptcha/recaptcha.factor | 11 ++++--- .../{chloe-tags => }/recaptcha/recaptcha.xml | 0 .../{chloe-tags => }/recaptcha/summary.txt | 0 .../{chloe-tags => }/recaptcha/tags.txt | 0 6 files changed, 26 insertions(+), 17 deletions(-) rename basis/furnace/{chloe-tags => }/recaptcha/authors.txt (100%) rename basis/furnace/{chloe-tags => }/recaptcha/recaptcha-docs.factor (71%) rename basis/furnace/{chloe-tags => }/recaptcha/recaptcha.factor (88%) rename basis/furnace/{chloe-tags => }/recaptcha/recaptcha.xml (100%) rename basis/furnace/{chloe-tags => }/recaptcha/summary.txt (100%) rename basis/furnace/{chloe-tags => }/recaptcha/tags.txt (100%) 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/chloe-tags/recaptcha/recaptcha-docs.factor b/basis/furnace/recaptcha/recaptcha-docs.factor similarity index 71% rename from basis/furnace/chloe-tags/recaptcha/recaptcha-docs.factor rename to basis/furnace/recaptcha/recaptcha-docs.factor index 0d93949f53..90d4a8195c 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 ; +IN: furnace.recaptcha HELP: { $values @@ -30,20 +30,27 @@ ARTICLE: "recaptcha-example" "Recaptcha example" "An example follows:" { $code HEREDOC: RECAPTCHA-TUTORIAL +USING: db.sqlite kernel http.server.dispatchers db.sqlite +furnace.actions furnace.recaptcha furnace.conversations +furnace.redirection xml.syntax html.templates.chloe.compiler +io.streams.string http.server.responses furnace.alloy http.server ; TUPLE: recaptcha-app < dispatcher recaptcha ; +: recaptcha-db ( -- obj ) + "recaptcha-example" ; + : ( -- obj ) [ + begin-conversation validate-recaptcha - recaptcha-valid? get "?good" "?bad" ? + recaptcha-valid? cget "?good" "?bad" ? >url ] >>submit [ - -{" - - -"} >>body + +
+ XML> + compile-template [ call( -- ) ] with-string-writer "text/html" ] >>display ; : ( -- obj ) @@ -51,8 +58,9 @@ TUPLE: recaptcha-app < dispatcher recaptcha ; "" add-responder "concatenative.org" >>domain - "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" >>public-key - "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" >>private-key ; + "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key + "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key + recaptcha-db ; main-responder set-global RECAPTCHA-TUTORIAL @@ -60,7 +68,7 @@ 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 +82,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 From b8a0216e26047ebae5708074b53df894304796f0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 17 Sep 2009 09:14:56 -0700 Subject: [PATCH 5/6] bootstrap.stage1: decent error message if stage2.factor can't be found --- core/bootstrap/stage1.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 ] [ From 785d0bbe66939f9a8362f8503ad3b961e7273ab6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 17 Sep 2009 09:48:49 -0700 Subject: [PATCH 6/6] move recaptcha example to a vocabulary on disk --- basis/furnace/recaptcha/example/authors.txt | 1 + .../furnace/recaptcha/example/example.factor | 31 +++++++++++ basis/furnace/recaptcha/example/example.xml | 4 ++ basis/furnace/recaptcha/recaptcha-docs.factor | 52 ++++--------------- 4 files changed, 47 insertions(+), 41 deletions(-) create mode 100644 basis/furnace/recaptcha/example/authors.txt create mode 100644 basis/furnace/recaptcha/example/example.factor create mode 100644 basis/furnace/recaptcha/example/example.xml 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/recaptcha/recaptcha-docs.factor b/basis/furnace/recaptcha/recaptcha-docs.factor index 90d4a8195c..d416dd9474 100644 --- a/basis/furnace/recaptcha/recaptcha-docs.factor +++ b/basis/furnace/recaptcha/recaptcha-docs.factor @@ -1,7 +1,7 @@ ! 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 furnace.alloy ; +multiline furnace.actions furnace.alloy furnace.conversations ; IN: furnace.recaptcha HELP: @@ -24,49 +24,19 @@ 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 -USING: db.sqlite kernel http.server.dispatchers db.sqlite -furnace.actions furnace.recaptcha furnace.conversations -furnace.redirection xml.syntax html.templates.chloe.compiler -io.streams.string http.server.responses furnace.alloy http.server ; -TUPLE: recaptcha-app < dispatcher recaptcha ; - -: recaptcha-db ( -- obj ) - "recaptcha-example" ; - -: ( -- obj ) - - [ - begin-conversation - validate-recaptcha - recaptcha-valid? cget "?good" "?bad" ? >url - ] >>submit - [ - -
- XML> - compile-template [ call( -- ) ] with-string-writer "text/html" - ] >>display ; - -: ( -- obj ) - \ recaptcha-app new-dispatcher - "" add-responder - - "concatenative.org" >>domain - "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key - "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key - recaptcha-db ; - - main-responder set-global -RECAPTCHA-TUTORIAL -} - -; + "USE: furnace.recaptcha.example" + " main-responder set-global" +} ; 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