diff options
Diffstat (limited to 'scsh-process.scm')
| -rw-r--r-- | scsh-process.scm | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/scsh-process.scm b/scsh-process.scm index c6e4337..b39543f 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -45,7 +45,7 @@ run/collecting run/string run/strings run/port run/file run/sexp run/sexps || && (& run-final-thunk maybe->string) (run maybe->string) (exec-epf maybe->string) - process?) + process? wait) (import chicken scheme data-structures) @@ -77,8 +77,14 @@ (define (remove-scsh-pending-process! pid) (hash-table-delete! *scsh-pending-processes* pid)) +(define wait #f) + (let ((posix-process-wait process-wait)) (set! process-wait + (lambda (#!optional pid nohang) + (receive (status ok? pid) (wait pid nohang) (values pid ok? status)))) + + (set! wait (lambda (#!optional pid-or-process nohang) (unless (or (not pid-or-process) (scsh-process? pid-or-process) @@ -91,14 +97,14 @@ pid-or-process #f) pid-or-process))) (if (and p (scsh-process-exit-status p)) - (values (scsh-process-pid p) + (values (scsh-process-exit-status p) (scsh-process-ok? p) - (scsh-process-exit-status p)) + (scsh-process-pid p)) (handle-exceptions exn (if (and p (scsh-process-exit-status p)) ; Signal might've occurred - (values (scsh-process-pid p) + (values (scsh-process-exit-status p) (scsh-process-ok? p) - (scsh-process-exit-status p)) + (scsh-process-pid p)) (abort exn)) (receive (pid ok? status) (posix-process-wait (and p (scsh-process-pid p)) nohang) @@ -107,7 +113,7 @@ (scsh-process-exit-status-set! p status) (scsh-process-ok?-set! p ok?)) (remove-scsh-pending-process! pid)) - (values pid ok? status))))))) + (values status ok? pid))))))) (set-signal-handler! signal/chld @@ -221,9 +227,7 @@ (conns (map (lambda (from-fd temp-file) (list from-fd (port->fileno temp-file))) fds temp-files))) - (receive (pid ok? status) - (process-wait (fork/pipe+ conns thunk)) - (apply values status temp-files)))) + (apply values (wait (fork/pipe+ conns thunk)) temp-files))) (define (run/port* thunk) (receive (in out) @@ -243,7 +247,7 @@ (define (run/file* thunk) (let* ((temp-file (create-temporary-file))) - (process-wait ; This is peculiar + (wait ; This is peculiar (fork/pipe (lambda () (let ((fd (file-open temp-file open/wronly))) (duplicate-fileno fd 1) @@ -306,9 +310,7 @@ (define-syntax run (syntax-rules () ((_ ?epf ...) - (receive (pid ok? status) - (process-wait (& ?epf ...)) - (values status ok? pid))))) + (wait (& ?epf ...))))) ;; Perhaps this should really be a procedure? (define-syntax setup-redirection |