GNU bug report logs - #44663
[PATCH] ui: Launch $PAGER through the shell.

Previous Next

Package: guix-patches;

Reported by: Tobias Geerinckx-Rice <me <at> tobias.gr>

Date: Sun, 15 Nov 2020 18:48:02 UTC

Severity: normal

Tags: patch

Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>

Bug is archived. No further changes may be made.

Full log


View this message in rfc822 format

From: Tobias Geerinckx-Rice <me <at> tobias.gr>
To: 44663 <at> debbugs.gnu.org
Subject: [bug#44663] [PATCH v2] ui: Handle multiword and empty $PAGER values.
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 <db48x <at> db48x.net>.
---
 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 <kyle <at> kyleam.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2019 Chris Marusich <cmmarusich <at> gmail.com>
-;;; Copyright © 2019 Tobias Geerinckx-Rice <me <at> tobias.gr>
+;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me <at> tobias.gr>
 ;;; Copyright © 2019 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;; Copyright © 2020 Arun Isaac <arunisaac <at> systemreboot.net>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
@@ -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





This bug report was last modified 3 years and 286 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.