+ Change interface of SEND/SUSPEND, SEND/FINISH, SEND:

They expect SURFLET-RESPONSE objects now (not HTTP-RESPONSE).
+  SEND-HTML/SUSPEND, SEND-HTML/FINISH, SEND-HTML respect this.

scheme/httpd/surflets/packages.scm

@@ -105,10 +105,19 @@
 	  resume-url-session-id
 	  resume-url-continuation-id))
 
+(define-interface surflet-handler/responses-interface
+  (export make-surflet-response
+	  surflet-response?
+	  surflet-response-status
+	  surflet-response-content-type
+	  surflet-response-headers
+	  surflet-response-data))
+
 (define-structures
   ((surflet-handler surflet-handler-interface)
    (surflet-handler/surflet surflet-handler/surflet-interface)
-   (surflet-handler/admin surflet-handler/admin-interface))
+   (surflet-handler/admin surflet-handler/admin-interface)
+   (surflet-handler/responses surflet-handler/responses-interface))
   (open	httpd-responses
 	httpd-requests
 	httpd-errors
@@ -184,7 +193,8 @@
  
 (define-structure surflets surflets-interface
   (open surflet-handler/surflet
-	httpd-responses
+	surflet-handler/responses
+	httpd-responses			; STATUS-CODE
 	httpd-requests			; HTTP-URL:SEARCH
 	url				; REQUEST:URL
 	parse-html-forms

scheme/httpd/surflets/surflet-handler.scm

@@ -49,6 +49,28 @@
   ;; session lifetime is in seconds
   (session-lifetime options:session-lifetime set-options:session-lifetime))
 
+;;; STATUS is the status code, an exact integer. See httpd/response.scm
+;;;  e.g. (status-code ok)
+;;; CONTENT-TYPE is a string, most probably "text/html".
+;;; HEADERS is a (maybe empty) list of pairs of (string or symbol);
+;;;   Additional headers to send, e.g. '(("Cache-Control" . "no-cache")) or
+;;;   '((Cache-Control . "no-cache")) etc.
+;;; DATA is either
+;;; * a string
+;;; * a list of strings
+;;; This list maybe extended to vectors later.
+(define-record-type surflet-response :surflet-response
+  (make-surflet-response status content-type headers data)
+  surflet-response?
+  (status surflet-response-status)
+  (content-type surflet-response-content-type)
+  (headers surflet-response-headers)
+  (data surflet-response-data))
+
+(define (valid-surflet-response-data? data)
+  (or (string? data) (list? data)))
+
+
 ;; Surflet-prefix is unused now. Formerly, it contained the virtual
 ;; path prefix for the handler.
 (define (make-default-options surflet-path surflet-prefix)
@@ -227,6 +249,7 @@
 	))))
 
 
+;; RESPONSE-MAKER is a procedure returnig a SURFLET-RESPONSE.
 (define (send/suspend response-maker)
   (shift return
 	 (let* ((session-id (instance-session-id))
@@ -246,40 +269,44 @@
 						     session-id 
 						     continuation-counter
 						     continuation-id)))
-		       (make-surflet-response (response-maker new-url))))))
+		       (make-http-response (response-maker new-url))))))
 	       (make-error-response (status-code not-found) #f
-					 "The URL refers to a surflet, whose session is no longer alive.")))))
+					 "The URL refers to a SUrflet, whose session is no longer alive.")))))
 
 (define (send/finish response)
   (delete-session! (instance-session-id))
-  (shift unused (make-surflet-response response)))
+  (shift unused (make-http-response response)))
 
 (define (send response)
-  (shift unused (make-surflet-response response)))
+  (shift unused (make-http-response response)))
 
-(define (make-surflet-response response)
-  (let ((buffer (open-output-string))
-	(surflet-in-port #f) ;; FIXME: no input-port available
-	(options #f))			;; FIXME: No access to httpd-options :-(
-    (if (writer-body? (response-body response))
-	(begin
-	  ;; Error-handler is already installed.
-	  ;; Force string-output to resolve all send/... calls. 
-	  (display-http-body (response-body response)
-			     surflet-in-port buffer 
-			     options)
-	  ;; Create write-out-response for webserver.
+(define (make-http-response response)
+  (cond
+   ((surflet-response? response)
+    (let ((data (surflet-response-data response)))
+      (if (valid-surflet-response-data? data)
 	  (make-response
-	   (response-code response)
-	   (response-message response)
-	   (response-seconds response)
-	   (response-mime response)
-	   (response-extras response)
-	   (make-writer-body
+	   (surflet-response-status response)
+	   #f
+	   (time)
+	   (surflet-response-content-type response)
+	   (surflet-response-headers response)
+	   (make-writer-body 
 	    (lambda (out options)
-	      (display (get-output-string buffer) out)))))
-	(make-error-response (status-code bad-gateway) #f 
-			     "The surflet returned an invalid response object (no writer-body)."))))
+	      (cond
+	       ((string? data) (display data out))
+	       ((list? data)   (for-each (lambda (data) (display data out)) data))
+	       (else  ;; We lose. 
+		(display "Error in SUrflet output.\n" out))
+	       ))))
+	  (make-error-response (status-code bad-gateway) #f 
+			       "The SUrflet returned an invalid response object (no surflet-response)."))))
+   ((and (response? response)		;; RESPONSE? refers to a HTTP-RESPONSE.
+	 (redirect-body? (response-body response)))
+    response)
+   (else
+    (make-error-response (status-code bad-gateway) #f
+			 "The SUrflet returned an invalid response object (no surflet-response)."))))
 
     
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

scheme/httpd/surflets/surflets.scm

@@ -5,8 +5,7 @@
   (send/suspend 
    (lambda (new-url)
      (make-usual-html-response
-      (lambda (out options)
-	(display (surflet-XML->HTML #f (html-tree-maker new-url)) out))))))
+      (surflet-XML->HTML #f (html-tree-maker new-url))))))
 
 (define (send-html/finish html-tree)
   (do-sending send/finish html-tree))
@@ -15,19 +14,15 @@
   (do-sending send html-tree))
 
 (define (do-sending send html-tree)
-  (let ((html-page (surflet-XML->HTML #f html-tree)))
-    (send (make-usual-html-response
-	   (lambda (out options)
-	     (display html-page out))))))
+  (send (make-usual-html-response 
+	 (surflet-XML->HTML #f html-tree))))
 
-(define (make-usual-html-response writer-proc)
-  (make-response
+(define (make-usual-html-response html-string)
+  (make-surflet-response
    (status-code ok)
-   #f
-   (time)
    "text/html"
    '(("Cache-Control" . "no-cache"))
-   (make-writer-body writer-proc)))
+   html-string))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; from cgi-script: