diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index e7a208374a..031f4955a6 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,8 +1,7 @@
-- telnetd should use multitasking
-- file-responder: Content-Length
-- HEAD request for file-responder
- - nicer way to combine two paths
- - icons for file responder
+- TEST telnetd should use multitasking
+- quit responder breaks with multithreading
+- nicer way to combine two paths
+- icons for file responder
- -1.1 3 ^ shouldn't give a complex number
- don't show listener on certain commands
- inferior hangs
@@ -19,6 +18,7 @@
- introduce ifte* and ?str-head/?str-tail where appropriate
- cwd, cd, pwd, dir., pwd. words
- namespace clone drops static var bindings
+- f usages. --> don't print all words
+ bignums:
@@ -100,7 +100,6 @@
+ httpd:
- 'default responder' for when we go to root
-- quit responder breaks with multithreading
- wiki responder:
- port to native
- text styles
diff --git a/actions.xml b/actions.xml
index d60bc249a8..4e729bca10 100644
--- a/actions.xml
+++ b/actions.xml
@@ -18,19 +18,22 @@
VFSManager.waitForRequests();
FactorPlugin.eval(view,
"\""
- + factor.FactorReader.charsToEscapes(buffer.path)
+ + FactorReader.charsToEscapes(buffer.path)
+ "\" run-file");
- if(textArea.selectionCount == 0)
- textArea.selectWord();
- FactorPlugin.eval(view,
- "\""
- + factor.FactorReader.charsToEscapes(
- textArea.selectedText)
- + "\" apropos.");
+ word = FactorPlugin.getWordAtCaret(textArea);
+ if(word == null)
+ view.toolkit.beep();
+ else
+ {
+ FactorPlugin.eval(view,
+ "\""
+ + FactorReader.charsToEscapes(word)
+ + "\" apropos.");
+ }
@@ -55,10 +58,11 @@
- if(textArea.selectionCount == 0)
- textArea.selectWord();
- FactorPlugin.insertUseDialog(view,
- textArea.selectedText);
+ word = FactorPlugin.getWordAtCaret(textArea);
+ if(word == null)
+ view.toolkit.beep();
+ else
+ FactorPlugin.insertUseDialog(view,word);
diff --git a/factor/jedit/FactorPlugin.java b/factor/jedit/FactorPlugin.java
index 1d122ee72b..9dd3885d3b 100644
--- a/factor/jedit/FactorPlugin.java
+++ b/factor/jedit/FactorPlugin.java
@@ -44,6 +44,13 @@ public class FactorPlugin extends EditPlugin
private static FactorInterpreter interp;
+ //{{{ start() method
+ public void start()
+ {
+ BeanShell.eval(null,BeanShell.getNameSpace(),
+ "import factor.*;\nimport factor.jedit.*;\n");
+ } //}}}
+
//{{{ getInterpreter() method
/**
* This can be called from the SideKick thread and must be thread safe.
diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor
index ad0190c29c..e4f5f442e3 100644
--- a/library/httpd/default-responders.factor
+++ b/library/httpd/default-responders.factor
@@ -68,6 +68,8 @@ USE: wiki-responder
[
"file" "responder" set
[ file-responder ] "get" set
+ [ file-responder ] "post" set
+ [ file-responder ] "head" set
] extend "file" set
! [
diff --git a/library/httpd/file-responder.factor b/library/httpd/file-responder.factor
index 4579d597a0..9673a9d846 100644
--- a/library/httpd/file-responder.factor
+++ b/library/httpd/file-responder.factor
@@ -33,6 +33,7 @@ USE: html
USE: httpd
USE: httpd-responder
USE: kernel
+USE: lists
USE: logging
USE: namespaces
USE: parser
@@ -40,18 +41,26 @@ USE: stack
USE: stdio
USE: streams
USE: strings
+USE: unparser
: serving-path ( filename -- filename )
f>"" "doc-root" get swap cat2 ;
-: file-header ( mime-type -- header )
- "200 Document follows" swap response ;
-
: copy-and-close ( from -- )
[ dupd "stdio" get fcopy ] [ >r fclose r> rethrow ] catch ;
+: file-response ( mime-type length -- )
+ [,
+ unparse "Content-Length" swons ,
+ "Content-Type" swons ,
+ ,] "200 OK" response ;
+
: serve-static ( filename mime-type -- )
- file-header print "stdio" get fcopy ;
+ over file-length file-response "method" get "head" = [
+ drop
+ ] [
+ "stdio" get copy-and-close
+ ] ifte ;
: serve-file ( filename -- )
dup mime-type dup "application/x-factor-server-page" = [
@@ -66,7 +75,12 @@ USE: strings
%> redirect ;
: list-directory ( directory -- )
- serving-html dup [ directory. ] simple-html-document ;
+ serving-html
+ "method" get "head" = [
+ drop
+ ] [
+ dup [ directory. ] simple-html-document
+ ] ifte ;
: serve-directory ( filename -- )
"/" ?str-tail [
@@ -82,13 +96,13 @@ USE: strings
: serve-object ( filename -- )
dup directory? [ serve-directory ] [ serve-file ] ifte ;
-: file-responder ( filename -- )
+: file-responder ( filename method -- )
"doc-root" get [
serving-path dup exists? [
serve-object
] [
- drop "404 not found" httpd-error
+ 2drop "404 not found" httpd-error
] ifte
] [
- drop "404 doc-root not set" httpd-error
+ 2drop "404 doc-root not set" httpd-error
] ifte ;
diff --git a/library/httpd/http-common.factor b/library/httpd/http-common.factor
index 4fdea40574..82aaa5afd2 100644
--- a/library/httpd/http-common.factor
+++ b/library/httpd/http-common.factor
@@ -42,30 +42,42 @@ USE: unparser
USE: url-encoding
-: response ( msg content-type -- response )
- swap <% "HTTP/1.0 " % % "\nContent-Type: " % % "\n" % %> ;
+: print-header ( alist -- )
+ [ unswons write ": " write url-encode print ] each ;
-: response-write ( msg content-type -- )
- response print ;
+: response ( header msg -- )
+ "HTTP/1.0 " write print print-header ;
: error-body ( error -- body )
- "\n" swap "
" cat3 ;
+ "" swap "
" cat3 print ;
+
+: error-head ( error -- )
+ dup log-error
+ [ [ "Content-Type" | "text/html" ] ] over response ;
: httpd-error ( error -- )
- dup log-error
- <% dup "text/html" response % error-body % %> print ;
+ #! This must be run from handle-request
+ error-head
+ "head" "method" get = [ terpri error-body ] unless ;
+
+: bad-request ( -- )
+ [
+ ! Make httpd-error print a body
+ "get" "method" set
+ "400 Bad request" httpd-error
+ ] with-scope ;
: serving-html ( -- )
- "200 Document follows" "text/html" response print ;
+ [ [ "Content-Type" | "text/html" ] ]
+ "200 Document follows" response terpri ;
: serving-text ( -- )
- "200 Document follows" "text/plain" response print ;
+ [ [ "Content-Type" | "text/plain" ] ]
+ "200 Document follows" response terpri ;
: redirect ( to -- )
- "301 Moved Permanently" "text/plain" response write
- "Location: " write write
- terpri terpri
- "The resource has moved." print ;
+ "Location" swons unit
+ "301 Moved Permanently" response terpri ;
: header-line ( alist line -- alist )
": " split1 dup [ transp acons ] [ 2drop ] ifte ;
@@ -107,7 +119,3 @@ USE: url-encoding
read-header dup "header" set
dup log-user-agent
read-post-request "response" set ;
-
-: with-request ( url quot -- )
- #! The quotation is called with the URL on the stack.
- [ swap prepare-url swap prepare-header call ] with-scope ;
diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor
index 373fa21b27..1b47875fe3 100644
--- a/library/httpd/httpd.factor
+++ b/library/httpd/httpd.factor
@@ -30,6 +30,7 @@ USE: combinators
USE: errors
USE: httpd-responder
USE: kernel
+USE: lists
USE: logging
USE: logic
USE: namespaces
@@ -48,9 +49,6 @@ USE: url-encoding
drop "stdio" get
] ifte ;
-: bad-request ( -- )
- "400 Bad request" httpd-error ;
-
: url>path ( uri -- path )
url-decode dup "http://" str-head? dup [
"/" split1 f "" replace nip nip
@@ -61,22 +59,19 @@ USE: url-encoding
: secure-path ( path -- path )
".." over str-contains? [ drop f ] when ;
-: get-request ( url -- )
- [ "get" swap serve-responder ] with-request ;
+: request-method ( cmd -- method )
+ [
+ [ "GET" | "get" ]
+ [ "POST" | "post" ]
+ [ "HEAD" | "head" ]
+ ] assoc [ "bad" ] unless* ;
-: post-request ( url -- )
- [ "post" swap serve-responder ] with-request ;
-
-: head-request ( url -- )
- [ "head" swap serve-responder ] with-request ;
+: (handle-request) ( arg cmd -- url method )
+ request-method dup "method" set swap
+ prepare-url prepare-header ;
: handle-request ( arg cmd -- )
- [
- [ "GET" = ] [ drop get-request ]
- [ "POST" = ] [ drop post-request ]
- [ "HEAD" = ] [ drop head-request ]
- [ drop t ] [ 2drop bad-request ]
- ] cond ;
+ [ (handle-request) serve-responder ] with-scope ;
: parse-request ( request -- )
dup log
diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor
index eaea0d8e5a..2d182d572f 100644
--- a/library/httpd/responder.factor
+++ b/library/httpd/responder.factor
@@ -41,6 +41,7 @@ USE: strings
! Responders are called in a new namespace with these
! variables:
+! - method -- one of get, post, or head.
! - request -- the entire URL requested, including responder
! name
! - raw-query -- raw query string
@@ -64,6 +65,10 @@ USE: strings
[
drop "HEAD method not implemented" httpd-error
] "head" set
+ ( url -- )
+ [
+ drop bad-request
+ ] "bad" set
] extend ;
: get-responder ( name -- responder )
diff --git a/library/platform/jvm/files.factor b/library/platform/jvm/files.factor
index 89f5566865..78a5f6a6bb 100644
--- a/library/platform/jvm/files.factor
+++ b/library/platform/jvm/files.factor
@@ -57,3 +57,6 @@ USE: strings
swap
[ "java.io.File" ] "java.io.File" "renameTo"
jinvoke ;
+
+: file-length ( file -- size )
+ [ ] "java.io.File" "length" jinvoke ;
diff --git a/library/platform/native/files.factor b/library/platform/native/files.factor
index 9d8defbec8..82357a3ce0 100644
--- a/library/platform/native/files.factor
+++ b/library/platform/native/files.factor
@@ -42,3 +42,6 @@ USE: strings
: directory ( dir -- list )
#! List a directory.
(directory) str-sort ;
+
+: file-length ( file -- length )
+ stat dup [ cdr cdr car ] when ;
diff --git a/library/telnetd.factor b/library/telnetd.factor
index 06522e113a..abb9d4102b 100644
--- a/library/telnetd.factor
+++ b/library/telnetd.factor
@@ -27,15 +27,16 @@
IN: telnetd
USE: combinators
-USE: continuations
USE: errors
USE: interpreter
+USE: kernel
USE: logging
USE: logic
USE: namespaces
USE: stack
USE: stdio
USE: streams
+USE: threads
: telnet-client ( socket -- )
dup [
@@ -45,6 +46,14 @@ USE: streams
interpreter-loop
] with-stream ;
+: telnet-connection ( socket -- )
+ #! We don't do multitasking in JFactor.
+ java? [
+ telnet-client
+ ] [
+ [ telnet-client ] in-thread drop
+ ] ifte ;
+
: quit-flag ( -- ? )
global [ "telnetd-quit-flag" get ] bind ;
@@ -55,7 +64,7 @@ USE: streams
[
quit-flag not
] [
- dup >r accept telnet-client r>
+ dup >r accept telnet-connection r>
] while ;
: telnetd ( port -- )
diff --git a/library/test/httpd/httpd.factor b/library/test/httpd/httpd.factor
index 2eb0afd9f7..5338c4bcc0 100644
--- a/library/test/httpd/httpd.factor
+++ b/library/test/httpd/httpd.factor
@@ -7,9 +7,14 @@ USE: namespaces
USE: stdio
USE: test
USE: url-encoding
+USE: strings
+USE: stack
+USE: lists
-[ "HTTP/1.0 404\nContent-Type: text/html\n" ]
-[ "404" "text/html" response ] unit-test
+[ "HTTP/1.0 200 OK\nContent-Length: 12\nContent-Type: text/html\n" ]
+[
+ [ "text/html" 12 file-response ] with-string
+] unit-test
[ 5430 ]
[ f "Content-Length: 5430" header-line content-length ] unit-test