nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2015-07-15 18:01:05 +02:00
parent d2825c9614
commit df36e62938
2 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
guix/scripts/package.scm
View File

@ -307,22 +307,6 @@ RX."
((<) #t) ((<) #t)
(else #f))))) (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) (define (upgradeable? name current-version current-path)
"Return #t if there's a version of package NAME newer than CURRENT-VERSION, "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 or if the newest available version is equal to CURRENT-VERSION but would have

17
guix/ui.scm
View File

@ -62,6 +62,7 @@
show-manifest-transaction show-manifest-transaction
call-with-error-handling call-with-error-handling
with-error-handling with-error-handling
leave-on-EPIPE
read/eval read/eval
read/eval-package-expression read/eval-package-expression
location->string location->string
@ -430,6 +431,22 @@ interpreted."
(leave (_ "~a: ~a~%") proc (leave (_ "~a: ~a~%") proc
(apply format #f format-string format-args)))))) (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 (define %guix-user-module
;; Module in which user expressions are evaluated. ;; Module in which user expressions are evaluated.
;; Compute lazily to avoid circularity with (guix gexp). ;; Compute lazily to avoid circularity with (guix gexp).