ui: Factorize 'print-diagnostic-prefix'.

* guix/ui.scm (define-diagnostic): Emit call to 'print-diagnostic-prefix'.
(print-diagnostic-prefix): New procedure.
This commit is contained in:
Ludovic Courtès 2019-04-10 10:26:39 +02:00
parent 26a2021a1f
commit cc3697d543
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 10 additions and 6 deletions

View File

@ -136,9 +136,7 @@ messages."
(and (string? (syntax->datum #'fmt)) (and (string? (syntax->datum #'fmt))
(free-identifier=? #'underscore #'G_)) (free-identifier=? #'underscore #'G_))
#'(begin #'(begin
(format (guix-warning-port) "~:[~*~;guix ~a: ~]~a" (print-diagnostic-prefix prefix)
(program-name) (program-name)
(gettext prefix %gettext-domain))
(format (guix-warning-port) (gettext fmt %gettext-domain) (format (guix-warning-port) (gettext fmt %gettext-domain)
args (... ...)))) args (... ...))))
((name (N-underscore singular plural n) args (... ...)) ((name (N-underscore singular plural n) args (... ...))
@ -146,9 +144,7 @@ messages."
(string? (syntax->datum #'plural)) (string? (syntax->datum #'plural))
(free-identifier=? #'N-underscore #'N_)) (free-identifier=? #'N-underscore #'N_))
#'(begin #'(begin
(format (guix-warning-port) "~:[~*~;guix ~a: ~]~a" (print-diagnostic-prefix prefix)
(program-name) (program-name)
(gettext prefix %gettext-domain))
(format (guix-warning-port) (format (guix-warning-port)
(ngettext singular plural n %gettext-domain) (ngettext singular plural n %gettext-domain)
args (... ...)))))))))) args (... ...))))))))))
@ -166,6 +162,14 @@ messages."
(report-error args ...) (report-error args ...)
(exit 1))) (exit 1)))
(define (print-diagnostic-prefix prefix)
"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))))
(define (print-unbound-variable-error port key args default-printer) (define (print-unbound-variable-error port key args default-printer)
;; Print unbound variable errors more nicely, and in the right language. ;; Print unbound variable errors more nicely, and in the right language.
(match args (match args