all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
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: Sat, 11 Jun 2022 20:26:12 +0900	[thread overview]
Message-ID: <87bkuzsap7.fsf@taiju.info> (raw)
In-Reply-To: <8250aad90dcf563aba4103127df95084a25fbd5d.camel@telenet.be> (Maxime Devos's message of "Fri, 10 Jun 2022 17:08:57 +0200")

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

Hi Maxime,

>> Sorry, I easily used with-environment-variable*s* because the interface
>> looked convenient, but perhaps I should have used
>> with-environment-variable defined in guix/tests.scm.
>> However, using this one does not seem to solve the problem. Should I
>> modify with-environment-variable*s*?
>
> I didn't know about 'with-environment-variable' (it already does the
> unsetenv!). Just use whatever works (a nested with-environment-variable
> or a modified with-environment-variables), though FWIW I would expect
> using the modified with-environment-variables to result in more compact
> code.

I have attached the v4 patch.

[-- Attachment #2: v4 patch --]
[-- Type: text/x-patch, Size: 6680 bytes --]

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

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/guix/utils.scm b/guix/utils.scm
index 37b2e29800..5c36b15cfe 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -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))
diff --git a/tests/ui.scm b/tests/ui.scm
index 3dc6952e1f..ff83e66a7e 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,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


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

I decided to fix with-environment-variables.

Also, the problem of find-available-pager tests being tests for
unexported functions has been changed to tests that use the exported
with-paginated-output-port to verify that the command is passed to
open-pipe* as expected.

Regards,
-- 
Taiju

  reply	other threads:[~2022-06-11 11:48 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
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 [this message]
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

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87bkuzsap7.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 external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.