diff options
| -rw-r--r-- | .dir-locals.el | 2 | ||||
| -rw-r--r-- | guix/ui.scm | 57 |
2 files changed, 35 insertions, 24 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index e34ddc5a85..dc8bc0e437 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -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 ?~ "'")) diff --git a/guix/ui.scm b/guix/ui.scm index ea5f460865..98b30445c8 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -69,6 +69,7 @@ #: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 @@ score, the more relevant OBJ is to 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 @@ them. If PORT is a terminal, print at most a full screen of results." (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) |