From 03c4704734ebf6d16975e93d4583fa4d17307fd8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 May 2005 05:18:51 +0000 Subject: [PATCH] slightly more modular loading of subsystems --- TODO.FACTOR.txt | 1 - library/bootstrap/boot-stage3.factor | 60 +------------------ library/errors.factor | 2 +- library/generic/generic.factor | 2 +- library/httpd/default-responders.factor | 76 +++++++++++++------------ library/httpd/httpd.factor | 15 ++--- library/httpd/load.factor | 18 ++++++ library/httpd/responder.factor | 34 +++++------ library/sdl/load.factor | 13 +++++ library/tools/debugger.factor | 9 +-- library/ui/load.factor | 39 +++++++++++++ 11 files changed, 145 insertions(+), 124 deletions(-) create mode 100644 library/httpd/load.factor create mode 100644 library/sdl/load.factor create mode 100644 library/ui/load.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 63ae9902b7..332b23817d 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -7,7 +7,6 @@ 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 diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor index 70a3ff82a5..648cc41814 100644 --- a/library/bootstrap/boot-stage3.factor +++ b/library/bootstrap/boot-stage3.factor @@ -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? [ diff --git a/library/errors.factor b/library/errors.factor index 49d40d9d13..f29bcbb3e5 100644 --- a/library/errors.factor +++ b/library/errors.factor @@ -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 throw ; + throw ; ! This is a very lightweight exception handling system. diff --git a/library/generic/generic.factor b/library/generic/generic.factor index bee7856685..98cf90f41e 100644 --- a/library/generic/generic.factor +++ b/library/generic/generic.factor @@ -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 ] = [ diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor index bb67c9f7ad..53fe5226ab 100644 --- a/library/httpd/default-responders.factor +++ b/library/httpd/default-responders.factor @@ -7,40 +7,46 @@ test-responder ; #! Remove all existing responders, and create a blank #! responder table. -global [ "httpd-responders" set ] bind +global [ + "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. - [ - "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. + [ + "test" "responder" set + [ test-responder ] "get" set + ] extend add-responder + + ! 404 error message pages are served by this guy + [ + "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. + [ + ! "/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 + [ + "resource" "responder" set + [ resource-responder ] "get" set + ] extend add-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 -! 404 error message pages are served by this guy - [ - "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. - [ - ! "/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 - [ - "resource" "responder" set - [ resource-responder ] "get" set -] extend add-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 + "httpd-vhosts" nest [ + "default" set + ] bind +] bind diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor index 7b159d8bb5..5b814a814f 100644 --- a/library/httpd/httpd.factor +++ b/library/httpd/httpd.factor @@ -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 -- ) "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 ( -- ) diff --git a/library/httpd/load.factor b/library/httpd/load.factor new file mode 100644 index 0000000000..33aefd0ce6 --- /dev/null +++ b/library/httpd/load.factor @@ -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 diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor index e1a676b899..aeb2faa619 100644 --- a/library/httpd/responder.factor +++ b/library/httpd/responder.factor @@ -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 ; diff --git a/library/sdl/load.factor b/library/sdl/load.factor new file mode 100644 index 0000000000..af12c572d8 --- /dev/null +++ b/library/sdl/load.factor @@ -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 diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index 9174b933a9..02b59e73bc 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -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 diff --git a/library/ui/load.factor b/library/ui/load.factor new file mode 100644 index 0000000000..d3e3c24033 --- /dev/null +++ b/library/ui/load.factor @@ -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