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

Prepare ANSI table reset.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-23 16:15:36 +01:00
parent 2db2624d21
commit 8f378d57c9
3 changed files with 19 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

13
table.scm
View file

@ -190,7 +190,7 @@
;; Accepts a table row - list of list of strings - and returns a list
;; of lines (list of strings).
(define (table-row->lines row left-border cell-separator right-border)
(define (table-row->lines row left-border cell-separator right-border ansi?)
(if (null? row)
'()
(let yloop ((row row)
@ -201,7 +201,10 @@
(cons
(string-append left-border
(string-intersperse
(map car row)
(let ((srow (map car row)))
(if ansi?
(map (lambda (c) (string-append c (ansi #:default))) srow)
srow))
cell-separator)
right-border)
res))))))
@ -239,6 +242,7 @@
(row-border (get-keyword #:row-border args (lambda () #f)))
(column-border (get-keyword #:col-border args (lambda () #f)))
(border-style (get-keyword #:border-style args (lambda () (*table-border-style*))))
(ansi? (get-keyword #:ansi args (lambda () #f)))
(stylepair (assq border-style table-borders-lookup))
(stylevec
(if stylepair
@ -246,7 +250,8 @@
(cdar table-borders-lookup)))
(cell-borders (list (if table-border (vector-ref stylevec 4) "")
(if column-border (vector-ref stylevec 6) "")
(if table-border (vector-ref stylevec 7) "")))
(if table-border (vector-ref stylevec 7) "")
ansi?))
(cws (map (compose ansi-string-length car) (car table))))
(let loop ((rows table)
(res (if table-border
@ -333,7 +338,7 @@
'((("a") ("bb") ("ccc") (" "))
((" ") ("b ") ("z ") ("x"))))
(test-equal? table-row->lines
(table-row->lines '(("a ") ("bb") ("ccc") (" ")) "]" "|" "[")
(table-row->lines '(("a ") ("bb") ("ccc") (" ")) "]" "|" "[" #f)
'("]a |bb|ccc| ["))
(test-equal? table-row-delimiter
(table-row-delimiter '(1 2 3 1) "/" "-" "+" "\\")