[bug#55845] [PATCH 1/1] ui: Improve pager selection logic when less is not installed.

[Taiju HIGASHI <higashi@taiju.info>]

[-- Attachment #1: Type: text/plain, Size: 123 bytes --]

Hi,

I have created a v2 patch and have attached it to this email and also
added a unit test for the find-available-pager.

[-- Attachment #2: v2-patch --]
[-- Type: text/x-patch, Size: 4953 bytes --]

From a65818b99ea1b327313fea08cf2db229c55e4b21 Mon Sep 17 00:00:00 2001
From: Taiju HIGASHI <higashi@taiju.info>
Date: Wed, 8 Jun 2022 18:50:28 +0900
Subject: [PATCH v2] ui: Improve pager selection logic when less is not
 installed.

* guix/ui.scm (find-available-pager): New procedure. Return a available pager.
  (call-with-paginated-output-port): Change to use find-available-pager to
  select pager.
* tests/ui.scm: Add tests for find-available-pager.
---
 guix/ui.scm  | 16 ++++++++++++---
 tests/ui.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+), 3 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index cb68a07c6c..93707a7a4b 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -17,6 +17,7 @@
 ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1672,11 +1673,20 @@ (define* (pager-wrapped-port #:optional (port (current-output-port)))
     (_
      #f)))
 
+(define (find-available-pager)
+  "Returns the program name or path of an available pager.
+If neither less nor more is installed, return an empty string so that
+call-with-paginated-output-port will not call pager."
+  (or (getenv "GUIX_PAGER")
+      (getenv "PAGER")
+      (which "less")
+      (which "more")
+      "" ;; Returns an empty string so that call-with-paginated-output-port does not call pager.
+      ))
+
 (define* (call-with-paginated-output-port proc
                                           #:key (less-options "FrX"))
-  (let ((pager-command-line (or (getenv "GUIX_PAGER")
-                                (getenv "PAGER")
-                                "less")))
+  (let ((pager-command-line (find-available-pager)))
     ;; Setting PAGER to the empty string conventionally disables paging.
     (if (and (not (string-null? pager-command-line))
              (isatty?* (current-output-port)))
diff --git a/tests/ui.scm b/tests/ui.scm
index 3dc6952e1f..41de3c63da 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,7 @@ (define-module (test-ui)
   #:use-module (guix derivations)
   #:use-module ((gnu packages) #:select (specification->package))
   #:use-module (guix tests)
+  #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
@@ -292,4 +294,60 @@ (define guile-2.0.9
          (>0 (package-relevance libb2
                                 (map rx '("crypto" "library")))))))
 
+(define make-dummy-file
+  (compose
+   close-port
+   open-output-file
+   (cut string-append <> "/" <>)))
+
+(test-equal "find-available-pager, All environment variables are specified and both less and more are installed"
+  "guix-pager"
+  (call-with-temporary-directory
+   (lambda (dir)
+     (with-environment-variables
+         `(("PATH" ,dir)
+           ("GUIX_PAGER" "guix-pager")
+           ("PAGER" "pager"))
+       (make-dummy-file dir "less")
+       (make-dummy-file dir "more")
+       ((@@ (guix ui) find-available-pager))))))
+
+(test-equal "find-available-pager, GUIX_PAGER is not specified"
+  "pager"
+  (call-with-temporary-directory
+   (lambda (dir)
+     (with-environment-variables
+         `(("PATH" ,dir)
+           ("PAGER" "pager"))
+       (make-dummy-file dir "less")
+       (make-dummy-file dir "more")
+       ((@@ (guix ui) find-available-pager))))))
+
+(test-equal "find-available-pager, All environment variables are not specified and both less and more are installed"
+  "less"
+  (call-with-temporary-directory
+   (lambda (dir)
+     (with-environment-variables
+         `(("PATH" ,dir))
+       (make-dummy-file dir "less")
+       (make-dummy-file dir "more")
+       (basename ((@@ (guix ui) find-available-pager)))))))
+
+(test-equal "find-available-pager, All environment variables are not specified and more is installed"
+  "more"
+  (call-with-temporary-directory
+   (lambda (dir)
+     (with-environment-variables
+         `(("PATH" ,dir))
+       (make-dummy-file dir "more")
+       (basename ((@@ (guix ui) find-available-pager)))))))
+
+(test-equal "find-available-pager, All environment variables are not specified and both less and more are not installed"
+  ""
+  (call-with-temporary-directory
+   (lambda (dir)
+     (with-environment-variables
+         `(("PATH" ,dir))
+       ((@@ (guix ui) find-available-pager))))))
+
 (test-end "ui")
-- 
2.36.1


[-- Attachment #3: Type: text/plain, Size: 42 bytes --]


Please check it out.

Regards,
-- 
Taiju