01/10: syscalls: Add fallback case for ‘terminal-string-width’.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit a14dafaa01497f733419b5a738baf5822544ebc4
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Nov 23 15:18:32 2023 +0100

    syscalls: Add fallback case for ‘terminal-string-width’.
    
    This makes ‘terminal-string-width’ synonymous with ‘string-length’ when
    running one a statically-linked Guile, as is the case in some unit
    tests, instead of throwing ENOSYS.
    
    * guix/build/syscalls.scm (terminal-string-width): Use ‘dynamic-func’
    and ‘pointer->procedure’ instead of ‘syscall->procedure’.  Return
    ‘string-length’ when one of the ‘dynamic-func’ calls fails.
    
    Change-Id: Icf55c9e7c34b46fac91b665fb4a2ecb02160f22e
---
 guix/build/syscalls.scm | 26 ++++++++++++++++----------
 1 file changed, 16 insertions(+), 10 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index b29b6f78b6..4afe6d2f87 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -2338,18 +2338,24 @@ 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.
+  (let ((mbstowcs (and=> (false-if-exception
+                          (dynamic-func "mbstowcs" (dynamic-link)))
+                         (cute pointer->procedure int <> (list '* '* size_t))))
+        (wcswidth (and=> (false-if-exception
+                          (dynamic-func "wcswidth" (dynamic-link)))
+                         (cute pointer->procedure int <> (list '* size_t)))))
+    (if (and mbstowcs wcswidth)
+        (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))))))
+          (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))))
+        string-length)))                      ;using a statically-linked Guile
 
 (define openpty
   (let ((proc (syscall->procedure int "openpty" '(* * * * *)