diff --git a/collects/web-server/docs/reference/servlet-env.scrbl b/collects/web-server/docs/reference/servlet-env.scrbl index ec8ee0f47c..3dbfd0951e 100644 --- a/collects/web-server/docs/reference/servlet-env.scrbl +++ b/collects/web-server/docs/reference/servlet-env.scrbl @@ -8,14 +8,19 @@ The @web-server provides a means of running Scheme servlets from within DrScheme, or any other REPL. @file{servlet-env.ss} provides the servlet API from @file{servlet.ss} -as well as the following special forms: +as well as the following: + +@defthing[send-url (parameter/c ([url string?] [separate-window? boolean?] . -> . void))]{ + Should open @scheme[url]. In another window if @scheme[separate-window?] is true. + By default this is from @scheme[(lib "sendurl.ss" "net")]. +} @defform[(on-web servlet-expr)]{This expands to @scheme[(on-web 8000 servlet-expr)].} @defform[(on-web port servlet-expr)]{ This constructs a small servlet, where the body of the @scheme[start] procedure is - @scheme[servlet-expr], runs the @web-server on port @scheme[port], and opens - a browser to a URL accessing the constructed servlet. The call blocks until the + @scheme[servlet-expr], runs the @web-server on port @scheme[port], and calls + @scheme[send-url] with a URL for the constructed servlet. The call blocks until the servlet finishes its computation, i.e. @scheme[servlet-expr] is evaluated, and returns its result. @scheme[servlet-expr] may use the entire Scheme servlet API. (See @secref["servlet"].) diff --git a/collects/web-server/servlet-env.ss b/collects/web-server/servlet-env.ss index 811edb5b2d..e8ae765930 100644 --- a/collects/web-server/servlet-env.ss +++ b/collects/web-server/servlet-env.ss @@ -1,5 +1,5 @@ (module servlet-env mzscheme - (require (lib "sendurl.ss" "net") + (require (prefix net: (lib "sendurl.ss" "net")) (lib "unit.ss")) (require "web-server.ss" "web-config-unit.ss" @@ -10,8 +10,11 @@ "private/cache-table.ss") (require "servlet.ss") (provide (rename on-web:syntax on-web) + send-url (all-from "servlet.ss")) + (define send-url (make-parameter net:send-url)) + ; XXX Change to setup temporary file and special dispatcher (define-syntax (on-web:syntax stx) (syntax-case stx () @@ -45,7 +48,7 @@ (body (p "This servlet has ended, please return to the interaction window."))))))] [shutdown-server (serve/web-config@ (build-standalone-servlet-configuration the-port the-path new-servlet))]) - (send-url standalone-url #t) + ((send-url) standalone-url #t) ; Wait for final call (semaphore-wait sema) ; XXX: Find a way to wait for final HTML to be sent diff --git a/collects/web-server/tests/servlet-env-test.ss b/collects/web-server/tests/servlet-env-test.ss index 6b7d57e950..3684c67bf2 100644 --- a/collects/web-server/tests/servlet-env-test.ss +++ b/collects/web-server/tests/servlet-env-test.ss @@ -1,13 +1,35 @@ (module servlet-env-test mzscheme (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) + (only (planet "ssax.ss" ("lizorkin" "ssax.plt" 1 3)) + ssax:xml->sxml) + (planet "sxml.ss" ("lizorkin" "sxml.plt" 1 4)) + (lib "etc.ss") + (lib "list.ss") + (lib "pretty.ss") + (lib "url.ss" "net") (lib "servlet-env.ss" "web-server")) (provide servlet-env-tests) + (define (call u bs) + (define sx (ssax:xml->sxml (get-pure-port (string->url u)) empty)) + (pretty-print sx) + sx) + (define servlet-env-tests (test-suite - "Servlet Environment")) - - ; XXX Turn below into tests + "Servlet Environment" + + (test-not-exn "Add two numbers" + (lambda () + (sleep 2) + (parameterize ([send-url + (lambda (a-url sep?) + (let* ([k0 (first ((sxpath "//form/@action/text()") (call a-url empty)))] + [k1 (first ((sxpath "//form/@action/text()") (call k0 (list (make-binding:form #"number" #"23")))))] + [n (first ((sxpath "//p/text()") (call k1 (list (make-binding:form #"number" #"12")))))]) + n) + (void))]) + (example)))))) ; request-number : str -> num (define (request-number which-number) @@ -25,11 +47,10 @@ "Enter the " ,which-number " number to add: " (input ([type "text"] [name "number"] [value ""])) (input ([type "submit"] [name "enter"] [value "Enter"]))))))) - #;(on-web + (define (example) + (on-web + 9999 `(html (head (title "Sum")) (body ([bgcolor "white"]) (p "The sum is " - ,(number->string (+ (request-number "first") (request-number "second"))))))) - - (define (test) - (on-web 9000 (+ (request-number "first") (request-number "second"))))) \ No newline at end of file + ,(number->string (+ (request-number "first") (request-number "second"))))))))) \ No newline at end of file