ui: Highlight package and service search results.

* 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.

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 @@ description matches REGEXPS sorted by relevance, and their score."
       (leave-on-EPIPE
        (display-search-results matches (current-output-port)
                                #:print service-type->recutils
+                               #:regexps regexps
                                #:command "guix home search")))))
 
 
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 @@ processed, #f otherwise."
               (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 @@ provided TYPE has a default value."
                                  #: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 @@ appropriate."
        (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 @@ appropriate."
 
   (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 @@ followed by \"+ \", which makes for a valid multi-line field value in the
 (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 @@ HYPERLINKS? is true, emit hyperlink escape sequences when appropriate."
   (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 @@ HYPERLINKS? is true, emit hyperlink escape sequences when appropriate."
             (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 @@ standard output is a tty, or with PORT set to the current 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 @@ them.  If PORT is a terminal, print at most a full screen of results."
   (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 @@ them.  If PORT is a terminal, print at most a full screen of results."
          (let* ((links? (supports-hyperlinks? port)))
            (print package paginated
                   #:hyperlinks? links?
-                  #:extra-fields `((relevance . ,score)))
+                  #:extra-fields `((relevance . ,score))
+                  #:highlighting highlighting)
            (loop rest)))
         (()
          #t)))))