brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Add UTF-8 support to ansi module.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-22 20:00:18 +01:00
parent 471ea24874
commit 4093313e43
2 changed files with 9 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

10
ansi.scm
View file

@ -43,6 +43,7 @@
(import scheme (import scheme
(chicken base) (chicken base)
(chicken string) (chicken string)
(chicken irregex)
testing testing
utils) utils)
@ -91,20 +92,20 @@
;; 1 - seen escape ;; 1 - seen escape
;; 2 - CSI started ;; 2 - CSI started
(define (ansi-string-length str) (define (ansi-string-length str)
(let loop ((lst (string->list str)) (let loop ((lst (irregex-extract (irregex "." 'u) str))
(state 0) (state 0)
(len 0)) (len 0))
(if (null? lst) (if (null? lst)
len len
(let ((ch (car lst))) (let ((ch (car lst)))
(case state (case state
((0) (if (eq? ch #\escape) ((0) (if (equal? ch "\x1b")
(loop (cdr lst) 1 len) (loop (cdr lst) 1 len)
(loop (cdr lst) 0 (add1 len)))) (loop (cdr lst) 0 (add1 len))))
((1) (if (eq? ch #\[) ((1) (if (equal? ch "[")
(loop (cdr lst) 2 len) (loop (cdr lst) 2 len)
(loop (cdr lst) 0 len))) (loop (cdr lst) 0 len)))
((2) (if (eq? ch #\m) ((2) (if (equal? ch "m")
(loop (cdr lst) 0 len) (loop (cdr lst) 0 len)
(loop (cdr lst) 2 len)))))))) (loop (cdr lst) 2 len))))))))
@ -118,6 +119,7 @@
(test-eq? ansi-string-length (ansi-string-length "test") 4) (test-eq? ansi-string-length (ansi-string-length "test") 4)
(test-eq? ansi-string-length (ansi-string-length "\x1b[1mtest") 4) (test-eq? ansi-string-length (ansi-string-length "\x1b[1mtest") 4)
(test-eq? ansi-string-length (ansi-string-length "\x1b[30mtest\x1b[0m") 4) (test-eq? ansi-string-length (ansi-string-length "\x1b[30mtest\x1b[0m") 4)
(test-eq? ansi-string-length (ansi-string-length "\x1b[30mščřž\x1b[0m") 4)
)) ))
) )

4
bbstool.scm
View file

@ -37,7 +37,8 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
members-base members-base
primes primes
member-record member-record
configuration) configuration
table)
;; Print banner ;; Print banner
(print "bbstool 0.4 (c) 2023 Brmlab, z.s.") (print "bbstool 0.4 (c) 2023 Brmlab, z.s.")
@ -95,6 +96,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(members-base-tests!) (members-base-tests!)
(primes-tests!) (primes-tests!)
(member-record-tests!) (member-record-tests!)
(table-tests!)
(newline)) (newline))
;; Load the members database (required for everything anyway) ;; Load the members database (required for everything anyway)