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

View File

@ -22,7 +22,16 @@
(define (make-get-number-page input-text title)
(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
<BODY>~a
<P>
@ -39,28 +48,27 @@
</P>
</BODY>
</HTML>"
(if title
(format #f "<TITLE>~a</TITLE>" title)
"")
(if title
(format #f "<H2>~a</H2>" title))
new-url
input-text
)))
(make-response
(status-code ok)
#f
(time)
"text/html"
'()
(make-writer-body
(lambda (out options)
(format out HTML-page))
)))))
(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)
(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>
<TITLE>Result</TITLE>
<BODY>
@ -74,18 +82,9 @@
<A href=~s>Close this session</A>
</BODY>
</HTML>"
(number->string (+ (get-number1) (get-number2)))
new-url)))
(make-response
(status-code ok)
#f
(time)
"text/html"
'()
(make-writer-body
(lambda (out options)
(format out HTML-page)))
)))
(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))