diff --git a/bbstool.scm b/bbstool.scm index b0da352..69fa086 100644 --- a/bbstool.scm +++ b/bbstool.scm @@ -131,7 +131,9 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (newline) (if mr (print-member-record-table mr) - (print-members-base-info MB)) + (let () + (print-members-base-info MB) + (print-members-base-table MB))) (newline)) ((print-stats) (newline) diff --git a/members-base.scm b/members-base.scm index 93c2def..6593540 100644 --- a/members-base.scm +++ b/members-base.scm @@ -35,6 +35,7 @@ list-members-nicks members-base-stats print-members-base-info + print-members-base-table print-members-base-stats get-free-members-ids print-members-ids-stats @@ -63,7 +64,8 @@ period month configuration - progress) + progress + table) ;; Gets all files and symbolic links from given directory. The ;; symbolic links are represented by cons cells with car being the @@ -332,6 +334,10 @@ (member-records->string (sort invalid-mrs memberlines 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) "/" "-" "+" "\\")