colors: Add 'highlight'.

* guix/colors.scm (%highlight-color): New variable.
(highlight): New procedure.
* guix/ui.scm (%highlight-argument)[highlight]: Remove.
(%highlight-color): Remove.

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)))