mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
ui: 'display-search-results' automatically invokes the pager.
* guix/ui.scm (call-with-paginated-output-port): New procedure. (with-paginated-output-port): New macro. (display-search-results): Use it instead of displaying a hint.
This commit is contained in:
parent
d67a881966
commit
c39693d760
2 changed files with 35 additions and 24 deletions
|
@ -99,6 +99,8 @@
|
|||
(eval . (put 'with-environment-variables 'scheme-indent-function 1))
|
||||
(eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1))
|
||||
|
||||
(eval . (put 'with-paginated-output-port 'scheme-indent-function 1))
|
||||
|
||||
;; This notably allows '(' in Paredit to not insert a space when the
|
||||
;; preceding symbol is one of these.
|
||||
(eval . (modify-syntax-entry ?~ "'"))
|
||||
|
|
57
guix/ui.scm
57
guix/ui.scm
|
@ -69,6 +69,7 @@ (define-module (guix ui)
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 regex)
|
||||
#:autoload (ice-9 popen) (open-pipe* close-pipe)
|
||||
#:autoload (system base compile) (compile-file)
|
||||
#:autoload (system repl repl) (start-repl)
|
||||
#:autoload (system repl debug) (make-debug stack->vector)
|
||||
|
@ -1557,6 +1558,27 @@ (define (package-relevance package regexps)
|
|||
zero means that PACKAGE does not match any of REGEXPS."
|
||||
(relevance package regexps %package-metrics))
|
||||
|
||||
(define (call-with-paginated-output-port proc)
|
||||
(if (isatty?* (current-output-port))
|
||||
;; Set 'LESS' so that 'less' exits if everything fits on the screen (F),
|
||||
;; lets ANSI escapes through (r), does not send the termcap
|
||||
;; initialization string (X).
|
||||
(let ((pager (with-environment-variables `(("LESS"
|
||||
,(or (getenv "LESS") "FrX")))
|
||||
(open-pipe* OPEN_WRITE
|
||||
(or (getenv "GUIX_PAGER") (getenv "PAGER")
|
||||
"less")))))
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
(lambda () (proc pager))
|
||||
(lambda () (close-pipe pager))))
|
||||
(proc (current-output-port))))
|
||||
|
||||
(define-syntax-rule (with-paginated-output-port port exp ...)
|
||||
"Evaluate EXP... with PORT bound to a port that talks to the pager if
|
||||
standard output is a tty, or with PORT set to the current output port."
|
||||
(call-with-paginated-output-port (lambda (port) exp ...)))
|
||||
|
||||
(define* (display-search-results matches port
|
||||
#:key
|
||||
(command "guix search")
|
||||
|
@ -1573,30 +1595,17 @@ (define max-rows
|
|||
(define (line-count str)
|
||||
(string-count str #\newline))
|
||||
|
||||
(let loop ((matches matches))
|
||||
(match matches
|
||||
(((package . score) rest ...)
|
||||
(let* ((links? (supports-hyperlinks? port))
|
||||
(text (call-with-output-string
|
||||
(lambda (port)
|
||||
(print package port
|
||||
#:hyperlinks? links?
|
||||
#:extra-fields
|
||||
`((relevance . ,score)))))))
|
||||
(if (and (not (getenv "INSIDE_EMACS"))
|
||||
max-rows
|
||||
(> (port-line port) first-line) ;print at least one result
|
||||
(> (+ 4 (line-count text) (port-line port))
|
||||
max-rows))
|
||||
(unless (null? rest)
|
||||
(display-hint (format #f (G_ "Run @code{~a ... | less} \
|
||||
to view all the results.")
|
||||
command)))
|
||||
(begin
|
||||
(display text port)
|
||||
(loop rest)))))
|
||||
(()
|
||||
#t))))
|
||||
(with-paginated-output-port paginated
|
||||
(let loop ((matches matches))
|
||||
(match matches
|
||||
(((package . score) rest ...)
|
||||
(let* ((links? (supports-hyperlinks? port)))
|
||||
(print package paginated
|
||||
#:hyperlinks? links?
|
||||
#:extra-fields `((relevance . ,score)))
|
||||
(loop rest)))
|
||||
(()
|
||||
#t)))))
|
||||
|
||||
|
||||
(define (string->generations str)
|
||||
|
|
Loading…
Reference in a new issue