From 03520fc63b62fafc240b6fd6bd0650acc5e2be92 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Thu, 22 Jun 2023 21:41:04 +0200
Subject: [PATCH] Implement new approach to changing month and day.

---
 src/cal-period.scm | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

diff --git a/src/cal-period.scm b/src/cal-period.scm
index fd3c071..74c6e15 100644
--- a/src/cal-period.scm
+++ b/src/cal-period.scm
@@ -30,6 +30,12 @@
  (
   *current-month*
   *current-day*
+
+  set-current-month!
+  set-current-day!
+
+  with-current-month
+  with-current-day
   
   make-cal-period
 
@@ -90,6 +96,36 @@
 		    (+ (vector-ref d 4) 1)
 		    (vector-ref d 3)))))
 
+ ;; Changes both current-month and current-day based on given month
+ (define (set-current-month! m)
+   (*current-month* m)
+   (*current-day* (cal-ensure-day m)))
+
+ ;; Changes both current-day and current-month based on given day
+ (define (set-current-day! d)
+   (*current-day* d)
+   (*current-month* (cal-ensure-month d)))
+
+ ;; Parameterizes both current-month and current-day based on given
+ ;; month
+ (define-syntax with-current-month
+   (syntax-rules ()
+     ((_ ms body ...)
+      (let ((m ms))
+	(parameterize ((*current-month* m)
+		       (*current-day* (cal-ensure-day m)))
+	  body ...)))))
+
+ ;; Parameterizes both current-day and current-month based on given
+ ;; day
+ (define-syntax with-current-day
+   (syntax-rules ()
+     ((_ ds body ...)
+      (let ((d ds))
+	(parameterize ((*current-day* d)
+		       (*current-month* (cal-ensure-month d)))
+	  body ...)))))
+
  ;; Creates a new period value with optional since and before
  ;; comments.
  (define (make-cal-period since before . args)