From b39984aaa662c522e4e5cfedbbcba5f67a06fd23 Mon Sep 17 00:00:00 2001
From: "chris.double" <chris.double@double.co.nz>
Date: Mon, 6 Feb 2006 00:04:55 +0000
Subject: [PATCH] Change cont-responder to stream instead of building a string

---
 contrib/httpd/cont-responder.factor | 25 ++++++++++++++-----------
 1 file changed, 14 insertions(+), 11 deletions(-)

diff --git a/contrib/httpd/cont-responder.factor b/contrib/httpd/cont-responder.factor
index 65abd165d6..3728d80081 100644
--- a/contrib/httpd/cont-responder.factor
+++ b/contrib/httpd/cont-responder.factor
@@ -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 ;