syscalls: Add TIOCGWINSZ bindings.

* guix/build/syscalls.scm (TIOCGWINSZ): New macro.
(<window-size>): New record type.
(winsize): New C struct.
(winsize-struct): New variable.
(terminal-window-size, terminal-columns): New procedures.
This commit is contained in:
Ludovic Courtès 2016-04-14 23:35:03 +02:00
parent 4d276c6403
commit 29ff6d9fcc
2 changed files with 86 additions and 1 deletions

View file

@ -82,7 +82,15 @@ (define-module (guix build syscalls)
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 @@ (define free-ifaddrs
(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

View file

@ -244,4 +244,17 @@ (define perform-container-tests?
(#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)