Rename TRY-INPUT-FIELD-VALUE --> INPUT-FIELD-VALUE and
INPUT-FIELD-VALUE --> RAW-INPUT-FIELD-VALUE simultanously. Thus, the WITH-FATAL-ERROR-HANDLER wrappers are not needed anymore.
This commit is contained in:
parent
a03e5914da
commit
223c1da086
|
@ -166,8 +166,8 @@
|
||||||
make-submit-button
|
make-submit-button
|
||||||
make-reset-button
|
make-reset-button
|
||||||
make-image-button
|
make-image-button
|
||||||
try-input-field-value
|
|
||||||
input-field-value
|
input-field-value
|
||||||
|
raw-input-field-value
|
||||||
input-field-binding
|
input-field-binding
|
||||||
|
|
||||||
make-address
|
make-address
|
||||||
|
|
|
@ -575,7 +575,7 @@
|
||||||
|
|
||||||
;; <input-field>: '(input-field . <real-input-field>)
|
;; <input-field>: '(input-field . <real-input-field>)
|
||||||
;; <real-input-field>: #{Input-field "name"}
|
;; <real-input-field>: #{Input-field "name"}
|
||||||
(define (input-field-value input-field bindings)
|
(define (raw-input-field-value input-field bindings)
|
||||||
(let ((input-field (cadr input-field)))
|
(let ((input-field (cadr input-field)))
|
||||||
(cond
|
(cond
|
||||||
((input-field-get-bindings? input-field)
|
((input-field-get-bindings? input-field)
|
||||||
|
@ -587,18 +587,20 @@
|
||||||
(error "no such input-field" input-field bindings)))))
|
(error "no such input-field" input-field bindings)))))
|
||||||
|
|
||||||
;; Trys to get a value for INPUT-FIELD in BINDINGS. If this fails
|
;; Trys to get a value for INPUT-FIELD in BINDINGS. If this fails
|
||||||
;; (i.e. INPUT-FIELD-VALUE returns an error), the default-value is
|
;; (i.e. RAW-INPUT-FIELD-VALUE returns an error), the default-value is
|
||||||
;; returned. The default-value defaults to #f. NOTE: If you do this
|
;; returned. The default-value defaults to #f. NOTE: If you do this
|
||||||
;; with input-fields whose valid values may be the same as the default
|
;; with input-fields whose valid values may be the same as the default
|
||||||
;; value, you cannot determine by the result if there was such a value
|
;; value, you cannot determine by the result if there was such a value
|
||||||
;; or not. Keep in mind, that INPUT-FIELD-VALUE returns also an error,
|
;; or not. Keep in mind, that RAW-INPUT-FIELD-VALUE returns also an
|
||||||
;; if there was not such an input field.
|
;; error, if there was not such an input field. This makes
|
||||||
(define (try-input-field-value input-field bindings . maybe-default)
|
;; INPUT-FIELD-VALUE working with checkbox input fields because they
|
||||||
|
;; miss if they are not checked.
|
||||||
|
(define (input-field-value input-field bindings . maybe-default)
|
||||||
(let ((default (:optional maybe-default #f)))
|
(let ((default (:optional maybe-default #f)))
|
||||||
(with-fatal-error-handler
|
(with-fatal-error-handler
|
||||||
(lambda (condition more)
|
(lambda (condition more)
|
||||||
default)
|
default)
|
||||||
(input-field-value input-field bindings))))
|
(raw-input-field-value input-field bindings))))
|
||||||
|
|
||||||
(define (real-input-field-binding input-field bindings)
|
(define (real-input-field-binding input-field bindings)
|
||||||
(assoc (input-field-name input-field) bindings))
|
(assoc (input-field-name input-field) bindings))
|
||||||
|
|
|
@ -13,6 +13,7 @@
|
||||||
<li><a href="servlet/calculate.scm">Simple Calculator</a></li>
|
<li><a href="servlet/calculate.scm">Simple Calculator</a></li>
|
||||||
<li><a href="servlet/byte-input.scm">Byte Input Widget</a></li>
|
<li><a href="servlet/byte-input.scm">Byte Input Widget</a></li>
|
||||||
<li><a href="servlet/simple-servlet.scm">Simple Servlet</a></li>
|
<li><a href="servlet/simple-servlet.scm">Simple Servlet</a></li>
|
||||||
|
<li><a href="servlet/spaceship.scm">Spaceship builder</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="servlet/admin.scm">Servlet Administration</a></li>
|
<li><a href="servlet/admin.scm">Servlet Administration</a></li>
|
||||||
<li><a href=index.html>This file</a></li>
|
<li><a href=index.html>This file</a></li>
|
||||||
|
@ -23,7 +24,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: Sun Nov 3 15:24:22 CET 2002
|
Last modified: Tue Nov 5 10:39:46 CET 2002
|
||||||
<!-- hhmts end -->
|
<!-- hhmts end -->
|
||||||
</body>
|
</body>
|
||||||
</html>
|
</html>
|
||||||
|
|
|
@ -27,11 +27,9 @@
|
||||||
(p (URL "/" "Return to main menu.") (br)
|
(p (URL "/" "Return to main menu.") (br)
|
||||||
(URL "add2.scm" "Start new calculation."))))))))
|
(URL "add2.scm" "Start new calculation."))))))))
|
||||||
(if result
|
(if result
|
||||||
(with-fatal-error-handler
|
(or (input-field-value number-input-field
|
||||||
(lambda (condition more)
|
(form-query (http-url:search (request:url result))))
|
||||||
(get-number input-text "Please enter a valid number."))
|
(get-number input-text "Please enter a valid number."))
|
||||||
(input-field-value number-input-field
|
|
||||||
(form-query (http-url:search (request:url result)))))
|
|
||||||
(get-number input-text "Please enter a number."))))
|
(get-number input-text "Please enter a number."))))
|
||||||
|
|
||||||
(define (get-number1)
|
(define (get-number1)
|
||||||
|
|
|
@ -55,10 +55,8 @@
|
||||||
((returned-via? return-address bindings)
|
((returned-via? return-address bindings)
|
||||||
(return-to-main-page req))
|
(return-to-main-page req))
|
||||||
((input-field-binding submit-timeout bindings)
|
((input-field-binding submit-timeout bindings)
|
||||||
(with-fatal-error-handler
|
|
||||||
(lambda (condition more)
|
|
||||||
(handler-options req "Please enter a valid, positive integer number"))
|
|
||||||
(let ((result (input-field-value number-field bindings)))
|
(let ((result (input-field-value number-field bindings)))
|
||||||
|
(if result
|
||||||
(if (and (integer? result)
|
(if (and (integer? result)
|
||||||
(> result 0))
|
(> result 0))
|
||||||
(begin
|
(begin
|
||||||
|
@ -66,7 +64,8 @@
|
||||||
(handler-options req
|
(handler-options req
|
||||||
(format #f "Instance lifetime changed to ~a."
|
(format #f "Instance lifetime changed to ~a."
|
||||||
(options-instance-lifetime))))
|
(options-instance-lifetime))))
|
||||||
(error "not a positive integer")))))
|
(error "not a positive integer"))
|
||||||
|
(handler-options req "Please enter a valid, positive integer number"))))
|
||||||
((input-field-binding submit-cache bindings)
|
((input-field-binding submit-cache bindings)
|
||||||
(let ((cache-plugins? (if (input-field-binding cache-checkbox bindings)
|
(let ((cache-plugins? (if (input-field-binding cache-checkbox bindings)
|
||||||
#t
|
#t
|
||||||
|
|
|
@ -89,10 +89,7 @@
|
||||||
((returned-via? reset-return-address bindings)
|
((returned-via? reset-return-address bindings)
|
||||||
(reset-and-return-to-main-page req))
|
(reset-and-return-to-main-page req))
|
||||||
(else
|
(else
|
||||||
(let ((new-gnuplot-location (with-fatal-error-handler
|
(let ((new-gnuplot-location (input-field-value input-field bindings)))
|
||||||
(lambda (condition more)
|
|
||||||
#f)
|
|
||||||
(input-field-value input-field bindings))))
|
|
||||||
(if (and new-gnuplot-location
|
(if (and new-gnuplot-location
|
||||||
(file-executable? new-gnuplot-location))
|
(file-executable? new-gnuplot-location))
|
||||||
(begin
|
(begin
|
||||||
|
|
|
@ -58,10 +58,7 @@
|
||||||
(values
|
(values
|
||||||
action
|
action
|
||||||
(filter-map (lambda (checkbox table-element)
|
(filter-map (lambda (checkbox table-element)
|
||||||
(if(with-fatal-error-handler
|
(if (input-field-value checkbox bindings)
|
||||||
(lambda (condition more)
|
|
||||||
#f)
|
|
||||||
(input-field-value checkbox bindings))
|
|
||||||
table-element
|
table-element
|
||||||
#f))
|
#f))
|
||||||
checkboxes
|
checkboxes
|
||||||
|
|
|
@ -58,9 +58,7 @@
|
||||||
(values #f #f)
|
(values #f #f)
|
||||||
(values action
|
(values action
|
||||||
(filter-map (lambda (checkbox table-element)
|
(filter-map (lambda (checkbox table-element)
|
||||||
(if (with-fatal-error-handler
|
(if (input-field-value checkbox bindings)
|
||||||
(lambda (c m) #f)
|
|
||||||
(input-field-value checkbox bindings))
|
|
||||||
table-element
|
table-element
|
||||||
#f))
|
#f))
|
||||||
checkboxes
|
checkboxes
|
||||||
|
|
|
@ -27,9 +27,8 @@
|
||||||
(if (null? checkboxes)
|
(if (null? checkboxes)
|
||||||
sum
|
sum
|
||||||
(loop (+ sum (string->number
|
(loop (+ sum (string->number
|
||||||
(with-fatal-error-handler
|
(or (input-field-value (car checkboxes) bindings)
|
||||||
(lambda (condition decline) "0")
|
"0")))
|
||||||
(input-field-value (car checkboxes) bindings))))
|
|
||||||
(cdr checkboxes)))))
|
(cdr checkboxes)))))
|
||||||
checkboxes)))
|
checkboxes)))
|
||||||
|
|
||||||
|
|
|
@ -37,7 +37,7 @@
|
||||||
(make-callback
|
(make-callback
|
||||||
(lambda (req)
|
(lambda (req)
|
||||||
(change-operator
|
(change-operator
|
||||||
;; This yields an error only when the browser doing wrong.
|
;; This yields an error only when the browser is doing wrong.
|
||||||
(input-field-value operator-input-field
|
(input-field-value operator-input-field
|
||||||
(get-bindings req))))
|
(get-bindings req))))
|
||||||
))
|
))
|
||||||
|
@ -78,14 +78,8 @@
|
||||||
(td ,(make-submit-button
|
(td ,(make-submit-button
|
||||||
'(@ (value "change operator"))))))))))))
|
'(@ (value "change operator"))))))))))))
|
||||||
(bindings (get-bindings req)))
|
(bindings (get-bindings req)))
|
||||||
(let ((number1
|
(let ((number1 (input-field-value number-field1 bindings))
|
||||||
(with-fatal-error-handler
|
(number2 (input-field-value number-field2 bindings)))
|
||||||
(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 number1
|
||||||
(if number2
|
(if number2
|
||||||
(calculate operator-pair number1 number2)
|
(calculate operator-pair number1 number2)
|
||||||
|
|
|
@ -69,12 +69,8 @@
|
||||||
(hr)
|
(hr)
|
||||||
(p (URL "/" "Return to main menu."))))))))
|
(p (URL "/" "Return to main menu."))))))))
|
||||||
(bindings (get-bindings req)))
|
(bindings (get-bindings req)))
|
||||||
(let ((number1 (with-fatal-error-handler
|
(let ((number1 (input-field-value number-field1 bindings))
|
||||||
(lambda (c d) #f)
|
(number2 (input-field-value number-field2 bindings)))
|
||||||
(input-field-value number-field1 bindings)))
|
|
||||||
(number2 (with-fatal-error-handler
|
|
||||||
(lambda (c d) #f)
|
|
||||||
(input-field-value number-field2 bindings))))
|
|
||||||
(cond
|
(cond
|
||||||
((input-field-binding calculate-button bindings)
|
((input-field-binding calculate-button bindings)
|
||||||
(if number1
|
(if number1
|
||||||
|
|
Loading…
Reference in New Issue