diff options
| -rw-r--r-- | guix/build/syscalls.scm | 74 | ||||
| -rw-r--r-- | tests/syscalls.scm | 13 |
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) |