remove incongruousnesses of previous accident commit
This commit is contained in:
parent
fba9e1a4d3
commit
8e4a0c2872
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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>
|
||||||
|
|
|
@ -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"))
|
||||||
|
))
|
||||||
|
|
Loading…
Reference in New Issue