[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/09: ui: Highlight diagnostic format string arguments.
From: |
guix-commits |
Subject: |
02/09: ui: Highlight diagnostic format string arguments. |
Date: |
Wed, 10 Apr 2019 11:17:50 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 238589e566013a36df0347b200f8a6059398666c
Author: Ludovic Courtès <address@hidden>
Date: Wed Apr 10 16:12:54 2019 +0200
ui: Highlight diagnostic format string arguments.
* guix/ui.scm (highlight-argument): New macro.
(%highlight-argument): New procedure.
(define-diagnostic): Use 'highlight-argument'.
---
guix/ui.scm | 47 +++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 45 insertions(+), 2 deletions(-)
diff --git a/guix/ui.scm b/guix/ui.scm
index 63977f3..c3612d9 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -125,6 +125,48 @@
;;;
;;; Code:
+(define-syntax highlight-argument
+ (lambda (s)
+ "Given FMT and ARG, expand ARG to a call that highlights it, provided FMT
+is a trivial format string."
+ (define (trivial-format-string? fmt)
+ (define len
+ (string-length fmt))
+
+ (let loop ((start 0))
+ (or (>= (+ 1 start) len)
+ (let ((tilde (string-index fmt #\~ start)))
+ (or (not tilde)
+ (case (string-ref fmt (+ tilde 1))
+ ((#\a #\A #\%) (loop (+ tilde 2)))
+ (else #f)))))))
+
+ ;; Be conservative: limit format argument highlighting to cases where the
+ ;; format string contains nothing but ~a escapes. If it contained ~s
+ ;; escapes, this strategy wouldn't work.
+ (syntax-case s ()
+ ((_ "~a~%" arg) ;don't highlight whole messages
+ #'arg)
+ ((_ fmt arg)
+ (trivial-format-string? (syntax->datum #'fmt))
+ #'(%highlight-argument arg))
+ ((_ fmt arg)
+ #'arg))))
+
+(define* (%highlight-argument arg #:optional (port (guix-warning-port)))
+ "Highlight ARG, a format string argument, if PORT supports colors."
+ (define highlight
+ (if (color-output? port)
+ (lambda (str)
+ (apply colorize-string str %highlight-colors))
+ identity))
+
+ (cond ((string? arg)
+ (highlight arg))
+ ((symbol? arg)
+ (highlight (symbol->string arg)))
+ (else arg)))
+
(define-syntax define-diagnostic
(syntax-rules ()
"Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all
@@ -140,7 +182,7 @@ messages."
(print-diagnostic-prefix prefix location
#:colors colors)
(format (guix-warning-port) (gettext fmt %gettext-domain)
- args (... ...))))
+ (highlight-argument fmt args) (... ...))))
((name location (N-underscore singular plural n)
args (... ...))
(and (string? (syntax->datum #'singular))
@@ -151,7 +193,7 @@ messages."
#:colors colors)
(format (guix-warning-port)
(ngettext singular plural n %gettext-domain)
- args (... ...))))
+ (highlight-argument singular args) (... ...))))
((name (underscore fmt) args (... ...))
(free-identifier=? #'underscore #'G_)
#'(name #f (underscore fmt) args (... ...)))
@@ -178,6 +220,7 @@ messages."
(define %info-colors '(BOLD))
(define %error-colors '(BOLD RED))
(define %hint-colors '(BOLD CYAN))
+(define %highlight-colors '(BOLD))
(define* (print-diagnostic-prefix prefix #:optional location
#:key (colors '()))
- branch master updated (eff3a9b -> 3e4e74c), guix-commits, 2019/04/10
- 04/09: Add (guix store roots)., guix-commits, 2019/04/10
- 02/09: ui: Highlight diagnostic format string arguments.,
guix-commits <=
- 01/09: ui: Colorize hints., guix-commits, 2019/04/10
- 08/09: scripts: GC hint suggests 'guix gc -d 1m'., guix-commits, 2019/04/10
- 07/09: guix gc: Add '--delete-generations'., guix-commits, 2019/04/10
- 05/09: guix gc: Add '--list-roots'., guix-commits, 2019/04/10
- 03/09: pull: Remove duplicate '--dry-run' description., guix-commits, 2019/04/10
- 09/09: gnu: kodi: Allow connecting to HTTPS sources., guix-commits, 2019/04/10
- 06/09: profiles: Add 'generation-profile'., guix-commits, 2019/04/10