scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix typo in SERVLETS' open-clause

This commit is contained in:
interp 2002-12-02 08:39:10 +00:00
parent 543dbdf9ab
commit ba04964918
3 changed files with 31 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
scheme/httpd/surflets/packages.scm
View File

@ -180,7 +180,7 @@
(define-structure servlets servlets-interface (define-structure servlets servlets-interface
(open servlet-handler/servlet (open servlet-handler/servlet
httpd-responses httpd-responses
httpd-request ; HTTP-URL:SEARCH httpd-requests ; HTTP-URL:SEARCH
url ; REQUEST:URL url ; REQUEST:URL
parse-html-forms parse-html-forms
sxml-to-html ; SXML->HTML sxml-to-html ; SXML->HTML
@ -189,7 +189,6 @@
(subset srfi-13 (string-index)) (subset srfi-13 (string-index))
sxml-tree-trans sxml-tree-trans
url url
httpd-request
define-record-types define-record-types
weak ;MAKE-WEAK-POINTER weak ;MAKE-WEAK-POINTER
locks locks

2
scheme/httpd/surflets/start-surflet-server
View File

@ -193,7 +193,7 @@ exec scsh -lm $sunet/packages.scm -lm $ssax/lib/packages.scm -lm $sunet/httpd/se
; (cons "cgi-bin" (cgi-handler cgi-bin-dir)) ; (cons "cgi-bin" (cgi-handler cgi-bin-dir))
(cons "source" (rooted-file-or-directory-handler servlet-dir)) (cons "source" (rooted-file-or-directory-handler servlet-dir))
(cons "img" (rooted-file-handler images-dir)) (cons "img" (rooted-file-handler images-dir))
(cons "servlet" (servlet-handler servlet-dir "/servlet/"))) (cons "servlet" (servlet-handler servlet-dir)))
(rooted-file-or-directory-handler htdocs-dir))))))))))) (rooted-file-or-directory-handler htdocs-dir)))))))))))
)) ))
)) ))

46
scheme/httpd/surflets/web-server/root/surflets/test.scm
View File

@ -1,6 +1,5 @@
(define-structure servlet servlet-interface (define-structure servlet servlet-interface
(open scsh (open scheme-with-scsh
scheme
servlets servlets
httpd-responses) httpd-responses)
(begin (begin
@ -17,21 +16,34 @@
,(make-submit-button)) ,(make-submit-button))
(hr) (hr)
(p (URL "/" "Return to main menu.")) (p (URL "/" "Return to main menu."))
)))))) )))))
(send-html/suspend (save-k #f)
(lambda (continue) (done? #f))
`(html (body (h1 "Result")
,(format #f "~s" (get-bindings req)) (br) (call-with-current-continuation
(URL ,continue "show results again") (lambda (k)
(hr) (set! save-k k)
(p (URL "test.scm" "Test again.") (br) 13))
(URL "/" "Return to main menu."))))))
(if (not done?)
(begin
(send-html/suspend
(lambda (continue)
`(html (body (h1 "Result")
,(format #f "~s" (get-bindings req)) (br)
(URL ,continue "show results again")
(hr)
(p (URL "test.scm" "Test again.") (br)
(URL "/" "Return to main menu."))))))
(set! done? #t)
(save-k 13))
(send-html/finish (send-html/finish
`(html (body (h1 "Result 2") `(html (body (h1 "Result 2")
,(format #f "~s" (get-bindings req)) ,(format #f "~s" (get-bindings req))
(hr) (hr)
(p (URL "test.scm" "Test again.") (br) (p (URL "test.scm" "Test again.") (br)
(URL "/" "Return to main menu."))))))) (URL "/" "Return to main menu."))))))))
)) ))