ui: Add 'leave-on-EPIPE'.
* guix/scripts/package.scm (leave-on-EPIPE): Move to... * guix/ui.scm (leave-on-EPIPE): ... here.
This commit is contained in:
parent
d2825c9614
commit
df36e62938
|
@ -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
|
||||
|
|
17
guix/ui.scm
17
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).
|
||||
|
|
Loading…
Reference in New Issue