From d08e4d52a3c9790b8141d10540d4215a1df80375 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 9 Apr 2022 20:09:58 +0200
Subject: colors: Add 'colorize-full-matches'.

* guix/colors.scm (colorize-full-matches): New procedure.
---
 guix/colors.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'guix')

diff --git a/guix/colors.scm b/guix/colors.scm
index 3fd36c68ef..543f4c3ec5 100644
--- a/guix/colors.scm
+++ b/guix/colors.scm
@@ -36,6 +36,7 @@ (define-module (guix colors)
             highlight/warn
             dim
 
+            colorize-full-matches
             color-rules
             color-output?
             isatty?*
@@ -153,6 +154,27 @@ (define highlight (coloring-procedure (color BOLD)))
 (define highlight/warn (coloring-procedure (color BOLD MAGENTA)))
 (define dim (coloring-procedure (color DARK)))
 
+(define (colorize-full-matches rules)
+  "Return a procedure that, given a string, colorizes according to RULES.
+RULES must be a list of regexp/color pairs; the whole match of a regexp is
+colorized with the corresponding color."
+  (define proc
+    (lambda (str)
+      (if (string-index str #\nul)
+          str
+          (let loop ((rules rules))
+            (match rules
+              (()
+               str)
+              (((regexp . color) . rest)
+               (match (regexp-exec regexp str)
+                 (#f (loop rest))
+                 (m  (string-append (proc (match:prefix m))
+                                    (colorize-string (match:substring m)
+                                                     color)
+                                    (proc (match:suffix m)))))))))))
+  proc)
+
 (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:
-- 
cgit v1.2.3