02/05: colors: Add 'colorize-full-matches'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit d08e4d52a3c9790b8141d10540d4215a1df80375
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Apr 9 20:09:58 2022 +0200

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

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 @@
             highlight/warn
             dim
 
+            colorize-full-matches
             color-rules
             color-output?
             isatty?*
@@ -153,6 +154,27 @@ that subsequent output will not have any colors in effect."
 (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: