send/formlet issue

svn: r13020

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)

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)))))
 

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")))))))

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?)])

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].
 }