Update HTTP server for HTML stream changes

extra/furnace/furnace.factor

@@ -118,18 +118,18 @@ SYMBOL: model
 
 : render-page* ( model body-template head-template -- )
     [
-        [ render-template ] [ f rot render-template ] html-document* 
+        [ render-template ] [ f rot render-template ] html-document 
     ] serve-html ;
 
 : render-titled-page* ( model body-template head-template title -- )
     [ 
-        [ render-template ] swap [ <title> write </title> f rot render-template ] curry html-document* 
+        [ render-template ] swap [ <title> write </title> f rot render-template ] curry html-document
     ] serve-html ;
 
 
 : render-page ( model template title -- )
     [
-        [ render-template ] html-document
+        [ render-template ] simple-html-document
     ] serve-html ;
 
 : web-app ( name default path -- )

extra/http/http.factor

@@ -7,7 +7,7 @@ IN: http
 : header-line ( line -- )
     ": " split1 dup [ swap set ] [ 2drop ] if ;
 
-: (read-header) ( hash -- hash )
+: (read-header) ( -- )
     readln dup
     empty? [ drop ] [ header-line (read-header) ] if ;
 

extra/http/server/responders/continuation/examples/examples.factor

@@ -34,7 +34,7 @@ IN: http.server.responders.continuation.examples
     <h1> over write </h1>
     swap [ 
       <a =href a> "Next" write </a>
-    ] html-document 
+    ] simple-html-document 
   ] show 2drop ;
 
 : display-get-name-page ( -- name )
@@ -47,7 +47,7 @@ IN: http.server.responders.continuation.examples
         <input "text" =type "name" =name "20" =size input/>
         <input "submit" =type "Ok" =value input/>
       </form>
-    ] html-document
+    ] simple-html-document
   ] show "name" swap at ;
 
 : test-cont-responder ( -- )
@@ -71,7 +71,7 @@ IN: http.server.responders.continuation.examples
         <li> "Test responder1" [ test-cont-responder ] quot-href </li>
         <li> "Test responder2" [ test-cont-responder2 ] quot-href </li>
       </ol>
-    ] html-document 
+    ] simple-html-document 
   ] show-final ;
 
 : counter-example ( count -- )
@@ -87,7 +87,7 @@ IN: http.server.responders.continuation.examples
       "++" over 1quotation [ f ] swap append [ 1 + counter-example ] append quot-href
       "--" over 1quotation [ f ] swap append [ 1 - counter-example ] append quot-href
       drop
-    ] html-document 
+    ] simple-html-document 
   ] show drop ;
 
 : counter-example2 ( -- )
@@ -102,7 +102,7 @@ IN: http.server.responders.continuation.examples
       <h2> "counter" get unparse write </h2>
       "++" [ "counter" get 1 + "counter" set ] quot-href
       "--" [ "counter" get 1 - "counter" set ] quot-href
-    ] html-document 
+    ] simple-html-document 
   ] show 
   drop ;
 

extra/http/server/responders/file/file.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: calendar html io io.files kernel math math.parser http.server.responders
-http.server.templating namespaces parser sequences strings assocs hashtables
-debugger http.mime sorting ;
+USING: calendar html io io.files kernel math math.parser
+http.server.responders http.server.templating namespaces parser
+sequences strings assocs hashtables debugger http.mime sorting
+html.elements ;
 
 IN: http.server.responders.file
 
@@ -55,19 +56,25 @@ SYMBOL: page
     dup mime-type dup "application/x-factor-server-page" =
     [ drop serving-html run-page ] [ serve-static ] if ;
 
-: file. ( path name dirp -- )
-    "[DIR] " "      " ? write
-    dup <pathname> write-object nl ;
+: file. ( name dirp -- )
+    [ "/" append ] when
+    dup <a =href a> write </a> ;
 
-: directory. ( path -- )
-    directory sort-keys [ first2 file. ] each ;
+: directory. ( path request -- )
+    dup [
+        <h1> write </h1>
+        <ul>
+            directory sort-keys
+            [ <li> file. </li> ] assoc-each
+        </ul>
+    ] simple-html-document ;
 
 : list-directory ( directory -- )
     serving-html
      "method" get "head" = [
         drop
     ] [
-        "request" get [ directory. ] simple-html-document
+        "request" get directory.
     ] if ;
 
 : find-index ( filename -- path )
@@ -98,17 +105,17 @@ SYMBOL: page
     ] if ;
 
 global [
-    ! Javascript source used by ajax libraries
+    ! Serve up our own source code
     "resources" [ 
         [
-            "extra/http/server/resources/" resource-path "doc-root" set
+            "" resource-path "doc-root" set
             file-responder
         ] with-scope
     ] add-simple-responder
     
     ! Serves files from a directory stored in the "doc-root"
-    ! variable. You can set the variable in the global namespace,
-    ! or inside the responder.
+    ! variable. You can set the variable in the global
+    ! namespace, or inside the responder.
     "file" [ file-responder ] add-simple-responder
     
     ! The root directory is served by...

extra/http/server/responders/responders.factor

@@ -16,16 +16,16 @@ SYMBOL: responders
 : response ( header msg -- )
     "HTTP/1.0 " write print print-header ;
 
-: error-body ( error -- body )
+: error-body ( error -- )
     <html> <body> <h1> write </h1> </body> </html> ;
 
 : error-head ( error -- )
     dup log-error
-    H{ { "Content-Type" "text/html" } } over response ;
+    H{ { "Content-Type" "text/html" } } swap response ;
 
 : httpd-error ( error -- )
     #! This must be run from handle-request
-    error-head
+    dup error-head
     "head" "method" get = [ drop ] [ nl error-body ] if ;
 
 : bad-request ( -- )
@@ -101,7 +101,8 @@ SYMBOL: max-post-request
     dup "request" set ;
 
 : prepare-header ( -- )
-    read-header dup "header" set
+    read-header
+    dup "header" set
     dup log-headers
     read-post-request "response" set "raw-response" set ;
 

extra/webapps/help/help.factor

@@ -10,7 +10,7 @@ IN: webapps.help
     serving-html
     dup article-title [
         [ help ] with-html-stream
-    ] html-document ;
+    ] simple-html-document ;
 
 : string>topic ( string -- topic )
     " " split dup length 1 = [ first ] when ;
@@ -73,9 +73,10 @@ M: vocab-author browser-link-href
 "help" "show-help" "extra/webapps/help" web-app
 
 ! Hard-coding for factorcode.org
-M: pathname browser-link-href
-    pathname-string "resource:" ?head [
-        "http://factorcode.org/repos/Factor/" swap append
-    ] [
-        drop f
-    ] if ;
+PREDICATE: pathname resource-pathname
+    pathname-string "resource:" head? ;
+
+M: resource-pathname browser-link-href
+    pathname-string
+    "resource:" ?head drop
+    "/responder/resources/" swap append ;