gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Wed May 1 07:15:36 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/653d8cb5 (commit)
via https://github.com/Gnucash/gnucash/commit/ff3a3471 (commit)
via https://github.com/Gnucash/gnucash/commit/b87d693a (commit)
via https://github.com/Gnucash/gnucash/commit/14b32559 (commit)
from https://github.com/Gnucash/gnucash/commit/29416292 (commit)
commit 653d8cb5c3ba4b65bba29cb009452dcc922a9168
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Apr 26 21:16:14 2019 +0800
[general-ledger] remove dependency on transaction.scm
diff --git a/gnucash/report/standard-reports/general-ledger.scm b/gnucash/report/standard-reports/general-ledger.scm
index 2e2231695..521b89263 100644
--- a/gnucash/report/standard-reports/general-ledger.scm
+++ b/gnucash/report/standard-reports/general-ledger.scm
@@ -34,7 +34,6 @@
(use-modules (gnucash utilities))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash report standard-reports transaction))
(gnc:module-load "gnucash/report/report-system" 0)
@@ -52,7 +51,7 @@
;; options generator
(define (general-ledger-options-generator)
- (let* ((options (trep-options-generator)))
+ (let ((options (gnc:trep-options-generator)))
(define pagename-sorting (N_ "Sorting"))
(define (set-option! section name value)
commit ff3a34711a5af7a7d3026fc26b9f5498932035ae
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Apr 26 21:17:33 2019 +0800
[income-gst-statement] remove dependency on transaction.scm
diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm
index b85eb9ebf..be947db4c 100644
--- a/gnucash/report/standard-reports/income-gst-statement.scm
+++ b/gnucash/report/standard-reports/income-gst-statement.scm
@@ -32,7 +32,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(gnc:module-load "gnucash/report/report-system" 0)
-(use-modules (gnucash report standard-reports transaction))
;; Define the strings here to avoid typos and make changes easier.
(define reportname (N_ "Income and GST Statement"))
@@ -57,11 +56,12 @@ accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY fo
(gnc:html-markup-br)
(gnc:html-markup-br)))
-(define (income-gst-statement-renderer rpt)
- (trep-renderer rpt
- #:custom-calculated-cells gst-calculated-cells
- #:empty-report-message TAX-SETUP-DESC
- #:custom-split-filter gst-custom-split-filter))
+(define (gst-statement-renderer rpt)
+ (gnc:trep-renderer
+ rpt
+ #:custom-calculated-cells gst-calculated-cells
+ #:empty-report-message TAX-SETUP-DESC
+ #:custom-split-filter gst-custom-split-filter))
(define (gst-custom-split-filter split)
;; split -> bool
@@ -74,7 +74,7 @@ accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY fo
(define (gst-statement-options-generator)
;; Retrieve the list of options specified within the transaction report
- (define options (trep-options-generator))
+ (define options (gnc:trep-options-generator))
;; Delete Accounts selector
(gnc:unregister-option options gnc:pagename-accounts (N_ "Accounts"))
@@ -112,7 +112,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
(list (N_ "Net Balance") "t" (N_ "Display the net balance (sales without tax - purchases without tax)") #f)
(list (N_ "Tax payable") "u" (N_ "Display the tax payable (tax on sales - tax on purchases)") #f)))
- ;; Enable secret option to delete transactions with >1 split
+ ;; Enable option to retrieve unique transactions only
(gnc:option-set-value (gnc:lookup-option options "__trep" "unique-transactions") #t)
;; Disable account filtering
(gnc:option-make-internal! options gnc:pagename-accounts "Filter Type")
@@ -134,48 +134,45 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
(define (gst-calculated-cells options)
(define (opt-val section name)
- (let ((option (gnc:lookup-option options section name)))
- (if option
- (gnc:option-value option)
- (gnc:error "gnc:lookup-option error: " section "/" name))))
+ (gnc:option-value (gnc:lookup-option options section name)))
+ (define (accfilter accounts type)
+ (filter
+ (lambda (acc)
+ (eqv? (xaccAccountGetType acc) type))
+ accounts))
(letrec*
- ((myadd (lambda (X Y) (if X (if Y (gnc:monetary+ X Y) X) Y))) ; custom monetary adder which understands #f
- (myneg (lambda (X) (and X (gnc:monetary-neg X)))) ; custom monetary negator which understands #f
+ ((myadd (lambda (X Y) (if X (if Y (gnc:monetary+ X Y) X) Y)))
+ (myneg (lambda (X) (and X (gnc:monetary-neg X))))
(accounts (opt-val gnc:pagename-accounts "Accounts"))
(tax-accounts (opt-val gnc:pagename-accounts "Tax Accounts"))
- (accounts-tax-collected (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-LIABILITY)) tax-accounts))
- (accounts-tax-paid (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-ASSET)) tax-accounts))
- (accounts-sales (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-INCOME)) accounts))
- (accounts-purchases (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-EXPENSE)) accounts))
- (common-currency (and (opt-val gnc:pagename-general "Common Currency") ; if a common currency was specified,
- (opt-val gnc:pagename-general "Report's currency"))) ; use it
- (split-date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
- (split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
+ (accounts-tax-collected (accfilter tax-accounts ACCT-TYPE-LIABILITY))
+ (accounts-tax-paid (accfilter tax-accounts ACCT-TYPE-ASSET))
+ (accounts-sales (accfilter accounts ACCT-TYPE-INCOME))
+ (accounts-purchases (accfilter accounts ACCT-TYPE-EXPENSE))
+ (common-currency (and (opt-val gnc:pagename-general "Common Currency")
+ (opt-val gnc:pagename-general "Report's currency")))
+ (split->date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
+ (split->currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
(split-adder (lambda (split accountlist)
- (let* (;; 1. from split, get the trans
- (transaction (xaccSplitGetParent split))
- ;; 2. from trans, get all splits
- (splits-in-transaction (xaccTransGetSplitList transaction))
- ;; 3. but only from accounts specified
- (include-split? (lambda (s) (member (xaccSplitGetAccount s) accountlist)))
- (filtered-splits (filter include-split? splits-in-transaction))
- ;; 4. get the filtered split amount
- (split-get-monetary (lambda (s)
- (gnc:make-gnc-monetary
- (split-currency s)
- (if (xaccTransGetVoidStatus transaction)
- (xaccSplitVoidFormerAmount s)
- (xaccSplitGetAmount s)))))
- ;; 5. amount - always convert to
- ;; either report currency or the original split currency
- (split-monetary-converted (lambda (s)
- (gnc:exchange-by-pricedb-nearest
- (split-get-monetary s)
- (or common-currency
- (split-currency split))
- (time64CanonicalDayTime
- (split-date s)))))
- (list-of-values (map split-monetary-converted filtered-splits)))
+ (let* ((txn (xaccSplitGetParent split))
+ (filtered-splits (filter
+ (lambda (s)
+ (member (xaccSplitGetAccount s)
+ accountlist))
+ (xaccTransGetSplitList txn)))
+ (split->monetary (lambda (s)
+ (gnc:make-gnc-monetary
+ (split->currency s)
+ (if (xaccTransGetVoidStatus txn)
+ (xaccSplitVoidFormerAmount s)
+ (xaccSplitGetAmount s)))))
+ (split->converted
+ (lambda (s)
+ (gnc:exchange-by-pricedb-nearest
+ (split->monetary s)
+ (or common-currency (split->currency split))
+ (time64CanonicalDayTime (split->date s)))))
+ (list-of-values (map split->converted filtered-splits)))
(fold myadd #f list-of-values))))
(account-adder (lambda (acc) (lambda (s) (split-adder s (list acc)))))
(account-adder-neg (lambda (acc) (lambda (s) (myneg (split-adder s (list acc))))))
@@ -283,4 +280,4 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
'name reportname
'report-guid "5bf27f249a0d11e7abc4cec278b6b50a"
'options-generator gst-statement-options-generator
- 'renderer income-gst-statement-renderer)
+ 'renderer gst-statement-renderer)
commit b87d693a77d89e8c55bc76c0587d287e093c2f75
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Apr 26 21:17:13 2019 +0800
[trep-engine] modularise trep-engine
diff --git a/gnucash/report/report-system/CMakeLists.txt b/gnucash/report/report-system/CMakeLists.txt
index a06f4c43b..9fee1071a 100644
--- a/gnucash/report/report-system/CMakeLists.txt
+++ b/gnucash/report/report-system/CMakeLists.txt
@@ -76,6 +76,7 @@ set (report_system_SCHEME_3
options-utilities.scm
report-utilities.scm
report.scm
+ trep-engine.scm
)
set(GUILE_DEPENDS
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 9ce7da797..387135e51 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -743,6 +743,10 @@
(export gnc:strify)
(export gnc:pk)
+;; trep-engine.scm
+(export gnc:trep-options-generator)
+(export gnc:trep-renderer)
+
(load-from-path "commodity-utilities")
(load-from-path "html-barchart")
(load-from-path "html-document")
@@ -761,5 +765,6 @@
(load-from-path "options-utilities")
(load-from-path "report-utilities")
(load-from-path "report")
+(load-from-path "trep-engine")
(gnc-hook-add-scm-dangler HOOK-SAVE-OPTIONS gnc:save-style-sheet-options)
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/report-system/trep-engine.scm
similarity index 55%
copy from gnucash/report/standard-reports/transaction.scm
copy to gnucash/report/report-system/trep-engine.scm
index d1b3b94fa..b4947700b 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/report-system/trep-engine.scm
@@ -1,5 +1,5 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; transaction-report.scm : Report on all transactions in account(s)
+;; trep-engine.scm : Transaction Report engine
;;
;; Original report by Robert Merkel <rgmerk at mira.net>
;; Contributions by Bryan Larsen <blarsen at ada-works.com>
@@ -15,21 +15,20 @@
;; - common currency - optionally show original currency amount
;; and enable multiple data columns
;; - add support for indenting for better grouping
-;; - add defaults suitable for a reconciliation report
-;; including alternative date filtering strategy
;; - add subtotal summary grid
;; - by default, exclude closing transactions from the report
+;; - converted to module in 2019
+;;
+;; 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.
;;
-;; 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:
;;
@@ -39,20 +38,11 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-module (gnucash report standard-reports transaction))
-
-(use-modules (gnucash utilities))
-(use-modules (srfi srfi-1))
-(use-modules (srfi srfi-11))
-(use-modules (srfi srfi-13))
-(use-modules (ice-9 regex))
-(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-
-(gnc:module-load "gnucash/report/report-system" 0)
+(use-modules (srfi srfi-11))
+(use-modules (srfi srfi-1))
;; Define the strings here to avoid typos and make changes easier.
-(define reportname (N_ "Transaction Report"))
;;Accounts
(define optname-accounts (N_ "Accounts"))
@@ -73,7 +63,8 @@
(define optname-show-account-code (N_ "Show Account Code"))
(define optname-show-account-description (N_ "Show Account Description"))
(define optname-show-informal-headers (N_ "Show Informal Debit/Credit Headers"))
-(define optname-show-subtotals-only (N_ "Show subtotals only (hide transactional data)"))
+(define optname-show-subtotals-only
+ (N_ "Show subtotals only (hide transactional data)"))
(define optname-indenting (N_ "Add indenting columns"))
(define optname-sec-sortkey (N_ "Secondary Key"))
(define optname-sec-subtotal (N_ "Secondary Subtotal"))
@@ -92,9 +83,11 @@
;;Filtering
(define pagename-filter (N_ "Filter"))
(define optname-account-matcher (N_ "Account Name Filter"))
-(define optname-account-matcher-regex (N_ "Use regular expressions for account name filter"))
+(define optname-account-matcher-regex
+ (N_ "Use regular expressions for account name filter"))
(define optname-transaction-matcher (N_ "Transaction Filter"))
-(define optname-transaction-matcher-regex (N_ "Use regular expressions for transaction filter"))
+(define optname-transaction-matcher-regex
+ (N_ "Use regular expressions for transaction filter"))
(define optname-reconcile-status (N_ "Reconcile Status"))
(define optname-void-transactions (N_ "Void Transactions"))
(define optname-closing-transactions (N_ "Closing transactions"))
@@ -111,19 +104,28 @@
match the time interval and account selection specified \
in the Options panel."))
-(define DATE-SORTING-TYPES (list 'date 'reconciled-date))
+(define DATE-SORTING-TYPES
+ (list 'date 'reconciled-date))
+
+(define ACCOUNT-SORTING-TYPES
+ (list 'account-name 'corresponding-acc-name
+ 'account-code 'corresponding-acc-code))
-(define ACCOUNT-SORTING-TYPES (list 'account-name 'corresponding-acc-name
- 'account-code 'corresponding-acc-code))
+(define SORTKEY-INFORMAL-HEADERS
+ (list 'account-name 'account-code))
-(define SORTKEY-INFORMAL-HEADERS (list 'account-name 'account-code))
+(define reconcile-list
+ (list (cons #\n (_ "Unreconciled"))
+ (cons #\c (_ "Cleared"))
+ (cons #\y (_ "Reconciled"))
+ (cons #\f (_ "Frozen"))
+ (cons #\v (_ "Voided"))))
(define (sortkey-list split-action?)
- ;;
;; Defines the different sorting keys, as an association-list
;; together with the subtotal functions. Each entry:
;; 'sortkey - sort parameter sent via qof-query
- ;; 'split-sortvalue - function which retrieves number/string used for comparing splits
+ ;; 'split-sortvalue - function retrieves number/string for comparing splits
;; 'text - text displayed in Display tab
;; 'tip - tooltip displayed in Display tab
;; 'renderer-fn - helper function to select subtotal/subheading renderer
@@ -132,214 +134,245 @@ in the Options panel."))
;; #f means the sortkey cannot be subtotalled
;; otherwise it converts split->string
;;
- (list (cons 'account-name (list (cons 'sortkey (list SPLIT-ACCT-FULLNAME))
- (cons 'split-sortvalue (lambda (a) (gnc-account-get-full-name (xaccSplitGetAccount a))))
- (cons 'text (_ "Account Name"))
- (cons 'tip (_ "Sort & subtotal by account name."))
- (cons 'renderer-fn (lambda (a) (xaccSplitGetAccount a)))))
-
- (cons 'account-code (list (cons 'sortkey (list SPLIT-ACCOUNT ACCOUNT-CODE-))
- (cons 'split-sortvalue (lambda (a) (xaccAccountGetCode (xaccSplitGetAccount a))))
- (cons 'text (_ "Account Code"))
- (cons 'tip (_ "Sort & subtotal by account code."))
- (cons 'renderer-fn (lambda (a) (xaccSplitGetAccount a)))))
-
- (cons 'date (list (cons 'sortkey (list SPLIT-TRANS TRANS-DATE-POSTED))
- (cons 'split-sortvalue (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
- (cons 'text (_ "Date"))
- (cons 'tip (_ "Sort by date."))
- (cons 'renderer-fn #f)))
-
- (cons 'reconciled-date (list (cons 'sortkey (list SPLIT-DATE-RECONCILED))
- (cons 'split-sortvalue (lambda (s) (xaccSplitGetDateReconciled s)))
- (cons 'text (_ "Reconciled Date"))
- (cons 'tip (_ "Sort by the Reconciled Date."))
- (cons 'renderer-fn #f)))
-
- (cons 'reconciled-status (list (cons 'sortkey #f)
- (cons 'split-sortvalue (lambda (s) (length (memq (xaccSplitGetReconcile s)
- '(#\n #\c #\y #\f #\v)))))
- (cons 'text (_ "Reconciled Status"))
- (cons 'tip (_ "Sort by the Reconciled Status"))
- (cons 'renderer-fn (lambda (s) (case (xaccSplitGetReconcile s)
- ((#\y) (_ "Reconciled"))
- ((#\c) (_ "Cleared"))
- ((#\n) (_ "Unreconciled"))
- ((#\f) (_ "Frozen"))
- ((#\v) (_ "Voided"))
- (else (_ "Unknown")))))))
-
- (cons 'register-order (list (cons 'sortkey (list QUERY-DEFAULT-SORT))
- (cons 'split-sortvalue #f)
- (cons 'text (_ "Register Order"))
- (cons 'tip (_ "Sort as in the register."))
- (cons 'renderer-fn #f)))
-
- (cons 'corresponding-acc-name (list (cons 'sortkey (list SPLIT-CORR-ACCT-NAME))
- (cons 'split-sortvalue (lambda (a) (xaccSplitGetCorrAccountFullName a)))
- (cons 'text (_ "Other Account Name"))
- (cons 'tip (_ "Sort by account transferred from/to's name."))
- (cons 'renderer-fn (lambda (a) (xaccSplitGetAccount (xaccSplitGetOtherSplit a))))))
-
- (cons 'corresponding-acc-code (list (cons 'sortkey (list SPLIT-CORR-ACCT-CODE))
- (cons 'split-sortvalue (lambda (a) (xaccSplitGetCorrAccountCode a)))
- (cons 'text (_ "Other Account Code"))
- (cons 'tip (_ "Sort by account transferred from/to's code."))
- (cons 'renderer-fn (lambda (a) (xaccSplitGetAccount (xaccSplitGetOtherSplit a))))))
-
- (cons 'amount (list (cons 'sortkey (list SPLIT-VALUE))
- (cons 'split-sortvalue (lambda (a) (gnc-numeric-to-scm (xaccSplitGetValue a))))
- (cons 'text (_ "Amount"))
- (cons 'tip (_ "Sort by amount."))
- (cons 'renderer-fn #f)))
-
- (cons 'description (list (cons 'sortkey (list SPLIT-TRANS TRANS-DESCRIPTION))
- (cons 'split-sortvalue (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s))))
- (cons 'text (_ "Description"))
- (cons 'tip (_ "Sort by description."))
- (cons 'renderer-fn (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s))))))
+ (list (list 'account-name
+ (cons 'sortkey (list SPLIT-ACCT-FULLNAME))
+ (cons 'split-sortvalue
+ (compose gnc-account-get-full-name xaccSplitGetAccount))
+ (cons 'text (_ "Account Name"))
+ (cons 'tip (_ "Sort & subtotal by account name."))
+ (cons 'renderer-fn xaccSplitGetAccount))
+
+ (list 'account-code
+ (cons 'sortkey (list SPLIT-ACCOUNT ACCOUNT-CODE-))
+ (cons 'split-sortvalue (compose xaccAccountGetCode xaccSplitGetAccount))
+ (cons 'text (_ "Account Code"))
+ (cons 'tip (_ "Sort & subtotal by account code."))
+ (cons 'renderer-fn xaccSplitGetAccount))
+
+ (list 'date
+ (cons 'sortkey (list SPLIT-TRANS TRANS-DATE-POSTED))
+ (cons 'split-sortvalue (compose xaccTransGetDate xaccSplitGetParent))
+ (cons 'text (_ "Date"))
+ (cons 'tip (_ "Sort by date."))
+ (cons 'renderer-fn #f))
+
+ (list 'reconciled-date
+ (cons 'sortkey (list SPLIT-DATE-RECONCILED))
+ (cons 'split-sortvalue xaccSplitGetDateReconciled)
+ (cons 'text (_ "Reconciled Date"))
+ (cons 'tip (_ "Sort by the Reconciled Date."))
+ (cons 'renderer-fn #f))
+
+ (list 'reconciled-status
+ (cons 'sortkey #f)
+ (cons 'split-sortvalue (lambda (s)
+ (length (memv (xaccSplitGetReconcile s)
+ (map car reconcile-list)))))
+ (cons 'text (_ "Reconciled Status"))
+ (cons 'tip (_ "Sort by the Reconciled Status"))
+ (cons 'renderer-fn (lambda (s)
+ (assv-ref reconcile-list
+ (xaccSplitGetReconcile s)))))
+
+ (list 'register-order
+ (cons 'sortkey (list QUERY-DEFAULT-SORT))
+ (cons 'split-sortvalue #f)
+ (cons 'text (_ "Register Order"))
+ (cons 'tip (_ "Sort as in the register."))
+ (cons 'renderer-fn #f))
+
+ (list 'corresponding-acc-name
+ (cons 'sortkey (list SPLIT-CORR-ACCT-NAME))
+ (cons 'split-sortvalue xaccSplitGetCorrAccountFullName)
+ (cons 'text (_ "Other Account Name"))
+ (cons 'tip (_ "Sort by account transferred from/to's name."))
+ (cons 'renderer-fn (compose xaccSplitGetAccount xaccSplitGetOtherSplit)))
+
+ (list 'corresponding-acc-code
+ (cons 'sortkey (list SPLIT-CORR-ACCT-CODE))
+ (cons 'split-sortvalue xaccSplitGetCorrAccountCode)
+ (cons 'text (_ "Other Account Code"))
+ (cons 'tip (_ "Sort by account transferred from/to's code."))
+ (cons 'renderer-fn (compose xaccSplitGetAccount xaccSplitGetOtherSplit)))
+
+ (list 'amount
+ (cons 'sortkey (list SPLIT-VALUE))
+ (cons 'split-sortvalue xaccSplitGetValue)
+ (cons 'text (_ "Amount"))
+ (cons 'tip (_ "Sort by amount."))
+ (cons 'renderer-fn #f))
+
+ (list 'description
+ (cons 'sortkey (list SPLIT-TRANS TRANS-DESCRIPTION))
+ (cons 'split-sortvalue (compose xaccTransGetDescription
+ xaccSplitGetParent))
+ (cons 'text (_ "Description"))
+ (cons 'tip (_ "Sort by description."))
+ (cons 'renderer-fn (compose xaccTransGetDescription xaccSplitGetParent)))
(if split-action?
- (cons 'number (list (cons 'sortkey (list SPLIT-ACTION))
- (cons 'split-sortvalue (lambda (a) (xaccSplitGetAction a)))
- (cons 'text (_ "Number/Action"))
- (cons 'tip (_ "Sort by check number/action."))
- (cons 'renderer-fn #f)))
-
- (cons 'number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
- (cons 'split-sortvalue (lambda (a) (xaccTransGetNum (xaccSplitGetParent a))))
- (cons 'text (_ "Number"))
- (cons 'tip (_ "Sort by check/transaction number."))
- (cons 'renderer-fn #f))))
-
- (cons 't-number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
- (cons 'split-sortvalue (lambda (a) (xaccTransGetNum (xaccSplitGetParent a))))
- (cons 'text (_ "Transaction Number"))
- (cons 'tip (_ "Sort by transaction number."))
- (cons 'renderer-fn #f)))
-
- (cons 'memo (list (cons 'sortkey (list SPLIT-MEMO))
- (cons 'split-sortvalue (lambda (s) (xaccSplitGetMemo s)))
- (cons 'text (_ "Memo"))
- (cons 'tip (_ "Sort by memo."))
- (cons 'renderer-fn (lambda (s) (xaccSplitGetMemo s)))))
-
- (cons 'notes (list (cons 'sortkey #f)
- (cons 'split-sortvalue (lambda (s) (xaccTransGetNotes (xaccSplitGetParent s))))
- (cons 'text (_ "Notes"))
- (cons 'tip (_ "Sort by transaction notes."))
- (cons 'renderer-fn (lambda (s) (xaccTransGetNotes (xaccSplitGetParent s))))))
-
- (cons 'none (list (cons 'sortkey '())
- (cons 'split-sortvalue #f)
- (cons 'text (_ "None"))
- (cons 'tip (_ "Do not sort."))
- (cons 'renderer-fn #f)))))
-
-(define (time64-year t64) (gnc:date-get-year (gnc-localtime t64)))
-(define (time64-quarter t64) (+ (* 10 (gnc:date-get-year (gnc-localtime t64))) (gnc:date-get-quarter (gnc-localtime t64))))
-(define (time64-month t64) (+ (* 100 (gnc:date-get-year (gnc-localtime t64))) (gnc:date-get-month (gnc-localtime t64))))
-(define (time64-week t64) (gnc:date-get-week (gnc-localtime t64)))
-(define (time64-day t64) (+ (* 500 (gnc:date-get-year (gnc-localtime t64))) (gnc:date-get-year-day (gnc-localtime t64))))
-(define (time64->daily-string t) (qof-print-date t))
-(define (split->time64 s) (xaccTransGetDate (xaccSplitGetParent s)))
+ (list 'number
+ (cons 'sortkey (list SPLIT-ACTION))
+ (cons 'split-sortvalue xaccSplitGetAction)
+ (cons 'text (_ "Number/Action"))
+ (cons 'tip (_ "Sort by check number/action."))
+ (cons 'renderer-fn #f))
+
+ (list 'number
+ (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
+ (cons 'split-sortvalue (compose xaccTransGetNum xaccSplitGetParent))
+ (cons 'text (_ "Number"))
+ (cons 'tip (_ "Sort by check/transaction number."))
+ (cons 'renderer-fn #f)))
+
+ (list 't-number
+ (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
+ (cons 'split-sortvalue (compose xaccTransGetNum xaccSplitGetParent))
+ (cons 'text (_ "Transaction Number"))
+ (cons 'tip (_ "Sort by transaction number."))
+ (cons 'renderer-fn #f))
+
+ (list 'memo
+ (cons 'sortkey (list SPLIT-MEMO))
+ (cons 'split-sortvalue xaccSplitGetMemo)
+ (cons 'text (_ "Memo"))
+ (cons 'tip (_ "Sort by memo."))
+ (cons 'renderer-fn xaccSplitGetMemo))
+
+ (list 'notes
+ (cons 'sortkey #f)
+ (cons 'split-sortvalue (compose xaccTransGetNotes xaccSplitGetParent))
+ (cons 'text (_ "Notes"))
+ (cons 'tip (_ "Sort by transaction notes."))
+ (cons 'renderer-fn (compose xaccTransGetNotes xaccSplitGetParent)))
+
+ (list 'none
+ (cons 'sortkey '())
+ (cons 'split-sortvalue #f)
+ (cons 'text (_ "None"))
+ (cons 'tip (_ "Do not sort."))
+ (cons 'renderer-fn #f))))
+
+(define (time64-year t64)
+ (gnc:date-get-year (gnc-localtime t64)))
+(define (time64-quarter t64)
+ (+ (* 10 (gnc:date-get-year (gnc-localtime t64)))
+ (gnc:date-get-quarter (gnc-localtime t64))))
+(define (time64-month t64)
+ (+ (* 100 (gnc:date-get-year (gnc-localtime t64)))
+ (gnc:date-get-month (gnc-localtime t64))))
+(define (time64-week t64)
+ (gnc:date-get-week (gnc-localtime t64)))
+(define (time64-day t64)
+ (+ (* 500 (gnc:date-get-year (gnc-localtime t64)))
+ (gnc:date-get-year-day (gnc-localtime t64))))
+(define (split->time64 s)
+ (xaccTransGetDate (xaccSplitGetParent s)))
(define date-subtotal-list
;; List for date option.
;; Defines the different date sorting keys, as an association-list. Each entry:
- ;; 'split-sortvalue - function which retrieves number/string used for comparing splits
+ ;; 'split-sortvalue - func retrieves number/string used for comparing splits
;; 'text - text displayed in Display tab
;; 'tip - tooltip displayed in Display tab
- ;; 'renderer-fn - func retrieve string for subtotal/subheading renderer
+ ;; 'renderer-fn - func retrieves string for subtotal/subheading renderer
;; #f means the date sortkey is not grouped
;; otherwise it converts split->string
(list
- (cons 'none (list
- (cons 'split-sortvalue #f)
- (cons 'date-sortvalue #f)
- (cons 'text (_ "None"))
- (cons 'tip (_ "None."))
- (cons 'renderer-fn #f)))
-
- (cons 'daily (list
- (cons 'split-sortvalue (lambda (s) (time64-day (split->time64 s))))
- (cons 'date-sortvalue time64-day)
- (cons 'text (_ "Daily"))
- (cons 'tip (_ "Daily."))
- (cons 'renderer-fn (lambda (s) (time64->daily-string (split->time64 s))))))
-
- (cons 'weekly (list
- (cons 'split-sortvalue (lambda (s) (time64-week (split->time64 s))))
- (cons 'date-sortvalue time64-week)
- (cons 'text (_ "Weekly"))
- (cons 'tip (_ "Weekly."))
- (cons 'renderer-fn (lambda (s) (gnc:date-get-week-year-string (gnc-localtime (split->time64 s)))))))
-
- (cons 'monthly (list
- (cons 'split-sortvalue (lambda (s) (time64-month (split->time64 s))))
- (cons 'date-sortvalue time64-month)
- (cons 'text (_ "Monthly"))
- (cons 'tip (_ "Monthly."))
- (cons 'renderer-fn (lambda (s) (gnc:date-get-month-year-string (gnc-localtime (split->time64 s)))))))
-
- (cons 'quarterly (list
- (cons 'split-sortvalue (lambda (s) (time64-quarter (split->time64 s))))
- (cons 'date-sortvalue time64-quarter)
- (cons 'text (_ "Quarterly"))
- (cons 'tip (_ "Quarterly."))
- (cons 'renderer-fn (lambda (s) (gnc:date-get-quarter-year-string (gnc-localtime (split->time64 s)))))))
-
- (cons 'yearly (list
- (cons 'split-sortvalue (lambda (s) (time64-year (split->time64 s))))
- (cons 'date-sortvalue time64-year)
- (cons 'text (_ "Yearly"))
- (cons 'tip (_ "Yearly."))
- (cons 'renderer-fn (lambda (s) (gnc:date-get-year-string (gnc-localtime (split->time64 s)))))))))
+ (list 'none
+ (cons 'split-sortvalue #f)
+ (cons 'date-sortvalue #f)
+ (cons 'text (_ "None"))
+ (cons 'tip (_ "None."))
+ (cons 'renderer-fn #f))
+
+ (list 'daily
+ (cons 'split-sortvalue (lambda (s) (time64-day (split->time64 s))))
+ (cons 'date-sortvalue time64-day)
+ (cons 'text (_ "Daily"))
+ (cons 'tip (_ "Daily."))
+ (cons 'renderer-fn (lambda (s) (qof-print-date (split->time64 s)))))
+
+ (list 'weekly
+ (cons 'split-sortvalue (lambda (s) (time64-week (split->time64 s))))
+ (cons 'date-sortvalue time64-week)
+ (cons 'text (_ "Weekly"))
+ (cons 'tip (_ "Weekly."))
+ (cons 'renderer-fn (compose gnc:date-get-week-year-string
+ gnc-localtime
+ split->time64)))
+
+ (list 'monthly
+ (cons 'split-sortvalue (lambda (s) (time64-month (split->time64 s))))
+ (cons 'date-sortvalue time64-month)
+ (cons 'text (_ "Monthly"))
+ (cons 'tip (_ "Monthly."))
+ (cons 'renderer-fn (compose gnc:date-get-month-year-string
+ gnc-localtime
+ split->time64)))
+
+ (list 'quarterly
+ (cons 'split-sortvalue (lambda (s) (time64-quarter (split->time64 s))))
+ (cons 'date-sortvalue time64-quarter)
+ (cons 'text (_ "Quarterly"))
+ (cons 'tip (_ "Quarterly."))
+ (cons 'renderer-fn (compose gnc:date-get-quarter-year-string
+ gnc-localtime
+ split->time64)))
+
+ (list 'yearly
+ (cons 'split-sortvalue (lambda (s) (time64-year (split->time64 s))))
+ (cons 'date-sortvalue time64-year)
+ (cons 'text (_ "Yearly"))
+ (cons 'tip (_ "Yearly."))
+ (cons 'renderer-fn (compose gnc:date-get-year-string
+ gnc-localtime
+ split->time64)))))
(define filter-list
(list
- (cons 'none (list
- (cons 'text (_ "None"))
- (cons 'tip (_ "Do not do any filtering."))))
+ (list 'none
+ (cons 'text (_ "None"))
+ (cons 'tip (_ "Do not do any filtering.")))
- (cons 'include (list
- (cons 'text (_ "Include Transactions to/from Filter Accounts"))
- (cons 'tip (_ "Include transactions to/from filter accounts only."))))
+ (list 'include
+ (cons 'text (_ "Include Transactions to/from Filter Accounts"))
+ (cons 'tip (_ "Include transactions to/from filter accounts only.")))
- (cons 'exclude (list
- (cons 'text (_ "Exclude Transactions to/from Filter Accounts"))
- (cons 'tip (_ "Exclude transactions to/from all filter accounts."))))))
+ (list 'exclude
+ (cons 'text (_ "Exclude Transactions to/from Filter Accounts"))
+ (cons 'tip (_ "Exclude transactions to/from all filter accounts.")))))
(define show-void-list
(list
- (cons 'non-void-only (list
- (cons 'text (_ "Non-void only"))
- (cons 'tip (_ "Show only non-voided transactions."))))
+ (list 'non-void-only
+ (cons 'text (_ "Non-void only"))
+ (cons 'tip (_ "Show only non-voided transactions.")))
- (cons 'void-only (list
- (cons 'text (_ "Void only"))
- (cons 'tip (_ "Show only voided transactions."))))
+ (list 'void-only
+ (cons 'text (_ "Void only"))
+ (cons 'tip (_ "Show only voided transactions.")))
- (cons 'both (list
- (cons 'text (_ "Both"))
- (cons 'tip (_ "Show both (and include void transactions in totals)."))))))
+ (list 'both
+ (cons 'text (_ "Both"))
+ (cons 'tip (_ "Show both (and include void transactions in totals).")))))
(define show-closing-list
(list
- (cons 'exclude-closing (list
- (cons 'text (_ "Exclude closing transactions"))
- (cons 'tip (_ "Exclude closing transactions from report."))
- (cons 'closing-match #f)))
+ (list 'exclude-closing
+ (cons 'text (_ "Exclude closing transactions"))
+ (cons 'tip (_ "Exclude closing transactions from report."))
+ (cons 'closing-match #f))
- (cons 'include-both (list
- (cons 'text (_ "Show both closing and regular transactions"))
- (cons 'tip (_ "Show both (and include closing transactions in totals)."))
- (cons 'closing-match 'both)))
+ (list 'include-both
+ (cons 'text (_ "Show both closing and regular transactions"))
+ (cons 'tip (_ "Show both (and include closing transactions in totals)."))
+ (cons 'closing-match 'both))
- (cons 'closing-only (list
- (cons 'text (_ "Show closing transactions only"))
- (cons 'tip (_ "Show only closing transactions."))
- (cons 'closing-match #t)))))
+ (list 'closing-only
+ (cons 'text (_ "Show closing transactions only"))
+ (cons 'tip (_ "Show only closing transactions."))
+ (cons 'closing-match #t))))
(define reconcile-status-list
;; 'filter-types must be either #f (i.e. disable reconcile filter)
@@ -347,68 +380,60 @@ in the Options panel."))
;; e.g. CLEARED-NO for unreconciled
;; (logior CLEARED-NO CLEARED-CLEARED) for unreconciled & cleared
(list
- (cons 'all
- (list
- (cons 'text (_ "All"))
- (cons 'tip (_ "Show All Transactions"))
- (cons 'filter-types #f)))
-
- (cons 'unreconciled
- (list
- (cons 'text (_ "Unreconciled"))
- (cons 'tip (_ "Unreconciled only"))
- (cons 'filter-types CLEARED-NO)))
-
- (cons 'cleared
- (list
- (cons 'text (_ "Cleared"))
- (cons 'tip (_ "Cleared only"))
- (cons 'filter-types CLEARED-CLEARED)))
-
- (cons 'reconciled
- (list
- (cons 'text (_ "Reconciled"))
- (cons 'tip (_ "Reconciled only"))
- (cons 'filter-types CLEARED-RECONCILED)))))
+ (list 'all
+ (cons 'text (_ "All"))
+ (cons 'tip (_ "Show All Transactions"))
+ (cons 'filter-types #f))
+
+ (list 'unreconciled
+ (cons 'text (_ "Unreconciled"))
+ (cons 'tip (_ "Unreconciled only"))
+ (cons 'filter-types CLEARED-NO))
+
+ (list 'cleared
+ (cons 'text (_ "Cleared"))
+ (cons 'tip (_ "Cleared only"))
+ (cons 'filter-types CLEARED-CLEARED))
+
+ (list 'reconciled
+ (cons 'text (_ "Reconciled"))
+ (cons 'tip (_ "Reconciled only"))
+ (cons 'filter-types CLEARED-RECONCILED))))
(define ascending-list
(list
- (cons 'ascend (list
- (cons 'text (_ "Ascending"))
- (cons 'tip (_ "Smallest to largest, earliest to latest."))))
- (cons 'descend (list
- (cons 'text (_ "Descending"))
- (cons 'tip (_ "Largest to smallest, latest to earliest."))))))
+ (list 'ascend
+ (cons 'text (_ "Ascending"))
+ (cons 'tip (_ "Smallest to largest, earliest to latest.")))
+ (list 'descend
+ (cons 'text (_ "Descending"))
+ (cons 'tip (_ "Largest to smallest, latest to earliest.")))))
(define sign-reverse-list
(list
- (cons 'global
- (list
- (cons 'text (_ "Use Global Preference"))
- (cons 'tip (_ "Use reversing option specified in global preference."))
- (cons 'acct-types #f)))
- (cons 'none
- (list
- (cons 'text (_ "None"))
- (cons 'tip (_ "Don't change any displayed amounts."))
- (cons 'acct-types '())))
- (cons 'income-expense
- (list
- (cons 'text (_ "Income and Expense"))
- (cons 'tip (_ "Reverse amount display for Income and Expense Accounts."))
- (cons 'acct-types (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE))))
- (cons 'credit-accounts
- (list
- (cons 'text (_ "Credit Accounts"))
- (cons 'tip (_ "Reverse amount display for Liability, Payable, Equity, \
+ (list 'global
+ (cons 'text (_ "Use Global Preference"))
+ (cons 'tip (_ "Use reversing option specified in global preference."))
+ (cons 'acct-types #f))
+ (list 'none
+ (cons 'text (_ "None"))
+ (cons 'tip (_ "Don't change any displayed amounts."))
+ (cons 'acct-types '()))
+ (list 'income-expense
+ (cons 'text (_ "Income and Expense"))
+ (cons 'tip (_ "Reverse amount display for Income and Expense Accounts."))
+ (cons 'acct-types (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)))
+ (list 'credit-accounts
+ (cons 'text (_ "Credit Accounts"))
+ (cons 'tip (_ "Reverse amount display for Liability, Payable, Equity, \
Credit Card, and Income accounts."))
- (cons 'acct-types (list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE
- ACCT-TYPE-EQUITY ACCT-TYPE-CREDIT
- ACCT-TYPE-INCOME))))))
+ (cons 'acct-types (list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE
+ ACCT-TYPE-EQUITY ACCT-TYPE-CREDIT
+ ACCT-TYPE-INCOME)))))
(define (keylist-get-info keylist key info)
- (cdr (assq info (cdr (assq key keylist)))))
+ (assq-ref (assq-ref keylist key) info))
(define (keylist->vectorlist keylist)
(map
@@ -435,67 +460,16 @@ Credit Card, and Income accounts."))
(not (keylist-get-info (sortkey-list split-action?) sortkey 'sortkey))))
;;
-;; Set defaults for reconcilation report
-;;
-(define (reconcile-report-options-generator)
- (define options (trep-options-generator))
- (gnc:option-set-value (gnc:lookup-option options pagename-sorting optname-prime-sortkey) 'reconciled-status)
- (gnc:option-set-value (gnc:lookup-option options pagename-sorting optname-sec-sortkey) 'date)
- (gnc:option-set-value (gnc:lookup-option options pagename-sorting optname-sec-date-subtotal) 'none)
- ;; the start date should really be the last-reconcile-date but this information is not
- ;; easily accessible from scheme:
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-general optname-startdate) (cons 'relative 'start-prev-quarter))
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-general optname-enddate) (cons 'relative 'today))
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-display (N_ "Reconciled Date")) #t)
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-display (N_ "Running Balance")) #f)
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-display (N_ "Memo")) #f)
- (gnc:option-make-internal! options gnc:pagename-display "Running Balance")
- options)
-
-(define reconcile-report-instructions
- (gnc:make-html-text
- (_ "The reconcile report is designed to be similar to the formal reconciliation tool.
-Please select the account from Report Options. Please note the dates specified in the options
-will apply to the Reconciliation Date.")
- (gnc:html-markup-br)
- (gnc:html-markup-br)))
-
-;; if split is reconciled, retrieve its reconciled date; if not yet reconciled, return #f
-(define (split->reconcile-date split)
- (and (char=? (xaccSplitGetReconcile split) #\y)
- (xaccSplitGetDateReconciled split)))
-
-(define (reconcile-report-calculated-cells options)
- (define (opt-val section name)
- (gnc:option-value (gnc:lookup-option options section name)))
- (letrec
- ((split-amount (lambda (s) (if (gnc:split-voided? s)
- (xaccSplitVoidFormerAmount s)
- (xaccSplitGetAmount s))))
- (split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
- (amount (lambda (s) (gnc:make-gnc-monetary (split-currency s) (split-amount s))))
- (debit-amount (lambda (s) (and (positive? (split-amount s))
- (amount s))))
- (credit-amount (lambda (s) (and (not (positive? (split-amount s)))
- (gnc:monetary-neg (amount s))))))
- ;; similar to default-calculated-cells but disable dual-subtotals.
- (list (vector (_ "Funds In")
- debit-amount #f #t #f
- (const ""))
- (vector (_ "Funds Out")
- credit-amount #f #t #f
- (const "")))))
-;;
;; Default Transaction Report
;;
-(define (trep-options-generator)
-
+(define (gnc:trep-options-generator)
(define options (gnc:new-options))
- (define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
+ (define BOOK-SPLIT-ACTION
+ (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
(define (gnc:register-trep-option new-option)
(gnc:register-option options new-option))
- ;; (Feb 2018) Note to future hackers - this trep-options-generator
+ ;; (Feb 2018) Note to future hackers - this gnc:trep-options-generator
;; defines a long set of options to be assigned as an object in
;; the report. This long list (52 at Feb 2018 count) of options
;; may be modified in a derived report (see income-gst-statement.scm)
@@ -515,13 +489,10 @@ will apply to the Reconciliation Date.")
"e" (_ "Convert all transactions into a common currency.") #f
#f
(lambda (x)
- (begin
- (gnc-option-db-set-option-selectable-by-name options
- gnc:pagename-general
- optname-currency x)
- (gnc-option-db-set-option-selectable-by-name options
- gnc:pagename-general
- optname-orig-currency x)))))
+ (gnc-option-db-set-option-selectable-by-name
+ options gnc:pagename-general optname-currency x)
+ (gnc-option-db-set-option-selectable-by-name
+ options gnc:pagename-general optname-orig-currency x))))
(gnc:options-add-currency!
options gnc:pagename-general optname-currency "f")
@@ -534,7 +505,8 @@ will apply to the Reconciliation Date.")
(gnc:register-trep-option
(gnc:make-simple-boolean-option
gnc:pagename-general optname-table-export
- "g" (_ "Formats the table suitable for cut & paste exporting with extra cells.") #f))
+ "g" (_ "Formats the table suitable for cut & paste exporting with extra cells.")
+ #f))
(gnc:register-trep-option
(gnc:make-multichoice-option
@@ -665,11 +637,13 @@ be excluded from periodic reporting.")
(define (apply-selectable-by-name-sorting-options)
(let* ((prime-sortkey-enabled (not (eq? prime-sortkey 'none)))
- (prime-sortkey-subtotal-enabled (SUBTOTAL-ENABLED? prime-sortkey BOOK-SPLIT-ACTION))
- (prime-date-sortingtype-enabled (member prime-sortkey DATE-SORTING-TYPES))
+ (prime-sortkey-subtotal-enabled
+ (SUBTOTAL-ENABLED? prime-sortkey BOOK-SPLIT-ACTION))
+ (prime-date-sortingtype-enabled (memq prime-sortkey DATE-SORTING-TYPES))
(sec-sortkey-enabled (not (eq? sec-sortkey 'none)))
- (sec-sortkey-subtotal-enabled (SUBTOTAL-ENABLED? sec-sortkey BOOK-SPLIT-ACTION))
- (sec-date-sortingtype-enabled (member sec-sortkey DATE-SORTING-TYPES)))
+ (sec-sortkey-subtotal-enabled
+ (SUBTOTAL-ENABLED? sec-sortkey BOOK-SPLIT-ACTION))
+ (sec-date-sortingtype-enabled (memq sec-sortkey DATE-SORTING-TYPES)))
(gnc-option-db-set-option-selectable-by-name
options pagename-sorting optname-prime-subtotal
@@ -718,8 +692,8 @@ be excluded from periodic reporting.")
(gnc-option-db-set-option-selectable-by-name
options pagename-sorting optname-show-informal-headers
- (or (member prime-sortkey (list 'account-name 'account-code))
- (member sec-sortkey (list 'account-name 'account-code))))
+ (or (memq prime-sortkey (list 'account-name 'account-code))
+ (memq sec-sortkey (list 'account-name 'account-code))))
(gnc-option-db-set-option-selectable-by-name
options pagename-sorting optname-prime-date-subtotal
@@ -917,11 +891,11 @@ be excluded from periodic reporting.")
(list (N_ "Running Balance") "n" (_ "Display a running balance?") #f)
(list (N_ "Totals") "o" (_ "Display the totals?") #t)))
- (if BOOK-SPLIT-ACTION
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display (N_ "Trans Number")
- "b2" (_ "Display the trans number?") #f)))
+ (when BOOK-SPLIT-ACTION
+ (gnc:register-trep-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display (N_ "Trans Number")
+ "b2" (_ "Display the trans number?") #f)))
;; Add an option to display the memo, and disable the notes option
;; when memos are not included.
@@ -1016,10 +990,12 @@ be excluded from periodic reporting.")
(if option
(gnc:option-value option)
(gnc:error "gnc:lookup-option error: " section "/" name))))
- (define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
+ (define BOOK-SPLIT-ACTION
+ (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
(define (build-columns-used)
- (define detail-is-single? (eq? (opt-val gnc:pagename-display optname-detail-level) 'single))
+ (define detail-is-single?
+ (eq? (opt-val gnc:pagename-display optname-detail-level) 'single))
(define amount-setting (opt-val gnc:pagename-display (N_ "Amount")))
(list (cons 'date (opt-val gnc:pagename-display (N_ "Date")))
(cons 'reconciled-date (opt-val gnc:pagename-display (N_ "Reconciled Date")))
@@ -1028,8 +1004,9 @@ be excluded from periodic reporting.")
(opt-val gnc:pagename-display (N_ "Num"))))
(cons 'description (opt-val gnc:pagename-display (N_ "Description")))
(cons 'account-name (opt-val gnc:pagename-display (N_ "Account Name")))
- (cons 'other-account-name (and detail-is-single?
- (opt-val gnc:pagename-display (N_ "Other Account Name"))))
+ (cons 'other-account-name
+ (and detail-is-single?
+ (opt-val gnc:pagename-display (N_ "Other Account Name"))))
(cons 'shares (opt-val gnc:pagename-display (N_ "Shares")))
(cons 'price (opt-val gnc:pagename-display (N_ "Price")))
(cons 'amount-single (eq? amount-setting 'single))
@@ -1039,40 +1016,49 @@ be excluded from periodic reporting.")
(and (opt-val gnc:pagename-general optname-common-currency)
(opt-val gnc:pagename-general optname-orig-currency)))
(cons 'indenting (opt-val pagename-sorting optname-indenting))
- (cons 'subtotals-only (and (opt-val pagename-sorting optname-show-subtotals-only)
- (or (primary-get-info 'renderer-fn)
- (secondary-get-info 'renderer-fn))))
+ (cons 'subtotals-only
+ (and (opt-val pagename-sorting optname-show-subtotals-only)
+ (or (primary-get-info 'renderer-fn)
+ (secondary-get-info 'renderer-fn))))
(cons 'running-balance (opt-val gnc:pagename-display (N_ "Running Balance")))
- (cons 'account-full-name (opt-val gnc:pagename-display (N_ "Use Full Account Name")))
+ (cons 'account-full-name
+ (opt-val gnc:pagename-display (N_ "Use Full Account Name")))
(cons 'memo (opt-val gnc:pagename-display (N_ "Memo")))
(cons 'account-code (opt-val gnc:pagename-display (N_ "Account Code")))
- (cons 'other-account-code (and detail-is-single?
- (opt-val gnc:pagename-display (N_ "Other Account Code"))))
- (cons 'other-account-full-name (and detail-is-single?
- (opt-val gnc:pagename-display (N_ "Use Full Other Account Name"))))
+ (cons 'other-account-code
+ (and detail-is-single?
+ (opt-val gnc:pagename-display (N_ "Other Account Code"))))
+ (cons 'other-account-full-name
+ (and detail-is-single?
+ (opt-val gnc:pagename-display (N_ "Use Full Other Account Name"))))
(cons 'sort-account-code (opt-val pagename-sorting (N_ "Show Account Code")))
- (cons 'sort-account-full-name (opt-val pagename-sorting (N_ "Show Full Account Name")))
- (cons 'sort-account-description (opt-val pagename-sorting (N_ "Show Account Description")))
+ (cons 'sort-account-full-name
+ (opt-val pagename-sorting (N_ "Show Full Account Name")))
+ (cons 'sort-account-description
+ (opt-val pagename-sorting (N_ "Show Account Description")))
(cons 'notes (opt-val gnc:pagename-display (N_ "Notes")))))
(define (primary-get-info info)
(let ((sortkey (opt-val pagename-sorting optname-prime-sortkey)))
- (if (member sortkey DATE-SORTING-TYPES)
- (keylist-get-info date-subtotal-list (opt-val pagename-sorting optname-prime-date-subtotal) info)
+ (if (memq sortkey DATE-SORTING-TYPES)
+ (keylist-get-info
+ date-subtotal-list
+ (opt-val pagename-sorting optname-prime-date-subtotal) info)
(and (SUBTOTAL-ENABLED? sortkey BOOK-SPLIT-ACTION)
(opt-val pagename-sorting optname-prime-subtotal)
(keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey info)))))
(define (secondary-get-info info)
(let ((sortkey (opt-val pagename-sorting optname-sec-sortkey)))
- (if (member sortkey DATE-SORTING-TYPES)
- (keylist-get-info date-subtotal-list (opt-val pagename-sorting optname-sec-date-subtotal) info)
+ (if (memq sortkey DATE-SORTING-TYPES)
+ (keylist-get-info
+ date-subtotal-list
+ (opt-val pagename-sorting optname-sec-date-subtotal) info)
(and (SUBTOTAL-ENABLED? sortkey BOOK-SPLIT-ACTION)
(opt-val pagename-sorting optname-sec-subtotal)
(keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey info)))))
(let* ((work-to-do (length splits))
- (work-done 0)
(table (gnc:make-html-table))
(used-columns (build-columns-used))
(opt-use-links? (opt-val gnc:pagename-display "Enable links"))
@@ -1080,7 +1066,8 @@ be excluded from periodic reporting.")
(keylist-get-info sign-reverse-list
(opt-val gnc:pagename-display (N_ "Sign Reverses"))
'acct-types))
- (is-multiline? (eq? (opt-val gnc:pagename-display optname-detail-level) 'multi-line))
+ (is-multiline? (eq? (opt-val gnc:pagename-display optname-detail-level)
+ 'multi-line))
(export? (opt-val gnc:pagename-general optname-table-export)))
(define (column-uses? param)
@@ -1093,16 +1080,19 @@ be excluded from periodic reporting.")
(add-if (column-uses? 'date)
(vector (_ "Date")
(lambda (split transaction-row?)
- (if transaction-row?
- (gnc:make-html-table-cell/markup
- "date-cell"
- (qof-print-date (xaccTransGetDate (xaccSplitGetParent split))))
- ""))))
+ (and transaction-row?
+ (gnc:make-html-table-cell/markup
+ "date-cell"
+ (qof-print-date
+ (xaccTransGetDate
+ (xaccSplitGetParent split))))))))
(add-if (column-uses? 'reconciled-date)
(vector (_ "Reconciled Date")
(lambda (split transaction-row?)
- (let ((reconcile-date (split->reconcile-date split)))
+ (let ((reconcile-date
+ (and (char=? (xaccSplitGetReconcile split) #\y)
+ (xaccSplitGetDateReconciled split))))
(and reconcile-date
(gnc:make-html-table-cell/markup
"date-cell"
@@ -1110,32 +1100,34 @@ be excluded from periodic reporting.")
(add-if (column-uses? 'num)
(vector (if (and BOOK-SPLIT-ACTION
- (opt-val gnc:pagename-display (N_ "Trans Number")))
+ (opt-val gnc:pagename-display
+ (N_ "Trans Number")))
(_ "Num/T-Num")
(_ "Num"))
(lambda (split transaction-row?)
(let* ((trans (xaccSplitGetParent split))
(num (gnc-get-num-action trans split))
(t-num (if (and BOOK-SPLIT-ACTION
- (opt-val gnc:pagename-display (N_ "Trans Number")))
+ (opt-val
+ gnc:pagename-display
+ (N_ "Trans Number")))
(gnc-get-num-action trans #f)
""))
(num-string (if (string-null? t-num)
num
(string-append num "/" t-num))))
- (if transaction-row?
- (gnc:make-html-table-cell/markup "text-cell" num-string)
- "")))))
+ (and transaction-row?
+ (gnc:make-html-table-cell/markup
+ "text-cell" num-string))))))
(add-if (column-uses? 'description)
(vector (_ "Description")
(lambda (split transaction-row?)
(define trans (xaccSplitGetParent split))
- (if transaction-row?
- (gnc:make-html-table-cell/markup
- "text-cell"
- (xaccTransGetDescription trans))
- ""))))
+ (and transaction-row?
+ (gnc:make-html-table-cell/markup
+ "text-cell"
+ (xaccTransGetDescription trans))))))
(add-if (column-uses? 'memo)
(vector (if (column-uses? 'notes)
@@ -1151,11 +1143,11 @@ be excluded from periodic reporting.")
(add-if (or (column-uses? 'account-name) (column-uses? 'account-code))
(vector (_ "Account")
(lambda (split transaction-row?)
- (define account (xaccSplitGetAccount split))
- (account-namestring account
- (column-uses? 'account-code)
- (column-uses? 'account-name)
- (column-uses? 'account-full-name)))))
+ (account-namestring
+ (xaccSplitGetAccount split)
+ (column-uses? 'account-code)
+ (column-uses? 'account-name)
+ (column-uses? 'account-full-name)))))
(add-if (or (column-uses? 'other-account-name)
(column-uses? 'other-account-code))
@@ -1180,20 +1172,24 @@ be excluded from periodic reporting.")
(add-if (column-uses? 'price)
(vector (_ "Price")
(lambda (split transaction-row?)
- ;; share price is retrieved as an exact rational; convert for
- ;; presentation to decimal, rounded to the currency SCU, optionally
- ;; increasing precision by 2 significant digits.
- (let* ((currency (xaccTransGetCurrency (xaccSplitGetParent split)))
+ ;; share price is retrieved as an
+ ;; exact rational; convert for
+ ;; presentation to decimal, rounded
+ ;; to the currency SCU, optionally
+ ;; increasing precision by 2
+ ;; significant digits.
+ (let* ((currency (xaccTransGetCurrency
+ (xaccSplitGetParent split)))
(scu (gnc-commodity-get-fraction currency))
(price (xaccSplitGetSharePrice split))
- (price-decimal (gnc-numeric-convert price
- (if (< scu 10000)
- (* scu 100)
- scu)
- GNC-HOW-RND-ROUND)))
+ (price-decimal
+ (gnc-numeric-convert
+ price (min 10000 (* 100 scu))
+ GNC-HOW-RND-ROUND)))
(gnc:make-html-table-cell/markup
"number-cell"
- (gnc:make-gnc-monetary currency price-decimal)))))))))
+ (gnc:make-gnc-monetary
+ currency price-decimal)))))))))
(if (or (column-uses? 'subtotals-only)
(and (null? left-cols-list)
@@ -1214,7 +1210,7 @@ be excluded from periodic reporting.")
((split-amount (lambda (s) (if (gnc:split-voided? s)
(xaccSplitVoidFormerAmount s)
(xaccSplitGetAmount s))))
- (split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
+ (split-currency (compose xaccAccountGetCommodity xaccSplitGetAccount))
(row-currency (lambda (s) (if (column-uses? 'common-currency)
(opt-val gnc:pagename-general optname-currency)
(split-currency s))))
@@ -1226,36 +1222,49 @@ be excluded from periodic reporting.")
(if (column-uses? 'common-currency)
(format #f " (~a)"
(gnc-commodity-get-mnemonic
- (opt-val gnc:pagename-general optname-currency)))
+ (opt-val gnc:pagename-general
+ optname-currency)))
""))))
;; For conversion to row-currency. Use midday as the
;; transaction time so it matches a price on the same day.
;; Otherwise it uses midnight which will likely match a
;; price on the previous day
- (converted-amount (lambda (s) (gnc:exchange-by-pricedb-nearest
- (gnc:make-gnc-monetary (split-currency s) (split-amount s))
- (row-currency s)
- (time64CanonicalDayTime
- (xaccTransGetDate (xaccSplitGetParent s))))))
+ (converted-amount (lambda (s)
+ (gnc:exchange-by-pricedb-nearest
+ (gnc:make-gnc-monetary (split-currency s)
+ (split-amount s))
+ (row-currency s)
+ (time64CanonicalDayTime
+ (xaccTransGetDate (xaccSplitGetParent s))))))
(converted-debit-amount (lambda (s) (and (positive? (split-amount s))
(converted-amount s))))
- (converted-credit-amount (lambda (s) (and (not (positive? (split-amount s)))
- (gnc:monetary-neg (converted-amount s)))))
- (original-amount (lambda (s) (gnc:make-gnc-monetary (split-currency s) (split-amount s))))
- (original-debit-amount (lambda (s) (and (positive? (split-amount s))
- (original-amount s))))
- (original-credit-amount (lambda (s) (and (not (positive? (split-amount s)))
- (gnc:monetary-neg (original-amount s)))))
- (running-balance (lambda (s) (gnc:make-gnc-monetary (split-currency s) (xaccSplitGetBalance s)))))
+ (converted-credit-amount (lambda (s)
+ (and (not (positive? (split-amount s)))
+ (gnc:monetary-neg (converted-amount s)))))
+ (original-amount (lambda (s)
+ (gnc:make-gnc-monetary
+ (split-currency s) (split-amount s))))
+ (original-debit-amount (lambda (s)
+ (and (positive? (split-amount s))
+ (original-amount s))))
+ (original-credit-amount (lambda (s)
+ (and (not (positive? (split-amount s)))
+ (gnc:monetary-neg (original-amount s)))))
+ (running-balance (lambda (s)
+ (gnc:make-gnc-monetary
+ (split-currency s) (xaccSplitGetBalance s)))))
(append
;; each column will be a vector
;; (vector heading
- ;; calculator-function ;; (calculator-function split) to obtain amount
- ;; reverse-column? ;; #t to allow reverse signs
- ;; subtotal? ;; #t to allow subtotals (ie must be #f for running balance)
- ;; start-dual-column? ;; #t for the debit side of a dual column (i.e. debit/credit)
- ;; ;; which means the next column must be the credit side
- ;; friendly-heading-fn ;; (friendly-heading-fn account) to retrieve friendly name for account debit/credit
+ ;; calculator-function (calculator-function split) to obtain amount
+ ;; reverse-column? #t to allow reverse signs
+ ;; subtotal? #t to allow subtotals (ie must be #f for
+ ;; running balance)
+ ;; start-dual-column? #t for the debit side of a dual column
+ ;; (i.e. debit/credit) which means the next
+ ;; column must be the credit side
+ ;; friendly-heading-fn (friendly-heading-fn account) to retrieve
+ ;; friendly name for account debit/credit
(if (column-uses? 'amount-single)
(list (vector (header-commodity (_ "Amount"))
@@ -1346,7 +1355,7 @@ be excluded from periodic reporting.")
(gnc:html-make-empty-cells left-indent)
(if (and (opt-val pagename-sorting optname-show-informal-headers)
(column-uses? 'amount-double)
- (member sortkey SORTKEY-INFORMAL-HEADERS))
+ (memq sortkey SORTKEY-INFORMAL-HEADERS))
(append
(if export?
(cons
@@ -1369,19 +1378,25 @@ be excluded from periodic reporting.")
1 (+ right-indent width-left-columns width-right-columns)
data))))))))
- (define (add-subtotal-row subtotal-string subtotal-collectors subtotal-style level row col)
+ (define (add-subtotal-row subtotal-string subtotal-collectors
+ subtotal-style level row col)
(let* ((left-indent (case level
((total) 0)
((primary) primary-indent)
((secondary) (+ primary-indent secondary-indent))))
(right-indent (- indent-level left-indent))
(merge-list (map (lambda (cell) (vector-ref cell 4)) calculated-cells))
- (columns (map (lambda (coll) (coll 'format gnc:make-gnc-monetary #f)) subtotal-collectors))
- (list-of-commodities (delete-duplicates (map gnc:gnc-monetary-commodity (concatenate columns))
- gnc-commodity-equal)))
+ (columns (map (lambda (coll)
+ (coll 'format gnc:make-gnc-monetary #f))
+ subtotal-collectors))
+ (list-of-commodities
+ (delete-duplicates
+ (map gnc:gnc-monetary-commodity (concatenate columns))
+ gnc-commodity-equal)))
(define (retrieve-commodity list-of-monetary commodity)
- (find (lambda (mon) (gnc-commodity-equal commodity (gnc:gnc-monetary-commodity mon)))
+ (find (lambda (mon)
+ (gnc-commodity-equal commodity (gnc:gnc-monetary-commodity mon)))
list-of-monetary))
(define (first-column string)
@@ -1390,7 +1405,8 @@ be excluded from periodic reporting.")
(gnc:make-html-table-cell/markup "total-label-cell" string)
(gnc:html-make-empty-cells (+ right-indent width-left-columns -1)))
(list
- (gnc:make-html-table-cell/size/markup 1 (+ right-indent width-left-columns) "total-label-cell" string))))
+ (gnc:make-html-table-cell/size/markup
+ 1 (+ right-indent width-left-columns) "total-label-cell" string))))
(define (data-columns commodity)
(let loop ((merging? #f)
@@ -1399,7 +1415,8 @@ be excluded from periodic reporting.")
(merge-list merge-list)
(result '()))
(if (null? columns)
- ;; we've processed all columns. return the (reversed) list of html-table-cells.
+ ;; we've processed all columns. return the (reversed)
+ ;; list of html-table-cells.
(reverse result)
(let* ((mon (retrieve-commodity (car columns) commodity))
(this-column (and mon (gnc:gnc-monetary-amount mon))))
@@ -1427,9 +1444,7 @@ be excluded from periodic reporting.")
#f
(cdr columns)
(cdr merge-list)
- (cons* (or credit-col "")
- (or debit-col "")
- result))))
+ (cons* credit-col debit-col result))))
;; Not merging nor completed merge. Just add amount to result.
(else
@@ -1437,14 +1452,16 @@ be excluded from periodic reporting.")
#f
(cdr columns)
(cdr merge-list)
- (cons (gnc:make-html-table-cell/markup "total-number-cell" mon)
+ (cons (gnc:make-html-table-cell/markup
+ "total-number-cell" mon)
result))))))))
;; take the first column of each commodity, add onto the subtotal grid
- (set! grid (grid-add grid row col
- (map (lambda (commodity)
- (retrieve-commodity (car columns) commodity))
- list-of-commodities)))
+ (set! grid
+ (grid-add grid row col
+ (map (lambda (commodity)
+ (retrieve-commodity (car columns) commodity))
+ list-of-commodities)))
;; each commodity subtotal gets a separate line in the html-table
;; each line comprises: indenting, first-column, data-columns
@@ -1462,28 +1479,25 @@ be excluded from periodic reporting.")
(define (total-string str) (string-append (_ "Total For ") str))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
;; renderers
-
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; display an account name depending on the options the user has set
- (define (account-namestring account show-account-code? show-account-name? show-account-full-name?)
+ (define (account-namestring account show-account-code?
+ show-account-name? show-account-full-name?)
;;# on multi-line splits we can get an empty ('()) account
(if (null? account)
(_ "Split Transaction")
- (string-append
- ;; display account code?
- (if show-account-code?
- (string-append (xaccAccountGetCode account) " ")
- "")
- ;; display account name?
- (if show-account-name?
- ;; display full account name?
- (if show-account-full-name?
- (gnc-account-get-full-name account)
- (xaccAccountGetName account))
- ""))))
+ (with-output-to-string
+ (lambda ()
+ (when show-account-code?
+ (display (xaccAccountGetCode account))
+ (display " "))
+ (when show-account-name?
+ (display
+ (if show-account-full-name?
+ (gnc-account-get-full-name account)
+ (xaccAccountGetName account))))))))
;; retrieve date renderer from the date-subtotal-list
(define (render-date date-subtotal-key split)
@@ -1491,17 +1505,19 @@ be excluded from periodic reporting.")
;; generate account name, optionally with anchor to account register
(define (render-account sortkey split anchor?)
- (let* ((account ((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'renderer-fn) split))
+ (let* ((account ((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION)
+ sortkey 'renderer-fn) split))
(name (account-namestring account
(column-uses? 'sort-account-code)
#t
(column-uses? 'sort-account-full-name)))
(description (if (and (column-uses? 'sort-account-description)
- (not (string-null? (xaccAccountGetDescription account))))
+ (not (string-null?
+ (xaccAccountGetDescription account))))
(string-append ": " (xaccAccountGetDescription account))
"")))
(if (and anchor? opt-use-links?
- (not (null? account))) ;html anchor for 2-split transactions only
+ (pair? account)) ;html anchor for 2-split transactions only
(gnc:make-html-text
(gnc:html-markup-anchor (gnc:account-anchor-text account) name)
description)
@@ -1521,9 +1537,9 @@ be excluded from periodic reporting.")
((primary) optname-prime-date-subtotal)
((secondary) optname-sec-date-subtotal)))))
(cond
- ((member sortkey DATE-SORTING-TYPES)
+ ((memq sortkey DATE-SORTING-TYPES)
(render-date date-subtotal-key split))
- ((member sortkey ACCOUNT-SORTING-TYPES)
+ ((memq sortkey ACCOUNT-SORTING-TYPES)
(render-account sortkey split anchor?))
(else
(render-generic sortkey split)))))
@@ -1532,19 +1548,17 @@ be excluded from periodic reporting.")
(_ "Grand Total"))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
;; add-split-row
- ;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (add-split-row split cell-calculators row-style transaction-row?)
(let* ((account (xaccSplitGetAccount split))
(reversible-account? (if account-types-to-reverse
- (member (xaccAccountGetType account)
- account-types-to-reverse)
+ (memv (xaccAccountGetType account)
+ account-types-to-reverse)
(gnc-reverse-balance account)))
(cells (map (lambda (cell)
- (let* ((split->monetary (vector-ref cell 1)))
+ (let ((split->monetary (vector-ref cell 1)))
(vector (split->monetary split)
(vector-ref cell 2) ;reverse?
(vector-ref cell 3) ;subtotal?
@@ -1597,145 +1611,142 @@ be excluded from periodic reporting.")
(define total-collectors
(map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
- (define (do-rows-with-subtotals splits odd-row?)
- (define primary-subtotal-comparator (primary-get-info 'split-sortvalue))
- (define secondary-subtotal-comparator (secondary-get-info 'split-sortvalue))
+ (define grid (make-grid))
+ (define primary-subtotal-comparator (primary-get-info 'split-sortvalue))
+ (define secondary-subtotal-comparator (secondary-get-info 'split-sortvalue))
- (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
+ (gnc:html-table-set-col-headers!
+ table (concatenate (list
+ (gnc:html-make-empty-cells indent-level)
+ headings-left-columns
+ headings-right-columns)))
- (set! work-done (+ 1 work-done))
+ (when (primary-get-info 'renderer-fn)
+ (add-subheading (render-summary (car splits) 'primary #t)
+ def:primary-subtotal-style (car splits) 'primary))
+
+ (when (secondary-get-info 'renderer-fn)
+ (add-subheading (render-summary (car splits) 'secondary #t)
+ def:secondary-subtotal-style (car splits) 'secondary))
+
+ (let loop ((splits splits)
+ (odd-row? #t)
+ (work-done 0))
+
+ (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
(if (null? splits)
- (if (opt-val gnc:pagename-display "Totals")
- (begin
- (gnc:html-table-append-row/markup!
- table def:grand-total-style
- (list
- (gnc:make-html-table-cell/size
- 1 (+ indent-level width-left-columns width-right-columns)
- (gnc:make-html-text (gnc:html-markup-hr)))))
+ (when (opt-val gnc:pagename-display "Totals")
+ (gnc:html-table-append-row/markup!
+ table def:grand-total-style
+ (list
+ (gnc:make-html-table-cell/size
+ 1 (+ indent-level width-left-columns width-right-columns)
+ (gnc:make-html-text (gnc:html-markup-hr)))))
- (add-subtotal-row (render-grand-total) total-collectors def:grand-total-style 'total 'row-total 'col-total)))
+ (add-subtotal-row
+ (render-grand-total) total-collectors
+ def:grand-total-style 'total 'row-total 'col-total))
(let* ((current (car splits))
(rest (cdr splits))
- (next (if (null? rest) #f (car rest)))
+ (next (and (pair? rest) (car rest)))
(split-values (add-split-row
current
calculated-cells
- (if is-multiline? def:normal-row-style
- (if odd-row?
- def:normal-row-style
- def:alternate-row-style))
+ (if (or odd-row? is-multiline?)
+ def:normal-row-style
+ def:alternate-row-style)
#t)))
- (if is-multiline?
- (for-each
- (lambda (othersplits)
- (add-split-row othersplits calculated-cells def:alternate-row-style #f))
- (delete current (xaccTransGetSplitList (xaccSplitGetParent current)))))
-
- (for-each
- (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- primary-subtotal-collectors split-values)
+ (when is-multiline?
+ (for-each
+ (lambda (othersplit)
+ (add-split-row othersplit calculated-cells
+ def:alternate-row-style #f))
+ (delete current (xaccTransGetSplitList
+ (xaccSplitGetParent current)))))
(for-each
- (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- secondary-subtotal-collectors split-values)
-
- (for-each
- (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- total-collectors split-values)
-
- (if (and primary-subtotal-comparator
- (or (not next)
- (and next
- (not (equal? (primary-subtotal-comparator current)
- (primary-subtotal-comparator next))))))
-
- (begin
- (if secondary-subtotal-comparator
- (begin
- (add-subtotal-row (total-string
- (render-summary current 'secondary #f))
- secondary-subtotal-collectors
- def:secondary-subtotal-style
- 'secondary
- (cons (primary-subtotal-comparator current)
- (render-summary current 'primary #f))
- (cons (secondary-subtotal-comparator current)
- (render-summary current 'secondary #f)))
- (for-each (lambda (coll) (coll 'reset #f #f))
- secondary-subtotal-collectors)))
- (add-subtotal-row (total-string
- (render-summary current 'primary #f))
- primary-subtotal-collectors
- def:primary-subtotal-style
- 'primary
- (cons (primary-subtotal-comparator current)
- (render-summary current 'primary #f))
- 'col-total)
- (for-each (lambda (coll) (coll 'reset #f #f))
- primary-subtotal-collectors)
- (if next
- (begin
- (add-subheading (render-summary next 'primary #t)
- def:primary-subtotal-style next 'primary)
- (if secondary-subtotal-comparator
- (add-subheading (render-summary next 'secondary #t)
- def:secondary-subtotal-style next 'secondary)))))
-
- (if (and secondary-subtotal-comparator
+ (lambda (prime-collector sec-collector tot-collector value)
+ (when value
+ (let ((comm (gnc:gnc-monetary-commodity value))
+ (val (gnc:gnc-monetary-amount value)))
+ (prime-collector 'add comm val)
+ (sec-collector 'add comm val)
+ (tot-collector 'add comm val))))
+ primary-subtotal-collectors
+ secondary-subtotal-collectors
+ total-collectors
+ split-values)
+
+ (cond
+ ((and primary-subtotal-comparator
+ (or (not next)
+ (not (equal? (primary-subtotal-comparator current)
+ (primary-subtotal-comparator next)))))
+ (when secondary-subtotal-comparator
+ (add-subtotal-row (total-string
+ (render-summary current 'secondary #f))
+ secondary-subtotal-collectors
+ def:secondary-subtotal-style
+ 'secondary
+ (cons (primary-subtotal-comparator current)
+ (render-summary current 'primary #f))
+ (cons (secondary-subtotal-comparator current)
+ (render-summary current 'secondary #f)))
+ (for-each
+ (lambda (coll)
+ (coll 'reset #f #f))
+ secondary-subtotal-collectors))
+ (add-subtotal-row (total-string
+ (render-summary current 'primary #f))
+ primary-subtotal-collectors
+ def:primary-subtotal-style
+ 'primary
+ (cons (primary-subtotal-comparator current)
+ (render-summary current 'primary #f))
+ 'col-total)
+ (for-each
+ (lambda (coll)
+ (coll 'reset #f #f))
+ primary-subtotal-collectors)
+ (when next
+ (add-subheading (render-summary next 'primary #t)
+ def:primary-subtotal-style next 'primary)
+ (when secondary-subtotal-comparator
+ (add-subheading (render-summary next 'secondary #t)
+ def:secondary-subtotal-style next
+ 'secondary))))
+
+ (else
+ (when (and secondary-subtotal-comparator
(or (not next)
- (and next
- (not (equal? (secondary-subtotal-comparator current)
- (secondary-subtotal-comparator next))))))
- (begin (add-subtotal-row (total-string
- (render-summary current 'secondary #f))
- secondary-subtotal-collectors
- def:secondary-subtotal-style
- 'secondary
- (if primary-subtotal-comparator
- (cons (primary-subtotal-comparator current)
- (render-summary current 'primary #f))
- (cons #f ""))
- (cons (secondary-subtotal-comparator current)
- (render-summary current 'secondary #f)))
- (for-each (lambda (coll) (coll 'reset #f #f))
- secondary-subtotal-collectors)
- (if next
- (add-subheading (render-summary next 'secondary #t)
- def:secondary-subtotal-style next 'secondary)))))
-
- (do-rows-with-subtotals rest (not odd-row?)))))
-
- (define grid (make-grid))
-
- (gnc:html-table-set-col-headers! table (concatenate (list
- (gnc:html-make-empty-cells indent-level)
- headings-left-columns
- headings-right-columns)))
-
- (if (primary-get-info 'renderer-fn)
- (add-subheading (render-summary (car splits) 'primary #t)
- def:primary-subtotal-style (car splits) 'primary))
-
- (if (secondary-get-info 'renderer-fn)
- (add-subheading (render-summary (car splits) 'secondary #t)
- def:secondary-subtotal-style (car splits) 'secondary))
-
- (do-rows-with-subtotals splits #t)
+ (not (equal? (secondary-subtotal-comparator current)
+ (secondary-subtotal-comparator next)))))
+ (add-subtotal-row (total-string
+ (render-summary current 'secondary #f))
+ secondary-subtotal-collectors
+ def:secondary-subtotal-style
+ 'secondary
+ (if primary-subtotal-comparator
+ (cons (primary-subtotal-comparator current)
+ (render-summary current 'primary #f))
+ (cons #f ""))
+ (cons (secondary-subtotal-comparator current)
+ (render-summary current 'secondary #f)))
+ (for-each
+ (lambda (coll)
+ (coll 'reset #f #f))
+ secondary-subtotal-collectors)
+ (when next
+ (add-subheading (render-summary next 'secondary #t)
+ def:secondary-subtotal-style next 'secondary)))))
- (values table
- grid)))
+ (loop rest (not odd-row?) (1+ work-done)))))
+ (values table grid)))
;; grid data structure
(define (make-grid)
@@ -1743,11 +1754,14 @@ be excluded from periodic reporting.")
(define (cell-match? cell row col)
(and (or (not row) (equal? row (vector-ref cell 0)))
(or (not col) (equal? col (vector-ref cell 1)))))
-(define (grid-get grid row col) ; grid filter - get all row/col - if #f then retrieve whole row/col
+(define (grid-get grid row col)
+ ;; grid filter - get all row/col - if #f then retrieve whole row/col
(filter
- (lambda (cell) (cell-match? cell row col))
+ (lambda (cell)
+ (cell-match? cell row col))
grid))
-(define (grid-del grid row col) ; grid filter - del all row/col - if #f then delete whole row/col - CAREFUL!
+(define (grid-del grid row col)
+ ;; grid filter - del all row/col - if #f then delete whole row/col
(filter
(lambda (cell)
(not (cell-match? cell row col)))
@@ -1756,10 +1770,13 @@ be excluded from periodic reporting.")
(delete-duplicates (map (lambda (cell) (vector-ref cell 0)) grid)))
(define (grid-cols grid)
(delete-duplicates (map (lambda (cell) (vector-ref cell 1)) grid)))
-(define (grid-add grid row col data) ;-> misonomer - we don't 'add' to existing data,
- (set! grid (grid-del grid row col)) ;we simply delete old data stored at row/col and
- (set! grid (cons (vector row col data) grid)) ;add again. this is fine because the grid should
- grid) ;never have duplicate data in the trep.
+(define (grid-add grid row col data)
+ ;;misonomer - we don't 'add' to existing data, we delete old data
+ ;;stored at row/col and add again. this is fine because the grid
+ ;;should never have duplicate data in the trep.
+ (set! grid (grid-del grid row col))
+ (set! grid (cons (vector row col data) grid))
+ grid)
(define (grid->html-table grid list-of-rows list-of-cols)
(define row-average-enabled? (> (length list-of-cols) 1))
(define (monetary-div monetary divisor)
@@ -1768,7 +1785,8 @@ be excluded from periodic reporting.")
(currency (gnc:gnc-monetary-commodity monetary))
(scu (gnc-commodity-get-fraction currency)))
(gnc:make-gnc-monetary
- currency (gnc-numeric-convert (/ amount divisor) scu GNC-HOW-RND-ROUND)))))
+ currency (gnc-numeric-convert
+ (/ amount divisor) scu GNC-HOW-RND-ROUND)))))
(define (row->num-of-commodities row)
;; for a row, find the maximum number of commodities being stored
(apply max
@@ -1780,8 +1798,11 @@ be excluded from periodic reporting.")
(define (make-table-cell row col commodity-idx divisor)
(let ((cell (grid-get grid row col)))
(if (null? cell) ""
- (gnc:make-html-table-cell/markup "number-cell"
- (monetary-div (list-ref-safe (vector-ref (car cell) 2) commodity-idx) divisor)))))
+ (gnc:make-html-table-cell/markup
+ "number-cell"
+ (monetary-div
+ (list-ref-safe (vector-ref (car cell) 2) commodity-idx)
+ divisor)))))
(define (make-row row commodity-idx)
(append
(list (cond
@@ -1792,35 +1813,40 @@ be excluded from periodic reporting.")
list-of-cols)
(list (make-table-cell row 'col-total commodity-idx 1))
(if row-average-enabled?
- (list (make-table-cell row 'col-total commodity-idx (length list-of-cols)))
+ (list (make-table-cell
+ row 'col-total commodity-idx (length list-of-cols)))
'())))
(let ((table (gnc:make-html-table)))
(gnc:html-table-set-caption! table optname-grid)
- (gnc:html-table-set-col-headers! table (append (list "") (map cdr list-of-cols) (list (_ "Total"))
- (if row-average-enabled? (list (_ "Average")) '())))
- (gnc:html-table-set-style! table "th"
- 'attribute (list "class" "column-heading-right"))
+ (gnc:html-table-set-col-headers!
+ table (append (list "")
+ (map cdr list-of-cols)
+ (list (_ "Total"))
+ (if row-average-enabled? (list (_ "Average")) '())))
+ (gnc:html-table-set-style!
+ table "th"
+ 'attribute (list "class" "column-heading-right"))
(for-each
(lambda (row)
- (for-each (lambda (commodity-idx)
- (gnc:html-table-append-row! table (make-row row commodity-idx)))
- (iota (row->num-of-commodities row))))
+ (for-each
+ (lambda (commodity-idx)
+ (gnc:html-table-append-row!
+ table (make-row row commodity-idx)))
+ (iota (row->num-of-commodities row))))
(if (memq 'row-total (grid-rows grid))
(append list-of-rows '(row-total))
list-of-rows))
table))
-;; ;;;;;;;;;;;;;;;;;;;;
-;; Here comes the renderer function for this report.
-
-
-(define* (trep-renderer report-obj #:key custom-calculated-cells empty-report-message
- custom-split-filter split->date split->date-include-false?)
- ;; the trep-renderer is a define* function which, at minimum, takes the report object
+(define* (gnc:trep-renderer
+ report-obj #:key custom-calculated-cells empty-report-message
+ custom-split-filter split->date split->date-include-false?)
+ ;; the trep-renderer is a define* function which, at minimum, takes
+ ;; the report object
;;
;; the optional arguments are:
;; #:custom-calculated-cells - a list of vectors to define customized data columns
- ;; #:empty-report-message - a str or html-object which is displayed at the initial report opening
+ ;; #:empty-report-message - a str or html-object displayed at the initial run
;; #:custom-split-filter - a split->bool function to add to the split filter
;; #:split->date - a split->time64 which overrides the default posted date filter
;; (see reconcile report)
@@ -1830,32 +1856,30 @@ be excluded from periodic reporting.")
;; transaction->invoice->payment date.
(define options (gnc:report-options report-obj))
- (define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name)))
- (define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
-
+ (define (opt-val section name)
+ (gnc:option-value (gnc:lookup-option options section name)))
+ (define BOOK-SPLIT-ACTION
+ (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
(define (is-filter-member split account-list)
(let* ((txn (xaccSplitGetParent split))
(splitcount (xaccTransCountSplits txn))
- (other-account (xaccSplitGetAccount (xaccSplitGetOtherSplit split)))
- (splits-equal? (lambda (s1 s2) (xaccSplitEqual s1 s2 #t #f #f)))
- (other-splits (delete split (xaccTransGetSplitList txn) splits-equal?))
- (other-accounts (map xaccSplitGetAccount other-splits))
(is-in-account-list? (lambda (acc) (member acc account-list))))
(cond
- ;; A 2-split transaction - test separately so it can be optimized
- ;; to significantly reduce the number of splits to traverse
- ;; in guile code
- ((= splitcount 2) (is-in-account-list? other-account))
- ;; A multi-split transaction - run over all splits
- ((> splitcount 2) (or-map is-in-account-list? other-accounts))
- ;; Single transaction splits
- (else #f))))
+ ((= splitcount 2)
+ (is-in-account-list?
+ (xaccSplitGetAccount (xaccSplitGetOtherSplit split))))
+ ((> splitcount 2)
+ (or-map is-in-account-list?
+ (map xaccSplitGetAccount
+ (delete split (xaccTransGetSplitList txn)))))
+ (else #f))))
- (gnc:report-starting reportname)
+ (gnc:report-starting (opt-val gnc:pagename-general gnc:optname-reportname))
(let* ((document (gnc:make-html-document))
(account-matcher (opt-val pagename-filter optname-account-matcher))
- (account-matcher-regexp (and (opt-val pagename-filter optname-account-matcher-regex)
+ (account-matcher-regexp (and (opt-val pagename-filter
+ optname-account-matcher-regex)
(catch 'regular-expression-syntax
(lambda () (make-regexp account-matcher))
(const 'invalid-regex))))
@@ -1863,8 +1887,10 @@ be excluded from periodic reporting.")
(c_account_1 (filter
(lambda (acc)
(if (regexp? account-matcher-regexp)
- (regexp-exec account-matcher-regexp (gnc-account-get-full-name acc))
- (string-contains (gnc-account-get-full-name acc) account-matcher)))
+ (regexp-exec account-matcher-regexp
+ (gnc-account-get-full-name acc))
+ (string-contains (gnc-account-get-full-name acc)
+ account-matcher)))
c_account_0))
(c_account_2 (opt-val gnc:pagename-accounts optname-filterby))
(filter-mode (opt-val gnc:pagename-accounts optname-filtertype))
@@ -1875,13 +1901,15 @@ be excluded from periodic reporting.")
(gnc:date-option-absolute-time
(opt-val gnc:pagename-general optname-enddate))))
(transaction-matcher (opt-val pagename-filter optname-transaction-matcher))
- (transaction-matcher-regexp (and (opt-val pagename-filter optname-transaction-matcher-regex)
- (catch 'regular-expression-syntax
- (lambda () (make-regexp transaction-matcher))
- (const 'invalid-regex))))
- (reconcile-status-filter (keylist-get-info reconcile-status-list
- (opt-val pagename-filter optname-reconcile-status)
- 'filter-types))
+ (transaction-matcher-regexp
+ (and (opt-val pagename-filter optname-transaction-matcher-regex)
+ (catch 'regular-expression-syntax
+ (lambda () (make-regexp transaction-matcher))
+ (const 'invalid-regex))))
+ (reconcile-status-filter
+ (keylist-get-info reconcile-status-list
+ (opt-val pagename-filter optname-reconcile-status)
+ 'filter-types))
(report-title (opt-val gnc:pagename-general gnc:optname-reportname))
(primary-key (opt-val pagename-sorting optname-prime-sortkey))
(primary-order (opt-val pagename-sorting optname-prime-sortorder))
@@ -1890,22 +1918,29 @@ be excluded from periodic reporting.")
(secondary-order (opt-val pagename-sorting optname-sec-sortorder))
(secondary-date-subtotal (opt-val pagename-sorting optname-sec-date-subtotal))
(void-status (opt-val pagename-filter optname-void-transactions))
- (closing-match (keylist-get-info show-closing-list
- (opt-val pagename-filter optname-closing-transactions)
- 'closing-match))
+ (closing-match (keylist-get-info
+ show-closing-list
+ (opt-val pagename-filter optname-closing-transactions)
+ 'closing-match))
(splits '())
- (custom-sort? (or (and (member primary-key DATE-SORTING-TYPES) ; this will remain
- (not (eq? primary-date-subtotal 'none))) ; until qof-query
- (and (member secondary-key DATE-SORTING-TYPES) ; is upgraded
+ (custom-sort? (or (and (memq primary-key DATE-SORTING-TYPES)
+ (not (eq? primary-date-subtotal 'none)))
+ (and (memq secondary-key DATE-SORTING-TYPES)
(not (eq? secondary-date-subtotal 'none)))
(or (CUSTOM-SORTING? primary-key BOOK-SPLIT-ACTION)
(CUSTOM-SORTING? secondary-key BOOK-SPLIT-ACTION))))
(subtotal-table? (and (opt-val gnc:pagename-display optname-grid)
(if (memq primary-key DATE-SORTING-TYPES)
- (keylist-get-info date-subtotal-list primary-date-subtotal 'renderer-fn)
+ (keylist-get-info date-subtotal-list
+ primary-date-subtotal 'renderer-fn)
(opt-val pagename-sorting optname-prime-subtotal))
- (eq? (opt-val gnc:pagename-display (N_ "Amount")) 'single)))
+ (eq? (opt-val gnc:pagename-display (N_ "Amount"))
+ 'single)))
(infobox-display (opt-val gnc:pagename-general optname-infobox-display))
+ (match? (lambda (str)
+ (if transaction-matcher-regexp
+ (regexp-exec transaction-matcher-regexp str)
+ (string-contains str transaction-matcher))))
(query (qof-query-create-for-splits)))
(define (generic-less? split-X split-Y sortkey date-subtotal-key ascend?)
@@ -1914,12 +1949,16 @@ be excluded from periodic reporting.")
;; ascend? specifies whether ascending or descending
(let* ((comparator-function
(if (memq sortkey DATE-SORTING-TYPES)
- (let ((date (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'split-sortvalue))
- (date-comparator (keylist-get-info date-subtotal-list date-subtotal-key 'date-sortvalue)))
+ (let ((date (keylist-get-info
+ (sortkey-list BOOK-SPLIT-ACTION)
+ sortkey 'split-sortvalue))
+ (date-comparator
+ (keylist-get-info date-subtotal-list
+ date-subtotal-key 'date-sortvalue)))
(lambda (s)
- (and date-comparator
- (date-comparator (date s)))))
- (or (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'split-sortvalue)
+ (and date-comparator (date-comparator (date s)))))
+ (or (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION)
+ sortkey 'split-sortvalue)
(lambda (s) #f))))
(value-of-X (comparator-function split-X))
(value-of-Y (comparator-function split-Y))
@@ -1942,171 +1981,144 @@ be excluded from periodic reporting.")
(define (date-comparator? X Y)
(generic-less? X Y 'date 'none #t))
- (if (or (or (null? c_account_1) (and-map not c_account_1))
- (eq? account-matcher-regexp 'invalid-regex)
- (eq? transaction-matcher-regexp 'invalid-regex))
-
- ;; error condition: no accounts specified or obtained after filtering
- (begin
+ (cond
+ ((or (null? c_account_1)
+ (eq? account-matcher-regexp 'invalid-regex)
+ (eq? transaction-matcher-regexp 'invalid-regex))
+
+ ;; error condition: no accounts specified or obtained after filtering
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj)))
+
+ ;; if an empty-report-message is passed by a derived report to
+ ;; the renderer, display it here.
+ (when empty-report-message
+ (gnc:html-document-add-object!
+ document
+ empty-report-message))
+
+ (when (memq infobox-display '(always no-match))
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-render-options-changed options))))
+
+ (else
+ (qof-query-set-book query (gnc-get-current-book))
+ (xaccQueryAddAccountMatch query c_account_1 QOF-GUID-MATCH-ANY QOF-QUERY-AND)
+ (unless split->date
+ (xaccQueryAddDateMatchTT query #t begindate #t enddate QOF-QUERY-AND))
+ (case void-status
+ ((non-void-only)
+ (gnc:query-set-match-non-voids-only! query (gnc-get-current-book)))
+ ((void-only)
+ (gnc:query-set-match-voids-only! query (gnc-get-current-book)))
+ (else #f))
+ (when reconcile-status-filter
+ (xaccQueryAddClearedMatch query reconcile-status-filter QOF-QUERY-AND))
+ (when (boolean? closing-match)
+ (xaccQueryAddClosingTransMatch query closing-match QOF-QUERY-AND))
+ (unless custom-sort?
+ (qof-query-set-sort-order
+ query
+ (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) primary-key 'sortkey)
+ (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) secondary-key 'sortkey)
+ '())
+ (qof-query-set-sort-increasing
+ query (eq? primary-order 'ascend) (eq? secondary-order 'ascend)
+ #t))
+
+ (if (opt-val "__trep" "unique-transactions")
+ (set! splits (xaccQueryGetSplitsUniqueTrans query))
+ (set! splits (qof-query-run query)))
+
+ (qof-query-destroy query)
+
+ ;; Combined Filter:
+ ;; - include/exclude using split->date according to date options
+ ;; - include/exclude splits to/from selected accounts
+ ;; - substring/regex matcher for Transaction Description/Notes/Memo
+ ;; - custom-split-filter, a split->bool function for derived reports
+ (set! splits
+ (filter
+ (lambda (split)
+ (let* ((trans (xaccSplitGetParent split)))
+ (and (or (not split->date)
+ (let ((date (split->date split)))
+ (if date
+ (<= begindate date enddate)
+ split->date-include-false?)))
+ (case filter-mode
+ ((none) #t)
+ ((include) (is-filter-member split c_account_2))
+ ((exclude) (not (is-filter-member split c_account_2))))
+ (or (string-null? transaction-matcher)
+ (match? (xaccTransGetDescription trans))
+ (match? (xaccTransGetNotes trans))
+ (match? (xaccSplitGetMemo split)))
+ (or (not custom-split-filter)
+ (custom-split-filter split)))))
+ splits))
+
+ (when custom-sort?
+ (set! splits (stable-sort! splits date-comparator?))
+ (set! splits (stable-sort! splits secondary-comparator?))
+ (set! splits (stable-sort! splits primary-comparator?)))
+ (cond
+ ((null? splits)
+ ;; error condition: no splits found
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-generic-warning
+ report-title (gnc:report-id report-obj)
+ NO-MATCHING-TRANS-HEADER NO-MATCHING-TRANS-TEXT))
+
+ (when (memq infobox-display '(always no-match))
(gnc:html-document-add-object!
document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj)))
+ (gnc:html-render-options-changed options))))
- ;; if an empty-report-message is passed by a derived report to
- ;; the renderer, display it here.
- (if empty-report-message
- (gnc:html-document-add-object!
- document
- empty-report-message))
+ (else
+ (let-values (((table grid)
+ (make-split-table splits options custom-calculated-cells)))
+
+ (gnc:html-document-set-title! document report-title)
- (if (memq infobox-display '(always no-match))
+ (gnc:html-document-add-object!
+ document
+ (gnc:make-html-text
+ (gnc:html-markup-h3
+ (format #f
+ (_ "From ~a to ~a")
+ (qof-print-date begindate)
+ (qof-print-date enddate)))))
+
+ (when (eq? infobox-display 'always)
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-render-options-changed options)))
+
+ (when subtotal-table?
+ (let* ((generic<?
+ (lambda (a b)
+ (cond ((string? (car a)) (string<? (car a) (car b)))
+ ((number? (car a)) (< (car a) (car b)))
+ (else (gnc:error "unknown sortvalue")))))
+ (list-of-rows
+ (stable-sort! (delete 'row-total (grid-rows grid))
+ generic<?))
+ (list-of-cols
+ (stable-sort! (delete 'col-total (grid-cols grid))
+ generic<?)))
(gnc:html-document-add-object!
- document
- (gnc:html-render-options-changed options))))
-
- (begin
-
- (qof-query-set-book query (gnc-get-current-book))
- (xaccQueryAddAccountMatch query c_account_1 QOF-GUID-MATCH-ANY QOF-QUERY-AND)
- (if (not split->date)
- (xaccQueryAddDateMatchTT query #t begindate #t enddate QOF-QUERY-AND))
- (case void-status
- ((non-void-only) (gnc:query-set-match-non-voids-only! query (gnc-get-current-book)))
- ((void-only) (gnc:query-set-match-voids-only! query (gnc-get-current-book)))
- (else #f))
- (if reconcile-status-filter
- (xaccQueryAddClearedMatch query reconcile-status-filter QOF-QUERY-AND))
- (if (boolean? closing-match)
- (xaccQueryAddClosingTransMatch query closing-match QOF-QUERY-AND))
- (if (not custom-sort?)
- (begin
- (qof-query-set-sort-order query
- (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) primary-key 'sortkey)
- (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) secondary-key 'sortkey)
- '())
- (qof-query-set-sort-increasing query
- (eq? primary-order 'ascend)
- (eq? secondary-order 'ascend)
- #t)))
-
- (if (opt-val "__trep" "unique-transactions")
- (set! splits (xaccQueryGetSplitsUniqueTrans query))
- (set! splits (qof-query-run query)))
-
- (qof-query-destroy query)
-
- ;; Combined Filter:
- ;; - include/exclude using split->date according to date options
- ;; - include/exclude splits to/from selected accounts
- ;; - substring/regex matcher for Transaction Description/Notes/Memo
- ;; - custom-split-filter, a split->bool function for derived reports
- (set! splits (filter
- (lambda (split)
- (let* ((trans (xaccSplitGetParent split))
- (match? (lambda (str)
- (if transaction-matcher-regexp
- (regexp-exec transaction-matcher-regexp str)
- (string-contains str transaction-matcher)))))
- (and (or (not split->date) ; #f = ignore custom date filter
- (let ((date (split->date split))) ; cache split->date time64 or #f.
- (if date ; if a split->date exists,
- (<= begindate date enddate) ; then check for inclusion;
- split->date-include-false?))); else behave according to parameter
- (case filter-mode
- ((none) #t)
- ((include) (is-filter-member split c_account_2))
- ((exclude) (not (is-filter-member split c_account_2))))
- (or (string-null? transaction-matcher) ; null-string = ignore filters
- (match? (xaccTransGetDescription trans))
- (match? (xaccTransGetNotes trans))
- (match? (xaccSplitGetMemo split)))
- (or (not custom-split-filter) ; #f = ignore custom-split-filter
- (custom-split-filter split))
- )))
- splits))
-
- (when custom-sort?
- (set! splits (stable-sort! splits date-comparator?))
- (set! splits (stable-sort! splits secondary-comparator?))
- (set! splits (stable-sort! splits primary-comparator?)))
-
- (if (null? splits)
-
- ;; error condition: no splits found
- (begin
-
- (gnc:html-document-add-object!
- document
- (gnc:html-make-generic-warning
- report-title (gnc:report-id report-obj)
- NO-MATCHING-TRANS-HEADER NO-MATCHING-TRANS-TEXT))
-
- (if (memq infobox-display '(always no-match))
- (gnc:html-document-add-object!
- document
- (gnc:html-render-options-changed options))))
-
- (let-values (((table grid) (make-split-table splits options custom-calculated-cells)))
-
- (gnc:html-document-set-title! document report-title)
-
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-h3
- (format #f
- (_ "From ~a to ~a")
- (qof-print-date begindate)
- (qof-print-date enddate)))))
-
- (if (eq? infobox-display 'always)
- (gnc:html-document-add-object!
- document
- (gnc:html-render-options-changed options)))
-
- (if subtotal-table?
- (let* ((generic<? (lambda (a b)
- (cond ((string? (car a)) (string<? (car a) (car b)))
- ((number? (car a)) (< (car a) (car b)))
- (else (gnc:error "unknown sortvalue")))))
- (list-of-rows (stable-sort! (delete 'row-total (grid-rows grid)) generic<?))
- (list-of-cols (stable-sort! (delete 'col-total (grid-cols grid)) generic<?)))
- (gnc:html-document-add-object!
- document (grid->html-table grid list-of-rows list-of-cols))))
-
- (unless (and subtotal-table?
- (opt-val pagename-sorting optname-show-subtotals-only))
- (gnc:html-document-add-object! document table))))))
+ document (grid->html-table grid list-of-rows list-of-cols))))
+
+ (unless (and subtotal-table?
+ (opt-val pagename-sorting optname-show-subtotals-only))
+ (gnc:html-document-add-object! document table)))))))
(gnc:report-finished)
document))
-
-(define trep-guid "2fe3b9833af044abb929a88d5a59620f")
-(export trep-guid)
-(export trep-renderer)
-(export trep-options-generator)
-
-;; Define the report.
-(gnc:define-report
- 'version 1
- 'name (_ "Reconciliation Report")
- 'report-guid "e45218c6d76f11e7b5ef0800277ef320"
- 'options-generator reconcile-report-options-generator
- ;; the renderer is the same as trep, however we're using a different split-date strategy.
- ;; we're comparing reconcile date for inclusion, and if split is unreconciled, include it anyway.
- 'renderer (lambda (rpt) (trep-renderer rpt
- #:custom-calculated-cells reconcile-report-calculated-cells
- #:split->date split->reconcile-date
- #:split->date-include-false? #t
- #:empty-report-message reconcile-report-instructions)))
-
-;; Define the report.
-(gnc:define-report
- 'version 1
- 'name reportname
- 'report-guid trep-guid
- 'options-generator trep-options-generator
- 'renderer trep-renderer)
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index d1b3b94fa..868526193 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1,24 +1,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; transaction-report.scm : Report on all transactions in account(s)
;;
-;; Original report by Robert Merkel <rgmerk at mira.net>
-;; Contributions by Bryan Larsen <blarsen at ada-works.com>
-;; More contributions for new report generation code by Robert Merkel
-;; More contributions by Christian Stimming <stimming at tuhh.de>
-;; Modified to support the intersection of two account lists by
-;; Michael T. Garrison Stuber
-;; Modified account names display by Tomas Pospisek
-;; <tpo_deb at sourcepole.ch> with a lot of help from "warlord"
-;; Refactored by Christopher Lam (2017)
-;; - introduced account/transaction substring/regex matcher
-;; - add custom sorter in scheme
-;; - common currency - optionally show original currency amount
-;; and enable multiple data columns
-;; - add support for indenting for better grouping
-;; - add defaults suitable for a reconciliation report
-;; including alternative date filtering strategy
-;; - add subtotal summary grid
-;; - by default, exclude closing transactions from the report
+;; calls transaction report functions in trep-engine.scm
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -41,2072 +24,13 @@
(define-module (gnucash report standard-reports transaction))
-(use-modules (gnucash utilities))
-(use-modules (srfi srfi-1))
-(use-modules (srfi srfi-11))
-(use-modules (srfi srfi-13))
-(use-modules (ice-9 regex))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-
(gnc:module-load "gnucash/report/report-system" 0)
-;; Define the strings here to avoid typos and make changes easier.
-(define reportname (N_ "Transaction Report"))
-
-;;Accounts
-(define optname-accounts (N_ "Accounts"))
-(define optname-filterby (N_ "Filter By..."))
-(define optname-filtertype (N_ "Filter Type"))
-
-;;Display
-(define optname-detail-level (N_ "Detail Level"))
-(define optname-grid (N_ "Subtotal Table"))
-
-;;Sorting
-(define pagename-sorting (N_ "Sorting"))
-(define optname-prime-sortkey (N_ "Primary Key"))
-(define optname-prime-subtotal (N_ "Primary Subtotal"))
-(define optname-prime-sortorder (N_ "Primary Sort Order"))
-(define optname-prime-date-subtotal (N_ "Primary Subtotal for Date Key"))
-(define optname-full-account-name (N_ "Show Full Account Name"))
-(define optname-show-account-code (N_ "Show Account Code"))
-(define optname-show-account-description (N_ "Show Account Description"))
-(define optname-show-informal-headers (N_ "Show Informal Debit/Credit Headers"))
-(define optname-show-subtotals-only (N_ "Show subtotals only (hide transactional data)"))
-(define optname-indenting (N_ "Add indenting columns"))
-(define optname-sec-sortkey (N_ "Secondary Key"))
-(define optname-sec-subtotal (N_ "Secondary Subtotal"))
-(define optname-sec-sortorder (N_ "Secondary Sort Order"))
-(define optname-sec-date-subtotal (N_ "Secondary Subtotal for Date Key"))
-
-;;General
-(define optname-startdate (N_ "Start Date"))
-(define optname-enddate (N_ "End Date"))
-(define optname-table-export (N_ "Table for Exporting"))
-(define optname-common-currency (N_ "Common Currency"))
-(define optname-orig-currency (N_ "Show original currency amount"))
-(define optname-currency (N_ "Report's currency"))
-(define optname-infobox-display (N_ "Add options summary"))
-
-;;Filtering
-(define pagename-filter (N_ "Filter"))
-(define optname-account-matcher (N_ "Account Name Filter"))
-(define optname-account-matcher-regex (N_ "Use regular expressions for account name filter"))
-(define optname-transaction-matcher (N_ "Transaction Filter"))
-(define optname-transaction-matcher-regex (N_ "Use regular expressions for transaction filter"))
-(define optname-reconcile-status (N_ "Reconcile Status"))
-(define optname-void-transactions (N_ "Void Transactions"))
-(define optname-closing-transactions (N_ "Closing transactions"))
-
-;;Styles
-(define def:grand-total-style "grand-total")
-(define def:normal-row-style "normal-row")
-(define def:alternate-row-style "alternate-row")
-(define def:primary-subtotal-style "primary-subheading")
-(define def:secondary-subtotal-style "secondary-subheading")
-
-(define NO-MATCHING-TRANS-HEADER (_ "No matching transactions found"))
-(define NO-MATCHING-TRANS-TEXT (_ "No transactions were found that \
-match the time interval and account selection specified \
-in the Options panel."))
-
-(define DATE-SORTING-TYPES (list 'date 'reconciled-date))
-
-(define ACCOUNT-SORTING-TYPES (list 'account-name 'corresponding-acc-name
- 'account-code 'corresponding-acc-code))
-
-(define SORTKEY-INFORMAL-HEADERS (list 'account-name 'account-code))
-
-(define (sortkey-list split-action?)
- ;;
- ;; Defines the different sorting keys, as an association-list
- ;; together with the subtotal functions. Each entry:
- ;; 'sortkey - sort parameter sent via qof-query
- ;; 'split-sortvalue - function which retrieves number/string used for comparing splits
- ;; 'text - text displayed in Display tab
- ;; 'tip - tooltip displayed in Display tab
- ;; 'renderer-fn - helper function to select subtotal/subheading renderer
- ;; behaviour varies according to sortkey.
- ;; account-types converts split->account
- ;; #f means the sortkey cannot be subtotalled
- ;; otherwise it converts split->string
- ;;
- (list (cons 'account-name (list (cons 'sortkey (list SPLIT-ACCT-FULLNAME))
- (cons 'split-sortvalue (lambda (a) (gnc-account-get-full-name (xaccSplitGetAccount a))))
- (cons 'text (_ "Account Name"))
- (cons 'tip (_ "Sort & subtotal by account name."))
- (cons 'renderer-fn (lambda (a) (xaccSplitGetAccount a)))))
-
- (cons 'account-code (list (cons 'sortkey (list SPLIT-ACCOUNT ACCOUNT-CODE-))
- (cons 'split-sortvalue (lambda (a) (xaccAccountGetCode (xaccSplitGetAccount a))))
- (cons 'text (_ "Account Code"))
- (cons 'tip (_ "Sort & subtotal by account code."))
- (cons 'renderer-fn (lambda (a) (xaccSplitGetAccount a)))))
-
- (cons 'date (list (cons 'sortkey (list SPLIT-TRANS TRANS-DATE-POSTED))
- (cons 'split-sortvalue (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
- (cons 'text (_ "Date"))
- (cons 'tip (_ "Sort by date."))
- (cons 'renderer-fn #f)))
-
- (cons 'reconciled-date (list (cons 'sortkey (list SPLIT-DATE-RECONCILED))
- (cons 'split-sortvalue (lambda (s) (xaccSplitGetDateReconciled s)))
- (cons 'text (_ "Reconciled Date"))
- (cons 'tip (_ "Sort by the Reconciled Date."))
- (cons 'renderer-fn #f)))
-
- (cons 'reconciled-status (list (cons 'sortkey #f)
- (cons 'split-sortvalue (lambda (s) (length (memq (xaccSplitGetReconcile s)
- '(#\n #\c #\y #\f #\v)))))
- (cons 'text (_ "Reconciled Status"))
- (cons 'tip (_ "Sort by the Reconciled Status"))
- (cons 'renderer-fn (lambda (s) (case (xaccSplitGetReconcile s)
- ((#\y) (_ "Reconciled"))
- ((#\c) (_ "Cleared"))
- ((#\n) (_ "Unreconciled"))
- ((#\f) (_ "Frozen"))
- ((#\v) (_ "Voided"))
- (else (_ "Unknown")))))))
-
- (cons 'register-order (list (cons 'sortkey (list QUERY-DEFAULT-SORT))
- (cons 'split-sortvalue #f)
- (cons 'text (_ "Register Order"))
- (cons 'tip (_ "Sort as in the register."))
- (cons 'renderer-fn #f)))
-
- (cons 'corresponding-acc-name (list (cons 'sortkey (list SPLIT-CORR-ACCT-NAME))
- (cons 'split-sortvalue (lambda (a) (xaccSplitGetCorrAccountFullName a)))
- (cons 'text (_ "Other Account Name"))
- (cons 'tip (_ "Sort by account transferred from/to's name."))
- (cons 'renderer-fn (lambda (a) (xaccSplitGetAccount (xaccSplitGetOtherSplit a))))))
-
- (cons 'corresponding-acc-code (list (cons 'sortkey (list SPLIT-CORR-ACCT-CODE))
- (cons 'split-sortvalue (lambda (a) (xaccSplitGetCorrAccountCode a)))
- (cons 'text (_ "Other Account Code"))
- (cons 'tip (_ "Sort by account transferred from/to's code."))
- (cons 'renderer-fn (lambda (a) (xaccSplitGetAccount (xaccSplitGetOtherSplit a))))))
-
- (cons 'amount (list (cons 'sortkey (list SPLIT-VALUE))
- (cons 'split-sortvalue (lambda (a) (gnc-numeric-to-scm (xaccSplitGetValue a))))
- (cons 'text (_ "Amount"))
- (cons 'tip (_ "Sort by amount."))
- (cons 'renderer-fn #f)))
-
- (cons 'description (list (cons 'sortkey (list SPLIT-TRANS TRANS-DESCRIPTION))
- (cons 'split-sortvalue (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s))))
- (cons 'text (_ "Description"))
- (cons 'tip (_ "Sort by description."))
- (cons 'renderer-fn (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s))))))
-
- (if split-action?
- (cons 'number (list (cons 'sortkey (list SPLIT-ACTION))
- (cons 'split-sortvalue (lambda (a) (xaccSplitGetAction a)))
- (cons 'text (_ "Number/Action"))
- (cons 'tip (_ "Sort by check number/action."))
- (cons 'renderer-fn #f)))
-
- (cons 'number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
- (cons 'split-sortvalue (lambda (a) (xaccTransGetNum (xaccSplitGetParent a))))
- (cons 'text (_ "Number"))
- (cons 'tip (_ "Sort by check/transaction number."))
- (cons 'renderer-fn #f))))
-
- (cons 't-number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
- (cons 'split-sortvalue (lambda (a) (xaccTransGetNum (xaccSplitGetParent a))))
- (cons 'text (_ "Transaction Number"))
- (cons 'tip (_ "Sort by transaction number."))
- (cons 'renderer-fn #f)))
-
- (cons 'memo (list (cons 'sortkey (list SPLIT-MEMO))
- (cons 'split-sortvalue (lambda (s) (xaccSplitGetMemo s)))
- (cons 'text (_ "Memo"))
- (cons 'tip (_ "Sort by memo."))
- (cons 'renderer-fn (lambda (s) (xaccSplitGetMemo s)))))
-
- (cons 'notes (list (cons 'sortkey #f)
- (cons 'split-sortvalue (lambda (s) (xaccTransGetNotes (xaccSplitGetParent s))))
- (cons 'text (_ "Notes"))
- (cons 'tip (_ "Sort by transaction notes."))
- (cons 'renderer-fn (lambda (s) (xaccTransGetNotes (xaccSplitGetParent s))))))
-
- (cons 'none (list (cons 'sortkey '())
- (cons 'split-sortvalue #f)
- (cons 'text (_ "None"))
- (cons 'tip (_ "Do not sort."))
- (cons 'renderer-fn #f)))))
-
-(define (time64-year t64) (gnc:date-get-year (gnc-localtime t64)))
-(define (time64-quarter t64) (+ (* 10 (gnc:date-get-year (gnc-localtime t64))) (gnc:date-get-quarter (gnc-localtime t64))))
-(define (time64-month t64) (+ (* 100 (gnc:date-get-year (gnc-localtime t64))) (gnc:date-get-month (gnc-localtime t64))))
-(define (time64-week t64) (gnc:date-get-week (gnc-localtime t64)))
-(define (time64-day t64) (+ (* 500 (gnc:date-get-year (gnc-localtime t64))) (gnc:date-get-year-day (gnc-localtime t64))))
-(define (time64->daily-string t) (qof-print-date t))
-(define (split->time64 s) (xaccTransGetDate (xaccSplitGetParent s)))
-
-(define date-subtotal-list
- ;; List for date option.
- ;; Defines the different date sorting keys, as an association-list. Each entry:
- ;; 'split-sortvalue - function which retrieves number/string used for comparing splits
- ;; 'text - text displayed in Display tab
- ;; 'tip - tooltip displayed in Display tab
- ;; 'renderer-fn - func retrieve string for subtotal/subheading renderer
- ;; #f means the date sortkey is not grouped
- ;; otherwise it converts split->string
- (list
- (cons 'none (list
- (cons 'split-sortvalue #f)
- (cons 'date-sortvalue #f)
- (cons 'text (_ "None"))
- (cons 'tip (_ "None."))
- (cons 'renderer-fn #f)))
-
- (cons 'daily (list
- (cons 'split-sortvalue (lambda (s) (time64-day (split->time64 s))))
- (cons 'date-sortvalue time64-day)
- (cons 'text (_ "Daily"))
- (cons 'tip (_ "Daily."))
- (cons 'renderer-fn (lambda (s) (time64->daily-string (split->time64 s))))))
-
- (cons 'weekly (list
- (cons 'split-sortvalue (lambda (s) (time64-week (split->time64 s))))
- (cons 'date-sortvalue time64-week)
- (cons 'text (_ "Weekly"))
- (cons 'tip (_ "Weekly."))
- (cons 'renderer-fn (lambda (s) (gnc:date-get-week-year-string (gnc-localtime (split->time64 s)))))))
-
- (cons 'monthly (list
- (cons 'split-sortvalue (lambda (s) (time64-month (split->time64 s))))
- (cons 'date-sortvalue time64-month)
- (cons 'text (_ "Monthly"))
- (cons 'tip (_ "Monthly."))
- (cons 'renderer-fn (lambda (s) (gnc:date-get-month-year-string (gnc-localtime (split->time64 s)))))))
-
- (cons 'quarterly (list
- (cons 'split-sortvalue (lambda (s) (time64-quarter (split->time64 s))))
- (cons 'date-sortvalue time64-quarter)
- (cons 'text (_ "Quarterly"))
- (cons 'tip (_ "Quarterly."))
- (cons 'renderer-fn (lambda (s) (gnc:date-get-quarter-year-string (gnc-localtime (split->time64 s)))))))
-
- (cons 'yearly (list
- (cons 'split-sortvalue (lambda (s) (time64-year (split->time64 s))))
- (cons 'date-sortvalue time64-year)
- (cons 'text (_ "Yearly"))
- (cons 'tip (_ "Yearly."))
- (cons 'renderer-fn (lambda (s) (gnc:date-get-year-string (gnc-localtime (split->time64 s)))))))))
-
-(define filter-list
- (list
- (cons 'none (list
- (cons 'text (_ "None"))
- (cons 'tip (_ "Do not do any filtering."))))
-
- (cons 'include (list
- (cons 'text (_ "Include Transactions to/from Filter Accounts"))
- (cons 'tip (_ "Include transactions to/from filter accounts only."))))
-
- (cons 'exclude (list
- (cons 'text (_ "Exclude Transactions to/from Filter Accounts"))
- (cons 'tip (_ "Exclude transactions to/from all filter accounts."))))))
-
-(define show-void-list
- (list
- (cons 'non-void-only (list
- (cons 'text (_ "Non-void only"))
- (cons 'tip (_ "Show only non-voided transactions."))))
-
- (cons 'void-only (list
- (cons 'text (_ "Void only"))
- (cons 'tip (_ "Show only voided transactions."))))
-
- (cons 'both (list
- (cons 'text (_ "Both"))
- (cons 'tip (_ "Show both (and include void transactions in totals)."))))))
-
-(define show-closing-list
- (list
- (cons 'exclude-closing (list
- (cons 'text (_ "Exclude closing transactions"))
- (cons 'tip (_ "Exclude closing transactions from report."))
- (cons 'closing-match #f)))
-
- (cons 'include-both (list
- (cons 'text (_ "Show both closing and regular transactions"))
- (cons 'tip (_ "Show both (and include closing transactions in totals)."))
- (cons 'closing-match 'both)))
-
- (cons 'closing-only (list
- (cons 'text (_ "Show closing transactions only"))
- (cons 'tip (_ "Show only closing transactions."))
- (cons 'closing-match #t)))))
-
-(define reconcile-status-list
- ;; 'filter-types must be either #f (i.e. disable reconcile filter)
- ;; or a value defined as defined in Query.c
- ;; e.g. CLEARED-NO for unreconciled
- ;; (logior CLEARED-NO CLEARED-CLEARED) for unreconciled & cleared
- (list
- (cons 'all
- (list
- (cons 'text (_ "All"))
- (cons 'tip (_ "Show All Transactions"))
- (cons 'filter-types #f)))
-
- (cons 'unreconciled
- (list
- (cons 'text (_ "Unreconciled"))
- (cons 'tip (_ "Unreconciled only"))
- (cons 'filter-types CLEARED-NO)))
-
- (cons 'cleared
- (list
- (cons 'text (_ "Cleared"))
- (cons 'tip (_ "Cleared only"))
- (cons 'filter-types CLEARED-CLEARED)))
-
- (cons 'reconciled
- (list
- (cons 'text (_ "Reconciled"))
- (cons 'tip (_ "Reconciled only"))
- (cons 'filter-types CLEARED-RECONCILED)))))
-
-
-(define ascending-list
- (list
- (cons 'ascend (list
- (cons 'text (_ "Ascending"))
- (cons 'tip (_ "Smallest to largest, earliest to latest."))))
- (cons 'descend (list
- (cons 'text (_ "Descending"))
- (cons 'tip (_ "Largest to smallest, latest to earliest."))))))
-
-(define sign-reverse-list
- (list
- (cons 'global
- (list
- (cons 'text (_ "Use Global Preference"))
- (cons 'tip (_ "Use reversing option specified in global preference."))
- (cons 'acct-types #f)))
- (cons 'none
- (list
- (cons 'text (_ "None"))
- (cons 'tip (_ "Don't change any displayed amounts."))
- (cons 'acct-types '())))
- (cons 'income-expense
- (list
- (cons 'text (_ "Income and Expense"))
- (cons 'tip (_ "Reverse amount display for Income and Expense Accounts."))
- (cons 'acct-types (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE))))
- (cons 'credit-accounts
- (list
- (cons 'text (_ "Credit Accounts"))
- (cons 'tip (_ "Reverse amount display for Liability, Payable, Equity, \
-Credit Card, and Income accounts."))
- (cons 'acct-types (list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE
- ACCT-TYPE-EQUITY ACCT-TYPE-CREDIT
- ACCT-TYPE-INCOME))))))
-
-(define (keylist-get-info keylist key info)
- (cdr (assq info (cdr (assq key keylist)))))
-
-(define (keylist->vectorlist keylist)
- (map
- (lambda (item)
- (vector
- (car item)
- (keylist-get-info keylist (car item) 'text)
- (keylist-get-info keylist (car item) 'tip)))
- keylist))
-
-(define (SUBTOTAL-ENABLED? sortkey split-action?)
- ;; this returns whether sortkey *can* be subtotalled/grouped.
- ;; it checks whether a renderer-fn is defined.
- (keylist-get-info (sortkey-list split-action?) sortkey 'renderer-fn))
-
-(define (CUSTOM-SORTING? sortkey split-action?)
- ;; sortkey -> bool
- ;;
- ;; this returns which sortkeys which *must* use the custom sorter.
- ;; it filters whereby a split-sortvalue is defined (i.e. the splits
- ;; can be compared according to their 'sortvalue) but the QofQuery
- ;; sortkey is not defined (i.e. their 'sortkey is #f).
- (and (keylist-get-info (sortkey-list split-action?) sortkey 'split-sortvalue)
- (not (keylist-get-info (sortkey-list split-action?) sortkey 'sortkey))))
-
-;;
-;; Set defaults for reconcilation report
-;;
-(define (reconcile-report-options-generator)
- (define options (trep-options-generator))
- (gnc:option-set-value (gnc:lookup-option options pagename-sorting optname-prime-sortkey) 'reconciled-status)
- (gnc:option-set-value (gnc:lookup-option options pagename-sorting optname-sec-sortkey) 'date)
- (gnc:option-set-value (gnc:lookup-option options pagename-sorting optname-sec-date-subtotal) 'none)
- ;; the start date should really be the last-reconcile-date but this information is not
- ;; easily accessible from scheme:
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-general optname-startdate) (cons 'relative 'start-prev-quarter))
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-general optname-enddate) (cons 'relative 'today))
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-display (N_ "Reconciled Date")) #t)
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-display (N_ "Running Balance")) #f)
- (gnc:option-set-value (gnc:lookup-option options gnc:pagename-display (N_ "Memo")) #f)
- (gnc:option-make-internal! options gnc:pagename-display "Running Balance")
- options)
-
-(define reconcile-report-instructions
- (gnc:make-html-text
- (_ "The reconcile report is designed to be similar to the formal reconciliation tool.
-Please select the account from Report Options. Please note the dates specified in the options
-will apply to the Reconciliation Date.")
- (gnc:html-markup-br)
- (gnc:html-markup-br)))
-
-;; if split is reconciled, retrieve its reconciled date; if not yet reconciled, return #f
-(define (split->reconcile-date split)
- (and (char=? (xaccSplitGetReconcile split) #\y)
- (xaccSplitGetDateReconciled split)))
-
-(define (reconcile-report-calculated-cells options)
- (define (opt-val section name)
- (gnc:option-value (gnc:lookup-option options section name)))
- (letrec
- ((split-amount (lambda (s) (if (gnc:split-voided? s)
- (xaccSplitVoidFormerAmount s)
- (xaccSplitGetAmount s))))
- (split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
- (amount (lambda (s) (gnc:make-gnc-monetary (split-currency s) (split-amount s))))
- (debit-amount (lambda (s) (and (positive? (split-amount s))
- (amount s))))
- (credit-amount (lambda (s) (and (not (positive? (split-amount s)))
- (gnc:monetary-neg (amount s))))))
- ;; similar to default-calculated-cells but disable dual-subtotals.
- (list (vector (_ "Funds In")
- debit-amount #f #t #f
- (const ""))
- (vector (_ "Funds Out")
- credit-amount #f #t #f
- (const "")))))
-;;
-;; Default Transaction Report
-;;
-(define (trep-options-generator)
-
- (define options (gnc:new-options))
- (define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
- (define (gnc:register-trep-option new-option)
- (gnc:register-option options new-option))
-
- ;; (Feb 2018) Note to future hackers - this trep-options-generator
- ;; defines a long set of options to be assigned as an object in
- ;; the report. This long list (52 at Feb 2018 count) of options
- ;; may be modified in a derived report (see income-gst-statement.scm)
- ;; via gnc:make-internal! and gnc-unregister-option to hide
- ;; and remove options, respectively. If an option is unregistered,
- ;; don't forget to re-register them via gnc:register-option, unless
- ;; your derived report truly does not require them.
-
- ;; General options
-
- (gnc:options-add-date-interval!
- options gnc:pagename-general optname-startdate optname-enddate "a")
-
- (gnc:register-trep-option
- (gnc:make-complex-boolean-option
- gnc:pagename-general optname-common-currency
- "e" (_ "Convert all transactions into a common currency.") #f
- #f
- (lambda (x)
- (begin
- (gnc-option-db-set-option-selectable-by-name options
- gnc:pagename-general
- optname-currency x)
- (gnc-option-db-set-option-selectable-by-name options
- gnc:pagename-general
- optname-orig-currency x)))))
-
- (gnc:options-add-currency!
- options gnc:pagename-general optname-currency "f")
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-general optname-orig-currency
- "f1" (_ "Also show original currency amounts") #f))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-general optname-table-export
- "g" (_ "Formats the table suitable for cut & paste exporting with extra cells.") #f))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- gnc:pagename-general optname-infobox-display
- "h" (_ "Add summary of options.")
- 'no-match
- ;; This is an alist of conditions for displaying the infobox
- ;; 'no-match for empty-report
- ;; 'match for generated report
- (list (vector 'no-match
- (_ "If no transactions matched")
- (_ "Display summary if no transactions were matched."))
- (vector 'always
- (_ "Always")
- (_ "Always display summary."))
- (vector 'never
- (_ "Never")
- (_ "Disable report summary.")))))
-
- ;; Filtering Options
-
- (gnc:register-trep-option
- (gnc:make-string-option
- pagename-filter optname-account-matcher
- "a5" (_ "Show only accounts whose full name matches this filter e.g. ':Travel' will match \
-Expenses:Travel:Holiday and Expenses:Business:Travel. It can be left blank, which will \
-disable the filter.")
- ""))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-filter optname-account-matcher-regex
- "a6"
- (_ "By default the account filter will search substring only. Set this to true to \
-enable full POSIX regular expressions capabilities. 'Car|Flights' will match both \
-Expenses:Car and Expenses:Flights. Use a period (.) to match a single character e.g. \
-'20../.' will match 'Travel 2017/1 London'. ")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-string-option
- pagename-filter optname-transaction-matcher
- "i1" (_ "Show only transactions where description, notes, or memo matches this filter.
-e.g. '#gift' will find all transactions with #gift in description, notes or memo. It can be left \
-blank, which will disable the filter.")
- ""))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-filter optname-transaction-matcher-regex
- "i2"
- (_ "By default the transaction filter will search substring only. Set this to true to \
-enable full POSIX regular expressions capabilities. '#work|#family' will match both \
-tags within description, notes or memo. ")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- pagename-filter optname-reconcile-status
- "j1" (_ "Filter by reconcile status.")
- 'all
- (keylist->vectorlist reconcile-status-list)))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- pagename-filter optname-void-transactions
- "k" (N_ "How to handle void transactions.")
- 'non-void-only
- (keylist->vectorlist show-void-list)))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- pagename-filter optname-closing-transactions
- "l" (_ "By default most users should not include closing \
-transactions in a transaction report. Closing transactions are \
-transfers from income and expense accounts to equity, and must usually \
-be excluded from periodic reporting.")
- 'exclude-closing
- (keylist->vectorlist show-closing-list)))
-
- ;; Accounts options
-
- ;; account to do report on
- (gnc:register-trep-option
- (gnc:make-account-list-option
- gnc:pagename-accounts optname-accounts
- "a" (_ "Report on these accounts.")
- ;; select, by default, no accounts! Selecting all accounts will
- ;; always imply an insanely long waiting time upon opening, and it
- ;; is almost never useful. So we instead display the normal error
- ;; message saying "Click here", and the user knows how to
- ;; continue.
- (lambda ()
- '())
- #f #t))
-
- (gnc:register-trep-option
- (gnc:make-account-list-option
- gnc:pagename-accounts optname-filterby
- "c1" (_ "Filter on these accounts.")
- (lambda ()
- '())
- #f #t))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-callback-option
- gnc:pagename-accounts optname-filtertype
- "c" (_ "Filter account.")
- 'none
- (keylist->vectorlist filter-list)
- #f
- (lambda (x)
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-accounts optname-filterby
- (not (eq? x 'none))))))
-
- ;; Sorting options
-
- (let ((ascending-choice-list (keylist->vectorlist ascending-list))
- (key-choice-list (keylist->vectorlist (sortkey-list BOOK-SPLIT-ACTION)))
- (date-subtotal-choice-list (keylist->vectorlist date-subtotal-list))
- (prime-sortkey 'account-name)
- (prime-sortkey-subtotal-true #t)
- (prime-date-subtotal 'monthly)
- (sec-sortkey 'register-order)
- (sec-sortkey-subtotal-true #f)
- (sec-date-subtotal 'monthly))
-
- (define (apply-selectable-by-name-sorting-options)
- (let* ((prime-sortkey-enabled (not (eq? prime-sortkey 'none)))
- (prime-sortkey-subtotal-enabled (SUBTOTAL-ENABLED? prime-sortkey BOOK-SPLIT-ACTION))
- (prime-date-sortingtype-enabled (member prime-sortkey DATE-SORTING-TYPES))
- (sec-sortkey-enabled (not (eq? sec-sortkey 'none)))
- (sec-sortkey-subtotal-enabled (SUBTOTAL-ENABLED? sec-sortkey BOOK-SPLIT-ACTION))
- (sec-date-sortingtype-enabled (member sec-sortkey DATE-SORTING-TYPES)))
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-prime-subtotal
- prime-sortkey-subtotal-enabled)
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-prime-sortorder
- prime-sortkey-enabled)
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-sec-subtotal
- sec-sortkey-subtotal-enabled)
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-sec-sortorder
- sec-sortkey-enabled)
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-full-account-name
- (or (and prime-sortkey-subtotal-enabled prime-sortkey-subtotal-true)
- (and sec-sortkey-subtotal-enabled sec-sortkey-subtotal-true)))
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-show-account-code
- (or (and prime-sortkey-subtotal-enabled prime-sortkey-subtotal-true)
- (and sec-sortkey-subtotal-enabled sec-sortkey-subtotal-true)))
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-show-account-description
- (or (and prime-sortkey-subtotal-enabled prime-sortkey-subtotal-true)
- (and sec-sortkey-subtotal-enabled sec-sortkey-subtotal-true)))
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-indenting
- (or (and prime-sortkey-subtotal-enabled prime-sortkey-subtotal-true)
- (and sec-sortkey-subtotal-enabled sec-sortkey-subtotal-true)
- (and prime-date-sortingtype-enabled (not (eq? 'none prime-date-subtotal)))
- (and sec-date-sortingtype-enabled (not (eq? 'none sec-date-subtotal)))))
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-show-subtotals-only
- (or (and prime-sortkey-subtotal-enabled prime-sortkey-subtotal-true)
- (and sec-sortkey-subtotal-enabled sec-sortkey-subtotal-true)
- (and prime-date-sortingtype-enabled (not (eq? 'none prime-date-subtotal)))
- (and sec-date-sortingtype-enabled (not (eq? 'none sec-date-subtotal)))))
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-show-informal-headers
- (or (member prime-sortkey (list 'account-name 'account-code))
- (member sec-sortkey (list 'account-name 'account-code))))
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-prime-date-subtotal
- prime-date-sortingtype-enabled)
-
- (gnc-option-db-set-option-selectable-by-name
- options pagename-sorting optname-sec-date-subtotal
- sec-date-sortingtype-enabled)))
-
- ;; primary sorting criterion
- (gnc:register-trep-option
- (gnc:make-multichoice-callback-option
- pagename-sorting optname-prime-sortkey
- "a" (_ "Sort by this criterion first.")
- prime-sortkey
- key-choice-list #f
- (lambda (x)
- (set! prime-sortkey x)
- (apply-selectable-by-name-sorting-options))))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-sorting optname-full-account-name
- "j1"
- (_ "Show the full account name for subtotals and subheadings?")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-sorting optname-show-account-code
- "j2"
- (_ "Show the account code for subtotals and subheadings?")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-sorting optname-show-account-description
- "j3"
- (_ "Show the account description for subheadings?")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-sorting optname-show-informal-headers
- "j4"
- (_ "Show the informal headers for debit/credit accounts?")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-sorting optname-indenting
- "j5"
- (_ "Add indenting columns with grouping and subtotals?")
- #t))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-sorting optname-show-subtotals-only
- "j6"
- (_ "Show subtotals only, hiding transactional detail?")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-complex-boolean-option
- pagename-sorting optname-prime-subtotal
- "e5"
- (_ "Subtotal according to the primary key?")
- prime-sortkey-subtotal-true #f
- (lambda (x)
- (set! prime-sortkey-subtotal-true x)
- (apply-selectable-by-name-sorting-options))))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-callback-option
- pagename-sorting optname-prime-date-subtotal
- "e2" (_ "Do a date subtotal.")
- prime-date-subtotal
- date-subtotal-choice-list #f
- (lambda (x)
- (set! prime-date-subtotal x)
- (apply-selectable-by-name-sorting-options))))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- pagename-sorting optname-prime-sortorder
- "e" (_ "Order of primary sorting.")
- 'ascend
- ascending-choice-list))
-
- ;; Secondary sorting criterion
- (gnc:register-trep-option
- (gnc:make-multichoice-callback-option
- pagename-sorting optname-sec-sortkey
- "f"
- (_ "Sort by this criterion second.")
- sec-sortkey
- key-choice-list #f
- (lambda (x)
- (set! sec-sortkey x)
- (apply-selectable-by-name-sorting-options))))
-
- (gnc:register-trep-option
- (gnc:make-complex-boolean-option
- pagename-sorting optname-sec-subtotal
- "i5"
- (_ "Subtotal according to the secondary key?")
- sec-sortkey-subtotal-true #f
- (lambda (x)
- (set! sec-sortkey-subtotal-true x)
- (apply-selectable-by-name-sorting-options))))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-callback-option
- pagename-sorting optname-sec-date-subtotal
- "i2" (_ "Do a date subtotal.")
- sec-date-subtotal
- date-subtotal-choice-list #f
- (lambda (x)
- (set! sec-date-subtotal x)
- (apply-selectable-by-name-sorting-options))))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- pagename-sorting optname-sec-sortorder
- "i" (_ "Order of Secondary sorting.")
- 'ascend
- ascending-choice-list)))
-
- ;; Display options
-
- (let ((disp-memo? #t)
- (disp-accname? #t)
- (disp-other-accname? #f)
- (detail-is-single? #t)
- (amount-value 'single))
-
- (define (apply-selectable-by-name-display-options)
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-display (N_ "Use Full Account Name")
- disp-accname?)
-
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-display (N_ "Other Account Name")
- detail-is-single?)
-
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-display (N_ "Sign Reverses")
- (eq? amount-value 'single))
-
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-display optname-grid
- (eq? amount-value 'single))
-
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-display "Enable links"
- (not (eq? amount-value 'none)))
-
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-display (N_ "Use Full Other Account Name")
- (and disp-other-accname? detail-is-single?))
-
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-display (N_ "Other Account Code")
- detail-is-single?)
-
- (gnc-option-db-set-option-selectable-by-name
- options gnc:pagename-display (N_ "Notes")
- disp-memo?))
-
- (for-each
- (lambda (l)
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display (car l) (cadr l) (caddr l) (cadddr l))))
- ;; One list per option here with: option-name, sort-tag,
- ;; help-string, default-value
- (list
- (list (N_ "Date") "a" (_ "Display the date?") #t)
- (list (N_ "Reconciled Date") "a2" (_ "Display the reconciled date?") #f)
- (if BOOK-SPLIT-ACTION
- (list (N_ "Num/Action") "b" (_ "Display the check number?") #t)
- (list (N_ "Num") "b" (_ "Display the check number?") #t))
- (list (N_ "Description") "c" (_ "Display the description?") #t)
- (list (N_ "Notes") "d2" (_ "Display the notes if the memo is unavailable?") #t)
- ;; account name option appears here
- (list (N_ "Use Full Account Name") "f" (_ "Display the full account name?") #t)
- (list (N_ "Account Code") "g" (_ "Display the account code?") #f)
- ;; other account name option appears here
- (list (N_ "Use Full Other Account Name") "i" (_ "Display the full account name?") #f)
- (list (N_ "Other Account Code") "j" (_ "Display the other account code?") #f)
- (list (N_ "Shares") "k" (_ "Display the number of shares?") #f)
- (list (N_ "Price") "l" (_ "Display the shares price?") #f)
- ;; note the "Amount" multichoice option in between here
- (list optname-grid "m5" (_ "Display a subtotal summary table. This requires Display/Amount being 'single") #f)
- (list (N_ "Running Balance") "n" (_ "Display a running balance?") #f)
- (list (N_ "Totals") "o" (_ "Display the totals?") #t)))
-
- (if BOOK-SPLIT-ACTION
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display (N_ "Trans Number")
- "b2" (_ "Display the trans number?") #f)))
-
- ;; Add an option to display the memo, and disable the notes option
- ;; when memos are not included.
- (gnc:register-trep-option
- (gnc:make-complex-boolean-option
- gnc:pagename-display (N_ "Memo")
- "d" (_ "Display the memo?") #t
- disp-memo?
- (lambda (x)
- (set! disp-memo? x)
- (apply-selectable-by-name-display-options))))
-
- ;; Ditto for Account Name #t -> Use Full Account Name is selectable
- (gnc:register-trep-option
- (gnc:make-complex-boolean-option
- gnc:pagename-display (N_ "Account Name")
- "e" (_ "Display the account name?") #t
- disp-accname?
- (lambda (x)
- (set! disp-accname? x)
- (apply-selectable-by-name-display-options))))
-
- ;; Ditto for Other Account Name #t -> Use Full Other Account Name is selectable
- (gnc:register-trep-option
- (gnc:make-complex-boolean-option
- gnc:pagename-display (N_ "Other Account Name")
- "h5" (_ "Display the other account name? (if this is a split transaction, this parameter is guessed).") #f
- disp-other-accname?
- (lambda (x)
- (set! disp-other-accname? x)
- (apply-selectable-by-name-display-options))))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-callback-option
- gnc:pagename-display optname-detail-level
- "h" (_ "Amount of detail to display per transaction.")
- 'single
- (list (vector 'multi-line
- (_ "Multi-Line")
- (_ "Display all splits in a transaction on a separate line."))
- (vector 'single
- (_ "Single")
- (_ "Display one line per transaction, merging multiple splits where required.")))
- #f
- (lambda (x)
- (set! detail-is-single? (eq? x 'single))
- (apply-selectable-by-name-display-options))))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-callback-option
- gnc:pagename-display (N_ "Amount")
- "m" (_ "Display the amount?")
- amount-value
- (list
- (vector 'none (_ "None") (_ "No amount display."))
- (vector 'single (_ "Single") (_ "Single Column Display."))
- (vector 'double (_ "Double") (_ "Two Column Display.")))
- #f
- (lambda (x)
- (set! amount-value x)
- (apply-selectable-by-name-display-options))))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display (N_ "Enable links")
- "m2" (_ "Enable hyperlinks in amounts.") #t))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- gnc:pagename-display (N_ "Sign Reverses")
- "m1" (_ "Reverse amount display for certain account types.")
- 'global
- (keylist->vectorlist sign-reverse-list))))
-
- ;; this hidden option will toggle whether the default
- ;; qof-query is run, or a different query which ensures
- ;; no transaction is duplicated. It can be enabled in
- ;; a derived report (eg income-gst-statement.scm)
- (gnc:register-trep-option
- (gnc:make-internal-option "__trep" "unique-transactions" #f))
-
- (gnc:options-set-default-section options gnc:pagename-general)
- options)
-
-;; ;;;;;;;;;;;;;;;;;;;;
-;; Here comes the big function that builds the whole table.
-
-(define (make-split-table splits options custom-calculated-cells)
-
- (define (opt-val section name)
- (let ((option (gnc:lookup-option options section name)))
- (if option
- (gnc:option-value option)
- (gnc:error "gnc:lookup-option error: " section "/" name))))
- (define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
-
- (define (build-columns-used)
- (define detail-is-single? (eq? (opt-val gnc:pagename-display optname-detail-level) 'single))
- (define amount-setting (opt-val gnc:pagename-display (N_ "Amount")))
- (list (cons 'date (opt-val gnc:pagename-display (N_ "Date")))
- (cons 'reconciled-date (opt-val gnc:pagename-display (N_ "Reconciled Date")))
- (cons 'num (if BOOK-SPLIT-ACTION
- (opt-val gnc:pagename-display (N_ "Num/Action"))
- (opt-val gnc:pagename-display (N_ "Num"))))
- (cons 'description (opt-val gnc:pagename-display (N_ "Description")))
- (cons 'account-name (opt-val gnc:pagename-display (N_ "Account Name")))
- (cons 'other-account-name (and detail-is-single?
- (opt-val gnc:pagename-display (N_ "Other Account Name"))))
- (cons 'shares (opt-val gnc:pagename-display (N_ "Shares")))
- (cons 'price (opt-val gnc:pagename-display (N_ "Price")))
- (cons 'amount-single (eq? amount-setting 'single))
- (cons 'amount-double (eq? amount-setting 'double))
- (cons 'common-currency (opt-val gnc:pagename-general optname-common-currency))
- (cons 'amount-original-currency
- (and (opt-val gnc:pagename-general optname-common-currency)
- (opt-val gnc:pagename-general optname-orig-currency)))
- (cons 'indenting (opt-val pagename-sorting optname-indenting))
- (cons 'subtotals-only (and (opt-val pagename-sorting optname-show-subtotals-only)
- (or (primary-get-info 'renderer-fn)
- (secondary-get-info 'renderer-fn))))
- (cons 'running-balance (opt-val gnc:pagename-display (N_ "Running Balance")))
- (cons 'account-full-name (opt-val gnc:pagename-display (N_ "Use Full Account Name")))
- (cons 'memo (opt-val gnc:pagename-display (N_ "Memo")))
- (cons 'account-code (opt-val gnc:pagename-display (N_ "Account Code")))
- (cons 'other-account-code (and detail-is-single?
- (opt-val gnc:pagename-display (N_ "Other Account Code"))))
- (cons 'other-account-full-name (and detail-is-single?
- (opt-val gnc:pagename-display (N_ "Use Full Other Account Name"))))
- (cons 'sort-account-code (opt-val pagename-sorting (N_ "Show Account Code")))
- (cons 'sort-account-full-name (opt-val pagename-sorting (N_ "Show Full Account Name")))
- (cons 'sort-account-description (opt-val pagename-sorting (N_ "Show Account Description")))
- (cons 'notes (opt-val gnc:pagename-display (N_ "Notes")))))
-
- (define (primary-get-info info)
- (let ((sortkey (opt-val pagename-sorting optname-prime-sortkey)))
- (if (member sortkey DATE-SORTING-TYPES)
- (keylist-get-info date-subtotal-list (opt-val pagename-sorting optname-prime-date-subtotal) info)
- (and (SUBTOTAL-ENABLED? sortkey BOOK-SPLIT-ACTION)
- (opt-val pagename-sorting optname-prime-subtotal)
- (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey info)))))
-
- (define (secondary-get-info info)
- (let ((sortkey (opt-val pagename-sorting optname-sec-sortkey)))
- (if (member sortkey DATE-SORTING-TYPES)
- (keylist-get-info date-subtotal-list (opt-val pagename-sorting optname-sec-date-subtotal) info)
- (and (SUBTOTAL-ENABLED? sortkey BOOK-SPLIT-ACTION)
- (opt-val pagename-sorting optname-sec-subtotal)
- (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey info)))))
-
- (let* ((work-to-do (length splits))
- (work-done 0)
- (table (gnc:make-html-table))
- (used-columns (build-columns-used))
- (opt-use-links? (opt-val gnc:pagename-display "Enable links"))
- (account-types-to-reverse
- (keylist-get-info sign-reverse-list
- (opt-val gnc:pagename-display (N_ "Sign Reverses"))
- 'acct-types))
- (is-multiline? (eq? (opt-val gnc:pagename-display optname-detail-level) 'multi-line))
- (export? (opt-val gnc:pagename-general optname-table-export)))
-
- (define (column-uses? param)
- (cdr (assq param used-columns)))
-
- (define left-columns
- (let* ((add-if (lambda (pred? . items) (if pred? items '())))
- (left-cols-list
- (append
- (add-if (column-uses? 'date)
- (vector (_ "Date")
- (lambda (split transaction-row?)
- (if transaction-row?
- (gnc:make-html-table-cell/markup
- "date-cell"
- (qof-print-date (xaccTransGetDate (xaccSplitGetParent split))))
- ""))))
-
- (add-if (column-uses? 'reconciled-date)
- (vector (_ "Reconciled Date")
- (lambda (split transaction-row?)
- (let ((reconcile-date (split->reconcile-date split)))
- (and reconcile-date
- (gnc:make-html-table-cell/markup
- "date-cell"
- (qof-print-date reconcile-date)))))))
-
- (add-if (column-uses? 'num)
- (vector (if (and BOOK-SPLIT-ACTION
- (opt-val gnc:pagename-display (N_ "Trans Number")))
- (_ "Num/T-Num")
- (_ "Num"))
- (lambda (split transaction-row?)
- (let* ((trans (xaccSplitGetParent split))
- (num (gnc-get-num-action trans split))
- (t-num (if (and BOOK-SPLIT-ACTION
- (opt-val gnc:pagename-display (N_ "Trans Number")))
- (gnc-get-num-action trans #f)
- ""))
- (num-string (if (string-null? t-num)
- num
- (string-append num "/" t-num))))
- (if transaction-row?
- (gnc:make-html-table-cell/markup "text-cell" num-string)
- "")))))
-
- (add-if (column-uses? 'description)
- (vector (_ "Description")
- (lambda (split transaction-row?)
- (define trans (xaccSplitGetParent split))
- (if transaction-row?
- (gnc:make-html-table-cell/markup
- "text-cell"
- (xaccTransGetDescription trans))
- ""))))
-
- (add-if (column-uses? 'memo)
- (vector (if (column-uses? 'notes)
- (string-append (_ "Memo") "/" (_ "Notes"))
- (_ "Memo"))
- (lambda (split transaction-row?)
- (define trans (xaccSplitGetParent split))
- (define memo (xaccSplitGetMemo split))
- (if (and (string-null? memo) (column-uses? 'notes))
- (xaccTransGetNotes trans)
- memo))))
-
- (add-if (or (column-uses? 'account-name) (column-uses? 'account-code))
- (vector (_ "Account")
- (lambda (split transaction-row?)
- (define account (xaccSplitGetAccount split))
- (account-namestring account
- (column-uses? 'account-code)
- (column-uses? 'account-name)
- (column-uses? 'account-full-name)))))
-
- (add-if (or (column-uses? 'other-account-name)
- (column-uses? 'other-account-code))
- (vector (_ "Transfer from/to")
- (lambda (split transaction-row?)
- (and (< 1 (xaccTransCountSplits
- (xaccSplitGetParent split)))
- (account-namestring
- (xaccSplitGetAccount
- (xaccSplitGetOtherSplit split))
- (column-uses? 'other-account-code)
- (column-uses? 'other-account-name)
- (column-uses? 'other-account-full-name))))))
-
- (add-if (column-uses? 'shares)
- (vector (_ "Shares")
- (lambda (split transaction-row?)
- (gnc:make-html-table-cell/markup
- "number-cell"
- (xaccSplitGetAmount split)))))
-
- (add-if (column-uses? 'price)
- (vector (_ "Price")
- (lambda (split transaction-row?)
- ;; share price is retrieved as an exact rational; convert for
- ;; presentation to decimal, rounded to the currency SCU, optionally
- ;; increasing precision by 2 significant digits.
- (let* ((currency (xaccTransGetCurrency (xaccSplitGetParent split)))
- (scu (gnc-commodity-get-fraction currency))
- (price (xaccSplitGetSharePrice split))
- (price-decimal (gnc-numeric-convert price
- (if (< scu 10000)
- (* scu 100)
- scu)
- GNC-HOW-RND-ROUND)))
- (gnc:make-html-table-cell/markup
- "number-cell"
- (gnc:make-gnc-monetary currency price-decimal)))))))))
-
- (if (or (column-uses? 'subtotals-only)
- (and (null? left-cols-list)
- (or (opt-val gnc:pagename-display "Totals")
- (primary-get-info 'renderer-fn)
- (secondary-get-info 'renderer-fn))))
- (list (vector "" (lambda (s t) #f)))
- left-cols-list)))
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;; calculated-cells
- ;;
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (define default-calculated-cells
- (letrec
- ((split-amount (lambda (s) (if (gnc:split-voided? s)
- (xaccSplitVoidFormerAmount s)
- (xaccSplitGetAmount s))))
- (split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
- (row-currency (lambda (s) (if (column-uses? 'common-currency)
- (opt-val gnc:pagename-general optname-currency)
- (split-currency s))))
- (friendly-debit (lambda (a) (gnc:get-debit-string (xaccAccountGetType a))))
- (friendly-credit (lambda (a) (gnc:get-credit-string (xaccAccountGetType a))))
- (header-commodity (lambda (str)
- (string-append
- str
- (if (column-uses? 'common-currency)
- (format #f " (~a)"
- (gnc-commodity-get-mnemonic
- (opt-val gnc:pagename-general optname-currency)))
- ""))))
- ;; For conversion to row-currency. Use midday as the
- ;; transaction time so it matches a price on the same day.
- ;; Otherwise it uses midnight which will likely match a
- ;; price on the previous day
- (converted-amount (lambda (s) (gnc:exchange-by-pricedb-nearest
- (gnc:make-gnc-monetary (split-currency s) (split-amount s))
- (row-currency s)
- (time64CanonicalDayTime
- (xaccTransGetDate (xaccSplitGetParent s))))))
- (converted-debit-amount (lambda (s) (and (positive? (split-amount s))
- (converted-amount s))))
- (converted-credit-amount (lambda (s) (and (not (positive? (split-amount s)))
- (gnc:monetary-neg (converted-amount s)))))
- (original-amount (lambda (s) (gnc:make-gnc-monetary (split-currency s) (split-amount s))))
- (original-debit-amount (lambda (s) (and (positive? (split-amount s))
- (original-amount s))))
- (original-credit-amount (lambda (s) (and (not (positive? (split-amount s)))
- (gnc:monetary-neg (original-amount s)))))
- (running-balance (lambda (s) (gnc:make-gnc-monetary (split-currency s) (xaccSplitGetBalance s)))))
- (append
- ;; each column will be a vector
- ;; (vector heading
- ;; calculator-function ;; (calculator-function split) to obtain amount
- ;; reverse-column? ;; #t to allow reverse signs
- ;; subtotal? ;; #t to allow subtotals (ie must be #f for running balance)
- ;; start-dual-column? ;; #t for the debit side of a dual column (i.e. debit/credit)
- ;; ;; which means the next column must be the credit side
- ;; friendly-heading-fn ;; (friendly-heading-fn account) to retrieve friendly name for account debit/credit
-
- (if (column-uses? 'amount-single)
- (list (vector (header-commodity (_ "Amount"))
- converted-amount #t #t #f
- (lambda (a) "")))
- '())
-
- (if (column-uses? 'amount-double)
- (list (vector (header-commodity (_ "Debit"))
- converted-debit-amount #f #t #t
- friendly-debit)
- (vector (header-commodity (_ "Credit"))
- converted-credit-amount #f #t #f
- friendly-credit))
- '())
-
- (if (and (column-uses? 'amount-original-currency)
- (column-uses? 'amount-single))
- (list (vector (_ "Amount")
- original-amount #t #t #f
- (lambda (a) "")))
- '())
-
- (if (and (column-uses? 'amount-original-currency)
- (column-uses? 'amount-double))
- (list (vector (_ "Debit")
- original-debit-amount #f #t #t
- friendly-debit)
- (vector (_ "Credit")
- original-credit-amount #f #t #f
- friendly-credit))
- '())
-
- (if (column-uses? 'running-balance)
- (list (vector (_ "Running Balance")
- running-balance #t #f #f
- (lambda (a) "")))
- '()))))
-
- (define calculated-cells
- ;; this part will check whether custom-calculated-cells were specified. this
- ;; describes a custom function which consumes an options list, and generates
- ;; a vectorlist similar to default-calculated-cells as above.
- (if custom-calculated-cells
- (custom-calculated-cells options)
- default-calculated-cells))
-
- (define headings-left-columns
- (map (lambda (column)
- (vector-ref column 0))
- left-columns))
-
- (define headings-right-columns
- (map (lambda (column)
- (vector-ref column 0))
- calculated-cells))
-
- (define width-left-columns (length left-columns))
- (define width-right-columns (length calculated-cells))
-
- (define primary-indent
- (if (and (column-uses? 'indenting)
- (primary-get-info 'renderer-fn))
- 1 0))
-
- (define secondary-indent
- (if (and (column-uses? 'indenting)
- (secondary-get-info 'renderer-fn))
- 1 0))
-
- (define indent-level
- (+ primary-indent secondary-indent))
-
- (define (add-subheading data subheading-style split level)
- (let* ((sortkey (opt-val pagename-sorting
- (case level
- ((primary) optname-prime-sortkey)
- ((secondary) optname-sec-sortkey))))
- (left-indent (case level
- ((primary total) 0)
- ((secondary) primary-indent)))
- (right-indent (- indent-level left-indent)))
-
- (unless (column-uses? 'subtotals-only)
- (gnc:html-table-append-row/markup!
- table subheading-style
- (append
- (gnc:html-make-empty-cells left-indent)
- (if (and (opt-val pagename-sorting optname-show-informal-headers)
- (column-uses? 'amount-double)
- (member sortkey SORTKEY-INFORMAL-HEADERS))
- (append
- (if export?
- (cons
- (gnc:make-html-table-cell data)
- (gnc:html-make-empty-cells
- (+ right-indent width-left-columns -1)))
- (list
- (gnc:make-html-table-cell/size
- 1 (+ right-indent width-left-columns) data)))
- (map (lambda (cell)
- (gnc:make-html-text
- (gnc:html-markup-b
- ((vector-ref cell 5)
- ((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION)
- sortkey 'renderer-fn)
- split)))))
- calculated-cells))
- (list
- (gnc:make-html-table-cell/size
- 1 (+ right-indent width-left-columns width-right-columns)
- data))))))))
-
- (define (add-subtotal-row subtotal-string subtotal-collectors subtotal-style level row col)
- (let* ((left-indent (case level
- ((total) 0)
- ((primary) primary-indent)
- ((secondary) (+ primary-indent secondary-indent))))
- (right-indent (- indent-level left-indent))
- (merge-list (map (lambda (cell) (vector-ref cell 4)) calculated-cells))
- (columns (map (lambda (coll) (coll 'format gnc:make-gnc-monetary #f)) subtotal-collectors))
- (list-of-commodities (delete-duplicates (map gnc:gnc-monetary-commodity (concatenate columns))
- gnc-commodity-equal)))
-
- (define (retrieve-commodity list-of-monetary commodity)
- (find (lambda (mon) (gnc-commodity-equal commodity (gnc:gnc-monetary-commodity mon)))
- list-of-monetary))
-
- (define (first-column string)
- (if export?
- (cons
- (gnc:make-html-table-cell/markup "total-label-cell" string)
- (gnc:html-make-empty-cells (+ right-indent width-left-columns -1)))
- (list
- (gnc:make-html-table-cell/size/markup 1 (+ right-indent width-left-columns) "total-label-cell" string))))
-
- (define (data-columns commodity)
- (let loop ((merging? #f)
- (last-column #f)
- (columns columns)
- (merge-list merge-list)
- (result '()))
- (if (null? columns)
- ;; we've processed all columns. return the (reversed) list of html-table-cells.
- (reverse result)
- (let* ((mon (retrieve-commodity (car columns) commodity))
- (this-column (and mon (gnc:gnc-monetary-amount mon))))
- (cond
-
- ;; We're merging. If a subtotal exists, send to next loop iteration.
- ((car merge-list)
- (loop #t
- this-column
- (cdr columns)
- (cdr merge-list)
- result))
-
- ;; We're completing merge. Display debit-credit in correct column.
- (merging?
- (let* ((sum (and (or last-column this-column)
- (- (or last-column 0) (or this-column 0))))
- (sum-table-cell (and sum (gnc:make-html-table-cell/markup
- "total-number-cell"
- (gnc:make-gnc-monetary
- commodity (abs sum)))))
- (debit-col (and sum (positive? sum) sum-table-cell))
- (credit-col (and sum (not (positive? sum)) sum-table-cell)))
- (loop #f
- #f
- (cdr columns)
- (cdr merge-list)
- (cons* (or credit-col "")
- (or debit-col "")
- result))))
-
- ;; Not merging nor completed merge. Just add amount to result.
- (else
- (loop #f
- #f
- (cdr columns)
- (cdr merge-list)
- (cons (gnc:make-html-table-cell/markup "total-number-cell" mon)
- result))))))))
-
- ;; take the first column of each commodity, add onto the subtotal grid
- (set! grid (grid-add grid row col
- (map (lambda (commodity)
- (retrieve-commodity (car columns) commodity))
- list-of-commodities)))
-
- ;; each commodity subtotal gets a separate line in the html-table
- ;; each line comprises: indenting, first-column, data-columns
- (let loop ((first-column-string subtotal-string)
- (list-of-commodities list-of-commodities))
- (unless (null? list-of-commodities)
- (gnc:html-table-append-row/markup!
- table subtotal-style
- (append
- (gnc:html-make-empty-cells left-indent)
- (first-column first-column-string)
- (data-columns (car list-of-commodities))))
- (loop "" (cdr list-of-commodities))))))
-
- (define (total-string str) (string-append (_ "Total For ") str))
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; renderers
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; display an account name depending on the options the user has set
- (define (account-namestring account show-account-code? show-account-name? show-account-full-name?)
- ;;# on multi-line splits we can get an empty ('()) account
- (if (null? account)
- (_ "Split Transaction")
- (string-append
- ;; display account code?
- (if show-account-code?
- (string-append (xaccAccountGetCode account) " ")
- "")
- ;; display account name?
- (if show-account-name?
- ;; display full account name?
- (if show-account-full-name?
- (gnc-account-get-full-name account)
- (xaccAccountGetName account))
- ""))))
-
- ;; retrieve date renderer from the date-subtotal-list
- (define (render-date date-subtotal-key split)
- ((keylist-get-info date-subtotal-list date-subtotal-key 'renderer-fn) split))
-
- ;; generate account name, optionally with anchor to account register
- (define (render-account sortkey split anchor?)
- (let* ((account ((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'renderer-fn) split))
- (name (account-namestring account
- (column-uses? 'sort-account-code)
- #t
- (column-uses? 'sort-account-full-name)))
- (description (if (and (column-uses? 'sort-account-description)
- (not (string-null? (xaccAccountGetDescription account))))
- (string-append ": " (xaccAccountGetDescription account))
- "")))
- (if (and anchor? opt-use-links?
- (not (null? account))) ;html anchor for 2-split transactions only
- (gnc:make-html-text
- (gnc:html-markup-anchor (gnc:account-anchor-text account) name)
- description)
- name)))
-
- ;; generic renderer. retrieve renderer-fn which should return a str
- (define (render-generic sortkey split)
- ((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'renderer-fn) split))
-
- (define (render-summary split level anchor?)
- (let ((sortkey (opt-val pagename-sorting
- (case level
- ((primary) optname-prime-sortkey)
- ((secondary) optname-sec-sortkey))))
- (date-subtotal-key (opt-val pagename-sorting
- (case level
- ((primary) optname-prime-date-subtotal)
- ((secondary) optname-sec-date-subtotal)))))
- (cond
- ((member sortkey DATE-SORTING-TYPES)
- (render-date date-subtotal-key split))
- ((member sortkey ACCOUNT-SORTING-TYPES)
- (render-account sortkey split anchor?))
- (else
- (render-generic sortkey split)))))
-
- (define (render-grand-total)
- (_ "Grand Total"))
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;; add-split-row
- ;;
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (define (add-split-row split cell-calculators row-style transaction-row?)
- (let* ((account (xaccSplitGetAccount split))
- (reversible-account? (if account-types-to-reverse
- (member (xaccAccountGetType account)
- account-types-to-reverse)
- (gnc-reverse-balance account)))
- (cells (map (lambda (cell)
- (let* ((split->monetary (vector-ref cell 1)))
- (vector (split->monetary split)
- (vector-ref cell 2) ;reverse?
- (vector-ref cell 3) ;subtotal?
- )))
- cell-calculators)))
-
- (unless (column-uses? 'subtotals-only)
- (gnc:html-table-append-row/markup!
- table row-style
- (append
- (gnc:html-make-empty-cells indent-level)
- (map (lambda (left-col)
- ((vector-ref left-col 1)
- split transaction-row?))
- left-columns)
- (map (lambda (cell)
- (let* ((cell-monetary (vector-ref cell 0))
- (reverse? (and (vector-ref cell 1)
- reversible-account?))
- (cell-content (and cell-monetary
- (if reverse?
- (gnc:monetary-neg cell-monetary)
- cell-monetary))))
- (and cell-content
- (gnc:make-html-table-cell/markup
- "number-cell"
- (if opt-use-links?
- (gnc:html-split-anchor split cell-content)
- cell-content)))))
- cells))))
-
- (map (lambda (cell)
- (let ((cell-monetary (vector-ref cell 0))
- (subtotal? (vector-ref cell 2)))
- (and subtotal? cell-monetary)))
- cells)))
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; do-rows-with-subtotals
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (define primary-subtotal-collectors
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
-
- (define secondary-subtotal-collectors
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
-
- (define total-collectors
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
-
- (define (do-rows-with-subtotals splits odd-row?)
- (define primary-subtotal-comparator (primary-get-info 'split-sortvalue))
- (define secondary-subtotal-comparator (secondary-get-info 'split-sortvalue))
-
- (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
-
- (set! work-done (+ 1 work-done))
-
- (if (null? splits)
-
- (if (opt-val gnc:pagename-display "Totals")
- (begin
- (gnc:html-table-append-row/markup!
- table def:grand-total-style
- (list
- (gnc:make-html-table-cell/size
- 1 (+ indent-level width-left-columns width-right-columns)
- (gnc:make-html-text (gnc:html-markup-hr)))))
-
- (add-subtotal-row (render-grand-total) total-collectors def:grand-total-style 'total 'row-total 'col-total)))
-
- (let* ((current (car splits))
- (rest (cdr splits))
- (next (if (null? rest) #f (car rest)))
- (split-values (add-split-row
- current
- calculated-cells
- (if is-multiline? def:normal-row-style
- (if odd-row?
- def:normal-row-style
- def:alternate-row-style))
- #t)))
-
- (if is-multiline?
- (for-each
- (lambda (othersplits)
- (add-split-row othersplits calculated-cells def:alternate-row-style #f))
- (delete current (xaccTransGetSplitList (xaccSplitGetParent current)))))
-
- (for-each
- (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- primary-subtotal-collectors split-values)
-
- (for-each
- (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- secondary-subtotal-collectors split-values)
-
- (for-each
- (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- total-collectors split-values)
-
- (if (and primary-subtotal-comparator
- (or (not next)
- (and next
- (not (equal? (primary-subtotal-comparator current)
- (primary-subtotal-comparator next))))))
-
- (begin
- (if secondary-subtotal-comparator
- (begin
- (add-subtotal-row (total-string
- (render-summary current 'secondary #f))
- secondary-subtotal-collectors
- def:secondary-subtotal-style
- 'secondary
- (cons (primary-subtotal-comparator current)
- (render-summary current 'primary #f))
- (cons (secondary-subtotal-comparator current)
- (render-summary current 'secondary #f)))
- (for-each (lambda (coll) (coll 'reset #f #f))
- secondary-subtotal-collectors)))
- (add-subtotal-row (total-string
- (render-summary current 'primary #f))
- primary-subtotal-collectors
- def:primary-subtotal-style
- 'primary
- (cons (primary-subtotal-comparator current)
- (render-summary current 'primary #f))
- 'col-total)
- (for-each (lambda (coll) (coll 'reset #f #f))
- primary-subtotal-collectors)
- (if next
- (begin
- (add-subheading (render-summary next 'primary #t)
- def:primary-subtotal-style next 'primary)
- (if secondary-subtotal-comparator
- (add-subheading (render-summary next 'secondary #t)
- def:secondary-subtotal-style next 'secondary)))))
-
- (if (and secondary-subtotal-comparator
- (or (not next)
- (and next
- (not (equal? (secondary-subtotal-comparator current)
- (secondary-subtotal-comparator next))))))
- (begin (add-subtotal-row (total-string
- (render-summary current 'secondary #f))
- secondary-subtotal-collectors
- def:secondary-subtotal-style
- 'secondary
- (if primary-subtotal-comparator
- (cons (primary-subtotal-comparator current)
- (render-summary current 'primary #f))
- (cons #f ""))
- (cons (secondary-subtotal-comparator current)
- (render-summary current 'secondary #f)))
- (for-each (lambda (coll) (coll 'reset #f #f))
- secondary-subtotal-collectors)
- (if next
- (add-subheading (render-summary next 'secondary #t)
- def:secondary-subtotal-style next 'secondary)))))
-
- (do-rows-with-subtotals rest (not odd-row?)))))
-
- (define grid (make-grid))
-
- (gnc:html-table-set-col-headers! table (concatenate (list
- (gnc:html-make-empty-cells indent-level)
- headings-left-columns
- headings-right-columns)))
-
- (if (primary-get-info 'renderer-fn)
- (add-subheading (render-summary (car splits) 'primary #t)
- def:primary-subtotal-style (car splits) 'primary))
-
- (if (secondary-get-info 'renderer-fn)
- (add-subheading (render-summary (car splits) 'secondary #t)
- def:secondary-subtotal-style (car splits) 'secondary))
-
- (do-rows-with-subtotals splits #t)
-
- (values table
- grid)))
-
-
-;; grid data structure
-(define (make-grid)
- '())
-(define (cell-match? cell row col)
- (and (or (not row) (equal? row (vector-ref cell 0)))
- (or (not col) (equal? col (vector-ref cell 1)))))
-(define (grid-get grid row col) ; grid filter - get all row/col - if #f then retrieve whole row/col
- (filter
- (lambda (cell) (cell-match? cell row col))
- grid))
-(define (grid-del grid row col) ; grid filter - del all row/col - if #f then delete whole row/col - CAREFUL!
- (filter
- (lambda (cell)
- (not (cell-match? cell row col)))
- grid))
-(define (grid-rows grid)
- (delete-duplicates (map (lambda (cell) (vector-ref cell 0)) grid)))
-(define (grid-cols grid)
- (delete-duplicates (map (lambda (cell) (vector-ref cell 1)) grid)))
-(define (grid-add grid row col data) ;-> misonomer - we don't 'add' to existing data,
- (set! grid (grid-del grid row col)) ;we simply delete old data stored at row/col and
- (set! grid (cons (vector row col data) grid)) ;add again. this is fine because the grid should
- grid) ;never have duplicate data in the trep.
-(define (grid->html-table grid list-of-rows list-of-cols)
- (define row-average-enabled? (> (length list-of-cols) 1))
- (define (monetary-div monetary divisor)
- (and monetary
- (let* ((amount (gnc:gnc-monetary-amount monetary))
- (currency (gnc:gnc-monetary-commodity monetary))
- (scu (gnc-commodity-get-fraction currency)))
- (gnc:make-gnc-monetary
- currency (gnc-numeric-convert (/ amount divisor) scu GNC-HOW-RND-ROUND)))))
- (define (row->num-of-commodities row)
- ;; for a row, find the maximum number of commodities being stored
- (apply max
- (map (lambda (col)
- (let ((cell (grid-get grid row col)))
- (if (null? cell) 0
- (length (vector-ref (car cell) 2)))))
- (cons 'col-total list-of-cols))))
- (define (make-table-cell row col commodity-idx divisor)
- (let ((cell (grid-get grid row col)))
- (if (null? cell) ""
- (gnc:make-html-table-cell/markup "number-cell"
- (monetary-div (list-ref-safe (vector-ref (car cell) 2) commodity-idx) divisor)))))
- (define (make-row row commodity-idx)
- (append
- (list (cond
- ((positive? commodity-idx) "")
- ((eq? row 'row-total) (_ "Grand Total"))
- (else (cdr row))))
- (map (lambda (col) (make-table-cell row col commodity-idx 1))
- list-of-cols)
- (list (make-table-cell row 'col-total commodity-idx 1))
- (if row-average-enabled?
- (list (make-table-cell row 'col-total commodity-idx (length list-of-cols)))
- '())))
- (let ((table (gnc:make-html-table)))
- (gnc:html-table-set-caption! table optname-grid)
- (gnc:html-table-set-col-headers! table (append (list "") (map cdr list-of-cols) (list (_ "Total"))
- (if row-average-enabled? (list (_ "Average")) '())))
- (gnc:html-table-set-style! table "th"
- 'attribute (list "class" "column-heading-right"))
- (for-each
- (lambda (row)
- (for-each (lambda (commodity-idx)
- (gnc:html-table-append-row! table (make-row row commodity-idx)))
- (iota (row->num-of-commodities row))))
- (if (memq 'row-total (grid-rows grid))
- (append list-of-rows '(row-total))
- list-of-rows))
- table))
-
-;; ;;;;;;;;;;;;;;;;;;;;
-;; Here comes the renderer function for this report.
-
-
-(define* (trep-renderer report-obj #:key custom-calculated-cells empty-report-message
- custom-split-filter split->date split->date-include-false?)
- ;; the trep-renderer is a define* function which, at minimum, takes the report object
- ;;
- ;; the optional arguments are:
- ;; #:custom-calculated-cells - a list of vectors to define customized data columns
- ;; #:empty-report-message - a str or html-object which is displayed at the initial report opening
- ;; #:custom-split-filter - a split->bool function to add to the split filter
- ;; #:split->date - a split->time64 which overrides the default posted date filter
- ;; (see reconcile report)
- ;; #:split->date-include-false? - addendum to above, specifies filter behaviour if
- ;; split->date returns #f. useful to include unreconciled splits in reconcile
- ;; report. it can be useful for alternative date filtering, e.g. filter by
- ;; transaction->invoice->payment date.
-
- (define options (gnc:report-options report-obj))
- (define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name)))
- (define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
-
- (define (is-filter-member split account-list)
- (let* ((txn (xaccSplitGetParent split))
- (splitcount (xaccTransCountSplits txn))
- (other-account (xaccSplitGetAccount (xaccSplitGetOtherSplit split)))
- (splits-equal? (lambda (s1 s2) (xaccSplitEqual s1 s2 #t #f #f)))
- (other-splits (delete split (xaccTransGetSplitList txn) splits-equal?))
- (other-accounts (map xaccSplitGetAccount other-splits))
- (is-in-account-list? (lambda (acc) (member acc account-list))))
- (cond
- ;; A 2-split transaction - test separately so it can be optimized
- ;; to significantly reduce the number of splits to traverse
- ;; in guile code
- ((= splitcount 2) (is-in-account-list? other-account))
- ;; A multi-split transaction - run over all splits
- ((> splitcount 2) (or-map is-in-account-list? other-accounts))
- ;; Single transaction splits
- (else #f))))
-
- (gnc:report-starting reportname)
-
- (let* ((document (gnc:make-html-document))
- (account-matcher (opt-val pagename-filter optname-account-matcher))
- (account-matcher-regexp (and (opt-val pagename-filter optname-account-matcher-regex)
- (catch 'regular-expression-syntax
- (lambda () (make-regexp account-matcher))
- (const 'invalid-regex))))
- (c_account_0 (opt-val gnc:pagename-accounts optname-accounts))
- (c_account_1 (filter
- (lambda (acc)
- (if (regexp? account-matcher-regexp)
- (regexp-exec account-matcher-regexp (gnc-account-get-full-name acc))
- (string-contains (gnc-account-get-full-name acc) account-matcher)))
- c_account_0))
- (c_account_2 (opt-val gnc:pagename-accounts optname-filterby))
- (filter-mode (opt-val gnc:pagename-accounts optname-filtertype))
- (begindate (gnc:time64-start-day-time
- (gnc:date-option-absolute-time
- (opt-val gnc:pagename-general optname-startdate))))
- (enddate (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
- (opt-val gnc:pagename-general optname-enddate))))
- (transaction-matcher (opt-val pagename-filter optname-transaction-matcher))
- (transaction-matcher-regexp (and (opt-val pagename-filter optname-transaction-matcher-regex)
- (catch 'regular-expression-syntax
- (lambda () (make-regexp transaction-matcher))
- (const 'invalid-regex))))
- (reconcile-status-filter (keylist-get-info reconcile-status-list
- (opt-val pagename-filter optname-reconcile-status)
- 'filter-types))
- (report-title (opt-val gnc:pagename-general gnc:optname-reportname))
- (primary-key (opt-val pagename-sorting optname-prime-sortkey))
- (primary-order (opt-val pagename-sorting optname-prime-sortorder))
- (primary-date-subtotal (opt-val pagename-sorting optname-prime-date-subtotal))
- (secondary-key (opt-val pagename-sorting optname-sec-sortkey))
- (secondary-order (opt-val pagename-sorting optname-sec-sortorder))
- (secondary-date-subtotal (opt-val pagename-sorting optname-sec-date-subtotal))
- (void-status (opt-val pagename-filter optname-void-transactions))
- (closing-match (keylist-get-info show-closing-list
- (opt-val pagename-filter optname-closing-transactions)
- 'closing-match))
- (splits '())
- (custom-sort? (or (and (member primary-key DATE-SORTING-TYPES) ; this will remain
- (not (eq? primary-date-subtotal 'none))) ; until qof-query
- (and (member secondary-key DATE-SORTING-TYPES) ; is upgraded
- (not (eq? secondary-date-subtotal 'none)))
- (or (CUSTOM-SORTING? primary-key BOOK-SPLIT-ACTION)
- (CUSTOM-SORTING? secondary-key BOOK-SPLIT-ACTION))))
- (subtotal-table? (and (opt-val gnc:pagename-display optname-grid)
- (if (memq primary-key DATE-SORTING-TYPES)
- (keylist-get-info date-subtotal-list primary-date-subtotal 'renderer-fn)
- (opt-val pagename-sorting optname-prime-subtotal))
- (eq? (opt-val gnc:pagename-display (N_ "Amount")) 'single)))
- (infobox-display (opt-val gnc:pagename-general optname-infobox-display))
- (query (qof-query-create-for-splits)))
-
- (define (generic-less? split-X split-Y sortkey date-subtotal-key ascend?)
- ;; compare splits X and Y, whereby
- ;; sortkey and date-subtotal-key specify the options used
- ;; ascend? specifies whether ascending or descending
- (let* ((comparator-function
- (if (memq sortkey DATE-SORTING-TYPES)
- (let ((date (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'split-sortvalue))
- (date-comparator (keylist-get-info date-subtotal-list date-subtotal-key 'date-sortvalue)))
- (lambda (s)
- (and date-comparator
- (date-comparator (date s)))))
- (or (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'split-sortvalue)
- (lambda (s) #f))))
- (value-of-X (comparator-function split-X))
- (value-of-Y (comparator-function split-Y))
- (op (if (string? value-of-X)
- (if ascend? string<? string>?)
- (if ascend? < >))))
- (and value-of-X (op value-of-X value-of-Y))))
-
- (define (primary-comparator? X Y)
- (generic-less? X Y primary-key
- primary-date-subtotal
- (eq? primary-order 'ascend)))
-
- (define (secondary-comparator? X Y)
- (generic-less? X Y secondary-key
- secondary-date-subtotal
- (eq? secondary-order 'ascend)))
-
- ;; This will, by default, sort the split list by ascending posted-date.
- (define (date-comparator? X Y)
- (generic-less? X Y 'date 'none #t))
-
- (if (or (or (null? c_account_1) (and-map not c_account_1))
- (eq? account-matcher-regexp 'invalid-regex)
- (eq? transaction-matcher-regexp 'invalid-regex))
-
- ;; error condition: no accounts specified or obtained after filtering
- (begin
-
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj)))
-
- ;; if an empty-report-message is passed by a derived report to
- ;; the renderer, display it here.
- (if empty-report-message
- (gnc:html-document-add-object!
- document
- empty-report-message))
-
- (if (memq infobox-display '(always no-match))
- (gnc:html-document-add-object!
- document
- (gnc:html-render-options-changed options))))
-
- (begin
-
- (qof-query-set-book query (gnc-get-current-book))
- (xaccQueryAddAccountMatch query c_account_1 QOF-GUID-MATCH-ANY QOF-QUERY-AND)
- (if (not split->date)
- (xaccQueryAddDateMatchTT query #t begindate #t enddate QOF-QUERY-AND))
- (case void-status
- ((non-void-only) (gnc:query-set-match-non-voids-only! query (gnc-get-current-book)))
- ((void-only) (gnc:query-set-match-voids-only! query (gnc-get-current-book)))
- (else #f))
- (if reconcile-status-filter
- (xaccQueryAddClearedMatch query reconcile-status-filter QOF-QUERY-AND))
- (if (boolean? closing-match)
- (xaccQueryAddClosingTransMatch query closing-match QOF-QUERY-AND))
- (if (not custom-sort?)
- (begin
- (qof-query-set-sort-order query
- (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) primary-key 'sortkey)
- (keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) secondary-key 'sortkey)
- '())
- (qof-query-set-sort-increasing query
- (eq? primary-order 'ascend)
- (eq? secondary-order 'ascend)
- #t)))
-
- (if (opt-val "__trep" "unique-transactions")
- (set! splits (xaccQueryGetSplitsUniqueTrans query))
- (set! splits (qof-query-run query)))
-
- (qof-query-destroy query)
-
- ;; Combined Filter:
- ;; - include/exclude using split->date according to date options
- ;; - include/exclude splits to/from selected accounts
- ;; - substring/regex matcher for Transaction Description/Notes/Memo
- ;; - custom-split-filter, a split->bool function for derived reports
- (set! splits (filter
- (lambda (split)
- (let* ((trans (xaccSplitGetParent split))
- (match? (lambda (str)
- (if transaction-matcher-regexp
- (regexp-exec transaction-matcher-regexp str)
- (string-contains str transaction-matcher)))))
- (and (or (not split->date) ; #f = ignore custom date filter
- (let ((date (split->date split))) ; cache split->date time64 or #f.
- (if date ; if a split->date exists,
- (<= begindate date enddate) ; then check for inclusion;
- split->date-include-false?))); else behave according to parameter
- (case filter-mode
- ((none) #t)
- ((include) (is-filter-member split c_account_2))
- ((exclude) (not (is-filter-member split c_account_2))))
- (or (string-null? transaction-matcher) ; null-string = ignore filters
- (match? (xaccTransGetDescription trans))
- (match? (xaccTransGetNotes trans))
- (match? (xaccSplitGetMemo split)))
- (or (not custom-split-filter) ; #f = ignore custom-split-filter
- (custom-split-filter split))
- )))
- splits))
-
- (when custom-sort?
- (set! splits (stable-sort! splits date-comparator?))
- (set! splits (stable-sort! splits secondary-comparator?))
- (set! splits (stable-sort! splits primary-comparator?)))
-
- (if (null? splits)
-
- ;; error condition: no splits found
- (begin
-
- (gnc:html-document-add-object!
- document
- (gnc:html-make-generic-warning
- report-title (gnc:report-id report-obj)
- NO-MATCHING-TRANS-HEADER NO-MATCHING-TRANS-TEXT))
-
- (if (memq infobox-display '(always no-match))
- (gnc:html-document-add-object!
- document
- (gnc:html-render-options-changed options))))
-
- (let-values (((table grid) (make-split-table splits options custom-calculated-cells)))
-
- (gnc:html-document-set-title! document report-title)
-
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-h3
- (format #f
- (_ "From ~a to ~a")
- (qof-print-date begindate)
- (qof-print-date enddate)))))
-
- (if (eq? infobox-display 'always)
- (gnc:html-document-add-object!
- document
- (gnc:html-render-options-changed options)))
-
- (if subtotal-table?
- (let* ((generic<? (lambda (a b)
- (cond ((string? (car a)) (string<? (car a) (car b)))
- ((number? (car a)) (< (car a) (car b)))
- (else (gnc:error "unknown sortvalue")))))
- (list-of-rows (stable-sort! (delete 'row-total (grid-rows grid)) generic<?))
- (list-of-cols (stable-sort! (delete 'col-total (grid-cols grid)) generic<?)))
- (gnc:html-document-add-object!
- document (grid->html-table grid list-of-rows list-of-cols))))
-
- (unless (and subtotal-table?
- (opt-val pagename-sorting optname-show-subtotals-only))
- (gnc:html-document-add-object! document table))))))
-
- (gnc:report-finished)
-
- document))
-
-(define trep-guid "2fe3b9833af044abb929a88d5a59620f")
-(export trep-guid)
-(export trep-renderer)
-(export trep-options-generator)
-
-;; Define the report.
-(gnc:define-report
- 'version 1
- 'name (_ "Reconciliation Report")
- 'report-guid "e45218c6d76f11e7b5ef0800277ef320"
- 'options-generator reconcile-report-options-generator
- ;; the renderer is the same as trep, however we're using a different split-date strategy.
- ;; we're comparing reconcile date for inclusion, and if split is unreconciled, include it anyway.
- 'renderer (lambda (rpt) (trep-renderer rpt
- #:custom-calculated-cells reconcile-report-calculated-cells
- #:split->date split->reconcile-date
- #:split->date-include-false? #t
- #:empty-report-message reconcile-report-instructions)))
-
-;; Define the report.
(gnc:define-report
'version 1
- 'name reportname
- 'report-guid trep-guid
- 'options-generator trep-options-generator
- 'renderer trep-renderer)
+ 'name (N_ "Transaction Report")
+ 'report-guid "2fe3b9833af044abb929a88d5a59620f"
+ 'options-generator gnc:trep-options-generator
+ 'renderer gnc:trep-renderer)
diff --git a/po/POTFILES.in b/po/POTFILES.in
index f090c8fad..a4cabf716 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -462,6 +462,7 @@ gnucash/report/report-system/report-collectors.scm
gnucash/report/report-system/report.scm
gnucash/report/report-system/report-system.scm
gnucash/report/report-system/report-utilities.scm
+gnucash/report/report-system/trep-engine.scm
gnucash/report/standard-reports/account-piecharts.scm
gnucash/report/standard-reports/account-summary.scm
gnucash/report/standard-reports/advanced-portfolio.scm
commit 14b325593310492fe652b4ba2c2ae8929a8e9d70
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Apr 26 22:36:08 2019 +0800
[reconcile-report] pull reconcile-report into separate file
diff --git a/gnucash/report/standard-reports/CMakeLists.txt b/gnucash/report/standard-reports/CMakeLists.txt
index af94b30cb..429e7a43f 100644
--- a/gnucash/report/standard-reports/CMakeLists.txt
+++ b/gnucash/report/standard-reports/CMakeLists.txt
@@ -27,6 +27,7 @@ set (standard_reports_SCHEME_2
net-charts.scm
portfolio.scm
price-scatter.scm
+ reconcile-report.scm
register.scm
sx-summary.scm
transaction.scm
diff --git a/gnucash/report/standard-reports/reconcile-report.scm b/gnucash/report/standard-reports/reconcile-report.scm
new file mode 100644
index 000000000..fc5eb8b23
--- /dev/null
+++ b/gnucash/report/standard-reports/reconcile-report.scm
@@ -0,0 +1,109 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; reconcile-report.scm : Reconciliation report
+;;
+;; calls functions defined in trep-engine.scm with defaults suitable
+;; for a reconciliation report including alternative date filtering
+;; strategy
+;;
+;; 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 reconcile-report))
+
+(use-modules (gnucash gettext))
+(use-modules (gnucash gnc-module))
+(gnc:module-load "gnucash/report/report-system" 0)
+
+(define (reconcile-report-options-generator)
+ (let ((options (gnc:trep-options-generator)))
+ (gnc:option-set-value
+ (gnc:lookup-option options "Sorting" "Primary Key") 'reconciled-status)
+ (gnc:option-set-value
+ (gnc:lookup-option options "Sorting" "Secondary Key") 'date)
+ (gnc:option-set-value
+ (gnc:lookup-option options "Sorting" "Secondary Subtotal for Date Key") 'none)
+ (gnc:option-set-value
+ (gnc:lookup-option options gnc:pagename-general "Start Date")
+ (cons 'relative 'start-prev-quarter))
+ (gnc:option-set-value
+ (gnc:lookup-option options gnc:pagename-general "End Date")
+ (cons 'relative 'today))
+ (gnc:option-set-value
+ (gnc:lookup-option options gnc:pagename-display "Reconciled Date") #t)
+ (gnc:option-set-value
+ (gnc:lookup-option options gnc:pagename-display "Running Balance") #f)
+ (gnc:option-set-value
+ (gnc:lookup-option options gnc:pagename-display "Memo") #f)
+ (gnc:option-make-internal! options gnc:pagename-display "Running Balance")
+ options))
+
+(define reconcile-report-instructions
+ (gnc:make-html-text
+ (_ "The reconcile report is designed to be similar to the formal \
+reconciliation tool. Please select the account from Report \
+Options. Please note the dates specified in the options will apply \
+to the Reconciliation Date.")
+ (gnc:html-markup-br)
+ (gnc:html-markup-br)))
+
+(define (split->reconcile-date split)
+ (and (char=? (xaccSplitGetReconcile split) #\y)
+ (xaccSplitGetDateReconciled split)))
+
+(define (reconcile-report-calculated-cells options)
+ (letrec
+ ((split-amount (lambda (s)
+ (if (gnc:split-voided? s)
+ (xaccSplitVoidFormerAmount s)
+ (xaccSplitGetAmount s))))
+ (split-currency (compose xaccAccountGetCommodity xaccSplitGetAccount))
+ (amount (lambda (s)
+ (gnc:make-gnc-monetary (split-currency s) (split-amount s))))
+ (debit-amount (lambda (s)
+ (and (positive? (split-amount s))
+ (amount s))))
+ (credit-amount (lambda (s)
+ (and (not (positive? (split-amount s)))
+ (gnc:monetary-neg (amount s))))))
+ ;; similar to default-calculated-cells but disable dual-subtotals.
+ (list (vector (_ "Funds In")
+ debit-amount #f #t #f
+ (const ""))
+ (vector (_ "Funds Out")
+ credit-amount #f #t #f
+ (const "")))))
+
+(define (reconcile-report-renderer rpt)
+ (gnc:trep-renderer
+ rpt
+ #:custom-calculated-cells reconcile-report-calculated-cells
+ #:split->date split->reconcile-date
+ #:split->date-include-false? #t
+ #:empty-report-message reconcile-report-instructions))
+
+(gnc:define-report
+ 'version 1
+ 'name (_ "Reconciliation Report")
+ 'report-guid "e45218c6d76f11e7b5ef0800277ef320"
+ 'options-generator reconcile-report-options-generator
+ ;; the renderer is the same as trep, however we're using a different
+ ;; split-date strategy. we're comparing reconcile date for
+ ;; inclusion, and if split is unreconciled, include it anyway.
+ 'renderer reconcile-report-renderer)
+
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index f2a24e1f1..31a791caa 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -2,6 +2,7 @@
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report standard-reports transaction))
+(use-modules (gnucash report standard-reports reconcile-report))
(use-modules (gnucash report stylesheets))
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
@@ -890,9 +891,8 @@
(let* ((options (default-testing-options)))
- (let ((sxml (options->sxml options "null test")))
- (test-assert "sxml"
- sxml))
+ (test-assert "reconcile-report basic run"
+ (options->sxml options "null test"))
(set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 01 03 1970)))
(set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 03 1970)))
(let ((sxml (options->sxml options "filter reconcile date")))
diff --git a/po/POTFILES.in b/po/POTFILES.in
index 742e71a18..f090c8fad 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -485,6 +485,7 @@ gnucash/report/standard-reports/income-statement.scm
gnucash/report/standard-reports/net-charts.scm
gnucash/report/standard-reports/portfolio.scm
gnucash/report/standard-reports/price-scatter.scm
+gnucash/report/standard-reports/reconcile-report.scm
gnucash/report/standard-reports/register.scm
gnucash/report/standard-reports/standard-reports.scm
gnucash/report/standard-reports/sx-summary.scm
Summary of changes:
gnucash/report/report-system/CMakeLists.txt | 1 +
gnucash/report/report-system/report-system.scm | 5 +
.../trep-engine.scm} | 1606 +++++++--------
gnucash/report/standard-reports/CMakeLists.txt | 1 +
gnucash/report/standard-reports/general-ledger.scm | 3 +-
.../standard-reports/income-gst-statement.scm | 91 +-
.../report/standard-reports/reconcile-report.scm | 109 +
.../standard-reports/test/test-transaction.scm | 6 +-
gnucash/report/standard-reports/transaction.scm | 2086 +-------------------
po/POTFILES.in | 2 +
10 files changed, 980 insertions(+), 2930 deletions(-)
copy gnucash/report/{standard-reports/transaction.scm => report-system/trep-engine.scm} (55%)
create mode 100644 gnucash/report/standard-reports/reconcile-report.scm
More information about the gnucash-changes
mailing list