ui: 'display-search-results' automatically invokes the pager.

* guix/ui.scm (call-with-paginated-output-port): New procedure.
(with-paginated-output-port): New macro.
(display-search-results): Use it instead of displaying a hint.

2 files changed, 35 insertions, 24 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index e34ddc5a85..dc8bc0e437 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -99,6 +99,8 @@
    (eval . (put 'with-environment-variables 'scheme-indent-function 1))
    (eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1))
 
+   (eval . (put 'with-paginated-output-port 'scheme-indent-function 1))
+
    ;; 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..98b30445c8 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -69,6 +69,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 regex)
+  #:autoload   (ice-9 popen) (open-pipe* close-pipe)
   #:autoload   (system base compile) (compile-file)
   #:autoload   (system repl repl)  (start-repl)
   #:autoload   (system repl debug) (make-debug stack->vector)
@@ -1557,6 +1558,27 @@ score, the more relevant OBJ is to REGEXPS."
 zero means that PACKAGE does not match any of REGEXPS."
   (relevance package regexps %package-metrics))
 
+(define (call-with-paginated-output-port proc)
+  (if (isatty?* (current-output-port))
+      ;; Set 'LESS' so that 'less' exits if everything fits on the screen (F),
+      ;; lets ANSI escapes through (r), does not send the termcap
+      ;; initialization string (X).
+      (let ((pager (with-environment-variables `(("LESS"
+                                                  ,(or (getenv "LESS") "FrX")))
+                     (open-pipe* OPEN_WRITE
+                                 (or (getenv "GUIX_PAGER") (getenv "PAGER")
+                                     "less")))))
+        (dynamic-wind
+          (const #t)
+          (lambda () (proc pager))
+          (lambda () (close-pipe pager))))
+      (proc (current-output-port))))
+
+(define-syntax-rule (with-paginated-output-port port exp ...)
+  "Evaluate EXP... with PORT bound to a port that talks to the pager if
+standard output is a tty, or with PORT set to the current output port."
+  (call-with-paginated-output-port (lambda (port) exp ...)))
+
 (define* (display-search-results matches port
                                  #:key
                                  (command "guix search")
@@ -1573,30 +1595,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-paginated-output-port paginated
+    (let loop ((matches matches))
+      (match matches
+        (((package . score) rest ...)
+         (let* ((links? (supports-hyperlinks? port)))
+           (print package paginated
+                  #:hyperlinks? links?
+                  #:extra-fields `((relevance . ,score)))
+           (loop rest)))
+        (()
+         #t)))))
 
 
 (define (string->generations str)