Deal with tty's that return EIO on EOF (e.g. on Linux)
This commit is contained in:
parent
c02e88c11a
commit
d222c8aefb
|
@ -20,16 +20,29 @@
|
|||
pty-in pty-out pause-channel resume-channel
|
||||
window terminal-buffer)))
|
||||
|
||||
(define (eio? condition)
|
||||
(and (eq? (car condition) 'exception)
|
||||
(eq? (list-ref condition 2) 'os-error)
|
||||
(= (list-ref condition 3) errno/io)))
|
||||
|
||||
(define (read-char-pty pty)
|
||||
(with-fatal-error-handler
|
||||
(lambda (condition more)
|
||||
(if (eio? condition)
|
||||
(eof-object)
|
||||
(more)))
|
||||
(read-char pty)))
|
||||
|
||||
(define (make-channel-for-pty-out pty)
|
||||
(let ((channel (make-channel)))
|
||||
(spawn
|
||||
(lambda ()
|
||||
(debug-message "make-channel-for-pty-out " pty)
|
||||
(let lp ((c (read-char pty)))
|
||||
(let lp ((c (read-char-pty pty)))
|
||||
(if (not (eof-object? c))
|
||||
(begin
|
||||
(send channel c)
|
||||
(lp (read-char pty)))))))
|
||||
(lp (read-char-pty pty)))))))
|
||||
channel))
|
||||
|
||||
(define (spawn-console-loop
|
||||
|
|
Loading…
Reference in New Issue