From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:55345) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hg3mg-0001wR-Sv for guix-patches@gnu.org; Wed, 26 Jun 2019 05:00:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hg3me-0008E6-Qi for guix-patches@gnu.org; Wed, 26 Jun 2019 05:00:06 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:48932) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hg3md-0008DH-OP for guix-patches@gnu.org; Wed, 26 Jun 2019 05:00:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hg3md-00006w-Kv for guix-patches@gnu.org; Wed, 26 Jun 2019 05:00:03 -0400 Subject: [bug#36390] [PATCH 2/3] syscalls: Add 'terminal-rows'. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Wed, 26 Jun 2019 10:59:03 +0200 Message-Id: <20190626085904.3560-2-ludo@gnu.org> In-Reply-To: <20190626085904.3560-1-ludo@gnu.org> References: <20190626085904.3560-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 36390@debbugs.gnu.org * guix/build/syscalls.scm (terminal-dimension): New procedure. (terminal-columns): Rewrite in terms of 'terminal-dimension'. (terminal-rows): New procedure. * tests/syscalls.scm ("terminal-rows"): New test. --- guix/build/syscalls.scm | 37 +++++++++++++++++++++++++------------ tests/syscalls.scm | 5 ++++- 2 files changed, 29 insertions(+), 13 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 5c2eb3c14d..eb045cbd1c 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -146,6 +146,7 @@ window-size-y-pixels terminal-window-size terminal-columns + terminal-rows utmpx? utmpx-login-type @@ -1871,23 +1872,17 @@ corresponds to the TIOCGWINSZ ioctl." (list (strerror err)) (list err))))) -(define* (terminal-columns #:optional (port (current-output-port))) - "Return the best approximation of the number of columns of the terminal at -PORT, trying to guess a reasonable value if all else fails. The result is -always a positive integer." - (define (fall-back) - (match (and=> (getenv "COLUMNS") string->number) - (#f 80) - ((? number? columns) - (if (> columns 0) columns 80)))) - +(define (terminal-dimension window-dimension port fall-back) + "Return the terminal dimension defined by WINDOW-DIMENSION, one of +'window-size-columns' or 'window-size-rows' for PORT. If PORT does not +correspond to a terminal, return the value returned by FALL-BACK." (catch 'system-error (lambda () (if (file-port? port) - (match (window-size-columns (terminal-window-size port)) + (match (window-dimension (terminal-window-size port)) ;; Things like Emacs shell-mode return 0, which is unreasonable. (0 (fall-back)) - ((? number? columns) columns)) + ((? number? n) n)) (fall-back))) (lambda args (let ((errno (system-error-errno args))) @@ -1900,6 +1895,24 @@ always a positive integer." (fall-back) (apply throw args)))))) +(define* (terminal-columns #:optional (port (current-output-port))) + "Return the best approximation of the number of columns of the terminal at +PORT, trying to guess a reasonable value if all else fails. The result is +always a positive integer." + (define (fall-back) + (match (and=> (getenv "COLUMNS") string->number) + (#f 80) + ((? number? columns) + (if (> columns 0) columns 80)))) + + (terminal-dimension window-size-columns port fall-back)) + +(define* (terminal-rows #:optional (port (current-output-port))) + "Return the best approximation of the number of rows of the terminal at +PORT, trying to guess a reasonable value if all else fails. The result is +always a positive integer." + (terminal-dimension window-size-rows port (const 25))) + ;;; ;;; utmpx. diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 3e267c9f01..eeb223b950 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2015 David Thompson ;;; ;;; This file is part of GNU Guix. @@ -538,6 +538,9 @@ (> (terminal-columns (open-input-string "Join us now, share the software!")) 0)) +(test-assert "terminal-rows" + (> (terminal-rows) 0)) + (test-assert "utmpx-entries" (match (utmpx-entries) (((? utmpx? entries) ...) -- 2.22.0