diff options
| -rw-r--r-- | tissue/utils.scm | 15 |
1 files changed, 15 insertions, 0 deletions
diff --git a/tissue/utils.scm b/tissue/utils.scm index aed729b..2eccc4f 100644 --- a/tissue/utils.scm +++ b/tissue/utils.scm @@ -24,6 +24,7 @@ #:export (string-remove-prefix human-date-string call-with-current-directory + call-with-output-pipe get-line-dos-or-unix memoize-thunk)) @@ -59,6 +60,20 @@ directory after THUNK returns." thunk (cut chdir original-current-directory)))) +(define (call-with-output-pipe proc program . args) + "Execute PROGRAM ARGS ... in a subprocess with a pipe to it. Call PROC +with an output port to that pipe. Close the pipe once PROC exits, even +if it exits non-locally. Return the value returned by PROC." + (let ((port #f)) + (dynamic-wind + (cut set! port (apply open-pipe* OPEN_WRITE program args)) + (cut proc port) + (lambda () + (let ((return-value (status:exit-val (close-pipe port)))) + (unless (and return-value + (zero? return-value)) + (error "Invocation of program failed" (cons program args)))))))) + (define (get-line-dos-or-unix port) "Read line from PORT. This differs from `get-line' in (rnrs io ports) in that it also supports DOS line endings." |