01/13: processes: Allow 'less' to properly estimate line length.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 9296a2e511311d23dc49c4e4b3cbb9341ea82bb3
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Jul 26 16:45:42 2020 +0200

    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'.
---
 guix/scripts/processes.scm |  5 ++++-
 guix/ui.scm                | 20 +++++++++++++++-----
 2 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm
index 01f7213..35698a0 100644
--- a/guix/scripts/processes.scm
+++ b/guix/scripts/processes.scm
@@ -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"))
diff --git a/guix/ui.scm b/guix/ui.scm
index 420c968..55460ce 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -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