From c1c5d68a94e219d0e56d5dc0e0d6ed9b08076a30 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 14 Apr 2019 19:48:19 +0200 Subject: colors: Add 'highlight'. * guix/colors.scm (%highlight-color): New variable. (highlight): New procedure. * guix/ui.scm (%highlight-argument)[highlight]: Remove. (%highlight-color): Remove. --- guix/colors.scm | 10 ++++++++++ guix/ui.scm | 11 ++--------- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/guix/colors.scm b/guix/colors.scm index 30ad231dfe..7949cf5763 100644 --- a/guix/colors.scm +++ b/guix/colors.scm @@ -30,6 +30,7 @@ color? colorize-string + highlight color-rules color-output? isatty?*)) @@ -132,6 +133,15 @@ that subsequent output will not have any colors in effect." (not (getenv "NO_COLOR")) (isatty?* port))) +(define %highlight-color (color BOLD)) + +(define* (highlight str #:optional (port (current-output-port))) + "Return STR with extra ANSI color attributes to highlight it if PORT +supports it." + (if (color-output? port) + (colorize-string str %highlight-color) + str)) + (define (colorize-matches rules) "Return a procedure that, when passed a string, returns that string colorized according to RULES. RULES must be a list of tuples like: diff --git a/guix/ui.scm b/guix/ui.scm index 2481a1b78b..39b13fd4bc 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -155,16 +155,10 @@ is a trivial format string." (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) - (colorize-string str %highlight-color)) - identity)) - (cond ((string? arg) - (highlight arg)) + (highlight arg port)) ((symbol? arg) - (highlight (symbol->string arg))) + (highlight (symbol->string arg) port)) (else arg))) (define-syntax define-diagnostic @@ -220,7 +214,6 @@ messages." (define %info-color (color BOLD)) (define %error-color (color BOLD RED)) (define %hint-color (color BOLD CYAN)) -(define %highlight-color (color BOLD)) (define* (print-diagnostic-prefix prefix #:optional location #:key (colors (color))) -- cgit v1.2.3