01/02: guix: syscalls: Add terminal-string-width.

[guix-commits]

roptat pushed a commit to branch master
in repository guix.

commit fd11d7fbf8e0fcc61ff764dcc0ab737971afc55a
Author: Julien Lepiller <julien@lepiller.eu>
AuthorDate: Sat Aug 26 07:59:09 2023 +0200

    guix: syscalls: Add terminal-string-width.
    
    * guix/build/syscalls.scm (terminal-width): New procedure.
    * tests/syscalls.scm: Add tests.
    
    Change-Id: I6c2caa9fbaffb1e8f4b8933103399be970d5a8f3
---
 guix/build/syscalls.scm | 15 +++++++++++++++
 tests/syscalls.scm      |  6 ++++++
 2 files changed, 21 insertions(+)

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)