diff options
Diffstat (limited to 'guix/ui.scm')
| -rw-r--r-- | guix/ui.scm | 62 |
1 files changed, 45 insertions, 17 deletions
diff --git a/guix/ui.scm b/guix/ui.scm index 588eb8480e..162eb35d26 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -388,12 +388,18 @@ ARGS is the list of arguments received by the 'throw' handler." (('unbound-variable _ ...) (report-unbound-variable-error args #:frame frame)) (((or 'srfi-34 '%exception) obj) - (if (message-condition? obj) - (report-error (and (error-location? obj) - (error-location obj)) - (G_ "~a~%") - (gettext (condition-message obj) %gettext-domain)) - (report-error (G_ "exception thrown: ~s~%") obj)) + (cond ((message-condition? obj) + (report-error (and (error-location? obj) + (error-location obj)) + (G_ "~a~%") + (gettext (condition-message obj) %gettext-domain))) + ((formatted-message? obj) + (apply report-error + (and (error-location? obj) (error-location obj)) + (gettext (formatted-message-string obj) %gettext-domain) + (formatted-message-arguments obj))) + (else + (report-error (G_ "exception thrown: ~s~%") obj))) (when (fix-hint? obj) (display-hint (condition-fix-hint obj)))) ((key args ...) @@ -420,12 +426,19 @@ exiting. ARGS is the list of arguments received by the 'throw' handler." (('unbound-variable _ ...) (report-unbound-variable-error args)) (((or 'srfi-34 '%exception) obj) - (if (message-condition? obj) - (warning (G_ "failed to load '~a': ~a~%") - file - (gettext (condition-message obj) %gettext-domain)) - (warning (G_ "failed to load '~a': exception thrown: ~s~%") - file obj))) + (cond ((message-condition? obj) + (warning (G_ "failed to load '~a': ~a~%") + file + (gettext (condition-message obj) %gettext-domain))) + ((formatted-message? obj) + (warning (G_ "failed to load '~a': ~a~%") + (apply format #f + (gettext (formatted-message-string obj) + %gettext-domain) + (formatted-message-arguments obj)))) + (else + (warning (G_ "failed to load '~a': exception thrown: ~s~%") + file obj)))) ((error args ...) (warning (G_ "failed to load '~a':~%") module) (apply display-error #f (current-error-port) args) @@ -791,6 +804,15 @@ directories:~{ ~a~}~%") (display-hint (condition-fix-hint c))) (exit 1)) + ((formatted-message? c) + (apply report-error + (and (error-location? c) (error-location c)) + (gettext (formatted-message-string c) %gettext-domain) + (formatted-message-arguments c)) + (when (fix-hint? c) + (display-hint (condition-fix-hint c))) + (exit 1)) + ;; On Guile 3.0.0, exceptions such as 'unbound-variable' are ;; compound and include a '&message'. However, that message only ;; contains the format string. Thus, special-case it here to @@ -854,11 +876,17 @@ similar." (('syntax-error proc message properties form . rest) (report-error (G_ "syntax error: ~a~%") message)) (((or 'srfi-34 '%exception) obj) - (if (message-condition? obj) - (report-error (G_ "~a~%") - (gettext (condition-message obj) - %gettext-domain)) - (report-error (G_ "exception thrown: ~s~%") obj))) + (cond ((message-condition? obj) + (report-error (G_ "~a~%") + (gettext (condition-message obj) + %gettext-domain))) + ((formatted-message? obj) + (apply report-error #f + (gettext (formatted-message-string obj) + %gettext-domain) + (formatted-message-arguments obj))) + (else + (report-error (G_ "exception thrown: ~s~%") obj)))) ((error args ...) (apply display-error #f (current-error-port) args)) (what? #f)) |