[bug#54823] [PATCH 0/3] Highlight keywords in search results

[bug#54823] [PATCH 0/3] Highlight keywords in search results

[Ludovic Courtès]

Hi!

In the quest for colorful output, one thing I’ve always missed
is keyword highlighting in the search results in ‘guix search’,
‘guix system search’, and ‘guix home search’.

The last patch does that; the first one highlights the ‘name’
and ‘version’ field of the recutils output.

Thoughts?

Ludo’.

Ludovic Courtès (3):
  ui: Highlight important bits in recutils output.
  colors: Add 'colorize-full-matches'.
  ui: Highlight package and service search results.

 guix/colors.scm                | 22 ++++++++++++
 guix/scripts/home.scm          |  1 +
 guix/scripts/package.scm       |  3 +-
 guix/scripts/system/search.scm | 37 +++++++++++++-------
 guix/ui.scm                    | 64 +++++++++++++++++++++++-----------
 5 files changed, 93 insertions(+), 34 deletions(-)


base-commit: 0996d48d0e79a360e0d5583b812cd565f62ca32e
-- 
2.35.1

[bug#54823] [PATCH 1/3] ui: Highlight important bits in recutils output.

[Ludovic Courtès]

* guix/scripts/system/search.scm (service-type->recutils): Highlight the
value of the 'name' field.
* guix/ui.scm (package->recutils): Likewise for 'name' and 'version'.
---
 guix/scripts/system/search.scm | 9 +++++++--
 guix/ui.scm                    | 7 +++++--
 2 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index 93c9fc5644..2a237e03d9 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -20,7 +20,7 @@
 (define-module (guix scripts system search)
   #:use-module (guix ui)
   #:use-module (guix utils)
-  #:autoload   (guix colors) (supports-hyperlinks?)
+  #:autoload   (guix colors) (highlight supports-hyperlinks?)
   #:autoload   (guix diagnostics) (location->hyperlink)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
@@ -74,6 +74,9 @@ (define* (service-type->recutils type port
   "Write to PORT a recutils record of TYPE, arranging to fit within WIDTH
 columns.  When HYPERLINKS? is true, emit hyperlink escape sequences when
 appropriate."
+  (define port*
+    (or (pager-wrapped-port port) port))
+
   (define width*
     ;; The available number of columns once we've taken into account space for
     ;; the initial "+ " prefix.
@@ -88,7 +91,9 @@ (define (extensions->recutils extensions)
                        (string-length "extends: ")))))
 
   ;; Note: Don't i18n field names so that people can post-process it.
-  (format port "name: ~a~%" (service-type-name type))
+  (format port "name: ~a~%"
+          (highlight (symbol->string (service-type-name type))
+                     port*))
   (format port "location: ~a~%"
           (or (and=> (service-type-location type)
                      (if hyperlinks? location->hyperlink location->string))
diff --git a/guix/ui.scm b/guix/ui.scm
index 37d24030e4..555a614faa 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1489,6 +1489,9 @@ (define* (package->recutils p port #:optional (width (%text-width))
   "Write to PORT a `recutils' record of package P, arranging to fit within
 WIDTH columns.  EXTRA-FIELDS is a list of symbol/value pairs to emit.  When
 HYPERLINKS? is true, emit hyperlink escape sequences when appropriate."
+  (define port*
+    (or (pager-wrapped-port port) port))
+
   (define width*
     ;; The available number of columns once we've taken into account space for
     ;; the initial "+ " prefix.
@@ -1508,8 +1511,8 @@ (define (package<? p1 p2)
     (string<? (package-full-name p1) (package-full-name p2)))
 
   ;; Note: Don't i18n field names so that people can post-process it.
-  (format port "name: ~a~%" (package-name p))
-  (format port "version: ~a~%" (package-version p))
+  (format port "name: ~a~%" (highlight (package-name p) port*))
+  (format port "version: ~a~%" (highlight (package-version p) port*))
   (format port "outputs: ~a~%" (string-join (package-outputs p)))
   (format port "systems: ~a~%"
           (split-lines (string-join (package-transitive-supported-systems p))
-- 
2.35.1

[bug#54823] [PATCH 2/3] colors: Add 'colorize-full-matches'.

[Ludovic Courtès]

* 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

[bug#54823] [PATCH 3/3] ui: Highlight package and service search results.

[Ludovic Courtès]

* guix/ui.scm (package->recutils): Add #:highlighting parameter and use it.
(display-search-results): Add #:regexps parameter; call
'colorize-full-matches' and pass #:highlighting.
* guix/scripts/package.scm (process-query): Pass #:regexps to
'display-search-results'.
* guix/scripts/home.scm (search): Likewise.
* guix/scripts/system/search.scm (service-type->recutils): Add #:highlighting
parameter and use it.
---
 guix/scripts/home.scm          |  1 +
 guix/scripts/package.scm       |  3 +-
 guix/scripts/system/search.scm | 30 +++++++++++-------
 guix/ui.scm                    | 57 ++++++++++++++++++++++------------
 4 files changed, 60 insertions(+), 31 deletions(-)

diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 341d83943d..f43bf865a7 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -733,6 +733,7 @@ (define (search . args)
       (leave-on-EPIPE
        (display-search-results matches (current-output-port)
                                #:print service-type->recutils
+                               #:regexps regexps
                                #:command "guix home search")))))
 
 \f
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 22ee8a2485..d007005607 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -885,7 +885,8 @@ (define (diff-profiles profile numbers)
               (regexps  (map (cut make-regexp* <> regexp/icase) patterns))
               (matches  (find-packages-by-description regexps)))
          (leave-on-EPIPE
-          (display-search-results matches (current-output-port)))
+          (display-search-results matches (current-output-port)
+                                  #:regexps regexps))
          #t))
 
       (('show _)
diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index 2a237e03d9..d70ed266f4 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -20,7 +20,7 @@
 (define-module (guix scripts system search)
   #:use-module (guix ui)
   #:use-module (guix utils)
-  #:autoload   (guix colors) (highlight supports-hyperlinks?)
+  #:autoload   (guix colors) (color-output? highlight supports-hyperlinks?)
   #:autoload   (guix diagnostics) (location->hyperlink)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
@@ -70,10 +70,12 @@ (define* (service-type->recutils type port
                                  #:optional (width (%text-width))
                                  #:key
                                  (extra-fields '())
-                                 (hyperlinks? (supports-hyperlinks? port)))
+                                 (hyperlinks? (supports-hyperlinks? port))
+                                 (highlighting identity))
   "Write to PORT a recutils record of TYPE, arranging to fit within WIDTH
 columns.  When HYPERLINKS? is true, emit hyperlink escape sequences when
-appropriate."
+appropriate.  Pass the description through HIGHLIGHTING, a one-argument
+procedure that may return a colorized version of its argument."
   (define port*
     (or (pager-wrapped-port port) port))
 
@@ -90,6 +92,11 @@ (define (extensions->recutils extensions)
        (fill-paragraph list width*
                        (string-length "extends: ")))))
 
+  (define highlighting*
+    (if (color-output? port*)
+        highlighting
+        identity))
+
   ;; Note: Don't i18n field names so that people can post-process it.
   (format port "name: ~a~%"
           (highlight (symbol->string (service-type-name type))
@@ -114,14 +121,15 @@ (define (extensions->recutils extensions)
 
   (when (service-type-description type)
     (format port "~a~%"
-            (string->recutils
-             (string-trim-right
-              (parameterize ((%text-width width*))
-                (texi->plain-text
-                 (string-append "description: "
-                                (or (and=> (service-type-description type) P_)
-                                    ""))))
-              #\newline))))
+            (highlighting*
+             (string->recutils
+              (string-trim-right
+               (parameterize ((%text-width width*))
+                 (texi->plain-text
+                  (string-append "description: "
+                                 (or (and=> (service-type-description type) P_)
+                                     ""))))
+               #\newline)))))
 
   (for-each (match-lambda
               ((field . value)
diff --git a/guix/ui.scm b/guix/ui.scm
index 555a614faa..cb68a07c6c 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1485,10 +1485,13 @@ (define (string->recutils str)
 (define* (package->recutils p port #:optional (width (%text-width))
                             #:key
                             (hyperlinks? (supports-hyperlinks? port))
-                            (extra-fields '()))
+                            (extra-fields '())
+                            (highlighting identity))
   "Write to PORT a `recutils' record of package P, arranging to fit within
 WIDTH columns.  EXTRA-FIELDS is a list of symbol/value pairs to emit.  When
-HYPERLINKS? is true, emit hyperlink escape sequences when appropriate."
+HYPERLINKS? is true, emit hyperlink escape sequences when appropriate.  Pass
+the synopsis and description through HIGHLIGHTING, a one-argument procedure
+that may return a colorized version of its argument."
   (define port*
     (or (pager-wrapped-port port) port))
 
@@ -1510,6 +1513,11 @@ (define (dependencies->recutils packages)
   (define (package<? p1 p2)
     (string<? (package-full-name p1) (package-full-name p2)))
 
+  (define highlighting*
+    (if (color-output? port*)
+        highlighting
+        identity))
+
   ;; Note: Don't i18n field names so that people can post-process it.
   (format port "name: ~a~%" (highlight (package-name p) port*))
   (format port "version: ~a~%" (highlight (package-version p) port*))
@@ -1544,22 +1552,24 @@ (define (package<? p1 p2)
             (x
              (G_ "unknown"))))
   (format port "synopsis: ~a~%"
-          (string-map (match-lambda
-                        (#\newline #\space)
-                        (chr       chr))
-                      (or (package-synopsis-string p) "")))
+          (highlighting*
+           (string-map (match-lambda
+                         (#\newline #\space)
+                         (chr       chr))
+                       (or (package-synopsis-string p) ""))))
   (format port "~a~%"
-          (string->recutils
-           (string-trim-right
-            (parameterize ((%text-width width*))
-              ;; Call 'texi->plain-text' on the concatenated string to account
-              ;; for the width of "description:" in paragraph filling.
-              (texi->plain-text*
-               p
-               (string-append "description: "
-                              (or (and=> (package-description p) P_)
-                                  ""))))
-            #\newline)))
+          (highlighting*
+           (string->recutils
+            (string-trim-right
+             (parameterize ((%text-width width*))
+               ;; Call 'texi->plain-text' on the concatenated string to account
+               ;; for the width of "description:" in paragraph filling.
+               (texi->plain-text*
+                p
+                (string-append "description: "
+                               (or (and=> (package-description p) P_)
+                                   ""))))
+             #\newline))))
   (for-each (match-lambda
               ((field . value)
                (let ((field (symbol->string field)))
@@ -1707,10 +1717,12 @@ (define-syntax with-paginated-output-port
 
 (define* (display-search-results matches port
                                  #:key
+                                 (regexps '())
                                  (command "guix search")
                                  (print package->recutils))
   "Display MATCHES, a list of object/score pairs, by calling PRINT on each of
-them.  If PORT is a terminal, print at most a full screen of results."
+them.  If PORT is a terminal, print at most a full screen of results.  REGEXPS
+is a list of regexps to highlight in search results."
   (define first-line
     (port-line port))
 
@@ -1721,6 +1733,12 @@ (define max-rows
   (define (line-count str)
     (string-count str #\newline))
 
+  (define highlighting
+    (let ((match-color (color ON-RED BOLD)))
+      (colorize-full-matches (map (lambda (regexp)
+                                    (cons regexp match-color))
+                                  regexps))))
+
   (with-paginated-output-port paginated
     (let loop ((matches matches))
       (match matches
@@ -1728,7 +1746,8 @@ (define (line-count str)
          (let* ((links? (supports-hyperlinks? port)))
            (print package paginated
                   #:hyperlinks? links?
-                  #:extra-fields `((relevance . ,score)))
+                  #:extra-fields `((relevance . ,score))
+                  #:highlighting highlighting)
            (loop rest)))
         (()
          #t)))))
-- 
2.35.1

bug#54823: [PATCH 0/3] Highlight keywords in search results

[Ludovic Courtès]

Pushed!

  5e0c347975 ui: Highlight package and service search results.
  d08e4d52a3 colors: Add 'colorize-full-matches'.
  00dcfb261b ui: Highlight important bits in recutils output.