Correcting problems in Horace's path
This commit is contained in:
Jay McCarthy
parent
3d43c7e7ac
commit
e6219740b8
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user