me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2022-04-09 20:26:45 +02:00
parent d08e4d52a3
commit 5e0c347975
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 60 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
guix/scripts/home.scm
View File

@ -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")))))

3
guix/scripts/package.scm
View File

@ -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 _)

30
guix/scripts/system/search.scm
View File

@ -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)

57
guix/ui.scm
View File

@ -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)))))