|
|
|
|
@ -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
|
|
|
|
|
|