steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

slightly more modular loading of subsystems

cvs
Slava Pestov 2005-05-23 05:18:51 +00:00
parent 1dd70d4e26
commit 03c4704734
11 changed files with 145 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO.FACTOR.txt
View File

@ -7,7 +7,6 @@
<magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup
- single-stepper and variable access: wrong namespace?
- [ over ] generics no-method
- investigate if COPYING_GEN needs a fix
- faster layout
- add a socket timeout

60
library/bootstrap/boot-stage3.factor
View File

@ -73,63 +73,9 @@ t [
"/library/tools/jedit-wire.factor"
"/library/tools/jedit.factor"
"/library/httpd/http-common.factor"
"/library/httpd/mime.factor"
"/library/httpd/html-tags.factor"
"/library/httpd/html.factor"
"/library/httpd/responder.factor"
"/library/httpd/httpd.factor"
"/library/httpd/file-responder.factor"
"/library/httpd/test-responder.factor"
"/library/httpd/resource-responder.factor"
"/library/httpd/cont-responder.factor"
"/library/httpd/browser-responder.factor"
"/library/httpd/default-responders.factor"
"/library/httpd/http-client.factor"
"/library/sdl/sdl.factor"
"/library/sdl/sdl-video.factor"
"/library/sdl/sdl-event.factor"
"/library/sdl/sdl-gfx.factor"
"/library/sdl/sdl-keysym.factor"
"/library/sdl/sdl-keyboard.factor"
"/library/sdl/sdl-ttf.factor"
"/library/sdl/sdl-utils.factor"
"/library/ui/shapes.factor"
"/library/ui/points.factor"
"/library/ui/rectangles.factor"
"/library/ui/lines.factor"
"/library/ui/ellipses.factor"
"/library/ui/gadgets.factor"
"/library/ui/hierarchy.factor"
"/library/ui/paint.factor"
"/library/ui/text.factor"
"/library/ui/gestures.factor"
"/library/ui/hand.factor"
"/library/ui/layouts.factor"
"/library/ui/piles.factor"
"/library/ui/shelves.factor"
"/library/ui/borders.factor"
"/library/ui/stacks.factor"
"/library/ui/frames.factor"
"/library/ui/world.factor"
"/library/ui/labels.factor"
"/library/ui/buttons.factor"
"/library/ui/checkboxes.factor"
"/library/ui/line-editor.factor"
"/library/ui/events.factor"
"/library/ui/scrolling.factor"
"/library/ui/editors.factor"
"/library/ui/menus.factor"
"/library/ui/presentations.factor"
"/library/ui/tiles.factor"
"/library/ui/panes.factor"
"/library/ui/dialogs.factor"
"/library/ui/inspector.factor"
"/library/ui/init-world.factor"
"/library/ui/tool-menus.factor"
"/library/ui/ui.factor"
"/library/httpd/load.factor"
"/library/sdl/load.factor"
"/library/ui/load.factor"
] pull-in
compile? [

2
library/errors.factor
View File

@ -10,7 +10,7 @@ TUPLE: no-method object generic ;
: no-method ( object generic -- )
#! We 2dup here to leave both values on the stack, for
#! post-mortem inspection.
2dup <no-method> throw ;
<no-method> throw ;
! This is a very lightweight exception handling system.

2
library/generic/generic.factor
View File

@ -64,7 +64,7 @@ math-internals ;
: dispatcher% "dispatcher" word-prop % ;
: error-method ( generic -- method )
[ literal, \ no-method , ] make-list ;
[ dup picker% literal, \ no-method , ] make-list ;
: empty-method ( generic -- method )
dup "picker" word-prop [ dup ] = [

68
library/httpd/default-responders.factor
View File

@ -7,40 +7,46 @@ test-responder ;
#! Remove all existing responders, and create a blank
#! responder table.
global [ <namespace> "httpd-responders" set ] bind
global [
<namespace> "httpd-responders" set
! Runs all unit tests and dumps result to the client. This uses
! a lot of server resources, so disable it on a busy server.
<responder> [
"test" "responder" set
[ test-responder ] "get" set
] extend add-responder
! Runs all unit tests and dumps result to the client. This uses
! a lot of server resources, so disable it on a busy server.
<responder> [
"test" "responder" set
[ test-responder ] "get" set
] extend add-responder
! 404 error message pages are served by this guy
<responder> [
"404" "responder" set
[ drop no-such-responder ] "get" set
] extend add-responder
! 404 error message pages are served by this guy
<responder> [
"404" "responder" set
[ drop no-such-responder ] "get" set
] extend add-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.
<responder> [
! "/var/www/" "doc-root" set
"file" "responder" set
[ file-responder ] "get" set
[ file-responder ] "post" set
[ file-responder ] "head" set
] extend add-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.
<responder> [
! "/var/www/" "doc-root" set
"file" "responder" set
[ file-responder ] "get" set
[ file-responder ] "post" set
[ file-responder ] "head" set
] extend add-responder
! Serves Factor source code
<responder> [
"resource" "responder" set
[ resource-responder ] "get" set
] extend add-responder
! Serves Factor source code
<responder> [
"resource" "responder" set
[ resource-responder ] "get" set
] extend add-responder
! Servers Factor word definitions from the image.
"browser" [ f browser-responder ] install-cont-responder
! Servers Factor word definitions from the image.
"browser" [ f browser-responder ] install-cont-responder
! The root directory is served by...
"file" set-default-responder
! The root directory is served by...
"file" set-default-responder
"httpd-vhosts" nest [
<namespace> "default" set
] bind
] bind

15
library/httpd/httpd.factor
View File

@ -26,12 +26,16 @@ stdio streams strings threads http sequences ;
[[ "HEAD" "head" ]]
] assoc [ "bad" ] unless* ;
: (handle-request) ( arg cmd -- url method )
: (handle-request) ( arg cmd -- method path )
request-method dup "method" set swap
prepare-url prepare-header ;
: handle-request ( arg cmd -- )
[ (handle-request) serve-responder ] with-scope ;
[
(handle-request)
"Host" "header" get assoc
serve-responder
] with-scope ;
: parse-request ( request -- )
dup log
@ -59,11 +63,8 @@ stdio streams strings threads http sequences ;
: httpd ( port -- )
<server> "http-server" set [
[
httpd-loop
] [
"http-server" get stream-close rethrow
] catch
[ httpd-loop ]
[ "http-server" get stream-close rethrow ] catch
] with-logging ;
: stop-httpd ( -- )

18
library/httpd/load.factor Normal file
View File

@ -0,0 +1,18 @@
USING: kernel parser sequences stdio ;
[
"/library/httpd/http-common.factor"
"/library/httpd/mime.factor"
"/library/httpd/html-tags.factor"
"/library/httpd/html.factor"
"/library/httpd/responder.factor"
"/library/httpd/httpd.factor"
"/library/httpd/file-responder.factor"
"/library/httpd/test-responder.factor"
"/library/httpd/resource-responder.factor"
"/library/httpd/cont-responder.factor"
"/library/httpd/browser-responder.factor"
"/library/httpd/default-responders.factor"
"/library/httpd/http-client.factor"
] [
dup print run-resource
] each

34
library/httpd/responder.factor
View File

@ -111,16 +111,16 @@ stdio streams strings ;
] "bad" set
] extend ;
: get-responder ( name -- responder )
: vhost ( name -- responder )
"httpd-vhosts" get hash [ "default" vhost ] unless* ;
: responder ( name -- responder )
"httpd-responders" get hash [
"404" "httpd-responders" get hash
] unless* ;
: default-responder ( -- responder )
"default" get-responder ;
: set-default-responder ( name -- )
get-responder "default" "httpd-responders" get set-hash ;
responder "default" "httpd-responders" get set-hash ;
: responder-argument ( argument -- argument )
dup empty? [ drop "default-argument" get ] when ;
@ -129,9 +129,9 @@ stdio streams strings ;
[ responder-argument swap get call ] bind ;
: serve-default-responder ( method url -- )
default-responder call-responder ;
"default" responder call-responder ;
: log-responder ( url -- )
: log-responder ( path -- )
"Calling responder " swap append log ;
: trim-/ ( url -- url )
@ -140,21 +140,23 @@ stdio streams strings ;
: serve-explicit-responder ( method url -- )
"/" split1 dup [
swap get-responder call-responder
swap responder call-responder
] [
! Just a responder name by itself
drop "request" get "/" append redirect drop
] ifte ;
: serve-responder ( method url -- )
#! Responder URLs come in two forms:
#! /foo/bar... - default-responder used
: serve-responder ( method path host -- )
#! Responder paths come in two forms:
#! /foo/bar... - default responder used
#! /responder/foo/bar - responder foo, argument bar
dup log-responder trim-/ "responder/" ?head [
serve-explicit-responder
] [
serve-default-responder
] ifte ;
vhost [
dup log-responder trim-/ "responder/" ?head [
serve-explicit-responder
] [
serve-default-responder
] ifte
] bind ;
: no-such-responder ( -- )
"404 No such responder" httpd-error ;

