diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-04-15 23:48:34 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-04-16 00:48:07 +0200 |
| commit | f816dba680124860022ba155cf5a6a337739ef11 (patch) | |
| tree | a9b05a1a6e147eae0fd49d662726197cbc1da46a | |
| parent | efe7d19a9edafb793dca21dcefce89ead3465030 (diff) | |
| download | guix-f816dba680124860022ba155cf5a6a337739ef11.tar.gz | |
ui: Gracefully report '&message' conditions.
* guix/ui.scm (report-load-error, warn-about-load-error) (read/eval): Add special-case for SRFI-35 &message conditions.
| -rw-r--r-- | guix/ui.scm | 20 |
1 files changed, 16 insertions, 4 deletions
diff --git a/guix/ui.scm b/guix/ui.scm index b3c94795fe..ae59718747 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -260,7 +260,11 @@ ARGS is the list of arguments received by the 'throw' handler." (format (current-error-port) (_ "~a: error: ~a~%") (location->string loc) message))) (('srfi-34 obj) - (report-error (_ "exception thrown: ~s~%") obj)) + (if (message-condition? obj) + (report-error (_ "~a~%") + (gettext (condition-message obj) + %gettext-domain)) + (report-error (_ "exception thrown: ~s~%") obj))) ((error args ...) (report-error (_ "failed to load '~a':~%") file) (apply display-error frame (current-error-port) args)))) @@ -277,8 +281,12 @@ exiting. ARGS is the list of arguments received by the 'throw' handler." (format (current-error-port) (_ "~a: warning: ~a~%") (location->string loc) message))) (('srfi-34 obj) - (warning (_ "failed to load '~a': exception thrown: ~s~%") - file obj)) + (if (message-condition? obj) + (warning (_ "failed to load '~a': ~a~%") + file + (gettext (condition-message obj) %gettext-domain)) + (warning (_ "failed to load '~a': exception thrown: ~s~%") + file obj))) ((error args ...) (warning (_ "failed to load '~a':~%") file) (apply display-error #f (current-error-port) args)))) @@ -539,7 +547,11 @@ similar." (('syntax-error proc message properties form . rest) (report-error (_ "syntax error: ~a~%") message)) (('srfi-34 obj) - (report-error (_ "exception thrown: ~s~%") obj)) + (if (message-condition? obj) + (report-error (_ "~a~%") + (gettext (condition-message obj) + %gettext-domain)) + (report-error (_ "exception thrown: ~s~%") obj))) ((error args ...) (apply display-error #f (current-error-port) args)) (what? #f)) |