diff --git a/extra/crypto/common/common-docs.factor b/extra/crypto/common/common-docs.factor index 1292e04777..032e174eb1 100644 --- a/extra/crypto/common/common-docs.factor +++ b/extra/crypto/common/common-docs.factor @@ -1,5 +1,6 @@ USING: help.markup help.syntax kernel math sequences quotations -crypto.common math.private ; +math.private ; +IN: crypto.common HELP: >32-bit { $values { "x" "an integer" } { "y" "an integer" } } diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor index 09c175f94c..80419e9c8d 100644 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2006 Slava Pestov, Doug Coleman +! Copyright (C) 2006, 2008 Slava Pestov, Doug Coleman ! See http://factorcode.org/license.txt for BSD license. -USING: arrays assocs calendar debugger furnace.sessions furnace.validator -hashtables heaps html.elements http http.server.responders -http.server.templating io.files kernel math namespaces -quotations sequences splitting words strings vectors -webapps.callback ; -USING: continuations io prettyprint ; +USING: arrays assocs calendar debugger furnace.sessions +furnace.validator hashtables heaps html.elements http +http.server.responders http.server.templating io.files kernel +math namespaces quotations sequences splitting words strings +vectors webapps.callback continuations tuples classes vocabs +html io ; IN: furnace : code>quotation ( word/quot -- quot ) @@ -174,7 +174,6 @@ PREDICATE: word action "action" word-prop ; [ service-post ] "post" set ] make-responder ; -USING: classes html tuples vocabs ; : explode-tuple ( tuple -- ) dup tuple-slots swap class "slot-names" word-prop [ set ] 2each ; diff --git a/extra/help/markup/markup.factor b/extra/help/markup/markup.factor index 5d90fd367c..5f1b027823 100644 --- a/extra/help/markup/markup.factor +++ b/extra/help/markup/markup.factor @@ -44,7 +44,7 @@ M: f print-element drop ; : with-default-style ( quot -- ) default-style get [ last-element off - H{ } swap with-nesting + default-style get swap with-nesting ] with-style ; inline : print-content ( element -- ) diff --git a/extra/html/elements/elements-tests.factor b/extra/html/elements/elements-tests.factor new file mode 100644 index 0000000000..786fe0e68c --- /dev/null +++ b/extra/html/elements/elements-tests.factor @@ -0,0 +1,8 @@ +IN: temporary +USING: tools.test html html.elements io.streams.string ; + +: make-html-string + [ with-html-stream ] string-out ; + +[ "" ] +[ [ ] make-html-string ] unit-test diff --git a/extra/html/elements/elements.factor b/extra/html/elements/elements.factor index d737c113a8..ff3e7b1283 100644 --- a/extra/html/elements/elements.factor +++ b/extra/html/elements/elements.factor @@ -4,17 +4,17 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io kernel namespaces prettyprint quotations -sequences strings words xml.writer ; +sequences strings words xml.writer compiler.units effects ; IN: html.elements ! These words are used to provide a means of writing ! formatted HTML to standard output with a familiar 'html' look -! and feel in the code. +! and feel in the code. ! ! HTML tags can be used in a number of different ways. The highest ! level involves a similar syntax to HTML: -! +! !

"someoutput" write

! !

will output the opening tag and

