solarpunk-guile/guile-uniseg
3
0
Fork 0
Code Issues Pull requests Releases 2 Activity

Reorganize, fix a bug with string shared

Browse source
This commit is contained in:
Vivianne 2024-03-02 13:59:31 -05:00
parent 470b20a74c
commit 5b440bbb64
3 changed files with 24 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
hall.scm
View file

@ -22,10 +22,14 @@
((directory ((directory
"runewidth" "runewidth"
((scheme-file "emoji") ((scheme-file "emoji")
(directory "eastasian"
((scheme-file "locale")))
(scheme-file "eastasian") (scheme-file "eastasian")
(scheme-file "internal"))) (scheme-file "internal")))
(scheme-file "runewidth"))) (scheme-file "runewidth")))
(tests ((directory "tests" ((scheme-file "test-posix"))))) (tests ((directory
"tests"
((scheme-file "test-eastasian-locale")))))
(programs (programs
((directory ((directory
"scripts" "scripts"
@ -40,5 +44,4 @@
(infrastructure (infrastructure
((scheme-file "guix") ((scheme-file "guix")
(text-file ".gitignore") (text-file ".gitignore")
(scheme-file "hall") (scheme-file "hall")))))
(directory "tests" ((scheme-file "test-posix")))))))

14
runewidth/posix.scm → runewidth/eastasian/locale.scm
View file

@ -1,6 +1,6 @@
(define-module (runewidth posix) (define-module (runewidth eastasian locale)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:export (east-asian?)) #:export (eastasian-locale?))
(define wide-locales (define wide-locales
(list (list
@ -36,7 +36,7 @@
(getenv "LANG") (getenv "LANG")
"")) ""))
(define* (east-asian? #:optional (locale (get-env-locale))) (define* (eastasian-locale? #:optional (locale (get-env-locale)))
"Check if a given locale (or the currently installed locale from the environment) is considered an east asian locale" "Check if a given locale (or the currently installed locale from the environment) is considered an east asian locale"
(unless (string? locale) (unless (string? locale)
(error "`locale' must be a string")) (error "`locale' must be a string"))
@ -52,13 +52,19 @@
(match:substring locale-match 2))) (match:substring locale-match 2)))
locale))) locale)))
(pk locale)
(pk charset)
(and (and
(not (regexp-exec c-or-posix-regexp locale)) (not (regexp-exec c-or-posix-regexp locale))
(not (string-suffix? "@cjk_narrow" charset)) (not (string-suffix? "@cjk_narrow" charset))
(let ((index-@ (string-index charset #\@))) (let ((index-@ (string-index charset #\@)))
;; strip @foo from the end of the charset ;; strip @foo from the end of the charset
(when index-@ (when index-@
(set! charset (substring/shared charset 0 index-@))) (set! charset (substring charset 0 index-@)))
(pk charset)
(pk locale)
(and (member charset wide-locales) (and (member charset wide-locales)
(or (or

13
tests/test-posix.scm → tests/test-eastasian-locale.scm
View file

@ -1,11 +1,14 @@
(define-module (tests test-posix) (define-module (tests test-eastasian-locale)
#:use-module (runewidth posix) #:use-module (runewidth eastasian locale)
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
(test-begin "test-posix") (test-begin "test-eastasian-locale")
(define (test-east expected charset) (define (test-east expected charset)
(test-equal expected (east-asian? charset))) (test-equal
(format #f "check ~a" charset)
expected
(eastasian-locale? charset)))
(define data (define data
'((#f "foo@cjk_narrow") '((#f "foo@cjk_narrow")
@ -20,4 +23,4 @@
(for-each (λ (p) (apply test-east p)) data) (for-each (λ (p) (apply test-east p)) data)
(test-end "test-posix") (test-end "test-eastasian-locale")