nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui: Colorize diagnostics. 

* guix/ui.scm (define-diagnostic): Add 'colors' parameter and pass it to
'print-diagnostic-prefix'.
(warning, info, report-error): Add extra argument.
(%warning-colors, %info-colors, %error-colors): New variables.
(print-diagnostic-prefix): Add #:colors parameter and honor it.
This commit is contained in:
Ludovic Courtès 2019-04-10 12:00:55 +02:00
parent 402627714b
commit 9e1e046040
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 33 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
guix/ui.scm
View File

@ -29,6 +29,7 @@
(define-module (guix ui)
#:use-module (guix i18n)
#:use-module (guix colors)
#:use-module (guix gexp)
#:use-module (guix sets)
#:use-module (guix utils)
@ -128,7 +129,7 @@
(syntax-rules ()
"Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all
messages."
((_ name (G_ prefix))
((_ name (G_ prefix) colors)
(define-syntax name
(lambda (x)
(syntax-case x ()
@ -136,7 +137,8 @@ messages."
(and (string? (syntax->datum #'fmt))
(free-identifier=? #'underscore #'G_))
#'(begin
(print-diagnostic-prefix prefix location)
(print-diagnostic-prefix prefix location
#:colors colors)
(format (guix-warning-port) (gettext fmt %gettext-domain)
args (... ...))))
((name location (N-underscore singular plural n)
@ -145,7 +147,8 @@ messages."
(string? (syntax->datum #'plural))
(free-identifier=? #'N-underscore #'N_))
#'(begin
(print-diagnostic-prefix prefix location)
(print-diagnostic-prefix prefix location
#:colors colors)
(format (guix-warning-port)
(ngettext singular plural n %gettext-domain)
args (... ...))))
@ -161,26 +164,47 @@ messages."
;; XXX: This doesn't work well for right-to-left languages.
;; TRANSLATORS: The goal is to emit "warning:" followed by a short phrase;
;; "~a" is a placeholder for that phrase.
(define-diagnostic warning (G_ "warning: ")) ;emit a warning
(define-diagnostic info (G_ ""))
(define-diagnostic warning (G_ "warning: ") %warning-colors) ;emit a warning
(define-diagnostic info (G_ "") %info-colors)
(define-diagnostic report-error (G_ "error: ") %error-colors)
(define-diagnostic report-error (G_ "error: "))
(define-syntax-rule (leave args ...)
"Emit an error message and exit."
(begin
(report-error args ...)
(exit 1)))
(define* (print-diagnostic-prefix prefix #:optional location)
(define %warning-colors '(BOLD MAGENTA))
(define %info-colors '(BOLD CYAN))
(define %error-colors '(BOLD RED))
(define* (print-diagnostic-prefix prefix #:optional location
#:key (colors '()))
"Print PREFIX as a diagnostic line prefix."
(define color?
(color-output? (guix-warning-port)))
(define location-color
(if color?
(cut colorize-string <> 'BOLD)
identity))
(define prefix-color
(if color?
(lambda (prefix)
(apply colorize-string prefix colors))
identity))
(let ((prefix (if (string-null? prefix)
prefix
(gettext prefix %gettext-domain))))
(if location
(format (guix-warning-port) "~a: ~a"
(location->string location) prefix)
(location-color (location->string location))
(prefix-color prefix))
(format (guix-warning-port) "~:[~*~;guix ~a: ~]~a"
(program-name) (program-name) prefix))))
(program-name) (program-name)
(prefix-color prefix)))))
(define (print-unbound-variable-error port key args default-printer)
;; Print unbound variable errors more nicely, and in the right language.