sunet/scheme/httpd/surflets/web-server/root/surflets/add-servlet.scm

53 lines
1.4 KiB
Scheme

(define-structure servlet servlet-interface
(open servlets
httpd-requests
url
handle-fatal-error
let-opt
scheme-with-scsh)
(begin
(define number-input-field (make-number-input-field '(@ (maxlength 10))))
(define (get-number input-text . maybe-update-text)
(let* ((update-text (:optional maybe-update-text ""))
(result
(send-html/suspend
(lambda (new-url)
`(html (title ,input-text)
(body
(p (font (@ (color "red")) ,update-text))
(p
(servlet-form ,new-url
,input-text " "
,number-input-field
,(make-submit-button)))
(hr)
(p (URL "/" "Return to main menu.") (br)
(URL "add2.scm" "Start new calculation."))))))))
(if result
(or (input-field-value number-input-field
(form-query (http-url-search (request-url result))))
(get-number input-text "Please enter a valid number."))
(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
`(html (title "Result")
(body (h1 "Result")
(p ,(number->string (+ number1 number2)))
(hr)
(p (URL "add2.scm" "Make new calculation.") (br)
(URL "/" "Return to main menu.")))))
"this string will never be evaluated"))
))