"++" [ "counter" get 1 + "counter" set ] quot-href
"--" [ "counter" get 1 - "counter" set ] quot-href
- ] html-document
+ ] simple-html-document
] show
drop ;
diff --git a/extra/http/server/responders/file/file.factor b/extra/http/server/responders/file/file.factor
index e6af805462..4f83e8fa98 100644
--- a/extra/http/server/responders/file/file.factor
+++ b/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 write-object nl ;
+: file. ( name dirp -- )
+ [ "/" append ] when
+ dup write ;
-: directory. ( path -- )
- directory sort-keys [ first2 file. ] each ;
+: directory. ( path request -- )
+ dup [
+
write
+
+ directory sort-keys
+ [
file.
] assoc-each
+
+ ] 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...
diff --git a/extra/http/server/responders/responders.factor b/extra/http/server/responders/responders.factor
index 725cb515b0..aadf513aea 100644
--- a/extra/http/server/responders/responders.factor
+++ b/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 -- )
write
;
: 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 ;
diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor
index ec0590df34..366baffcb9 100644
--- a/extra/webapps/help/help.factor
+++ b/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 ;