~ruther/guix-local

f816dba680124860022ba155cf5a6a337739ef11 — Ludovic Courtès 9 years ago efe7d19
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.
1 files changed, 16 insertions(+), 4 deletions(-)

M guix/ui.scm
M guix/ui.scm => guix/ui.scm +16 -4
@@ 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))