scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

factor out transformers

This commit is contained in:
interp 2002-10-02 12:02:56 +00:00
parent c85bcfc502
commit 03eeb86a5f
1 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
scheme/httpd/surflets/surflets.scm
View File

@ -313,15 +313,19 @@
,(and attributes (cdr attributes)) ,(and attributes (cdr attributes))
)))))) ))))))
(define (make-number-input-field . maybe-further-attributes) (define make-number-input-field
(let ((number-input-field-transformer
(lambda (string)
(or (string->number string)
(error "wrong type")))
))
(lambda maybe-further-attributes)
(let ((name (generate-input-field-name "number"))) (let ((name (generate-input-field-name "number")))
(optionals maybe-further-attributes (optionals maybe-further-attributes
((attributes XML-attribute?)) ((attributes XML-attribute?))
(make-input-field (make-input-field
name name
(lambda (string) number-input-field-transformer
(or (string->number string)
(error "wrong type")))
`(input (@ (type "text") `(input (@ (type "text")
(name ,name) (name ,name)
,(and attributes (cdr attributes)))))))) ,(and attributes (cdr attributes))))))))
@ -357,14 +361,13 @@
;; preselected option: (selected) ;; preselected option: (selected)
;; changed return value: (value new-value) ;; changed return value: (value new-value)
;; returns a select input field with several options ;; returns a select input field with several options
(define (make-select-input-fields options . maybe-further-attributes) (define (make-select-input-field options . maybe-further-attributes)
(let ((name (generate-input-field-name "select"))) (let ((name (generate-input-field-name "select")))
(optionals maybe-further-attributes (optionals maybe-further-attributes
((attributes XML-attribute?)) ((attributes XML-attribute?))
(make-input-field (make-input-field
name name
(lambda (select) identity ;FIXME[extension] refer to list elements
select) ;FIXME[extension] refer to list elements
`(select (@ ((name ,name) `(select (@ ((name ,name)
,(and attributes (cdr attributes)))) ,(and attributes (cdr attributes))))
#\newline #\newline
@ -440,17 +443,19 @@
,(and button-caption `(value ,button-caption)) ,(and button-caption `(value ,button-caption))
,(and attributes (cdr attributes))))) ,(and attributes (cdr attributes)))))
(define (string-or-symbol? a)
(or (string? a)
(symbol? a)))
(define (make-submit-button . maybe-further-attributes) (define (make-submit-button . maybe-further-attributes)
(optionals maybe-further-attributes (optionals maybe-further-attributes
((button-caption (lambda (a) (or (string? a) ((button-caption string-or-symbol?)
(symbol? a))))
(attributes XML-attribute?)) (attributes XML-attribute?))
(make-button "submit" button-caption attributes))) (make-button "submit" button-caption attributes)))
(define (make-reset-button . maybe-further-attributes) (define (make-reset-button . maybe-further-attributes)
(optionals maybe-further-attributes (optionals maybe-further-attributes
((button-caption (lambda (a) (or (string? a) ((button-caption string-or-symbol?)
(symbol? a))))
(attributes XML-attribute?)) (attributes XML-attribute?))
(make-button "reset" button-caption attributes))) (make-button "reset" button-caption attributes)))