diff mbox series

[bug#44663,v2] ui: Handle multiword and empty $PAGER values.

Message ID 20201129164328.18776-1-me@tobias.gr
State Accepted
Headers show
Series [bug#44663,v2] ui: Handle multiword and empty $PAGER values. | expand

Checks

Context Check Description
cbaines/submitting builds success
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Tobias Geerinckx-Rice Nov. 29, 2020, 4:43 p.m. UTC 
* 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>.
---
 guix/ui.scm | 47 ++++++++++++++++++++++++++++-------------------
 1 file changed, 28 insertions(+), 19 deletions(-)

Comments

Tobias Geerinckx-Rice Nov. 29, 2020, 4:56 p.m. UTC | #1 
...it's also missing a

  #:use-module ((rnrs lists) #:select (remove))

that got dropped on the floor.

This module already imports SRFI-1, so that's some bonus ick for 
you.

Kind regards,

T G-R
Maxim Cournoyer Aug. 3, 2021, 8:02 p.m. UTC | #2 
Hey,

Tobias Geerinckx-Rice <me@tobias.gr> writes:

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

I see this got pushed with a81258c12415b9cee52c951b8b53cbe46f27654f
about a year ago.

Closing!

Maxim
diff mbox series

Patch

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@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>
@@ -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 ()