diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm index 0d63ae2..caff3c1 100644 --- a/scheme/httpd/surflets/packages.scm +++ b/scheme/httpd/surflets/packages.scm @@ -157,6 +157,7 @@ make-reset-button make-image-button input-field-value + input-field-binding make-callback)) (define-structure servlets servlets-interface diff --git a/scheme/httpd/surflets/surflets.scm b/scheme/httpd/surflets/surflets.scm index d732e8f..96b71b4 100644 --- a/scheme/httpd/surflets/surflets.scm +++ b/scheme/httpd/surflets/surflets.scm @@ -230,11 +230,11 @@ ;; PRED-LIST contains list of predicates that recognizes optional ;; leading parameters. FURTHER-ATTRIBUTES is the optional parameter -;; list as got by procedure call. PREFIX-OPTIONALS returns two values: +;; list as got by procedure call. TYPED-OPTIONALS returns two values: ;; a list of the same length as PRED-LIST and a list containing the ;; left arguments that did not fit the predicates. ;; -;; With the help of PREFIX-OPTIONALS you can define a function +;; With the help of TYPED-OPTIONALS you can define a function ;; like `make-submit-button [string] [further-attributes]' this way: ;; (define (make-submit-button . args) ;; (receive (params rest-args) @@ -319,16 +319,16 @@ (or (string->number string) (error "wrong type"))) )) - (lambda maybe-further-attributes) - (let ((name (generate-input-field-name "number"))) - (optionals maybe-further-attributes - ((attributes XML-attribute?)) - (make-input-field - name - number-input-field-transformer - `(input (@ (type "text") - (name ,name) - ,(and attributes (cdr attributes)))))))) + (lambda maybe-further-attributes + (let ((name (generate-input-field-name "number"))) + (optionals maybe-further-attributes + ((attributes XML-attribute?)) + (make-input-field + name + number-input-field-transformer + `(input (@ (type "text") + (name ,name) + ,(and attributes (cdr attributes)))))))))) (define (make-password-input-field . maybe-further-attributes) (let ((name (generate-input-field-name "password"))) @@ -438,10 +438,13 @@ (value ,value) ,(and attributes (cdr attributes)))))))) -(define (make-button type button-caption attributes) - `(input (@ (type ,type) - ,(and button-caption `(value ,button-caption)) - ,(and attributes (cdr attributes))))) +(define (make-button type name button-caption attributes) + (make-input-field name + identity + `(input (@ (type ,type) + (name ,name) + ,(and button-caption `(value ,button-caption)) + ,(and attributes (cdr attributes)))))) (define (string-or-symbol? a) (or (string? a) @@ -451,44 +454,36 @@ (optionals maybe-further-attributes ((button-caption string-or-symbol?) (attributes XML-attribute?)) - (make-button "submit" button-caption attributes))) + (make-button "submit" (generate-input-field-name "submit") + button-caption attributes))) (define (make-reset-button . maybe-further-attributes) (optionals maybe-further-attributes ((button-caption string-or-symbol?) (attributes XML-attribute?)) - (make-button "reset" button-caption attributes))) + (make-button "reset" (generate-input-field-name "reset") + button-caption attributes))) (define (make-image-button image-source . maybe-further-attributes) (optionals maybe-further-attributes ((attributes XML-attribute?)) - (make-button "image" #f `(@ (src ,image-source) - ,@(if attributes (cdr attributes) '()))))) + (make-button "image" (generate-input-field-name "imgbtn") + #f `(@ (src ,image-source) + ,@(if attributes (cdr 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) => + ((real-input-field-binding input-field bindings) => (lambda (binding) ((input-field-transformer input-field) (cdr binding)))) (else (error "no such input-field" input-field bindings))))) +(define (real-input-field-binding input-field bindings) + (assoc (input-field-name input-field) bindings)) - - -;;; tests -(define number-input-field (make-number-input-field)) - -(define test - `(html - (title "My Title") - (body - (p (URL "reset" "click here to reset")) - (p (form "return-URI" (table (tr (td "Enter a number ") (td ,number-input-field ))) - ,(make-submit-button)))))) - - - +(define (input-field-binding input-field bindings) + (real-input-field-binding (cadr input-field) bindings)) \ No newline at end of file