Add infrastructure for saving default values in get-results.

scheme/httpd/surflets/packages.scm

@@ -279,7 +279,7 @@
 	define-record-types
 	let-opt
 	servlets
-	(subset srfi-1 (zip filter))
+	(subset srfi-1 (zip filter find make-list))
 	handle-fatal-error
 	)
   (files simple-servlet-api))

scheme/httpd/surflets/simple-surflet-api.scm

@@ -13,32 +13,41 @@
   (zip (map car assoc-query-list)
        (get-results (map cadr assoc-query-list) "Web Query")))
 
-(define (get-results queries title . maybe-update-text)
+(define (get-results queries title . maybe-update-text+defaults)
+  (let-optionals maybe-update-text+defaults
+      ((update-text #f)
+       (defaults (make-list (length queries) #f)))
     (let* ((queries (map transform-string-to-query queries))
-	 (update-text (:optional maybe-update-text #f))
 	   (req (send-html/suspend
 		 (lambda (new-url)
+		   (generate-simple-servlet-page new-url update-text
+						 title
+						 queries defaults))))
+	   (bindings (get-bindings req))
+	   (queries+values (map (lambda (query)
+				  (cons query (ask query 'value bindings)))
+				queries))
+	   (bad-query+value (find (lambda (query+value) 
+				    (not (cdr query+value)))
+				  queries+values)))
+      (if bad-query+value
+	  (get-results queries title
+		       (ask (car bad-query+value) 'bad-input-text)
+		       (map cdr queries+values))
+	  (map cdr queries+values)))))
+
+(define (generate-simple-servlet-page new-url update-text title queries defaults)
   `(html 
     (title ,title)
     (body (@ (bgcolor "white"))
-			 (h3 ,(if update-text `(font (@ (color "red")) ,update-text) title))
+	  (h3 ,(if update-text 
+		   `(font (@ (color "red")) ,update-text) 
+		   title))
 	  (servlet-form ,new-url POST
-				       (table ,@(map (lambda (query)
+			(table ,@(map (lambda (query default)
-						       (ask query 'html-table-row))
+					(ask query 'html-table-row default))
-						     queries))
+				      queries defaults))
-				       ,(make-submit-button)))))))
+			,(make-submit-button)))))
-	 (bindings (get-bindings req)))
-    (call-with-current-continuation
-     (lambda (exit)
-       (map (lambda (query)
-	      (with-fatal-error-handler
-	       (lambda (c m)
-		 (exit
-		  (get-results queries title
-			       (ask query 'bad-input-text))))
-	       (ask query 'value bindings)))
-       queries)))))
-
 
 ;; Post some information on a Web page, wait for continue signal.
 (define (inform title . text)
@@ -77,7 +86,10 @@
   (lambda (message)
     (case message
       ((html-table-row)
-       (lambda (self)
+       (lambda (self default)
+	 ;; DEFAULT is ignored currently. There is a problem with
+	 ;; adding the default-value to an already generated
+	 ;; input-field.
 	 `(tr (td ,text) (td ,input-field))))
       ((value)
        (lambda (self bindings)
@@ -115,7 +127,8 @@
     (lambda (message)
       (case message
 	((html-table-row)
-	 (lambda (self)
+	 (lambda (self default)
+	   ;; See note above for default.
 	   `(tr (td ,text)
 		(td (table (tr
 			    ,@(map (lambda (radio choice)