Put post-refresh-get back in cont-responder and tidy stack usage
parent
f62277f8ba
commit
593c1808ec
|
|
@ -118,7 +118,7 @@ C: item ( quot data data-quot expire? id -- item )
|
||||||
] when*
|
] when*
|
||||||
item-quot call
|
item-quot call
|
||||||
exit-continuation get continue
|
exit-continuation get continue
|
||||||
] with-exit-continuation
|
] with-exit-continuation drop
|
||||||
] [
|
] [
|
||||||
"404 Callback not available" httpd-error
|
"404 Callback not available" httpd-error
|
||||||
] if* ;
|
] if* ;
|
||||||
|
|
|
||||||
|
|
@ -5,6 +5,11 @@ USING: http httpd math namespaces io strings kernel html hashtables
|
||||||
parser generic sequences callback-responder ;
|
parser generic sequences callback-responder ;
|
||||||
IN: cont-responder
|
IN: cont-responder
|
||||||
|
|
||||||
|
#! Used inside the session state of responders to indicate whether the
|
||||||
|
#! next request should use the post-refresh-get pattern. It is set to
|
||||||
|
#! true after each request.
|
||||||
|
SYMBOL: post-refresh-get?
|
||||||
|
|
||||||
: >callable ( quot|interp|f -- interp )
|
: >callable ( quot|interp|f -- interp )
|
||||||
dup continuation? [
|
dup continuation? [
|
||||||
[ continue ] curry
|
[ continue ] curry
|
||||||
|
|
@ -27,9 +32,9 @@ IN: cont-responder
|
||||||
|
|
||||||
SYMBOL: current-show
|
SYMBOL: current-show
|
||||||
|
|
||||||
: store-callback-cc ( -- )
|
: store-current-show ( -- )
|
||||||
#! Store the current continuation in the variable 'callback-cc'
|
#! Store the current continuation in the variable 'current-show'
|
||||||
#! so it can be returned to later by callbacks. Note that it
|
#! so it can be returned to later by href callbacks. Note that it
|
||||||
#! recalls itself when the continuation is called to ensure that
|
#! recalls itself when the continuation is called to ensure that
|
||||||
#! it resets its value back to the most recent show call.
|
#! it resets its value back to the most recent show call.
|
||||||
[ ( 0 -- )
|
[ ( 0 -- )
|
||||||
|
|
@ -40,14 +45,30 @@ SYMBOL: current-show
|
||||||
nip
|
nip
|
||||||
restore-request
|
restore-request
|
||||||
call
|
call
|
||||||
store-callback-cc
|
store-current-show
|
||||||
] callcc0 restore-request ;
|
] callcc0 restore-request ;
|
||||||
|
|
||||||
|
: redirect-to-here ( -- )
|
||||||
|
#! Force a redirect to the client browser so that the browser
|
||||||
|
#! goes to the current point in the code. This forces an URL
|
||||||
|
#! change on the browser so that refreshing that URL will
|
||||||
|
#! immediately run from this code point. This prevents the
|
||||||
|
#! "this request will issue a POST" warning from the browser
|
||||||
|
#! and prevents re-running the previous POST logic. This is
|
||||||
|
#! known as the 'post-refresh-get' pattern.
|
||||||
|
post-refresh-get? get [
|
||||||
|
[
|
||||||
|
>callable t register-callback forward-to-url
|
||||||
|
] callcc1 drop restore-request
|
||||||
|
] [
|
||||||
|
t post-refresh-get? set
|
||||||
|
] if ;
|
||||||
|
|
||||||
: (show) ( quot -- hashtable )
|
: (show) ( quot -- hashtable )
|
||||||
#! See comments for show. The difference is the
|
#! See comments for show. The difference is the
|
||||||
#! quotation MUST set the content-type using 'serving-html'
|
#! quotation MUST set the content-type using 'serving-html'
|
||||||
#! or similar.
|
#! or similar.
|
||||||
store-callback-cc
|
store-current-show redirect-to-here
|
||||||
[
|
[
|
||||||
>callable t register-callback swap with-scope
|
>callable t register-callback swap with-scope
|
||||||
exit-continuation get continue
|
exit-continuation get continue
|
||||||
|
|
@ -69,7 +90,7 @@ SYMBOL: current-show
|
||||||
#! See comments for show-final. The difference is the
|
#! See comments for show-final. The difference is the
|
||||||
#! quotation MUST set the content-type using 'serving-html'
|
#! quotation MUST set the content-type using 'serving-html'
|
||||||
#! or similar.
|
#! or similar.
|
||||||
store-callback-cc
|
store-current-show redirect-to-here
|
||||||
with-scope exit-continuation get continue ;
|
with-scope exit-continuation get continue ;
|
||||||
|
|
||||||
: show-final ( quot -- namespace )
|
: show-final ( quot -- namespace )
|
||||||
|
|
@ -91,9 +112,9 @@ SYMBOL: root-callback
|
||||||
#! The requests for actual continuation are processed by the
|
#! The requests for actual continuation are processed by the
|
||||||
#! 'callback-responder'.
|
#! 'callback-responder'.
|
||||||
[
|
[
|
||||||
[ <request> request set root-callback get call ] with-scope
|
[ f post-refresh-get? set <request> request set root-callback get call ] with-scope
|
||||||
exit-continuation get continue
|
exit-continuation get continue
|
||||||
] with-exit-continuation ;
|
] with-exit-continuation drop ;
|
||||||
|
|
||||||
: quot-url ( quot -- url )
|
: quot-url ( quot -- url )
|
||||||
current-show get [ continue-with ] curry curry t register-callback ;
|
current-show get [ continue-with ] curry curry t register-callback ;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue