From c9ba551132b402fdadf060829788bf27fe9e1431 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:15:56 +0200
Subject: [PATCH] Universal sorting of markers.

---
 src/cal-day.scm    | 14 ++++++++++++++
 src/cal-period.scm |  2 +-
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/src/cal-day.scm b/src/cal-day.scm
index 99bc377..b623f6a 100644
--- a/src/cal-day.scm
+++ b/src/cal-day.scm
@@ -48,6 +48,8 @@
   cal-day>=?
   cal-day>?
 
+  cal-day/month<?
+
   cal-day-tests!
   )
 
@@ -191,6 +193,18 @@
  (define (cal-day>? a b)
    (not (cal-day<=? a b)))
 
+ ;; Universal sorting comparator
+ (define (cal-day/month<? a b)
+   (if (and (cal-day? a)
+	    (cal-day? b))
+       (cal-day<? a b)
+       (if (and (cal-month? a)
+		(cal-month? b))
+	   (cal-month<? a b)
+	   (error 'cal-day/month<?
+		  "Requires two arguments of the same type"
+		  (list a b)))))
+
  ;; Module self-tests
  (define (cal-day-tests!)
    (run-tests
diff --git a/src/cal-period.scm b/src/cal-period.scm
index 3c55592..98c9c31 100644
--- a/src/cal-period.scm
+++ b/src/cal-period.scm
@@ -130,7 +130,7 @@
  (define (sort-period-markers l)
    (sort l
 	 (lambda (a b)
-	   (cal-month<? (cadr a) (cadr b)))))
+	   (cal-day/month<? (cadr a) (cadr b)))))
 
  ;; Converts list of start/stop markers to list of pairs of months -
  ;; periods. The markers are lists in the form (start/stop cal-month).