Applied a patch fixing error when the standard input/output ports

are closed before the interactive session terminates.
This commit is contained in:
Abdulaziz Ghuloum 2008-08-03 13:50:20 -07:00
parent 6d52912aef
commit c5381d4cb3
2 changed files with 49 additions and 39 deletions

View File

@ -53,48 +53,58 @@ description:
(display ">" (console-output-port)) (display ">" (console-output-port))
(display-prompt (fx+ i 1)))))) (display-prompt (fx+ i 1))))))
(define my-read (define (print-ex ex)
(lambda (k) (flush-output-port (console-output-port))
(parameterize ([interrupt-handler (display "Unhandled exception\n" (console-error-port))
(lambda () (print-condition ex (console-error-port)))
(flush-output-port (console-output-port))
(reset-input-port! (console-input-port)) (define (reset k)
(newline (console-output-port)) (reset-input-port! (console-input-port))
(k))]) (k))
(read (console-input-port)))))
(define wait (define wait
(lambda (eval-proc escape-k) (lambda (eval-proc escape-k)
(call/cc (call/cc
(lambda (k) (lambda (k)
(with-exception-handler (display-prompt 0)
(lambda (con) (let ([x (with-exception-handler
(reset-input-port! (console-input-port)) (lambda (ex)
(k (void))) (cond [(lexical-violation? ex)
(lambda () (print-ex ex)
(with-exception-handler (reset k)]
(lambda (con) [(interrupted-condition? ex)
(flush-output-port (console-output-port)) (flush-output-port (console-output-port))
(display "Unhandled exception\n" (console-error-port)) (newline (console-output-port))
(print-condition con (console-error-port)) (reset k)]
(when (interrupted-condition? con) [else (raise-continuable ex)]))
(raise-continuable con))) (lambda ()
(lambda () (read (console-input-port))))])
(display-prompt 0) (cond
(let ([x (my-read k)]) [(eof-object? x)
(cond (newline (console-output-port))
[(eof-object? x) (escape-k (void))]
(newline (console-output-port)) [else
(escape-k (void))] (call-with-values
[else (lambda ()
(call-with-values (with-exception-handler
(lambda () (eval-proc x)) (lambda (ex)
(lambda v* (if (non-continuable-violation? ex)
(unless (andmap (lambda (v) (eq? v (void))) v*) (reset k)
(for-each (raise-continuable ex)))
(lambda (v) (lambda ()
(pretty-print v (console-output-port))) (with-exception-handler
v*))))])))))))) (lambda (ex)
(print-ex ex)
(when (serious-condition? ex)
(reset k)))
(lambda ()
(eval-proc x))))))
(lambda v*
(unless (andmap (lambda (v) (eq? v (void))) v*)
(for-each
(lambda (v)
(pretty-print v (console-output-port)))
v*))))]))))
(wait eval-proc escape-k))) (wait eval-proc escape-k)))
(define do-new-cafe (define do-new-cafe

View File

@ -1 +1 @@
1567 1568