gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Fri Jan 24 07:36:07 EST 2020
Updated via https://github.com/Gnucash/gnucash/commit/a01bfa68 (commit)
via https://github.com/Gnucash/gnucash/commit/8e34a799 (commit)
via https://github.com/Gnucash/gnucash/commit/cbb74317 (commit)
via https://github.com/Gnucash/gnucash/commit/3866d9bb (commit)
from https://github.com/Gnucash/gnucash/commit/a033b7b1 (commit)
commit a01bfa6843de7c98b8876f4632b5473b0b6ac073
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jan 24 18:50:35 2020 +0800
[new-owner-report] RHS partial amount/amount separated
RHS partial-amount and amount are shown in separate cells.
also modify test-owner-report.scm to allow pass
the $2.00 is strictly a RHS amount but I'm not sure how to exclude it
using sxpath.
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 9a9c839b5..5504dcc73 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -88,12 +88,13 @@
(assv-ref owner-string-alist key))
(define-record-type :link-data
- (make-link-data date ref type desc amount)
+ (make-link-data date ref type desc partial-amount amount)
link-data?
(date link-data-date)
(ref link-data-ref)
(type link-data-type)
(desc link-data-desc)
+ (partial-amount link-data-partial-amount)
(amount link-data-amount))
(define-record-type :link-desc-amount
@@ -151,7 +152,7 @@
(list 'lhs-cols date? due? ref? type? desc? sale? tax? credit? debit? bal?)
(list 'ptt-span date? due? ref? type? desc?)
(list 'mid-spac spacer?)
- (list 'rhs-cols date? ref? type? desc? amt?)
+ (list 'rhs-cols date? ref? type? desc? amt? amt?)
(list 'rhs-span date? ref? type? desc?)))
(cols-list (assq-ref cols-alist section)))
(count identity cols-list)))
@@ -220,6 +221,8 @@
(if (ref-col column-vector) (addto! heading-list (_ "Reference")))
(if (type-col column-vector) (addto! heading-list (_ "Type")))
(if (desc-col column-vector) (addto! heading-list (_ "Description")))
+ (if (or (debit-col column-vector) (credit-col column-vector))
+ (addto! heading-list (_ "Partial Amount")))
(if (or (debit-col column-vector) (credit-col column-vector))
(addto! heading-list (_ "Amount")))))
(reverse heading-list)))
@@ -352,6 +355,9 @@
(addif (ref-col column-vector) (link-data-ref link-data))
(addif (type-col column-vector) (link-data-type link-data))
(addif (desc-col column-vector) (link-data-desc link-data))
+ (addif (or (debit-col column-vector) (credit-col column-vector))
+ (gnc:make-html-table-cell/markup
+ "number-cell" (link-data-partial-amount link-data)))
(addif (or (debit-col column-vector) (credit-col column-vector))
(gnc:make-html-table-cell/markup
"number-cell" (link-data-amount link-data)))))
@@ -362,8 +368,8 @@
(addif (< 0 cols) (gnc:make-html-table-cell/size
1 cols (link-desc-amount-desc link-data)))
(addif (or (debit-col column-vector) (credit-col column-vector))
- (gnc:make-html-table-cell/markup
- "number-cell" (link-desc-amount-amount link-data))))))
+ (gnc:make-html-table-cell/size/markup
+ 1 2 "number-cell" (link-desc-amount-amount link-data))))))
((link-blank? link-data)
(make-list (num-cols column-vector 'rhs-cols) #f))
@@ -498,6 +504,7 @@
(split->reference posting-split)
(split->type-str posting-split)
(splits->desc (list posting-split))
+ #f
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:split-anchor-text (txn->transfer-split posting-txn))
@@ -537,8 +544,8 @@
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:split-anchor-text lot-split)
- (gnc:make-gnc-monetary currency lot-amt))
- " of "
+ (gnc:make-gnc-monetary currency lot-amt)))
+ (gnc:make-html-text
(gnc:html-markup-anchor
(gnc:split-anchor-text tfr-split)
(gnc:make-gnc-monetary
@@ -641,8 +648,8 @@
(gnc:html-markup-anchor
(gnc:split-anchor-text APAR-split)
(gnc:make-gnc-monetary
- currency (AP-negate (- (xaccSplitGetAmount APAR-split)))))
- " of "
+ currency (AP-negate (- (xaccSplitGetAmount APAR-split))))))
+ (gnc:make-html-text
(gnc:html-markup-anchor
(gnc:split-anchor-text tfr-split)
(gnc:make-gnc-monetary
diff --git a/gnucash/report/business-reports/test/test-owner-report.scm b/gnucash/report/business-reports/test/test-owner-report.scm
index 94eed7d30..9a9271786 100644
--- a/gnucash/report/business-reports/test/test-owner-report.scm
+++ b/gnucash/report/business-reports/test/test-owner-report.scm
@@ -340,7 +340,7 @@
((sxpath `(// (table 3) // tr (td 5) // *text*))
sxml))
(test-equal "credit-amounts"
- '("$11.50" "$7.50" "$8.50" "$4.00" "$200.00" "$6.75" "$8.00")
+ '("$11.50" "$2.00" "$7.50" "$8.50" "$4.00" "$200.00" "$6.75" "$8.00")
((sxpath `(// (table 3) // tr (td 6) // *text*))
sxml))
(test-equal "debit-amounts"
commit 8e34a7999dbcbfbea937417009505018487488e2
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 23 22:45:19 2020 +0800
[new-owner-report] LHS invoice->RHS payments show partial amounts
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index eb72ebc2f..9a9c839b5 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -490,20 +490,6 @@
((detailed) (list (make-link-blank))))))
(define (make-invoice->payments-table invoice)
- (define (tfr-split->row tfr-split)
- (let* ((pmt-txn (xaccSplitGetParent tfr-split))
- (tfr-acct (xaccSplitGetAccount tfr-split))
- (tfr-curr (xaccAccountGetCommodity tfr-acct))
- (tfr-amt (AP-negate (xaccSplitGetAmount tfr-split))))
- (make-link-data
- (qof-print-date (xaccTransGetDate pmt-txn))
- (split->reference tfr-split)
- (split->type-str tfr-split)
- (splits->desc (list tfr-split))
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:split-anchor-text (txn->transfer-split pmt-txn))
- (gnc:make-gnc-monetary tfr-curr tfr-amt))))))
(define (posting-split->row posting-split)
(let* ((posting-txn (xaccSplitGetParent posting-split))
(inv (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot posting-split))))
@@ -519,7 +505,6 @@
currency (AP-negate (xaccSplitGetAmount posting-split))))))))
(let ((lot (gncInvoiceGetPostedLot invoice)))
(let lp ((lot-splits (gnc-lot-get-split-list lot))
- (transfer-splits-seen '())
(link-splits-seen '())
(result '()))
(cond
@@ -538,24 +523,28 @@
;; This is the regular payment split. Find Transfer acct
;; splits, and if haven't encountered before, add to result rows.
((txn-is-payment? (xaccSplitGetParent (car lot-splits)))
- (let lp1 ((pmt-splits (xaccTransGetPaymentAcctSplitList
- (xaccSplitGetParent (car lot-splits))))
- (transfer-splits-seen transfer-splits-seen)
- (result result))
- ;; this is a secondary 'inner loop', looping
- ;; lot-split->tfr-account-splits.
- (cond
- ;; finished tfr-splits. loop main lot-splits.
- ((null? pmt-splits)
- (lp (cdr lot-splits) transfer-splits-seen link-splits-seen result))
- ;; we've encountered this tfr-split before. skip.
- ((member (car pmt-splits) transfer-splits-seen)
- (lp1 (cdr pmt-splits) transfer-splits-seen result))
- ;; new tfr-split. render in original currency.
- (else
- (lp1 (cdr pmt-splits)
- (cons (car pmt-splits) transfer-splits-seen)
- (cons (tfr-split->row (car pmt-splits)) result))))))
+ (lp (cdr lot-splits)
+ link-splits-seen
+ (cons (let* ((lot-split (car lot-splits))
+ (lot-txn (xaccSplitGetParent lot-split))
+ (lot-amt (AP-negate (- (xaccSplitGetAmount lot-split))))
+ (tfr-split (txn->transfer-split lot-txn)))
+ (make-link-data
+ (qof-print-date (xaccTransGetDate lot-txn))
+ (split->reference lot-split)
+ (split->type-str lot-split)
+ (splits->desc (list lot-split))
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text lot-split)
+ (gnc:make-gnc-monetary currency lot-amt))
+ " of "
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text tfr-split)
+ (gnc:make-gnc-monetary
+ (xaccAccountGetCommodity (xaccSplitGetAccount tfr-split))
+ (AP-negate (xaccSplitGetAmount tfr-split)))))))
+ result)))
;; This is a lot link split. Find corresponding documents,
;; and add to result rows.
@@ -569,7 +558,7 @@
(cond
;; finished peer-splits. loop main lot-splits.
((null? link-splits)
- (lp (cdr lot-splits) transfer-splits-seen link-splits-seen result))
+ (lp (cdr lot-splits) link-splits-seen result))
;; peer split is of same sign as lot split. skip.
((sign-equal? (xaccSplitGetAmount (car lot-splits))
(xaccSplitGetAmount (car link-splits)))
@@ -589,7 +578,7 @@
;; This is either the invoice posting transaction, or a
;; TXN-TYPE-NONE txn which shouldn't happen. Skip both.
(else
- (lp (cdr lot-splits) transfer-splits-seen link-splits-seen result))))))
+ (lp (cdr lot-splits) link-splits-seen result))))))
(define (payment-txn->overpayment-and-invoices txn)
(let lp ((splits (xaccTransGetAPARAcctSplitList txn #f))
commit cbb743175241a28f888e7cd20f30c6c5f5948c17
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 23 22:05:34 2020 +0800
[new-owner-report] LHS payment->RHS invoices show partial amounts
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 460b4f57b..eb72ebc2f 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -607,7 +607,7 @@
overpayment
(if (member invoice invoices)
invoices
- (cons invoice invoices)))))))))
+ (cons (cons invoice split) invoices)))))))))
(define (make-payment->invoices-list txn)
(list
@@ -615,17 +615,18 @@
(apply
gnc:make-html-text
(map
- (lambda (inv)
- (gnc:html-markup-anchor
- (gnc:invoice-anchor-text inv)
- (gncInvoiceGetID inv)))
+ (lambda (inv-split-pair)
+ (let ((inv (car inv-split-pair)))
+ (gnc:html-markup-anchor
+ (gnc:invoice-anchor-text inv)
+ (gncInvoiceGetID inv))))
(cdr (payment-txn->overpayment-and-invoices txn)))))))
(define (make-payment->invoices-table txn)
(define overpayment-and-invoices (payment-txn->overpayment-and-invoices txn))
- (let lp ((invoices (cdr overpayment-and-invoices))
+ (let lp ((invoice-split-pairs (cdr overpayment-and-invoices))
(result '()))
- (match invoices
+ (match invoice-split-pairs
(()
(let ((overpayment (car overpayment-and-invoices)))
(reverse
@@ -635,7 +636,7 @@
(_ "Pre-Payment")
(gnc:make-gnc-monetary currency overpayment))
result)))))
- ((inv . rest)
+ (((inv . APAR-split) . rest)
(let* ((tfr-txn (gncInvoiceGetPostedTxn inv))
(tfr-split (txn->transfer-split tfr-txn)))
(lp rest
@@ -646,11 +647,17 @@
(gnc:invoice-anchor-text inv)
(gncInvoiceGetID inv)))
(gncInvoiceGetTypeString inv)
- (splits->desc (txn->assetliab-splits tfr-txn))
+ (splits->desc (list APAR-split))
(gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text APAR-split)
+ (gnc:make-gnc-monetary
+ currency (AP-negate (- (xaccSplitGetAmount APAR-split)))))
+ " of "
(gnc:html-markup-anchor
(gnc:split-anchor-text tfr-split)
- (gnc:make-gnc-monetary currency (invoice->total inv)))))
+ (gnc:make-gnc-monetary
+ currency (invoice->total inv)))))
result)))))))
(define (invoice->sale invoice)
commit 3866d9bb7c31c80279dbd96dd811a67a9480dee6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jan 23 21:31:04 2020 +0800
[new-owner-report] refactor. separate LHS inv/pmt processing.
1. handle accumulation of totals and printing of balance-b/f row
earlier
2. separate LHS processing into invoice and payment.
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 57aea2856..460b4f57b 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -710,8 +710,22 @@
(gnc:warn "sanity check fail" txn)
(lp printed? odd-row? (cdr splits) total debit credit tax sale))
+ ;; txn-date < start-date. skip display, accumulate amounts
+ ((< (xaccTransGetDate (xaccSplitGetParent (car splits))) start-date)
+ (let* ((txn (xaccSplitGetParent (car splits)))
+ (value (AP-negate (xaccTransGetAccountAmount txn acc))))
+ (lp printed? odd-row? (cdr splits) (+ total value)
+ debit credit tax sale)))
+
+ ;; if balance row hasn't been rendered, consider
+ ;; adding here. skip if value=0.
+ ((not printed?)
+ (let ((print? (and (bal-col used-columns) (not (zero? total)))))
+ (if print? (add-balance-row odd-row? total))
+ (lp #t (not print?) splits total debit credit tax sale)))
+
;; start printing txns.
- (else
+ ((txn-is-invoice? (xaccSplitGetParent (car splits)))
(let* ((split (car splits))
(txn (xaccSplitGetParent split))
(date (xaccTransGetDate txn))
@@ -719,52 +733,57 @@
(value (AP-negate orig-value))
(invoice (gncInvoiceGetInvoiceFromTxn txn)))
- (cond
- ;; txn-date < start-date. skip display, accumulate amounts
- ((< date start-date)
- (lp printed? odd-row? (cdr splits) (+ total value)
- debit credit tax sale))
-
- ;; if balance row hasn't been rendered, consider
- ;; adding here. skip if value=0.
- ((not printed?)
- (let ((print? (and (bal-col used-columns) (not (zero? total)))))
- (if print? (add-balance-row odd-row? total))
- (lp #t (not print?) splits total debit credit tax sale)))
+ (add-row
+ table odd-row? used-columns date (invoice->due-date invoice)
+ (split->reference split)
+ (split->type-str split)
+ (splits->desc (list split))
+ currency (+ total value)
+ (and (< orig-value 0) orig-value)
+ (and (>= orig-value 0) orig-value)
+ (invoice->sale invoice) (invoice->tax invoice)
+ split
+ link-option
+ (case link-option
+ ((simple) (list (list (and (gncInvoiceIsPaid invoice) (_ "Paid")))))
+ ((detailed) (make-invoice->payments-table invoice))
+ (else '(()))))
+
+ (lp printed? (not odd-row?) (cdr splits) (+ total value)
+ (if (< 0 orig-value) (+ debit orig-value) debit)
+ (if (< 0 orig-value) credit (- credit orig-value))
+ (+ tax (or (invoice->tax invoice) 0))
+ (+ sale (or (invoice->sale invoice) 0)))))
+
+ ((txn-is-payment? (xaccSplitGetParent (car splits)))
+ (let* ((split (car splits))
+ (txn (xaccSplitGetParent split))
+ (date (xaccTransGetDate txn))
+ (orig-value (xaccTransGetAccountAmount txn acc))
+ (value (AP-negate orig-value))
+ (invoice (gncInvoiceGetInvoiceFromTxn txn)))
- (else
- (add-row
- table odd-row? used-columns date (invoice->due-date invoice)
- (split->reference split)
- (split->type-str split)
- (splits->desc
- (cond
- ((txn-is-invoice? txn) (list split))
- ((txn-is-payment? txn) (txn->assetliab-splits txn))))
- currency (+ total value)
- (and (< orig-value 0) orig-value)
- (and (>= orig-value 0) orig-value)
- (invoice->sale invoice) (invoice->tax invoice)
- split
- link-option
- (cond
- ((and (txn-is-invoice? txn) (eq? link-option 'simple))
- (if (gncInvoiceIsPaid invoice)
- (list (list (_ "Paid")))
- (list (list #f))))
- ((and (txn-is-invoice? txn) (eq? link-option 'detailed))
- (make-invoice->payments-table invoice))
- ((and (txn-is-payment? txn) (eq? link-option 'simple))
- (make-payment->invoices-list txn))
- ((and (txn-is-payment? txn) (eq? link-option 'detailed))
- (make-payment->invoices-table txn))
- (else '(()))))
-
- (lp printed? (not odd-row?) (cdr splits) (+ total value)
- (if (< 0 orig-value) (+ debit orig-value) debit)
- (if (< 0 orig-value) credit (- credit orig-value))
- (+ tax (or (invoice->tax invoice) 0))
- (+ sale (or (invoice->sale invoice) 0))))))))))
+ (add-row
+ table odd-row? used-columns date (invoice->due-date invoice)
+ (split->reference split)
+ (split->type-str split)
+ (splits->desc (txn->assetliab-splits txn))
+ currency (+ total value)
+ (and (< orig-value 0) orig-value)
+ (and (>= orig-value 0) orig-value)
+ (invoice->sale invoice) (invoice->tax invoice)
+ split
+ link-option
+ (case link-option
+ ((simple) (make-payment->invoices-list txn))
+ ((detailed) (make-payment->invoices-table txn))
+ (else '(()))))
+
+ (lp printed? (not odd-row?) (cdr splits) (+ total value)
+ (if (< 0 orig-value) (+ debit orig-value) debit)
+ (if (< 0 orig-value) credit (- credit orig-value))
+ (+ tax (or (invoice->tax invoice) 0))
+ (+ sale (or (invoice->sale invoice) 0))))))))
(define (options-generator owner-type)
Summary of changes:
.../report/business-reports/new-owner-report.scm | 212 ++++++++++++---------
.../business-reports/test/test-owner-report.scm | 2 +-
2 files changed, 118 insertions(+), 96 deletions(-)
More information about the gnucash-changes
mailing list