From 64ff4255e32b1d0bfbd83b3b9a6404b358a86e66 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Wed, 22 Mar 2023 19:10:38 +0100
Subject: [PATCH] Implement row delimiters.

---
 Makefile  |  3 ++-
 README.md |  8 ++++++++
 table.scm | 39 +++++++++++++++++++++++++++++++++++++--
 utils.scm | 11 +++++++++++
 4 files changed, 58 insertions(+), 3 deletions(-)

diff --git a/Makefile b/Makefile
index 8a13d33..e882898 100644
--- a/Makefile
+++ b/Makefile
@@ -182,7 +182,8 @@ progress.so: progress.o
 progress.o: progress.import.scm
 progress.import.scm: $(PROGRESS-SOURCES)
 
-TABLE-SOURCES=table.scm ansi.import.scm testing.import.scm
+TABLE-SOURCES=table.scm ansi.import.scm testing.import.scm	\
+	utils.import.scm
 
 table.so: table.o
 table.o: table.import.scm
diff --git a/README.md b/README.md
index 475732e..b8c2022 100644
--- a/README.md
+++ b/README.md
@@ -453,3 +453,11 @@ any algorithms used.
 
 Returns a list containing only elements matching given ```pred?```
 predicate.
+
+    (string-repeat str rep)
+
+* ```str``` - string to repeat
+* ```rep``` - number of repeats
+
+Returns a string created by repeating the string ```str``` exactly
+```rep``` number of times.
diff --git a/table.scm b/table.scm
index abfead6..6436753 100644
--- a/table.scm
+++ b/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))
diff --git a/utils.scm b/utils.scm
index 2001a0e..54b128d 100644
--- a/utils.scm
+++ b/utils.scm
@@ -29,11 +29,13 @@
  utils
  (
   filter
+  string-repeat
   utils-tests!
   )
 
  (import scheme
 	 (chicken base)
+	 (chicken string)
 	 testing)
 
  ;; Returns a list with elements matching pred? predicate.
@@ -48,6 +50,15 @@
 	     (loop (cdr lst)
 		   res)))))
 
+ ;; Repeats given string.
+ (define (string-repeat str rep)
+   (let loop ((rep rep)
+	      (res '()))
+     (if (> rep 0)
+	 (loop (sub1 rep)
+	       (cons str res))
+	 (string-intersperse res ""))))
+
  ;; Performs utils module self-tests.
  (define (utils-tests!)
    (run-tests