Some changes to get things working in native factor.

cvs
Chris Double 2004-08-08 05:29:01 +00:00
parent 73d57549f0
commit 9f052b3c82
3 changed files with 18 additions and 16 deletions

View File

@ -33,6 +33,7 @@ USE: strings
USE: arithmetic USE: arithmetic
USE: namespaces USE: namespaces
USE: prettyprint USE: prettyprint
USE: unparser
: 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.
@ -90,8 +91,8 @@ USE: prettyprint
[ [
#! And we don't need the 'url' argument #! And we don't need the 'url' argument
drop drop
"Counter: " over cat2 [ "Counter: " over unparse cat2 [
dup <h2> write </h2> dup <h2> unparse write </h2>
"++" over unit [ f ] swap append [ 1 + counter-example ] append quot-href "++" over unit [ f ] swap append [ 1 + counter-example ] append quot-href
"--" over unit [ f ] swap append [ 1 - counter-example ] append quot-href "--" over unit [ f ] swap append [ 1 - counter-example ] append quot-href
drop drop
@ -106,17 +107,17 @@ USE: prettyprint
[ [
#! We don't need the 'url' argument #! We don't need the 'url' argument
drop drop
"Counter: " "counter" get cat2 [ "Counter: " "counter" get unparse cat2 [
<h2> "counter" get write </h2> <h2> "counter" get unparse write </h2>
"++" [ "counter" get 1 + "counter" set ] quot-href "++" [ "counter" get 1 + "counter" set ] quot-href
"--" [ "counter" get 1 - "counter" set ] quot-href "--" [ "counter" get 1 - "counter" set ] quot-href
] html-document ] html-document
] show ] show
drop ; drop ;
#! Install the examples ! Install the examples
"counter1" [ drop 0 counter-example ] install-cont-responder "counter1" [ drop 0 counter-example ] install-cont-responder
"counter2" [ drop counter-example2 ] install-cont-responder "counter2" [ drop counter-example2 ] install-cont-responder
"test1" [ drop test-cont-responder ] install-cont-responder "test1" [ drop test-cont-responder ] install-cont-responder
"test2" [ drop test-cont-responder2 ] install-cont-responder "test2" [ drop test-cont-responder2 ] install-cont-responder
"test3" [ drop test-cont-responder3 ] install-cont-responder "test3" [ drop test-cont-responder3 ] install-cont-responder

View File

@ -99,21 +99,21 @@ USE: logic
! Each closable HTML tag has four words defined. The example below is for ! Each closable HTML tag has four words defined. The example below is for
! <p>: ! <p>:
! !
!: <p> ( -- ) ! : <p> ( -- )
! #! Writes the opening tag to standard output. ! #! Writes the opening tag to standard output.
! "<p>" write ; ! "<p>" write ;
!: <p ( -- n: <namespace> ) ! : <p ( -- n: <namespace> )
! #! Used for setting inline attributes. Prints out ! #! Used for setting inline attributes. Prints out
! #! an unclosed opening tag. ! #! an unclosed opening tag.
! "<p" write <namespace> >n ; ! "<p" write <namespace> >n ;
! !
!: p> ( n: <namespace> -- ) ! : p> ( n: <namespace> -- )
! #! Used to close off inline attribute version of word. ! #! Used to close off inline attribute version of word.
! #! Prints out attributes and closes opening tag. ! #! Prints out attributes and closes opening tag.
! store-prev-attribute write-attributes n> drop ">" write ; ! store-prev-attribute write-attributes n> drop ">" write ;
! !
!: </p> ( -- ) ! : </p> ( -- )
! #! Write out the closing tag. ! #! Write out the closing tag.
! "</foo>" write ; ! "</foo>" write ;
! !
@ -135,7 +135,7 @@ USE: logic
! Each attribute word has the form xxxx= where 'xxxx' is the attribute ! Each attribute word has the form xxxx= where 'xxxx' is the attribute
! name. The example below is for href: ! name. The example below is for href:
! !
!: href= ( n: <namespace> optional-value -- ) ! : href= ( n: <namespace> optional-value -- )
! store-prev-attribute "href" "current-attribute" set ; ! store-prev-attribute "href" "current-attribute" set ;
: define-compound ( vocab name def -- ) : define-compound ( vocab name def -- )

View File

@ -42,6 +42,7 @@ USE: logic
USE: cont-html USE: cont-html
USE: logging USE: logging
USE: url-encoding USE: url-encoding
USE: unparser
: expiry-timeout ( -- timeout-seconds ) : expiry-timeout ( -- timeout-seconds )
#! Number of seconds to timeout continuations in #! Number of seconds to timeout continuations in
@ -58,7 +59,7 @@ USE: url-encoding
: get-random-id ( -- id ) : get-random-id ( -- id )
#! Generate a random id to use for continuation URL's #! Generate a random id to use for continuation URL's
<% 16 [ random-digit % ] times %> ; <% 16 [ random-digit unparse % ] times %> ;
: continuation-table ( -- <namespace> ) : continuation-table ( -- <namespace> )
#! Return the global table of continuations #! Return the global table of continuations