[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
08/09: ui: Diagnostic procedures can display error location.
From: |
guix-commits |
Subject: |
08/09: ui: Diagnostic procedures can display error location. |
Date: |
Wed, 10 Apr 2019 06:41:10 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 402627714b8ba75be48b1c8fbd46cfd4cfe8238f
Author: Ludovic Courtès <address@hidden>
Date: Wed Apr 10 11:14:25 2019 +0200
ui: Diagnostic procedures can display error location.
* guix/ui.scm (define-diagnostic): Add optional 'location' parameter.
Pass it to 'print-diagnostic-prefix'.
(print-diagnostic-prefix): Add optional 'location' parameter and honor
it.
(report-load-error): Use 'report-error' and 'warning' instead
of (format (current-error-port) …).
---
guix/ui.scm | 64 +++++++++++++++++++++++++++++++------------------------------
1 file changed, 33 insertions(+), 31 deletions(-)
diff --git a/guix/ui.scm b/guix/ui.scm
index 8893cc8..9c8f943 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -132,22 +132,31 @@ messages."
(define-syntax name
(lambda (x)
(syntax-case x ()
- ((name (underscore fmt) args (... ...))
+ ((name location (underscore fmt) args (... ...))
(and (string? (syntax->datum #'fmt))
(free-identifier=? #'underscore #'G_))
#'(begin
- (print-diagnostic-prefix prefix)
+ (print-diagnostic-prefix prefix location)
(format (guix-warning-port) (gettext fmt %gettext-domain)
args (... ...))))
- ((name (N-underscore singular plural n) args (... ...))
+ ((name location (N-underscore singular plural n)
+ args (... ...))
(and (string? (syntax->datum #'singular))
(string? (syntax->datum #'plural))
(free-identifier=? #'N-underscore #'N_))
#'(begin
- (print-diagnostic-prefix prefix)
+ (print-diagnostic-prefix prefix location)
(format (guix-warning-port)
(ngettext singular plural n %gettext-domain)
- args (... ...))))))))))
+ args (... ...))))
+ ((name (underscore fmt) args (... ...))
+ (free-identifier=? #'underscore #'G_)
+ #'(name #f (underscore fmt) args (... ...)))
+ ((name (N-underscore singular plural n)
+ args (... ...))
+ (free-identifier=? #'N-underscore #'N_)
+ #'(name #f (N-underscore singular plural n)
+ args (... ...)))))))))
;; XXX: This doesn't work well for right-to-left languages.
;; TRANSLATORS: The goal is to emit "warning:" followed by a short phrase;
@@ -162,13 +171,16 @@ messages."
(report-error args ...)
(exit 1)))
-(define (print-diagnostic-prefix prefix)
+(define* (print-diagnostic-prefix prefix #:optional location)
"Print PREFIX as a diagnostic line prefix."
- (format (guix-warning-port) "~:[~*~;guix ~a: ~]~a"
- (program-name) (program-name)
- (if (string-null? prefix)
- prefix
- (gettext prefix %gettext-domain))))
+ (let ((prefix (if (string-null? prefix)
+ prefix
+ (gettext prefix %gettext-domain))))
+ (if location
+ (format (guix-warning-port) "~a: ~a"
+ (location->string location) prefix)
+ (format (guix-warning-port) "~:[~*~;guix ~a: ~]~a"
+ (program-name) (program-name) prefix))))
(define (print-unbound-variable-error port key args default-printer)
;; Print unbound variable errors more nicely, and in the right language.
@@ -360,21 +372,15 @@ ARGS is the list of arguments received by the 'throw'
handler."
(apply throw args)))
(('syntax-error proc message properties form . rest)
(let ((loc (source-properties->location properties)))
- (format (current-error-port) (G_ "~a: error: ~a~%")
- (location->string loc) message)))
+ (report-error loc (G_ "~a~%") message)))
(('unbound-variable _ ...)
(report-unbound-variable-error args #:frame frame))
(('srfi-34 obj)
(if (message-condition? obj)
- (if (error-location? obj)
- (format (current-error-port)
- (G_ "~a: error: ~a~%")
- (location->string (error-location obj))
- (gettext (condition-message obj)
- %gettext-domain))
- (report-error (G_ "~a~%")
- (gettext (condition-message obj)
- %gettext-domain)))
+ (report-error (and (error-location? obj)
+ (error-location obj))
+ (G_ "~a~%")
+ (gettext (condition-message obj) %gettext-domain))
(report-error (G_ "exception thrown: ~s~%") obj))
(when (fix-hint? obj)
(display-hint (condition-fix-hint obj))))
@@ -398,8 +404,7 @@ exiting. ARGS is the list of arguments received by the
'throw' handler."
(warning (G_ "failed to load '~a': ~a~%") file (strerror err))))
(('syntax-error proc message properties form . rest)
(let ((loc (source-properties->location properties)))
- (format (current-error-port) (G_ "~a: warning: ~a~%")
- (location->string loc) message)))
+ (warning loc (G_ "~a~%") message)))
(('srfi-34 obj)
(if (message-condition? obj)
(warning (G_ "failed to load '~a': ~a~%")
@@ -731,17 +736,14 @@ directories:~{ ~a~}~%")
(cons (invoke-error-program c)
(invoke-error-arguments c))))
((and (error-location? c) (message-condition? c))
- (format (current-error-port)
- (G_ "~a: error: ~a~%")
- (location->string (error-location c))
- (gettext (condition-message c) %gettext-domain))
+ (report-error (error-location c) (G_ "~a~%")
+ (gettext (condition-message c) %gettext-domain))
(when (fix-hint? c)
(display-hint (condition-fix-hint c)))
(exit 1))
((and (message-condition? c) (fix-hint? c))
- (format (current-error-port) "~a: error: ~a~%"
- (program-name)
- (gettext (condition-message c) %gettext-domain))
+ (report-error (G_ "~a~%")
+ (gettext (condition-message c) %gettext-domain))
(display-hint (condition-fix-hint c))
(exit 1))
((message-condition? c)
- branch master updated (6b11da7 -> 9e1e046), guix-commits, 2019/04/10
- 01/09: guix package: Use absolute file names in search path recommendations., guix-commits, 2019/04/10
- 02/09: doc: Adjust desktop instructions for GDM., guix-commits, 2019/04/10
- 05/09: ui: Fix i18n for diagnostic messages., guix-commits, 2019/04/10
- 09/09: ui: Colorize diagnostics., guix-commits, 2019/04/10
- 08/09: ui: Diagnostic procedures can display error location.,
guix-commits <=
- 04/09: Add (guix colors)., guix-commits, 2019/04/10
- 06/09: ui: Make diagnostic message prefix translatable., guix-commits, 2019/04/10
- 03/09: store: 'with-store' expands to a single procedure call., guix-commits, 2019/04/10
- 07/09: ui: Factorize 'print-diagnostic-prefix'., guix-commits, 2019/04/10