Initial versions from Horace Dynamite
This commit is contained in:
Jay McCarthy
parent
04d3a23e1c
commit
3d43c7e7ac
|
|
@ -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")
|
||||
|
|
|
|||
231
collects/web-server/formlets/input.rkt
Normal file → Executable file
231
collects/web-server/formlets/input.rkt
Normal file → Executable file
|
|
@ -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)
|
||||
|
|
|
|||
65
collects/web-server/scribblings/formlets.scrbl
Normal file → Executable file
65
collects/web-server/scribblings/formlets.scrbl
Normal file → Executable file
|
|
@ -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)]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user