unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 54823@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#54823] [PATCH 2/3] colors: Add 'colorize-full-matches'.
Date: Sat,  9 Apr 2022 22:23:43 +0200	[thread overview]
Message-ID: <20220409202344.32090-2-ludo@gnu.org> (raw)
In-Reply-To: <20220409202344.32090-1-ludo@gnu.org>

* 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 @@ (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:
-- 
2.35.1





  reply	other threads:[~2022-04-09 20:25 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-04-09 20:22 [bug#54823] [PATCH 0/3] Highlight keywords in search results Ludovic Courtès
2022-04-09 20:23 ` [bug#54823] [PATCH 1/3] ui: Highlight important bits in recutils output Ludovic Courtès
2022-04-09 20:23   ` Ludovic Courtès [this message]
2022-04-09 20:23   ` [bug#54823] [PATCH 3/3] ui: Highlight package and service search results Ludovic Courtès
2022-04-19 16:09 ` bug#54823: [PATCH 0/3] Highlight keywords in " Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20220409202344.32090-2-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=54823@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).