more sequence code fixes for cont-responder examples
parent
3ecf223a68
commit
93f4088747
|
|
@ -34,6 +34,7 @@ USE: math
|
||||||
USE: namespaces
|
USE: namespaces
|
||||||
USE: prettyprint
|
USE: prettyprint
|
||||||
USE: unparser
|
USE: unparser
|
||||||
|
USE: sequences
|
||||||
|
|
||||||
: display-page ( title -- )
|
: display-page ( title -- )
|
||||||
#! Display a page with some text to test the cont-responder.
|
#! Display a page with some text to test the cont-responder.
|
||||||
|
|
@ -66,7 +67,7 @@ USE: unparser
|
||||||
|
|
||||||
: test-cont-responder2 ( - )
|
: test-cont-responder2 ( - )
|
||||||
#! Test the cont-responder responder by displaying a few pages in a loop.
|
#! Test the cont-responder responder by displaying a few pages in a loop.
|
||||||
[ "one" "two" "three" "four" ] [ display-page [ .s ] with-string-stream display-page ] each
|
[ "one" "two" "three" "four" ] [ display-page [ .s ] with-string display-page ] each
|
||||||
"Done!" display-page ;
|
"Done!" display-page ;
|
||||||
|
|
||||||
: test-cont-responder3 ( - )
|
: test-cont-responder3 ( - )
|
||||||
|
|
@ -78,7 +79,7 @@ USE: unparser
|
||||||
"Menu" [
|
"Menu" [
|
||||||
<ol>
|
<ol>
|
||||||
<li> "Test responder1" [ test-cont-responder ] quot-href </li>
|
<li> "Test responder1" [ test-cont-responder ] quot-href </li>
|
||||||
<li> "Test responder2" [ [ .s ] with-string-stream display-page test-cont-responder2 [ .s ] with-string-stream display-page ] quot-href </li>
|
<li> "Test responder2" [ [ .s ] with-string display-page test-cont-responder2 [ .s ] with-string display-page ] quot-href </li>
|
||||||
</ol>
|
</ol>
|
||||||
] html-document
|
] html-document
|
||||||
] show drop ;
|
] show drop ;
|
||||||
|
|
|
||||||
|
|
@ -73,7 +73,7 @@ USE: sequences
|
||||||
: escape-quotes ( string -- string )
|
: escape-quotes ( string -- string )
|
||||||
#! Replace occurrences of single quotes with
|
#! Replace occurrences of single quotes with
|
||||||
#! backslash quote.
|
#! backslash quote.
|
||||||
[ dup [ [[ CHAR: ' "\\'" ]] [[ CHAR: " "\\\"" ]] ] assoc dup rot ? ] string-map ;
|
[ dup [ [[ CHAR: ' "\\'" ]] [[ CHAR: " "\\\"" ]] ] assoc dup rot ? ] map ;
|
||||||
|
|
||||||
: make-eval-javascript ( string -- string )
|
: make-eval-javascript ( string -- string )
|
||||||
#! Give a string return some javascript that when
|
#! Give a string return some javascript that when
|
||||||
|
|
@ -88,7 +88,7 @@ USE: sequences
|
||||||
#! Write out html to display the stack.
|
#! Write out html to display the stack.
|
||||||
<table border= "1" table>
|
<table border= "1" table>
|
||||||
<tr> <th> "Callstack" write </th> </tr>
|
<tr> <th> "Callstack" write </th> </tr>
|
||||||
[ <tr> <td> [ unparse write ] with-string-stream write-eval-link </td> </tr> ] each
|
[ <tr> <td> [ unparse write ] with-string write-eval-link </td> </tr> ] each
|
||||||
</table> ;
|
</table> ;
|
||||||
|
|
||||||
: display-clear-history-link ( -- )
|
: display-clear-history-link ( -- )
|
||||||
|
|
@ -190,12 +190,11 @@ USE: sequences
|
||||||
#! Evaluate expression using 'list' as the current callstack.
|
#! Evaluate expression using 'list' as the current callstack.
|
||||||
#! All output should go to a string which is returned on the
|
#! All output should go to a string which is returned on the
|
||||||
#! callstack along with the resulting datastack as a list.
|
#! callstack along with the resulting datastack as a list.
|
||||||
<namespace> [
|
[
|
||||||
"browser" "responder" set
|
"browser" "responder" set
|
||||||
1024 <string-output> dup >r <html-stream> [
|
stdio [ <html-stream> ] change
|
||||||
do-eval
|
do-eval
|
||||||
] with-stream r> stream>str
|
] with-string ;
|
||||||
] bind ;
|
|
||||||
|
|
||||||
: forever ( quot -- )
|
: forever ( quot -- )
|
||||||
#! The code is evaluated in an infinite loop. Typically, a
|
#! The code is evaluated in an infinite loop. Typically, a
|
||||||
|
|
|
||||||
|
|
@ -41,6 +41,7 @@ USE: prettyprint
|
||||||
USE: todo
|
USE: todo
|
||||||
USE: math
|
USE: math
|
||||||
USE: kernel
|
USE: kernel
|
||||||
|
USE: sequences
|
||||||
|
|
||||||
: todo-stylesheet ( -- string )
|
: todo-stylesheet ( -- string )
|
||||||
#! Return the stylesheet for the todo list
|
#! Return the stylesheet for the todo list
|
||||||
|
|
@ -114,7 +115,7 @@ USE: kernel
|
||||||
|
|
||||||
: show-stack-page ( -- )
|
: show-stack-page ( -- )
|
||||||
#! Debug function to show a page containing the current call stack.
|
#! Debug function to show a page containing the current call stack.
|
||||||
[ .s ] with-string-stream chars>entities show-message-page ;
|
[ .s ] with-string chars>entities show-message-page ;
|
||||||
|
|
||||||
: row ( list -- )
|
: row ( list -- )
|
||||||
#! Output an html TR row with each element of the list
|
#! Output an html TR row with each element of the list
|
||||||
|
|
@ -208,7 +209,7 @@ USE: kernel
|
||||||
] [
|
] [
|
||||||
drop CHAR: _
|
drop CHAR: _
|
||||||
] ifte
|
] ifte
|
||||||
] string-map ;
|
] map ;
|
||||||
|
|
||||||
: is-valid-username? ( username -- bool )
|
: is-valid-username? ( username -- bool )
|
||||||
#! Return true if the username parses correctly
|
#! Return true if the username parses correctly
|
||||||
|
|
@ -334,11 +335,11 @@ USE: kernel
|
||||||
: priority-valid? ( string -- bool )
|
: priority-valid? ( string -- bool )
|
||||||
#! Test the string containing a priority to see if it is
|
#! Test the string containing a priority to see if it is
|
||||||
#! valid. It should be a single digit from 0-9.
|
#! valid. It should be a single digit from 0-9.
|
||||||
dup string-length 1 = [ 0 swap string-nth digit? ] [ drop f ] ifte ;
|
dup length 1 = [ 0 swap string-nth digit? ] [ drop f ] ifte ;
|
||||||
|
|
||||||
: todo-details-valid? ( priority description -- bool )
|
: todo-details-valid? ( priority description -- bool )
|
||||||
#! Return true if a valid priority and description were entered.
|
#! Return true if a valid priority and description were entered.
|
||||||
string-length 0 > [ priority-valid? ] [ drop f ] ifte ;
|
length 0 > [ priority-valid? ] [ drop f ] ifte ;
|
||||||
|
|
||||||
: get-new-todo-item ( -- <todo-item> )
|
: get-new-todo-item ( -- <todo-item> )
|
||||||
#! Enter a new item to the current todo list.
|
#! Enter a new item to the current todo list.
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue