suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Correcting problems in Horace's path

Browse Source
This commit is contained in:
Jay McCarthy 2010-08-18 12:45:53 -06:00
parent 3d43c7e7ac
commit e6219740b8
3 changed files with 150 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

154
collects/tests/web-server/formlets-test.rkt
View File

@ -152,18 +152,110 @@
(test-process (make-input* (lambda (n) n)) empty) (test-process (make-input* (lambda (n) n)) empty)
empty) empty)
; XXX Do we need to test "input" ? ; XXX input process
; XXX input output
(test-equal? "text-input" (test-equal? "text-input"
(->cons (test-process (text-input) (list (make-binding:form #"input_0" #"value")))) (->cons (test-process (text-input) (list (make-binding:form #"input_0" #"value"))))
(cons #"input_0" #"value")) (cons #"input_0" #"value"))
; XXX output
(test-equal? "password-input" (test-equal? "password-input"
(->cons (test-process (password-input) (list (make-binding:form #"input_0" #"value")))) (->cons (test-process (password-input) (list (make-binding:form #"input_0" #"value"))))
(cons #"input_0" #"value")) (cons #"input_0" #"value"))
; XXX output
(test-equal? "checkbox" (test-equal? "checkbox"
(->cons (test-process (checkbox #"start" #t) (list (make-binding:form #"input_0" #"value")))) (->cons (test-process (checkbox #"start" #t) (list (make-binding:form #"input_0" #"value"))))
(cons #"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-equal? "multiselect-input"
(test-process (multiselect-input (list 1 2 3)) (test-process (multiselect-input (list 1 2 3))
(list (make-binding:form #"input_0" #"0"))) (list (make-binding:form #"input_0" #"0")))
@ -177,9 +269,9 @@
(test-process (multiselect-input (list 1 2 3)) (test-process (multiselect-input (list 1 2 3))
empty) empty)
empty) empty)
; XXX output
; XXX check output ; select
(test-equal? "select-input" (test-equal? "select-input"
(test-process (select-input (list 1 2 3)) (test-process (select-input (list 1 2 3))
(list (make-binding:form #"input_0" #"0"))) (list (make-binding:form #"input_0" #"0")))
@ -194,6 +286,7 @@
(lambda () (lambda ()
(test-process (select-input (list 1 2 3)) (test-process (select-input (list 1 2 3))
empty))) empty)))
; XXX output
(test-equal? "required" (test-equal? "required"
(test-process (required (text-input)) (list (make-binding:form #"input_0" #"value"))) (test-process (required (text-input)) (list (make-binding:form #"input_0" #"value")))
@ -210,61 +303,6 @@
(test-process (default #"def" (text-input)) empty) (test-process (default #"def" (text-input)) empty)
#"def") #"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-equal? "to-string"
(test-process (to-string (required (text-input))) (list (make-binding:form #"input_0" #"value"))) (test-process (to-string (required (text-input))) (list (make-binding:form #"input_0" #"value")))
"value") "value")

104
collects/web-server/formlets/input.rkt
View File

@ -52,7 +52,6 @@
(define (input (define (input
#:type [type "text"] #:type [type "text"]
#:value [value #f] #:value [value #f]
#:name [name #f]
#:size [size #f] #:size [size #f]
#:max-length [max-length #f] #:max-length [max-length #f]
#:read-only? [read-only? #f] #:read-only? [read-only? #f]
@ -65,7 +64,6 @@
(append (append
(filter list? (filter list?
(list (and value (list 'value (bytes->string/utf-8 value))) (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 size (list 'size (number->string size)))
(and max-length (list 'maxlength (number->string max-length))) (and max-length (list 'maxlength (number->string max-length)))
(and read-only? (list 'readonly "true")))) (and read-only? (list 'readonly "true"))))
@ -73,7 +71,6 @@
(define (text-input (define (text-input
#:value [value #f] #:value [value #f]
#:name [name #f]
#:size [size #f] #:size [size #f]
#:max-length [max-length #f] #:max-length [max-length #f]
#:read-only? [read-only? #f] #:read-only? [read-only? #f]
@ -81,7 +78,6 @@
(input (input
#:type "text" #:type "text"
#:value value #:value value
#:name name
#:size size #:size size
#:max-length max-length #:max-length max-length
#:read-only? read-only? #:read-only? read-only?
@ -89,7 +85,6 @@
(define (password-input (define (password-input
#:value [value #f] #:value [value #f]
#:name [name #f]
#:size [size #f] #:size [size #f]
#:max-length [max-length #f] #:max-length [max-length #f]
#:read-only? [read-only? #f] #:read-only? [read-only? #f]
@ -97,77 +92,65 @@
(input (input
#:type "password" #:type "password"
#:value value #:value value
#:name name
#:size size #:size size
#:max-length max-length #:max-length max-length
#:read-only? read-only? #:read-only? read-only?
#:attributes attrs)) #:attributes attrs))
(define (checkbox value checked? (define (checkbox value checked?
#:name [name #f]
#:attributes [attrs empty]) #:attributes [attrs empty])
(input (input
#:type "checkbox" #:type "checkbox"
#:value value #:value value
#:name name
#:attributes #:attributes
(if checked? (append (list (list 'checked "true")) attrs) attrs))) (if checked? (append (list (list 'checked "true")) attrs) attrs)))
(define (radio value checked? (define (radio value checked?
#:name [name #f]
#:attributes [attrs empty]) #:attributes [attrs empty])
(input (input
#:type "radio" #:type "radio"
#:name name
#:attributes #:attributes
(if checked? (append (list (list 'checked "true")) attrs) attrs))) (if checked? (append (list (list 'checked "true")) attrs) attrs)))
(define (submit value (define (submit value
#:name [name #f]
#:attributes [attrs empty]) #:attributes [attrs empty])
(input (input
#:type "submit" #:type "submit"
#:name name
#:value value #:value value
#:attributes attrs)) #:attributes attrs))
(define (reset value (define (reset value
#:name [name #f]
#:attributes [attrs empty]) #:attributes [attrs empty])
(input (input
#:type "reset" #:type "reset"
#:name name
#:value value #:value value
#:attributes attrs)) #:attributes attrs))
(define (file-upload #:name [name #f] (define (file-upload #:attributes [attrs empty])
#:attributes [attrs empty])
(input (input
#:type "file" #:type "file"
#:name name
#:attributes attrs)) #:attributes attrs))
(define (hidden #:name [name #f] (define (hidden #:attributes [attrs empty])
#:attributes [attrs empty])
(input (input
#:type "hidden" #:type "hidden"
#:name name
#:attributes attrs)) #:attributes attrs))
(define (button type name (define (button type text
#:disabled [disabled #f] #:disabled [disabled #f]
#:value [value #f] #:value [value #f]
#:attributes [attrs empty]) #:attributes [attrs empty])
(make-input (make-input
(λ (n) (λ (n)
(list 'button (list 'button
(list* (list 'type (bytes->string/utf-8 type)) (list* (list 'name n)
(list 'type (bytes->string/utf-8 type))
(append (append
(filter list? (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))))) (and value (list 'value (bytes->string/utf-8 value)))))
attrs)) attrs))
(bytes->string/utf-8 name))))) (bytes->string/utf-8 text)))))
(define (img alt src (define (img alt src
#:height [height #f] #:height [height #f]
@ -178,7 +161,8 @@
(make-input (make-input
(λ (n) (λ (n)
(list 'img (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)) (list 'alt (bytes->string/utf-8 alt))
(append (append
(filter list? (filter list?
@ -246,50 +230,60 @@
"")))) ""))))
(provide/contract (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?) [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?)))] (formlet/c (or/c false/c binding?)))]
[radio ((bytes? boolean?) [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?)))] (formlet/c (or/c false/c binding?)))]
[submit ((bytes?) [submit ((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?)))]
(formlet/c (or/c false/c binding?)))]
[reset ((bytes?) [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?)))] (formlet/c (or/c false/c binding?)))]
[file-upload (() [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?)))] (formlet/c (or/c false/c binding?)))]
[hidden (() [hidden (()
(#: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?)))]
(formlet/c (or/c false/c binding?)))]
[img ((bytes? bytes?) [img ((bytes? bytes?)
(#:height (or/c false/c exact-nonnegative-integer?) (#:height (or/c false/c exact-nonnegative-integer?)
#:longdesc (or/c false/c bytes?) #:longdesc (or/c false/c bytes?)
#:usemap (or/c false/c bytes?) #:usemap (or/c false/c bytes?)
#:width (or/c false/c exact-nonnegative-integer?) #:width (or/c false/c exact-nonnegative-integer?)
#:attributes (listof (list/c symbol? string?))) #:attributes (listof (list/c symbol? string?)))
. ->* . . ->* .
(formlet/c string?))] (formlet/c string?))]
[button ((bytes? bytes?) [button ((bytes? bytes?)
(#:disabled boolean? (#:disabled boolean?
#:value (or/c false/c bytes?) #:value (or/c false/c bytes?)
#:attributes (listof (list/c symbol? string?))) #:attributes (listof (list/c symbol? string?)))
. ->* . . ->* .
(formlet/c (or/c false/c binding?)))] (formlet/c (or/c false/c binding?)))]
[multiselect-input ((sequence?) [multiselect-input ((sequence?)
(#:multiple? boolean? (#:multiple? boolean?
#:selected? (any/c . -> . boolean?) #:selected? (any/c . -> . boolean?)
@ -303,9 +297,9 @@
(formlet/c any/c))] (formlet/c any/c))]
[textarea-input (() [textarea-input (()
(#:rows number? (#:rows number?
#:cols number?) #:cols number?)
. ->* . . ->* .
(formlet/c string?))]) (formlet/c (or/c false/c binding?)))])
; High-level ; High-level
(define (required f) (define (required f)

15
collects/web-server/scribblings/formlets.scrbl
View File

@ -1,6 +1,7 @@
#lang scribble/doc #lang scribble/doc
@(require "web-server.rkt") @(require "web-server.rkt")
@(require (for-label web-server/servlet @(require (for-label web-server/servlet
racket/list
xml)) xml))
@(define xexpr @tech[#:doc '(lib "xml/xml.scrbl")]{X-expression}) @(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] @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] [#:size size (or/c false/c exact-nonnegative-integer?) #f]
[#:max-length max-length (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] [#: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] @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] [#:size size (or/c false/c exact-nonnegative-integer?) #f]
[#:max-length max-length (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] [#: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] @defproc[(textarea-input [#:rows rows (or/c false/c number?) #f]
[#:cols cols (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. This @tech{formlet} renders using an TEXTAREA element with attributes given in the arguments.
} }
@defproc[(checkbox [value bytes?] @defproc[(checkbox [value bytes?]
[checked? boolean?] [checked? boolean?]
[#:name name (or/c false/c bytes?) #f]
[#:attributes attrs (listof (list/c symbol? string?)) empty]) [#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{ (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. 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?] @defproc[(radio [value bytes?]
[checked? boolean?] [checked? boolean?]
[#:name name (or/c false/c bytes?) #f]
[#:attributes attrs (listof (list/c symbol? string?)) empty]) [#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{ (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. This @tech{formlet} renders using an INPUT element with the RADIO type and the attributes given in the arguments.
} }
@defproc[(submit [value bytes?] @defproc[(submit [value bytes?]
[#:name name (or/c false/c bytes?) #f]
[#:attributes attrs (listof (list/c symbol? string?)) empty]) [#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{ (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. This @tech{formlet} renders using an INPUT element with the SUBMIT type and the attributes given in the arguments.
} }
@defproc[(reset [value bytes?] @defproc[(reset [value bytes?]
[#:name name (or/c false/c bytes?) #f]
[#:attributes attrs (listof (list/c symbol? string?)) empty]) [#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{ (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. 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] @defproc[(file-upload [#:attributes attrs (listof (list/c symbol? string?)) empty])
[#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{ (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. 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] @defproc[(hidden [#:attributes attrs (listof (list/c symbol? string?)) empty])
[#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{ (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. This @tech{formlet} renders using an INPUT element with HIDDEN type and the attributes given in the arguments.
} }