02/05: ui: Gracefully report '&message' conditions.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit f816dba680124860022ba155cf5a6a337739ef11
Author: Ludovic Courtès <address@hidden>
Date:   Sat Apr 15 23:48:34 2017 +0200

    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.
---
 guix/ui.scm | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index b3c9479..ae59718 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))