more sequence code fixes for cont-responder examples

cvs
Chris Double 2005-04-30 04:15:12 +00:00
parent 3ecf223a68
commit 93f4088747
3 changed files with 15 additions and 14 deletions

View File

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

View File

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

View File

@ -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.