From d1f37ab5ecbee1633028ac8118607e0527e5ab47 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 20 Apr 2008 02:30:52 -0500 Subject: [PATCH 01/12] Fix bloopers --- .../io/encodings/utf16/.utf16.factor.swo | Bin {extra => core}/io/encodings/utf16/authors.txt | 0 {extra => core}/io/encodings/utf16/summary.txt | 0 {extra => core}/io/encodings/utf16/tags.txt | 0 .../io/encodings/utf16/utf16-docs.factor | 0 .../io/encodings/utf16/utf16-tests.factor | 0 {extra => core}/io/encodings/utf16/utf16.factor | 8 ++++---- extra/benchmark/spectral-norm/spectral-norm.factor | 4 ++-- extra/bit-vectors/bit-vectors.factor | 4 ++-- extra/float-vectors/float-vectors.factor | 2 +- 10 files changed, 9 insertions(+), 9 deletions(-) rename {extra => core}/io/encodings/utf16/.utf16.factor.swo (100%) rename {extra => core}/io/encodings/utf16/authors.txt (100%) rename {extra => core}/io/encodings/utf16/summary.txt (100%) rename {extra => core}/io/encodings/utf16/tags.txt (100%) rename {extra => core}/io/encodings/utf16/utf16-docs.factor (100%) rename {extra => core}/io/encodings/utf16/utf16-tests.factor (100%) rename {extra => core}/io/encodings/utf16/utf16.factor (95%) diff --git a/extra/io/encodings/utf16/.utf16.factor.swo b/core/io/encodings/utf16/.utf16.factor.swo similarity index 100% rename from extra/io/encodings/utf16/.utf16.factor.swo rename to core/io/encodings/utf16/.utf16.factor.swo diff --git a/extra/io/encodings/utf16/authors.txt b/core/io/encodings/utf16/authors.txt similarity index 100% rename from extra/io/encodings/utf16/authors.txt rename to core/io/encodings/utf16/authors.txt diff --git a/extra/io/encodings/utf16/summary.txt b/core/io/encodings/utf16/summary.txt similarity index 100% rename from extra/io/encodings/utf16/summary.txt rename to core/io/encodings/utf16/summary.txt diff --git a/extra/io/encodings/utf16/tags.txt b/core/io/encodings/utf16/tags.txt similarity index 100% rename from extra/io/encodings/utf16/tags.txt rename to core/io/encodings/utf16/tags.txt diff --git a/extra/io/encodings/utf16/utf16-docs.factor b/core/io/encodings/utf16/utf16-docs.factor similarity index 100% rename from extra/io/encodings/utf16/utf16-docs.factor rename to core/io/encodings/utf16/utf16-docs.factor diff --git a/extra/io/encodings/utf16/utf16-tests.factor b/core/io/encodings/utf16/utf16-tests.factor similarity index 100% rename from extra/io/encodings/utf16/utf16-tests.factor rename to core/io/encodings/utf16/utf16-tests.factor diff --git a/extra/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor similarity index 95% rename from extra/io/encodings/utf16/utf16.factor rename to core/io/encodings/utf16/utf16.factor index fbc296e57c..953671d7f4 100755 --- a/extra/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -126,11 +126,11 @@ M: utf16 ( stream utf16 -- encoder ) ! Native-order UTF-16 -: native-utf16 ( -- descriptor ) - little-endian? utf16le utf16be ? ; +: utf16n ( -- descriptor ) + little-endian? utf16le utf16be ? ; foldable -M: utf16n drop native-utf16 ; +M: utf16n drop utf16n ; -M: utf16n drop native-utf16 ; +M: utf16n drop utf16n ; PRIVATE> diff --git a/extra/benchmark/spectral-norm/spectral-norm.factor b/extra/benchmark/spectral-norm/spectral-norm.factor index 2c7dc1e80d..7eddeefc1b 100644 --- a/extra/benchmark/spectral-norm/spectral-norm.factor +++ b/extra/benchmark/spectral-norm/spectral-norm.factor @@ -19,7 +19,7 @@ IN: benchmark.spectral-norm pick 0.0 [ swap >r >r 2dup r> (eval-A-times-u) r> + ] reduce nip - ] F{ } map-as { float-array } declare 2nip ; inline + ] F{ } map-as 2nip ; inline : (eval-At-times-u) ( u i j -- x ) tuck swap eval-A >r swap nth-unsafe r> * ; inline @@ -29,7 +29,7 @@ IN: benchmark.spectral-norm pick 0.0 [ swap >r >r 2dup r> (eval-At-times-u) r> + ] reduce nip - ] F{ } map-as { float-array } declare 2nip ; inline + ] F{ } map-as 2nip ; inline : eval-AtA-times-u ( n u -- seq ) dupd eval-A-times-u eval-At-times-u ; inline diff --git a/extra/bit-vectors/bit-vectors.factor b/extra/bit-vectors/bit-vectors.factor index b011f146c5..c14b0a5476 100755 --- a/extra/bit-vectors/bit-vectors.factor +++ b/extra/bit-vectors/bit-vectors.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel kernel.private math sequences sequences.private growable bit-arrays prettyprint.backend -parser ; +parser accessors ; IN: bit-vectors TUPLE: bit-vector underlying fill ; @@ -44,7 +44,7 @@ M: bit-array new-resizable drop ; INSTANCE: bit-vector growable -: ?V \ } [ >bit-vector ] parse-literal ; parsing +: ?V{ \ } [ >bit-vector ] parse-literal ; parsing M: bit-vector >pprint-sequence ; diff --git a/extra/float-vectors/float-vectors.factor b/extra/float-vectors/float-vectors.factor index f0db37610a..d51f0d4e44 100755 --- a/extra/float-vectors/float-vectors.factor +++ b/extra/float-vectors/float-vectors.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel kernel.private math sequences sequences.private growable float-arrays prettyprint.backend -parser ; +parser accessors ; IN: float-vectors TUPLE: float-vector underlying fill ; From e2a185f1f45696d3c3102196f02f6e7c1e597357 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 20 Apr 2008 04:19:06 -0500 Subject: [PATCH 02/12] Web framework work in progress --- .../server/boilerplate/boilerplate.factor | 23 ++- .../server/components/components-tests.factor | 2 + .../http/server/components/components.factor | 95 +++++++--- .../server/components/farkup/farkup.factor | 6 +- extra/http/server/forms/forms.factor | 5 +- .../http/server/templating/chloe/chloe.factor | 29 ++- .../server/validators/validators-tests.factor | 6 + .../http/server/validators/validators.factor | 7 +- extra/webapps/planet/authors.txt | 1 + extra/webapps/planet/blog-summary.xml | 7 + extra/webapps/planet/edit-blog.xml | 40 ++++ extra/webapps/planet/entry-summary.xml | 10 + extra/webapps/planet/entry.xml | 9 + extra/webapps/planet/mini-planet.xml | 7 + extra/webapps/planet/page.xml | 64 +++++++ extra/webapps/planet/planet.css | 30 +++ extra/webapps/planet/planet.factor | 174 ++++++++++++++++++ extra/webapps/planet/planet.xml | 37 ++++ extra/webapps/planet/view-blog.xml | 41 +++++ 19 files changed, 557 insertions(+), 36 deletions(-) create mode 100755 extra/webapps/planet/authors.txt create mode 100644 extra/webapps/planet/blog-summary.xml create mode 100644 extra/webapps/planet/edit-blog.xml create mode 100644 extra/webapps/planet/entry-summary.xml create mode 100644 extra/webapps/planet/entry.xml create mode 100644 extra/webapps/planet/mini-planet.xml create mode 100644 extra/webapps/planet/page.xml create mode 100644 extra/webapps/planet/planet.css create mode 100755 extra/webapps/planet/planet.factor create mode 100644 extra/webapps/planet/planet.xml create mode 100644 extra/webapps/planet/view-blog.xml diff --git a/extra/http/server/boilerplate/boilerplate.factor b/extra/http/server/boilerplate/boilerplate.factor index 4e847cff70..6c62452ec2 100644 --- a/extra/http/server/boilerplate/boilerplate.factor +++ b/extra/http/server/boilerplate/boilerplate.factor @@ -1,7 +1,8 @@ ! Copyright (c) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel namespaces boxes sequences strings -io io.streams.string +io io.streams.string arrays +html.elements http http.server http.server.templating ; @@ -28,6 +29,18 @@ SYMBOL: style : write-style ( -- ) style get >string write ; +SYMBOL: atom-feed + +: set-atom-feed ( title url -- ) + 2array atom-feed get >box ; + +: write-atom-feed ( -- ) + atom-feed get value>> [ + + ] when* ; + SYMBOL: nested-template? SYMBOL: next-template @@ -40,6 +53,7 @@ M: f call-template drop call-next-template ; : with-boilerplate ( body template -- ) [ title get [ title set ] unless + atom-feed get [ atom-feed set ] unless style get [ SBUF" " clone style set ] unless [ @@ -54,5 +68,8 @@ M: f call-template drop call-next-template ; ] with-scope ; inline M: boilerplate call-responder - [ responder>> call-responder clone ] [ template>> ] bi - [ [ with-boilerplate ] 2curry ] curry change-body ; + tuck responder>> call-responder + dup "content-type" header "text/html" = [ + clone swap template>> + [ [ with-boilerplate ] 2curry ] curry change-body + ] [ nip ] if ; diff --git a/extra/http/server/components/components-tests.factor b/extra/http/server/components/components-tests.factor index 6d3a048ac4..ff87bb71fb 100755 --- a/extra/http/server/components/components-tests.factor +++ b/extra/http/server/components/components-tests.factor @@ -129,3 +129,5 @@ TUPLE: test-tuple text number more-text ; [ t ] [ "wake up sheeple" dup "n" validate = ] unit-test [ ] [ "password" "p" set ] unit-test + +[ ] [ "pub-date" "d" set ] unit-test diff --git a/extra/http/server/components/components.factor b/extra/http/server/components/components.factor index 50353c6b87..bdcdd95c71 100755 --- a/extra/http/server/components/components.factor +++ b/extra/http/server/components/components.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: html.elements http.server.validators accessors namespaces -kernel io math.parser assocs classes words classes.tuple arrays -sequences splitting mirrors hashtables fry combinators -continuations math ; +USING: accessors namespaces kernel io math.parser assocs classes +words classes.tuple arrays sequences splitting mirrors +hashtables fry combinators continuations math +calendar.format html.elements +http.server.validators ; IN: http.server.components ! Renderer protocol @@ -59,9 +60,14 @@ SYMBOL: values : values-tuple values get mirror-object ; +: render-view-or-summary ( component -- value renderer ) + [ id>> value ] [ component-string ] [ renderer>> ] tri ; + : render-view ( component -- ) - [ id>> value ] [ component-string ] [ renderer>> ] tri - render-view* ; + render-view-or-summary render-view* ; + +: render-summary ( component -- ) + render-view-or-summary render-summary* ; ( id -- component ) + url new-string + 5 >>min-length + 60 >>max-length ; + +M: url validate* + call-next-method dup empty? [ v-url ] unless ; + ! Don't send passwords back to the user TUPLE: password-renderer < field ; @@ -206,20 +223,20 @@ M: captcha validate* drop v-captcha ; ! Text areas -TUPLE: textarea-renderer rows cols ; +TUPLE: text-renderer rows cols ; -: new-textarea-renderer ( class -- renderer ) +: new-text-renderer ( class -- renderer ) new 60 >>cols 20 >>rows ; -: ( -- renderer ) - textarea-renderer new-textarea-renderer ; +: ( -- renderer ) + text-renderer new-text-renderer ; -M: textarea-renderer render-view* +M: text-renderer render-view* drop write ; -M: textarea-renderer render-edit* +M: text-renderer render-edit*