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
url ; HTTP-URL-SEARCH
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)
(begin
@ -22,15 +23,11 @@
(define (make-get-number-page input-text title)
(lambda (new-url)
(make-response
(make-surflet-response
(status-code ok)
#f
(time)
"text/html"
'()
(make-writer-body
(lambda (out options)
(format out "
(format #f "
<HTML>~a
<BODY>~a
<P>
@ -47,26 +44,21 @@
</P>
</BODY>
</HTML>"
(if title
(format #f "<TITLE>~a</TITLE>" title)
"")
(if title
(format #f "<H2>~a</H2>" title))
new-url
input-text
))
))))
(if title
(format #f "<TITLE>~a</TITLE>" title)
"")
(if title
(format #f "<H2>~a</H2>" title))
new-url
input-text
))))
(define (make-result-page new-url)
(make-response
(make-surflet-response
(status-code ok)
#f
(time)
"text/html"
'()
(make-writer-body
(lambda (out options)
(format out "
(format #f "
<HTML>
<TITLE>Result</TITLE>
<BODY>
@ -80,9 +72,8 @@
<A href=~s>Close this session</A>
</BODY>
</HTML>"
(number->string (+ (get-number1) (get-number2)))
new-url)))
))
(number->string (+ (get-number1) (get-number2)))
new-url)))
(define (get-number input-text . maybe-title)
(let* ((title (if (pair? maybe-title) (car maybe-title) #f))
@ -105,9 +96,7 @@
(send/suspend make-result-page)
;; This finishes the session and does a redirect to the root
;; page.
(send/finish
(make-error-response (status-code moved-temp) req
"/" "/")))
(send-error (status-code moved-temp) #f "/" "/"))
))