diff options
| author | Julien Lepiller <julien@lepiller.eu> | 2023-08-26 07:59:09 +0200 |
|---|---|---|
| committer | Julien Lepiller <julien@lepiller.eu> | 2023-11-11 11:07:27 +0100 |
| commit | fd11d7fbf8e0fcc61ff764dcc0ab737971afc55a (patch) | |
| tree | 8644012afee53d31cc109bacff8173ab1857a0e4 | |
| parent | 61c527227ceebdad8da2d52214b253a48323cbb9 (diff) | |
| download | guix-fd11d7fbf8e0fcc61ff764dcc0ab737971afc55a.tar guix-fd11d7fbf8e0fcc61ff764dcc0ab737971afc55a.tar.gz | |
guix: syscalls: Add terminal-string-width.
* guix/build/syscalls.scm (terminal-width): New procedure.
* tests/syscalls.scm: Add tests.
Change-Id: I6c2caa9fbaffb1e8f4b8933103399be970d5a8f3
| -rw-r--r-- | guix/build/syscalls.scm | 15 | ||||
| -rw-r--r-- | tests/syscalls.scm | 6 |
2 files changed, 21 insertions, 0 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index b845b8aab9..b29b6f78b6 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -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"))) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index c9e011f453..eb85b358c4 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -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) |