blocking with-input-from-pipe added by klm` on Thu Jul 7 14:03:35 2016


(use posix)
;; like open-input-file* but doesn't block other threads. obs: this
;; port isn't thread-safe (it may block all threads if used from
;; multiple threads). it's buffered, but not thread-safe. fd can be 0
;; for stdin.
(define (open-input-file*/nonblock fd)
  (##sys#file-nonblocking! fd)
  (define buffer '())
  (make-input-port
   (lambda ()
     (let retry ()
       (if (pair? buffer)
           (let ((head (car buffer)))
             (set! buffer (cdr buffer))
             head)
           ;; fill buffer and retry
           (begin
             (thread-wait-for-i/o! fd #:input)
             (let* ((r (file-read fd 1024))
                    (bytes (cadr r))
                    (data (substring (car r) 0 bytes)))
               (if (= 0 bytes) ;; we just waited for 0 bytes => eof
                   #!eof
                   (begin (set! buffer (string->list data))
                          (retry))))))))
   (lambda () (file-select fd #f 0))
   (lambda () (file-close fd))))

(define (with-input-from-pipe/nonblock cmd thunk #!optional (mode #:text))
  ;; open-input-pipe returns a blocking input-port. fix that.
  (define iport (open-input-file*/nonblock (port->fileno (open-input-pipe cmd mode))))
  (parameterize ((current-input-port iport))
    (dynamic-wind void
                  thunk
                  (lambda () (close-input-port iport)))))