From e6219740b8a85f9e8d006835ff9b34dc0f4e2435 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 18 Aug 2010 12:45:53 -0600 Subject: [PATCH] Correcting problems in Horace's path --- collects/tests/web-server/formlets-test.rkt | 154 +++++++++++------- collects/web-server/formlets/input.rkt | 106 ++++++------ .../web-server/scribblings/formlets.scrbl | 15 +- 3 files changed, 150 insertions(+), 125 deletions(-) diff --git a/collects/tests/web-server/formlets-test.rkt b/collects/tests/web-server/formlets-test.rkt index 17fa9ff589..99d2a6c2f1 100644 --- a/collects/tests/web-server/formlets-test.rkt +++ b/collects/tests/web-server/formlets-test.rkt @@ -152,18 +152,110 @@ (test-process (make-input* (lambda (n) n)) empty) empty) - ; XXX Do we need to test "input" ? + ; XXX input process + ; XXX input output (test-equal? "text-input" (->cons (test-process (text-input) (list (make-binding:form #"input_0" #"value")))) (cons #"input_0" #"value")) + ; XXX output + (test-equal? "password-input" (->cons (test-process (password-input) (list (make-binding:form #"input_0" #"value")))) (cons #"input_0" #"value")) + ; XXX output + (test-equal? "checkbox" (->cons (test-process (checkbox #"start" #t) (list (make-binding:form #"input_0" #"value")))) (cons #"input_0" #"value")) + ; XXX output + ; XXX radio process + ; XXX radio output + + ; XXX submit process + ; XXX submit output + + ; XXX reset process + ; XXX reset output + + ; XXX file-upload process + ; XXX file-upload output + + ; XXX hidden process + ; XXX hidden output + + ; BUTTON element + ; XXX test-process + (test-equal? "button" + (test-display (button #"button" #"click me")) + '((button ((name "input_0") (type "button")) "click me"))) + (test-equal? "button" + (test-display (button #"button" #"click me" #:disabled #t)) + '((button ((name "input_0") (type "button") (disabled "true")) "click me"))) + (test-equal? "button" + (test-display (button #"button" #"click me" #:disabled #f)) + '((button ((name "input_0") (type "button")) "click me"))) + (test-equal? "button" + (test-display (button #"button" #"click me" #:value #"b1")) + '((button ((name "input_0") (type "button") (value "b1")) "click me"))) + (test-equal? "button" + (test-display (button #"button" #"click me" #:disabled #t #:value #"b2")) + '((button + ((name "input_0") (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 ((name "input_0") (src "http://h.d.com/1") (alt "pic"))))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:height 12)) + '((img ((name "input_0") (src "http://h.d.com/1") (alt "pic") (height "12"))))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:longdesc #"longer desc")) + '((img + ((name "input_0") + (src "http://h.d.com/1") + (alt "pic") + (longdesc "longer desc"))))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:usemap #"#map")) + '((img + ((name "input_0") (src "http://h.d.com/1") (alt "pic") (usemap "#map"))))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:width 50)) + '((img ((name "input_0") (src "http://h.d.com/1") (alt "pic") (width "50"))))) + (test-equal? "img" + (test-display (img #"pic" #"http://h.d.com/1" #:height 12 #:longdesc #"longer desc" #:usemap #"#map" #:width 50)) + '((img + ((name "input_0") + (src "http://h.d.com/1") + (alt "pic") + (height "12") + (longdesc "longer desc") + (usemap "#map") + (width "50"))))) + + ; TEXTAREA element + (test-equal? "textarea-input" + (binding:form-value (test-process (textarea-input) (list (make-binding:form #"input_0" #"value")))) + #"value") + (test-equal? "textarea-input" + (test-display (textarea-input)) + '((textarea ([name "input_0"]) ""))) + (test-equal? "textarea-input" + (test-display (textarea-input #:rows 80)) + '((textarea ([name "input_0"] [rows "80"]) ""))) + (test-equal? "textarea-input" + (test-display (textarea-input #:cols 80)) + '((textarea ([name "input_0"] [cols "80"]) ""))) + (test-equal? "textarea-input" + (test-display (textarea-input #:cols 80 #:rows 70)) + '((textarea ([name "input_0"] [rows "70"] [cols "80"]) ""))) + + ; multiselect (test-equal? "multiselect-input" (test-process (multiselect-input (list 1 2 3)) (list (make-binding:form #"input_0" #"0"))) @@ -177,9 +269,9 @@ (test-process (multiselect-input (list 1 2 3)) empty) empty) + ; XXX output - ; XXX check output - + ; select (test-equal? "select-input" (test-process (select-input (list 1 2 3)) (list (make-binding:form #"input_0" #"0"))) @@ -194,6 +286,7 @@ (lambda () (test-process (select-input (list 1 2 3)) empty))) + ; XXX output (test-equal? "required" (test-process (required (text-input)) (list (make-binding:form #"input_0" #"value"))) @@ -210,61 +303,6 @@ (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") - (test-equal? "textarea-input" - (test-display (textarea-input)) - '((textarea ([name "input_0"]) ""))) - (test-equal? "textarea-input" - (test-display (textarea-input #:rows 80)) - '((textarea ([name "input_0"] [rows "80"]) ""))) - (test-equal? "textarea-input" - (test-display (textarea-input #:cols 80)) - '((textarea ([name "input_0"] [cols "80"]) ""))) - (test-equal? "textarea-input" - (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 index 924d00a5fc..6dc17a09bd 100755 --- a/collects/web-server/formlets/input.rkt +++ b/collects/web-server/formlets/input.rkt @@ -52,7 +52,6 @@ (define (input #:type [type "text"] #:value [value #f] - #:name [name #f] #:size [size #f] #:max-length [max-length #f] #:read-only? [read-only? #f] @@ -65,7 +64,6 @@ (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")))) @@ -73,7 +71,6 @@ (define (text-input #:value [value #f] - #:name [name #f] #:size [size #f] #:max-length [max-length #f] #:read-only? [read-only? #f] @@ -81,7 +78,6 @@ (input #:type "text" #:value value - #:name name #:size size #:max-length max-length #:read-only? read-only? @@ -89,7 +85,6 @@ (define (password-input #:value [value #f] - #:name [name #f] #:size [size #f] #:max-length [max-length #f] #:read-only? [read-only? #f] @@ -97,77 +92,65 @@ (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]) +(define (file-upload #:attributes [attrs empty]) (input #:type "file" - #:name name #:attributes attrs)) -(define (hidden #:name [name #f] - #:attributes [attrs empty]) +(define (hidden #:attributes [attrs empty]) (input #:type "hidden" - #:name name #:attributes attrs)) -(define (button type name +(define (button type text #:disabled [disabled #f] #:value [value #f] #:attributes [attrs empty]) (make-input (λ (n) (list 'button - (list* (list 'type (bytes->string/utf-8 type)) + (list* (list 'name n) + (list 'type (bytes->string/utf-8 type)) (append (filter list? - (list (and disabled (list 'disabled disabled)) + (list (and disabled (list 'disabled (if disabled "true" "false"))) (and value (list 'value (bytes->string/utf-8 value))))) attrs)) - (bytes->string/utf-8 name))))) + (bytes->string/utf-8 text))))) (define (img alt src #:height [height #f] @@ -178,7 +161,8 @@ (make-input (λ (n) (list 'img - (list* (list 'src (bytes->string/utf-8 src)) + (list* (list 'name n) + (list 'src (bytes->string/utf-8 src)) (list 'alt (bytes->string/utf-8 alt)) (append (filter list? @@ -234,7 +218,7 @@ (define (textarea-input #:rows [rows #f] - #:cols [cols #f]) + #:cols [cols #f]) (make-input (lambda (n) (list 'textarea @@ -246,50 +230,60 @@ "")))) (provide/contract + [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?) - (#:name (or/c false/c bytes?) - #:attributes (listof (list/c symbol? string?))) + (#: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?))) + (#: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?)))] + (#: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?))) + (#: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?))) + (#: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?)))] + (#: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?))] + (#: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?)))] + (#: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?) @@ -303,9 +297,9 @@ (formlet/c any/c))] [textarea-input (() (#:rows number? - #:cols number?) + #:cols number?) . ->* . - (formlet/c string?))]) + (formlet/c (or/c false/c binding?)))]) ; High-level (define (required f) diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl index 0936465138..bc7637b0f6 100755 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -1,6 +1,7 @@ #lang scribble/doc @(require "web-server.rkt") @(require (for-label web-server/servlet + racket/list xml)) @(define xexpr @tech[#:doc '(lib "xml/xml.scrbl")]{X-expression}) @@ -286,7 +287,6 @@ 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] @@ -296,7 +296,6 @@ 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] @@ -307,13 +306,12 @@ These @tech{formlet}s are the main combinators for form input. @defproc[(textarea-input [#:rows rows (or/c false/c number?) #f] [#:cols cols (or/c false/c number?) #f]) - (formlet/c string?)]{ + (formlet/c (or/c false/c binding?))]{ 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 an INPUT element with the CHECKBOX type and the attributes given in the arguments. @@ -321,34 +319,29 @@ These @tech{formlet}s are the main combinators for form input. @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]) +@defproc[(file-upload [#: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]) +@defproc[(hidden [#: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. }