Implement new approach to changing month and day.
This commit is contained in:
parent
46baebfa6d
commit
03520fc63b
1 changed files with 36 additions and 0 deletions
|
@ -30,6 +30,12 @@
|
||||||
(
|
(
|
||||||
*current-month*
|
*current-month*
|
||||||
*current-day*
|
*current-day*
|
||||||
|
|
||||||
|
set-current-month!
|
||||||
|
set-current-day!
|
||||||
|
|
||||||
|
with-current-month
|
||||||
|
with-current-day
|
||||||
|
|
||||||
make-cal-period
|
make-cal-period
|
||||||
|
|
||||||
|
@ -90,6 +96,36 @@
|
||||||
(+ (vector-ref d 4) 1)
|
(+ (vector-ref d 4) 1)
|
||||||
(vector-ref d 3)))))
|
(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
|
;; Creates a new period value with optional since and before
|
||||||
;; comments.
|
;; comments.
|
||||||
(define (make-cal-period since before . args)
|
(define (make-cal-period since before . args)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue