~ruther/guix-local

fd11d7fbf8e0fcc61ff764dcc0ab737971afc55a — Julien Lepiller 2 years ago 61c5272
guix: syscalls: Add terminal-string-width.

* guix/build/syscalls.scm (terminal-width): New procedure.
* tests/syscalls.scm: Add tests.

Change-Id: I6c2caa9fbaffb1e8f4b8933103399be970d5a8f3
2 files changed, 21 insertions(+), 0 deletions(-)

M guix/build/syscalls.scm
M tests/syscalls.scm
M guix/build/syscalls.scm => guix/build/syscalls.scm +15 -0
@@ 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")))

M tests/syscalls.scm => tests/syscalls.scm +6 -0
@@ 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)