From f5aa64f90bebb821340babd6387f742b8a7e23d2 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 6 Jan 2009 15:37:23 +0000 Subject: [PATCH] send/formlet issue svn: r13020 --- .../dispatchers/dispatch-servlets-test.ss | 2 ++ .../dispatchers/servlet-test-util.ss | 15 +++++++---- .../htdocs/servlets/examples/add-formlets.ss | 26 +++++++++++++++++++ collects/web-server/formlets/servlet.ss | 16 +++++++++--- .../web-server/scribblings/formlets.scrbl | 10 +++++-- 5 files changed, 58 insertions(+), 11 deletions(-) create mode 100644 collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets.ss diff --git a/collects/tests/web-server/dispatchers/dispatch-servlets-test.ss b/collects/tests/web-server/dispatchers/dispatch-servlets-test.ss index 9716d4b9b9..9546581058 100644 --- a/collects/tests/web-server/dispatchers/dispatch-servlets-test.ss +++ b/collects/tests/web-server/dispatchers/dispatch-servlets-test.ss @@ -60,6 +60,8 @@ (build-path example-servlets "add-v2.ss")) (test-add-two-numbers mkd "add-ssd.ss - send/suspend/dispatch" (build-path example-servlets "add-ssd.ss")) + (test-add-two-numbers mkd "add-ssd.ss - send/formlet" + (build-path example-servlets "add-formlets.ss")) (test-equal? "count.ss - state" (let* ([d (mkd (build-path example-servlets "count.ss"))] [ext (lambda (c) diff --git a/collects/tests/web-server/dispatchers/servlet-test-util.ss b/collects/tests/web-server/dispatchers/servlet-test-util.ss index 7b916dbdf1..37db1dfbcf 100644 --- a/collects/tests/web-server/dispatchers/servlet-test-util.ss +++ b/collects/tests/web-server/dispatchers/servlet-test-util.ss @@ -20,11 +20,16 @@ (test-equal? t (let* ([d (mkd p)] - [k0 (first ((sxpath "//form/@action/text()") (call d url0 empty)))] - [k1 (first ((sxpath "//form/@action/text()") (call d (format "~a?number=~a" k0 xs) - (list (make-binding:form #"number" xs)))))] - [n (first ((sxpath "//p/text()") (call d (format "~a?number=~a" k1 ys) - (list (make-binding:form #"number" ys)))))]) + [r0 (call d url0 empty)] + [k0 (first ((sxpath "//form/@action/text()") r0))] + [i0 (first ((sxpath "//form/input/@name/text()") r0))] + [r1 (call d (format "~a?~a=~a" k0 i0 xs) + (list (make-binding:form (string->bytes/utf-8 i0) xs)))] + [k1 (first ((sxpath "//form/@action/text()") r1))] + [i1 (first ((sxpath "//form/input/@name/text()") r1))] + [r2 (call d (format "~a?~a=~a" k1 i1 ys) + (list (make-binding:form (string->bytes/utf-8 i1) ys)))] + [n (first ((sxpath "//p/text()") r2))]) n) (format "The answer is ~a" (+ x y))))) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets.ss b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets.ss new file mode 100644 index 0000000000..f7173a76aa --- /dev/null +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/add-formlets.ss @@ -0,0 +1,26 @@ +#lang scheme +(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) + #:wrap + (lambda (f-expr) + `(html (head (title "Enter a Number to Add")) + (body ([bgcolor "white"]) + ,f-expr))))) + +(define (start initial-request) + `(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.ss b/collects/web-server/formlets/servlet.ss index e6d97a0f14..2e1230ec0f 100644 --- a/collects/web-server/formlets/servlet.ss +++ b/collects/web-server/formlets/servlet.ss @@ -4,15 +4,23 @@ "lib.ss") (provide/contract - [send/formlet ((formlet/c any/c) . -> . any/c)]) + [send/formlet (((formlet/c any/c)) + (#:wrap (xexpr? . -> . response?)) + . ->* . any/c)]) -(define (send/formlet f) +(define (send/formlet f + #:wrap + [wrapper + (lambda (form-xexpr) + `(html (head (title "Form Entry")) + (body ,form-xexpr)))]) (formlet-process f (send/suspend (lambda (k-url) - `(form ([action ,k-url]) - ,@(formlet-display f)))))) + (wrapper + `(form ([action ,k-url]) + ,@(formlet-display f))))))) (provide/contract [embed-formlet (embed/url/c (formlet/c any/c) . -> . xexpr?)]) diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl index 07337d67df..e3e865eaa9 100644 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -226,10 +226,16 @@ There are a few basic @tech{formlet}s provided by this library. A few utilities are provided for using @tech{formlet}s in Web applications. -@defproc[(send/formlet [f (formlet/c any/c)]) +@defproc[(send/formlet [f (formlet/c any/c)] + [#:wrap wrapper + (xexpr? . -> . response?) + (lambda (form-xexpr) + `(html (head (title "Form Entry")) + (body ,form-xexpr)))]) any/c]{ Uses @scheme[send/suspend] to send @scheme[f]'s rendering (wrapped in a FORM tag whose action is - the continuation URL) to the client. When the form is submitted, the request is passed to the + the continuation URL (wrapped again by @scheme[wrapper])) to the client. + When the form is submitted, the request is passed to the processing stage of @scheme[f]. }