Fixing httpd

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" } }

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 ;

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 -- )

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 ;
+
+[ "<a href='h&amp;o'>" ]
+[ [ <a "h&o" =href a> ] make-html-string ] unit-test

extra/html/elements/elements.factor

@@ -4,7 +4,7 @@
 ! 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
 
@@ -57,52 +57,57 @@ 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 ;
 
 : <foo> "<" swap ">" 3append ;
 
+: empty-effect T{ effect f 0 0 } ;
+
 : def-for-html-word-<foo> ( name -- )
     #! Return the name and code for the <foo> patterned
     #! word.
-    dup <foo> swap [ <foo> write-html ] curry html-word ;
+    dup <foo> swap [ <foo> write-html ] curry
+    empty-effect html-word ;
 
 : <foo "<" swap append ;
 
 : def-for-html-word-<foo ( name -- )
     #! Return the name and code for the <foo patterned
     #! word.
-    <foo dup [ write-html ] curry html-word ;
+    <foo dup [ 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 ;
+    foo> [ ">" write-html ] empty-effect html-word ;
 
 : </foo> [ "</" % % ">" % ] "" make ;
 
 : def-for-html-word-</foo> ( name -- )
     #! Return the name and code for the </foo> patterned
     #! word.
-    </foo> dup [ write-html ] curry html-word ;
+    </foo> dup [ write-html ] curry empty-effect html-word ;
 
 : <foo/> [ "<" % % "/>" % ] "" make ;
 
 : def-for-html-word-<foo/> ( name -- )
     #! Return the name and code for the <foo/> patterned
     #! word.
-    dup <foo/> swap [ <foo/> write-html ] curry html-word ;
+    dup <foo/> swap [ <foo/> 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 ;
+    foo/> [ "/>" write-html ] empty-effect html-word ;
 
 : define-closed-html-word ( name -- )
     #! Given an HTML tag name, define the words for
@@ -123,13 +128,16 @@ 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"
@@ -154,3 +162,4 @@ SYMBOL: html
         "src" "language" "colspan" "onchange" "rel"
         "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang"
     ] [ define-attribute-word ] each
+] with-compilation-unit

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 -- )

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 ;

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 ;

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 -- )

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