me
/
guix
Archived
1
0
Fork 0
Code

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
master
Ludovic Courtès 2023-11-23 15:18:32 +01:00
parent 1566e00fbc
commit a14dafaa01
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
guix/build/syscalls.scm
View File

@ -2338,18 +2338,24 @@ always a positive integer."
(terminal-dimension window-size-rows port (const 25))) (terminal-dimension window-size-rows port (const 25)))
(define terminal-string-width (define terminal-string-width
(let ((mbstowcs (syscall->procedure int "mbstowcs" (list '* '* size_t))) (let ((mbstowcs (and=> (false-if-exception
(wcswidth (syscall->procedure int "wcswidth" (list '* size_t)))) (dynamic-func "mbstowcs" (dynamic-link)))
(lambda (str) (cute pointer->procedure int <> (list '* '* size_t))))
"Return the width of a string as it would be printed on the terminal. (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 This procedure accounts for characters that have a different width than 1, such
as CJK double-width characters." as CJK double-width characters."
(let ((wchar (make-bytevector (* (+ (string-length str) 1) 4)))) (let ((wchar (make-bytevector (* (+ (string-length str) 1) 4))))
(mbstowcs (bytevector->pointer wchar) (mbstowcs (bytevector->pointer wchar)
(string->pointer str) (string->pointer str)
(string-length str)) (string-length str))
(wcswidth (bytevector->pointer wchar) (wcswidth (bytevector->pointer wchar)
(string-length str)))))) (string-length str))))
string-length))) ;using a statically-linked Guile
(define openpty (define openpty
(let ((proc (syscall->procedure int "openpty" '(* * * * *) (let ((proc (syscall->procedure int "openpty" '(* * * * *)