From 65680737ca84c6f8d38b9b4abb8ab61eec92d6e8 Mon Sep 17 00:00:00 2001 From: slava Date: Thu, 15 Jun 2006 05:21:16 +0000 Subject: [PATCH] HTTPD updates and minor help fixes --- TODO.FACTOR.txt | 9 +- contrib/httpd/browser-responder.factor | 108 +++++++++--------------- contrib/httpd/cont-responder.factor | 2 +- contrib/httpd/darcs-responder.factor | 4 +- contrib/httpd/default-responders.factor | 24 +++--- contrib/httpd/file-responder.factor | 22 +++-- contrib/httpd/help-responder.factor | 18 ++-- contrib/httpd/html-tags.factor | 24 +----- contrib/httpd/html.factor | 52 ++++++------ contrib/httpd/inspect-responder.factor | 11 ++- contrib/httpd/load.factor | 1 + contrib/httpd/prototype-js.factor | 5 +- contrib/httpd/responder.factor | 14 ++- contrib/httpd/test/html.factor | 2 +- library/bootstrap/init.factor | 2 +- library/help/word-help.factor | 3 + library/test/benchmark/help.factor | 4 +- library/threads.factor | 2 +- library/tools/describe.facts | 8 +- library/ui/tools/help.factor | 6 +- 20 files changed, 144 insertions(+), 177 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 055a657fb7..6a87eb119e 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,11 +1,4 @@ - if a primitive throws an error, :c doesn't show the call frame there -- "benchmark/help": without a yield UI runs out of memory - -+ httpd: - - outliners don't work - - browser responder doesn't work - - fix remaining HTML stream issues - - update for file style prop becoming presented + io: @@ -13,7 +6,6 @@ - factorcode httpd started using 99% CPU, but still received connections; closing read-fds solved it - gdb triggers 'mutliple i/o ops on port' error -- better i/o scheduler - eg, yield in a loop starves i/o - "localhost" 50 won't fail + help: @@ -26,6 +18,7 @@ - edit distance algorithm - store positions in index - phrase scoring algorithm based on how close the terms occur? +- fix remaining HTML stream issues + ui: diff --git a/contrib/httpd/browser-responder.factor b/contrib/httpd/browser-responder.factor index de26cdafbd..3d460fa4d7 100644 --- a/contrib/httpd/browser-responder.factor +++ b/contrib/httpd/browser-responder.factor @@ -1,64 +1,41 @@ ! Copyright (C) 2004 Chris Double. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! A Smalltalk-like browser that runs in the httpd server using -! cont-responder facilities. -! +! See http://factorcode.org/license.txt for BSD license. IN: browser-responder -USING: cont-responder hashtables help html io kernel -memory namespaces prettyprint sequences words xml ; +USING: hashtables help html httpd io kernel memory namespaces +prettyprint sequences words xml ; : option ( current text -- ) #! Output the HTML option tag for the given text. If #! it is equal to the current string, make the option selected. - 2dup = [ - "\n" write drop ; + ; -: vocab-list ( vocab -- ) - #! Write out the HTML for the list of vocabularies. Make the currently - #! selected vocab be 'vocab'. - + options ; -: word-list ( vocab word -- ) - #! Write out the HTML for the list of words in a vocabulary. Make the 'word' item - #! the currently selected option. - ; +: current-vocab ( -- string ) + "vocab" query-param [ "kernel" ] unless* ; -: word-source ( vocab word -- ) +: current-word ( -- word ) + "word" query-param "vocab" query-param lookup ; + +: vocab-list ( -- ) + current-vocab vocabs "vocab" list ; + +: word-list ( -- ) + current-word [ word-name ] [ f ] if* + current-vocab vocab hash-keys natural-sort "word" list ; + +: word-source ( -- ) #! Write the source for the given word from the vocab as HTML. - swap lookup [ [ help ] with-html-stream ] when* ; + current-word [ [ word-help ] with-html-stream ] when* ; -: browser-body ( vocab word -- ) +: browser-body ( -- ) #! Write out the HTML for the body of the main browser page. @@ -67,26 +44,25 @@ memory namespaces prettyprint sequences words xml ; - - + +
"Documentation" write
over vocab-list 2dup word-list + vocab-list + + word-list + word-source
; -: browser-title ( vocab word -- ) - #! Output the HTML title for the browser. - [ "Factor Browser - " % swap % " - " % % ] "" make ; - -: browse ( vocab word -- ) - #! Display a Smalltalk like browser for exploring words. - [ - 2dup browser-title dup [ -

