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