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

don't use callbacks, but two submit-buttons

This commit is contained in:
interp 2002-10-02 18:22:19 +00:00
parent 74acc71447
commit d690a7a24e
1 changed files with 35 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
scheme/httpd/surflets/web-server/root/surflets/calculate.scm
View File

@ -7,7 +7,7 @@
scheme) scheme)
(begin (begin
;; This uses callbacks. ;; This doesn't use callbacks anymore.
(define *operator-alist* (define *operator-alist*
`(("+" . ,+) `(("+" . ,+)
@ -33,15 +33,6 @@
`(option ,(operator-symbol operator))) `(option ,(operator-symbol operator)))
*operator-alist*))))) *operator-alist*)))))
(define (change-operator-callback)
(make-callback
(lambda (req)
(change-operator
;; This yields an error only when the browser doing wrong.
(input-field-value operator-input-field
(get-bindings req))))
))
(define (make-number-input-field/default default) (define (make-number-input-field/default default)
(if default (if default
@ -52,6 +43,8 @@
(let* ((update-text (:optional maybe-update-text "")) (let* ((update-text (:optional maybe-update-text ""))
(number-field1 (make-number-input-field/default number1)) (number-field1 (make-number-input-field/default number1))
(number-field2 (make-number-input-field/default number2)) (number-field2 (make-number-input-field/default number2))
(calculate-button (make-submit-button "Calculate"))
(change-button (make-submit-button "Change operator"))
(req (req
(send-html/suspend (send-html/suspend
(lambda (new-url) (lambda (new-url)
@ -67,33 +60,41 @@
(td ,(operator-symbol operator-pair)) (td ,(operator-symbol operator-pair))
(td ,number-field2) (td ,number-field2)
(td " = ") (td " = ")
(td ,(make-submit-button '(@ (value "calculate"))))))) (td ,calculate-button)))
(hr) (hr)
(p "You may choose another operator:") (p "You may choose another operator:")
(servlet-form
,(change-operator-callback)
(table (table
(tr (td ,operator-input-field) (tr (td ,operator-input-field)
(td ,(make-submit-button (td ,change-button)))))))))
'(@ (value "change operator"))))))))))))
(bindings (get-bindings req))) (bindings (get-bindings req)))
(let ((number1 (cond
(with-fatal-error-handler ((input-field-binding calculate-button bindings)
(lambda (c d) #f) (let ((number1 (with-fatal-error-handler
(input-field-value number-field1 bindings))) (lambda (c d) #f)
(number2 (input-field-value number-field1 bindings)))
(with-fatal-error-handler (number2 (with-fatal-error-handler
(lambda (c d) #f) (lambda (c d) #f)
(input-field-value number-field2 bindings)))) (input-field-value number-field2 bindings))))
(if number1 (if number1
(if number2 (if number2
(calculate operator-pair number1 number2) (calculate operator-pair number1 number2)
(show-page operator-pair number1 number2 "Please enter a valid second number.")) (show-page operator-pair number1 number2
(show-page operator-pair number1 number2 "Please enter a valid first number.")) "Please enter a valid second number."))
))) (show-page operator-pair number1 number2
"Please enter a valid first number."))))
(define (change-operator to-operation) ((input-field-binding change-button bindings)
(show-page to-operation #f #f)) (with-fatal-error-handler
(lambda (c d)
;; This should never happen.
(show-page operator-pair #f #f
"Internal error. Please retry or report."))
(show-page (input-field-value operator-input-field
bindings)
#f #f)))
(else
;; This should never happen.
(show-page operator-pair #f #f
"Internal error. Please retry or report.")))))
(define (calculate operator-pair number1 number2) (define (calculate operator-pair number1 number2)
(let ((operator (operator-operator operator-pair))) (let ((operator (operator-operator operator-pair)))