Table row to list of lines conversion.
This commit is contained in:
parent
595b26ac50
commit
56815f2b35
1 changed files with 24 additions and 3 deletions
27
table.scm
27
table.scm
|
@ -162,8 +162,8 @@
|
|||
;; Table border styles in visual form
|
||||
(define table-borders-lookup-source
|
||||
'((ascii
|
||||
"/~,\\"
|
||||
"| ||"
|
||||
"/=,\\"
|
||||
"] |["
|
||||
">-+<"
|
||||
"'~^`")
|
||||
(unicode
|
||||
|
@ -175,9 +175,27 @@
|
|||
;; Compiled table borders for rendering
|
||||
(define table-borders-lookup
|
||||
(map (lambda (src)
|
||||
(cons (car src) (apply string-intersperse (cdr src))))
|
||||
(cons (car src) (string-intersperse (cdr src) "")))
|
||||
table-borders-lookup-source))
|
||||
|
||||
;; 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)
|
||||
(if (null? row)
|
||||
'()
|
||||
(let yloop ((row row)
|
||||
(res '()))
|
||||
(if (null? (car row))
|
||||
(reverse res)
|
||||
(yloop (map cdr row)
|
||||
(cons
|
||||
(string-append left-border
|
||||
(string-intersperse
|
||||
(map car row)
|
||||
cell-separator)
|
||||
right-border)
|
||||
res))))))
|
||||
|
||||
(define (table->string tbl . args)
|
||||
(let ((table-border (get-keyword #:table-border args (lambda () #f)))
|
||||
(cell-border (get-keyword #:cell-border args (lambda () #f)))
|
||||
|
@ -228,6 +246,9 @@
|
|||
(("") ("b") ("z") ("x"))))
|
||||
'((("a") ("bb") ("ccc") (" "))
|
||||
((" ") ("b ") ("z ") ("x"))))
|
||||
(test-equal? table-row->lines
|
||||
(table-row->lines '(("a ") ("bb") ("ccc") (" ")) "]" "|" "[")
|
||||
'("]a |bb|ccc| ["))
|
||||
))
|
||||
|
||||
)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue