Change cont-responder to stream instead of building a string
parent
149ce89d0b
commit
b39984aaa6
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue