diff --git a/src/brmember.scm b/src/brmember.scm index 8603e36..51db8bd 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -85,6 +85,8 @@ brmember-mailman brmember-add-mailman + brmember-spec-fee + brmember-tests! ) @@ -478,6 +480,18 @@ (cons ml (brmember-mailman mr)))) + ;; Returns special fee for current month or #f if it should be default + (define (brmember-spec-fee mr) + (let ((fee-periods (brmember-info mr 'fee #f))) + (if fee-periods + (let ((fee-period (cal-month-find-period fee-periods))) + (if fee-period + (let () + (print fee-period) + #t) + #f)) + #f))) + ;; Self-tests (define (brmember-tests!) (run-tests diff --git a/src/cal-period.scm b/src/cal-period.scm index 48c29ba..ea1cf3d 100644 --- a/src/cal-period.scm +++ b/src/cal-period.scm @@ -53,6 +53,8 @@ cal-month-in-period? cal-month-in-periods? + cal-month-find-period + cal-day-in-period? cal-day-in-periods? @@ -265,6 +267,19 @@ #t (loop (cdr ps))))))) + ;; Returns true if given month is in at least one of the periods + ;; given. Defaults to current month. + (define (cal-month-find-period ps . ml) + (let ((m (if (null? ml) + (*current-month*) + (car ml)))) + (let loop ((ps ps)) + (if (null? ps) + #f + (if (cal-month-in-period? (car ps) m) + (car ps) + (loop (cdr ps))))))) + ;; Checks whether given day belongs to day or month period (define (cal-day-in-period? p . dl) (let ((d (if (null? dl) diff --git a/src/members-fees.scm b/src/members-fees.scm index 1d92ab9..6659fcb 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -85,7 +85,11 @@ (cons (list cm (with-current-month cm - (brmember-flags mr))) + (brmember-flags mr)) + ;; TODO: the following needs to be handled everywhere + (with-current-month + cm + (brmember-spec-fee mr))) cal)))))) ;; Returns the first month of the calendar