diff --git a/basis/farkup/farkup-docs.factor b/basis/farkup/farkup-docs.factor index f2d53d2362..6e7a5ddcb0 100644 --- a/basis/farkup/farkup-docs.factor +++ b/basis/farkup/farkup-docs.factor @@ -9,7 +9,7 @@ HELP: write-farkup { $values { "string" string } } { $description "Parse a Farkup string and writes the resulting HTML to " { $link output-stream } "." } ; -HELP: farkup ( string -- farkup ) +HELP: parse-farkup ( string -- farkup ) { $values { "string" string } { "farkup" "a Farkup syntax tree node" } } { $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ; @@ -18,7 +18,7 @@ HELP: (write-farkup) { $description "Writes a Farkup syntax tree as HTML on " { $link output-stream } "." } ; ARTICLE: "farkup-ast" "Farkup syntax tree nodes" -"The " { $link farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "." +"The " { $link parse-farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "." { $subsection heading1 } { $subsection heading2 } { $subsection heading3 } @@ -44,7 +44,7 @@ $nl { $subsection convert-farkup } { $subsection write-farkup } "The syntax tree of a piece of Farkup can also be inspected and modified:" -{ $subsection farkup } +{ $subsection parse-farkup } { $subsection (write-farkup) } { $subsection "farkup-ast" } ; diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor index e25fa34960..cc032913b7 100644 --- a/basis/farkup/farkup-tests.factor +++ b/basis/farkup/farkup-tests.factor @@ -118,3 +118,7 @@ link-no-follow? off ] unit-test [ "

a c

" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test + +[ "

C++

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

<foo>

" ] [ "" convert-farkup ] unit-test diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 4d6ac127ad..cc56f48949 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -1,29 +1,29 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays combinators html.elements io io.streams.string -kernel math memoize namespaces peg peg.ebnf prettyprint -sequences sequences.deep strings xml.entities vectors splitting -xmode.code2html ; +USING: accessors arrays combinators html.elements io +io.streams.string kernel math memoize namespaces peg peg.ebnf +prettyprint sequences sequences.deep strings xml.entities +vectors splitting xmode.code2html urls ; IN: farkup SYMBOL: relative-link-prefix SYMBOL: disable-images? SYMBOL: link-no-follow? -TUPLE: heading1 obj ; -TUPLE: heading2 obj ; -TUPLE: heading3 obj ; -TUPLE: heading4 obj ; -TUPLE: strong obj ; -TUPLE: emphasis obj ; -TUPLE: superscript obj ; -TUPLE: subscript obj ; -TUPLE: inline-code obj ; -TUPLE: paragraph obj ; -TUPLE: list-item obj ; -TUPLE: list obj ; -TUPLE: table obj ; -TUPLE: table-row obj ; +TUPLE: heading1 child ; +TUPLE: heading2 child ; +TUPLE: heading3 child ; +TUPLE: heading4 child ; +TUPLE: strong child ; +TUPLE: emphasis child ; +TUPLE: superscript child ; +TUPLE: subscript child ; +TUPLE: inline-code child ; +TUPLE: paragraph child ; +TUPLE: list-item child ; +TUPLE: list child ; +TUPLE: table child ; +TUPLE: table-row child ; TUPLE: link href text ; TUPLE: image href text ; TUPLE: code mode string ; @@ -34,7 +34,7 @@ TUPLE: code mode string ; : simple-link-title ( string -- string' ) dup absolute-url? [ "/" last-split1 swap or ] unless ; -EBNF: farkup +EBNF: parse-farkup nl = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]] 2nl = nl nl @@ -65,7 +65,7 @@ subscript = "~" (!("~" | nl).)+ "~" inline-code = "%" (!("%" | nl).)+ "%" => [[ second >string inline-code boa ]] -escaped-char = "\" . => [[ second ]] +escaped-char = "\" . => [[ second 1string ]] link-content = (!("|"|"]").)+ @@ -89,20 +89,26 @@ inline-tag = strong | emphasis | superscript | subscript | inline-code inline-delimiter = '*' | '_' | '^' | '~' | '%' | '\' | '[' -table-column = (list | (!(nl | inline-delimiter | '|').)+ | inline-tag | inline-delimiter ) '|' +cell = (!(inline-delimiter | '|' | nl).)+ + => [[ >string ]] + +table-column = (list | cell | inline-tag | inline-delimiter ) '|' => [[ first ]] table-row = "|" (table-column)+ => [[ second table-row boa ]] table = ((table-row nl => [[ first ]] )+ table-row? | table-row) => [[ table boa ]] -paragraph-item = ( table | (!(nl | code | heading | inline-delimiter | table ).) | inline-tag | inline-delimiter)+ +text = (!(nl | code | heading | inline-delimiter | table ).)+ + => [[ >string ]] + +paragraph-item = (table | text | inline-tag | inline-delimiter)+ paragraph = ((paragraph-item nl => [[ first ]])+ nl+ => [[ first ]] | (paragraph-item nl)+ paragraph-item? | paragraph-item) => [[ paragraph boa ]] - -list-item = '-' ((!(inline-delimiter | nl).)+ | inline-tag)* + +list-item = '-' (cell | inline-tag)* => [[ second list-item boa ]] list = ((list-item nl)+ list-item? | list-item) => [[ list boa ]] @@ -136,7 +142,7 @@ stand-alone : write-link ( href text -- ) escape-link - [ ] + [ ] [ write ] bi* ; @@ -146,7 +152,7 @@ stand-alone "Images are not allowed" write ] [ escape-link - [ ] bi* + [ ] bi* ] if ; : render-code ( string mode -- string' ) @@ -161,31 +167,30 @@ GENERIC: (write-farkup) ( farkup -- ) : ( string -- ) write ; : ( string -- ) write ; : in-tag. ( obj quot string -- ) [ call ] keep ; inline -M: heading1 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h1" in-tag. ; -M: heading2 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h2" in-tag. ; -M: heading3 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h3" in-tag. ; -M: heading4 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h4" in-tag. ; -M: strong (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "strong" in-tag. ; -M: emphasis (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "em" in-tag. ; -M: superscript (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "sup" in-tag. ; -M: subscript (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "sub" in-tag. ; -M: inline-code (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "code" in-tag. ; -M: list-item (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "li" in-tag. ; -M: list (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "ul" in-tag. ; -M: paragraph (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "p" in-tag. ; -M: link (write-farkup) ( obj -- ) [ href>> ] [ text>> ] bi write-link ; -M: image (write-farkup) ( obj -- ) [ href>> ] [ text>> ] bi write-image-link ; -M: code (write-farkup) ( obj -- ) [ string>> ] [ mode>> ] bi render-code ; +M: heading1 (write-farkup) [ child>> (write-farkup) ] "h1" in-tag. ; +M: heading2 (write-farkup) [ child>> (write-farkup) ] "h2" in-tag. ; +M: heading3 (write-farkup) [ child>> (write-farkup) ] "h3" in-tag. ; +M: heading4 (write-farkup) [ child>> (write-farkup) ] "h4" in-tag. ; +M: strong (write-farkup) [ child>> (write-farkup) ] "strong" in-tag. ; +M: emphasis (write-farkup) [ child>> (write-farkup) ] "em" in-tag. ; +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: 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: table-row (write-farkup) ( obj -- ) - obj>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ; -M: table (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "table" in-tag. ; -M: fixnum (write-farkup) ( obj -- ) write1 ; -M: string (write-farkup) ( obj -- ) write ; -M: vector (write-farkup) ( obj -- ) [ (write-farkup) ] each ; -M: f (write-farkup) ( obj -- ) drop ; + child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ; +M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ; +M: string (write-farkup) escape-string write ; +M: vector (write-farkup) [ (write-farkup) ] each ; +M: f (write-farkup) drop ; : write-farkup ( string -- ) - farkup (write-farkup) ; + parse-farkup (write-farkup) ; : convert-farkup ( string -- string' ) - farkup [ (write-farkup) ] with-string-writer ; + parse-farkup [ (write-farkup) ] with-string-writer ; diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index cce098f208..6e55ca44a0 100755 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -14,7 +14,8 @@ html.elements html.components html.components html.templates.chloe -html.templates.chloe.syntax ; +html.templates.chloe.syntax +html.templates.chloe.compiler ; IN: furnace.actions SYMBOL: params @@ -29,7 +30,8 @@ SYMBOL: rest ] unless-empty ; -CHLOE: validation-messages drop render-validation-messages ; +CHLOE: validation-messages + drop [ render-validation-messages ] [code] ; TUPLE: action rest authorize init display validate submit ; diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor index ab9d987b67..ad75b58df3 100644 --- a/basis/html/elements/elements.factor +++ b/basis/html/elements/elements.factor @@ -48,8 +48,6 @@ IN: html.elements ! ! -: elements-vocab ( -- vocab-name ) "html.elements" ; - SYMBOL: html : write-html ( str -- ) @@ -60,6 +58,8 @@ SYMBOL: html << +: elements-vocab ( -- vocab-name ) "html.elements" ; + : html-word ( name def effect -- ) #! Define 'word creating' word to allow #! dynamically creating words. diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index e16f62d1f1..4f2639975b 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -14,7 +14,7 @@ IN: urls [ letter? ] [ LETTER? ] [ digit? ] - [ "/_-." member? ] + [ "/_-.:" member? ] } 1|| ; foldable -: url-encode ( str -- str ) +: url-encode ( str -- encoded ) [ [ dup url-quotable? [ , ] [ push-utf8 ] if ] each ] "" make ; @@ -58,7 +58,7 @@ PRIVATE> PRIVATE> -: url-decode ( str -- str ) +: url-decode ( str -- decoded ) [ 0 swap url-decode-iter ] "" make utf8 decode ; class [ + dup . flush "predicate" word-prop instances [ class drop ] each diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 789837ea47..b8be31c55c 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1356,16 +1356,18 @@ ARTICLE: "sequences-slices" "Subsequences and slices" "A " { $emphasis "slice" } " is a virtual sequence which presents as view of a subsequence of an underlying sequence:" { $subsection slice } { $subsection slice? } -"Creating slices:" +"Extracting a slice:" { $subsection } { $subsection head-slice } { $subsection tail-slice } -{ $subsection but-last-slice } -{ $subsection rest-slice } { $subsection head-slice* } { $subsection tail-slice* } +"Removing the first or last element:" +{ $subsection rest-slice } +{ $subsection but-last-slice } "Taking a sequence apart into a head and a tail:" { $subsection unclip-slice } +{ $subsection unclip-last-slice } { $subsection cut-slice } "A utility for words which use slices as iterators:" { $subsection } ; diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor index f3efb3868f..a0ee3a1b29 100644 --- a/extra/webapps/counter/counter.factor +++ b/extra/webapps/counter/counter.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. USING: math kernel accessors http.server http.server.dispatchers furnace furnace.actions furnace.sessions furnace.redirection html.components html.forms html.templates.chloe @@ -28,3 +30,20 @@ M: counter-app init-session* drop 0 count sset ; [ 1- ] "dec" add-responder "" add-responder ; + +! Deployment example +USING: db.sqlite db.tuples db furnace.db namespaces ; + +: counter-db ( -- params db ) "counter.db" sqlite-db ; + +: init-counter-db ( -- ) + counter-db [ session ensure-table ] with-db ; + +: run-counter ( -- ) + init-counter-db + + counter-db + main-responder set-global + 8080 httpd ; + +MAIN: run-counter diff --git a/vm/image.c b/vm/image.c index a668cb7913..62f9e1c906 100755 --- a/vm/image.c +++ b/vm/image.c @@ -186,13 +186,16 @@ void strip_compiled_quotations(void) DEFINE_PRIMITIVE(save_image_and_exit) { - /* This reduces deployed image size */ - strip_compiled_quotations(); - + /* We unbox this before doing anything else. This is the only point + where we might throw an error, so we have to throw an error here since + later steps destroy the current image. */ F_CHAR *path = unbox_native_string(); REGISTER_C_STRING(path); + /* This reduces deployed image size */ + strip_compiled_quotations(); + /* strip out userenv data which is set on startup anyway */ CELL i; for(i = 0; i < FIRST_SAVE_ENV; i++)