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

Remove bug from previous commit: write out to outport.

This commit is contained in:
interp 2003-01-18 17:18:19 +00:00
parent b7133f4393
commit c2bb9ae9e8
1 changed files with 32 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,16 @@
(define (make-get-number-page input-text title) (define (make-get-number-page input-text title)
(lambda (new-url) (lambda (new-url)
(let ((HTML-page (format #f " (make-response
(status-code ok)
#f
(time)
"text/html"
'()
(make-writer-body
(lambda (out options)
(format #t "make-get-number-page: omitting HTML page.~%")
(format out "
<HTML>~a <HTML>~a
<BODY>~a <BODY>~a
<P> <P>
@ -39,28 +48,27 @@
</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
))) ))
))))
(make-response
(status-code ok)
#f
(time)
"text/html"
'()
(make-writer-body
(lambda (out options)
(format out HTML-page))
)))))
(define (make-result-page new-url) (define (make-result-page new-url)
(let ((HTML-page (format #f " (make-response
(status-code ok)
#f
(time)
"text/html"
'()
(make-writer-body
(lambda (out options)
(format #t "make-result-page: ommiting HTML page~%")
(format out "
<HTML> <HTML>
<TITLE>Result</TITLE> <TITLE>Result</TITLE>
<BODY> <BODY>
@ -74,18 +82,9 @@
<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)))
(make-response ))
(status-code ok)
#f
(time)
"text/html"
'()
(make-writer-body
(lambda (out options)
(format out HTML-page)))
)))
(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))