futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: Handle multiword and empty $PAGER values.

Browse Source 
* guix/ui.scm (call-with-paginated-output-port): Empty PAGER values
disable paging.  Non-empty ones are split into command arguments.

Reported by Daniel Brooks <db48x@db48x.net>.
This commit is contained in:
Tobias Geerinckx-Rice 2020-11-15 19:25:00 +01:00
parent 4d0b61a1f6
commit a81258c124
No known key found for this signature in database
GPG Key ID: 0DB0FF884F556D79
1 changed files with 28 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
guix/ui.scm
View File

@ -12,7 +12,7 @@
;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@ -1664,24 +1664,33 @@ zero means that PACKAGE does not match any of REGEXPS."
(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.
;;
;; 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")))))
(dynamic-wind
(const #t)
(lambda () (proc pager))
(lambda () (close-pipe pager))))
(proc (current-output-port))))
(let ((pager-command-line (or (getenv "GUIX_PAGER")
(getenv "PAGER")
"less")))
;; Setting PAGER to the empty string conventionally disables paging.
(if (and (not (string-null? pager-command-line))
(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.
;;
;; 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))
(apply open-pipe* OPEN_WRITE
;; Split into arguments. Treat runs of multiple
;; whitespace characters as one. libpipeline-
;; style "cmd one\ arg" escaping is unsupported.
(remove (lambda (s) (string-null? s))
(string-split pager-command-line
char-set:whitespace))))))
(dynamic-wind
(const #t)
(lambda () (proc pager))
(lambda () (close-pipe pager))))
(proc (current-output-port)))))
(define-syntax with-paginated-output-port
(syntax-rules ()