~ruther/guix-local

df36e62938a7a2250601e7652a968e31f89a13f4 — Ludovic Courtès 10 years ago d2825c9
ui: Add 'leave-on-EPIPE'.

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

M guix/scripts/package.scm
M guix/ui.scm
M guix/scripts/package.scm => guix/scripts/package.scm +0 -16
@@ 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

M guix/ui.scm => guix/ui.scm +17 -0
@@ 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).