gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Wed Jan 29 05:55:48 EST 2020
Updated via https://github.com/Gnucash/gnucash/commit/2adaf692 (commit)
via https://github.com/Gnucash/gnucash/commit/67fbb232 (commit)
via https://github.com/Gnucash/gnucash/commit/b8c71e1e (commit)
via https://github.com/Gnucash/gnucash/commit/c0044f53 (commit)
via https://github.com/Gnucash/gnucash/commit/e65db8df (commit)
via https://github.com/Gnucash/gnucash/commit/074aed94 (commit)
via https://github.com/Gnucash/gnucash/commit/0131780b (commit)
via https://github.com/Gnucash/gnucash/commit/00d00a46 (commit)
from https://github.com/Gnucash/gnucash/commit/3fd7f19f (commit)
commit 2adaf692b844fe9b69199f0d6e9d516e4bb3371b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Jan 28 23:05:18 2020 +0800
[lot-viewer.scm] initial commit
Simple report to visualise lots (business and non-business) in a
spreadsheet. Each column is a unique lot, and each row is a unique
transaction. The lot balance, and the associated lot invoice are also
included.
Each transaction is analysed to render the split in the lot column,
and non-lot splits are rendered in a last column.
An account must be chosen in options, and all splits in the specified
date range will be scanned to find unique lots which are all reported
in order of first appearance.
A heavy APAR account will lead to an impractical number of columns
signifying multiple lots, therefore date-range filtering and
description filtering are both encouraged to narrow down the list of
transactions.
diff --git a/gnucash/report/standard-reports/CMakeLists.txt b/gnucash/report/standard-reports/CMakeLists.txt
index df41fc441..e7e171e8f 100644
--- a/gnucash/report/standard-reports/CMakeLists.txt
+++ b/gnucash/report/standard-reports/CMakeLists.txt
@@ -25,6 +25,7 @@ set (standard_reports_SCHEME_2
general-ledger.scm
income-gst-statement.scm
income-statement.scm
+ lot-viewer.scm
net-charts.scm
portfolio.scm
price-scatter.scm
diff --git a/gnucash/report/standard-reports/lot-viewer.scm b/gnucash/report/standard-reports/lot-viewer.scm
new file mode 100644
index 000000000..01a061007
--- /dev/null
+++ b/gnucash/report/standard-reports/lot-viewer.scm
@@ -0,0 +1,206 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
+;; Boston, MA 02110-1301, USA gnu at gnu.org
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-module (gnucash report standard-reports lot-viewer))
+
+(use-modules (srfi srfi-1))
+(use-modules (ice-9 match))
+(use-modules (gnucash utilities))
+(use-modules (gnucash gnc-module))
+(use-modules (gnucash report business-reports))
+(use-modules (gnucash gettext))
+(use-modules (sw_core_utils)) ;for gnc-prefs-is-extra-enabled
+
+(gnc:module-load "gnucash/report/report-system" 0)
+
+(define reportname (N_ "Lot Viewer"))
+(define optname-from-date (N_ "Start Date"))
+(define optname-to-date (N_ "End Date"))
+(define optname-account (N_ "Account"))
+(define optname-desc-filter (N_ "Desc Filter"))
+
+(define txn-type-alist
+ (list (cons TXN-TYPE-NONE "None")
+ (cons TXN-TYPE-INVOICE "Inv")
+ (cons TXN-TYPE-PAYMENT "Pmt")
+ (cons TXN-TYPE-LINK "Link")))
+
+(define (options-generator)
+ (let ((options (gnc:new-options)))
+
+ (define (add-option new-option)
+ (gnc:register-option options new-option))
+
+ ;; General tab
+ (gnc:options-add-date-interval!
+ options gnc:pagename-general
+ optname-from-date optname-to-date "a")
+
+ (add-option
+ (gnc:make-account-sel-option
+ gnc:pagename-general optname-account "b"
+ (N_ "The account to search for lots.")
+ #f #f))
+
+ (add-option
+ (gnc:make-string-option
+ gnc:pagename-general optname-desc-filter "b" "Description Filter" ""))
+
+ options))
+
+(define (lot-renderer report-obj)
+
+ ;; This is a helper function for looking up option values.
+ (define (get-option section name)
+ (gnc:option-value
+ (gnc:lookup-option (gnc:report-options report-obj) section name)))
+
+ (define (get-all-lots splits)
+ (let lp ((splits splits) (lots '()))
+ (match splits
+ (() (reverse lots))
+ ((split . rest)
+ (let ((lot (xaccSplitGetLot split)))
+ (lp rest
+ (cond
+ ((null? lot) lots)
+ ((member lot lots) lots) ;warning: O(N^2)!
+ (else (cons lot lots)))))))))
+
+ (let* ((to-date (gnc:time64-end-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general optname-to-date))))
+ (from-date (gnc:time64-start-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general optname-from-date))))
+ (account (get-option gnc:pagename-general optname-account))
+ (desc-filter (get-option gnc:pagename-general optname-desc-filter))
+ (desc-filter? (lambda (split)
+ (string-contains
+ (xaccTransGetDescription (xaccSplitGetParent split))
+ desc-filter)))
+ (currency (xaccAccountGetCommodity account))
+ (document (gnc:make-html-document))
+ (splits
+ (let ((query (qof-query-create-for-splits)))
+ (qof-query-set-book query (gnc-get-current-book))
+ (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
+ (xaccQueryAddSingleAccountMatch query account QOF-QUERY-AND)
+ (xaccQueryAddDateMatchTT query #t from-date #t to-date QOF-QUERY-AND)
+ (filter desc-filter? (qof-query-run query))))
+ (transactions
+ (sort-and-delete-duplicates
+ (map xaccSplitGetParent splits)
+ (lambda (a b) (string<? (gncTransGetGUID a) (gncTransGetGUID b)))
+ equal?))
+ (lots (get-all-lots splits))
+ (lots-splits (map gnc-lot-get-split-list lots)))
+
+ (define (amount->monetary amount)
+ (gnc:make-gnc-monetary currency amount))
+
+ (define (elt->cell split)
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text split)
+ (amount->monetary (xaccSplitGetAmount split))))
+
+ (define (list->text lst)
+ (let lp ((lst lst) (result '()))
+ (match lst
+ (() (if (null? result) (gnc:make-html-text ":")
+ (apply gnc:make-html-text result)))
+ ((elt . rest) (lp rest (cons* (elt->cell elt) result))))))
+
+ (define (lot->title lot)
+ (let ((title (gnc-lot-get-title lot)))
+ (if (string-null? title) "None" title)))
+
+ (define (to-cell elt)
+ (gnc:make-html-table-cell/markup "number-cell" elt))
+
+ (define (lot->document lot)
+ (let ((inv (gncInvoiceGetInvoiceFromLot lot)))
+ (and (not (null? inv))
+ (to-cell
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc:invoice-anchor-text inv)
+ (gncInvoiceGetID inv))
+ (gnc:html-markup-br)
+ (string-take (gncInvoiceReturnGUID inv) 8))))))
+
+ (define (lot->balance lot)
+ (to-cell (amount->monetary (gnc-lot-get-balance lot))))
+
+ (cond
+ ((null? splits)
+ (gnc:html-document-add-object!
+ document (gnc:html-make-empty-data-warning
+ reportname (gnc:report-id report-obj))))
+
+ (else
+ (let ((table (gnc:make-html-table)))
+ (gnc:html-table-set-col-headers!
+ table `("Date" "Desc" "Type" ,@(map lot->title lots) "Non-APAR"))
+
+ (gnc:html-table-append-row!
+ table `(#f "Document" #f ,@(map lot->document lots)))
+
+ (for-each
+ (lambda (txn)
+ (gnc:html-table-append-row!
+ table
+ (append
+ (list (qof-print-date (xaccTransGetDate txn))
+ (xaccTransGetDescription txn)
+ (assv-ref txn-type-alist (xaccTransGetTxnType txn)))
+ (let lp ((lots lots)
+ (lots-splits lots-splits)
+ (splits (xaccTransGetSplitList txn))
+ (accum '()))
+ (match lots
+ (() (map (compose to-cell list->text) (reverse (cons splits accum))))
+ ((this-lot . rest-lots)
+ (define (in-lot? s) (member s (car lots-splits)))
+ (let lp1 ((splits splits) (next '()) (this '()))
+ (match splits
+ (() (lp rest-lots (cdr lots-splits) next (cons this accum)))
+ (((? in-lot? head) . tail) (lp1 tail next (cons head this)))
+ ((head . tail) (lp1 tail (cons head next) this))))))))))
+ (sort transactions (lambda (a b) (< (xaccTransOrder a b) 0))))
+
+ (gnc:html-table-append-row!
+ table `(#f "Balance" #f ,@(map lot->balance lots)))
+
+ (gnc:html-document-add-object! document table))))
+
+ document))
+
+
+;; Here we define the actual report
+(gnc:define-report
+ 'version 1
+ 'name reportname
+ 'report-guid "b64b8cbaa633472c93ab7d9a2424d157"
+ 'menu-path (list gnc:menuname-experimental)
+ 'options-generator options-generator
+ 'in-menu? (gnc-prefs-is-extra-enabled)
+ 'renderer lot-renderer)
diff --git a/po/POTFILES.in b/po/POTFILES.in
index d564198eb..790cb84f3 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -486,6 +486,7 @@ gnucash/report/standard-reports/general-journal.scm
gnucash/report/standard-reports/general-ledger.scm
gnucash/report/standard-reports/income-gst-statement.scm
gnucash/report/standard-reports/income-statement.scm
+gnucash/report/standard-reports/lot-viewer.scm
gnucash/report/standard-reports/net-charts.scm
gnucash/report/standard-reports/portfolio.scm
gnucash/report/standard-reports/price-scatter.scm
commit 67fbb2322cfe4d27b6bcbd8452e8003fa41cd2ad
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jan 29 06:00:46 2020 +0800
[new-owner-report] remove unused code
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index eae206fdc..c581d02a3 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -304,20 +304,6 @@
((txn-is-link? txn) (_ "Link"))
(else (_ "Unknown")))))
-;; for splits, find the first peer that is not in an APAR
-;; account. this is adequate to find the transfer split (ie
-;; asset/liability/income/expense account split). lot-link txns are
-;; not expected to have any non-APAR split therefore returns #f.
-(define (txn->transfer-split txn)
- (find
- (compose (negate xaccAccountIsAPARType) xaccAccountGetType xaccSplitGetAccount)
- (xaccTransGetSplitList txn)))
-
-(define (txn->assetliab-splits txn)
- (filter
- (compose xaccAccountIsAssetLiabType xaccAccountGetType xaccSplitGetAccount)
- (xaccTransGetSplitList txn)))
-
;; input: list of html-text elements
;; output: a cell with html-text interleaved with <br> tags
(define (list->cell lst)
commit b8c71e1e4fe81f44302efb8fb4b0a7a2ebf5a831
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jan 29 00:34:15 2020 +0800
[new-owner-report] inline single-use invoice accessors
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 3ad96ebfb..eae206fdc 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -754,26 +754,6 @@
(append invoices-list payments-list overpayment-list))
- (define (invoice->sale invoice)
- (and (not (null? invoice))
- ((if (gncInvoiceGetIsCreditNote invoice) - identity)
- (gncInvoiceGetTotalSubtotal invoice))))
-
- (define (invoice->tax invoice)
- (and (not (null? invoice))
- ((if (gncInvoiceGetIsCreditNote invoice) - identity)
- (gncInvoiceGetTotalTax invoice))))
-
- (define (invoice->total invoice)
- (and (not (null? invoice))
- ((if (gncInvoiceGetIsCreditNote invoice) - identity)
- (gncInvoiceGetTotal invoice))))
-
- (define (invoice->due-date invoice)
- (and (not (null? invoice))
- (gncInvoiceIsPosted invoice)
- (gncInvoiceGetDateDue invoice)))
-
(define (amount->anchor split amount)
(gnc:make-html-text
(gnc:html-markup-anchor
@@ -841,15 +821,18 @@
(value (AP-negate orig-value))
(invoice (gncInvoiceGetInvoiceFromTxn txn)))
+ (define (CN-negate fn)
+ (if (gncInvoiceGetIsCreditNote invoice) (- (fn invoice)) (fn invoice)))
+
(add-row
- table odd-row? used-columns date (invoice->due-date invoice)
+ table odd-row? used-columns date (gncInvoiceGetDateDue invoice)
(split->reference split)
(split->type-str split)
(splits->desc (list split))
currency (+ total value)
(and (>= orig-value 0) (amount->anchor split orig-value))
(and (< orig-value 0) (amount->anchor split (- orig-value)))
- (invoice->sale invoice) (invoice->tax invoice)
+ (CN-negate gncInvoiceGetTotalSubtotal) (CN-negate gncInvoiceGetTotalTax)
(gncInvoiceReturnGUID invoice)
link-option
(case link-option
@@ -860,8 +843,8 @@
(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 (invoice->tax invoice))
- (+ sale (invoice->sale invoice)))))
+ (+ tax (CN-negate gncInvoiceGetTotalTax))
+ (+ sale (CN-negate gncInvoiceGetTotalSubtotal)))))
((txn-is-payment? (xaccSplitGetParent (car splits)))
(let* ((split (car splits))
commit c0044f533956432a7192a3cab627b2b0698b13cc
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jan 29 00:46:48 2020 +0800
[new-owner-report] LHS invoice->RHS payments rewritten
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 96d454f6c..3ad96ebfb 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -301,6 +301,7 @@
(cond
((txn-is-invoice? txn) (gncInvoiceGetTypeString invoice))
((txn-is-payment? txn) (_ "Payment"))
+ ((txn-is-link? txn) (_ "Link"))
(else (_ "Unknown")))))
;; for splits, find the first peer that is not in an APAR
@@ -317,14 +318,16 @@
(compose xaccAccountIsAssetLiabType xaccAccountGetType xaccSplitGetAccount)
(xaccTransGetSplitList txn)))
-(define (splits->desc splits)
- (let lp ((splits splits) (result '()))
- (match splits
+;; input: list of html-text elements
+;; output: a cell with html-text interleaved with <br> tags
+(define (list->cell lst)
+ (let lp ((lst lst) (result '()))
+ (match lst
(() (apply gnc:make-html-text result))
- ((split . rest)
- (lp rest (cons* (gnc:html-string-sanitize (xaccSplitGetMemo split))
- (gnc:html-markup-br)
- result))))))
+ ((elt . rest) (lp rest (cons* elt (gnc:html-markup-br) result))))))
+
+(define (splits->desc splits)
+ (list->cell (map (compose gnc:html-string-sanitize xaccSplitGetMemo) splits)))
(define (make-aging-table splits to-date payable? date-type currency)
(let ((table (gnc:make-html-table))
@@ -564,24 +567,8 @@
((detailed) (list (make-link-blank))))))
(define (make-invoice->payments-table invoice)
- (define (posting-split->row posting-split)
- (let* ((posting-txn (xaccSplitGetParent posting-split))
- (inv (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot posting-split))))
- (make-link-data
- (qof-print-date (xaccTransGetDate posting-txn))
- (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))
- (gnc:make-gnc-monetary
- currency (AP-negate (xaccSplitGetAmount posting-split)))))
- (gncInvoiceReturnGUID inv))))
(let ((lot (gncInvoiceGetPostedLot invoice)))
(let lp ((lot-splits (gnc-lot-get-split-list lot))
- (link-splits-seen '())
(result '()))
(cond
;; Finished result rows. Display them, and add Outstanding if
@@ -597,63 +584,93 @@
(gncInvoiceReturnGUID invoice))
result))))
- ;; 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)))
- (lp (cdr lot-splits)
- link-splits-seen
- (cons (let* ((lot-split (car lot-splits))
- (lot-txn (xaccSplitGetParent lot-split))
- (pmt-splits (xaccTransGetPaymentAcctSplitList lot-txn)))
- (make-link-data
- (qof-print-date (xaccTransGetDate lot-txn))
- (split->reference lot-split)
- (split->type-str lot-split)
- (splits->desc pmt-splits)
- (gnc:make-html-text (split->anchor lot-split #t))
- (let lp1 ((pmt-splits pmt-splits) (acc '()))
- (match pmt-splits
- (() (apply gnc:make-html-text acc))
- ((pmt-split . rest)
- (lp1 rest (cons* (split->anchor pmt-split #f)
- (gnc:html-markup-br)
- acc)))))
- (gncTransGetGUID lot-txn)))
- result)))
-
- ;; This is a lot link split. Find corresponding documents,
- ;; and add to result rows.
- ((txn-is-link? (xaccSplitGetParent (car lot-splits)))
- (let lp1 ((link-splits (xaccTransGetSplitList
- (xaccSplitGetParent (car lot-splits))))
- (link-splits-seen link-splits-seen)
- (result result))
- ;; this is a secondary 'inner loop', looping
- ;; lot-split->peer-splits.
- (cond
- ;; finished peer-splits. loop main lot-splits.
- ((null? link-splits)
- (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)))
- (lp1 (cdr link-splits) link-splits-seen result))
- ;; we've encountered this peer-split before. skip.
- ((member (car link-splits) link-splits-seen)
- (lp1 (cdr link-splits) link-splits-seen result))
- ;; new peer-split. render the posting split details.
- ((lot-split->posting-split (car link-splits))
- => (lambda (posting-split)
- (lp1 (cdr link-splits)
- (cons (car link-splits) link-splits-seen)
- (cons (posting-split->row posting-split) result))))
- ;; can't find posting split. probably invalid txn. skip.
- (else (lp1 (cdr link-splits) link-splits-seen result)))))
-
- ;; This is either the invoice posting transaction, or a
- ;; TXN-TYPE-NONE txn which shouldn't happen. Skip both.
+ ;; this is invoice posting split. skip. has no payment data.
+ ((equal? (xaccSplitGetParent (car lot-splits))
+ (gncInvoiceGetPostedTxn invoice))
+ (lp (cdr lot-splits) result))
+
+ ;; this is an invoice payment split (reduces the lot).
(else
- (lp (cdr lot-splits) link-splits-seen result))))))
+ (let* ((lot-split (car lot-splits))
+ (lot-txn (xaccSplitGetParent lot-split)))
+
+ ;; each invoice payment split's peer splits are analysed.
+ (let lp1 ((lot-txn-splits (xaccTransGetSplitList lot-txn))
+ (non-APAR '())
+ (result result))
+ (cond
+
+ ;; finished. loop up, adding single row with non-APAR
+ ((null? lot-txn-splits)
+ (lp (cdr lot-splits)
+ (if (null? non-APAR)
+ result
+ (cons (make-link-data
+ (qof-print-date (xaccTransGetDate lot-txn))
+ (split->reference lot-split)
+ (split->type-str lot-split)
+ (splits->desc non-APAR)
+ (gnc:make-html-text (split->anchor lot-split #t))
+ (list->cell
+ (map (lambda (s) (split->anchor s #f)) non-APAR))
+ (gncTransGetGUID lot-txn))
+ result))))
+
+ ;; this payment peer is non-APAR, accumulate it.
+ ((not (memv (xaccAccountGetType
+ (xaccSplitGetAccount (car lot-txn-splits)))
+ (list ACCT-TYPE-RECEIVABLE ACCT-TYPE-PAYABLE)))
+ (lp1 (cdr lot-txn-splits)
+ (cons (car lot-txn-splits) non-APAR)
+ result))
+
+ ;; this payment's peer split has same sign as the
+ ;; payment split. ignore.
+ ((sign-equal? (xaccSplitGetAmount (car lot-txn-splits))
+ (xaccSplitGetAmount lot-split))
+ (lp1 (cdr lot-txn-splits) non-APAR result))
+
+ ;; this payment's peer APAR split is a document lot
+ ;; reducing split.
+ ((lot-split->posting-split (car lot-txn-splits)) =>
+ (lambda (posting-split)
+ (let ((lot-txn-split (car lot-txn-splits))
+ (invoice (gncInvoiceGetInvoiceFromTxn
+ (xaccSplitGetParent posting-split)))
+ (posting-txn (xaccSplitGetParent posting-split)))
+ (lp1 (cdr lot-txn-splits)
+ non-APAR
+ (cons (make-link-data
+ (qof-print-date (xaccTransGetDate posting-txn))
+ (split->reference posting-split)
+ (split->type-str posting-split)
+ (splits->desc (list posting-split))
+ (gnc:make-html-text (split->anchor lot-txn-split #t))
+ (gnc:make-html-text (split->anchor posting-split #f))
+ (gncInvoiceReturnGUID invoice))
+ result)))))
+
+ ;; this payment's peer APAR split can't find
+ ;; document. this likely is an old style link txn. RHS
+ ;; show transaction only.
+ (else
+ (gnc:warn (car lot-txn-splits) " in APAR but can't find "
+ "owner; is likely an old-style link transaction.")
+ (let* ((lot-txn-split (car lot-txn-splits))
+ (posting-txn (xaccSplitGetParent lot-txn-split)))
+ (lp1 (cdr lot-txn-splits)
+ non-APAR
+ (cons (make-link-data
+ (qof-print-date (xaccTransGetDate posting-txn))
+ (split->reference lot-txn-split)
+ (split->type-str lot-txn-split)
+ (splits->desc (list lot-txn-split))
+ (gnc:make-html-text (split->anchor lot-txn-split #t))
+ (gnc:make-html-text (split->anchor lot-txn-split #t))
+ (gncTransGetGUID posting-txn))
+ result))))))))))))
+
+
(define (payment-txn->payment-info txn)
(let lp ((splits (xaccTransGetAPARAcctSplitList txn #f))
@@ -730,7 +747,7 @@
(split->reference s)
(split->type-str s)
(splits->desc (list s))
- (gnc:make-html-text (split->anchor s #t))
+ (gnc:make-html-text (split->anchor s #f))
(gnc:make-html-text (split->anchor s #f))
(gncTransGetGUID (xaccSplitGetParent s))))
(payment-info-opposing-splits payment-info)))
commit e65db8df4a6416865cc9706c331c345c2443a37e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jan 26 11:44:55 2020 +0800
[new-owner-report] RHS Pre-Payment and UNPAID get link-id highlights
They are related to the LHS invoice or payment.
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index fa1703eb7..96d454f6c 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -116,10 +116,11 @@
(rhs-class link-data-rhs-class))
(define-record-type :link-desc-amount
- (make-link-desc-amount desc amount)
+ (make-link-desc-amount desc amount rhs-class)
link-desc-amount?
(desc link-desc-amount-desc)
- (amount link-desc-amount-amount))
+ (amount link-desc-amount-amount)
+ (rhs-class link-desc-amount-rhs-class))
(define-record-type :link-blank
(make-link-blank)
@@ -403,11 +404,25 @@
((link-desc-amount? link-data)
(let ((cols (num-cols column-vector 'rhs-span)))
(append
- (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/size/markup
- 1 2 "number-cell" (link-desc-amount-amount link-data))))))
+ (map
+ (lambda (str)
+ (let ((cell (gnc:make-html-table-cell/size 1 cols str))
+ (rhs-class (link-desc-amount-rhs-class link-data)))
+ (when rhs-class
+ (gnc:html-table-cell-set-style!
+ cell "td" 'attribute (list "link-id" rhs-class)))
+ cell))
+ (addif (< 0 cols) (link-desc-amount-desc link-data)))
+ (map
+ (lambda (str)
+ (let ((cell (gnc:make-html-table-cell/size/markup 1 2 "number-cell" str))
+ (rhs-class (link-desc-amount-rhs-class link-data)))
+ (when rhs-class
+ (gnc:html-table-cell-set-style!
+ cell "number-cell" 'attribute (list "link-id" rhs-class)))
+ cell))
+ (addif (or (debit-col column-vector) (credit-col column-vector))
+ (link-desc-amount-amount link-data))))))
((link-blank? link-data)
(make-list (num-cols column-vector 'rhs-cols) #f))
@@ -578,7 +593,8 @@
(cons (make-link-desc-amount
(_ "UNPAID")
(gnc:make-gnc-monetary
- currency (AP-negate (gnc-lot-get-balance lot))))
+ currency (AP-negate (gnc-lot-get-balance lot)))
+ (gncInvoiceReturnGUID invoice))
result))))
;; This is the regular payment split. Find Transfer acct
@@ -703,7 +719,8 @@
'()
(list (make-link-desc-amount
(_ "Pre-Payment")
- (gnc:make-gnc-monetary currency overpayment))))))
+ (gnc:make-gnc-monetary currency overpayment)
+ (gncTransGetGUID txn))))))
(define payments-list
(map
commit 074aed940eac089eb40b8aeadf62e0a674ce9e4f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jan 29 00:32:23 2020 +0800
[new-owner-report] payment-info has 3 components now
* overpayment, a number
* invoice-split-pairs, a list of (cons invoice posting-split) pairs
* opposing-splits, a list of opposing-sign splits
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 4c1122e79..fa1703eb7 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -125,6 +125,13 @@
(make-link-blank)
link-blank?)
+(define-record-type :payment-info
+ (make-payment-info overpayment invoices opposing-splits)
+ payment-info?
+ (overpayment payment-info-overpayment)
+ (invoices payment-info-invoices)
+ (opposing-splits payment-info-opposing-splits))
+
;; Names in Option panel (Untranslated! Because it is used for option
;; naming and lookup only, and the display of the option name will be
;; translated somewhere else.)
@@ -632,16 +639,31 @@
(else
(lp (cdr lot-splits) link-splits-seen result))))))
- (define (payment-txn->overpayment-and-invoices txn)
+ (define (payment-txn->payment-info txn)
(let lp ((splits (xaccTransGetAPARAcctSplitList txn #f))
(overpayment 0)
- (invoices '()))
+ (invoices '())
+ (opposing-splits '()))
(match splits
- (() (cons (AP-negate overpayment) invoices))
+ (() (make-payment-info (AP-negate overpayment) invoices opposing-splits))
((split . rest)
- (match (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot split))
- (() (lp rest (- overpayment (xaccSplitGetAmount split)) invoices))
- (invoice (lp rest overpayment (cons (cons invoice split) invoices))))))))
+ (let ((lot (xaccSplitGetLot split)))
+ (define (equal-to-split? s) (equal? s split))
+ (match (gncInvoiceGetInvoiceFromLot lot)
+ (() (lp rest
+ (- overpayment (gnc-lot-get-balance lot))
+ invoices
+ (let lp ((lot-splits (gnc-lot-get-split-list lot))
+ (acc opposing-splits))
+ (match lot-splits
+ (() acc)
+ (((? equal-to-split?) . rest) (lp rest acc))
+ ((lot-split . rest) (lp rest (cons lot-split acc)))))))
+ (inv
+ (lp rest
+ overpayment
+ (cons (cons inv split) invoices)
+ opposing-splits))))))))
(define (make-payment->invoices-list txn)
(list
@@ -651,34 +673,52 @@
(map
(lambda (inv-split-pair)
(invoice->anchor (car inv-split-pair)))
- (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 ((invoice-split-pairs (cdr overpayment-and-invoices))
- (result '()))
- (match invoice-split-pairs
- (()
- (let ((overpayment (car overpayment-and-invoices)))
- (reverse
- (if (zero? overpayment)
- result
- (cons (make-link-desc-amount
- (_ "Pre-Payment")
- (gnc:make-gnc-monetary currency overpayment))
- result)))))
- (((inv . APAR-split) . rest)
- (let* ((posting-split (lot-split->posting-split APAR-split)))
- (lp rest
- (cons (make-link-data
- (qof-print-date (gncInvoiceGetDatePosted inv))
- (gnc:make-html-text (invoice->anchor inv))
- (gncInvoiceGetTypeString inv)
- (splits->desc (list APAR-split))
- (gnc:make-html-text (split->anchor APAR-split #t))
- (gnc:make-html-text (split->anchor posting-split #f))
- (gncInvoiceReturnGUID inv))
- result)))))))
+ (payment-info-invoices (payment-txn->payment-info txn)))))))
+
+ (define (make-payment->payee-table txn)
+
+ (define payment-info (payment-txn->payment-info txn))
+
+ (define invoices-list
+ (let lp ((invoice-split-pairs (payment-info-invoices payment-info))
+ (result '()))
+ (match invoice-split-pairs
+ (() result)
+ (((inv . APAR-split) . rest)
+ (let* ((posting-split (lot-split->posting-split APAR-split)))
+ (lp rest
+ (cons (make-link-data
+ (qof-print-date (gncInvoiceGetDatePosted inv))
+ (gnc:make-html-text (invoice->anchor inv))
+ (gncInvoiceGetTypeString inv)
+ (splits->desc (list APAR-split))
+ (gnc:make-html-text (split->anchor APAR-split #t))
+ (gnc:make-html-text (split->anchor posting-split #f))
+ (gncInvoiceReturnGUID inv))
+ result)))))))
+
+ (define overpayment-list
+ (let ((overpayment (payment-info-overpayment payment-info)))
+ (if (zero? overpayment)
+ '()
+ (list (make-link-desc-amount
+ (_ "Pre-Payment")
+ (gnc:make-gnc-monetary currency overpayment))))))
+
+ (define payments-list
+ (map
+ (lambda (s)
+ (make-link-data
+ (qof-print-date (xaccTransGetDate (xaccSplitGetParent s)))
+ (split->reference s)
+ (split->type-str s)
+ (splits->desc (list s))
+ (gnc:make-html-text (split->anchor s #t))
+ (gnc:make-html-text (split->anchor s #f))
+ (gncTransGetGUID (xaccSplitGetParent s))))
+ (payment-info-opposing-splits payment-info)))
+
+ (append invoices-list payments-list overpayment-list))
(define (invoice->sale invoice)
(and (not (null? invoice))
@@ -714,6 +754,7 @@
(credit 0)
(tax 0)
(sale 0))
+
(cond
((null? splits)
@@ -808,7 +849,7 @@
link-option
(case link-option
((simple) (make-payment->invoices-list txn))
- ((detailed) (make-payment->invoices-table txn))
+ ((detailed) (make-payment->payee-table txn))
(else '(()))))
(lp printed? (not odd-row?) (cdr splits) (+ total value)
commit 0131780b3028e04b332fab0fa10b8d66a8e78c2e
Author: Geert Janssens <geert at kobaltwit.be>
Date: Mon Jan 27 11:53:16 2020 +0100
Add guile function to extract a lot's guid
Useful for debugging lot issues in reports.
diff --git a/libgnucash/engine/business-core.i b/libgnucash/engine/business-core.i
index 5ceb8e51e..7d61460a7 100644
--- a/libgnucash/engine/business-core.i
+++ b/libgnucash/engine/business-core.i
@@ -52,6 +52,9 @@ static GncGUID gncCustomerReturnGUID(GncCustomer *x)
static GncGUID gncEmployeeReturnGUID(GncEmployee *x)
{ return (x ? *(qof_instance_get_guid(QOF_INSTANCE(x))) : *(guid_null())); }
+static GncGUID gncLotReturnGUID(GNCLot *x)
+{ return (x ? *(qof_instance_get_guid(QOF_INSTANCE(x))) : *(guid_null())); }
+
static GncTaxTable * gncTaxTableLookupFlip(GncGUID g, QofBook *b)
{ return gncTaxTableLookup(b, &g); }
commit 00d00a465090107acaad95080d9c40be7e76afee
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Jan 27 06:38:33 2020 +0800
[report-utilities] fix overpayments calc
overpayment is lot->balance rather than split->amount.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 9f40770eb..1c595a673 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1169,15 +1169,14 @@ flawed. see report-utilities.scm. please update reports.")
TXN-TYPE-PAYMENT)
(let* ((txn (xaccSplitGetParent (car splits)))
(splitlist (xaccTransGetAPARAcctSplitList txn #f))
- (payment (apply + (map xaccSplitGetAmount splitlist)))
(overpayment
(fold
(lambda (a b)
(if (null? (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot a)))
- (- b (xaccSplitGetAmount a))
+ (- b (gnc-lot-get-balance (xaccSplitGetLot a)))
b))
0 splitlist)))
- (gnc:msg "next " (gnc:strify (car splits)) " payment " payment
+ (gnc:msg "next " (gnc:strify (car splits))
" overpayment " overpayment)
(addbucket! (1- num-buckets) (if receivable? (- overpayment) overpayment))
(lp (cdr splits))))
Summary of changes:
.../report/business-reports/new-owner-report.scm | 364 ++++++++++++---------
gnucash/report/report-system/report-utilities.scm | 5 +-
gnucash/report/standard-reports/CMakeLists.txt | 1 +
gnucash/report/standard-reports/lot-viewer.scm | 206 ++++++++++++
libgnucash/engine/business-core.i | 3 +
po/POTFILES.in | 1 +
6 files changed, 417 insertions(+), 163 deletions(-)
create mode 100644 gnucash/report/standard-reports/lot-viewer.scm
More information about the gnucash-changes
mailing list