diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-06-25 23:05:00 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-06-27 11:14:40 +0200 |
commit | 4593f5a654b4e59c5025cc4f99914e24e82515a4 (patch) | |
tree | 58e5584c28d45650c99cd60a015c339d7e53b6d3 | |
parent | 8874faaaac665100a095ef25e39c9a389f5a397f (diff) | |
download | guix-4593f5a654b4e59c5025cc4f99914e24e82515a4.tar.gz |
syscalls: Add 'terminal-rows'.
* 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.
-rw-r--r-- | guix/build/syscalls.scm | 37 | ||||
-rw-r--r-- | 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 <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; ;;; 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) ...) |