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.
master
Ludovic Courtès 2017-04-15 23:48:34 +02:00
parent efe7d19a9e
commit f816dba680
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 16 additions and 4 deletions

View File

@ -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))