diff --git a/basis/alarms/summary.txt b/basis/alarms/summary.txt new file mode 100644 index 0000000000..f6e12238fa --- /dev/null +++ b/basis/alarms/summary.txt @@ -0,0 +1 @@ +One-time and recurring events diff --git a/basis/alias/summary.txt b/basis/alias/summary.txt new file mode 100644 index 0000000000..15690a7b9b --- /dev/null +++ b/basis/alias/summary.txt @@ -0,0 +1 @@ +Defining multiple words with the same name diff --git a/basis/binary-search/summary.txt b/basis/binary-search/summary.txt new file mode 100644 index 0000000000..c4fd4f2774 --- /dev/null +++ b/basis/binary-search/summary.txt @@ -0,0 +1 @@ +Fast searching of sorted arrays diff --git a/basis/boxes/summary.txt b/basis/boxes/summary.txt new file mode 100644 index 0000000000..44c1352e36 --- /dev/null +++ b/basis/boxes/summary.txt @@ -0,0 +1 @@ +An abstraction for enforcing a mutual-exclusion invariant diff --git a/basis/circular/circular-docs.factor b/basis/circular/circular-docs.factor index 362d41c9de..c7af57c1fe 100644 --- a/basis/circular/circular-docs.factor +++ b/basis/circular/circular-docs.factor @@ -43,7 +43,7 @@ HELP: push-growing-circular { "elt" object } { "circular" circular } } { $description "Pushes an element onto a " { $link growing-circular } " object." } ; -ARTICLE: "circular" "circular" +ARTICLE: "circular" "Circular sequences" "The " { $vocab-link "circular" } " vocabulary implements the " { $link "sequence-protocol" } " to allow an arbitrary start index and wrap-around indexing." $nl "Creating a new circular object:" { $subsection } diff --git a/basis/colors/summary.txt b/basis/colors/summary.txt new file mode 100644 index 0000000000..a90b1aaf76 --- /dev/null +++ b/basis/colors/summary.txt @@ -0,0 +1 @@ +Colors as a first-class data type diff --git a/basis/combinators/short-circuit/short-circuit-docs.factor b/basis/combinators/short-circuit/short-circuit-docs.factor index 058291d022..54fc3aac43 100644 --- a/basis/combinators/short-circuit/short-circuit-docs.factor +++ b/basis/combinators/short-circuit/short-circuit-docs.factor @@ -64,7 +64,7 @@ HELP: n||-rewrite { "quot" quotation } } { $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each OR quotation." } ; -ARTICLE: "combinators.short-circuit" "combinators.short-circuit" +ARTICLE: "combinators.short-circuit" "Short-circuit combinators" "The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl "AND combinators:" { $subsection 0&& } diff --git a/basis/combinators/short-circuit/smart/smart-docs.factor b/basis/combinators/short-circuit/smart/smart-docs.factor index abf3ff0eef..34abde15b6 100644 --- a/basis/combinators/short-circuit/smart/smart-docs.factor +++ b/basis/combinators/short-circuit/smart/smart-docs.factor @@ -27,8 +27,9 @@ HELP: || } } ; -ARTICLE: "combinators.short-circuit.smart" "combinators.short-circuit.smart" -"The " { $vocab-link "combinators.short-circuit.smart" } " vocabulary infers the number of inputs that the sequence of quotations takes." $nl +ARTICLE: "combinators.short-circuit.smart" "Smart short-circuit combinators" +"The " { $vocab-link "combinators.short-circuit.smart" } " vocabulary is similar to " { $vocab-link "combinators.short-circuit" } " except the combinators here infer the number of inputs that the sequence of quotations takes." +$nl "Generalized AND:" { $subsection && } "Generalized OR:" diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 89c28b5262..300822cc50 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -168,7 +168,7 @@ M: db ( tuple class -- statement ) number>string " limit " swap 3append ] curry change-sql drop ; -: make-query ( tuple query -- tuple' ) +: make-query* ( tuple query -- tuple' ) dupd { [ group>> [ drop ] [ do-group ] if-empty ] @@ -177,8 +177,8 @@ M: db ( tuple class -- statement ) [ offset>> [ do-offset ] [ drop ] if* ] } 2cleave ; -M: db ( tuple class query -- tuple ) - [ ] dip make-query ; +M: db make-query ( tuple class query -- tuple ) + [ ] dip make-query* ; ! select ID, NAME, SCORE from EXAM limit 1 offset 3 @@ -198,7 +198,7 @@ M: db ( tuple class groups -- statement ) \ query new swap >>group [ [ "select count(*) from " 0% 0% where-clause ] query-make ] - dip make-query ; + dip make-query* ; : create-index ( index-name table-name columns -- ) [ diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 67e46f9e18..45a51719f9 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -236,6 +236,17 @@ TUPLE: exam id name score ; exam boa ; : test-intervals ( -- ) + [ + exam "EXAM" + { + { "idd" "ID" +db-assigned-id+ } + { "named" "NAME" TEXT } + { "score" "SCORE" INTEGER } + } define-persistent + ] [ + seq>> { "idd" "named" } = + ] must-fail-with + exam "EXAM" { { "id" "ID" +db-assigned-id+ } @@ -499,3 +510,17 @@ string-encoding-test "STRING_ENCODING_TEST" { \ ensure-table must-infer \ create-table must-infer \ drop-table must-infer + +: test-queries ( -- ) + [ ] [ exam ensure-table ] unit-test + ! [ ] [ T{ exam f f "Kyle" 100 } insert-tuple ] unit-test + ! [ ] [ T{ exam f f "Stan" 80 } insert-tuple ] unit-test + ! [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test + ! [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test + [ ] [ 10 [ random-exam insert-tuple ] times ] unit-test + ! [ ] [ T{ exam { name "Kenny" } } >query ] unit-test + ! [ ] [ query ] unit-test + ; + +: test-db ( -- ) + "tuples-test.db" temp-file sqlite-db make-db db-open db set ; diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 3c3bae3adc..2bdbb138d7 100755 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -3,11 +3,44 @@ USING: arrays assocs classes db kernel namespaces classes.tuple words sequences slots math accessors math.parser io prettyprint db.types continuations -destructors mirrors ; +destructors mirrors sets ; IN: db.tuples +TUPLE: query tuple group order offset limit ; + +: ( -- query ) \ query new ; + +GENERIC: >query ( object -- query ) + +M: query >query ; + +M: tuple >query swap >>tuple ; + +! returns a sequence of prepared-statements +HOOK: create-sql-statement db ( class -- object ) +HOOK: drop-sql-statement db ( class -- object ) + +HOOK: db ( class -- object ) +HOOK: db ( class -- object ) +HOOK: db ( class -- object ) +HOOK: db ( tuple class -- object ) +HOOK: db ( tuple class -- tuple ) +HOOK: db ( tuple class groups -- statement ) +HOOK: make-query db ( tuple class query -- statement ) + +HOOK: insert-tuple* db ( tuple statement -- ) + +ERROR: no-slots-named class seq ; +: check-columns ( class columns -- ) + tuck + [ [ first ] map ] + [ all-slots [ name>> ] map ] bi* diff + [ drop ] [ no-slots-named ] if-empty ; + : define-persistent ( class table columns -- ) - >r dupd "db-table" set-word-prop dup r> + pick dupd + check-columns + [ dupd "db-table" set-word-prop dup ] dip [ relation? ] partition swapd dupd [ spec>tuple ] with map "db-columns" set-word-prop @@ -33,21 +66,6 @@ SYMBOL: sql-counter : next-sql-counter ( -- str ) sql-counter [ inc ] [ get ] bi number>string ; -! returns a sequence of prepared-statements -HOOK: create-sql-statement db ( class -- object ) -HOOK: drop-sql-statement db ( class -- object ) - -HOOK: db ( class -- object ) -HOOK: db ( class -- object ) -HOOK: db ( class -- object ) -HOOK: db ( tuple class -- object ) -HOOK: db ( tuple class -- tuple ) -TUPLE: query group order offset limit ; -HOOK: db ( tuple class query -- statement' ) -HOOK: db ( tuple class groups -- n ) - -HOOK: insert-tuple* db ( tuple statement -- ) - GENERIC: eval-generator ( singleton -- object ) : resulting-tuple ( exemplar-tuple row out-params -- tuple ) @@ -121,13 +139,14 @@ GENERIC: eval-generator ( singleton -- object ) [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ; : query ( tuple query -- tuples ) - [ dup dup class ] dip do-select ; + [ dup dup class ] dip make-query do-select ; + : select-tuples ( tuple -- tuples ) dup dup class do-select ; : select-tuple ( tuple -- tuple/f ) - dup dup class \ query new 1 >>limit do-select + dup dup class \ query new 1 >>limit make-query do-select [ f ] [ first ] if-empty ; : do-count ( exemplar-tuple statement -- tuples ) diff --git a/basis/editors/macvim/authors.txt b/basis/editors/macvim/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/basis/editors/macvim/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/basis/editors/macvim/macvim.factor b/basis/editors/macvim/macvim.factor new file mode 100755 index 0000000000..b5f864dcd0 --- /dev/null +++ b/basis/editors/macvim/macvim.factor @@ -0,0 +1,13 @@ +USING: definitions io.launcher kernel math math.parser parser +namespaces prettyprint editors make ; + +IN: editors.macvim + +: macvim-location ( file line -- ) + drop + [ "open" , "-a" , "MacVim", , ] { } make + try-process ; + +[ macvim-location ] edit-hook set-global + + diff --git a/basis/editors/macvim/summary.txt b/basis/editors/macvim/summary.txt new file mode 100644 index 0000000000..894d635b47 --- /dev/null +++ b/basis/editors/macvim/summary.txt @@ -0,0 +1 @@ +MacVim editor integration diff --git a/basis/editors/macvim/tags.txt b/basis/editors/macvim/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/editors/macvim/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/editors/textedit/authors.txt b/basis/editors/textedit/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/basis/editors/textedit/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/basis/editors/textedit/summary.txt b/basis/editors/textedit/summary.txt new file mode 100644 index 0000000000..1d72d10db0 --- /dev/null +++ b/basis/editors/textedit/summary.txt @@ -0,0 +1 @@ +TextEdit editor integration diff --git a/basis/editors/textedit/tags.txt b/basis/editors/textedit/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/editors/textedit/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/editors/textedit/textedit.factor b/basis/editors/textedit/textedit.factor new file mode 100755 index 0000000000..6942e24534 --- /dev/null +++ b/basis/editors/textedit/textedit.factor @@ -0,0 +1,13 @@ +USING: definitions io.launcher kernel math math.parser parser +namespaces prettyprint editors make ; + +IN: editors.textedit + +: textedit-location ( file line -- ) + drop + [ "open" , "-a" , "TextEdit", , ] { } make + try-process ; + +[ textedit-location ] edit-hook set-global + + diff --git a/basis/eval/authors.txt b/basis/eval/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/eval/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/eval/summary.txt b/basis/eval/summary.txt new file mode 100644 index 0000000000..679f074e90 --- /dev/null +++ b/basis/eval/summary.txt @@ -0,0 +1 @@ +Ad-hoc evaluation of strings of code diff --git a/basis/farkup/farkup-docs.factor b/basis/farkup/farkup-docs.factor index 6e7a5ddcb0..8e7270cc01 100644 --- a/basis/farkup/farkup-docs.factor +++ b/basis/farkup/farkup-docs.factor @@ -30,7 +30,8 @@ ARTICLE: "farkup-ast" "Farkup syntax tree nodes" { $subsection inline-code } { $subsection paragraph } { $subsection list-item } -{ $subsection list } +{ $subsection unordered-list } +{ $subsection ordered-list } { $subsection table } { $subsection table-row } { $subsection link } diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor index 571d333359..42979007e8 100644 --- a/basis/farkup/farkup-tests.factor +++ b/basis/farkup/farkup-tests.factor @@ -35,6 +35,14 @@ link-no-follow? off [ "
  • foo
    • \n

bar\n

" ] [ "-foo\nbar\n" convert-farkup ] unit-test +[ "
  1. a-b
" ] [ "#a-b" convert-farkup ] unit-test +[ "
  1. foo
" ] [ "#foo" convert-farkup ] unit-test +[ "
  1. foo
    2. \n
" ] [ "#foo\n" convert-farkup ] unit-test +[ "
  1. foo
    2. \n
  2. bar
" ] [ "#foo\n#bar" convert-farkup ] unit-test +[ "
  1. foo
    2. \n
  2. bar
    3. \n
" ] [ "#foo\n#bar\n" convert-farkup ] unit-test + +[ "
  1. foo
    2. \n

bar\n

" ] [ "#foo\nbar\n" convert-farkup ] unit-test + [ "\n\n" ] [ "\n\n" convert-farkup ] unit-test [ "\n\n" ] [ "\r\n\r\n" convert-farkup ] unit-test @@ -120,3 +128,10 @@ link-no-follow? off [ "

C++

" ] [ "[[C++]]" convert-farkup ] unit-test [ "

<foo>

" ] [ "" convert-farkup ] unit-test + +[ "

asdf\n

  • lol
    • \n
  • haha

" ] [ "asdf\n-lol\n-haha" convert-farkup ] unit-test + +[ "

asdf

  • lol
    • \n
  • haha
" ] [ "asdf\n\n-lol\n-haha" convert-farkup ] unit-test + +[ "
" ] [ "___" convert-farkup ] unit-test +[ "
\n" ] [ "___\n" convert-farkup ] unit-test diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index cc56f48949..f482f8beaa 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -21,12 +21,14 @@ TUPLE: subscript child ; TUPLE: inline-code child ; TUPLE: paragraph child ; TUPLE: list-item child ; -TUPLE: list child ; +TUPLE: unordered-list child ; +TUPLE: ordered-list child ; TUPLE: table child ; TUPLE: table-row child ; TUPLE: link href text ; TUPLE: image href text ; TUPLE: code mode string ; +TUPLE: line ; : absolute-url? ( string -- ? ) { "http://" "https://" "ftp://" } [ head? ] with contains? ; @@ -102,16 +104,28 @@ table = ((table-row nl => [[ first ]] )+ table-row? | table-row) text = (!(nl | code | heading | inline-delimiter | table ).)+ => [[ >string ]] -paragraph-item = (table | text | inline-tag | inline-delimiter)+ +paragraph-item = (table | list | text | inline-tag | inline-delimiter)+ paragraph = ((paragraph-item nl => [[ first ]])+ nl+ => [[ first ]] | (paragraph-item nl)+ paragraph-item? | paragraph-item) => [[ paragraph boa ]] -list-item = '-' (cell | inline-tag)* +list-item = (cell | inline-tag)* + +ordered-list-item = '#' list-item => [[ second list-item boa ]] -list = ((list-item nl)+ list-item? | list-item) - => [[ list boa ]] +ordered-list = ((ordered-list-item nl)+ ordered-list-item? | ordered-list-item) + => [[ ordered-list boa ]] + +unordered-list-item = '-' list-item + => [[ second list-item boa ]] +unordered-list = ((unordered-list-item nl)+ unordered-list-item? | unordered-list-item) + => [[ unordered-list boa ]] + +list = ordered-list | unordered-list + +line = '___' + => [[ drop line new ]] code = '[' (!('{' | nl | '[').)+ '{' (!("}]").)+ "}]" => [[ [ second >string ] [ fourth >string ] bi code boa ]] @@ -121,7 +135,7 @@ simple-code => [[ second f swap code boa ]] stand-alone - = (code | simple-code | heading | list | table | paragraph | nl)* + = (line | code | simple-code | heading | list | table | paragraph | nl)* ;EBNF @@ -177,11 +191,13 @@ M: superscript (write-farkup) [ child>> (write-farkup) ] "sup" in-tag. ; M: subscript (write-farkup) [ child>> (write-farkup) ] "sub" in-tag. ; M: inline-code (write-farkup) [ child>> (write-farkup) ] "code" in-tag. ; M: list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ; -M: list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ; +M: unordered-list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ; +M: ordered-list (write-farkup) [ child>> (write-farkup) ] "ol" in-tag. ; M: paragraph (write-farkup) [ child>> (write-farkup) ] "p" in-tag. ; M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ; M: image (write-farkup) [ href>> ] [ text>> ] bi write-image-link ; M: code (write-farkup) [ string>> ] [ mode>> ] bi render-code ; +M: line (write-farkup) drop
; M: table-row (write-farkup) ( obj -- ) child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ; M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ; diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 6e55ca44a0..2a63489299 100755 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -86,7 +86,7 @@ TUPLE: action rest authorize init display validate submit ; begin-conversation nested-forms-key param " " split harvest nested-forms cset form get form cset - + ] [ <400> ] if* exit-with ; diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor index 6f5f6fdbf6..decee690a3 100644 --- a/basis/furnace/alloy/alloy.factor +++ b/basis/furnace/alloy/alloy.factor @@ -3,6 +3,7 @@ USING: kernel sequences db.tuples alarms calendar db fry furnace.db furnace.cache +furnace.asides furnace.referrer furnace.sessions furnace.conversations @@ -10,20 +11,24 @@ furnace.auth.providers furnace.auth.login.permits ; IN: furnace.alloy -: ( responder db params -- responder' ) - '[ - - - _ _ - - ] call ; - -: state-classes { session conversation permit } ; inline +: state-classes { session aside conversation permit } ; inline : init-furnace-tables ( -- ) state-classes ensure-tables user ensure-table ; +: ( responder db params -- responder' ) + [ [ init-furnace-tables ] with-db ] + [ + [ + + + + ] 2dip + + + ] 2bi ; + : start-expiring ( db params -- ) '[ _ _ [ state-classes [ expire-state ] each ] with-db diff --git a/basis/furnace/asides/asides.factor b/basis/furnace/asides/asides.factor new file mode 100644 index 0000000000..6d4196cf0b --- /dev/null +++ b/basis/furnace/asides/asides.factor @@ -0,0 +1,111 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces assocs kernel sequences accessors hashtables +urls db.types db.tuples math.parser fry logging combinators +html.templates.chloe.syntax +http http.server http.server.filters http.server.redirection +furnace +furnace.cache +furnace.sessions +furnace.redirection ; +IN: furnace.asides + +TUPLE: aside < server-state +session method url post-data ; + +: