From bf557600c549e22a06ccfb288b89b1a0736b0500 Mon Sep 17 00:00:00 2001
From: Taiju HIGASHI <higashi@taiju.info>
Date: Wed, 8 Jun 2022 18:50:28 +0900
Subject: [PATCH v4] 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.
* guix/utils.scm (call-with-environment-variables): Allow clearing of
specified environment variables.
* tests/ui.scm: Add tests for find-available-pager.
---
guix/ui.scm | 16 +++++++++--
guix/utils.scm | 3 ++
tests/ui.scm | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 90 insertions(+), 3 deletions(-)
@@ -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)))
@@ -13,6 +13,7 @@
;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -158,6 +159,8 @@ (define (call-with-environment-variables variables thunk)
(dynamic-wind
(lambda ()
(for-each (match-lambda
+ ((variable #false)
+ (unsetenv variable))
((variable value)
(setenv variable value)))
variables))
@@ -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,76 @@ (define guile-2.0.9
(>0 (package-relevance libb2
(map rx '("crypto" "library")))))))
+(define make-dummy-file
+ (compose
+ close-port
+ open-output-file
+ (cut in-vicinity <> <>)))
+
+(define (assert-equals-find-available-pager expected)
+ (define used-command "")
+ (mock ((ice-9 popen) open-pipe*
+ (lambda (mode command . args)
+ (unless (string-null? used-command)
+ (error "open-pipe* should only be called once"))
+ (set! used-command command)
+ (%make-void-port "")))
+ (mock ((ice-9 popen) close-pipe (const 'ok))
+ (mock ((guix colors) isatty?* (const #t))
+ (with-paginated-output-port port 'ok)
+ (string=? expected used-command)))))
+
+
+(test-assert "find-available-pager, All environment variables are specified and both less and more are installed"
+ (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")
+ (assert-equals-find-available-pager "guix-pager")))))
+
+(test-assert "find-available-pager, GUIX_PAGER is not specified"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables
+ `(("PATH" ,dir)
+ ("GUIX_PAGER" #false)
+ ("PAGER" "pager"))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ (assert-equals-find-available-pager "pager")))))
+
+(test-assert "find-available-pager, All environment variables are not specified and both less and more are installed"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables
+ `(("PATH" ,dir)
+ ("GUIX_PAGER" #false)
+ ("PAGER" #false))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ (assert-equals-find-available-pager (in-vicinity dir "less"))))))
+
+(test-assert "find-available-pager, All environment variables are not specified and more is installed"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables
+ `(("PATH" ,dir)
+ ("GUIX_PAGER" #false)
+ ("PAGER" #false))
+ (make-dummy-file dir "more")
+ (assert-equals-find-available-pager (in-vicinity dir "more"))))))
+
+(test-assert "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_PAGER" #false)
+ ("PAGER" #false))
+ (assert-equals-find-available-pager "")))))
+
(test-end "ui")
--
2.36.1