summaryrefslogtreecommitdiff
path: root/guix/build/syscalls.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-04-14 23:35:03 +0200
committerLudovic Courtès <ludo@gnu.org>2016-04-15 00:32:18 +0200
commit29ff6d9fcc05b283b6d797146330e950286028ed (patch)
tree66789441730e6b22149c953b254e7e753cee70a2 /guix/build/syscalls.scm
parent4d276c640374c9981dad2681f98af8c8d133939a (diff)
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.
Diffstat (limited to 'guix/build/syscalls.scm')
-rw-r--r--guix/build/syscalls.scm74
1 files changed, 73 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