Remove image button bug (thanks to Eric Knauel for reporting this): Image

buttons return the coordinates where the user clicked � la
imgbtn321.x=13&imgbtn321.y=12. Thus, we cannot search for the
input-field-name of the image button. To remove this bug, we introduce
following changes:

surflet-input-fields.scm:

+ make-image-button returns a multi-input-field that searches for its
  coordinates in the bindings, returning a pair (x y) of it (numbers).
+ Adapt select-input-fields to interface changes of multi-input-fields:
  transformers get also their input-fields.

returned-via.scm:
Don't simply check for the input field name in the binding. Use
input-field-value to check for existance of the input field in the
bindings

input-fields.scm:
multi-input-fields get also their input-field as argument

web-server/root/surflets/byte-input.scm:
Adapt to interface change of multi-input-fields: transformers get also
their input-field

web-server/root/surflets/test.scm:
Check the image-button feature  correctly.

scheme/httpd/surflets/input-fields.scm

@@ -135,7 +135,7 @@
   (let ((real-input-field (cadr input-field)))
     (cond
      ((real-input-field-multi? real-input-field)
-      ((real-input-field-transformer real-input-field) bindings))
+      ((real-input-field-transformer real-input-field) input-field bindings))
      ((real-input-field-binding real-input-field bindings) =>
       (lambda (binding)
 	((real-input-field-transformer real-input-field) (cdr binding))))
@@ -162,6 +162,9 @@
 (define (real-input-field-binding input-field bindings)
   (assoc (real-input-field-name input-field) bindings))
 
+;; Returns the binding of the input-field in bindings by the
+;; input-field's name. If your input-field will have another name in
+;; the bindings than it was created with, use a multi-input-field.
 (define (input-field-binding input-field bindings)
   (real-input-field-binding (cadr input-field) bindings))
 

scheme/httpd/surflets/returned-via.scm

@@ -1,7 +1,7 @@
 
 (define (returned-via return-object bindings)
   (if (input-field? return-object)
-      (input-field-binding return-object bindings)
+      (input-field-value return-object bindings)
       ;; We assume we have a return-address-object instead.
       (let ((address (return-object 'address)))
 	(cond 

scheme/httpd/surflets/surflet-input-fields.scm

@@ -149,8 +149,12 @@
 ;;; A selection input field shows a list of options that can be
 ;;; selected. For this purpose, we introduce an sel-if-option record,
 ;;; that contains all the information for each option. This is
-;;; justified by the fact, that the options list is in HTML seperated,
+;;; justified by the fact, that the options list is seperated in HTML,
-;;; too.
+;;; too. The TAG is the string that is displayed in the website, the
+;;; VALUE is the value that is returned by input-field-value, if this
+;;; option was selected. TAG is assumed to be unique by some functions
+;;; (e.g. select and unselect) SELECTED? tells us, if this option is
+;;; preselected.
 (define-record-type sel-if-option :sel-if-option
   (really-make-sel-if-option tag value selected? attributes)
   sel-if-option?
@@ -177,7 +181,7 @@
   (optionals maybe-attributes
       ((selected? boolean?)
        (attributes sxml-attribute?))
-    (make-sel-if-option tag 'ignored selected? attributes)))
+    (make-sel-if-option tag tag selected? attributes)))
 
 (define-record-discloser :sel-if-option
   (lambda (sel-if-option)
@@ -196,6 +200,36 @@
 (define (unselect-sel-if-option! tag sel-if)
   (set-select-input-field-option-selected?! tag sel-if #f))
 
+(define (set-select-input-field-option-selected?! tag sel-if selected?)
+  (let ((options (input-field-attributes-default 
+		  (input-field-attributes sel-if))))
+    (if (number? tag)			; is tag an index?
+	(set-sel-if-option-selected?! (list-ref options tag) 
+				      selected?)
+	(let lp ((options options))
+	  (if (null? options)
+	      (error "No such option" tag sel-if)
+	      (if (tag=sel-if-option? tag (car options))
+		  (set-sel-if-option-selected?! (car options) selected?)
+		  (lp (cdr options))))))
+    (touch-input-field! sel-if)))
+
+;; Find sel-if-option in a list by its tag.
+(define (tag=sel-if-option? tag sel-if-option)
+  (string=? tag (sel-if-option-tag sel-if-option)))
+
+(define (find-sel-if-option tag sel-if-options)
+  (cond ((member/srfi-1 tag sel-if-options tag=sel-if-option?)
+	 => car)			
+	;; MEMBER/SRFI-1 returns the sublist that starts with the
+	;; searched element.
+	(else #f)))
+
+(define (find-sel-if-option-value tag sel-if-options)
+  (cond ((find-sel-if-option tag sel-if-options)
+	 => sel-if-option-value)
+	(else #f)))
+
 (define (add-sel-if-option! sel-if sel-if-option)
   (let ((attributes (input-field-attributes sel-if)))
     (set-input-field-attributes-default!
@@ -217,34 +251,6 @@
 	   (delete tag sel-if-options tag=sel-if-option?))))
     (touch-input-field! sel-if)))
 
-(define (set-select-input-field-option-selected?! tag sel-if selected?)
-  (let ((options (input-field-attributes-default 
-		  (input-field-attributes sel-if))))
-    (if (number? tag)
-	(set-sel-if-option-selected?! (list-ref options tag) 
-				      selected?)
-	(let lp ((options options))
-	  (if (null? options)
-	      (error "No such option" tag sel-if)
-	      (if (tag=sel-if-option? tag (car options))
-		  (set-sel-if-option-selected?! (car options) selected?)
-		  (lp (cdr options))))))
-    (touch-input-field! sel-if)))
-
-;; Find sel-if-option in a list by its tag.
-(define (tag=sel-if-option? tag sel-if-option)
-  (string=? tag (sel-if-option-tag sel-if-option)))
-
-(define (find-sel-if-option tag sel-if-options)
-  (cond ((member/srfi-1 tag sel-if-options tag=sel-if-option?)
-	 => car)
-	(else #f)))
-
-(define (find-sel-if-option-value tag sel-if-options)
-  (cond ((find-sel-if-option tag sel-if-options)
-	 => sel-if-option-value)
-	(else #f)))
-
 ;; To be compatible with previous versions of MAKE-SELECT-INPUT-FIELD,
 ;; we accept also a simple list as an option-list. New programs should
 ;; use sel-if-options-list (easily createable with 
@@ -257,14 +263,13 @@
 
 (define (make-select-input-field sel-if-options . maybe-further-attributes)
   (really-make-select-input-field (tolerate-old-sel-if-options sel-if-options)
-				  #f
 				  maybe-further-attributes))
 
 (define (make-annotated-select-input-field sel-if-options . 
 					   maybe-further-attributes)
-  (really-make-select-input-field sel-if-options #t maybe-further-attributes))
+  (really-make-select-input-field sel-if-options maybe-further-attributes))
 
-(define (really-make-select-input-field sel-if-options annotated? 
+(define (really-make-select-input-field sel-if-options
 					maybe-further-attributes)
   (let ((real-sel-if-options (tolerate-old-sel-if-options sel-if-options)))
     (optionals maybe-further-attributes
@@ -272,17 +277,14 @@
 	 (attributes sxml-attribute?))
       (let ((name (generate-input-field-name "select")))
 	(if multiple?
-	    (make-multiple-select-input-field name sel-if-options 
+	    (make-multiple-select-input-field name sel-if-options attributes)
-					      annotated? attributes)
 	    (make-single-select-input-field name sel-if-options 
-					    annotated? attributes))))))
+					    attributes))))))
 
 ;; internal
-(define (make-multiple-select-input-field name sel-if-options 
+(define (make-multiple-select-input-field name sel-if-options attributes)
-					  annotated? attributes)
   (make-multi-input-field name "mult-select"
-			  (make-sel-if-multiple-transformer name sel-if-options
+			  sel-if-multiple-transformer
-							    annotated?)
 			  (make-input-field-attributes
 			   sel-if-options 
 			   (list '(multiple) 
@@ -290,33 +292,27 @@
 			  make-sel-if-html-tree))
 
 ;; internal
-(define (make-single-select-input-field name sel-if-options 
+(define (make-single-select-input-field name sel-if-options attributes)
-					annotated? attributes)
   (make-input-field name "select" 
-		    (if annotated?
 		    (lambda (tag)
 		      (cond ((find-sel-if-option-value tag sel-if-options)
 			     => identity)
 			    (else (error "no such option." tag))))
-			identity)
 		    (make-input-field-attributes
 		     sel-if-options 
 		     (sxml-attribute-attributes attributes))
 		    make-sel-if-html-tree))
 
-(define (make-sel-if-multiple-transformer name sel-if-options annotated?)
+(define (sel-if-multiple-transformer input-field bindings)
-  (lambda (bindings)
+  (let ((name (input-field-name input-field))
-    (let ((tags (map cdr
+	(sel-if-options (input-field-attributes-default 
-		     (filter (lambda (binding)
+			 (input-field-attributes input-field))))
+    (let* ((my-bindings (filter (lambda (binding)
 			       (equal? (car binding) name))
-			     bindings))))
+			     bindings))
-      (filter-map (if annotated?
+	   (tags (map cdr my-bindings)))
-		      (lambda (tag)
+      (filter-map (lambda (tag)
 		    (find-sel-if-option-value tag sel-if-options))
-		      (lambda (tag)
-			(if (find-sel-if-option tag sel-if-options)
-			    tag
-			    #f)))
 		  tags))))
 
 (define (make-sel-if-html-tree sel-if)
@@ -496,6 +492,30 @@
 		 #f `(@ (src ,image-source) 
 			,@(sxml-attribute-attributes attributes)))))
 
+(define (make-image-button image-source . maybe-further-attributes)
+  (optionals maybe-further-attributes
+      ((attributes sxml-attribute?))
+    (make-multi-input-field (generate-input-field-name "imgbtn")
+			    "image"
+			    image-button-transformer
+			    (make-input-field-attributes
+			     `(src ,image-source) 
+			     (sxml-attribute-attributes attributes))
+			    make-button-html-tree)))
+
+(define (image-button-transformer image-button bindings)
+  (let ((x (find-image-button-coordinate image-button bindings ".x"))
+	(y (find-image-button-coordinate image-button bindings ".y")))
+    (and x y (cons (string->number x)
+		   (string->number y)))))
+
+(define (find-image-button-coordinate image-button bindings suffix)
+  (let* ((name (input-field-name image-button)))
+    (cond 
+     ((assoc (string-append name suffix) bindings)
+      => (lambda (pair)
+	   (cdr pair)))
+     (else #f))))
  
 
 ;;EOF

scheme/httpd/surflets/web-server/root/surflets/byte-input.scm

@@ -22,7 +22,7 @@
 			   (* 2 order))))))))
 	(make-multi-input-field
 	 #f "byte-input"
-	 (lambda (bindings)
+	 (lambda (input-field bindings)
 	   (let loop ((sum 0)
 		      (checkboxes checkboxes))
 	     (if (null? checkboxes)

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

@@ -32,6 +32,10 @@ test"))
     (define radios (map radio radio-elements))
     (define checkbox (make-annotated-checkbox-input-field "hooray!"))
 
+    (define submit (make-submit-button))
+    (define image  (make-image-button "/img/221.gif"))
+    (define reset  (make-reset-button))
+
     (define (translate-line-breaks text)
       (let lp ((result '())
 	       (text text))
@@ -65,7 +69,7 @@ test"))
 			(p "called " ,global " times")
 			(p "Choose an annotated address:" (br)
 			   (ul
-			    (li (url ,(addr new-url "Eva Gottwald") "ab=ba"))
+			    (li (url ,(addr new-url "Zoe") "ab=ba"))
 			    (li (url ,(addr new-url "be<ta") "be<ta"))
 			    (li  (url ,(addr new-url) "<nothing>"))))
 			(p "Or choose an annotated callback" (br)
@@ -93,8 +97,7 @@ test"))
 							'(nbsp) '(nbsp)))
 						radio-elements))))
 			     (tr (td "Checkbox:") (td ,checkbox)))
-			    ,(make-submit-button) ,(make-reset-button) (br)
+			    ,submit ,reset (br) ,image))
-			    ,(make-image-button "/img/221.gif")))
 			(hr)
 			(p (url "/" "Return to main menu.")))))))
 	     (bindings (get-bindings req))
@@ -107,6 +110,9 @@ test"))
 	     (textarea-text (input-field-value textarea bindings))
 	     (radio-result (input-field-value (radio #f) bindings))
 	     (checkbox-result (input-field-value checkbox bindings))
+	     (submit-result (returned-via? submit bindings))
+	     (reset-result (returned-via? reset bindings))
+	     (image-result (returned-via image bindings))
 	     (result
 	      (cond
 	       ((returned-via? addr bindings) =>
@@ -114,7 +120,9 @@ test"))
 		  (format #f "returned via annotated string ~s" string)))
 	       (else
 		(set-text-input-field-value! text text-entered)
+		(format #t "passed1 ")
 		(only-select-selected! select selected (cdr selections))
+		(format #t "passed2 ")
 		(only-select-selected! select2 (list selected2) (car selections))
 		(if number-entered
 		    (set-number-input-field-value! number number-entered))
@@ -133,7 +141,10 @@ test"))
 		(if checkbox-result
 		    (check-checkbox-input-field! checkbox)
 		    (uncheck-checkbox-input-field! checkbox))
-		`(p "Returned via submit" (br)
+		`(p ,(cond
+		      (image-result (format #f "Returned via image ~s" image-result))
+		      (submit-result "Returned via submit")
+		      (else "Don't know how you did return.")) (br)
 		    "Bindings were: " ,(format #f "~s" bindings) (br)
 		    (table 
 		     (@ (valign "top"))
@@ -151,7 +162,6 @@ test"))
 		     (tr (td "Radio:") (td ,(format #f "~s" radio-result)))
 		     (tr (td "Checkbox:") (td ,(format #f "~s" checkbox-result)))))
 		    ))))
-
 	(set! global (+ 1 global))
 	(send-html/suspend
 	 (lambda (continue)
@@ -175,9 +185,11 @@ test"))
 			 (url "/" "Return to main menu.")))))))
 
     (define (only-select-selected! sel-if selected indices)
+      (format #t "called only-select-selected! with ~s  ~s  ~s~%" sel-if selected indices)
       (for-each (lambda (index)
 		  (unselect-sel-if-option! index sel-if))
 		(iota (length (cdr selections))))
+      (format #t "passeed 3 ")
       (for-each (lambda (selected)
 		  (select-sel-if-option! 
 		   (list-index (lambda (s) (string=? s selected))