diff --git a/collects/tests/web-server/formlets-test.rkt b/collects/tests/web-server/formlets-test.rkt index f7a0938f2b..17fa9ff589 100644 --- a/collects/tests/web-server/formlets-test.rkt +++ b/collects/tests/web-server/formlets-test.rkt @@ -152,6 +152,8 @@ (test-process (make-input* (lambda (n) n)) empty) empty) + ; XXX Do we need to test "input" ? + (test-equal? "text-input" (->cons (test-process (text-input) (list (make-binding:form #"input_0" #"value")))) (cons #"input_0" #"value")) @@ -208,6 +210,7 @@ (test-process (default #"def" (text-input)) empty) #"def") + ; TEXTAREA element (test-equal? "textarea-input" (test-process (textarea-input) (list (make-binding:form #"input_0" #"value"))) "value") @@ -224,6 +227,44 @@ (test-display (textarea-input #:cols 80 #:rows 70)) '((textarea ([name "input_0"] [rows "70"] [cols "80"]) ""))) + ; BUTTON element + ; XXX test-process + (test-equal? "button" + (test-display (button #"button" #"click me")) + '((button ([type "button"]) "click me"))) + (test-equal? "button" + (test-display (button #"button" #"click me" #:disabled #t)) + '((button ([type "button"] [disabled "true"]) "click me"))) + (test-equal? "button" + (test-display (button #"button" #"click me" #:value #"b1")) + '((button ([type "button"] [value "b1"]) "click me"))) + (test-equal? "button" + (test-display (button #"button" #"click me" #:disabled #t #:value #"b2")) + '((button ([type "button"] [disabled "true"] [value "b2"]) "click me"))) + + + ; IMG elements + ; XXX test-process + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1")) + '((img ([alt "pic"] [src "http://h.d.com/1"])))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:height 12)) + '((img ([alt "pic"] [src "http://h.d.com/1"] [height "12"])))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:longdesc #"longer desc")) + '((img ([alt "pic"] [src "http://h.d.com/1"] [longdesc "longer desc"])))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:usemap #"#map")) + '((img ([alt "pic"] [src "http://h.d.com/1"] [usemap "#map"])))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:width 50)) + '((img ([alt "pic"] [src "http://h.d.com/1"] [width "50"])))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:height 12 #:longdesc #"longer desc" #:usemap #"#map" #:width 50)) + '((img ([alt "pic"] [src "http://h.d.com/1"] [height "12"] [longdesc "longer desc"] [usemap "#map"] [width "50"])))) + + (test-equal? "to-string" (test-process (to-string (required (text-input))) (list (make-binding:form #"input_0" #"value"))) "value") diff --git a/collects/web-server/formlets/input.rkt b/collects/web-server/formlets/input.rkt old mode 100644 new mode 100755 index 51241e9fdc..924d00a5fc --- a/collects/web-server/formlets/input.rkt +++ b/collects/web-server/formlets/input.rkt @@ -9,6 +9,7 @@ ; Low-level (define (next-name i) (values (format "input_~a" i) (add1 i))) + (define (make-input* render) (lambda (i) (let-values ([(w i) (next-name i)]) @@ -19,6 +20,7 @@ #:when (bytes=? wb (binding-id b))) b)) i)))) + (define (make-input render) (lambda (i) (let-values ([(w i) (next-name i)]) @@ -47,9 +49,10 @@ #;[binding:form/default (bytes? . -> . (formlet/c (binding? . -> . bytes?)))]) ; HTML Spec -(define (text-or-password - #:password? password? +(define (input + #:type [type "text"] #:value [value #f] + #:name [name #f] #:size [size #f] #:max-length [max-length #f] #:read-only? [read-only? #f] @@ -58,11 +61,11 @@ (lambda (n) (list 'input (list* (list 'name n) - (list 'type - (if password? "password" "text")) + (list 'type type) (append (filter list? (list (and value (list 'value (bytes->string/utf-8 value))) + (and name (list 'name (bytes->string/utf-8 name))) (and size (list 'size (number->string size))) (and max-length (list 'maxlength (number->string max-length))) (and read-only? (list 'readonly "true")))) @@ -70,13 +73,15 @@ (define (text-input #:value [value #f] + #:name [name #f] #:size [size #f] #:max-length [max-length #f] #:read-only? [read-only? #f] #:attributes [attrs empty]) - (text-or-password - #:password? #f + (input + #:type "text" #:value value + #:name name #:size size #:max-length max-length #:read-only? read-only? @@ -84,42 +89,104 @@ (define (password-input #:value [value #f] + #:name [name #f] #:size [size #f] #:max-length [max-length #f] #:read-only? [read-only? #f] #:attributes [attrs empty]) - (text-or-password - #:password? #t + (input + #:type "password" #:value value + #:name name #:size size #:max-length max-length #:read-only? read-only? #:attributes attrs)) (define (checkbox value checked? + #:name [name #f] #:attributes [attrs empty]) + (input + #:type "checkbox" + #:value value + #:name name + #:attributes + (if checked? (append (list (list 'checked "true")) attrs) attrs))) + +(define (radio value checked? + #:name [name #f] + #:attributes [attrs empty]) + (input + #:type "radio" + #:name name + #:attributes + (if checked? (append (list (list 'checked "true")) attrs) attrs))) + +(define (submit value + #:name [name #f] + #:attributes [attrs empty]) + (input + #:type "submit" + #:name name + #:value value + #:attributes attrs)) + +(define (reset value + #:name [name #f] + #:attributes [attrs empty]) + (input + #:type "reset" + #:name name + #:value value + #:attributes attrs)) + +(define (file-upload #:name [name #f] + #:attributes [attrs empty]) + (input + #:type "file" + #:name name + #:attributes attrs)) + +(define (hidden #:name [name #f] + #:attributes [attrs empty]) + (input + #:type "hidden" + #:name name + #:attributes attrs)) + +(define (button type name + #:disabled [disabled #f] + #:value [value #f] + #:attributes [attrs empty]) (make-input - (lambda (n) - (list 'input - (list* (list 'name n) - (list 'type "checkbox") - (list 'value (bytes->string/utf-8 value)) - (append (if checked? (list (list 'checked "true")) empty) - attrs)))))) + (λ (n) + (list 'button + (list* (list 'type (bytes->string/utf-8 type)) + (append + (filter list? + (list (and disabled (list 'disabled disabled)) + (and value (list 'value (bytes->string/utf-8 value))))) + attrs)) + (bytes->string/utf-8 name))))) -; XXX radio - -; XXX submit - -; XXX reset - -; XXX file - -; XXX hidden - -; XXX image - -; XXX button +(define (img alt src + #:height [height #f] + #:longdesc [ldesc #f] + #:usemap [map #f] + #:width [width #f] + #:attributes [attrs empty]) + (make-input + (λ (n) + (list 'img + (list* (list 'src (bytes->string/utf-8 src)) + (list 'alt (bytes->string/utf-8 alt)) + (append + (filter list? + (list (and height (list 'height (number->string height))) + (and ldesc (list 'longdesc (bytes->string/utf-8 ldesc))) + (and map (list 'usemap (bytes->string/utf-8 map))) + (and width (list 'width (number->string width))))) + attrs)))))) (define (multiselect-input l #:multiple? [multiple? #t] @@ -167,54 +234,78 @@ (define (textarea-input #:rows [rows #f] - #:cols [cols #f]) - (to-string - (required - (make-input - (lambda (n) - (list 'textarea - (list* (list 'name n) - (append - (filter list? - (list (and rows (list 'rows (number->string rows))) - (and cols (list 'cols (number->string cols))))))) - "")))))) + #:cols [cols #f]) + (make-input + (lambda (n) + (list 'textarea + (list* (list 'name n) + (append + (filter list? + (list (and rows (list 'rows (number->string rows))) + (and cols (list 'cols (number->string cols))))))) + "")))) (provide/contract - [multiselect-input (->* (sequence?) - (#:multiple? boolean? - #:selected? (any/c . -> . boolean?) - #:display (any/c . -> . pretty-xexpr/c)) - (formlet/c (listof any/c)))] - [select-input (->* (sequence?) - (#:selected? (any/c . -> . boolean?) - #:display (any/c . -> . pretty-xexpr/c)) - (formlet/c any/c))] + [checkbox ((bytes? boolean?) + (#:name (or/c false/c bytes?) + #:attributes (listof (list/c symbol? string?))) + . ->* . + (formlet/c (or/c false/c binding?)))] + [radio ((bytes? boolean?) + (#:name (or/c false/c bytes?) + #:attributes (listof (list/c symbol? string?))) + . ->* . + (formlet/c (or/c false/c binding?)))] + [submit ((bytes?) + (#:name (or/c false/c bytes?) + #:attributes (listof (list/c symbol? string?))) + . ->* . + (formlet/c (or/c false/c binding?)))] + [reset ((bytes?) + (#:name (or/c false/c bytes?) + #:attributes (listof (list/c symbol? string?))) + . ->* . + (formlet/c (or/c false/c binding?)))] + [file-upload (() + (#:name (or/c false/c bytes?) + #:attributes (listof (list/c symbol? string?))) + . ->* . + (formlet/c (or/c false/c binding?)))] + [hidden (() + (#:name (or/c false/c bytes?) + #:attributes (listof (list/c symbol? string?))) + . ->* . + (formlet/c (or/c false/c binding?)))] + [img ((bytes? bytes?) + (#:height (or/c false/c exact-nonnegative-integer?) + #:longdesc (or/c false/c bytes?) + #:usemap (or/c false/c bytes?) + #:width (or/c false/c exact-nonnegative-integer?) + #:attributes (listof (list/c symbol? string?))) + . ->* . + (formlet/c string?))] + [button ((bytes? bytes?) + (#:disabled boolean? + #:value (or/c false/c bytes?) + #:attributes (listof (list/c symbol? string?))) + . ->* . + (formlet/c (or/c false/c binding?)))] + [multiselect-input ((sequence?) + (#:multiple? boolean? + #:selected? (any/c . -> . boolean?) + #:display (any/c . -> . pretty-xexpr/c)) + . ->* . + (formlet/c (listof any/c)))] + [select-input ((sequence?) + (#:selected? (any/c . -> . boolean?) + #:display (any/c . -> . pretty-xexpr/c)) + . ->* . + (formlet/c any/c))] [textarea-input (() (#:rows number? #:cols number?) . ->* . - (formlet/c string?))] - [text-input (() - (#:value (or/c false/c bytes?) - #:size (or/c false/c exact-nonnegative-integer?) - #:max-length (or/c false/c exact-nonnegative-integer?) - #:read-only? boolean? - #:attributes (listof (list/c symbol? string?))) - . ->* . - (formlet/c (or/c false/c binding?)))] - [password-input (() - (#:value (or/c false/c bytes?) - #:size (or/c false/c exact-nonnegative-integer?) - #:max-length (or/c false/c exact-nonnegative-integer?) - #:read-only? boolean? - #:attributes (listof (list/c symbol? string?))) - . ->* . - (formlet/c (or/c false/c binding?)))] - [checkbox ((bytes? boolean?) - (#:attributes (listof (list/c symbol? string?))) - . ->* . - (formlet/c (or/c false/c binding?)))]) + (formlet/c string?))]) ; High-level (define (required f) diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl old mode 100644 new mode 100755 index 2408450f60..0936465138 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -277,7 +277,7 @@ These @tech{formlet}s are the main combinators for form input. (formlet/c (or/c false/c binding?))]{ This @tech{formlet} is rendered with @racket[render], which is passed the input name, and results in the extracted @racket[binding]. -} +} @defproc[(make-input* [render (string? . -> . xexpr/c)]) (formlet/c (listof binding?))]{ @@ -286,6 +286,7 @@ These @tech{formlet}s are the main combinators for form input. } @defproc[(text-input [#:value value (or/c false/c bytes?) #f] + [#:name name (or/c false/c bytes?) #f] [#:size size (or/c false/c exact-nonnegative-integer?) #f] [#:max-length max-length (or/c false/c exact-nonnegative-integer?) #f] [#:read-only? read-only? boolean? #f] @@ -295,6 +296,7 @@ These @tech{formlet}s are the main combinators for form input. } @defproc[(password-input [#:value value (or/c false/c bytes?) #f] + [#:name name (or/c false/c bytes?) #f] [#:size size (or/c false/c exact-nonnegative-integer?) #f] [#:max-length max-length (or/c false/c exact-nonnegative-integer?) #f] [#:read-only? read-only? boolean? #f] @@ -302,20 +304,75 @@ These @tech{formlet}s are the main combinators for form input. (formlet/c (or/c false/c binding?))]{ This @tech{formlet} renders using an INPUT element with the PASSWORD type and the attributes given in the arguments. } - + @defproc[(textarea-input [#:rows rows (or/c false/c number?) #f] [#:cols cols (or/c false/c number?) #f]) (formlet/c string?)]{ - This @tech{formlet} renders using an TEXTAREA element. + This @tech{formlet} renders using an TEXTAREA element with attributes given in the arguments. } @defproc[(checkbox [value bytes?] [checked? boolean?] + [#:name name (or/c false/c bytes?) #f] [#:attributes attrs (listof (list/c symbol? string?)) empty]) (formlet/c (or/c false/c binding?))]{ - This @tech{formlet} renders using a INPUT elemen with the CHECKBOX type and the attributes given in the arguments. + This @tech{formlet} renders using an INPUT element with the CHECKBOX type and the attributes given in the arguments. } +@defproc[(radio [value bytes?] + [checked? boolean?] + [#:name name (or/c false/c bytes?) #f] + [#:attributes attrs (listof (list/c symbol? string?)) empty]) + (formlet/c (or/c false/c binding?))]{ + This @tech{formlet} renders using an INPUT element with the RADIO type and the attributes given in the arguments. +} + +@defproc[(submit [value bytes?] + [#:name name (or/c false/c bytes?) #f] + [#:attributes attrs (listof (list/c symbol? string?)) empty]) + (formlet/c (or/c false/c binding?))]{ + This @tech{formlet} renders using an INPUT element with the SUBMIT type and the attributes given in the arguments. +} + +@defproc[(reset [value bytes?] + [#:name name (or/c false/c bytes?) #f] + [#:attributes attrs (listof (list/c symbol? string?)) empty]) + (formlet/c (or/c false/c binding?))]{ + This @tech{formlet} renders using an INPUT element with the RESET type and the attributes given in the arguments. +} + +@defproc[(file-upload [#:name name (or/c false/c bytes?) #f] + [#:attributes attrs (listof (list/c symbol? string?)) empty]) + (formlet/c (or/c false/c binding?))]{ + This @tech{formlet} renders using an INPUT element with the FILE type and the attributes given in the arguments. +} + +@defproc[(hidden [#:name name (or/c false/c bytes?) #f] + [#:attributes attrs (listof (list/c symbol? string?)) empty]) + (formlet/c (or/c false/c binding?))]{ + This @tech{formlet} renders using an INPUT element with HIDDEN type and the attributes given in the arguments. +} + +@defproc[(img [alt bytes?] + [src bytes?] + [#:height height (or/c false/c exact-nonnegative-integer?) #f] + [#:longdesc ldesc (or/c false/c bytes?) #f] + [#:usemap map (or/c false/c bytes?) #f] + [#:width width (or/c false/c exact-nonnegative-integer?) #f] + [#:attributes attrs (listof (list/c symbol? string?)) empty]) + (formlet/c string?)]{ + This @tech{formlet} renders using an IMG element with the attributes given in the arguments. +} + +@defproc[(button [type bytes?] + [button-text bytes?] + [#:disabled disabled boolean? #f] + [#:value value (or/c false/c bytes?) #f] + [#:attributes attrs (listof (list/c symbol? string?)) empty]) + (formlet/c (or/c false/c binding?))]{ + This @tech{formlet} renders using a BUTTON element with the attributes given in the arguments. @racket[button-text] is the text that will appear on the button when rendered. +} + @defproc[(multiselect-input [l sequence?] [#:multiple? multiple? boolean? #t] [#:selected? selected? (any/c . -> . boolean?) (λ (x) #f)]