diff --git a/gnucash/report/report-utilities.scm b/gnucash/report/report-utilities.scm index eaf42e5eef..9974e2d6d4 100644 --- a/gnucash/report/report-utilities.scm +++ b/gnucash/report/report-utilities.scm @@ -995,49 +995,49 @@ query instead.") ;; amount does not match the transaction amount ;; overpayment: a number indicating overpayment amount (define (gnc:payment-txn->payment-info txn) -(let* ((apar-split (xaccTransGetFirstAPARAcctSplit txn #t)) - (apar-acct (xaccSplitGetAccount apar-split))) - (let lp ((splits (xaccTransGetSplitList txn)) - (invoices '()) - (overpayment 0) - (opposing-splits '())) - (match splits - (() (vector invoices opposing-splits overpayment)) - (((? not-APAR? split) . rest) - (gnc:msg "next " (gnc:strify split) " overpayment " (+ overpayment (xaccSplitConvertAmount split apar-acct))) - (lp rest invoices (+ overpayment (xaccSplitConvertAmount split apar-acct)) - opposing-splits)) - ((split . rest) - (let* ((lot (xaccSplitGetLot split)) - (lot-all-splits (gnc-lot-get-split-list lot))) - (define split=? (cut equal? <> split)) - (match (gncInvoiceGetInvoiceFromLot lot) - (() (let lp1 ((lot-splits lot-all-splits) - (overpayment overpayment) - (opposing-splits opposing-splits)) - (match lot-splits - (() (lp rest invoices overpayment opposing-splits)) - (((? split=?) . tail) (lp1 tail overpayment opposing-splits)) - ((s . tail) - (let* ((lot-bal (gnc-lot-get-balance lot)) - (lot-bal (if (sign-equal? lot-bal (xaccSplitConvertAmount s apar-acct)) - 0 lot-bal)) - (derived? (not (zero? lot-bal))) - (partial-amount - (fold - (lambda (a b) - (if (equal? s a) b (+ b (xaccSplitConvertAmount a apar-acct)))) - (- lot-bal) lot-all-splits))) - (gnc:msg "next " (gnc:strify s) " overpayment " (+ overpayment partial-amount)) - (lp1 tail (+ overpayment partial-amount) - (cons (list s partial-amount derived?) - opposing-splits))))))) - (inv - (gnc:msg "next " (gnc:strify split) " overpayment " (+ overpayment (xaccSplitConvertAmount split apar-acct))) - (lp rest - (cons (cons inv split) invoices) - (+ overpayment (xaccSplitConvertAmount split apar-acct)) - opposing-splits))))))))) + (let* ((apar-split (xaccTransGetFirstAPARAcctSplit txn #t)) + (apar-acct (xaccSplitGetAccount apar-split))) + (let lp ((splits (xaccTransGetSplitList txn)) + (invoices '()) + (overpayment 0) + (opposing-splits '())) + (match splits + (() (vector invoices opposing-splits overpayment)) + (((? not-APAR? split) . rest) + (gnc:msg "next " (gnc:strify split) " overpayment " (+ overpayment (xaccSplitConvertAmount split apar-acct))) + (lp rest invoices (+ overpayment (xaccSplitConvertAmount split apar-acct)) + opposing-splits)) + ((split . rest) + (let* ((lot (xaccSplitGetLot split)) + (lot-all-splits (gnc-lot-get-split-list lot))) + (define split=? (cut equal? <> split)) + (match (gncInvoiceGetInvoiceFromLot lot) + (() (let lp1 ((lot-splits lot-all-splits) + (overpayment overpayment) + (opposing-splits opposing-splits)) + (match lot-splits + (() (lp rest invoices overpayment opposing-splits)) + (((? split=?) . tail) (lp1 tail overpayment opposing-splits)) + ((s . tail) + (let* ((lot-bal (gnc-lot-get-balance lot)) + (lot-bal (if (sign-equal? lot-bal (xaccSplitConvertAmount s apar-acct)) + 0 lot-bal)) + (derived? (not (zero? lot-bal))) + (partial-amount + (fold + (lambda (a b) + (if (equal? s a) b (+ b (xaccSplitConvertAmount a apar-acct)))) + (- lot-bal) lot-all-splits))) + (gnc:msg "next " (gnc:strify s) " overpayment " (+ overpayment partial-amount)) + (lp1 tail (+ overpayment partial-amount) + (cons (list s partial-amount derived?) + opposing-splits))))))) + (inv + (gnc:msg "next " (gnc:strify split) " overpayment " (+ overpayment (xaccSplitConvertAmount split apar-acct))) + (lp rest + (cons (cons inv split) invoices) + (+ overpayment (xaccSplitConvertAmount split apar-acct)) + opposing-splits))))))))) ;; create a stepped list, then add a date in the infinite future for ;; the "current" bucket