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

removed bug in MAKE-YES-NO

This commit is contained in:
interp 2002-11-05 22:20:59 +00:00
parent d4ea641e14
commit 555af5225d
1 changed files with 10 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
scheme/httpd/surflets/simple-surflet-api.scm
View File

@ -32,9 +32,9 @@
(lambda (exit) (lambda (exit)
(map (lambda (query) (map (lambda (query)
(with-fatal-error-handler (with-fatal-error-handler
(lambda (c m) (lambda (c m)
(exit (exit
(get-results queries title (get-results queries title
(ask query 'bad-input-text)))) (ask query 'bad-input-text))))
(ask query 'value bindings))) (ask query 'value bindings)))
queries))))) queries)))))
@ -107,9 +107,11 @@
(else (else
(get-method standard message)))))) (get-method standard message))))))
(define (make-radio text choices) (define (make-radio text choices . maybe-insist)
(let* ((radios (make-radio-input-fields choices)) (let* ((insist (:optional maybe-insist ""))
(standard (standard-query text (car radios) "Please respond"))) (radios (make-radio-input-fields choices))
(standard (standard-query text (car radios)
(string-append "Please respond" insist))))
(lambda (message) (lambda (message)
(case message (case message
((html-table-row) ((html-table-row)
@ -124,15 +126,9 @@
(get-method standard message)))))) (get-method standard message))))))
(define (make-yes-no text yes-text no-text) (define (make-yes-no text yes-text no-text)
(let ((radio (make-radio text (list yes-text no-text)))) (make-radio text
(lambda (message) (list yes-text no-text)
(case message (format #f " with ~s or ~s" yes-text no-text)))
((bad-input-text)
(format #f "Please respond with ~s or ~s"
yes-text no-text))
(else
(get-method radio message))))))
(define (transform-string-to-query query) (define (transform-string-to-query query)
(if (string? query) (if (string? query)