From 23dfce1dc7dba756fe747d1af2132d15098b6de6 Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Fri, 4 Oct 2002 15:51:51 +0000
Subject: [PATCH] add further configurable option: cache servlets

---
 .../root/surflets/admin-handler.scm           | 48 ++++++++++++++-----
 1 file changed, 36 insertions(+), 12 deletions(-)

diff --git a/scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm b/scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm
index ec4c6bf..1a4cd65 100644
--- a/scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm
+++ b/scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm
@@ -9,7 +9,7 @@
 	)
   (begin
 
-    (define (get-option-change number-field return-address update-text)
+    (define (get-option-change return-address update-text options)
       (send-html/suspend
        (lambda (new-url)
 	 `(html 
@@ -19,28 +19,41 @@
 	    (h2 "Handler options")
 	    ,(and (pair? update-text) update-text)
 	    (p "These are the runtime configurable options of the handler:")
-	    (table
-	     (servlet-form ,new-url
-			   (tr (td "Current instance lifetime: ") 
-			       (td ,number-field) 
-			       (td ,(make-submit-button "Change")))))
+	    (servlet-form 
+	     ,new-url
+	     POST
+	     (table
+	      ,@(map (lambda (option)
+		       (let ((text (car option))
+			     (input-field (cadr option))
+			     (submit-button (caddr option)))
+			 `(tr (td ,text) 
+			      (td ,input-field)
+			      (td ,submit-button))))
+		     options)))
 	    (hr)
 	    (URL ,(return-address new-url) "Return to main page")))
 	 )))
+    
+    (define submit-timeout (make-submit-button "Change"))
+    (define return-address (make-address))
+    (define submit-cache (make-submit-button "Change"))
+    
 
     (define (handler-options req . maybe-update-text)
       (let* ((update-text `(font (@ (color "red"))
 				 ,(:optional maybe-update-text "")))
 	     (number-field 
-	      (make-number-input-field `(@ ((value ,(options-instance-lifetime))))))
-	     (return-address (make-address))
-	     (req (get-option-change number-field return-address update-text))
+	      (make-number-input-field (options-instance-lifetime)))
+	     (cache-checkbox (make-checkbox-input-field (options-cache-servlets?)))
+	     (options `(("Current instance lifetime: " ,number-field ,submit-timeout)
+			("Cache servlets?" ,cache-checkbox ,submit-cache)))
+	     (req (get-option-change return-address update-text options))
 	     (bindings (get-bindings req)))
 	(cond 
 	 ((returned-via? return-address bindings)
 	  (return-to-main-page req))
-	 (else
-
+	 ((input-field-binding submit-timeout bindings)
 	  (with-fatal-error-handler
 	   (lambda (condition more)
 	     (handler-options req "Please enter a valid, positive integer number"))
@@ -52,7 +65,18 @@
 		   (handler-options req 
 				    (format #f "Instance lifetime changed to ~a." 
 					    (options-instance-lifetime))))
-		  (error "not a positive integer"))))))))
+		  (error "not a positive integer")))))
+	 ((input-field-binding submit-cache bindings)
+	  (let ((cache-plugins? (if (input-field-binding cache-checkbox bindings)
+				    #t 
+				    #f)))
+	    (set-options-cache-servlets? cache-plugins?)
+	    (handler-options req 
+			     (format #f "Caching turned ~s" 
+				     (if cache-plugins? "on" "off")))))
+	 (else
+	  (error "unexpected return" bindings)))))
+
 
     (define (return-to-main-page req)
       (send/finish (make-http-error-response http-status/moved-perm req