04/06: ui: Add 'leave-on-EPIPE'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit df36e62938a7a2250601e7652a968e31f89a13f4
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jul 15 18:01:05 2015 +0200

    ui: Add 'leave-on-EPIPE'.
    
    * guix/scripts/package.scm (leave-on-EPIPE): Move to...
    * guix/ui.scm (leave-on-EPIPE): ... here.
---
 guix/scripts/package.scm |   16 ----------------
 guix/ui.scm              |   17 +++++++++++++++++
 2 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 56a6e2d..b545ea2 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 11af646..28d4b97 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).