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

Adapt to recent changes in surflet-handler

This commit is contained in:
interp 2003-01-24 16:05:39 +00:00
parent 3f3bf045de
commit 1f10457d52
1 changed files with 17 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
scheme/httpd/surflets/web-server/root/surflets/add-raw.scm
View File

@ -4,7 +4,8 @@
parse-html-forms ; PARSE-HTML-FORM-QUERY parse-html-forms ; PARSE-HTML-FORM-QUERY
url ; HTTP-URL-SEARCH url ; HTTP-URL-SEARCH
srfi-1 ; FILTER srfi-1 ; FILTER
surflet-handler/surflet ; SEND/SUSPEND, SEND/FINISH surflet-handler/surflets ; SEND/SUSPEND, SEND/FINISH
surflet-handler/responses ; MAKE-SURFLET-RESPONSE
scheme-with-scsh) scheme-with-scsh)
(begin (begin
@ -22,15 +23,11 @@
(define (make-get-number-page input-text title) (define (make-get-number-page input-text title)
(lambda (new-url) (lambda (new-url)
(make-response (make-surflet-response
(status-code ok) (status-code ok)
#f
(time)
"text/html" "text/html"
'() '()
(make-writer-body (format #f "
(lambda (out options)
(format out "
<HTML>~a <HTML>~a
<BODY>~a <BODY>~a
<P> <P>
@ -47,26 +44,21 @@
</P> </P>
</BODY> </BODY>
</HTML>" </HTML>"
(if title (if title
(format #f "<TITLE>~a</TITLE>" title) (format #f "<TITLE>~a</TITLE>" title)
"") "")
(if title (if title
(format #f "<H2>~a</H2>" title)) (format #f "<H2>~a</H2>" title))
new-url new-url
input-text input-text
)) ))))
))))
(define (make-result-page new-url) (define (make-result-page new-url)
(make-response (make-surflet-response
(status-code ok) (status-code ok)
#f
(time)
"text/html" "text/html"
'() '()
(make-writer-body (format #f "
(lambda (out options)
(format out "
<HTML> <HTML>
<TITLE>Result</TITLE> <TITLE>Result</TITLE>
<BODY> <BODY>
@ -80,9 +72,8 @@
<A href=~s>Close this session</A> <A href=~s>Close this session</A>
</BODY> </BODY>
</HTML>" </HTML>"
(number->string (+ (get-number1) (get-number2))) (number->string (+ (get-number1) (get-number2)))
new-url))) new-url)))
))
(define (get-number input-text . maybe-title) (define (get-number input-text . maybe-title)
(let* ((title (if (pair? maybe-title) (car maybe-title) #f)) (let* ((title (if (pair? maybe-title) (car maybe-title) #f))
@ -105,9 +96,7 @@
(send/suspend make-result-page) (send/suspend make-result-page)
;; This finishes the session and does a redirect to the root ;; This finishes the session and does a redirect to the root
;; page. ;; page.
(send/finish (send-error (status-code moved-temp) #f "/" "/"))
(make-error-response (status-code moved-temp) req
"/" "/")))
)) ))