ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-23 02:59:17 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: syscalls: Add terminal-string-width.

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

15
guix/build/syscalls.scm
View file

@ -192,6 +192,7 @@ (define-module (guix build syscalls)
terminal-window-size
terminal-columns
terminal-rows
terminal-string-width
openpty
login-tty
@ -2336,6 +2337,20 @@ (define* (terminal-rows #:optional (port (current-output-port)))
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")))

6
tests/syscalls.scm
View file

@ -583,6 +583,12 @@ (define perform-container-tests?
(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)