aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/build/syscalls.scm74
-rw-r--r--tests/syscalls.scm13
2 files changed, 86 insertions, 1 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 69a507def8..ed833c10b2 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -82,7 +82,15 @@
interface-address
interface-netmask
interface-broadcast-address
- network-interfaces))
+ network-interfaces
+
+ window-size?
+ window-size-rows
+ window-size-columns
+ window-size-x-pixels
+ window-size-y-pixels
+ terminal-window-size
+ terminal-columns))
;;; Commentary:
;;;
@@ -853,4 +861,68 @@ network interface. This is implemented using the 'getifaddrs' libc function."
(let ((ptr (dynamic-func "freeifaddrs" (dynamic-link))))
(pointer->procedure void ptr '(*))))
+
+;;;
+;;; Terminals.
+;;;
+
+(define-syntax TIOCGWINSZ ;<asm-generic/ioctls.h>
+ (identifier-syntax #x5413))
+
+(define-record-type <window-size>
+ (window-size rows columns x-pixels y-pixels)
+ window-size?
+ (rows window-size-rows)
+ (columns window-size-columns)
+ (x-pixels window-size-x-pixels)
+ (y-pixels window-size-y-pixels))
+
+(define-c-struct winsize ;<bits/ioctl-types.h>
+ window-size
+ read-winsize
+ write-winsize!
+ (rows unsigned-short)
+ (columns unsigned-short)
+ (x-pixels unsigned-short)
+ (y-pixels unsigned-short))
+
+(define winsize-struct
+ (list unsigned-short unsigned-short unsigned-short unsigned-short))
+
+(define* (terminal-window-size #:optional (port (current-output-port)))
+ "Return a <window-size> structure describing the terminal at PORT, or raise
+a 'system-error' if PORT is not backed by a terminal. This procedure
+corresponds to the TIOCGWINSZ ioctl."
+ (let* ((size (make-c-struct winsize-struct '(0 0 0 0)))
+ (ret (%ioctl (fileno port) TIOCGWINSZ size))
+ (err (errno)))
+ (if (zero? ret)
+ (read-winsize (pointer->bytevector size (sizeof winsize-struct))
+ 0)
+ (throw 'system-error "terminal-window-size" "~A"
+ (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))))
+
+ (catch 'system-error
+ (lambda ()
+ (match (window-size-columns (terminal-window-size port))
+ ;; Things like Emacs shell-mode return 0, which is unreasonable.
+ (0 (fall-back))
+ ((? number? columns) columns)))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (if (= errno ENOTTY)
+ (fall-back)
+ (apply throw args))))))
+
;;; syscalls.scm ends here
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 8e24184fe2..1b443be0c8 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -244,4 +244,17 @@
(#f #f)
(lo (interface-address lo)))))))
+(test-equal "terminal-window-size ENOTTY"
+ ENOTTY
+ (call-with-input-file "/dev/null"
+ (lambda (port)
+ (catch 'system-error
+ (lambda ()
+ (terminal-window-size port))
+ (lambda args
+ (system-error-errno args))))))
+
+(test-assert "terminal-columns"
+ (> (terminal-columns) 0))
+
(test-end)