[PATCH 0/3] Highlight keywords in search results

  • Done
  • quality assurance status badge
Details
One participant
  • Ludovic Courtès
Owner
unassigned
Submitted by
Ludovic Courtès
Severity
normal

Debbugs page

Ludovic Courtès wrote 3 years ago
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220409202224.32040-1-ludo@gnu.org
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
Ludovic Courtès wrote 3 years ago
[PATCH 1/3] ui: Highlight important bits in recutils output.
(address . 54823@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220409202344.32090-1-ludo@gnu.org
* 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(-)

Toggle diff (61 lines)
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
Ludovic Courtès wrote 3 years ago
[PATCH 3/3] ui: Highlight package and service search results.
(address . 54823@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220409202344.32090-3-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(-)

Toggle diff (201 lines)
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")))))
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
Ludovic Courtès wrote 3 years ago
[PATCH 2/3] colors: Add 'colorize-full-matches'.
(address . 54823@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20220409202344.32090-2-ludo@gnu.org
* guix/colors.scm (colorize-full-matches): New procedure.
---
guix/colors.scm | 22 ++++++++++++++++++++++
1 file changed, 22 insertions(+)

Toggle diff (42 lines)
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
Ludovic Courtès wrote 3 years ago
Re: bug#54823: [PATCH 0/3] Highlight keywords in search results
(address . 54823-done@debbugs.gnu.org)
87czhdqcku.fsf@gnu.org
Pushed!

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

This issue is archived.

To comment on this conversation send an email to 54823@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 54823
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch
You may also tag this issue. See list of standard tags. For example, to set the confirmed and easy tags
mumi command -t +confirmed -t +easy
Or, remove the moreinfo tag and set the help tag
mumi command -t -moreinfo -t +help