From fac674f886181f00f47aad2e64c7ad8dd72bd125 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Fri, 19 May 2023 21:58:14 +0200
Subject: [PATCH] Switch table to kwargs proc define, add more day/month
 support procedures.

---
 src/Makefile       |  3 ++-
 src/cal-day.scm    | 10 ++++++++++
 src/cal-period.scm |  4 ++--
 src/table.scm      | 21 +++++++++++----------
 4 files changed, 25 insertions(+), 13 deletions(-)

diff --git a/src/Makefile b/src/Makefile
index 6576312..2d9ba05 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -161,7 +161,8 @@ progress.o: progress.import.scm
 progress.import.scm: $(PROGRESS-SOURCES)
 
 TABLE-SOURCES=table.scm ansi.import.scm testing.import.scm	\
-	 util-string.import.scm util-list.import.scm
+	 util-string.import.scm util-list.import.scm		\
+	 util-kwargs.import.scm
 
 table.o: table.import.scm
 table.import.scm: $(TABLE-SOURCES)
diff --git a/src/cal-day.scm b/src/cal-day.scm
index b623f6a..8e6c40f 100644
--- a/src/cal-day.scm
+++ b/src/cal-day.scm
@@ -50,6 +50,8 @@
 
   cal-day/month<?
 
+  cal-day/month->string
+
   cal-day-tests!
   )
 
@@ -205,6 +207,14 @@
 		  "Requires two arguments of the same type"
 		  (list a b)))))
 
+ ;; Semi-universal string conversion
+ (define (cal-day/month->string v)
+   (if (cal-day? v)
+       (cal-day->string v)
+       (if (cal-month? v)
+	   (cal-month->string v)
+	   "")))
+
  ;; Module self-tests
  (define (cal-day-tests!)
    (run-tests
diff --git a/src/cal-period.scm b/src/cal-period.scm
index 98c9c31..eb5dd7e 100644
--- a/src/cal-period.scm
+++ b/src/cal-period.scm
@@ -207,8 +207,8 @@
  ;; Returns string representing a month period with possibly open end.
  (define (cal-period->string p)
    (sprintf "~A..~A"
-	    (cal-month->string (cal-period-since p))
-	    (cal-month->string (cal-period-before p))))
+	    (cal-day/month->string (cal-period-since p))
+	    (cal-day/month->string (cal-period-before p))))
 
  ;; Returns a string representing a list of periods.
  (define (cal-periods->string ps)
diff --git a/src/table.scm b/src/table.scm
index 376fe1d..8d01a90 100644
--- a/src/table.scm
+++ b/src/table.scm
@@ -43,7 +43,8 @@
 	 ansi
 	 testing
 	 util-list
-	 util-string)
+	 util-string
+	 util-kwargs)
 
  ;; Default table border style to use if not explicitly specified.
  (define *table-border-style* (make-parameter 'unicode))
@@ -272,19 +273,19 @@
 			(if tb (sref 3) "")))
 
  ;; Converts given table to a list of strings suitable for printing.
- (define (table->list tbl . args)
+ (define-kwproc (table->list tbl
+			     (#:table-border table-border)
+			     (#:row-border row-border)
+			     (#:col-border column-border)
+			     (#:row0-border row0-border)
+			     (#:col0-border col0-border)
+			     (#:border-style border-style (*table-border-style*))
+			     (#:ansi ansi?))
    (let ((table (table-prepare tbl)))
      (if (or (null? tbl)
 	     (null? (car tbl)))
 	 ""
-	 (let* ((table-border (get-keyword #:table-border args (lambda () #f)))
-		(row-border (get-keyword #:row-border args (lambda () #f)))
-		(column-border (get-keyword #:col-border args (lambda () #f)))
-		(row0-border (get-keyword #:row0-border args (lambda () #f)))
-		(col0-border (get-keyword #:col0-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))
+	 (let* ((stylepair (assq border-style table-borders-lookup))
 		(stylevec
 		 (if stylepair
 		     (cdr stylepair)