write

-
browser-body
- ] html-document - ] show-final ; +: browser-title ( -- ) + current-word + [ synopsis ] [ "IN: " current-vocab append ] if* ; : browser-responder ( -- ) - #! Start the Smalltalk-like browser. - "vocab" "query" get hash [ "browser-responder" ] unless* - "word" "query" get hash [ "browse" ] unless* browse ; + #! Display a Smalltalk like browser for exploring words. + serving-html browser-title dup [ +

write

+
+ browser-body +
+ ] html-document ; diff --git a/contrib/httpd/cont-responder.factor b/contrib/httpd/cont-responder.factor index cbf6d56888..4dc7d9c228 100644 --- a/contrib/httpd/cont-responder.factor +++ b/contrib/httpd/cont-responder.factor @@ -257,7 +257,7 @@ SYMBOL: root-continuation : id-or-root ( -- id ) #! Return the continuation id for the current requested continuation #! or the root continuation if no id is supplied. - "id" "query" get hash [ root-continuation get ] unless* ; + "id" query-param [ root-continuation get ] unless* ; : cont-get/post-responder ( id-or-f -- ) #! httpd responder that retrieves a continuation and calls it. diff --git a/contrib/httpd/darcs-responder.factor b/contrib/httpd/darcs-responder.factor index c9fd849b60..537d301855 100644 --- a/contrib/httpd/darcs-responder.factor +++ b/contrib/httpd/darcs-responder.factor @@ -1,4 +1,4 @@ -USING: cont-responder io kernel namespaces sequences xml ; +USING: httpd io kernel namespaces sequences xml ; SYMBOL: darcs-directory @@ -53,4 +53,4 @@ SYMBOL: rss-feed-description : darcs-rss-feed darcs-changelog changelog>rss-feed print ; -"darcs" [ darcs-rss-feed ] install-cont-responder +"darcs" [ darcs-rss-feed ] add-simple-responder diff --git a/contrib/httpd/default-responders.factor b/contrib/httpd/default-responders.factor index e60f0225dc..5767d3be23 100644 --- a/contrib/httpd/default-responders.factor +++ b/contrib/httpd/default-responders.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! Copyright (C) 2004, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. IN: httpd -USING: io browser-responder cont-responder file-responder -help-responder inspect-responder kernel namespaces prettyprint ; +USING: browser-responder callback-responder file-responder +help-responder inspect-responder io kernel namespaces +prettyprint ; #! Remove all existing responders, and create a blank #! responder table. @@ -10,10 +11,13 @@ global [ H{ } clone responders set ! 404 error message pages are served by this guy - "404" [ no-such-responder ] install-cont-responder + "404" [ no-such-responder ] add-simple-responder ! Online help browsing - "help" [ help-responder ] install-cont-responder + "help" [ help-responder ] add-simple-responder + + ! Used by other responders + "callback" [ callback-responder ] add-simple-responder ! Javascript source used by ajax libraries "javascript" [ @@ -22,18 +26,18 @@ global [ "doc-root" set file-responder ] with-scope - ] install-cont-responder + ] add-simple-responder ! Global variables - "inspector" [ inspect-responder ] install-cont-responder + "inspector" [ inspect-responder ] add-simple-responder ! Servers Factor word definitions from the image. - "browser" [ browser-responder ] install-cont-responder + "browser" [ browser-responder ] 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. - "file" [ file-responder ] install-cont-responder + "file" [ file-responder ] add-simple-responder ! The root directory is served by... "file" set-default-responder diff --git a/contrib/httpd/file-responder.factor b/contrib/httpd/file-responder.factor index f8c054f22a..f22b49b3c6 100644 --- a/contrib/httpd/file-responder.factor +++ b/contrib/httpd/file-responder.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2004,2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! Copyright (C) 2004, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. IN: file-responder -USING: cont-responder html httpd io kernel math namespaces +USING: html httpd io kernel math namespaces parser sequences strings ; : serving-path ( filename -- filename ) @@ -50,14 +50,12 @@ parser sequences strings ; dup directory? [ serve-directory ] [ serve-file ] if ; : file-responder ( -- ) - [ - "doc-root" get [ - "argument" get serving-path dup exists? [ - serve-object - ] [ - drop "404 not found" httpd-error - ] if + "doc-root" get [ + "argument" get serving-path dup exists? [ + serve-object ] [ - "404 doc-root not set" httpd-error + drop "404 not found" httpd-error ] if - ] (show-final) ; + ] [ + "404 doc-root not set" httpd-error + ] if ; diff --git a/contrib/httpd/help-responder.factor b/contrib/httpd/help-responder.factor index 3094543d0f..ac1772d83b 100644 --- a/contrib/httpd/help-responder.factor +++ b/contrib/httpd/help-responder.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: help-responder -USING: cont-responder hashtables help html kernel namespaces -sequences ; +USING: hashtables help html httpd io kernel namespaces sequences ; -: help-responder ( filename -- ) - [ - "topic" "query" get hash - dup empty? [ drop "handbook" ] when - dup article-title - [ [ help ] with-html-stream ] html-document - ] show-final ; +: help-topic + "topic" query-param dup empty? [ drop "handbook" ] when ; + +: help-responder ( -- ) + serving-html + help-topic dup article-title dup [ +

