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

more comfortable

This commit is contained in:
interp 2002-10-09 15:22:50 +00:00
parent 044c27e292
commit e29d3d750a
1 changed files with 18 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,7 @@
(define-structure servlet servlet-interface (define-structure servlet servlet-interface
(open servlets (open servlets
httpd-request httpd-request
httpd-responses
url url
scsh scsh
scheme) scheme)
@ -13,8 +14,7 @@
`(html ,(if title `(html ,(if title
`(title ,title) '()) `(title ,title) '())
(body (body
,(if title `(h1 ,title) '()) ,(if title `(h2 ,title) '())
(p (a (@ href "reset") "click here to reset server's servlet cache"))
(p (p
(form (@ (method "get") (form (@ (method "get")
(action ,new-url)) (action ,new-url))
@ -28,27 +28,28 @@
(extract-single-binding bindings "number")))) (extract-single-binding bindings "number"))))
(if number (if number
number number
(get-number input-text "Please enter a number"))))) (get-number input-text "Please enter a valid number")))))
(define (get-number1) (define (get-number1)
(get-number "First number:")) (get-number "First number:" "Calculation - Step one"))
(define (get-number2) (define (get-number2)
(get-number "Second number:")) (get-number "Second number:" "Calculation - Step two"))
(define (main req) (define (main req)
(let ((number1 (get-number1)) (let ((req
(number2 (get-number2))) (send-html/suspend
(send-html/suspend (lambda (new-url)
(lambda (new-url) `(html (title "Result")
`(html (title "Result") (body (h1 "Result")
(body (h1 "Result") (p ,(number->string (+ (get-number1) (get-number2))))
(p ,(number->string (+ number1 number2))) (a (@ (href "add.scm")) "new calculation (new instance)")(br)
(a (@ (href ,new-url)) "done"))))) (a (@ (href "javascript:history.back(2)")) "new calculation (same instance)")(br)
(send-html/finish '(html (a (@ (href ,new-url)) "close this instance")))))))
(title "Finished") (send/finish
(body (h1 "Finished") (make-http-error-response http-status/moved-temp req
(a (@ href "/") "yoh.")))))) "/" "/"))
))
; )) ; ))
)) ))