HTTPD updates and minor help fixes

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 <file>
 
 + 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 <client> 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:
 

contrib/httpd/browser-responder.factor

@@ -1,64 +1,41 @@
 ! Copyright (C) 2004 Chris Double.
-! 
+! See http://factorcode.org/license.txt for BSD license.
-! 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.
-!
 IN: browser-responder
-USING: cont-responder hashtables help html io kernel
+USING: hashtables help html httpd io kernel memory namespaces
-memory namespaces prettyprint sequences words xml ;
+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 = [
+    <option tuck = [ "yes" =selected ] when option>
-        "<option selected>" write
+        chars>entities write
-    ] [
+    </option> ;
-        "<option>" write
-    ] if            
-    chars>entities write 
-    "</option>\n" write drop ;
 
-: vocab-list ( vocab -- )
+: options ( current seq -- ) [ option ] each-with ;
-    #! Write out the HTML for the list of vocabularies. Make the currently 
+
-    #! selected vocab be 'vocab'.
+: list ( current seq name -- )
-    <select "vocab" =name "width: 200px; " =style "20" =size "document.forms.main.submit()" =onchange select> 
+    <select =name "width: 200px;" =style "20" =size "document.forms.main.submit()" =onchange select>
-        vocabs [ over swap option ] each drop
+        options
     </select> ;
 
-: word-list ( vocab word -- )
+: current-vocab ( -- string )
-    #! Write out the HTML for the list of words in a vocabulary. Make the 'word' item
+    "vocab" query-param [ "kernel" ] unless* ;
-    #! the currently selected option.
-    <select "word" =name "width: 200px; " =style "20" =size "document.forms.main.submit()" =onchange select> 
-        swap words natural-sort
-        [ word-name over swap option ] each drop
-    </select> ;
 
-: 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.
     <table "100%" =width table> 
         <tr>
@@ -67,26 +44,25 @@ memory namespaces prettyprint sequences words xml ;
             <th> "Documentation" write </th>
         </tr>
         <tr>    
-            <td "top" =valign "width: 200px;" =style td> over vocab-list </td> 
+            <td "top" =valign "width: 200px;" =style td>
-            <td "top" =valign "width: 200px;" =style td> 2dup word-list </td> 
+                vocab-list
+            </td> 
+            <td "top" =valign "width: 200px;" =style td>
+                word-list
+            </td>
             <td "top" =valign td> word-source </td> 
         </tr>
     </table> ;
 
-: browser-title ( vocab word -- )
+: browser-title ( -- )
-    #! Output the HTML title for the browser.
+    current-word
-    [ "Factor Browser - " % swap % " - " % % ] "" make ;
+    [ synopsis ] [ "IN: " current-vocab append ] if* ;
-
-: browse ( vocab word -- )
-    #! Display a Smalltalk like browser for exploring words.
-    [
-        2dup browser-title dup [
-            <h1> write </h1>
-            <form "main" =name "" =action "get" =method form> browser-body </form>
-        ] html-document
-    ] show-final ;
 
 : browser-responder ( -- )
-    #! Start the Smalltalk-like browser.
+    #! Display a Smalltalk like browser for exploring words.
-    "vocab" "query" get hash [ "browser-responder" ] unless*
+    serving-html browser-title dup [
-    "word" "query" get hash [ "browse" ] unless* browse ;
+        <h1> write </h1>
+        <form "main" =name "" =action "get" =method form>
+            browser-body
+        </form>
+    ] html-document ;

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.

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

contrib/httpd/default-responders.factor

@@ -1,8 +1,9 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
+! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: httpd
-USING: io browser-responder cont-responder file-responder
+USING: browser-responder callback-responder file-responder
-help-responder inspect-responder kernel namespaces prettyprint ;
+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

