Change cont-responder to stream instead of building a string

chris.double 2006-02-06 00:04:55 +00:00
parent 149ce89d0b
commit b39984aaa6
1 changed files with 14 additions and 11 deletions

View File

@ -153,7 +153,9 @@ DEFER: show
[ expired-page-handler ]
] if* >callable ;
: resume-continuation ( value id -- )
TUPLE: resume value stdio ;
: resume-continuation ( resumed-data id -- )
#! Call the continuation associated with the given id,
#! with 'value' on the top of the stack.
get-registered-continuation call ;
@ -193,6 +195,7 @@ SYMBOL: callback-cc
continue
] callcc1 ( 0 [ ] == )
nip
dup resume-stdio stdio set resume-value
call
store-callback-cc
] callcc0 ;
@ -204,7 +207,7 @@ SYMBOL: callback-cc
[
"HTTP/1.1 302 Document Moved\nLocation: " % %
"\nContent-Length: 0\nContent-Type: text/plain\n\n" %
] "" make call-exit-continuation ;
] "" make write "" call-exit-continuation ;
: forward-to-id ( id -- )
#! When executed inside a 'show' call, this will force a
@ -223,7 +226,7 @@ SYMBOL: callback-cc
post-refresh-get? get [
[
expirable register-continuation forward-to-id
] callcc1 drop
] callcc1 resume-stdio stdio set
] [
t post-refresh-get? set
] if ;
@ -235,14 +238,14 @@ SYMBOL: callback-cc
store-callback-cc redirect-to-here
[
expirable register-continuation id>url swap
string-out call-exit-continuation
with-scope "" call-exit-continuation
] callcc1
nip ;
nip dup resume-stdio stdio set resume-value ;
: show ( quot -- namespace )
#! Call the quotation with the URL associated with the current
#! continuation. Return the HTML string generated by that code
#! to the exit continuation. When the URL is later referenced then
#! continuation. All output from the quotation goes to the client
#! browser. When the URL is later referenced then
#! computation will resume from this 'show' call with a namespace on
#! the stack containing any query or post parameters.
#! NOTE: On return from 'show' the stack is exactly the same as
@ -255,7 +258,7 @@ SYMBOL: callback-cc
#! quotation MUST set the content-type using 'serving-html'
#! or similar.
store-callback-cc redirect-to-here
string-out call-exit-continuation ;
with-scope "" call-exit-continuation ;
: show-final ( quot -- namespace )
#! Similar to 'show', except the quotation does not receive the URL
@ -282,19 +285,19 @@ SYMBOL: root-continuation
#! no root continuation exists the expired continuation handler
#! should be called.
drop [
"response" get
"response" get stdio get <resume>
id-or-root [
resume-continuation
] [
expired-page-handler
] if*
] with-exit-continuation [ write flush ] when* ;
] with-exit-continuation [ drop flush ] when* ;
: callback-quot ( quot -- quot )
#! Convert the given quotation so it works as a callback
#! by returning a quotation that will pass the original
#! quotation to the callback continuation.
[ , callback-cc get , \ continue-with , ] [ ] make ;
[ , \ stdio , \ get , \ <resume> , callback-cc get , \ continue-with , ] [ ] make ;
: quot-url ( quot -- url )
callback-quot expirable register-continuation id>url ;