diff --git a/src/brmember.scm b/src/brmember.scm index 49892e7..58e4de7 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -70,6 +70,8 @@ brmember-add-payment brmember-payments + brmember-credit + brmember-mailman brmember-add-mailman @@ -357,6 +359,18 @@ (cal-month<=? month (*current-month*)))) (ldict-ref mr 'payments '()))) + ;; Returns credit records - respects *current-month* + (define (brmember-credit mr) + (filter (lambda (cr) + (let* ((cmon (cadr cr)) + (mon (if cmon + (cal-ensure-month cmon) + #f))) + (if mon + (cal-month<=? mon (*current-month*)) + #t))) + (brmember-info mr 'credit '()))) + ;; Returns a list of MLs this member is subscribed to (define (brmember-mailman mr) (ldict-ref mr 'mailman '())) diff --git a/src/members-fees.scm b/src/members-fees.scm index 3bb0020..6b9e8bd 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -163,15 +163,7 @@ ;; Total credit manually recorded in member record (define (member-credit-total mr) - (let* ((credit (filter (lambda (cr) - (let* ((cmon (cadr cr)) - (mon (if cmon - (cal-ensure-month cmon) - #f))) - (if mon - (cal-month<=? mon (*current-month*)) - #t))) - (brmember-info mr 'credit '()))) + (let* ((credit (brmember-credit mr)) (amounts (map car credit))) (foldl + 0 amounts))) diff --git a/src/members-print.scm b/src/members-print.scm index 0c94c21..72f0e17 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -103,7 +103,7 @@ (list (car c) (cal-format (cadr c)) (caddr c))) - v) + (brmember-credit mr)) #:col-border #t))) ((suspend student member) (list k