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

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:
interp 2002-11-07 20:41:35 +00:00
parent a03e5914da
commit 223c1da086
11 changed files with 36 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/httpd/surflets/packages.scm
View File

@ -166,8 +166,8 @@
make-submit-button
make-reset-button
make-image-button
try-input-field-value
input-field-value
raw-input-field-value
input-field-binding
make-address

14
scheme/httpd/surflets/surflets.scm
View File

@ -575,7 +575,7 @@
;; <input-field>: '(input-field . <real-input-field>)
;; <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)))
(cond
((input-field-get-bindings? input-field)
@ -587,18 +587,20 @@
(error "no such input-field" input-field bindings)))))
;; 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
;; 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
;; or not. Keep in mind, that INPUT-FIELD-VALUE returns also an error,
;; if there was not such an input field.
(define (try-input-field-value input-field bindings . maybe-default)
;; or not. Keep in mind, that RAW-INPUT-FIELD-VALUE returns also an
;; error, if there was not such an input field. This makes
;; 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)))
(with-fatal-error-handler
(lambda (condition more)
default)
(input-field-value input-field bindings))))
(raw-input-field-value input-field bindings))))
(define (real-input-field-binding input-field bindings)
(assoc (input-field-name input-field) bindings))

3
scheme/httpd/surflets/web-server/root/htdocs/index.html
View File

@ -13,6 +13,7 @@
<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/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/admin.scm">Servlet Administration</a></li>
<li><a href=index.html>This file</a></li>
@ -23,7 +24,7 @@
<hr>
<!-- Created: Thu Aug 22 16:44:16 CEST 2002 -->
<!-- hhmts start -->
Last modified: Sun Nov 3 15:24:22 CET 2002
Last modified: Tue Nov 5 10:39:46 CET 2002
<!-- hhmts end -->
</body>
</html>

8
scheme/httpd/surflets/web-server/root/surflets/add2.scm
View File

@ -27,11 +27,9 @@
(p (URL "/" "Return to main menu.") (br)
(URL "add2.scm" "Start new calculation."))))))))
(if result
(with-fatal-error-handler
(lambda (condition more)
(get-number input-text "Please enter a valid number."))
(input-field-value number-input-field
(form-query (http-url:search (request:url 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)

21
scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm
View File

@ -55,18 +55,17 @@
((returned-via? return-address bindings)
(return-to-main-page req))
((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)))
(if (and (integer? result)
(> result 0))
(begin
(set-options-instance-lifetime result)
(handler-options req
(format #f "Instance lifetime changed to ~a."
(options-instance-lifetime))))
(error "not a positive integer")))))
(if result
(if (and (integer? result)
(> result 0))
(begin
(set-options-instance-lifetime result)
(handler-options req
(format #f "Instance lifetime changed to ~a."
(options-instance-lifetime))))
(error "not a positive integer"))
(handler-options req "Please enter a valid, positive integer number"))))
((input-field-binding submit-cache bindings)
(let ((cache-plugins? (if (input-field-binding cache-checkbox bindings)
#t

5
scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm
View File

@ -89,10 +89,7 @@
((returned-via? reset-return-address bindings)
(reset-and-return-to-main-page req))
(else
(let ((new-gnuplot-location (with-fatal-error-handler
(lambda (condition more)
#f)
(input-field-value input-field bindings))))
(let ((new-gnuplot-location (input-field-value input-field bindings)))
(if (and new-gnuplot-location
(file-executable? new-gnuplot-location))
(begin

9
scheme/httpd/surflets/web-server/root/surflets/admin-servlets-cb.scm
View File

@ -58,12 +58,9 @@
(values
action
(filter-map (lambda (checkbox table-element)
(if(with-fatal-error-handler
(lambda (condition more)
#f)
(input-field-value checkbox bindings))
table-element
#f))
(if (input-field-value checkbox bindings)
table-element
#f))
checkboxes
table-elements)))))

4
scheme/httpd/surflets/web-server/root/surflets/admin-servlets.scm
View File

@ -58,9 +58,7 @@
(values #f #f)
(values action
(filter-map (lambda (checkbox table-element)
(if (with-fatal-error-handler
(lambda (c m) #f)
(input-field-value checkbox bindings))
(if (input-field-value checkbox bindings)
table-element
#f))
checkboxes

5
scheme/httpd/surflets/web-server/root/surflets/byte-input.scm
View File

@ -27,9 +27,8 @@
(if (null? checkboxes)
sum
(loop (+ sum (string->number
(with-fatal-error-handler
(lambda (condition decline) "0")
(input-field-value (car checkboxes) bindings))))
(or (input-field-value (car checkboxes) bindings)
"0")))
(cdr checkboxes)))))
checkboxes)))

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

@ -37,7 +37,7 @@
(make-callback
(lambda (req)
(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
(get-bindings req))))
))
@ -78,14 +78,8 @@
(td ,(make-submit-button
'(@ (value "change operator"))))))))))))
(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))))
(let ((number1 (input-field-value number-field1 bindings))
(number2 (input-field-value number-field2 bindings)))
(if number1
(if number2
(calculate operator-pair number1 number2)

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

@ -69,12 +69,8 @@
(hr)
(p (URL "/" "Return to main menu."))))))))
(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))))
(let ((number1 (input-field-value number-field1 bindings))
(number2 (input-field-value number-field2 bindings)))
(cond
((input-field-binding calculate-button bindings)
(if number1