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)))))
|
||||
|
||||
;; 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)
|
||||
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
|
||||
;; in each column.
|
||||
|
@ -123,10 +147,11 @@
|
|||
|
||||
;; Ensures the table is rectangular and each cell is a list of strings.
|
||||
(define (table-prepare tbl)
|
||||
(table-normalize-rows
|
||||
(table-prepare-cells
|
||||
(table-stringify
|
||||
(table-rectangularize tbl)))))
|
||||
(table-normalize-columns
|
||||
(table-normalize-rows
|
||||
(table-prepare-cells
|
||||
(table-stringify
|
||||
(table-rectangularize tbl))))))
|
||||
|
||||
(define (table->string tbl . args)
|
||||
"")
|
||||
|
@ -160,6 +185,20 @@
|
|||
(table-column-widths
|
||||
'((("x") ("y") ("zz") ("")) (("a") ("bcde") ("") ("")) (("123") ("2") ("3") ("4"))))
|
||||
'(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