Subject: [PATCH v2] ui: Handle multiword and empty $PAGER values.

From: Tobias Geerinckx-Rice <[email-masked]>
Date: Sun, 29 Nov 2020 17:43:28 +0100

* 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 <[email-masked]>.
---
 guix/ui.scm | 47 ++++++++++++++++++++++++++++-------------------
 1 file changed, 28 insertions(+), 19 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index a59be74ecd..37099eac7b 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -12,7 +12,7 @@
 ;;; Copyright © 2018 Kyle Meyer <[email-masked]>
 ;;; Copyright © 2018 Ricardo Wurmus <[email-masked]>
 ;;; Copyright © 2019 Chris Marusich <[email-masked]>
-;;; Copyright © 2019 Tobias Geerinckx-Rice <[email-masked]>
+;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <[email-masked]>
 ;;; Copyright © 2019 Simon Tournier <[email-masked]>
 ;;; Copyright © 2020 Arun Isaac <[email-masked]>
 ;;; Copyright © 2020 Maxim Cournoyer <[email-masked]>
@@ -1675,24 +1675,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 ""
+                                       (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 ()
-- 
2.29.2