will output the closing @@ -28,7 +28,7 @@ IN: html.elements ! in that namespace. Before the attribute word should come the ! value of that attribute. ! The finishing word will print out the operning tag including -! attributes. +! attributes. ! Any writes after this will appear after the opening tag. ! ! Values for attributes can be used directly without any stack @@ -57,54 +57,59 @@ SYMBOL: html : print-html ( str -- ) write-html "\n" write-html ; -: html-word ( name def -- ) +: html-word ( name def effect -- ) #! Define 'word creating' word to allow #! dynamically creating words. - >r elements-vocab create r> define-compound ; - + >r >r elements-vocab create r> r> define-declared ; + : "<" swap ">" 3append ; +: empty-effect T{ effect f 0 0 } ; + : def-for-html-word- ( name -- ) #! Return the name and code for the patterned #! word. - dup swap [ write-html ] curry html-word ; + dup swap [ write-html ] curry + empty-effect html-word ; : ">" append ; : def-for-html-word-foo> ( name -- ) #! Return the name and code for the foo> patterned #! word. - foo> [ ">" write-html ] html-word ; + foo> [ ">" write-html ] empty-effect html-word ; : [ "" % ] "" make ; : def-for-html-word- ( name -- ) #! Return the name and code for the patterned - #! word. - dup [ write-html ] curry html-word ; + #! word. + dup [ write-html ] curry empty-effect html-word ; : [ "<" % % "/>" % ] "" make ; : def-for-html-word- ( name -- ) #! Return the name and code for the patterned #! word. - dup swap [ write-html ] curry html-word ; + dup swap [ write-html ] curry + empty-effect html-word ; : foo/> "/>" append ; : def-for-html-word-foo/> ( name -- ) #! Return the name and code for the foo/> patterned - #! word. - foo/> [ "/>" write-html ] html-word ; + #! word. + foo/> [ "/>" write-html ] empty-effect html-word ; -: define-closed-html-word ( name -- ) +: define-closed-html-word ( name -- ) #! Given an HTML tag name, define the words for #! that closable HTML tag. dup def-for-html-word- @@ -112,7 +117,7 @@ SYMBOL: html dup def-for-html-word-foo> def-for-html-word- ; -: define-open-html-word ( name -- ) +: define-open-html-word ( name -- ) #! Given an HTML tag name, define the words for #! that open HTML tag. dup def-for-html-word- @@ -123,34 +128,38 @@ SYMBOL: html " " write-html write-html "='" write-html - escape-quoted-string write + escape-quoted-string write-html "'" write-html ; +: attribute-effect T{ effect f { "string" } 0 } ; + : define-attribute-word ( name -- ) dup "=" swap append swap - [ write-attr ] curry html-word ; + [ write-attr ] curry attribute-effect html-word ; -! Define some closed HTML tags [ - "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9" - "ol" "li" "form" "a" "p" "html" "head" "body" "title" - "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea" - "script" "div" "span" "select" "option" "style" -] [ define-closed-html-word ] each + ! Define some closed HTML tags + [ + "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9" + "ol" "li" "form" "a" "p" "html" "head" "body" "title" + "b" "i" "ul" "table" "tbody" "tr" "td" "th" "pre" "textarea" + "script" "div" "span" "select" "option" "style" + ] [ define-closed-html-word ] each -! Define some open HTML tags -[ - "input" - "br" - "link" - "img" -] [ define-open-html-word ] each + ! Define some open HTML tags + [ + "input" + "br" + "link" + "img" + ] [ define-open-html-word ] each -! Define some attributes -[ - "method" "action" "type" "value" "name" - "size" "href" "class" "border" "rows" "cols" - "id" "onclick" "style" "valign" "accesskey" - "src" "language" "colspan" "onchange" "rel" - "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang" -] [ define-attribute-word ] each + ! Define some attributes + [ + "method" "action" "type" "value" "name" + "size" "href" "class" "border" "rows" "cols" + "id" "onclick" "style" "valign" "accesskey" + "src" "language" "colspan" "onchange" "rel" + "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang" + ] [ define-attribute-word ] each +] with-compilation-unit diff --git a/extra/html/html.factor b/extra/html/html.factor index 391737ca61..700951dfdd 100755 --- a/extra/html/html.factor +++ b/extra/html/html.factor @@ -109,7 +109,10 @@ M: html-span-stream stream-close page-color [ bg-css, ] apply-style border-color [ border-css, ] apply-style border-width [ padding-css, ] apply-style - wrap-margin [ pre-css, ] apply-style + ! FIXME: This is a hack for webapps.help + building get empty? [ + wrap-margin over at pre-css, + ] unless ] make-css ; : div-tag ( style quot -- ) diff --git a/extra/http/server/responders/responders.factor b/extra/http/server/responders/responders.factor index 2dfbf73004..8dcaa7223d 100644 --- a/extra/http/server/responders/responders.factor +++ b/extra/http/server/responders/responders.factor @@ -124,6 +124,10 @@ SYMBOL: max-post-request : header-param ( key -- value ) "header" get at ; +: host ( -- string ) + #! The host the current responder was called from. + "Host" header-param ":" split1 drop ; + : add-responder ( responder -- ) #! Add a responder object to the list. "responder" over at responders get set-at ; diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index 58ef587150..99ed41afa3 100644 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -28,10 +28,6 @@ IN: http.server { "HEAD" "head" } } at "bad" or ; -: host ( -- string ) - #! The host the current responder was called from. - "Host" header-param ":" split1 drop ; - : (handle-request) ( arg cmd -- method path host ) request-method dup "method" set swap prepare-url prepare-header host ; diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor index 680f7b73d5..69f8b4e7fd 100755 --- a/extra/http/server/templating/templating.factor +++ b/extra/http/server/templating/templating.factor @@ -77,7 +77,6 @@ DEFER: <% delimiter [ [ "quiet" on - file-vocabs parser-notes off templating-vocab use+ dup source-file file set ! so that reload works properly @@ -85,7 +84,7 @@ DEFER: <% delimiter ?resource-path file-contents [ eval-template ] [ html-error. drop ] recover ] keep - ] with-scope + ] with-file-vocabs ] assert-depth drop ; : run-relative-template-file ( filename -- ) diff --git a/extra/webapps/cgi/cgi.factor b/extra/webapps/cgi/cgi.factor index 3588b21bda..26b8f31eae 100644 --- a/extra/webapps/cgi/cgi.factor +++ b/extra/webapps/cgi/cgi.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs io.files combinators -arrays io.launcher io http.server http.server.responders -webapps.file sequences strings ; +arrays io.launcher io http.server.responders webapps.file +sequences strings ; IN: webapps.cgi SYMBOL: cgi-root