GNU bug report logs - #40911
‘guix search’ and $PAGER

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 40911 in the body.
You can then email your comments to 40911 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Subject: ‘guix search’ and $PAGER
Date: Mon, 27 Apr 2020 23:24:55 +0200

[Message part 1 (text/plain, inline)]

Hello Guix!

There seems to be consensus on getting ‘guix search’ to automatically
invoke $PAGER (I don’t think there’s a bug report, though).

Below is a first stab at it that’s (almost) functional but raises
questions:

  1. This patch arranges to invoke the pager only if we output a
     screenful of text.  However, that means that the
     ‘supports-hyperlinks?’ call is passed the wrong port, typically the
     actual stdout (a terminal) instead of the pager.  Pagers typically
     don’t support hyperlinks, it seems.

     Is there another way to do that?  Should we just invoke the pager
     unconditionally?

  2. What if ‘less’ or $PAGER doesn’t exists or exits with non-zero?
     What do others do?

Feedback & alternative patches more than welcome!

Ludo’.

[Message part 2 (text/x-patch, inline)]

diff --git a/.dir-locals.el b/.dir-locals.el
index ce305602f2..2f5d31f632 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -96,6 +96,8 @@
    (eval . (put 'call-with-progress-reporter 'scheme-indent-function 1))
    (eval . (put 'with-temporary-git-repository 'scheme-indent-function 2))
 
+   (eval . (put 'with-paged-output-port 'scheme-indent-function 2))
+
    ;; This notably allows '(' in Paredit to not insert a space when the
    ;; preceding symbol is one of these.
    (eval . (modify-syntax-entry ?~ "'"))
diff --git a/guix/ui.scm b/guix/ui.scm
index ea5f460865..45c8923c99 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -69,6 +69,11 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 regex)
+  #:autoload   (ice-9 popen) (open-pipe* close-pipe)
+  #:use-module ((ice-9 binary-ports)
+                #:select (make-custom-binary-output-port
+                          put-bytevector))
+  #:use-module (rnrs bytevectors)
   #:autoload   (system base compile) (compile-file)
   #:autoload   (system repl repl)  (start-repl)
   #:autoload   (system repl debug) (make-debug stack->vector)
@@ -1557,6 +1562,77 @@ score, the more relevant OBJ is to REGEXPS."
 zero means that PACKAGE does not match any of REGEXPS."
   (relevance package regexps %package-metrics))
 
+(define (paged-output-port port)
+  (define max-rows
+    (and (isatty?* port) (terminal-rows port)))
+
+  (define lines 1)
+  (define pipe #f)
+  (define buffer '())
+  (define pager (or (getenv "PAGER") "less"))
+
+  (define (newline-count bv start count)
+    (define end (+ start count))
+    (let loop ((index start)
+               (newlines 0))
+      (if (< index end)
+          (loop (+ 1 index)
+                (match (bytevector-u8-ref bv index)
+                  (10 (+ newlines 1))
+                  (_  newlines)))
+          newlines)))
+
+  (define (flush)
+    (for-each (cut put-bytevector port <>) (reverse buffer))
+    (set! buffer '()))
+
+  (define (write! bv start count)
+    (cond (pipe
+           ;; Pager is running, write BV to it.
+           (if (zero? count)                      ;EOF
+               (begin
+                 (close-pipe pipe)
+                 (set! pipe #f)
+                 0)
+               (begin
+                 (put-bytevector pipe bv start count)
+                 count)))
+          ((zero? count)                          ;EOF, no pager
+           (flush)
+           0)
+          ((<= lines max-rows)
+           ;; We're below the threshold, so buffer BV.
+           (set! lines (+ lines (newline-count bv start count)))
+           (set! buffer
+             (let ((copy (make-bytevector count)))
+               (bytevector-copy! bv start copy 0 count)
+               (cons copy buffer)))
+           count)
+          (else
+           ;; We've reached the threshold: spawn a pager and write to it.
+           (set! pipe (open-pipe* OPEN_WRITE pager))
+           (flush)
+           (setvbuf pipe 'none)
+           (write! bv start count))))
+
+  (if max-rows
+      (let ((proxy (make-custom-binary-output-port "paged-output-port"
+                                                   write! #f #f flush)))
+        (set-port-encoding! proxy (port-encoding port))
+        proxy)
+      port))
+
+(define (call-with-paged-output-port port proc)
+  (let* ((paged (paged-output-port port))
+         (close (if (eq? paged port) (const #t) close-port)))
+    (dynamic-wind
+      (const #t)
+      (lambda () (proc paged))
+      (lambda () (close paged)))))
+
+(define-syntax-rule (with-paged-output-port proxied port exp ...)
+  (call-with-paged-output-port proxied (lambda (port) exp ...)))
+
 (define* (display-search-results matches port
                                  #:key
                                  (command "guix search")
@@ -1573,30 +1649,17 @@ them.  If PORT is a terminal, print at most a full screen of results."
   (define (line-count str)
     (string-count str #\newline))
 
-  (let loop ((matches matches))
-    (match matches
-      (((package . score) rest ...)
-       (let* ((links? (supports-hyperlinks? port))
-              (text   (call-with-output-string
-                        (lambda (port)
-                          (print package port
-                                 #:hyperlinks? links?
-                                 #:extra-fields
-                                 `((relevance . ,score)))))))
-         (if (and (not (getenv "INSIDE_EMACS"))
-                  max-rows
-                  (> (port-line port) first-line) ;print at least one result
-                  (> (+ 4 (line-count text) (port-line port))
-                     max-rows))
-             (unless (null? rest)
-               (display-hint (format #f (G_ "Run @code{~a ... | less} \
-to view all the results.")
-                                     command)))
-             (begin
-               (display text port)
-               (loop rest)))))
-      (()
-       #t))))
+  (with-paged-output-port port paged
+    (let loop ((matches matches))
+      (match matches
+        (((package . score) rest ...)
+         (let* ((links? (supports-hyperlinks? port)))
+           (print package paged
+                  #:hyperlinks? links?
+                  #:extra-fields `((relevance . ,score)))
+           (loop rest)))
+        (()
+         #t)))))
 
 
 (define (string->generations str)

Message #10 received at 40911-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 40911-done <at> debbugs.gnu.org
Subject: Re: [bug#40911] ‘guix search’ and $PAGER
Date: Sat, 06 Jun 2020 23:39:59 +0200

Ludovic Courtès <ludo <at> gnu.org> skribis:

> There seems to be consensus on getting ‘guix search’ to automatically
> invoke $PAGER (I don’t think there’s a bug report, though).

I ended up pushing a much simpler version, having learned about all the
options of ‘less’:

  https://git.savannah.gnu.org/cgit/guix.git/commit/?id=c39693d76099c159df856ffb5b2c43765fd6f2dd

Enjoy the pager!  :-)

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.