IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[report-utilities] simplify gnc:payment-txn->payment-info

Browse Source 
store lot splits in a separate identifier
This commit is contained in:
Christopher Lam 2021-07-08 21:22:55 +08:00
parent d1997c59bc
commit 074729bf19
1 changed files with 11 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gnucash/report/report-utilities.scm
View File

@ -1006,28 +1006,26 @@ query instead.")
(lp rest invoices (+ overpayment (xaccSplitGetAmount split)) (lp rest invoices (+ overpayment (xaccSplitGetAmount split))
opposing-splits)) opposing-splits))
((split . rest) ((split . rest)
(let ((lot (xaccSplitGetLot split))) (let* ((lot (xaccSplitGetLot split))
(define (equal-to-split? s) (equal? s split)) (lot-all-splits (gnc-lot-get-split-list lot)))
(define split=? (cut equal? <> split))
(match (gncInvoiceGetInvoiceFromLot lot) (match (gncInvoiceGetInvoiceFromLot lot)
(() (let lp1 ((lot-splits (gnc-lot-get-split-list lot)) (() (let lp1 ((lot-splits lot-all-splits)
(overpayment overpayment) (overpayment overpayment)
(opposing-splits opposing-splits)) (opposing-splits opposing-splits))
(match lot-splits (match lot-splits
(() (lp rest invoices overpayment opposing-splits)) (() (lp rest invoices overpayment opposing-splits))
(((? equal-to-split?) . tail) (((? split=?) . tail) (lp1 tail overpayment opposing-splits))
(lp1 tail overpayment opposing-splits))
((s . tail) ((s . tail)
(let* ((s-lot (xaccSplitGetLot s)) (let* ((lot-bal (gnc-lot-get-balance lot))
(sum (lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
0 lot-bal))
(derived? (not (zero? lot-bal)))
(partial-amount
(fold (fold
(lambda (a b) (lambda (a b)
(if (equal? s a) b (+ b (xaccSplitGetAmount a)))) (if (equal? s a) b (+ b (xaccSplitGetAmount a))))
0 (gnc-lot-get-split-list s-lot))) (- lot-bal) lot-all-splits)))
(lot-bal (gnc-lot-get-balance s-lot))
(lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
0 lot-bal))
(partial-amount (- sum lot-bal))
(derived? (not (zero? lot-bal))))
(lp1 tail (+ overpayment partial-amount) (lp1 tail (+ overpayment partial-amount)
(cons (list s partial-amount derived?) (cons (list s partial-amount derived?)
opposing-splits))))))) opposing-splits)))))))