diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm index 22502b8..3185855 100644 --- a/scheme/httpd/surflets/packages.scm +++ b/scheme/httpd/surflets/packages.scm @@ -110,11 +110,13 @@ extract-single-binding generate-input-field-name make-input-field + make-upper-input-field make-text-input-field make-password-input-field make-number-input-field make-textarea-input-field make-select-input-field + make-checkbox-input-field make-submit-button input-field-value diff --git a/scheme/httpd/surflets/surflets.scm b/scheme/httpd/surflets/surflets.scm index f6c3308..3edaec8 100644 --- a/scheme/httpd/surflets/surflets.scm +++ b/scheme/httpd/surflets/surflets.scm @@ -172,16 +172,18 @@ ;;; defines input-fields for servlets (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? (name input-field-name) (transformer input-field-transformer) (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 (lambda (input-field) - (list 'input-field (input-field-name input-field)))) + (list 'input-field + (input-field-name input-field)))) ;; FIXME: consider creating small names (define generate-input-field-name @@ -193,7 +195,10 @@ (define identity (lambda (a) a)) (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) (let ((name (generate-input-field-name "text"))) @@ -252,6 +257,24 @@ `(option ,option))) 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 (define (make-radio-input-field values . maybe-further-attributes) (let ((name (generate-input-field-name "radio"))) @@ -285,9 +308,12 @@ `(input (@ (type "submit") ,@maybe-further-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) => (lambda (binding) ((input-field-transformer input-field) (cdr binding))))