Remove bug from previous commit: write out to outport.
This commit is contained in:
parent
b7133f4393
commit
c2bb9ae9e8
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue