diff --git a/collects/tests/web-server/dispatchers/dispatch-servlets-test.rkt b/collects/tests/web-server/dispatchers/dispatch-servlets-test.rkt index 7224881887..99d45eebc4 100644 --- a/collects/tests/web-server/dispatchers/dispatch-servlets-test.rkt +++ b/collects/tests/web-server/dispatchers/dispatch-servlets-test.rkt @@ -75,7 +75,11 @@ (test-add-two-numbers mkd "add-compat0.rkt" (build-path example-servlets "add-compat0.rkt")) (test-add-two-numbers mkd "add-formlets.rkt - send/formlet" - (build-path example-servlets "add-formlets.rkt")) + (build-path example-servlets "add-formlets0.rkt")) + (test-add-two-numbers mkd "add-formlets.rkt - send/formlet, get" + (build-path example-servlets "add-formlets1.rkt")) + (test-add-two-numbers mkd "add-formlets.rkt - send/formlet, post" + (build-path example-servlets "add-formlets2.rkt")) (test-add-two-numbers mkd "add-page.rkt" (build-path example-servlets "add-page.rkt")) (test-equal? "count.rkt - state" diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets0.rkt similarity index 100% rename from collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets.rkt rename to collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets0.rkt diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets1.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets1.rkt new file mode 100644 index 0000000000..4007caa25d --- /dev/null +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets1.rkt @@ -0,0 +1,29 @@ +#lang racket +(require web-server/servlet + web-server/formlets) +(provide (all-defined-out)) +(define interface-version 'v1) +(define timeout +inf.0) + +; request-number : str -> num +(define (request-number which-number) + (send/formlet + (formlet + (#%# "Enter the " ,which-number " number to add: " + ,{input-int . => . the-number} + (input ([type "submit"] [name "enter"] [value "Enter"]))) + the-number) + #:method + "GET" + #:wrap + (lambda (f-expr) + `(html (head (title "Enter a Number to Add")) + (body ([bgcolor "white"]) + ,f-expr))))) + +(define (start initial-request) + (response/xexpr + `(html (head (title "Sum")) + (body ([bgcolor "white"]) + (p "The answer is " + ,(number->string (+ (request-number "first") (request-number "second")))))))) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets2.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets2.rkt new file mode 100644 index 0000000000..030abaf5fd --- /dev/null +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets2.rkt @@ -0,0 +1,29 @@ +#lang racket +(require web-server/servlet + web-server/formlets) +(provide (all-defined-out)) +(define interface-version 'v1) +(define timeout +inf.0) + +; request-number : str -> num +(define (request-number which-number) + (send/formlet + (formlet + (#%# "Enter the " ,which-number " number to add: " + ,{input-int . => . the-number} + (input ([type "submit"] [name "enter"] [value "Enter"]))) + the-number) + #:method + "POST" + #:wrap + (lambda (f-expr) + `(html (head (title "Enter a Number to Add")) + (body ([bgcolor "white"]) + ,f-expr))))) + +(define (start initial-request) + (response/xexpr + `(html (head (title "Sum")) + (body ([bgcolor "white"]) + (p "The answer is " + ,(number->string (+ (request-number "first") (request-number "second")))))))) diff --git a/collects/web-server/formlets/servlet.rkt b/collects/web-server/formlets/servlet.rkt index a4ac196bab..c8a00fc3c3 100644 --- a/collects/web-server/formlets/servlet.rkt +++ b/collects/web-server/formlets/servlet.rkt @@ -5,10 +5,14 @@ (provide/contract [send/formlet ((formlet*/c) - (#:wrap (pretty-xexpr/c . -> . pretty-xexpr/c)) - . ->* . any)]) + (#:method (or/c "GET" "POST" "get" "post") + #:wrap (pretty-xexpr/c . -> . pretty-xexpr/c)) + . ->* . + any)]) (define (send/formlet f + #:method + [method "POST"] #:wrap [wrapper (lambda (form-xexpr) @@ -20,11 +24,15 @@ (lambda (k-url) (response/xexpr (wrapper - `(form ([action ,k-url]) + `(form ([action ,k-url] [method ,method]) ,@(formlet-display f)))))))) (provide/contract - [embed-formlet (((request? . -> . any) . -> . string?) formlet*/c . -> . pretty-xexpr/c)]) + [embed-formlet + (((request? . -> . any) . -> . string?) + formlet*/c + . -> . + pretty-xexpr/c)]) (define (embed-formlet embed/url f) `(form ([action ,(embed/url diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl index 7ebdc81882..117178c79e 100644 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -502,17 +502,22 @@ a list of elements of the sequence. A few utilities are provided for using @tech{formlet}s in Web applications. @defproc[(send/formlet [f (formlet/c any/c ...)] + [#:method method + (or/c "GET" "POST" "get" "post") + "POST"] [#:wrap wrapper (xexpr/c . -> . xexpr/c) (lambda (form-xexpr) `(html (head (title "Form Entry")) (body ,form-xexpr)))]) (values any/c ...)]{ + Uses @racket[send/suspend] and @racket[response/xexpr] to send - @racket[f]'s rendering (wrapped in a FORM tag whose action is the - continuation URL (wrapped again by @racket[wrapper])) to the client. - When the form is submitted, the request is passed to the processing - stage of @racket[f]. + @racket[f]'s rendering (wrapped in a FORM tag with method + @racket[method] whose action is the continuation URL (wrapped again + by @racket[wrapper])) to the client. When the form is submitted, + the request is passed to the processing stage of @racket[f]. + } @defproc[(embed-formlet [embed/url ((request? . -> . any) . -> . string?)]