;;; this is stolen from http://bugs.call-cc.org/ticket/766


(define (open-input-file*/nonblock fd)
  (make-input-port
   (lambda ()
      (thread-wait-for-i/o! fd #:input)
      (let ((r (file-read fd 1)))
        (if (= 1 (cadr r)) ;; number of bytes read must = 1
            (string-ref (car r) 0)
            #!eof)))
    (lambda () (file-select fd #f 0))
    (lambda () (file-close fd))))

;; like open-output-file* but doesn't buffer anything.
(define (open-output-file*/nobuffer fd)
   (make-output-port (lambda (x) (file-write fd x))
                     (lambda ()  (file-close fd))))

;;; process* fix from Moritz (http://bugs.call-cc.org/ticket/766).
;;; non-blocking, line-buffered cli from a subprocess.
(define (spawn* cmd #!optional args env)
  (let*-values
      (((in-in   in-out) (create-pipe))
       ((out-in out-out) (create-pipe))
       ((pid) (process-fork
               (lambda ()
                 (duplicate-fileno in-in fileno/stdin)
                 (duplicate-fileno out-out fileno/stdout)
                 (file-close in-out)
                 (file-close in-in)
                 (file-close out-in)
                 (file-close out-out)
                 (process-execute cmd args env)))))

    (file-close in-in)
    (file-close out-out)

    (values (open-input-file*/nonblock  out-in)
            (open-output-file*/nobuffer in-out)
            pid)))





;; now this works:

(begin
  (print "begin " (current-milliseconds))

  (thread-start!
   (lambda ()
     (let-values (((pip pop pid) (spawn* "sh" '("-c" "sleep 1 ; echo foo"))))
       (print "output: "(read-string #f pip))
       (process-signal pid)
       (process-wait pid))))
  (thread-yield!)
  (print "end " (current-milliseconds)))