processes: Allow 'less' to properly estimate line length.

Until now, the first few lines in the output of 'guix processes' could
disappear in 'less'.

* guix/ui.scm (call-with-paginated-output-port): Add #:less-options
parameter and honor it.
(with-paginated-output-port): Allow callers to pass #:less-options.
* guix/scripts/processes.scm (guix-processes): Pass #:less-options to
'with-paginated-output-port'.
This commit is contained in:
Ludovic Courtès 2020-07-26 16:45:42 +02:00
parent 578a1d794b
commit 9296a2e511
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 19 additions and 6 deletions

View File

@ -235,4 +235,7 @@ List the current Guix sessions and their processes."))
(for-each (lambda (session)
(daemon-session->recutils session port)
(newline port))
(daemon-sessions))))
(daemon-sessions))
;; Pass 'R' (instead of 'r') so 'less' correctly estimates line length.
#:less-options "FRX"))

View File

@ -1607,13 +1607,18 @@ 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)
(define* (call-with-paginated-output-port proc
#:key (less-options "FrX"))
(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). Set it unconditionally because some
;; distros set it to something that doesn't work here.
(let ((pager (with-environment-variables `(("LESS" "FrX"))
;;
;; For things that produce long lines, such as 'guix processes', use 'R'
;; instead of 'r': this strips hyperlinks but allows 'less' to make a
;; good estimate of the line length.
(let ((pager (with-environment-variables `(("LESS" ,less-options))
(open-pipe* OPEN_WRITE
(or (getenv "GUIX_PAGER") (getenv "PAGER")
"less")))))
@ -1623,10 +1628,15 @@ zero means that PACKAGE does not match any of REGEXPS."
(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
(define-syntax with-paginated-output-port
(syntax-rules ()
"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 ...)))
((_ port exp ... #:less-options opts)
(call-with-paginated-output-port (lambda (port) exp ...)
#:less-options opts))
((_ port exp ...)
(call-with-paginated-output-port (lambda (port) exp ...)))))
(define* (display-search-results matches port
#:key