remove incongruousnesses of previous accident commit

This commit is contained in:
interp 2002-09-24 09:12:58 +00:00
parent fba9e1a4d3
commit 8e4a0c2872
4 changed files with 70 additions and 8 deletions

View File

@ -69,8 +69,9 @@
(export servlet-handler)) (export servlet-handler))
(define-interface servlet-handler/plugin-interface (define-interface servlet-handler/plugin-interface
(export send/suspend (export send/suspend ;send and suspend
send/finish send/finish ;send and finish
send ;just send (no finish, no suspend)
)) ))
(define-structures (define-structures

View File

@ -23,7 +23,6 @@
(with-current-output-port* ; FIXME: will change in further revision (with-current-output-port* ; FIXME: will change in further revision
out out
(lambda () (SXML->HTML html-tree))))))) (lambda () (SXML->HTML html-tree)))))))
(
(define (make-usual-html-response writer-proc) (define (make-usual-html-response writer-proc)
(make-response (make-response

View File

@ -7,10 +7,10 @@
Following files are available from here: Following files are available from here:
<ul> <ul>
<li><a href=/servlet/news.scm>News</a></li> <li><a href="servlet/news.scm">News</a></li>
<li><a href=/servlet/add.scm>Adding (Version 1)</a></li> <li><a href="servlet/add.scm">Adding (version 1)</a></li>
<li><a href="servlet/add2.scm">Adding (version 2)</a></li> <li><a href="servlet/add2.scm">Adding (version 2)</a></li>
<li><a href=/servlet/test.scm>A test servlet</a></li> <!-- <li><a href=/servlet/test.scm>A test servlet</a></li> -->
<li><a href=index.html>This file</a></li> <li><a href=index.html>This file</a></li>
</ul> </ul>
<br> <br>
@ -19,7 +19,7 @@
<hr> <hr>
<!-- Created: Thu Aug 22 16:44:16 CEST 2002 --> <!-- Created: Thu Aug 22 16:44:16 CEST 2002 -->
<!-- hhmts start --> <!-- hhmts start -->
Last modified: Tue Sep 24 10:16:52 CEST 2002 Last modified: Tue Sep 24 11:13:29 CEST 2002
<!-- hhmts end --> <!-- hhmts end -->
</body> </body>
</html> </html>

View File

@ -0,0 +1,62 @@
(define-structure plugin plugin-interface
(open plugin-utilities
httpd-request
url
scsh
scheme)
(begin
(define (add-call-back continue)
(make-call-back
(lambda (bindings)
(continue
(string->number (extract-single-binding bindings "number"))))))
(define (make-call-back function)
(call-with-current-continuation
(lambda (exit)
(let* ((req (send/suspend (lambda (new-url)
(exit new-url))))
(bindings (form-query (http-url:search (request:url req)))))
;; I know the names and the types from God
(function bindings)))))
(define (get-number input-text . maybe-title)
(let* ((title (if (pair? maybe-title) (car maybe-title) #f))
(result (call-with-current-continuation
(lambda (exit)
(send-html
(lambda (new-url)
`(html ,(if title
`(title ,title) '())
(body
,(if title `(h1 ,title) '())
(p (a (@ href "reset") "click here to reset server's plugin cache"))
(p
(form (@ (method "get")
(action ,(add-call-back exit)))
,input-text
(input (@ (type "text")
(name "number"))
(input (@ (type "submit"))))))))))))))
(if result
result
(get-number input-text "Please enter a number"))))
(define (get-number1)
(get-number "First number:"))
(define (get-number2)
(get-number "Second number:"))
(define (main req)
(let ((number1 (get-number1))
(number2 (get-number2)))
(send-html/finish
`(html (title "Result")
(body (h1 "Result")
(p ,(number->string (+ number1 number2)))
(a (@ (href "/")) "done"))))
"this will never be evaluated"))
))