From patchwork Mon Apr 27 21:24:55 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 21691 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 163B827BBE4; Mon, 27 Apr 2020 22:26:11 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 9381427BBE1 for ; Mon, 27 Apr 2020 22:26:10 +0100 (BST) Received: from localhost ([::1]:33918 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jTBGT-0006hQ-W1 for patchwork@mira.cbaines.net; Mon, 27 Apr 2020 17:26:10 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:59430) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jTBGN-0006fI-2U for guix-patches@gnu.org; Mon, 27 Apr 2020 17:26:03 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.90_1) (envelope-from ) id 1jTBGM-0007mC-Kh for guix-patches@gnu.org; Mon, 27 Apr 2020 17:26:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:54936) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jTBGM-0007kj-7E for guix-patches@gnu.org; Mon, 27 Apr 2020 17:26:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jTBGM-0000xu-3E for guix-patches@gnu.org; Mon, 27 Apr 2020 17:26:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#40911] =?utf-8?b?4oCYZ3VpeCBzZWFyY2jigJk=?= and $PAGER Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 27 Apr 2020 21:26:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 40911 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 40911@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.15880227023605 (code B ref -1); Mon, 27 Apr 2020 21:26:01 +0000 Received: (at submit) by debbugs.gnu.org; 27 Apr 2020 21:25:02 +0000 Received: from localhost ([127.0.0.1]:38249 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jTBFN-0000w0-AT for submit@debbugs.gnu.org; Mon, 27 Apr 2020 17:25:01 -0400 Received: from lists.gnu.org ([209.51.188.17]:52232) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jTBFL-0000vj-PJ for submit@debbugs.gnu.org; Mon, 27 Apr 2020 17:25:00 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:59320) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jTBFK-0006LR-IA for guix-patches@gnu.org; Mon, 27 Apr 2020 17:24:59 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:44847) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jTBFK-0005jz-9s for guix-patches@gnu.org; Mon, 27 Apr 2020 17:24:58 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=54508 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jTBFJ-0003NG-DI for guix-patches@gnu.org; Mon, 27 Apr 2020 17:24:57 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 9 =?utf-8?q?Flor=C3=A9al?= an 228 de la =?utf-8?q?R?= =?utf-8?q?=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Mon, 27 Apr 2020 23:24:55 +0200 Message-ID: <87wo60vcyg.fsf@inria.fr> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches 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’. 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)