diff --git a/collects/tests/web-server/formlets-test.rkt b/collects/tests/web-server/formlets-test.rkt index 4a7bcc1d71..ed9fc7868d 100644 --- a/collects/tests/web-server/formlets-test.rkt +++ b/collects/tests/web-server/formlets-test.rkt @@ -259,13 +259,67 @@ (cons #"input_0" #"value")) (test-equal? "radio" (test-display (radio #"start" #t)) - '((input ((name "input_0") (type "radio") (checked "true"))))) + '((input ((name "input_0") (type "radio") (value "start") (checked "true"))))) (test-equal? "radio" (test-display (radio #"start" #f)) - '((input ((name "input_0") (type "radio"))))) + '((input ((name "input_0") (type "radio") (value "start"))))) (test-equal? "radio" (test-display (radio #"start" #t #:attributes '([test "Test"]))) - '((input ((name "input_0") (type "radio") (checked "true") (test "Test"))))) + '((input ((name "input_0") (type "radio") (value "start") (checked "true") (test "Test"))))) + + ; radio-group + (test-equal? "radio-group" + (test-process (radio-group (list "1" "2" "3")) + (list (make-binding:form #"input_0" #"0"))) + "1") + (test-equal? "radio-group" + (test-process (radio-group (list 1 2 3) #:display number->string) + (list (make-binding:form #"input_0" #"0"))) + 1) + (test-equal? "radio-group" + (test-process (radio-group (list 1 2 3) #:display number->string) + (list (make-binding:form #"input_0" #"0") + (make-binding:form #"input_0" #"1"))) + 1) + (test-equal? "radio-group" + (test-display (radio-group + (list 1 2 3) + #:display number->string + #:checked? even? + #:attributes (λ (e) (list (list 'plus-one (number->string (add1 e))))))) + '((input ((name "input_0") (type "radio") (value "0") (plus-one "2"))) + "1" + (input ((name "input_0") (type "radio") (value "1") (checked "true") (plus-one "3"))) + "2" + (input ((name "input_0") (type "radio") (value "2") (plus-one "4"))) + "3")) + + ; checkbox-group + (test-equal? "checkbox-group" + (test-process (checkbox-group (list "1" "2" "3")) + (list (make-binding:form #"input_0" #"0"))) + (list "1")) + (test-equal? "checkbox-group" + (test-process (checkbox-group (list 1 2 3) #:display number->string) + (list (make-binding:form #"input_0" #"0"))) + (list 1)) + (test-equal? "checkbox-group" + (test-process (checkbox-group (list 1 2 3) #:display number->string) + (list (make-binding:form #"input_0" #"0") + (make-binding:form #"input_0" #"1"))) + (list 1 2)) + (test-equal? "checkbox-group" + (test-display (checkbox-group + (list 1 2 3) + #:display number->string + #:checked? even? + #:attributes (λ (e) (list (list 'plus-one (number->string (add1 e))))))) + '((input ((name "input_0") (type "checkbox") (value "0") (plus-one "2"))) + "1" + (input ((name "input_0") (type "checkbox") (value "1") (checked "true") (plus-one "3"))) + "2" + (input ((name "input_0") (type "checkbox") (value "2") (plus-one "4"))) + "3")) ; submit (test-equal? "submit" diff --git a/collects/web-server/formlets/input.rkt b/collects/web-server/formlets/input.rkt index 6504fc635f..ff1526b8d5 100644 --- a/collects/web-server/formlets/input.rkt +++ b/collects/web-server/formlets/input.rkt @@ -10,17 +10,22 @@ (define (next-name i) (values (format "input_~a" i) (add1 i))) -(define (make-input* render) +(define (make-input*/forest render) (lambda (i) (let-values ([(w i) (next-name i)]) (define wb (string->bytes/utf-8 w)) - (values (list (render w)) + (values (render w) (lambda (env) (for/list ([b (in-list env)] #:when (bytes=? wb (binding-id b))) b)) i)))) +(define (make-input* render) + (make-input*/forest + (lambda (w) + (list (render w))))) + (define (make-input render) (lambda (i) (let-values ([(w i) (next-name i)]) @@ -109,9 +114,74 @@ #:attributes [attrs empty]) (input #:type "radio" + #:value value #:attributes (if checked? (append (list (list 'checked "true")) attrs) attrs))) +(define (input-group l + #:kind kind + #:attributes [attrs (λ (x) empty)] + #:checked? [checked? (λ (x) #f)] + #:display [display (λ (x) x)]) + (define value->element (make-hasheq)) + (define i 0) + (define (remember! e) + (define this-i + (begin0 i (set! i (add1 i)))) + (hash-set! value->element this-i e)) + (define (recall i) + (hash-ref value->element i + (λ () (error 'input-group "Invalid selection: ~e" i)))) + (for ([e l]) + (remember! e)) + (define (radio-first l) + (if (string=? kind "radio") + (first l) + l)) + (cross + (pure + (lambda (bs) + (radio-first + (map (compose recall string->number + bytes->string/utf-8 + binding:form-value) + bs)))) + (make-input*/forest + (lambda (name) + (apply append + (for/list ([vn (in-range i)]) + (define e (hash-ref value->element vn)) + (define v (number->string vn)) + (list + `(input ([name ,name] + [type ,kind] + [value ,v] + ,@(if (checked? e) + '([checked "true"]) + empty) + ,@(attrs e))) + (display e)))))))) + +(define (radio-group l + #:attributes [attrs (λ (x) empty)] + #:checked? [checked? (λ (x) #f)] + #:display [display (λ (x) x)]) + (input-group l + #:kind "radio" + #:attributes attrs + #:checked? checked? + #:display display)) + +(define (checkbox-group l + #:attributes [attrs (λ (x) empty)] + #:checked? [checked? (λ (x) #f)] + #:display [display (λ (x) x)]) + (input-group l + #:kind "checkbox" + #:attributes attrs + #:checked? checked? + #:display display)) + (define (submit value #:attributes [attrs empty]) (input @@ -265,6 +335,20 @@ (#:attributes (listof (list/c symbol? string?))) . ->* . (formlet/c (or/c false/c binding?)))] + [radio-group ((sequence?) + (#:attributes + (-> any/c (listof (list/c symbol? string?))) + #:checked? (any/c . -> . boolean?) + #:display (any/c . -> . pretty-xexpr/c)) + . ->* . + (formlet/c any/c))] + [checkbox-group ((sequence?) + (#:attributes + (-> any/c (listof (list/c symbol? string?))) + #:checked? (any/c . -> . boolean?) + #:display (any/c . -> . pretty-xexpr/c)) + . ->* . + (formlet/c (listof any/c)))] [submit ((bytes?) (#:attributes (listof (list/c symbol? string?))) . ->* . diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl index c303a15d44..7ebdc81882 100644 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -338,6 +338,34 @@ These @tech{formlet}s are the main combinators for form input. This @tech{formlet} renders using an INPUT element with the RADIO type and the attributes given in the arguments. } +@defproc[(radio-group [l sequence?] + [#:attributes attrs (any/c . -> . (listof (list/c symbol? string?))) (λ (x) empty)] + [#:checked? checked? (any/c . -> . boolean?) (λ (x) #f)] + [#:display display (any/c . -> . xexpr/c) (λ (x) x)]) + (formlet/c any/c)]{ + + This @tech{formlet} renders using a sequence of INPUT elements of +RADIO type where each element gets its attributes from @racket[attrs] +that share a single NAME. An element is checked if @racket[checked?] +returns @racket[#t]. Elements are followed by the results of +@racket[display]. The result of processing this formlet is a single +element of the sequence. +} + +@defproc[(checkbox-group [l sequence?] + [#:attributes attrs (any/c . -> . (listof (list/c symbol? string?))) (λ (x) empty)] + [#:checked? checked? (any/c . -> . boolean?) (λ (x) #f)] + [#:display display (any/c . -> . xexpr/c) (λ (x) x)]) + (formlet/c (listof any/c))]{ + + This @tech{formlet} renders using a sequence of INPUT elements of +CHECKBOX type where each element gets its attributes from +@racket[attrs] that share a single NAME. An element is checked if +@racket[checked?] returns @racket[#t]. Elements are followed by the +results of @racket[display]. The result of processing this formlet is +a list of elements of the sequence. +} + @defproc[(submit [value bytes?] [#:attributes attrs (listof (list/c symbol? string?)) empty]) (formlet/c (or/c false/c binding?))]{