Columns normalization.
This commit is contained in:
parent
8c1db26931
commit
6d9c5b8d31
1 changed files with 44 additions and 5 deletions
49
table.scm
49
table.scm
|
@ -110,8 +110,32 @@
|
||||||
rcws))
|
rcws))
|
||||||
rcws)))))
|
rcws)))))
|
||||||
|
|
||||||
|
;; Pads all lines of this cell to required width
|
||||||
|
(define (table-normalize-cell c w)
|
||||||
|
(let loop ((c c)
|
||||||
|
(r '()))
|
||||||
|
(if (null? c)
|
||||||
|
(reverse r)
|
||||||
|
(loop (cdr c)
|
||||||
|
(cons (let* ((cs (car c))
|
||||||
|
(csl (string-length cs)))
|
||||||
|
(if (< csl w)
|
||||||
|
(string-append cs (make-string (- w csl) #\space))
|
||||||
|
cs))
|
||||||
|
r)))))
|
||||||
|
|
||||||
|
;; Returns a row (list) of cells (list of strings) with all strings
|
||||||
|
;; padded to given column width.
|
||||||
(define (table-row-normalize-cells row cwidths)
|
(define (table-row-normalize-cells row cwidths)
|
||||||
row)
|
(let loop ((cwidths cwidths)
|
||||||
|
(cells row)
|
||||||
|
(res '()))
|
||||||
|
(if (null? cells)
|
||||||
|
(reverse res)
|
||||||
|
(loop (cdr cwidths)
|
||||||
|
(cdr cells)
|
||||||
|
(cons (table-normalize-cell (car cells) (car cwidths))
|
||||||
|
res)))))
|
||||||
|
|
||||||
;; Normalizes cells in all rows to match the widths of the wides cell
|
;; Normalizes cells in all rows to match the widths of the wides cell
|
||||||
;; in each column.
|
;; in each column.
|
||||||
|
@ -123,10 +147,11 @@
|
||||||
|
|
||||||
;; Ensures the table is rectangular and each cell is a list of strings.
|
;; Ensures the table is rectangular and each cell is a list of strings.
|
||||||
(define (table-prepare tbl)
|
(define (table-prepare tbl)
|
||||||
(table-normalize-rows
|
(table-normalize-columns
|
||||||
(table-prepare-cells
|
(table-normalize-rows
|
||||||
(table-stringify
|
(table-prepare-cells
|
||||||
(table-rectangularize tbl)))))
|
(table-stringify
|
||||||
|
(table-rectangularize tbl))))))
|
||||||
|
|
||||||
(define (table->string tbl . args)
|
(define (table->string tbl . args)
|
||||||
"")
|
"")
|
||||||
|
@ -160,6 +185,20 @@
|
||||||
(table-column-widths
|
(table-column-widths
|
||||||
'((("x") ("y") ("zz") ("")) (("a") ("bcde") ("") ("")) (("123") ("2") ("3") ("4"))))
|
'((("x") ("y") ("zz") ("")) (("a") ("bcde") ("") ("")) (("123") ("2") ("3") ("4"))))
|
||||||
'(3 4 2 1))
|
'(3 4 2 1))
|
||||||
|
(test-equal? table-normalize-cell
|
||||||
|
(table-normalize-cell '("a" "bb" "ccc" "") 4)
|
||||||
|
'("a " "bb " "ccc " " "))
|
||||||
|
(test-equal? table-row-normalize-cells
|
||||||
|
(table-row-normalize-cells
|
||||||
|
'(("a") ("bb") ("ccc") (""))
|
||||||
|
'(1 2 3 4))
|
||||||
|
'(("a") ("bb") ("ccc") (" ")))
|
||||||
|
(test-equal? table-normalize-columns
|
||||||
|
(table-normalize-columns
|
||||||
|
'((("a") ("bb") ("ccc") (""))
|
||||||
|
(("") ("b") ("z") ("x"))))
|
||||||
|
'((("a") ("bb") ("ccc") (" "))
|
||||||
|
((" ") ("b ") ("z ") ("x"))))
|
||||||
))
|
))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue