Some minor changes:

+ Detach TEXTAREA input field from simple input fields
  (concerning its setter) and remove WRAP? parameter from
  make-simple-default-setter
+ Rename TOLERATE-OLD-SELECT-OPTIONS to SIMPLE-OPTIONS
+ Deprecate MAKE-ANNOTATED-SELECT; it's not useful anymore
+ Merge MAKE-SELECT and REALLY-MAKE-SELECT to one function MAKE-SELECT
This commit is contained in:
interp 2003-07-13 20:08:28 +00:00
parent 4ff633e5db
commit e634526856
1 changed files with 22 additions and 27 deletions

View File

@ -39,12 +39,12 @@
,(field-attributes-default attributes)
,(field-attributes-others attributes))))))
(define (make-simple-default-setter default-pred? wrap?)
(define (make-simple-default-setter default-pred?)
(lambda (input-field value)
(if (default-pred? value)
(set-field-attributes-default!
(input-field-attributes input-field)
(if wrap? `(value ,value) value))
`(value ,value))
(error "Default value must be a number or a string or a symbol."
value))
(touch-input-field! input-field)))
@ -54,7 +54,7 @@
(define simple-default? string-or-symbol?)
(define set-simple-field-default!
(make-simple-default-setter simple-default? #t))
(make-simple-default-setter simple-default?))
;;;;;;;;;;;;;;;;;;;;
;;; Text input field
@ -74,19 +74,15 @@
(simple-field-maker "text" "number"
number-field-default? number-field-transformer))
(define set-number-field-value!
(make-simple-default-setter number-field-default? #t))
(make-simple-default-setter number-field-default?))
;;;;;;;;;;;;;;;;;;;;;;
;;; hidden input-field
;; Little workaraound, as a hidden input-field needs a value. This
;; value is propagated in the slot "default value".
;; The programmer should supply a default value for this input-field
;; as it is hidden.
(define make-hidden-field
(let ((hidden-field-generator
(simple-field-maker "hidden" "text"
simple-default? identity)))
(lambda (value . maybe-further-attributes)
(apply hidden-field-generator
(cons value maybe-further-attributes)))))
simple-default? identity))
(define set-hidden-field-value! set-simple-field-default!)
;;;;;;;;;;;;;;;;;;;;;;;;
@ -126,11 +122,13 @@
,(field-attributes-others attributes))
,(field-attributes-default attributes))))
(define set-textarea-value!
(let ((textarea-default-setter!
(make-simple-default-setter simple-default? #f)))
(lambda (textarea value)
(textarea-default-setter! textarea value))))
(define (set-textarea-value! textarea value)
(if (simple-default? value)
(set-field-attributes-default!
(input-field-attributes textarea)
value)
(error "Default value must be a string or a symbol." value))
(touch-input-field! textarea))
;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Select input field
@ -156,6 +154,8 @@
(selected? select-option-selected? really-set-select-option-selected?!)
(attributes select-option-attributes set-select-option-attributes!))
;; No check of attributes as this is done by calling function. (This
;; function isn't exported.
(define (make-select-option tag value selected? attributes)
(if (string? tag)
(really-make-select-option tag value selected?
@ -249,22 +249,17 @@
;; we accept also a simple list as an option-list. New programs should
;; use select-options-list (easily createable with
;; (map make-simple-select-option option-list))
(define (tolerate-old-select-options select-options)
(define (simple-options select-options)
(if (and (list? select-options)
(every select-option? select-options))
select-options
(map make-simple-select-option select-options)))
(define (make-select select-options . maybe-further-attributes)
(really-make-select (tolerate-old-select-options select-options)
maybe-further-attributes))
;; deprecated: Does not introduce further functionality.
(define make-annotated-select make-select)
(define (make-annotated-select select-options .
maybe-further-attributes)
(really-make-select select-options maybe-further-attributes))
(define (really-make-select select-options maybe-further-attributes)
(let ((real-select-options (tolerate-old-select-options select-options)))
(define (make-select select-options maybe-further-attributes)
(let ((real-select-options (simple-options select-options)))
(let-optionals maybe-further-attributes
((multiple? #f boolean?)
(attributes '() sxml-attribute?))