gnucash stable: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Mon Apr 1 07:32:03 EDT 2024
Updated via https://github.com/Gnucash/gnucash/commit/9f998892 (commit)
via https://github.com/Gnucash/gnucash/commit/d2263b36 (commit)
from https://github.com/Gnucash/gnucash/commit/ac915f34 (commit)
commit 9f998892b5d010798ac6425218aec476728fad3e
Merge: ac915f34f7 d2263b368a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Apr 1 19:30:50 2024 +0800
Merge branch 'txn-columns' into stable #1880
Report in Experimental submenu
commit d2263b368a84d4013b8d8ded64bcb4e69d8f7096
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Mar 9 09:45:42 2024 +0800
[txn-columns.scm] Transaction Breakdown Report
- retrieves transactions from an account
- distribute splits into accounts
- note if a transaction has 2 or more splits into 1 account, the
transaction account cell will show the sum of the 2 splits
- note if a transaction's currency is different from the account's
currency, both amounts will be shown into the appropriate currency.
[txn-columns] multilevel sorting - type then name
https://code.gnucash.org/logs/2024/03/16.html
diff --git a/gnucash/report/reports/CMakeLists.txt b/gnucash/report/reports/CMakeLists.txt
index 857fdf512c..acb34d80d5 100644
--- a/gnucash/report/reports/CMakeLists.txt
+++ b/gnucash/report/reports/CMakeLists.txt
@@ -45,6 +45,7 @@ set (reports_standard_SCHEME
standard/reconcile-report.scm
standard/transaction.scm
standard/trial-balance.scm
+ standard/txn-columns.scm
standard/view-column.scm
standard/taxinvoice.scm
standard/receipt.scm
diff --git a/gnucash/report/reports/standard/txn-columns.scm b/gnucash/report/reports/standard/txn-columns.scm
new file mode 100644
index 0000000000..16f9cafd9d
--- /dev/null
+++ b/gnucash/report/reports/standard/txn-columns.scm
@@ -0,0 +1,262 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 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 reports standard txn-columns))
+
+(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-26))
+(use-modules (ice-9 match))
+(use-modules (gnucash utilities))
+(use-modules (gnucash report))
+(use-modules (gnucash core-utils))
+(use-modules (gnucash app-utils))
+(use-modules (gnucash engine))
+
+(define reportname (N_ "Transaction Breakdown Report"))
+(define optname-from-date (N_ "Start Date"))
+(define optname-to-date (N_ "End Date"))
+(define optname-account (N_ "Account"))
+(define optname-max-columns (N_ "Limit for number of columns"))
+(define opthelp-max-columns (N_ "Set the upper limit for number of columns"))
+(define optname-desc-filter "Description Filter")
+
+(define (options-generator)
+ (let ((options (gnc-new-optiondb)))
+
+ (gnc:options-add-date-interval!
+ options gnc:pagename-general optname-from-date optname-to-date "a")
+
+ (gnc-register-account-sel-limited-option
+ options gnc:pagename-general optname-account "b" "Account" '() '())
+
+ (gnc-register-string-option
+ options gnc:pagename-general optname-desc-filter "c" "Description Filter" "")
+
+ (gnc-register-number-range-option
+ options gnc:pagename-general optname-max-columns "d" opthelp-max-columns 10 1 100 1)
+
+ options))
+
+
+;; gets an account's fullname as a list eg: '("Asset" "Investments" "Shares")
+(define (acct-get-fullname-list acct)
+ (define root (gnc-book-get-root-account (gnc-get-current-book)))
+ (let lp ((acct acct) (accum '()))
+ (cond
+ ((equal? acct root) accum)
+ (else (lp (gnc-account-get-parent acct)
+ (cons (xaccAccountGetName acct) accum))))))
+
+(define (txn-columns-renderer report-obj)
+
+ (define options (gnc:report-options report-obj))
+
+ (define get-option
+ (cut gnc-optiondb-lookup-value options <> <>))
+
+ (define document (gnc:make-html-document))
+
+ (define to-date
+ (gnc:time64-end-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general optname-to-date))))
+
+ (define from-date
+ (gnc:time64-start-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general optname-from-date))))
+
+ (define account
+ (get-option gnc:pagename-general optname-account))
+
+ (define desc-filter
+ (get-option gnc:pagename-general optname-desc-filter))
+
+ (define opt-max-columns
+ (get-option gnc:pagename-general optname-max-columns))
+
+ (define currency (xaccAccountGetCommodity account))
+
+ (define (desc-filter? txn)
+ (string-contains (xaccTransGetDescription txn) desc-filter))
+
+ (define transactions
+ (cond
+ ((null? account) '())
+ (else (let ((query (qof-query-create-for-splits)))
+ (qof-query-set-book query (gnc-get-current-book))
+ (xaccQueryAddClearedMatch
+ query (logand CLEARED-ALL (lognot CLEARED-VOIDED)) QOF-QUERY-AND)
+ (xaccQueryAddSingleAccountMatch query account QOF-QUERY-AND)
+ (xaccQueryAddDateMatchTT query #t from-date #t to-date QOF-QUERY-AND)
+ (let ((result (filter-map (lambda (split) (let ((txn (xaccSplitGetParent split)))
+ (and (desc-filter? txn) txn)))
+ (xaccQueryGetSplitsUniqueTrans query))))
+ (qof-query-destroy query)
+ result)))))
+
+ (define (account<? a b)
+ (< (xaccAccountOrder a b) 0))
+
+ (define (account->sort-index a)
+ (list-index
+ (cut equal? <> (xaccAccountTypeGetFundamental (xaccAccountGetType a)))
+ (list ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY ACCT-TYPE-EQUITY ACCT-TYPE-EXPENSE ACCT-TYPE-INCOME)))
+
+ (define (account-type<? a b)
+ (< (account->sort-index a) (account->sort-index b)))
+
+ (define accounts
+ (let lp ((transactions transactions) (rv '()))
+ (match transactions
+ (() (stable-sort (sort rv account<?) account-type<?))
+ ((txn . rest)
+ (let lp1 ((txn-splits (xaccTransGetSplitList txn)) (rv rv))
+ (match txn-splits
+ (() (lp rest rv))
+ (((= xaccSplitGetAccount s-acc) . rest-splits)
+ (lp1 rest-splits (if (or (equal? (xaccAccountGetType s-acc) ACCT-TYPE-TRADING)
+ (member s-acc rv))
+ rv
+ (cons s-acc rv))))))))))
+
+ (define num-accounts-found (length accounts))
+
+ (cond
+ ((null? transactions)
+ (gnc:html-document-add-object!
+ document (gnc:html-make-empty-data-warning
+ reportname (gnc:report-id report-obj))))
+
+ ((> num-accounts-found opt-max-columns)
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-generic-warning
+ reportname (gnc:report-id report-obj)
+ (G_ "Too many accounts")
+ (G_ "The number of accounts linked by the transactions found exceeds the limit. \
+Select a different subset of transactions, or increase the limit in the options."))))
+
+ (else
+ (let ((table (gnc:make-html-table))
+ (max-depth (fold (lambda (a b) (max (gnc-account-get-current-depth a) b)) 0 accounts)))
+
+ (define (add-padding-right lst)
+ (let lp ((remaining max-depth) (lst lst) (accum '()))
+ (if (zero? remaining)
+ (reverse accum)
+ (match lst
+ ((head . tail) (lp (1- remaining) tail (cons head accum)))
+ (_ (lp (1- remaining) #f (cons #f accum)))))))
+
+ (gnc:html-table-set-multirow-col-headers!
+ table (apply zip (cons* (add-padding-right '("Date"))
+ (add-padding-right '("Num"))
+ (add-padding-right '("Desc"))
+ (map (compose add-padding-right acct-get-fullname-list) accounts))))
+
+ (let lp ((transactions transactions)
+ (totals (make-list num-accounts-found 0)))
+ (match transactions
+ (()
+ (gnc:html-table-append-row!
+ table
+ (cons* (gnc:make-html-table-cell/size/markup
+ 1 3 "total-label-cell"
+ (gnc:make-html-text
+ (G_ "Total For ")
+ (format #f "~a to ~a" (qof-print-date from-date) (qof-print-date to-date))))
+ (map (lambda (acc total)
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
+ (gnc:make-gnc-monetary (xaccAccountGetCommodity acc) total)))
+ accounts totals))))
+ ((txn . rest-txns)
+ (let lp1 ((accounts accounts)
+ (totals totals)
+ (columns '())
+ (new-totals '())
+ (txn-splits (xaccTransGetSplitList txn)))
+ (match accounts
+ (()
+ (gnc:html-table-append-row!
+ table
+ (cons* (qof-print-date (xaccTransGetDate txn))
+ (xaccTransGetNum txn)
+ (xaccTransGetDescription txn)
+ (reverse columns)))
+ (lp rest-txns (reverse new-totals)))
+ ((acc . rest-accts)
+ (define (is-acc? split)
+ (equal? acc (xaccSplitGetAccount split)))
+ (define (maybe-negate split->num split)
+ (let ((num (split->num split)))
+ (if (gnc-reverse-balance acc) (- num) num)))
+ (let lp2 ((txn-splits txn-splits)
+ (next-txn-splits '())
+ (bal-value #f)
+ (bal-amount #f)
+ (first-split #f))
+ (match txn-splits
+ (()
+ (lp1 rest-accts
+ (cdr totals)
+ (cons (and bal-value
+ (gnc:make-html-table-cell/markup
+ "number-cell"
+ (let* ((txn-currency (xaccTransGetCurrency txn))
+ (acc-commodity (xaccAccountGetCommodity acc))
+ (value-text (gnc:make-gnc-monetary txn-currency bal-value)))
+ (if (equal? acc-commodity txn-currency)
+ (gnc:make-html-text (gnc:html-markup-anchor
+ (gnc:split-anchor-text first-split)
+ value-text))
+ (gnc:make-html-text "[" value-text "] "
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text first-split)
+ (gnc:make-gnc-monetary acc-commodity bal-amount)))))))
+ columns)
+ (cons (+ (car totals) (or bal-amount 0)) new-totals)
+ (reverse next-txn-splits)))
+ (((? is-acc? split) . rest)
+ (lp2 rest next-txn-splits
+ (+ (or bal-value 0) (maybe-negate xaccSplitGetValue split))
+ (+ (or bal-amount 0) (maybe-negate xaccSplitGetAmount split))
+ (or first-split split)))
+ ((this . rest) (lp2 rest (cons this next-txn-splits) bal-value bal-amount first-split))))))))))
+
+ (gnc:html-document-set-title! document (G_ reportname))
+
+ (gnc:html-document-add-object! document (gnc:html-render-options-changed options))
+
+ (gnc:html-document-add-object! document table))))
+
+ document)
+
+
+;; Here we define the actual report
+(gnc:define-report
+ 'version 1
+ 'name reportname
+ 'report-guid "03603f0443494a6fa790b417f35d90d4"
+ 'menu-path (list gnc:menuname-experimental)
+ 'options-generator options-generator
+ 'renderer txn-columns-renderer)
diff --git a/po/POTFILES.in b/po/POTFILES.in
index 4388148293..c2c50a1a2d 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -495,6 +495,7 @@ gnucash/report/reports/standard/register.scm
gnucash/report/reports/standard/taxinvoice.scm
gnucash/report/reports/standard/transaction.scm
gnucash/report/reports/standard/trial-balance.scm
+gnucash/report/reports/standard/txn-columns.scm
gnucash/report/reports/standard/view-column.scm
gnucash/report/reports/support/balsheet-eg.eguile.scm
gnucash/report/reports/support/receipt.eguile.scm
Summary of changes:
gnucash/report/reports/CMakeLists.txt | 1 +
gnucash/report/reports/standard/txn-columns.scm | 262 ++++++++++++++++++++++++
po/POTFILES.in | 1 +
3 files changed, 264 insertions(+)
create mode 100644 gnucash/report/reports/standard/txn-columns.scm
More information about the gnucash-changes
mailing list