brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Convert all months to cal-months.

Browse source
This commit is contained in:
Dominik Pantůček 2023-05-21 20:50:40 +02:00
parent 82a4742914
commit 9ed3ef4423
1 changed files with 14 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

23
src/cal-period.scm
View file

@ -186,10 +186,12 @@
(define (cal-month-in-period? p . ml)
(let ((m (if (null? ml)
(*current-month*)
(car ml))))
(and (or (not (cal-period-before p))
(cal-month<? m (cal-period-before p)))
(not (cal-month<? m (cal-period-since p))))))
(car ml)))
(before (cal-ensure-month (cal-period-before p) #t))
(since (cal-ensure-month (cal-period-since p))))
(and (or (not before)
(cal-month<? m before))
(not (cal-month<? m since)))))
;; Returns true if given month is in at least one of the periods
;; given. Defaults to current month.
@ -234,12 +236,13 @@
(prev #f))
(if (null? lst)
(reverse
(cons (cons (make-cal-period (car prev) #f)
(cons (cons (make-cal-period (apply make-cal-month (car prev)) #f)
(cdr prev))
res))
(loop (cdr lst)
(if prev
(cons (cons (make-cal-period (car prev) (caar lst))
(cons (cons (make-cal-period (apply make-cal-month (car prev))
(apply make-cal-month (caar lst)))
(cdr prev))
res)
res)
@ -256,9 +259,11 @@
;; Wrapper that accepts either day or month and returns testable month
(define (cal-ensure-month v . stop?s)
(if (cal-month? v)
v
(apply cal-day->month v stop?s)))
(if v
(if (cal-month? v)
v
(apply cal-day->month v stop?s))
#f))
;; Performs self-tests of the period module.
(define (cal-period-tests!)