From 471ea248748948a1fdd3c9a250f435710133d94a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 22 Mar 2023 19:57:44 +0100 Subject: [PATCH] Finish table implementation. --- table.scm | 96 ++++++++++++++++++++----------------------------------- 1 file changed, 34 insertions(+), 62 deletions(-) diff --git a/table.scm b/table.scm index 2f72301..8ae4ef6 100644 --- a/table.scm +++ b/table.scm @@ -243,27 +243,49 @@ (if stylepair (cdr stylepair) (cdar table-borders-lookup))) - (cell-borders - (if column-border - (map (lambda (idx) - (vector-ref stylevec idx)) - '(4 6 7)) - '("" "" "")))) + (cell-borders (list (if table-border (vector-ref stylevec 4) "") + (if column-border (vector-ref stylevec 6) "") + (if table-border (vector-ref stylevec 7) ""))) + (cws (map (compose ansi-string-length car) (car table)))) (let loop ((rows table) - (res '()) + (res (if table-border + (list (table-row-delimiter/styled table-border + column-border + cws + stylevec + 0)) + '())) (idx 0)) (if (null? rows) - (string-intersperse - (flatten (reverse res)) - "\n") + (let ((res0 (if table-border + (cons (table-row-delimiter/styled table-border + column-border + cws + stylevec + 3) + res) + res))) + (string-intersperse + (flatten (reverse res0)) + "\n")) (let* ((res0 + (if (and row-border + (> idx 0)) + (cons (table-row-delimiter/styled table-border + column-border + cws + stylevec + 2) + res) + res)) + (res1 (cons (apply table-row->lines (car rows) cell-borders) - res))) + res0))) (loop (cdr rows) - res0 + res1 (add1 idx))))))))) ;; Performs module self-tests @@ -318,53 +340,3 @@ )) ) - -(import table) -(table-tests!) - -(print (table-row-delimiter '(1 2 3 1) "/" "-" "+" "\\")) -(print - (table->string - '(("a" "bb" "ccc" "") - ("" "b" "z" "x")))) -(print (table-row-delimiter/styled #t #t '(1 2 3 1) (cdr (assq 'unicode table-borders-lookup)) 3)) - -(print "************") -(print - (table->string - '(("a" "bb" "ccc" "") - ("" "b" "z" "x")) - #:table-border #f - #:col-border #f - )) - -(print "************") -(print - (table->string - '(("a" "bb" "ccc" "") - ("" "b" "z" "x")) - #:table-border #f - #:col-border #t - )) - -(print "************") -(print - (table->string - '(("a" "bb" "ccc" "") - ("" "b" "z" "x")) - #:table-border #t - #:col-border #f - #:row-border #t - #:border-style 'unicode - )) - -(print "************") -(print - (table->string - '(("a" "bb" "ccc" "") - ("" "b" "z" "x")) - #:table-border #t - #:row-border #t - #:col-border #t - #:border-style 'unicode - ))