added upper-input-field type

scheme/httpd/surflets/packages.scm

@@ -110,11 +110,13 @@
 	  extract-single-binding
 	  generate-input-field-name
 	  make-input-field
+	  make-upper-input-field
 	  make-text-input-field
 	  make-password-input-field
 	  make-number-input-field
 	  make-textarea-input-field
 	  make-select-input-field
+	  make-checkbox-input-field
 	  
 	  make-submit-button
 	  input-field-value

scheme/httpd/surflets/surflets.scm

@@ -172,16 +172,18 @@
 ;;; defines input-fields for servlets
 
 (define-record-type input-field :input-field
-  (real-make-input-field name transformer HTML-tree)
+  (real-make-input-field name transformer HTML-tree get-bindings?)
   input-field?
   (name input-field-name)
   (transformer input-field-transformer)
   (attributes input-field-attributes)
-  (HTML-tree input-field-HTML-tree))
+  (HTML-tree input-field-HTML-tree)
+  (get-bindings? input-field-get-bindings?))
 
 (define-record-discloser :input-field
   (lambda (input-field)
-    (list 'input-field (input-field-name input-field))))
+    (list 'input-field
+	  (input-field-name input-field))))
 
 ;; FIXME: consider creating small names
 (define generate-input-field-name
@@ -193,7 +195,10 @@
 (define identity (lambda (a) a))
 
 (define (make-input-field name transformer HTML-tree)
-  (list 'input-field (real-make-input-field name transformer HTML-tree)))
+  (list 'input-field (real-make-input-field name transformer HTML-tree #f)))
+
+(define (make-upper-input-field transformer HTML-tree)
+  (list 'input-field (real-make-input-field #f transformer HTML-tree #t)))
 
 (define (make-text-input-field . maybe-further-attributes)
   (let ((name (generate-input-field-name "text")))
@@ -252,6 +257,24 @@
 			   `(option ,option)))
 		     options)))))
 
+(define (make-checkbox-input-field . maybe-further-attributes)
+  (let* ((name (generate-input-field-name "checkbox"))
+	 (value (if (and (pair? maybe-further-attributes)
+			 (string? (car maybe-further-attributes)))
+		    (car maybe-further-attributes)
+		    #f))
+	 (further-attributes (if value 
+				 (cdr maybe-further-attributes)
+				 maybe-further-attributes)))
+    (make-input-field
+     name
+     identity
+     `(input (@ ((type "checkbox")
+		 (name ,name)
+		 ,(if value `(value ,value) '())
+		 ,@further-attributes))))))
+       
+
 ;; in work
 (define (make-radio-input-field values . maybe-further-attributes)
   (let ((name (generate-input-field-name "radio")))
@@ -285,9 +308,12 @@
       `(input (@ (type "submit")
 		 ,@maybe-further-attributes))))
 		    
+
 (define (input-field-value input-field bindings)
   (let ((input-field (cadr input-field)))
     (cond
+     ((input-field-get-bindings? input-field)
+      ((input-field-transformer input-field) bindings))
      ((assoc (input-field-name input-field) bindings) =>
       (lambda (binding)
 	((input-field-transformer input-field) (cdr binding))))