Implement new approach to changing month and day.

This commit is contained in:
Dominik Pantůček 2023-06-22 21:41:04 +02:00
parent 46baebfa6d
commit 03520fc63b

View file

@ -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)