contrib/httpd/file-responder.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2004,2005 Slava Pestov.
+! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! 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 [
-        "doc-root" get [
+        "argument" get serving-path dup exists? [
-            "argument" get serving-path dup exists? [
+            serve-object
-                serve-object
-            ] [
-                drop "404 not found" httpd-error
-            ] if
         ] [
-            "404 doc-root not set" httpd-error
+            drop "404 not found" httpd-error
         ] if
-    ] (show-final) ;
+    ] [
+        "404 doc-root not set" httpd-error
+    ] if ;

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
+USING: hashtables help html httpd io kernel namespaces sequences ;
-sequences ;
 
-: help-responder ( filename -- )
+: help-topic
-    [
+    "topic" query-param dup empty? [ drop "handbook" ] when ;
-        "topic" "query" get hash
+
-        dup empty? [ drop "handbook" ] when
+: help-responder ( -- )
-        dup article-title
+    serving-html
-        [ [ help ] with-html-stream ] html-document
+    help-topic dup article-title dup [
-    ] show-final ;
+        <h1> write </h1> [ help ] with-html-stream
+    ] html-document ;

contrib/httpd/html-tags.factor

@@ -1,27 +1,7 @@
 ! cont-html v0.6
 !
 ! Copyright (C) 2004 Chris Double.
-! 
+! See http://factorcode.org/license.txt for BSD license.
-! 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.
 
 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 

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
+USING: callback-responder generic hashtables help http inspector
-kernel prototype-js math namespaces sequences strings
+io kernel math namespaces prototype-js sequences strings styles
-styles words xml ;
+words xml ;
 IN: html
 
 : hex-color, ( triplet -- )
@@ -81,23 +81,6 @@ IN: html
         <div =style div> call </div>
     ] 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 [
-        <a file-link-href =href a> call </a>
-    ] [
-        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
     [ <a =href a> call </a> ] [ call ] if* ;
@@ -143,10 +137,8 @@ M: html-stream stream-format ( str style stream -- )
     [
         [
             [
-                [
+                do-escaping stdio get delegate-write
-                    do-escaping stdio get delegate-write
+            ] span-tag
-                ] span-tag
-            ] file-link-tag
         ] object-link-tag
     ] with-stream* ;
 
@@ -158,7 +150,7 @@ M: html-stream stream-format ( str style stream -- )
         <div "padding-left:10px;" =style div>
             with-html-stream
         </div>
-    ] 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 -- )
+    [
+        <table> rot [
+            <tr> [
+                <td>
+                pick pick stdio get with-nested-stream </td>
+            ] each </tr>
+        ] each 2drop </table>
+    ] with-stream* ;
+
 M: html-stream stream-terpri [ <br/> ] with-stream* ;
 
 : default-css ( -- )

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
+USING: callback-responder generic hashtables help html httpd
-kernel namespaces sequences ;
+inspector kernel namespaces sequences ;
 
 ! Mini object inspector
 : http-inspect ( obj -- )
-    "Inspecting " over summary append
+    dup summary [ describe ] simple-html-document ;
-    [ 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 ;

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"

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 -- )

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
+USING: arrays hashtables html http io kernel math namespaces
-parser sequences io strings ;
+parser sequences strings ;
 
 ! Variables
 SYMBOL: vhosts
@@ -15,7 +15,7 @@ SYMBOL: responders
     "HTTP/1.0 " write print print-header ;
 
 : error-body ( error -- body )
-    "<html><body><h1>" swap "</h1></body></html>" append3 print ;
+    <html> <body> <h1> write </h1> </body> </html> ;
 
 : 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 -- )

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" <pathname> browser-link-href
     ] with-scope
 ] unit-test
 

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 ;

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) ;

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

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 ( -- )

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." } ;

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? [
+    link-name dup word? [ word-help ] [ help ] if ;
-        { $definition } swap add add
-    ] [
-        drop
-    ] if (help) ;
 
 : show-help ( link help -- )
     dup add-history [ set-help-gadget-showing ] 2keep