From 2ab106745aed6254adaef9640a644759ad16a7a2 Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Sun, 3 Nov 2002 18:15:53 +0000
Subject: [PATCH] Get rid of a bug. Filtering of instances is disabled to
 achieve this.

---
 .../root/surflets/admin-servlets.scm          | 35 ++++++++-----------
 1 file changed, 15 insertions(+), 20 deletions(-)

diff --git a/scheme/httpd/surflets/web-server/root/surflets/admin-servlets.scm b/scheme/httpd/surflets/web-server/root/surflets/admin-servlets.scm
index 975c744..f94c4f4 100644
--- a/scheme/httpd/surflets/web-server/root/surflets/admin-servlets.scm
+++ b/scheme/httpd/surflets/web-server/root/surflets/admin-servlets.scm
@@ -87,7 +87,7 @@
 		       (URL ,(make-callback return-to-main-page) "Return to administration menu.")
 		       (br)
 		       (URL "/" "Return to main menu.")))
-	     (actions '("unload" "unload all" "view instances")))
+	     (actions '("unload" "unload all")))
 	(if (null? loaded-servlets)
 	    (send-html `(html (title ,title) (body ,header ,(no-servlets) ,footer)))
 	    (receive (action selected-servlets)
@@ -118,19 +118,6 @@
 		       ((string=? action "unload all")
 			(unload-servlets outdated? loaded-servlets)
 			(show-servlets 'no-req "Servlets unloaded."))
-		       ((string=? action "view instances")
-			(format #t "~s~%" selected-servlets)
-			(let* ((path-stripped-selected-servlets
-				(map remove-servlet-path selected-servlets))
-			       (selected-instances
-				(filter (lambda (instance-pair) 
-					  (member (instance-servlet-name (cdr instance-pair))
-						  path-stripped-selected-servlets))
-					(get-instances))))
-			  ;; this does not return
-			  (real-instances (sort-list! selected-instances 
-						      instance-servlet-name<?)
-					  "")))
 		       (else
 			(error "unknown action" action)))))))))
 
@@ -158,7 +145,6 @@
 	  (URL "admin.scm" "Go back to main page.")))
 
     (define (show-instances req . maybe-update-text)
-      (format #t "show-instances called with req ~s~%" req)
       (let* ((update-text (:optional maybe-update-text ""))
 	     (current-instances (sort-list! (get-instances) instance-servlet-name<?)))
 	(real-instances current-instances update-text)))
@@ -194,7 +180,7 @@
 			      actions
 			      footer)
 	      (if (not action)
-		  (real-instances current-instances "Choose an action.")
+		  (show-instances current-instances "Choose an action.")
 		  (let ((new-update-text
 			 (cond
 			  ((string=? action "kill")
@@ -218,7 +204,7 @@
 				   (show-continuations selected-instances))))
 			  (else
 			   (error "unknown action" action)))))
-		    (real-instances current-instances new-update-text)))))))
+		    (show-instances current-instances new-update-text)))))))
     
 
 
@@ -230,7 +216,7 @@
 	   " this page or go back to the "
 	   (URL ,(make-callback show-instances) "instance table overview."))))
 
-    (define (no-more-than-one-instance title header1)
+    (define (no-more-than-one-instance title header1 instances)
       (send-html 
        `(html (title ,title) 
 	      (body (h1 "Servlet Administration")
@@ -240,7 +226,16 @@
 		    (p "You may choose to go back to the " 
 		       (URL ,(make-callback show-instances) 
 			    "instances administration page")
-		       " where you can select one instance.")))))
+		       " where you can select one instance"
+		       " or select one instance from your chosen instances:" (br)
+		       (ul
+			,@(map (lambda (instance)
+				 `(li (URL ,(make-callback 
+					     (lambda (req)
+					       (show-continuations (list instance))))
+					   ,(instance-servlet-name (cdr instance))
+					   " (" ,(car instance) ")")))
+			       instances)))))))
       
     (define (continuation-id<? entry1 entry2)
       (< (car entry1) (car entry2)))
@@ -249,7 +244,7 @@
       (let ((title "Servlet Adminstration - Continuations")
 	    (header1 '(h1 "Servlet Administration")))
 	(if (not (= 1 (length instances)))
-	    (no-more-than-one-instance title header1)
+	    (no-more-than-one-instance title header1 instances)
 	    (let* ((instance-pair (car instances))
 		   (instance-id (car instance-pair))
 		   (instance-entry (cdr instance-pair))