From d705974612bcb07b03fa19b4b8cb2ef99e8cf0d7 Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Sat, 7 Dec 2002 22:27:02 +0000
Subject: [PATCH] Remove checkbox-bug

---
 scheme/httpd/surflets/simple-surflet-api.scm | 28 ++++++++++++++++----
 1 file changed, 23 insertions(+), 5 deletions(-)

diff --git a/scheme/httpd/surflets/simple-surflet-api.scm b/scheme/httpd/surflets/simple-surflet-api.scm
index 22cdf6b..5ac9de5 100644
--- a/scheme/httpd/surflets/simple-surflet-api.scm
+++ b/scheme/httpd/surflets/simple-surflet-api.scm
@@ -33,8 +33,14 @@
       (if bad-query+value
 	  (get-results queries title
 		       (ask (car bad-query+value) 'bad-input-text)
-		       (map cdr queries+values))
-	  (map cdr queries+values)))))
+		       (map (lambda (query+value)
+			      (let ((value (cdr query+value)))
+				(and value
+				     (value-value value))))
+			    queries+values))
+	  (map (lambda (query+value) 
+		 (value-value (cdr query+value)))
+	       queries+values)))))
 
 (define (generate-simple-servlet-page new-url update-text title queries defaults)
   `(html 
@@ -82,6 +88,11 @@
 ;  (input-field query-input-field)
 ;  (insist query-insist))
 
+(define-record-type value :value
+  (make-value value)
+  value?
+  (value value-value))
+
 (define (standard-query text input-field insist)
   (lambda (message)
     (case message
@@ -93,7 +104,12 @@
 	 `(tr (td ,text) (td ,input-field))))
       ((value)
        (lambda (self bindings)
-	 (input-field-value input-field bindings)))
+	 ;; Return #f, if getting value failed, otherwise a value
+	 ;; object containing the value. This lets the checkbox field
+	 ;; to return #f as a valid value.
+	 (with-fatal-error-handler
+	  (lambda (c m) #f)	
+	  (make-value (raw-input-field-value input-field bindings)))))
       ((bad-input-text)
        (lambda (self)
 	 (format #f "~a to the question: ~a" insist text)))
@@ -115,7 +131,9 @@
       (case message
        ((value)
 	(lambda (self bindings)
-	  (if (input-field-binding input-field bindings) #t #f)))
+	  (if (input-field-binding input-field bindings) 
+	      (make-value #t)
+	      (make-value #f))))
        (else
 	(get-method standard message))))))
 
@@ -161,7 +179,7 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; OOP
-;;; from Mike Sperber
+;;; from Mike Sperber (lecture winter term 1999/2000)
 ;; Objects are procedures returning methods
 
 (define get-method