File responder directory listing fixes

contrib/httpd/default-responders.factor

@@ -10,22 +10,19 @@ global [
     H{ } clone responders set
 
     ! 404 error message pages are served by this guy
-    [
+    "404" [ no-such-responder ] install-cont-responder
-        "404" "responder" set
-        [ drop no-such-responder ] "get" set
-    ] make-responder
 
     ! Online help browsing
     "help" [ help-responder ] install-cont-responder
 
     ! Javascript source used by ajax libraries
-    [ 
+    "javascript" [ 
-      "contrib/httpd/javascript/" resource-path "doc-root" set
+        [
-      "javascript" "responder" set
+            "contrib/httpd/javascript/" resource-path
-      [ file-responder ] "get" set
+            "doc-root" set
-      [ file-responder ] "post" set
+            file-responder
-      [ file-responder ] "head" set
+        ] with-scope
-    ] make-responder
+    ] install-cont-responder
 
     ! Global variables
     "inspector" [ inspect-responder ] install-cont-responder
@@ -36,13 +33,7 @@ global [
     ! Serves files from a directory stored in the "doc-root"
     ! variable. You can set the variable in the global namespace,
     ! or inside the responder.
-    [
+    "file" [ file-responder ] install-cont-responder
-        ! "/var/www/" "doc-root" set
-        "file" "responder" set
-        [ file-responder ] "get" set
-        [ file-responder ] "post" set
-        [ file-responder ] "head" set
-    ] make-responder
     
     ! The root directory is served by...
     "file" set-default-responder

contrib/httpd/file-responder.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004,2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: file-responder
-USING: html httpd kernel lists math namespaces parser sequences
+USING: cont-responder html httpd io kernel lists math namespaces
-io strings ;
+parser sequences strings ;
 
 : serving-path ( filename -- filename )
     [ "" ] unless* "doc-root" get swap append ;
@@ -49,13 +49,15 @@ io strings ;
 : serve-object ( filename -- )
     dup directory? [ serve-directory ] [ serve-file ] if ;
 
-: file-responder ( filename -- )
+: file-responder ( -- )
-    "doc-root" get [
+    [
-        serving-path dup exists? [
+        "doc-root" get [
-            serve-object
+            "argument" get serving-path dup exists? [
+                serve-object
+            ] [
+                drop "404 not found" httpd-error
+            ] if
         ] [
-            drop "404 not found" httpd-error
+            "404 doc-root not set" httpd-error
         ] if
-    ] [
+    ] (show-final) ;
-        drop "404 doc-root not set" httpd-error
-    ] if ;

contrib/httpd/responder.factor

@@ -126,11 +126,8 @@ SYMBOL: responders
 : set-default-responder ( name -- )
     responder "default" responders get set-hash ;
 
-: responder-argument ( argument -- argument )
-    dup empty? [ drop "default-argument" get ] when ;
-
 : call-responder ( method argument responder -- )
-    [ responder-argument swap get call ] bind ;
+    over "argument" set [ swap get call ] bind ;
 
 : serve-default-responder ( method url -- )
     "default" responder call-responder ;

contrib/httpd/test/httpd.factor

@@ -15,13 +15,6 @@ USE: lists
 
 [ ] [ "404 not found" httpd-error ] unit-test
 
-[ "arg" ] [
-    [
-        "arg" "default-argument" set
-        "" responder-argument
-    ] with-scope
-] unit-test
-
 [ "inspect/global" ] [ "/inspect/global" trim-/ ] unit-test
 
 [ ] [

library/io/files.factor

@@ -32,7 +32,7 @@ DEFER: directory.
 
 : (directory.) ( name path -- )
     dup [ directory. ] curry
-    [ "/" append (file.) ] write-outliner ;
+    [ "/" append (file.) ] write-outliner terpri ;
 
 : file. ( dir name -- )
     tuck path+