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)