Improved row border lookup.

table.scm

@@ -219,33 +219,52 @@
 
  ;; Returns table row delimiter based on column widths, extracting
  ;; line style from particular row of border style vector.
- (define (table-row-delimiter/styled cws svec srow)
+ (define (table-row-delimiter/styled tb cb cws svec srow)
-   (apply table-row-delimiter cws
+   (define (sref i)
-	  (map (lambda (idx)
+     (vector-ref svec (+ i (* srow 4))))
-		 (vector-ref svec (+ idx (* srow 4))))
+   (table-row-delimiter cws
-	       '(0 1 2 3))))
+			(if tb (sref 0) "")
+			(sref 1)
+			(if cb (sref 2) "")
+			(if tb (sref 3) "")))
 
  ;; Converts given table to a string suitable for printing.
  (define (table->string tbl . args)
-   (let* ((table-border (get-keyword #:table-border args (lambda () #f)))
+   (let ((table (table-prepare tbl)))
-	  (cell-border (get-keyword #:cell-border args (lambda () #f)))
+     (if (or (null? tbl)
-	  (border-style (get-keyword #:border-style args (lambda () 'ascii)))
+	     (null? (car tbl)))
-	  (table (table-prepare tbl))
+	 ""
-	  (stylepair (assq border-style table-borders-lookup))
+	 (let* ((table-border (get-keyword #:table-border args (lambda () #f)))
-	  (stylevec (if stylepair
+		(row-border (get-keyword #:row-border args (lambda () #f)))
-			(cdr stylepair)
+		(column-border (get-keyword #:col-border args (lambda () #f)))
-			(cdar table-borders-lookup)))
+		(border-style (get-keyword #:border-style args (lambda () 'ascii)))
-	  (cell-borders (if cell-border
+		(stylepair (assq border-style table-borders-lookup))
-			    (map (lambda (idx)
+		(stylevec
-				   (vector-ref stylevec idx))
+		 (if stylepair
-				 '(4 6 7))
+		     (cdr stylepair)
-			    '("" "" ""))))
+		     (cdar table-borders-lookup)))
-     (string-intersperse
+		(cell-borders
-      (flatten
+		 (if column-border
-       (map (lambda (row)
+		     (map (lambda (idx)
-	      (apply table-row->lines row cell-borders))
+			    (vector-ref stylevec idx))
-	    table))
+			  '(4 6 7))
-      "\n")))
+		     '("" "" ""))))
+	   (let loop ((rows table)
+		      (res '())
+		      (idx 0))
+	     (if (null? rows)
+		 (string-intersperse
+		  (flatten (reverse res))
+		  "\n")
+		 (let* ((res0
+			 (cons
+			  (apply table-row->lines
+				 (car rows)
+				 cell-borders)
+			  res)))
+		   (loop (cdr rows)
+			 res0
+			 (add1 idx)))))))))
 
  ;; Performs module self-tests
  (define (table-tests!)
@@ -308,7 +327,7 @@
  (table->string
   '(("a" "bb" "ccc" "")
     ("" "b" "z" "x"))))
-(print (table-row-delimiter/styled '(1 2 3 1) (cdr (assq 'unicode table-borders-lookup)) 3))
+(print (table-row-delimiter/styled #t #t '(1 2 3 1) (cdr (assq 'unicode table-borders-lookup)) 3))
 
 (print "************")
 (print
@@ -316,7 +335,7 @@
   '(("a" "bb" "ccc" "")
     ("" "b" "z" "x"))
   #:table-border #f
-  #:cell-border #f
+  #:col-border #f
   ))
 
 (print "************")
@@ -325,7 +344,17 @@
   '(("a" "bb" "ccc" "")
     ("" "b" "z" "x"))
   #:table-border #f
-  #:cell-border #t
+  #: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
   ))
 
@@ -335,15 +364,7 @@
   '(("a" "bb" "ccc" "")
     ("" "b" "z" "x"))
   #:table-border #t
-  #:cell-border #f
+  #:row-border #t
-  ))
+  #:col-border #t
-
-(print "************")
-(print
- (table->string
-  '(("a" "bb" "ccc" "")
-    ("" "b" "z" "x"))
-  #:table-border #t
-  #:cell-border #t
   #:border-style 'unicode
   ))