MAKE-SELECT-INPUT-FIELD can now create select input fields with multiple

selections. INPUT-FIELD-VALUE will always return a (possible empty) list in
the multiple case.

scheme/httpd/surflets/surflets.scm

@@ -399,31 +399,44 @@
 ;; preselected option: (selected)
 ;; changed return value: (value new-value)
 ;; returns a select input field with several options
-(define (make-select-input-field options . maybe-further-attributes)
+(define make-select-input-field 
-  (let ((name (generate-input-field-name "select")))
+  (let ((make-multiple-transformer
+	 (lambda (name)
+	   (lambda (bindings)
+	     (map cdr
+		  (filter (lambda (binding)
+			    (equal? (car binding) name))
+			  bindings))))))
+
+    (lambda (options . maybe-further-attributes)
       (optionals maybe-further-attributes
-	((attributes XML-attribute?))
+	    ((multiple? boolean?)
-      (make-input-field 
+	     (attributes XML-attribute?))
-       name
+	(let* ((name (generate-input-field-name "select"))
-       identity				;FIXME[extension] refer to list elements
+	       (SXML-options 
-       `(select (@ ((name ,name)
+		(map (lambda (option)
-		    ,(and attributes (cdr attributes))))
-		#\newline
-		,@(map (lambda (option)
 		       (cond
-			  ((string? option)
+			((string-or-symbol? option) 
 			 (list 'option option))
 			((list? option) 
 			 (cond
 			  ((null? (cdr option))
 			   `(option ,option))
-			    ((XML-attribute? (cadr option)) ; with attributes?
+			  ((XML-attribute? (cadr option)) ; w/attribs?
 			   `(option ,(cadr option) ,(car option)))
 			  (else
 			   (error "not an attribute" (cdr option)))))
 			(else
 			 (error "not an option" option))))
-		       options))))))
+		     options))
+	       (SXML `(select (@ ((name ,name)
+				 ,(if multiple? '(multiple) '())
+				 ,(and attributes (cdr attributes))))
+			     #\newline
+			     ,SXML-options)))
+	  (if multiple?
+	      (make-upper-input-field (make-multiple-transformer name) SXML)
+	      (make-input-field name identity SXML)))))))
 
 ;; returns a *list* of radio buttons
 (define (make-radio-input-fields values . maybe-further-attributes)
@@ -509,6 +522,8 @@
 		 #f `(@ (src ,image-source) 
 			,@(if attributes (cdr attributes) '())))))
 
+;; <input-field>: '(input-field . <real-input-field>)
+;; <real-input-field>: #{Input-field "name"}
 (define (input-field-value input-field bindings)
   (let ((input-field (cadr input-field)))
     (cond

scheme/httpd/surflets/web-server/root/surflets/admin-servlets.scm

@@ -51,9 +51,6 @@
 			,(make-submit-button "Do it")))
 		    ,footer)))))
 	     (bindings (get-bindings req))
-	     ;; No error handling as always something is selected. If
-	     ;; not, the browser did something wrong and we may yield
-	     ;; an error anyway.
 	     (action (input-field-value select bindings)))
 
 	(if (string=? action action-title)

scheme/httpd/surflets/web-server/root/surflets/test.scm

@@ -4,6 +4,18 @@
 	servlets
 	httpd-responses)
   (begin
+    (define select (make-select-input-field '("a" "b" "c") #t '(@ (size 2))))
+
     (define (main req)
+      (let ((req (send-html/suspend
+		  (lambda (new-url)
+		    `(html (body (h1 "This is from servlet")
+				 (servlet-form
+				  ,new-url
+				  ,select
+				  ,(make-submit-button))
+				 ))))))
 	(send-html/finish
-       '(html (body (h1 "This is from servlet")))))))
+	 `(html (body (h1 "Result")
+		      ,(format #f "~s" (get-bindings req)))))))
+    ))