From: Taiju HIGASHI <higashi@taiju.info>
To: Maxime Devos <maximedevos@telenet.be>
Cc: 55845@debbugs.gnu.org, me@tobias.gr
Subject: [bug#55845] [PATCH 1/1] ui: Improve pager selection logic when less is not installed.
Date: Fri, 10 Jun 2022 09:39:24 +0900 [thread overview]
Message-ID: <87a6alwdvn.fsf@taiju.info> (raw)
In-Reply-To: <5ccb68a4dc80a02baaf6d19fd782145b6b62e7b5.camel@telenet.be> (Maxime Devos's message of "Thu, 09 Jun 2022 21:43:11 +0200")
[-- Attachment #1: Type: text/plain, Size: 1674 bytes --]
Maxime Devos <maximedevos@telenet.be> writes:
> Taiju HIGASHI schreef op do 09-06-2022 om 19:23 [+0900]:
>> Hi Maxime,
>>
>> I tried to mock open-pipe* and isatty?* using the mock macro and also
>> add a test to inspect the program coming across to open-pipe*, but gave
>> up because I could not get the return value of the
>> with-paginated-output-port macro.
>
> The return value of 'with-paginated-output-port' is just whatever the
> last expression put in that macro evaluates to. Also 'close-pipe'
> needs to be mocked, otherwise an error will result.
>
> Try:
>
> (test-assert "with-paginated-output-port: finds less in PATH"
> (call-with-temporary-directory
> (lambda (dir)
> (define used-command #false)
> (with-environment-variables
> `(("PATH" ,dir))
> (make-dummy-executable-file dir "less")
> (mock ((ice-9 popen) open-pipe*
> (lambda (mode command . args)
> (when used-command ; <--- an extra test
> (error "open-pipe* should only be called once"))
> (set! used-command command) ; <--- this captures the passed command
> (%make-void-port ""))) ; return a dummy port
> (mock ((ice-9 popen) close-pipe (const 'ok))
> (mock ((guix colors) isatty?* (const #t))
> (with-paginated-output-port port 'ok)))))
> (and (pk 'used-command used-command dir) ; <-- fails on my computer because a non-absolute path is passed and I haven't applied our patch
> (string=? (in-vicinity dir "less") used-command)))))
Thank you very much! It worked as expected!
I made a v3 patch.
[-- Attachment #2: v3 patch --]
[-- Type: text/x-patch, Size: 6770 bytes --]
From b499be5cf73916005150ddf777ae705070f077d1 Mon Sep 17 00:00:00 2001
From: Taiju HIGASHI <higashi@taiju.info>
Date: Wed, 8 Jun 2022 18:50:28 +0900
Subject: [PATCH v3] 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 | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 109 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..ca01d8f03d 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,98 @@ (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 <> <>)))
+
+(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")
+ (string=? ((@@ (guix ui) 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)
+ ("PAGER" "pager"))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ (string=? ((@@ (guix ui) 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))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ (string=? ((@@ (guix ui) 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))
+ (make-dummy-file dir "more")
+ (string=? ((@@ (guix ui) 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))
+ (string=? ((@@ (guix ui) find-available-pager)) "")))))
+
+
+(test-assert "with-paginated-output-port: finds a pager in enviroment variables"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (define used-command #false)
+ (with-environment-variables
+ `(("PATH" ,dir)
+ ("GUIX_PAGER" "guix-pager")
+ ("PAGER" "pager"))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ (mock ((ice-9 popen) open-pipe*
+ (lambda (mode command . args)
+ (when 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=? "guix-pager" used-command))))
+
+(test-assert "with-paginated-output-port: finds less in PATH"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (define used-command #false)
+ (with-environment-variables
+ `(("PATH" ,dir))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ (mock ((ice-9 popen) open-pipe*
+ (lambda (mode command . args)
+ (when 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=? (in-vicinity dir "less") used-command))))
+
(test-end "ui")
--
2.36.1
[-- Attachment #3: Type: text/plain, Size: 266 bytes --]
Two tests have been added: one to select pager from the environment
variable and the other to select less from the PATH.
I also made some improvements to the existing tests based on your
answers.
There are many ways to do this. I learned a lot.
Thanks,
--
Taiju
next prev parent reply other threads:[~2022-06-10 0:40 UTC|newest]
Thread overview: 29+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-06-08 10:21 [bug#55845] [PATCH 0/1] Improve pager selection logic when less is not installed Taiju HIGASHI
2022-06-08 10:22 ` [bug#55845] [PATCH 1/1] ui: " Taiju HIGASHI
2022-06-08 13:18 ` Maxime Devos
[not found] ` <87leu72sbo.fsf@taiju.info>
2022-06-08 15:08 ` Maxime Devos
2022-06-08 15:17 ` Taiju HIGASHI
2022-06-08 16:46 ` Maxime Devos
2022-06-09 9:52 ` Taiju HIGASHI
2022-06-09 10:23 ` Taiju HIGASHI
2022-06-09 19:43 ` Maxime Devos
2022-06-10 0:39 ` Taiju HIGASHI [this message]
2022-06-10 7:47 ` Maxime Devos
2022-06-10 8:40 ` Taiju HIGASHI
2022-06-10 15:08 ` Maxime Devos
2022-06-11 11:26 ` Taiju HIGASHI
2022-06-14 23:58 ` Taiju HIGASHI
2022-06-15 8:02 ` Maxime Devos
2022-06-16 21:43 ` [bug#55845] [PATCH 0/1] " Ludovic Courtès
2022-06-17 0:38 ` Taiju HIGASHI
2022-06-17 12:39 ` Ludovic Courtès
2022-06-17 13:36 ` Taiju HIGASHI
2022-06-17 15:12 ` Ludovic Courtès
2022-06-18 14:11 ` Taiju HIGASHI
2022-06-10 0:55 ` [bug#55845] [PATCH 1/1] ui: " Taiju HIGASHI
2022-06-10 7:37 ` Maxime Devos
2022-06-10 8:52 ` Taiju HIGASHI
2022-06-08 12:14 ` [bug#55845] [PATCH 0/1] " Tobias Geerinckx-Rice via Guix-patches via
2022-06-08 13:12 ` Taiju HIGASHI
2022-06-08 14:22 ` Tobias Geerinckx-Rice via Guix-patches via
2022-06-08 15:09 ` Taiju HIGASHI
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87a6alwdvn.fsf@taiju.info \
--to=higashi@taiju.info \
--cc=55845@debbugs.gnu.org \
--cc=maximedevos@telenet.be \
--cc=me@tobias.gr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).