[new-owner-report] refine payment->description

LHS payment description are memos from APAR splits
RHS payment description are memos from non-APAR splits
RHS payment description should match RHS payment amounts
This commit is contained in:
Christopher Lam 2020-01-25 17:16:05 +08:00
parent 3f324952d4
commit 88bfc8b477

View File

@ -311,17 +311,12 @@
(define (splits->desc splits) (define (splits->desc splits)
(let lp ((splits splits) (result '())) (let lp ((splits splits) (result '()))
(if (null? splits) (match splits
(apply gnc:make-html-text (() (apply gnc:make-html-text result))
(fold ((split . rest)
(lambda (a b) (lp rest (cons* (gnc:html-string-sanitize (xaccSplitGetMemo split))
(cons* (gnc:html-string-sanitize a) (gnc:html-markup-br) b)) (gnc:html-markup-br)
'() result)) result))))))
(lp (cdr splits)
(let ((memo (xaccSplitGetMemo (car splits))))
(if (or (string-null? memo) (member memo result))
result
(cons memo result)))))))
(define (make-aging-table splits to-date payable? date-type currency) (define (make-aging-table splits to-date payable? date-type currency)
(let ((table (gnc:make-html-table)) (let ((table (gnc:make-html-table))
@ -591,7 +586,7 @@
(qof-print-date (xaccTransGetDate lot-txn)) (qof-print-date (xaccTransGetDate lot-txn))
(split->reference lot-split) (split->reference lot-split)
(split->type-str lot-split) (split->type-str lot-split)
(splits->desc (list lot-split)) (splits->desc pmt-splits)
(gnc:make-html-text (split->anchor lot-split #t)) (gnc:make-html-text (split->anchor lot-split #t))
(let lp1 ((pmt-splits pmt-splits) (acc '())) (let lp1 ((pmt-splits pmt-splits) (acc '()))
(match pmt-splits (match pmt-splits
@ -804,7 +799,7 @@
table odd-row? used-columns date #f table odd-row? used-columns date #f
(split->reference split) (split->reference split)
(split->type-str split) (split->type-str split)
(splits->desc (txn->assetliab-splits txn)) (splits->desc (xaccTransGetAPARAcctSplitList txn #t))
currency (+ total value) currency (+ total value)
(and (>= orig-value 0) (amount->anchor split orig-value)) (and (>= orig-value 0) (amount->anchor split orig-value))
(and (< orig-value 0) (amount->anchor split (- orig-value))) (and (< orig-value 0) (amount->anchor split (- orig-value)))