guix: syscalls: Add terminal-string-width.

* guix/build/syscalls.scm (terminal-width): New procedure.
* tests/syscalls.scm: Add tests.

Change-Id: I6c2caa9fbaffb1e8f4b8933103399be970d5a8f3
This commit is contained in:
Julien Lepiller 2023-08-26 07:59:09 +02:00
parent 61c527227c
commit fd11d7fbf8
No known key found for this signature in database
GPG Key ID: 53D457B2D636EE82
2 changed files with 21 additions and 0 deletions

View File

@ -192,6 +192,7 @@
terminal-window-size
terminal-columns
terminal-rows
terminal-string-width
openpty
login-tty
@ -2336,6 +2337,20 @@ 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)))
(define terminal-string-width
(let ((mbstowcs (syscall->procedure int "mbstowcs" (list '* '* size_t)))
(wcswidth (syscall->procedure int "wcswidth" (list '* size_t))))
(lambda (str)
"Return the width of a string as it would be printed on the terminal.
This procedure accounts for characters that have a different width than 1, such
as CJK double-width characters."
(let ((wchar (make-bytevector (* (+ (string-length str) 1) 4))))
(mbstowcs (bytevector->pointer wchar)
(string->pointer str)
(string-length str))
(wcswidth (bytevector->pointer wchar)
(string-length str))))))
(define openpty
(let ((proc (syscall->procedure int "openpty" '(* * * * *)
#:library "libutil")))

View File

@ -583,6 +583,12 @@
(test-assert "terminal-rows"
(> (terminal-rows) 0))
(test-assert "terminal-string-width English"
(= (terminal-string-width "hello") 5))
(test-assert "terminal-string-width Japanese"
(= (terminal-string-width "今日は") 6))
(test-assert "openpty"
(let ((head inferior (openpty)))
(and (integer? head) (integer? inferior)