summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-07-15 18:01:05 +0200
committerLudovic Courtès <ludo@gnu.org>2015-07-15 23:57:01 +0200
commitdf36e62938a7a2250601e7652a968e31f89a13f4 (patch)
tree10cb5395b2fbd9a3e544a70838bffba4ea8b3763
parentd2825c96141c7b6844d9e04f982919c0509165e1 (diff)
ui: Add 'leave-on-EPIPE'.
* guix/scripts/package.scm (leave-on-EPIPE): Move to... * guix/ui.scm (leave-on-EPIPE): ... here.
-rw-r--r--guix/scripts/package.scm16
-rw-r--r--guix/ui.scm17
2 files changed, 17 insertions, 16 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 56a6e2db64..b545ea2672 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -307,22 +307,6 @@ RX."
((<) #t)
(else #f)))))
-(define-syntax-rule (leave-on-EPIPE exp ...)
- "Run EXP... in a context when EPIPE errors are caught and lead to 'exit'
-with successful exit code. This is useful when writing to the standard output
-may lead to EPIPE, because the standard output is piped through 'head' or
-similar."
- (catch 'system-error
- (lambda ()
- exp ...)
- (lambda args
- ;; We really have to exit this brutally, otherwise Guile eventually
- ;; attempts to flush all the ports, leading to an uncaught EPIPE down
- ;; the path.
- (if (= EPIPE (system-error-errno args))
- (primitive-_exit 0)
- (apply throw args)))))
-
(define (upgradeable? name current-version current-path)
"Return #t if there's a version of package NAME newer than CURRENT-VERSION,
or if the newest available version is equal to CURRENT-VERSION but would have
diff --git a/guix/ui.scm b/guix/ui.scm
index 11af646a6e..28d4b97118 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -62,6 +62,7 @@
show-manifest-transaction
call-with-error-handling
with-error-handling
+ leave-on-EPIPE
read/eval
read/eval-package-expression
location->string
@@ -430,6 +431,22 @@ interpreted."
(leave (_ "~a: ~a~%") proc
(apply format #f format-string format-args))))))
+(define-syntax-rule (leave-on-EPIPE exp ...)
+ "Run EXP... in a context when EPIPE errors are caught and lead to 'exit'
+with successful exit code. This is useful when writing to the standard output
+may lead to EPIPE, because the standard output is piped through 'head' or
+similar."
+ (catch 'system-error
+ (lambda ()
+ exp ...)
+ (lambda args
+ ;; We really have to exit this brutally, otherwise Guile eventually
+ ;; attempts to flush all the ports, leading to an uncaught EPIPE down
+ ;; the path.
+ (if (= EPIPE (system-error-errno args))
+ (primitive-_exit 0)
+ (apply throw args)))))
+
(define %guix-user-module
;; Module in which user expressions are evaluated.
;; Compute lazily to avoid circularity with (guix gexp).