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