13
library/sdl/load.factor Normal file
View File

@ -0,0 +1,13 @@
USING: kernel parser sequences stdio ;
[
"/library/sdl/sdl.factor"
"/library/sdl/sdl-video.factor"
"/library/sdl/sdl-event.factor"
"/library/sdl/sdl-gfx.factor"
"/library/sdl/sdl-keysym.factor"
"/library/sdl/sdl-keyboard.factor"
"/library/sdl/sdl-ttf.factor"
"/library/sdl/sdl-utils.factor"
] [
dup print run-resource
] each

9
library/tools/debugger.factor
View File

@ -65,12 +65,9 @@ M: kernel-error error. ( error -- )
} nth execute ;
M: no-method error. ( error -- )
[
"The generic word " ,
dup no-method-generic unparse ,
" does not have a suitable method for " ,
no-method-object unparse ,
] make-string print ;
"No suitable method." print
"Generic word: " write dup no-method-generic .
"Object: " write no-method-object . ;
: parse-dump ( error -- )
"Parsing " write

39
library/ui/load.factor Normal file
View File

@ -0,0 +1,39 @@
USING: kernel parser sequences stdio ;
[
"/library/ui/shapes.factor"
"/library/ui/points.factor"
"/library/ui/rectangles.factor"
"/library/ui/lines.factor"
"/library/ui/ellipses.factor"
"/library/ui/gadgets.factor"
"/library/ui/hierarchy.factor"
"/library/ui/paint.factor"
"/library/ui/text.factor"
"/library/ui/gestures.factor"
"/library/ui/hand.factor"
"/library/ui/layouts.factor"
"/library/ui/piles.factor"
"/library/ui/shelves.factor"
"/library/ui/borders.factor"
"/library/ui/stacks.factor"
"/library/ui/frames.factor"
"/library/ui/world.factor"
"/library/ui/labels.factor"
"/library/ui/buttons.factor"
"/library/ui/checkboxes.factor"
"/library/ui/line-editor.factor"
"/library/ui/events.factor"
"/library/ui/scrolling.factor"
"/library/ui/editors.factor"
"/library/ui/menus.factor"
"/library/ui/presentations.factor"
"/library/ui/tiles.factor"
"/library/ui/panes.factor"
"/library/ui/dialogs.factor"
"/library/ui/inspector.factor"
"/library/ui/init-world.factor"
"/library/ui/tool-menus.factor"
"/library/ui/ui.factor"
] [
dup print run-resource
] each