HTTPD updates and minor help fixes
slava
parent
b4bff0a33d
commit
65680737ca
|
|
@ -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:
|
||||
|
||||
|
|
|
|||
|
|
@ -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 = [
|
||||
"<option selected>" write
|
||||
] [
|
||||
"<option>" write
|
||||
] if
|
||||
chars>entities write
|
||||
"</option>\n" write drop ;
|
||||
<option tuck = [ "yes" =selected ] when option>
|
||||
chars>entities write
|
||||
</option> ;
|
||||
|
||||
: vocab-list ( vocab -- )
|
||||
#! Write out the HTML for the list of vocabularies. Make the currently
|
||||
#! selected vocab be 'vocab'.
|
||||
<select "vocab" =name "width: 200px; " =style "20" =size "document.forms.main.submit()" =onchange select>
|
||||
vocabs [ over swap option ] each drop
|
||||
: options ( current seq -- ) [ option ] each-with ;
|
||||
|
||||
: list ( current seq name -- )
|
||||
<select =name "width: 200px;" =style "20" =size "document.forms.main.submit()" =onchange select>
|
||||
options
|
||||
</select> ;
|
||||
|
||||
: word-list ( vocab word -- )
|
||||
#! Write out the HTML for the list of words in a vocabulary. Make the 'word' item
|
||||
#! 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> ;
|
||||
: 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.
|
||||
<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> 2dup word-list </td>
|
||||
<td "top" =valign "width: 200px;" =style 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 -- )
|
||||
#! 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 [
|
||||
<h1> write </h1>
|
||||
<form "main" =name "" =action "get" =method form> browser-body </form>
|
||||
] 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 [
|
||||
<h1> write </h1>
|
||||
<form "main" =name "" =action "get" =method form>
|
||||
browser-body
|
||||
</form>
|
||||
] html-document ;
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 [
|
||||
<h1> write </h1> [ help ] with-html-stream
|
||||
] html-document ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
|||
<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
|
||||
] 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 -- )
|
|||
<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 ( -- )
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -9,6 +9,7 @@ USING: words kernel parser sequences io compiler ;
|
|||
"responder"
|
||||
"httpd"
|
||||
"cont-responder"
|
||||
"callback-responder"
|
||||
"prototype-js"
|
||||
"html"
|
||||
"file-responder"
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
"<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 -- )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -19,3 +19,6 @@ M: word article-content
|
|||
] when*
|
||||
] ?if
|
||||
] { } make ;
|
||||
|
||||
: word-help ( word -- )
|
||||
dup article-content { $definition } rot add add (help) ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ( -- )
|
||||
|
|
|
|||
|
|
@ -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." } ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue