add INPUT-FIELD-BINDING
This commit is contained in:
parent
d56d7f9fce
commit
74acc71447
|
@ -157,6 +157,7 @@
|
|||
make-reset-button
|
||||
make-image-button
|
||||
input-field-value
|
||||
input-field-binding
|
||||
make-callback))
|
||||
|
||||
(define-structure servlets servlets-interface
|
||||
|
|
|
@ -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,7 +319,7 @@
|
|||
(or (string->number string)
|
||||
(error "wrong type")))
|
||||
))
|
||||
(lambda maybe-further-attributes)
|
||||
(lambda maybe-further-attributes
|
||||
(let ((name (generate-input-field-name "number")))
|
||||
(optionals maybe-further-attributes
|
||||
((attributes XML-attribute?))
|
||||
|
@ -328,7 +328,7 @@
|
|||
number-input-field-transformer
|
||||
`(input (@ (type "text")
|
||||
(name ,name)
|
||||
,(and attributes (cdr attributes))))))))
|
||||
,(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)
|
||||
(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)))))
|
||||
,(and attributes (cdr attributes))))))
|
||||
|
||||
(define (string-or-symbol? a)
|
||||
(or (string? a)
|
||||
|
@ -451,18 +454,21 @@
|
|||
(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)
|
||||
(make-button "image" (generate-input-field-name "imgbtn")
|
||||
#f `(@ (src ,image-source)
|
||||
,@(if attributes (cdr attributes) '())))))
|
||||
|
||||
(define (input-field-value input-field bindings)
|
||||
|
@ -470,25 +476,14 @@
|
|||
(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))
|
Loading…
Reference in New Issue