write

[ help ] with-html-stream + ] html-document ; diff --git a/contrib/httpd/html-tags.factor b/contrib/httpd/html-tags.factor index 5aef485737..db7e7f3313 100644 --- a/contrib/httpd/html-tags.factor +++ b/contrib/httpd/html-tags.factor @@ -1,27 +1,7 @@ ! cont-html v0.6 ! ! Copyright (C) 2004 Chris Double. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! See http://factorcode.org/license.txt for BSD license. IN: html USE: prettyprint @@ -171,5 +151,5 @@ SYMBOL: html "size" "href" "class" "border" "rows" "cols" "id" "onclick" "style" "valign" "accesskey" "src" "language" "colspan" "onchange" "rel" - "width" + "width" "selected" ] [ define-attribute-word ] each diff --git a/contrib/httpd/html.factor b/contrib/httpd/html.factor index 88a302980f..175815835f 100644 --- a/contrib/httpd/html.factor +++ b/contrib/httpd/html.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: cont-responder generic hashtables help http inspector io -kernel prototype-js math namespaces sequences strings -styles words xml ; +USING: callback-responder generic hashtables help http inspector +io kernel math namespaces prototype-js sequences strings styles +words xml ; IN: html : hex-color, ( triplet -- ) @@ -81,23 +81,6 @@ IN: html
call
] if ; -: resolve-file-link ( path -- link ) - #! The file responder needs relative links not absolute - #! links. - "doc-root" get [ - ?head [ "/" ?head drop ] when - ] when* "/" ?tail drop ; - -: file-link-href ( path -- href ) - [ "/" % resolve-file-link url-encode % ] "" make ; - -: file-link-tag ( style quot -- ) - over file swap hash [ - call - ] [ - call - ] if* ; - : do-escaping ( string style -- string ) html swap hash [ chars>entities ] unless ; @@ -117,6 +100,17 @@ M: link browser-link-href "/responder/help/" swap "topic" associate build-url ] if ; +: resolve-file-link ( path -- link ) + #! The file responder needs relative links not absolute + #! links. + "doc-root" get [ + ?head [ "/" ?head drop ] when + ] when* "/" ?tail drop ; + +M: pathname browser-link-href + pathname-string + "/" swap resolve-file-link url-encode append ; + : object-link-tag ( style quot -- ) presented pick hash browser-link-href [ call ] [ call ] if* ; @@ -143,10 +137,8 @@ M: html-stream stream-format ( str style stream -- ) [ [ [ - [ - do-escaping stdio get delegate-write - ] span-tag - ] file-link-tag + do-escaping stdio get delegate-write + ] span-tag ] object-link-tag ] with-stream* ; @@ -158,7 +150,7 @@ M: html-stream stream-format ( str style stream -- )
with-html-stream
- ] curry [ , \ show-final , ] [ ] make ; + ] curry ; : html-outliner ( caption contents -- ) "+ " get-random-id dup >r @@ -179,6 +171,16 @@ M: html-stream with-nested-stream ( quot style stream -- ) ] outliner-tag ] with-stream* ; +M: html-stream with-stream-table ( grid quot style stream -- ) + [ + rot [ + [ + + ] each + ] each 2drop
+ pick pick stdio get with-nested-stream
+ ] with-stream* ; + M: html-stream stream-terpri [
] with-stream* ; : default-css ( -- ) diff --git a/contrib/httpd/inspect-responder.factor b/contrib/httpd/inspect-responder.factor index e1217cd3cc..5b821b376e 100644 --- a/contrib/httpd/inspect-responder.factor +++ b/contrib/httpd/inspect-responder.factor @@ -1,16 +1,15 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: inspect-responder -USING: cont-responder generic hashtables help html inspector -kernel namespaces sequences ; +USING: callback-responder generic hashtables help html httpd +inspector kernel namespaces sequences ; ! Mini object inspector : http-inspect ( obj -- ) - "Inspecting " over summary append - [ describe ] simple-html-document ; + dup summary [ describe ] simple-html-document ; M: general-t browser-link-href - [ [ http-inspect ] show-final ] curry quot-url ; + [ http-inspect ] curry t register-html-callback ; : inspect-responder ( url -- ) - [ global http-inspect ] show-final ; + serving-html global http-inspect ; diff --git a/contrib/httpd/load.factor b/contrib/httpd/load.factor index 7af1b24c54..431912e83c 100644 --- a/contrib/httpd/load.factor +++ b/contrib/httpd/load.factor @@ -9,6 +9,7 @@ USING: words kernel parser sequences io compiler ; "responder" "httpd" "cont-responder" + "callback-responder" "prototype-js" "html" "file-responder" diff --git a/contrib/httpd/prototype-js.factor b/contrib/httpd/prototype-js.factor index 5cbc835165..968f04afd4 100644 --- a/contrib/httpd/prototype-js.factor +++ b/contrib/httpd/prototype-js.factor @@ -5,7 +5,8 @@ ! For information and license details for protoype ! see http://prototype.conio.net IN: prototype-js -USING: io httpd cont-responder html kernel namespaces strings ; +USING: callback-responder html httpd io kernel namespaces +strings ; : include-prototype-js ( -- ) #! Write out the HTML script tag to include the prototype @@ -16,7 +17,7 @@ USING: io httpd cont-responder html kernel namespaces strings ; : updating-javascript ( id quot -- string ) #! Return the javascript code to perform the updating #! ajax call. - quot-url swap + t register-html-callback swap [ "new Ajax.Updater(\"" % % "\",\"" % % "\", { method: \"get\" });" % ] "" make ; : updating-anchor ( text id quot -- ) diff --git a/contrib/httpd/responder.factor b/contrib/httpd/responder.factor index 8758452585..259ed0852c 100644 --- a/contrib/httpd/responder.factor +++ b/contrib/httpd/responder.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: httpd -USING: arrays hashtables http kernel math namespaces -parser sequences io strings ; +USING: arrays hashtables html http io kernel math namespaces +parser sequences strings ; ! Variables SYMBOL: vhosts @@ -15,7 +15,7 @@ SYMBOL: responders "HTTP/1.0 " write print print-header ; : error-body ( error -- body ) - "

