From: "Ludovic Courtès" <ludo@gnu.org>
To: 54823@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#54823] [PATCH 3/3] ui: Highlight package and service search results.
Date: Sat, 9 Apr 2022 22:23:44 +0200 [thread overview]
Message-ID: <20220409202344.32090-3-ludo@gnu.org> (raw)
In-Reply-To: <20220409202344.32090-1-ludo@gnu.org>
* 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
next prev parent 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 ` [bug#54823] [PATCH 2/3] colors: Add 'colorize-full-matches' Ludovic Courtès
2022-04-09 20:23 ` Ludovic Courtès [this message]
2022-04-19 16:09 ` bug#54823: [PATCH 0/3] Highlight keywords in search results 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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220409202344.32090-3-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 external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.