(use posix extras ports srfi-13 srfi-18 posix srfi-1 clojurian-syntax)

;; don't exit on signal/pipe!
;; see http://krokisplace.blogspot.no/2010/02/suppressing-sigpipe-in-library.htlm
(set! (signal-handler signal/pipe) #f)

;; 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). note that it's unbuffered.
(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)))