" swap "

" append3 print ; +

write

; : error-head ( error -- ) dup log-error @@ -91,10 +91,18 @@ SYMBOL: responders ! - header -- a hashtable of headers from the user's client ! - response -- a hashtable of the POST request response +: query-param ( key -- value ) "query" get hash ; + : add-responder ( responder -- ) #! Add a responder object to the list. "responder" over hash responders get set-hash ; +: add-simple-responder ( name quot -- ) + [ + [ drop ] swap append dup "get" set "post" set + "responder" set + ] make-hash add-responder ; + : make-responder ( quot -- responder ) [ ( url -- ) diff --git a/contrib/httpd/test/html.factor b/contrib/httpd/test/html.factor index a1fc1aec63..aca595ce67 100644 --- a/contrib/httpd/test/html.factor +++ b/contrib/httpd/test/html.factor @@ -15,7 +15,7 @@ USING: html http io kernel namespaces styles test xml ; [ [ "/home/slava/doc/" "doc-root" set - "/home/slava/doc/foo/bar" file-link-href + "/home/slava/doc/foo/bar" browser-link-href ] with-scope ] unit-test diff --git a/library/bootstrap/init.factor b/library/bootstrap/init.factor index 996d505ec2..858a3778b5 100644 --- a/library/bootstrap/init.factor +++ b/library/bootstrap/init.factor @@ -9,10 +9,10 @@ parser threads words ; init-namespaces cell \ cell set millis init-random - init-threads init-io "HOME" os-env [ "." ] unless* "~" set init-error-handler + init-threads default-cli-args parse-command-line "null-stdio" get [ stdio off ] when ; diff --git a/library/help/word-help.factor b/library/help/word-help.factor index 4ef7fd15cc..38a1c704c5 100644 --- a/library/help/word-help.factor +++ b/library/help/word-help.factor @@ -19,3 +19,6 @@ M: word article-content ] when* ] ?if ] { } make ; + +: word-help ( word -- ) + dup article-content { $definition } rot add add (help) ; diff --git a/library/test/benchmark/help.factor b/library/test/benchmark/help.factor index 2a5f018f40..b405c7f3b2 100644 --- a/library/test/benchmark/help.factor +++ b/library/test/benchmark/help.factor @@ -3,9 +3,9 @@ sequences test threads words ; [ all-articles [ - ! stdio get pane-clear + stdio get pane-clear dup global [ . flush ] bind [ dup help ] assert-depth drop - 1 sleep + yield ] each ] time diff --git a/library/threads.factor b/library/threads.factor index bd5b884701..f30b378616 100644 --- a/library/threads.factor +++ b/library/threads.factor @@ -54,7 +54,7 @@ namespaces queues sequences vectors ; : (idle-thread) ( fast? -- ) #! If fast, then we don't sleep, just select() sleep-queue* dup sleep-time dup zero? - [ drop pop second schedule-thread ] + [ drop pop second schedule-thread drop ] [ nip 0 ? io-multiplex ] if ; : idle-thread ( -- ) diff --git a/library/tools/describe.facts b/library/tools/describe.facts index fc910f7c64..92b9cf150d 100644 --- a/library/tools/describe.facts +++ b/library/tools/describe.facts @@ -29,5 +29,11 @@ HELP: callstack. "( seq -- )" { $values { "seq" "a sequence" } } { $description "Displays a sequence output by " { $link callstack } " in a nice way, by highlighting the current execution point in every call frame." } ; +HELP: .c "( -- )" +{ $description "Displays the contents of the call stack, with the top of the stack printed first." } ; + HELP: .r "( -- )" -{ $description "Displays the contents of the return stack, with the top of the stack printed first." } ; +{ $description "Displays the contents of the retain stack, with the top of the stack printed first." } ; + +HELP: .s "( -- )" +{ $description "Displays the contents of the data stack, with the top of the stack printed first." } ; diff --git a/library/ui/tools/help.factor b/library/ui/tools/help.factor index cddbf24950..1e071f957d 100644 --- a/library/ui/tools/help.factor +++ b/library/ui/tools/help.factor @@ -50,11 +50,7 @@ M: help-gadget focusable-child* [ over history-seq push-new update-history ] [ 2drop ] if ; : fancy-help ( obj -- ) - link-name dup article-content swap dup word? [ - { $definition } swap add add - ] [ - drop - ] if (help) ; + link-name dup word? [ word-help ] [ help ] if ; : show-help ( link help -- ) dup add-history [ set-help-gadget-showing ] 2keep