guix: syscalls: Add terminal-string-width.
* guix/build/syscalls.scm (terminal-width): New procedure. * tests/syscalls.scm: Add tests. Change-Id: I6c2caa9fbaffb1e8f4b8933103399be970d5a8f3master
parent
61c527227c
commit
fd11d7fbf8
|
@ -192,6 +192,7 @@
|
||||||
terminal-window-size
|
terminal-window-size
|
||||||
terminal-columns
|
terminal-columns
|
||||||
terminal-rows
|
terminal-rows
|
||||||
|
terminal-string-width
|
||||||
openpty
|
openpty
|
||||||
login-tty
|
login-tty
|
||||||
|
|
||||||
|
@ -2336,6 +2337,20 @@ PORT, trying to guess a reasonable value if all else fails. The result is
|
||||||
always a positive integer."
|
always a positive integer."
|
||||||
(terminal-dimension window-size-rows port (const 25)))
|
(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
|
(define openpty
|
||||||
(let ((proc (syscall->procedure int "openpty" '(* * * * *)
|
(let ((proc (syscall->procedure int "openpty" '(* * * * *)
|
||||||
#:library "libutil")))
|
#:library "libutil")))
|
||||||
|
|
|
@ -583,6 +583,12 @@
|
||||||
(test-assert "terminal-rows"
|
(test-assert "terminal-rows"
|
||||||
(> (terminal-rows) 0))
|
(> (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"
|
(test-assert "openpty"
|
||||||
(let ((head inferior (openpty)))
|
(let ((head inferior (openpty)))
|
||||||
(and (integer? head) (integer? inferior)
|
(and (integer? head) (integer? inferior)
|
||||||
|
|
Reference in New Issue