summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--tissue/utils.scm15
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."