add possibility to clear instance table remotely (may go away in the

future)

scheme/httpd/surflets/surflet-handler.scm

@@ -45,6 +45,9 @@
 	    (http-syslog (syslog-level debug)
 			 "servlet-handler: clearing plugin cache")
 	    (reset-plugin-cache!)
+	    (http-syslog (syslog-level debug)
+			 "servlet-handler: clearing instance table")
+	    (reset-instance-table!))
 	    (make-http-error-response http-status/accepted req "plugin cache cleared"))
 	   ((or (string=? request-method "GET")
 ;		(string=? request-method "POST"))        ; do this at later time
@@ -123,7 +126,7 @@ You can try starting at the <A HREF=~a>beginning</a>."
       ))))
     
 
-(define (send-html/suspend html-tree-maker)
+(define (send/suspend response-maker)
   (shift return
 	 (let* ((instance-id (session-instance-id))
 		(instance (instance-lookup instance-id))
@@ -138,28 +141,12 @@ You can try starting at the <A HREF=~a>beginning</a>."
 					     instance-id 
 					     continuation-counter
 					     continuation-id)))
-	       (make-usual-html-response
-		(lambda (out options)
-		  (with-current-output-port*
-		   out
-		   (lambda () (SXML->HTML (html-tree-maker new-url)))))))))))
+	       (response-maker new-url))))))
+	       
 
-(define (send-html/finish html-tree)
+(define (send/finish response)
   (instance-delete! (session-instance-id))
-  (make-usual-html-response
-   (lambda (out options)
-     (with-current-output-port*		; FIXME: will change in further revision
-      out
-      (lambda ()  (SXML->HTML html-tree))))))
-
-(define (make-usual-html-response writer-proc)
-  (make-response
-   http-status/ok
-   (status-code->text http-status/ok)
-   (time)
-   "text/html"
-   '()
-   (make-writer-body writer-proc)))
+  response)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; access to instance-table
@@ -238,6 +225,16 @@ You can try starting at the <A HREF=~a>beginning</a>."
      (set! *plugin-table* (make-string-table))
      (release-lock *plugin-table-lock*))))
 
+(define (reset-instance-table!)
+  (with-fatal-error-handler
+   (lambda (condtion decline)
+     (release-lock *instance-table-lock*)
+     (decline))
+   (lambda ()
+     (obtain-lock *instance-table-lock*)
+     (set! *instance-table* (make-integer-table))
+     (release-lock *instance-table*))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SESSION
 (define *session* (make-thread-cell #f))