summaryrefslogtreecommitdiff
path: root/guix/colors.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-04-09 20:09:58 +0200
committerLudovic Courtès <ludo@gnu.org>2022-04-19 18:07:49 +0200
commitd08e4d52a3c9790b8141d10540d4215a1df80375 (patch)
tree81dcf01fc38030294d0c78e0abc44c21e4dfb15b /guix/colors.scm
parent00dcfb261b207f58d45d6cc542bdcdb0c346598d (diff)
colors: Add 'colorize-full-matches'.
* guix/colors.scm (colorize-full-matches): New procedure.
Diffstat (limited to 'guix/colors.scm')
-rw-r--r--guix/colors.scm22
1 files changed, 22 insertions, 0 deletions
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: