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

added upper-input-field type

This commit is contained in:
interp 2002-09-27 17:29:31 +00:00
parent 37aac43aa9
commit 0b6e68a2c0
2 changed files with 32 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/httpd/surflets/packages.scm
View File

@ -110,11 +110,13 @@
extract-single-binding extract-single-binding
generate-input-field-name generate-input-field-name
make-input-field make-input-field
make-upper-input-field
make-text-input-field make-text-input-field
make-password-input-field make-password-input-field
make-number-input-field make-number-input-field
make-textarea-input-field make-textarea-input-field
make-select-input-field make-select-input-field
make-checkbox-input-field
make-submit-button make-submit-button
input-field-value input-field-value

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

@ -172,16 +172,18 @@
;;; defines input-fields for servlets ;;; defines input-fields for servlets
(define-record-type input-field :input-field (define-record-type input-field :input-field
(real-make-input-field name transformer HTML-tree) (real-make-input-field name transformer HTML-tree get-bindings?)
input-field? input-field?
(name input-field-name) (name input-field-name)
(transformer input-field-transformer) (transformer input-field-transformer)
(attributes input-field-attributes) (attributes input-field-attributes)
(HTML-tree input-field-HTML-tree)) (HTML-tree input-field-HTML-tree)
(get-bindings? input-field-get-bindings?))
(define-record-discloser :input-field (define-record-discloser :input-field
(lambda (input-field) (lambda (input-field)
(list 'input-field (input-field-name input-field)))) (list 'input-field
(input-field-name input-field))))
;; FIXME: consider creating small names ;; FIXME: consider creating small names
(define generate-input-field-name (define generate-input-field-name
@ -193,7 +195,10 @@
(define identity (lambda (a) a)) (define identity (lambda (a) a))
(define (make-input-field name transformer HTML-tree) (define (make-input-field name transformer HTML-tree)
(list 'input-field (real-make-input-field name transformer HTML-tree))) (list 'input-field (real-make-input-field name transformer HTML-tree #f)))
(define (make-upper-input-field transformer HTML-tree)
(list 'input-field (real-make-input-field #f transformer HTML-tree #t)))
(define (make-text-input-field . maybe-further-attributes) (define (make-text-input-field . maybe-further-attributes)
(let ((name (generate-input-field-name "text"))) (let ((name (generate-input-field-name "text")))
@ -252,6 +257,24 @@
`(option ,option))) `(option ,option)))
options))))) options)))))
(define (make-checkbox-input-field . maybe-further-attributes)
(let* ((name (generate-input-field-name "checkbox"))
(value (if (and (pair? maybe-further-attributes)
(string? (car maybe-further-attributes)))
(car maybe-further-attributes)
#f))
(further-attributes (if value
(cdr maybe-further-attributes)
maybe-further-attributes)))
(make-input-field
name
identity
`(input (@ ((type "checkbox")
(name ,name)
,(if value `(value ,value) '())
,@further-attributes))))))
;; in work ;; in work
(define (make-radio-input-field values . maybe-further-attributes) (define (make-radio-input-field values . maybe-further-attributes)
(let ((name (generate-input-field-name "radio"))) (let ((name (generate-input-field-name "radio")))
@ -285,9 +308,12 @@
`(input (@ (type "submit") `(input (@ (type "submit")
,@maybe-further-attributes)))) ,@maybe-further-attributes))))
(define (input-field-value input-field bindings) (define (input-field-value input-field bindings)
(let ((input-field (cadr input-field))) (let ((input-field (cadr input-field)))
(cond (cond
((input-field-get-bindings? input-field)
((input-field-transformer input-field) bindings))
((assoc (input-field-name input-field) bindings) => ((assoc (input-field-name input-field) bindings) =>
(lambda (binding) (lambda (binding)
((input-field-transformer input-field) (cdr binding)))) ((input-field-transformer input-field) (cdr binding))))