Implement row delimiters.

table.scm

@@ -31,6 +31,10 @@
   *table-border-style*
   table->string
   table-tests!
+  ;;---
+  table-row-delimiter
+  table-row-delimiter/styled
+  table-borders-lookup
   )
 
  (import scheme
@@ -38,8 +42,10 @@
 	 (chicken string)
 	 (chicken format)
 	 (chicken keyword)
+	 (chicken irregex)
 	 ansi
-	 testing)
+	 testing
+	 utils)
 
  ;; Default table border style to use if not explicitly specified.
  (define *table-border-style* (make-parameter 'ascii))
@@ -175,7 +181,10 @@
  ;; Compiled table borders for rendering
  (define table-borders-lookup
    (map (lambda (src)
-	  (cons (car src) (string-intersperse (cdr src) "")))
+	  (cons (car src)
+		(list->vector
+		 (irregex-extract (irregex "." 'u)
+				  (string-intersperse (cdr src) "")))))
 	table-borders-lookup-source))
 
  ;; Accepts a table row - list of list of strings - and returns a list
@@ -196,6 +205,27 @@
 				    right-border)
 		     res))))))
 
+ ;; Creates table row delimiter based on column widths.
+ (define (table-row-delimiter cws left line cross right)
+   (string-append
+    left
+    (string-intersperse
+     (map
+      (lambda (cw)
+	(string-repeat line cw))
+      cws)
+     cross)
+    right))
+
+ ;; 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)
+   (apply table-row-delimiter cws
+	  (map (lambda (idx)
+		 (vector-ref svec (+ idx (* srow 4))))
+	       '(0 1 2 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)))
 	 (cell-border (get-keyword #:cell-border args (lambda () #f)))
@@ -254,6 +284,9 @@
     (test-equal? table-row->lines
 		 (table-row->lines '(("a ") ("bb") ("ccc") ("    ")) "]" "|" "[")
 		 '("]a |bb|ccc|    ["))
+    (test-equal? table-row-delimiter
+		 (table-row-delimiter '(1 2 3 1) "/" "-" "+" "\\")
+		 "/-+--+---+-\\")
     ))
 
  )
@@ -261,7 +294,9 @@
 (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 '(1 2 3 1) (cdr (assq 'unicode table-borders-lookup)) 3))