gnucash unstable: Multiple changes pushed
Geert Janssens
gjanssens at code.gnucash.org
Sat Feb 17 18:08:46 EST 2018
Updated via https://github.com/Gnucash/gnucash/commit/e3cd9f88 (commit)
via https://github.com/Gnucash/gnucash/commit/bdd7cc73 (commit)
via https://github.com/Gnucash/gnucash/commit/bc8ad896 (commit)
via https://github.com/Gnucash/gnucash/commit/97e415fd (commit)
via https://github.com/Gnucash/gnucash/commit/b261eb18 (commit)
via https://github.com/Gnucash/gnucash/commit/276a7d24 (commit)
via https://github.com/Gnucash/gnucash/commit/88b34462 (commit)
via https://github.com/Gnucash/gnucash/commit/6004b55d (commit)
via https://github.com/Gnucash/gnucash/commit/3749ca52 (commit)
via https://github.com/Gnucash/gnucash/commit/12f3099f (commit)
via https://github.com/Gnucash/gnucash/commit/01e604d8 (commit)
from https://github.com/Gnucash/gnucash/commit/611ead2b (commit)
commit e3cd9f88c94c3c2b5e8fcdbc5457908446879df2
Merge: 611ead2 bdd7cc7
Author: Geert Janssens <geert at kobaltwit.be>
Date: Sat Feb 17 23:22:23 2018 +0100
Merge branch 'unstable-TR-progress' of https://github.com/christopherlam/gnucash into unstable
commit bdd7cc73ef6ca8f844e908fbc35718ae73bfc543
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Feb 11 23:31:53 2018 +0800
GSTR: Restore some strings
diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm
index 6396db1..8143dd3 100644
--- a/gnucash/report/standard-reports/income-gst-statement.scm
+++ b/gnucash/report/standard-reports/income-gst-statement.scm
@@ -37,10 +37,20 @@
;; Define the strings here to avoid typos and make changes easier.
(define reportname (N_ "Income & GST Statement"))
(define pagename-sorting (N_ "Sorting"))
-(define TAX-SETUP-DESC (N_ "From the Report Options, you will need to select the accounts which will \
+(define TAX-SETUP-DESC
+ (string-append
+ (_ "This report is useful to calculate periodic business tax payable/receivable from
+ authorities. From <i>Edit report options</i> above, choose your Business Income and Business Expense accounts.
+ Each transaction may contain, in addition to the accounts payable/receivable or bank accounts,
+ a split to a tax account, e.g. Income:Sales -$1000, Liability:GST on Sales -$100, Asset:Bank $1100.")
+ "<br><br>"
+ (_ "These tax accounts can either be populated using the standard register, or from Business Invoices and Bills
+ which will require Business > Sales Tax Tables to be set up correctly. Please see the documentation.")
+ "<br><br>"
+ (_ "From the Report Options, you will need to select the accounts which will \
hold the GST/VAT taxes collected or paid. These accounts must contain splits which document the \
monies which are wholly sent or claimed from tax authorities during periodic GST/VAT returns. These \
-accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY for taxes collected on sales."))
+accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")))
(define (income-gst-statement-renderer rpt)
(trep-renderer rpt
commit bc8ad8961a0158b483c87032ee0367bc47f313fa
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Feb 7 23:13:58 2018 +0800
TR & GSTReport: Improve comments
This commit only improves the comments for
both reports, and uses gnc:error calls as
advised. The reordering in GST Report now
reflects the logical transformation of a
split into column amount.
diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm
index e338643..6396db1 100644
--- a/gnucash/report/standard-reports/income-gst-statement.scm
+++ b/gnucash/report/standard-reports/income-gst-statement.scm
@@ -58,11 +58,14 @@ accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY fo
(not (xaccTransGetIsClosingTxn trans)))))
(define (gst-statement-options-generator)
+
;; Retrieve the list of options specified within the transaction report
(define options (trep-options-generator))
- ;; Delete Accounts selector and recreate with limited account types
+ ;; Delete Accounts selector
(gnc:unregister-option options gnc:pagename-accounts (N_ "Accounts"))
+
+ ;; and recreate with limited account types
(gnc:register-option
options
(gnc:make-account-list-limited-option
@@ -125,8 +128,8 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
(amount (+ (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b))))
(if same-currency?
(gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
- (warn "incompatible currencies in monetary+: " a b)))
- (warn "wrong arguments for monetary+: " a b))))
+ (gnc:error "incompatible currencies in monetary+: " a b)))
+ (gnc:error "wrong arguments for monetary+: " a b))))
(myadd (lambda (X Y) (if X (if Y (monetary+ X Y) X) Y))) ; custom adder which understands #f values
(myneg (lambda (X) (and X (gnc:monetary-neg X)))) ; custom monetary negator which understands #f
(accounts (opt-val gnc:pagename-accounts "Accounts"))
@@ -140,14 +143,22 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
(split-date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
(split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
(split-adder (lambda (split accountlist)
- (let* ((transaction (xaccSplitGetParent split))
+ (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)
@@ -155,8 +166,6 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
(split-currency split))
(time64CanonicalDayTime
(split-date s)))))
- (include-split? (lambda (s) (member (xaccSplitGetAccount s) accountlist)))
- (filtered-splits (filter include-split? splits-in-transaction))
(list-of-values (map split-monetary-converted filtered-splits)))
(fold myadd #f list-of-values))))
(account-adder (lambda (acc) (lambda (s) (split-adder s (list acc)))))
@@ -177,10 +186,10 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
;; each column will be a vector
;; (vector heading
;; calculator-function ;; (calculator-function split) to obtain amount
- ;; reverse-column? ;; to optionally reverse signs
- ;; subtotal? ;; subtotal? to allow subtotals (ie irrelevant for running balance)
- ;; start-dual-column? ;; #t for the left side of a dual column (i.e. debit/credit)
- ;; friendly-heading-fn ;; retrieve friendly heading name for account debit/credit
+ ;; reverse-column? ;; unused in GST report
+ ;; subtotal? ;; #t - all columns need subtotals
+ ;; start-dual-column? ;; unused in GST report
+ ;; friendly-heading-fn ;; unused in GST report
(list (vector "TOTAL SALES"
total-sales
#t #t #f
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index b94ce09..1e4e523 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -397,6 +397,8 @@ Credit Card, and Income accounts."))
(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)
@@ -414,6 +416,15 @@ Credit Card, and Income accounts."))
(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!
@@ -550,8 +561,6 @@ tags within description, notes or memo. ")
(gnc-option-db-set-option-selectable-by-name
options gnc:pagename-accounts optname-filterby
(not (eq? x 'none))))))
- ;;
-
;; Sorting options
@@ -870,10 +879,14 @@ tags within description, notes or memo. ")
gnc:pagename-display (N_ "Sign Reverses")
"m1" (_ "Reverse amount display for certain account types.")
'global
- (keylist->vectorlist sign-reverse-list)))
+ (keylist->vectorlist sign-reverse-list))))
- (gnc:register-trep-option
- (gnc:make-internal-option "__trep" "unique-transactions" #f)))
+ ;; 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)
@@ -887,7 +900,7 @@ tags within description, notes or memo. ")
(let ((option (gnc:lookup-option options section name)))
(if option
(gnc:option-value option)
- (error (format #f "cannot find ~a ~a" section name)))))
+ (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)
@@ -1114,11 +1127,11 @@ tags within description, notes or memo. ")
;; each column will be a vector
;; (vector heading
;; calculator-function ;; (calculator-function split) to obtain amount
- ;; reverse-column? ;; to optionally reverse signs
- ;; subtotal? ;; subtotal? to allow subtotals (ie irrelevant for running balance)
- ;; start-dual-column? ;; #t for the left side of a dual column (i.e. debit/credit)
- ;; ;; which means the next column will be the right side
- ;; friendly-heading-fn ;; retrieve friendly heading name for account debit/credit
+ ;; 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"))
amount #t #t #f
@@ -1604,6 +1617,13 @@ tags within description, notes or memo. ")
(define* (trep-renderer report-obj #:key custom-calculated-cells empty-report-message custom-split-filter)
+ ;; 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 which is displayed at the initial report opening
+ ;; #:custom-split-filter - a split->bool function to add to the split filter
+
(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)))
@@ -1732,10 +1752,12 @@ tags within description, notes or memo. ")
document
(gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))
- (and empty-report-message
- (gnc:html-document-add-object!
- document
- empty-report-message)))
+ ;; 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 (member 'no-match infobox-display)
(gnc:html-document-add-object!
@@ -1777,6 +1799,7 @@ tags within description, notes or memo. ")
;; Combined Filter:
;; - 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
;; - by reconcile status
(set! splits (filter
(lambda (split)
commit 97e415fdf3fe0d9ccc7f68f5b4ffa5ef26455323
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Feb 7 22:00:39 2018 +0800
GSTReport: filter out some transactions
This commit restores filtering for closing, link
and payment transactions.
diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm
index 54a4521..e338643 100644
--- a/gnucash/report/standard-reports/income-gst-statement.scm
+++ b/gnucash/report/standard-reports/income-gst-statement.scm
@@ -45,7 +45,17 @@ accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY fo
(define (income-gst-statement-renderer rpt)
(trep-renderer rpt
#:custom-calculated-cells gst-calculated-cells
- #:empty-report-message TAX-SETUP-DESC))
+ #:empty-report-message TAX-SETUP-DESC
+ #:custom-split-filter gst-custom-split-filter))
+
+(define (gst-custom-split-filter split)
+ ;; split -> bool
+ ;;
+ ;; additional split filter - returns #t if split must be included
+ ;; we need to exclude Closing, Link and Payment transactions
+ (let ((trans (xaccSplitGetParent split)))
+ (and (member (xaccTransGetTxnType trans) (list TXN-TYPE-NONE TXN-TYPE-INVOICE))
+ (not (xaccTransGetIsClosingTxn trans)))))
(define (gst-statement-options-generator)
;; Retrieve the list of options specified within the transaction report
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index d3496df..b94ce09 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1603,7 +1603,7 @@ tags within description, notes or memo. ")
;; Here comes the renderer function for this report.
-(define* (trep-renderer report-obj #:key custom-calculated-cells empty-report-message)
+(define* (trep-renderer report-obj #:key custom-calculated-cells empty-report-message custom-split-filter)
(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)))
@@ -1793,6 +1793,8 @@ tags within description, notes or memo. ")
(match? (xaccTransGetDescription trans))
(match? (xaccTransGetNotes trans))
(match? (xaccSplitGetMemo split)))
+ (or (not custom-split-filter) ; #f = ignore custom-split-filter
+ (custom-split-filter split))
(or (not reconcile-status-filter) ; #f = ignore next filter
(member (xaccSplitGetReconcile split) reconcile-status-filter)))))
splits))
commit b261eb18b3b6c8be5b92c4610979b3a2bb8af7a5
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Feb 7 19:56:24 2018 +0800
Revert options.scm lookup-options renaming
and use (gnc:error) as advised
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index 09c2cc1..cfa0300 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -1722,12 +1722,6 @@
"Void Transactions?" (cons "Filter" "Void Transactions")
"Void Transactions" (cons "Filter" "Void Transactions")
"Account Substring" (cons "Filter" "Account Name Filter")
- "Account Matcher" (cons "Filter" "Account Name Filter")
- "Transaction Matcher" (cons "Filter" "Transaction Filter")
- "Account Matcher uses regular expressions for extended matching"
- (cons "Filter" "Use regular expressions for account name filter")
- "Transaction Matcher uses regular expressions for extended matching"
- (cons "Filter" "Use regular expressions for transaction filter")
))
(name-match (member name new-names-list)))
@@ -2130,4 +2124,4 @@
(let ((opt (gnc:lookup-option options section name)))
(if opt
(vector-set! opt 3 'internal)
- (error "gnc:option-make-internal! cannot find section / name"))))
+ (gnc:error "gnc:option-make-internal! cannot find " section " / " name))))
commit 276a7d24d2d0380cda24f5f0f7f159ea897101a5
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jan 12 16:45:03 2018 +1100
REWRITE income-gst-statement.scm
This commit rewrites income-gst-statement.scm to be a derivation
of transaction.scm, modifying the options database and passing
custom arguments to the trep-renderer.
This should hopefully reduce risk of errors.
diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm
index 824750e..54a4521 100644
--- a/gnucash/report/standard-reports/income-gst-statement.scm
+++ b/gnucash/report/standard-reports/income-gst-statement.scm
@@ -2,16 +2,9 @@
;; Income-GST-Statement.scm : Produce report suitable for
;; annual income tax returns and periodic VAT/GST reporting.
;;
-;; Original transaction.scm 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"
-;; Heavily amended by Christopher Lam to add calculations
-;; appropriate for GST/VAT, building on efforts by Doug Doughty.
+;; Original Income and GST Report designed by Christopher Lam
+;; Will reuse the Transaction Report with customised options
+;; and calculated cells.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -36,1783 +29,214 @@
(use-modules (gnucash utilities))
(use-modules (srfi srfi-1))
-(use-modules (srfi srfi-13))
-(use-modules (ice-9 regex))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
(gnc:module-load "gnucash/report/report-system" 0)
-
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
+(use-modules (gnucash report standard-reports transaction))
;; Define the strings here to avoid typos and make changes easier.
-
(define reportname (N_ "Income & GST Statement"))
(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-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"))
-(define optname-void-transactions (N_ "Void Transactions"))
-(define optname-table-export (N_ "Table for Exporting"))
-(define optname-common-currency (N_ "Common Currency"))
(define TAX-SETUP-DESC (N_ "From the Report Options, you will need to select the accounts which will \
hold the GST/VAT taxes collected or paid. These accounts must contain splits which document the \
monies which are wholly sent or claimed from tax authorities during periodic GST/VAT returns. These \
accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY for taxes collected on sales."))
-(define optname-currency (N_ "Report's currency"))
-(define optname-account-matcher (N_ "Account Matcher"))
-(define optname-account-matcher-regex (N_ "Account Matcher uses regular expressions for extended matching"))
-(define optname-transaction-matcher (N_ "Transaction Matcher"))
-(define optname-transaction-matcher-regex (N_ "Transaction Matcher uses regular expressions for extended matching"))
-(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")
-;; The option-values of the sorting key multichoice option, for
-;; which a subtotal should be enabled.
-(define subtotal-enabled '(account-name
- account-code
- corresponding-acc-name
- corresponding-acc-code))
-
-(define (split-account-full-name-same-p a b)
- (= (xaccSplitCompareAccountFullNames a b) 0))
-
-(define (split-account-code-same-p a b)
- (= (xaccSplitCompareAccountCodes a b) 0))
-
-(define (split-same-corr-account-full-name-p a b)
- (= (xaccSplitCompareOtherAccountFullNames a b) 0))
-
-(define (split-same-corr-account-code-p a b)
- (= (xaccSplitCompareOtherAccountCodes a b) 0))
-
-(define (time64-same-year tp-a tp-b)
- (= (gnc:time64-get-year tp-a)
- (gnc:time64-get-year tp-b)))
-
-(define (time64-same-quarter tp-a tp-b)
- (and (time64-same-year tp-a tp-b)
- (= (gnc:time64-get-quarter tp-a)
- (gnc:time64-get-quarter tp-b))))
-
-(define (time64-same-month tp-a tp-b)
- (and (time64-same-year tp-a tp-b)
- (= (gnc:time64-get-month tp-a)
- (gnc:time64-get-month tp-b))))
-
-(define (time64-same-week tp-a tp-b)
- (and (time64-same-year tp-a tp-b)
- (= (gnc:time64-get-week tp-a)
- (gnc:time64-get-week tp-b))))
-
-(define (split-same-week-p a b)
- (let ((tp-a (xaccTransGetDate (xaccSplitGetParent a)))
- (tp-b (xaccTransGetDate (xaccSplitGetParent b))))
- (time64-same-week tp-a tp-b)))
-
-(define (split-same-month-p a b)
- (let ((tp-a (xaccTransGetDate (xaccSplitGetParent a)))
- (tp-b (xaccTransGetDate (xaccSplitGetParent b))))
- (time64-same-month tp-a tp-b)))
-
-(define (split-same-quarter-p a b)
- (let ((tp-a (xaccTransGetDate (xaccSplitGetParent a)))
- (tp-b (xaccTransGetDate (xaccSplitGetParent b))))
- (time64-same-quarter tp-a tp-b)))
-
-(define (split-same-year-p a b)
- (let ((tp-a (xaccTransGetDate (xaccSplitGetParent a)))
- (tp-b (xaccTransGetDate (xaccSplitGetParent b))))
- (time64-same-year tp-a tp-b)))
-
-(define (set-last-row-style! table tag . rest)
- (let ((arg-list
- (cons table
- (cons (- (gnc:html-table-num-rows table) 1)
- (cons tag rest)))))
- (apply gnc:html-table-set-row-style! arg-list)))
-
-(define (add-subheading-row data table width subheading-style)
- (let ((heading-cell (gnc:make-html-table-cell data)))
- (gnc:html-table-cell-set-colspan! heading-cell width)
- (gnc:html-table-append-row/markup!
- table
- subheading-style
- (list heading-cell))))
-
-;; 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))
- ""))))
-
-;; render an account subheading - column-vector determines what is displayed
-(define (render-account-subheading
- split table width subheading-style column-vector)
- (let ((account (xaccSplitGetAccount split)))
- (add-subheading-row (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:account-anchor-text account)
- (account-namestring account
- (used-sort-account-code column-vector)
- #t
- (used-sort-account-full-name column-vector))))
- table width subheading-style)))
-
-(define (render-corresponding-account-subheading
- split table width subheading-style column-vector)
- (let ((account (xaccSplitGetAccount (xaccSplitGetOtherSplit split))))
- (add-subheading-row (gnc:make-html-text
- (gnc:html-markup-anchor
- (if (not (null? account))
- (gnc:account-anchor-text account)
- "")
- (account-namestring account
- (used-sort-account-code column-vector)
- #t
- (used-sort-account-full-name column-vector))))
- table width subheading-style)))
-
-(define (render-week-subheading split table width subheading-style column-vector)
- (add-subheading-row (gnc:date-get-week-year-string
- (gnc-localtime
- (xaccTransGetDate
- (xaccSplitGetParent split))))
- table width subheading-style))
-
-(define (render-month-subheading split table width subheading-style column-vector)
- (add-subheading-row (gnc:date-get-month-year-string
- (gnc-localtime
- (xaccTransGetDate
- (xaccSplitGetParent split))))
- table width subheading-style))
-
-(define (render-quarter-subheading split table width subheading-style column-vector)
- (add-subheading-row (gnc:date-get-quarter-year-string
- (gnc-localtime
- (xaccTransGetDate
- (xaccSplitGetParent split))))
- table width subheading-style))
-
-(define (render-year-subheading split table width subheading-style column-vector)
- (add-subheading-row (gnc:date-get-year-string
- (gnc-localtime
- (xaccTransGetDate
- (xaccSplitGetParent split))))
- table width subheading-style))
-
-
-(define (add-subtotal-row table width subtotal-string subtotal-collectors
- subtotal-style export?)
- (let* ((row-contents '())
- (columns (map (lambda (coll) (coll 'format gnc:make-gnc-monetary #f)) subtotal-collectors))
- (list-of-commodities (delete-duplicates (map gnc:gnc-monetary-commodity (apply append columns))
- gnc-commodity-equal)))
-
- (define (retrieve-commodity list-of-monetary commodity)
- (if (null? list-of-monetary)
- #f
- (if (gnc-commodity-equal (gnc:gnc-monetary-commodity (car list-of-monetary)) commodity)
- (car list-of-monetary)
- (retrieve-commodity (cdr list-of-monetary) commodity))))
-
- (define (add-first-column string)
- (if export?
- (begin
- (addto! row-contents (gnc:make-html-table-cell/markup "total-label-cell" string))
- (for-each (lambda (cell) (addto! row-contents cell))
- (gnc:html-make-empty-cells (- width 1))))
- (addto! row-contents (gnc:make-html-table-cell/size/markup 1 width "total-label-cell" string))))
-
- (define (add-columns commodity)
- (for-each (lambda (column)
- (addto! row-contents
- (gnc:make-html-table-cell/markup
- "total-number-cell"
- (retrieve-commodity column commodity))))
- columns))
-
- ;first row
- (add-first-column subtotal-string)
- (add-columns (if (pair? list-of-commodities)
- (car list-of-commodities)
- #f)) ;to account for empty-row subtotals
- (gnc:html-table-append-row/markup! table subtotal-style (reverse row-contents))
-
- ;subsequent rows
- (if (pair? list-of-commodities)
- (for-each (lambda (commodity)
- (set! row-contents '())
- (add-first-column "")
- (add-columns commodity)
- (gnc:html-table-append-row/markup! table subtotal-style (reverse row-contents)))
- (cdr list-of-commodities)))))
-
-(define (total-string str) (string-append (_ "Total For ") str))
-
-(define (render-account-subtotal
- table width split total-collector subtotal-style column-vector export?)
- (add-subtotal-row table width
- (total-string (account-namestring (xaccSplitGetAccount split)
- (used-sort-account-code column-vector)
- #t
- (used-sort-account-full-name column-vector)))
- total-collector subtotal-style export?))
-
-(define (render-corresponding-account-subtotal
- table width split total-collector subtotal-style column-vector export?)
- (add-subtotal-row table width
- (total-string (account-namestring (xaccSplitGetAccount
- (xaccSplitGetOtherSplit split))
- (used-sort-account-code column-vector)
- #t
- (used-sort-account-full-name column-vector)))
- total-collector subtotal-style export?))
-
-(define (render-week-subtotal
- table width split total-collector subtotal-style column-vector export?)
- (let ((tm (gnc-localtime (xaccTransGetDate
- (xaccSplitGetParent split)))))
- (add-subtotal-row table width
- (total-string (gnc:date-get-week-year-string tm))
- total-collector subtotal-style export?)))
-
-(define (render-month-subtotal
- table width split total-collector subtotal-style column-vector export?)
- (let ((tm (gnc-localtime (xaccTransGetDate
- (xaccSplitGetParent split)))))
- (add-subtotal-row table width
- (total-string (gnc:date-get-month-year-string tm))
- total-collector subtotal-style export?)))
-
-
-(define (render-quarter-subtotal
- table width split total-collector subtotal-style column-vector export?)
- (let ((tm (gnc-localtime (xaccTransGetDate
- (xaccSplitGetParent split)))))
- (add-subtotal-row table width
- (total-string (gnc:date-get-quarter-year-string tm))
- total-collector subtotal-style export?)))
-
-(define (render-year-subtotal
- table width split total-collector subtotal-style column-vector export?)
- (let ((tm (gnc-localtime (xaccTransGetDate
- (xaccSplitGetParent split)))))
- (add-subtotal-row table width
- (total-string (strftime "%Y" tm))
- total-collector subtotal-style export?)))
-
-
-(define (render-grand-total
- table width total-collector export?)
- (add-subtotal-row table width
- (_ "Grand Total")
- total-collector def:grand-total-style export?))
-
-(define account-types-to-reverse-assoc-list
- (list (cons 'none '())
- (cons 'income-expense
- (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE))
- (cons 'credit-accounts
- (list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE ACCT-TYPE-EQUITY
- ACCT-TYPE-CREDIT ACCT-TYPE-INCOME))))
-
-(define (used-date columns-used)
- (vector-ref columns-used 0))
-(define (used-reconciled-date columns-used)
- (vector-ref columns-used 1))
-(define (used-num columns-used)
- (vector-ref columns-used 2))
-(define (used-description columns-used)
- (vector-ref columns-used 3))
-(define (used-account-name columns-used)
- (vector-ref columns-used 4))
-(define (used-other-account-name columns-used)
- (vector-ref columns-used 5))
-(define (used-shares columns-used)
- (vector-ref columns-used 6))
-(define (used-price columns-used)
- (vector-ref columns-used 7))
-(define (used-amount-single columns-used)
- (vector-ref columns-used 8))
-(define (used-amount-double-positive columns-used)
- (vector-ref columns-used 9))
-(define (used-amount-double-negative columns-used)
- (vector-ref columns-used 10))
-(define (used-account-full-name columns-used)
- (vector-ref columns-used 12))
-(define (used-memo columns-used)
- (vector-ref columns-used 13))
-(define (used-account-code columns-used)
- (vector-ref columns-used 14))
-(define (used-other-account-code columns-used)
- (vector-ref columns-used 15))
-(define (used-other-account-full-name columns-used)
- (vector-ref columns-used 16))
-(define (used-sort-account-code columns-used)
- (vector-ref columns-used 17))
-(define (used-sort-account-full-name columns-used)
- (vector-ref columns-used 18))
-(define (used-notes columns-used)
- (vector-ref columns-used 19))
-
-(define columns-used-size 20)
-
-(define (num-columns-required columns-used)
- (do ((i 0 (+ i 1))
- (col-req 0 col-req))
- ((>= i columns-used-size) col-req)
- ; If column toggle is true, increase column count. But attention:
- ; some toggles only change the meaning of another toggle. Don't count these modifier toggles
- (if (and (not (= i 12)) ; Skip Account Full Name toggle - modifies Account Name column
- (not (= i 16)) ; Skip Other Account Full Name toggle - modifies Other Account Name column
- (not (= i 17)) ; Skip Sort Account Code - modifies Account Name subheading
- (not (= i 18)) ; Skip Sort Account Full Name - modifies Account Name subheading
- (not (= i 19)) ; Skip Note toggle - modifies Memo column
- (vector-ref columns-used i))
- (set! col-req (+ col-req 1)))
- ; Account Code and Account Name share one column so if both were ticked the
- ; the check above would have set up one column too much. The check below
- ; will compensate these again.
- (if (or (and (= i 14) (vector-ref columns-used 14) (vector-ref columns-used 4)) ; Account Code and Name
- (and (= i 15) (vector-ref columns-used 15) (vector-ref columns-used 5))) ; Other Account Code and Name
- (set! col-req (- col-req 1)))))
-
-(define (build-column-used options)
- (define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option options section name)))
- (let ((column-list (make-vector columns-used-size #f)))
- (if (opt-val gnc:pagename-display (N_ "Date"))
- (vector-set! column-list 0 #t))
- (if (opt-val gnc:pagename-display (N_ "Reconciled Date"))
- (vector-set! column-list 1 #t))
- (if (if (gnc:lookup-option options gnc:pagename-display (N_ "Num"))
- (opt-val gnc:pagename-display (N_ "Num"))
- (opt-val gnc:pagename-display (N_ "Num/Action")))
- (vector-set! column-list 2 #t))
- (if (opt-val gnc:pagename-display (N_ "Description"))
- (vector-set! column-list 3 #t))
- (if (opt-val gnc:pagename-display (N_ "Account Name"))
- (vector-set! column-list 4 #t))
- (if (opt-val gnc:pagename-display (N_ "Other Account Name"))
- (vector-set! column-list 5 #t))
- ;(if (opt-val gnc:pagename-display (N_ "Shares"))
- ; (vector-set! column-list 6 #t))
- ;(if (opt-val gnc:pagename-display (N_ "Price"))
- ; (vector-set! column-list 7 #t))
- ;(let ((amount-setting (opt-val gnc:pagename-display (N_ "Amount"))))
- ; (if (eq? amount-setting 'single)
- ; (vector-set! column-list 8 #t))
- ; (if (eq? amount-setting 'double)
- ; (begin (vector-set! column-list 9 #t)
- ; (vector-set! column-list 10 #t))))
-
- (if (opt-val gnc:pagename-display (N_ "Use Full Account Name"))
- (vector-set! column-list 12 #t))
- (if (opt-val gnc:pagename-display (N_ "Memo"))
- (vector-set! column-list 13 #t))
- (if (opt-val gnc:pagename-display (N_ "Account Code"))
- (vector-set! column-list 14 #t))
- (if (opt-val gnc:pagename-display (N_ "Other Account Code"))
- (vector-set! column-list 15 #t))
- (if (opt-val gnc:pagename-display (N_ "Use Full Other Account Name"))
- (vector-set! column-list 16 #t))
- (if (opt-val pagename-sorting (N_ "Show Account Code"))
- (vector-set! column-list 17 #t))
- (if (opt-val pagename-sorting (N_ "Show Full Account Name"))
- (vector-set! column-list 18 #t))
- (if (opt-val gnc:pagename-display (N_ "Notes"))
- (vector-set! column-list 19 #t))
- column-list))
-
-(define (make-heading-list column-vector calculated-cells options)
- (let ((heading-list '()))
- (if (used-date column-vector)
- (addto! heading-list (_ "Date")))
- (if (used-reconciled-date column-vector)
- (addto! heading-list (_ "Reconciled Date")))
- (if (used-num column-vector)
- (addto! heading-list (if (and (qof-book-use-split-action-for-num-field
- (gnc-get-current-book))
- (if (gnc:lookup-option options
- gnc:pagename-display
- (N_ "Trans Number"))
- (gnc:option-value
- (gnc:lookup-option options
- gnc:pagename-display
- (N_ "Trans Number")))
- #f))
- (_ "Num/T-Num")
- (_ "Num"))))
- (if (used-description column-vector)
- (addto! heading-list (_ "Description")))
- (if (used-memo column-vector)
- (if (used-notes column-vector)
- (addto! heading-list (string-append (_ "Memo") "/" (_ "Notes")))
- (addto! heading-list (_ "Memo"))))
- (if (or (used-account-name column-vector) (used-account-code column-vector))
- (addto! heading-list (_ "Account")))
- (if (or (used-other-account-name column-vector) (used-other-account-code column-vector))
- (addto! heading-list (_ "Transfer from/to")))
- ;(if (used-shares column-vector)
- ; (addto! heading-list (_ "Shares")))
- ;(if (used-price column-vector)
- ; (addto! heading-list (_ "Price")))
- ;(if (used-amount-single column-vector)
- ; (addto! heading-list (_ "Amount")))
- ;; FIXME: Proper labels: what?
- (if (used-amount-double-positive column-vector)
- (addto! heading-list (_ "Debit")))
- (if (used-amount-double-negative column-vector)
- (addto! heading-list (_ "Credit")))
-
- (for-each (lambda (cell)
- (addto! heading-list
- (gnc:make-html-table-cell/markup
- "column-heading-right"
- (vector-ref cell 0))))
- calculated-cells)
-
- (reverse heading-list)))
-(define (add-split-row table split column-vector cell-calculators options
- row-style account-types-to-reverse transaction-row?)
- (define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option options section name)))
-
- (let* ((row-contents '())
- (dummy (gnc:debug "split is originally" split))
- (parent (xaccSplitGetParent split))
- (account (xaccSplitGetAccount split))
- (account-type (xaccAccountGetType account))
- (currency (xaccTransGetCurrency parent))
- ;the following cannot be used, because we're using each split's tax currency
- ;(if (not (null? account))
- ; (xaccAccountGetCommodity account)
- ; (gnc-default-currency)))
- (report-currency (if (opt-val gnc:pagename-general optname-common-currency)
- (opt-val gnc:pagename-general optname-currency)
- currency))
- (sign-reverses? (opt-val gnc:pagename-display (N_ "Sign Reverses")))
- (trans-date (xaccTransGetDate parent))
- (converted (lambda (num)
- (gnc:exchange-by-pricedb-nearest
- (gnc:make-gnc-monetary currency num)
- report-currency
- (timespecCanonicalDayTime trans-date)))))
-
- (define cells
- (map (lambda (cell)
- (let* ((calculator (vector-ref cell 1))
- (reverse-column? (vector-ref cell 2))
- (calculated (calculator split)))
- (cond
- ((and sign-reverses? reverse-column? calculated) (converted (gnc-numeric-neg calculated)))
- (calculated (converted calculated))
- (else #f))))
- cell-calculators))
-
- (if (used-date column-vector)
- (addto! row-contents
- (if transaction-row?
- (gnc:make-html-table-cell/markup "date-cell"
- (qof-print-date (xaccTransGetDate parent)))
- " ")))
- (if (used-reconciled-date column-vector)
- (addto! row-contents
- (gnc:make-html-table-cell/markup "date-cell"
- (let ((date (xaccSplitGetDateReconciled split)))
- (if (zero? date)
- " "
- (qof-print-date date))))))
- (if (used-num column-vector)
- (addto! row-contents
- (if transaction-row?
- (if (qof-book-use-split-action-for-num-field
- (gnc-get-current-book))
- (let* ((num (gnc-get-num-action parent split))
- (t-num (if (if (gnc:lookup-option options
- gnc:pagename-display
- (N_ "Trans Number"))
- (opt-val gnc:pagename-display
- (N_ "Trans Number"))
- #f)
- (gnc-get-num-action parent #f)
- ""))
- (num-string (if (equal? t-num "")
- num
- (string-append num "/" t-num))))
- (gnc:make-html-table-cell/markup "text-cell"
- num-string))
- (gnc:make-html-table-cell/markup "text-cell"
- (gnc-get-num-action parent split)))
- " ")))
-
- (if (used-description column-vector)
- (addto! row-contents
- (if transaction-row?
- (gnc:make-html-table-cell/markup "text-cell"
- (xaccTransGetDescription parent))
- " ")))
-
- (if (used-memo column-vector)
- (let ((memo (xaccSplitGetMemo split)))
- (if (and (equal? memo "") (used-notes column-vector))
- (addto! row-contents (xaccTransGetNotes parent))
- (addto! row-contents memo))))
-
- (if (or (used-account-name column-vector) (used-account-code column-vector))
- (addto! row-contents (account-namestring account
- (used-account-code column-vector)
- (used-account-name column-vector)
- (used-account-full-name column-vector))))
-
- (if (or (used-other-account-name column-vector) (used-other-account-code column-vector))
- (addto! row-contents (account-namestring (xaccSplitGetAccount
- (xaccSplitGetOtherSplit split))
- (used-other-account-code column-vector)
- (used-other-account-name column-vector)
- (used-other-account-full-name column-vector))))
-
- ;(if (used-shares column-vector)
- ; (addto! row-contents (xaccSplitGetAmount split)))
- ;(if (used-price column-vector)
- ; (addto!
- ; row-contents
- ; (gnc:make-gnc-monetary (xaccTransGetCurrency parent)
- ; (xaccSplitGetSharePrice split))))
- ;(if (used-amount-single column-vector)
- ; (addto! row-contents
- ; (gnc:make-html-table-cell/markup "number-cell"
- ; (gnc:html-transaction-anchor parent split-value))))
- ;(if (used-amount-double-positive column-vector)
- ; (if (gnc-numeric-positive-p (gnc:gnc-monetary-amount split-value))
- ; (addto! row-contents
- ; (gnc:make-html-table-cell/markup "number-cell"
- ; (gnc:html-transaction-anchor parent split-value)))
- ; (addto! row-contents " ")))
- ;(if (used-amount-double-negative column-vector)
- ; (if (gnc-numeric-negative-p (gnc:gnc-monetary-amount split-value))
- ; (addto! row-contents
- ; (gnc:make-html-table-cell/markup
- ; "number-cell" (gnc:html-transaction-anchor parent (gnc:monetary-neg split-value))))
- ; (addto! row-contents " ")))
-
- (for-each (lambda (cell)
- (if cell
- (addto! row-contents
- (gnc:make-html-table-cell/markup
- "number-cell"
- (gnc:html-transaction-anchor
- parent
- cell)))
- (addto! row-contents (gnc:html-make-empty-cell))))
- cells)
-
- (gnc:html-table-append-row/markup! table row-style
- (reverse row-contents))
- cells))
-
-(define date-sorting-types (list 'date 'register-order))
-
-(define (trep-options-generator)
- (define gnc:*transaction-report-options* (gnc:new-options))
- (define (gnc:register-trep-option new-option)
- (gnc:register-option gnc:*transaction-report-options* new-option))
+(define (income-gst-statement-renderer rpt)
+ (trep-renderer rpt
+ #:custom-calculated-cells gst-calculated-cells
+ #:empty-report-message TAX-SETUP-DESC))
- ;; General options
+(define (gst-statement-options-generator)
+ ;; Retrieve the list of options specified within the transaction report
+ (define options (trep-options-generator))
- (gnc:options-add-date-interval!
- gnc:*transaction-report-options*
- gnc:pagename-general (N_ "Start Date") (N_ "End Date") "a")
-
- ;(gnc:register-trep-option
- ; (gnc:make-multichoice-option
- ; gnc:pagename-general (N_ "Style")
- ; "d" (N_ "Report style.")
- ; 'single
- ; (list (vector 'multi-line
- ; (N_ "Multi-Line")
- ; (N_ "Display N lines."))
- ; (vector 'single
- ; (N_ "Single")
- ; (N_ "Display 1 line.")))))
-
- (gnc:register-trep-option
- (gnc:make-complex-boolean-option
- gnc:pagename-general optname-common-currency
- "e" (N_ "Convert all transactions into a common currency.") #f
- #f
- (lambda (x) (gnc-option-db-set-option-selectable-by-name
- gnc:*transaction-report-options*
- gnc:pagename-general
- optname-currency
- x))))
-
- (gnc:options-add-currency!
- gnc:*transaction-report-options* gnc:pagename-general optname-currency "f")
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-general optname-table-export
- "g" (N_ "Formats the table suitable for cut & paste exporting with extra cells.") #f))
-
- (gnc:register-trep-option
- (gnc:make-string-option
- gnc:pagename-general optname-transaction-matcher
- "i1" (N_ "Match only transactions whose substring is matched e.g. '#gift' \
-will find all transactions with #gift in memo, description or notes. It can be left \
-blank, which will disable the matcher.")
- ""))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-general optname-transaction-matcher-regex
- "i2"
- (N_ "By default the transaction matcher 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))
-
- ;; Accounts options
-
- ;; account to do report on
-
- (gnc:register-trep-option
+ ;; Delete Accounts selector and recreate with limited account types
+ (gnc:unregister-option options gnc:pagename-accounts (N_ "Accounts"))
+ (gnc:register-option
+ options
(gnc:make-account-list-limited-option
- gnc:pagename-accounts (N_ "Accounts")
- "b1" (N_ "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:pagename-accounts (N_ "Accounts") "b1" (N_ "Report on these accounts.")
+ (lambda () '()) #f #t
(list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE)))
- (gnc:register-trep-option
- (gnc:make-string-option
- gnc:pagename-accounts optname-account-matcher
- "b15" (N_ "Match only above accounts whose fullname is matched e.g. ':Travel' will match \
-Expenses:Travel:Holiday and Expenses:Business:Travel. It can be left blank, which will disable \
-the matcher.")
- ""))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-accounts optname-account-matcher-regex
- "b16"
- (N_ "By default the account matcher 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:register-option
+ options
(gnc:make-account-list-limited-option
gnc:pagename-accounts (N_ "Tax Accounts")
"b17" (N_ "Please find and select the accounts which will hold the tax collected or paid. \
These accounts must contain splits which document the monies which are wholly sent or claimed \
from tax authorities during periodic GST/VAT returns. These accounts must be of type ASSET \
for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
- (lambda ()
- '())
- #f #t
+ (lambda () '()) #f #t
(list ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY)))
- (gnc:register-trep-option
- (gnc:make-account-list-option
- gnc:pagename-accounts (N_ "Filter By...")
- "b2" (N_ "Filter on these accounts.")
- (lambda ()
- ;; FIXME : gnc:get-current-accounts disappeared.
- (let* ((current-accounts '())
- (root (gnc-get-current-root-account))
- (num-accounts (gnc-account-n-children root))
- (first-account (gnc-account-nth-child root 0)))
- (cond ((not (null? current-accounts))
- (list (car current-accounts)))
- ((> num-accounts 0) (list first-account))
- (else '()))))
- #f #t))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- gnc:pagename-accounts (N_ "Filter Type")
- "c" (N_ "Filter account.")
- 'none
- (list (vector 'none
- (N_ "None")
- (N_ "Do not do any filtering."))
- (vector 'include
- (N_ "Include Transactions to/from Filter Accounts")
- (N_ "Include transactions to/from filter accounts only."))
- (vector 'exclude
- (N_ "Exclude Transactions to/from Filter Accounts")
- (N_ "Exclude transactions to/from all filter accounts."))
- )))
-
- ;;
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- gnc:pagename-accounts optname-void-transactions
- "d" (N_ "How to handle void transactions.")
- 'non-void-only
- (list (vector
- 'non-void-only
- (N_ "Non-void only")
- (N_ "Show only non-voided transactions."))
- (vector
- 'void-only
- (N_ "Void only")
- (N_ "Show only voided transactions."))
- (vector
- 'both
- (N_ "Both")
- (N_ "Show both (and include void transactions in totals).")))))
-
- ;; Sorting options
-
- (let ((options gnc:*transaction-report-options*)
-
- (key-choice-list
- (if (qof-book-use-split-action-for-num-field (gnc-get-current-book))
- (list (vector 'none
- (N_ "None")
- (N_ "Do not sort."))
-
- (vector 'account-name
- (N_ "Account Name")
- (N_ "Sort & subtotal by account name."))
-
- (vector 'account-code
- (N_ "Account Code")
- (N_ "Sort & subtotal by account code."))
-
- (vector 'date
- (N_ "Date")
- (N_ "Sort by date."))
-
- (vector 'reconciled-date
- (N_ "Reconciled Date")
- (N_ "Sort by the Reconciled Date."))
-
- (vector 'register-order
- (N_ "Register Order")
- (N_ "Sort as in the register."))
-
- (vector 'corresponding-acc-name
- (N_ "Other Account Name")
- (N_ "Sort by account transferred from/to's name."))
-
- (vector 'corresponding-acc-code
- (N_ "Other Account Code")
- (N_ "Sort by account transferred from/to's code."))
-
- (vector 'amount
- (N_ "Amount")
- (N_ "Sort by amount."))
-
- (vector 'description
- (N_ "Description")
- (N_ "Sort by description."))
-
- (vector 'number
- (N_ "Number/Action")
- (N_ "Sort by check number/action."))
-
- (vector 't-number
- (N_ "Transaction Number")
- (N_ "Sort by transaction number."))
-
- (vector 'memo
- (N_ "Memo")
- (N_ "Sort by memo.")))
- (list (vector 'none
- (N_ "None")
- (N_ "Do not sort."))
-
- (vector 'account-name
- (N_ "Account Name")
- (N_ "Sort & subtotal by account name."))
-
- (vector 'account-code
- (N_ "Account Code")
- (N_ "Sort & subtotal by account code."))
-
- (vector 'date
- (N_ "Date")
- (N_ "Sort by date."))
-
- (vector 'reconciled-date
- (N_ "Reconciled Date")
- (N_ "Sort by the Reconciled Date."))
-
- (vector 'register-order
- (N_ "Register Order")
- (N_ "Sort as in the register."))
-
- (vector 'corresponding-acc-name
- (N_ "Other Account Name")
- (N_ "Sort by account transferred from/to's name."))
-
- (vector 'corresponding-acc-code
- (N_ "Other Account Code")
- (N_ "Sort by account transferred from/to's code."))
-
- (vector 'amount
- (N_ "Amount")
- (N_ "Sort by amount."))
-
- (vector 'description
- (N_ "Description")
- (N_ "Sort by description."))
-
- (vector 'number
- (N_ "Number")
- (N_ "Sort by check/transaction number."))
-
- (vector 'memo
- (N_ "Memo")
- (N_ "Sort by memo.")))))
-
- (ascending-choice-list
- (list
- (vector 'ascend
- (N_ "Ascending")
- (N_ "Smallest to largest, earliest to latest."))
- (vector 'descend
- (N_ "Descending")
- (N_ "Largest to smallest, latest to earliest."))))
-
- (subtotal-choice-list
- (list
- (vector 'none (N_ "None") (N_ "None."))
- (vector 'weekly (N_ "Weekly") (N_ "Weekly."))
- (vector 'monthly (N_ "Monthly") (N_ "Monthly."))
- (vector 'quarterly (N_ "Quarterly") (N_ "Quarterly."))
- (vector 'yearly (N_ "Yearly") (N_ "Yearly."))))
-
- (prime-sortkey 'account-name)
- (prime-sortkey-subtotal-true #t)
- (sec-sortkey 'register-order)
- (sec-sortkey-subtotal-true #f))
-
- (define (apply-selectable-by-name-sorting-options)
- (let* ((prime-sortkey-enabled (not (eq? prime-sortkey 'none)))
- (prime-sortkey-subtotal-enabled (member prime-sortkey subtotal-enabled))
- (prime-date-sortingtype-enabled (member prime-sortkey date-sorting-types))
- (sec-sortkey-enabled (not (eq? sec-sortkey 'none)))
- (sec-sortkey-subtotal-enabled (member sec-sortkey subtotal-enabled))
- (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-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" (N_ "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"
- (N_ "Show the full account name for subtotals and subtitles?")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- pagename-sorting optname-show-account-code
- "j2"
- (N_ "Show the account code for subtotals and subtitles?")
- #f))
-
- (gnc:register-trep-option
- (gnc:make-complex-boolean-option
- pagename-sorting optname-prime-subtotal
- "e5"
- (N_ "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-option
- pagename-sorting optname-prime-date-subtotal
- "e2" (N_ "Do a date subtotal.")
- 'monthly
- subtotal-choice-list))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- pagename-sorting optname-prime-sortorder
- "e" (N_ "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"
- (N_ "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"
- (N_ "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-option
- pagename-sorting optname-sec-date-subtotal
- "i2" (N_ "Do a date subtotal.")
- 'none
- subtotal-choice-list))
-
- (gnc:register-trep-option
- (gnc:make-multichoice-option
- pagename-sorting optname-sec-sortorder
- "i" (N_ "Order of Secondary sorting.")
- 'ascend
- ascending-choice-list)))
-
- ;; Display options
-
(for-each
(lambda (l)
- (gnc:register-trep-option
+ (gnc:register-option
+ options
(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" (N_ "Display the date?") #t)
- (list (N_ "Reconciled Date") "a2" (N_ "Display the reconciled date?") #f)
- (if (qof-book-use-split-action-for-num-field (gnc-get-current-book))
- (list (N_ "Num/Action") "b" (N_ "Display the check number?") #t)
- (list (N_ "Num") "b" (N_ "Display the check number?") #t))
- (list (N_ "Description") "c" (N_ "Display the description?") #t)
- (list (N_ "Notes") "d2" (N_ "Display the notes if the memo is unavailable?") #t)
- ;; account name option appears here
- (list (N_ "Use Full Account Name") "f" (N_ "Display the full account name?") #t)
- (list (N_ "Account Code") "g" (N_ "Display the account code?") #f)
- ;; other account name option appears here
- (list (N_ "Use Full Other Account Name") "i" (N_ "Display the full account name?") #f)
- (list (N_ "Other Account Code") "j" (N_ "Display the other account code?") #f)
- ;(list (N_ "Shares") "k" (N_ "Display the number of shares?") #f)
- ;(list (N_ "Price") "l" (N_ "Display the shares price?") #f)
- ;; note the "Amount" multichoice option in between here
- (list (N_ "Totals") "o" (N_ "Display the totals?") #t)
(list (N_ "Individual income columns") "p" (N_ "Display individual income columns rather than their sum") #f)
(list (N_ "Individual expense columns") "q" (N_ "Display individual expense columns rather than their sum") #f)
(list (N_ "Individual tax columns") "r" (N_ "Display individual tax columns rather than their sum") #f)
(list (N_ "Remittance amount") "s" (N_ "Display the remittance amount (total sales - total purchases)") #f)
(list (N_ "Net Income") "t" (N_ "Display the net income (sales without tax - purchases without tax)") #f)
- (list (N_ "Tax payable") "u" (N_ "Display the tax payable (tax on sales - tax on purchases)") #f)
- (list (N_ "Sign Reverses") "z" (N_ "Reverse amount display for income-related columns.") #t)
- ))
-
- (if (qof-book-use-split-action-for-num-field (gnc-get-current-book))
- (gnc:register-trep-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display (N_ "Trans Number")
- "b2" (N_ "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" (N_ "Display the memo?") #t
- #f
- (lambda (x) (gnc-option-db-set-option-selectable-by-name
- gnc:*transaction-report-options*
- gnc:pagename-display
- (N_ "Notes")
- x))))
-
- ;; 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" (N_ "Display the account name?") #t
- #f
- (lambda (x) (gnc-option-db-set-option-selectable-by-name
- gnc:*transaction-report-options*
- gnc:pagename-display
- (N_ "Use Full Account Name")
- x))))
-
- ;; 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" (N_ "Display the other account name? (if this is a split transaction, this parameter is guessed).") #f
- #f
- (lambda (x) (gnc-option-db-set-option-selectable-by-name
- gnc:*transaction-report-options*
- gnc:pagename-display
- (N_ "Use Full Other Account Name")
- x))))
-
- ;(gnc:register-trep-option
- ; (gnc:make-multichoice-option
- ; gnc:pagename-display (N_ "Amount")
- ; "m" (N_ "Display the amount?")
- ; 'single
- ; (list
- ; (vector 'none (N_ "None") (N_ "No amount display."))
- ; (vector 'single (N_ "Single") (N_ "Single Column Display."))
- ; (vector 'double (N_ "Double") (N_ "Two Column Display."))
- ; )))
-
- (gnc:options-set-default-section gnc:*transaction-report-options*
- gnc:pagename-general)
-
- gnc:*transaction-report-options*)
-
-
-(define (display-date-interval begin end)
- (let ((begin-string (qof-print-date begin))
- (end-string (qof-print-date end)))
- (sprintf #f (_ "From %s To %s") begin-string end-string)))
-
-(define (get-primary-subtotal-style options)
- (let ((bgcolor (gnc:lookup-option options
- (N_ "Colors")
- (N_ "Primary Subtotals/headings"))))
- (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
-
-(define (get-secondary-subtotal-style options)
- (let ((bgcolor (gnc:lookup-option options
- (N_ "Colors")
- (N_ "Secondary Subtotals/headings"))))
- (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
-
-(define (get-grand-total-style options)
- (let ((bgcolor (gnc:lookup-option options
- (N_ "Colors")
- (N_ "Grand Total"))))
- (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
-
-(define (get-odd-row-style options)
- (let ((bgcolor (gnc:lookup-option options
- (N_ "Colors")
- (N_ "Split Odd"))))
- (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
-
-(define (get-even-row-style options)
- (let ((bgcolor (gnc:lookup-option options
- (N_ "Colors")
- (N_ "Split Even"))))
- (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
-
-
-;; ;;;;;;;;;;;;;;;;;;;;
-;; Here comes the big function that builds the whole table.
-(define (make-split-table splits options
- accounts-tax-paid
- accounts-tax-collected
- accounts-sales
- accounts-purchases
- primary-subtotal-pred
- secondary-subtotal-pred
- primary-subheading-renderer
- secondary-subheading-renderer
- primary-subtotal-renderer
- secondary-subtotal-renderer)
-
- (let ((work-to-do (length splits))
- (work-done 0)
- (used-columns (build-column-used options)))
-
- (define calculated-cells
- (letrec
- ((myadd (lambda (X Y) (if X (if Y (gnc-numeric-add X Y GNC-DENOM-AUTO GNC-RND-ROUND) X) Y)))
- (myneg (lambda (X) (if X (gnc-numeric-neg X) #f)))
- (split-adder (lambda (split accountlist)
- (let* ((transaction (xaccSplitGetParent split))
- (splits-in-transaction (xaccTransGetSplitList transaction))
- (split-get-value (lambda (s)
- (if (xaccTransGetVoidStatus transaction)
- (xaccSplitVoidFormerValue s)
- (xaccSplitGetValue s))))
- (include-split? (lambda (s) (member (xaccSplitGetAccount s) accountlist)))
- (filtered-splits (filter include-split? splits-in-transaction))
- (list-of-values (map split-get-value filtered-splits)))
- (fold myadd #f list-of-values))))
- (tax-on-sales (lambda (s) (split-adder s accounts-tax-collected)))
- (tax-on-purchases (lambda (s) (split-adder s accounts-tax-paid)))
- (sales-without-tax (lambda (s) (split-adder s accounts-sales)))
- (purchases-without-tax (lambda (s) (split-adder s accounts-purchases)))
- (account-adder (lambda (acc) (lambda (s) (split-adder s (list acc)))))
- (total-sales (lambda (s) (myadd (tax-on-sales s) (sales-without-tax s))))
- (total-purchases (lambda (s) (myadd (tax-on-purchases s) (purchases-without-tax s))))
- (bank-remittance (lambda (s) (myneg (myadd (total-sales s) (total-purchases s)))))
- (net-income (lambda (s) (myneg (myadd (sales-without-tax s) (purchases-without-tax s)))))
- (tax-payable (lambda (s) (myneg (myadd (tax-on-purchases s) (tax-on-sales s))))))
- (append
- ; each column will be a vector
- ; (vector heading calculator-function reverse-column?)
- (list (vector "TOTAL SALES" total-sales #t))
- (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Individual income columns")))
- (map (lambda (acc) (vector (xaccAccountGetName acc) (account-adder acc) #t))
- accounts-sales)
- (list (vector "Net Sales" sales-without-tax #t)))
- (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Individual tax columns")))
- (map (lambda (acc) (vector (xaccAccountGetName acc) (account-adder acc) #t))
- accounts-tax-collected)
- (list (vector "Tax on Sales" tax-on-sales #t)))
- (list (vector "TOTAL PURCHASES" total-purchases #f))
- (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Individual expense columns")))
- (map (lambda (acc) (vector (xaccAccountGetName acc) (account-adder acc) #f))
- accounts-purchases)
- (list (vector "Net Purchases" purchases-without-tax #f)))
- (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Individual tax columns")))
- (map (lambda (acc) (vector (xaccAccountGetName acc) (account-adder acc) #f))
- accounts-tax-paid)
- (list (vector "Tax on Purchases" tax-on-purchases #f)))
- (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Remittance amount")))
- (list (vector "Remittance" bank-remittance #f))
- '())
- (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Net Income")))
- (list (vector "Net Income" net-income #f))
- '())
- (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Tax payable")))
- (list (vector "Tax Payable" tax-payable #f))
- '()))))
-
- (define (transaction-report-export-p options)
- (gnc:option-value
- (gnc:lookup-option options gnc:pagename-general
- optname-table-export)))
-
- (define (add-other-split-rows split table used-columns
- row-style account-types-to-reverse)
- (define (other-rows-driver split parent table used-columns i)
- (let ((current (xaccTransGetSplit parent i)))
- (cond ((null? current) #f)
- ((equal? current split)
- (other-rows-driver split parent table used-columns (+ i 1)))
- (else (begin
- (add-split-row table current used-columns calculated-cells options
- row-style account-types-to-reverse #f)
- (other-rows-driver split parent table used-columns
- (+ i 1)))))))
-
- (other-rows-driver split (xaccSplitGetParent split)
- table used-columns 0))
-
- (define (do-rows-with-subtotals splits
- table
- used-columns
- width
- multi-rows?
- odd-row?
- export?
- account-types-to-reverse
- primary-subtotal-pred
- secondary-subtotal-pred
- primary-subheading-renderer
- secondary-subheading-renderer
- primary-subtotal-renderer
- secondary-subtotal-renderer
- primary-subtotal-collectors
- secondary-subtotal-collectors
- total-collectors)
-
- (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
- (set! work-done (+ 1 work-done))
- (if (null? splits)
- (begin
- (gnc:html-table-append-row/markup!
- table
- def:grand-total-style
- (list
- (gnc:make-html-table-cell/size
- 1 width (gnc:make-html-text (gnc:html-markup-hr)))))
- (if (gnc:option-value (gnc:lookup-option options "Display" "Totals"))
- (render-grand-total table width total-collectors export?)))
-
- (let* ((current (car splits))
- (current-row-style (if multi-rows? def:normal-row-style
- (if odd-row? def:normal-row-style
- def:alternate-row-style)))
- (rest (cdr splits))
- (next (if (null? rest) #f
- (car rest)))
- (split-values (add-split-row
- table
- current
- used-columns
- calculated-cells
- options
- current-row-style
- account-types-to-reverse
- #t)))
- (if multi-rows?
- (add-other-split-rows
- current table used-columns def:alternate-row-style
- account-types-to-reverse))
-
- (map (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- primary-subtotal-collectors
- split-values)
-
- (map (lambda (collector value)
- (if value
- (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
- secondary-subtotal-collectors
- split-values)
-
- (map (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-pred
- (or (not next)
- (and next
- (not (primary-subtotal-pred current next)))))
- (begin
- (if secondary-subtotal-pred
- (begin
- (secondary-subtotal-renderer
- table width current
- secondary-subtotal-collectors
- def:secondary-subtotal-style used-columns export?)
- (for-each (lambda (coll) (coll 'reset #f #f))
- secondary-subtotal-collectors)))
-
- (primary-subtotal-renderer table width current
- primary-subtotal-collectors
- def:primary-subtotal-style used-columns
- export?)
-
- (for-each (lambda (coll) (coll 'reset #f #f))
- primary-subtotal-collectors)
-
- (if next
- (begin
- (primary-subheading-renderer
- next table width def:primary-subtotal-style used-columns)
- (if secondary-subtotal-pred
- (secondary-subheading-renderer
- next
- table
- width def:secondary-subtotal-style used-columns)))))
-
- (if (and secondary-subtotal-pred
- (or (not next)
- (and next
- (not (secondary-subtotal-pred
- current next)))))
- (begin (secondary-subtotal-renderer
- table width current
- secondary-subtotal-collectors
- def:secondary-subtotal-style used-columns export?)
- (for-each (lambda (coll) (coll 'reset #f #f))
- secondary-subtotal-collectors)
- (if next
- (secondary-subheading-renderer
- next table width
- def:secondary-subtotal-style used-columns)))))
-
- (do-rows-with-subtotals rest
- table
- used-columns
- width
- multi-rows?
- (not odd-row?)
- export?
- account-types-to-reverse
- primary-subtotal-pred
- secondary-subtotal-pred
- primary-subheading-renderer
- secondary-subheading-renderer
- primary-subtotal-renderer
- secondary-subtotal-renderer
- primary-subtotal-collectors
- secondary-subtotal-collectors
- total-collectors))))
-
- (let* ((table (gnc:make-html-table))
- (width (num-columns-required used-columns))
- (multi-rows? #f) ;disable. (transaction-report-multi-rows-p options))
- (export? (transaction-report-export-p options))
- (account-types-to-reverse '()))
-
- (gnc:html-table-set-col-headers!
- table
- (make-heading-list used-columns calculated-cells options))
-
- (if (not (null? splits))
- (begin
- (if primary-subheading-renderer
- (primary-subheading-renderer
- (car splits) table width def:primary-subtotal-style used-columns))
- (if secondary-subheading-renderer
- (secondary-subheading-renderer
- (car splits) table width def:secondary-subtotal-style used-columns))
-
- (do-rows-with-subtotals splits table used-columns width
- multi-rows? #t
- export?
- account-types-to-reverse
- primary-subtotal-pred
- secondary-subtotal-pred
- primary-subheading-renderer
- secondary-subheading-renderer
- primary-subtotal-renderer
- secondary-subtotal-renderer
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells)
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells)
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))))
- table)))
-
-;; ;;;;;;;;;;;;;;;;;;;;
-;; Here comes the renderer function for this report.
-(define (trep-renderer report-obj)
- (define options (gnc:report-options report-obj))
+ (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
+ (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")
+ (gnc:option-make-internal! options gnc:pagename-accounts "Filter By...")
+ (gnc:option-make-internal! options gnc:pagename-general "Show original currency amount")
+ ;; Disable display options not being used anymore
+ (gnc:option-make-internal! options gnc:pagename-display "Shares")
+ (gnc:option-make-internal! options gnc:pagename-display "Price")
+ (gnc:option-make-internal! options gnc:pagename-display "Amount")
+ (gnc:option-make-internal! options gnc:pagename-display "Sign Reverses")
+ (gnc:option-make-internal! options gnc:pagename-display "Running Balance")
+ ;; No multilines allowed
+ (gnc:option-make-internal! options gnc:pagename-display "Detail Level")
+ (gnc:option-make-internal! options pagename-sorting "Show Informal Debit/Credit Headers")
+ options)
+
+(define (gst-calculated-cells options)
(define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option options section name)))
- (define comp-funcs-assoc-list
- ;; Defines the different sorting keys, together with the
- ;; subtotal functions. Each entry: (cons
- ;; 'sorting-key-option-value (vector 'query-sorting-key
- ;; subtotal-function subtotal-renderer))
- ;; (let* ((used-columns (build-column-used options))) ;; tpo: gives unbound variable options?
- (let* ((used-columns (build-column-used (gnc:report-options report-obj))))
- (list (cons 'account-name (vector
- (list SPLIT-ACCT-FULLNAME)
- split-account-full-name-same-p
- render-account-subheading
- render-account-subtotal))
- (cons 'account-code (vector
- (list SPLIT-ACCOUNT ACCOUNT-CODE-)
- split-account-code-same-p
- render-account-subheading
- render-account-subtotal))
- (cons 'date (vector
- (list SPLIT-TRANS TRANS-DATE-POSTED)
- #f #f #f))
- (cons 'reconciled-date (vector
- (list SPLIT-DATE-RECONCILED)
- #f #f #f))
- (cons 'register-order (vector
- (list QUERY-DEFAULT-SORT)
- #f #f #f))
- (cons 'corresponding-acc-name
- (vector
- (list SPLIT-CORR-ACCT-NAME)
- split-same-corr-account-full-name-p
- render-corresponding-account-subheading
- render-corresponding-account-subtotal))
- (cons 'corresponding-acc-code
- (vector
- (list SPLIT-CORR-ACCT-CODE)
- split-same-corr-account-code-p
- render-corresponding-account-subheading
- render-corresponding-account-subtotal))
- (cons 'amount (vector (list SPLIT-VALUE) #f #f #f))
- (cons 'description (vector (list SPLIT-TRANS TRANS-DESCRIPTION) #f #f #f))
- (if (qof-book-use-split-action-for-num-field (gnc-get-current-book))
- (cons 'number (vector (list SPLIT-ACTION) #f #f #f))
- (cons 'number (vector (list SPLIT-TRANS TRANS-NUM) #f #f #f)))
- (cons 't-number (vector (list SPLIT-TRANS TRANS-NUM) #f #f #f))
- (cons 'memo (vector (list SPLIT-MEMO) #f #f #f))
- (cons 'none (vector '() #f #f #f)))))
-
- (define date-comp-funcs-assoc-list
- ;; Extra list for date option. Each entry: (cons
- ;; 'date-subtotal-option-value (vector subtotal-function
- ;; subtotal-renderer))
- (list
- (cons 'none (vector #f #f #f))
- (cons 'weekly (vector split-same-week-p render-week-subheading
- render-week-subtotal))
- (cons 'monthly (vector split-same-month-p render-month-subheading
- render-month-subtotal))
- (cons 'quarterly (vector split-same-quarter-p render-quarter-subheading
- render-quarter-subtotal))
- (cons 'yearly (vector split-same-year-p render-year-subheading
- render-year-subtotal))))
-
- (define (get-subtotalstuff-helper
- name-sortkey name-subtotal name-date-subtotal
- comp-index date-index)
- ;; The value of the sorting-key multichoice option.
- (let ((sortkey (opt-val pagename-sorting name-sortkey)))
- (if (member sortkey date-sorting-types)
- ;; If sorting by date, look up the value of the
- ;; date-subtotalling multichoice option and return the
- ;; corresponding funcs in the assoc-list.
- (vector-ref
- (cdr (assq (opt-val pagename-sorting name-date-subtotal)
- date-comp-funcs-assoc-list))
- date-index)
- ;; For everything else: 1. check whether sortkey has
- ;; subtotalling enabled at all, 2. check whether the
- ;; enable-subtotal boolean option is #t, 3. look up the
- ;; appropriate funcs in the assoc-list.
- (and (member sortkey subtotal-enabled)
- (and (opt-val pagename-sorting name-subtotal)
- (vector-ref
- (cdr (assq sortkey comp-funcs-assoc-list))
- comp-index))))))
-
- (define (get-query-sortkey sort-option-value)
- (vector-ref
- (cdr (assq sort-option-value comp-funcs-assoc-list))
- 0))
-
- (define (get-subtotal-pred
- name-sortkey name-subtotal name-date-subtotal)
- (get-subtotalstuff-helper
- name-sortkey name-subtotal name-date-subtotal
- 1 0))
-
- (define (get-subheading-renderer
- name-sortkey name-subtotal name-date-subtotal)
- (get-subtotalstuff-helper
- name-sortkey name-subtotal name-date-subtotal
- 2 1))
-
- (define (get-subtotal-renderer
- name-sortkey name-subtotal name-date-subtotal)
- (get-subtotalstuff-helper
- name-sortkey name-subtotal name-date-subtotal
- 3 2))
-
- ;;(define (get-other-account-names account-list)
- ;; ( map (lambda (acct) (gnc-account-get-full-name acct)) account-list))
-
- (define (splits-filter-unique-transactions splits)
- (define (same-txn? s1 s2)
- (define txn1 (xaccSplitGetParent s1))
- (define txn2 (xaccSplitGetParent s2))
- (xaccTransEqual txn1 txn2 #t #t #t #f))
- (delete-duplicates! splits same-txn?))
-
- (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))
- (c_account_0 (opt-val gnc:pagename-accounts "Accounts"))
- (account-matcher (opt-val gnc:pagename-accounts optname-account-matcher))
- (account-matcher-regexp (if (opt-val gnc:pagename-accounts optname-account-matcher-regex)
- (make-regexp account-matcher)
- #f))
- (c_account_1 (filter
- (lambda (acc)
- (if 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 "Filter By..."))
- (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)) c_account_1))
- (accounts-purchases (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-EXPENSE)) c_account_1))
- (filter-mode (opt-val gnc:pagename-accounts "Filter Type"))
- (begindate (gnc:time64-start-day-time
- (gnc:date-option-absolute-time
- (opt-val gnc:pagename-general "Start Date"))))
- (enddate (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
- (opt-val gnc:pagename-general "End Date"))))
- (transaction-matcher (opt-val gnc:pagename-general optname-transaction-matcher))
- (transaction-matcher-regexp (if (opt-val gnc:pagename-general optname-transaction-matcher-regex)
- (make-regexp transaction-matcher)
- #f))
- (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 "Primary Sort Order"))
- (secondary-key (opt-val pagename-sorting optname-sec-sortkey))
- (secondary-order (opt-val pagename-sorting "Secondary Sort Order"))
- (void-status (opt-val gnc:pagename-accounts optname-void-transactions))
- (splits '())
- (query (qof-query-create-for-splits)))
-
- ;(gnc:warn "c1 is " c_account_1)
- ;(gnc:warn "c2 is " c_account_2)
- ;(gnc:warn "first c1 is " (xaccAccountGetName (car c_account_1)))
-
- (if (not (or (null? c_account_1) (and-map not c_account_1)))
- (begin
- (qof-query-set-book query (gnc-get-current-book))
- ;;(gnc:warn "query is:" query)
- (xaccQueryAddAccountMatch query
- c_account_1
- QOF-GUID-MATCH-ANY QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT
- query #t begindate #t enddate QOF-QUERY-AND)
- (qof-query-set-sort-order query
- (get-query-sortkey primary-key)
- (get-query-sortkey secondary-key)
- '())
-
- (qof-query-set-sort-increasing query
- (eq? primary-order 'ascend)
- (eq? secondary-order 'ascend)
- #t)
-
- (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))
-
- (set! splits (qof-query-run query))
-
- ;;(gnc:warn "Splits in trep-renderer:" splits)
-
- ; Combined Filter:
- ; - include/exclude splits to/from selected accounts
- ; - include only Invoices & Regular Transactions (i.e. remove Link & Payments)
- ; - disallow Closing Transactions, and
- ; - substring/regex matcher for Description/Notes/Memo
- (set! splits (filter
- (lambda (split)
- (let* ((trans (xaccSplitGetParent split))
- (txn-type (xaccTransGetTxnType trans))
- (match? (lambda (str)
- (if transaction-matcher-regexp
- (regexp-exec transaction-matcher-regexp str)
- (string-contains str transaction-matcher)))))
- (and (if (eq? filter-mode 'include) (is-filter-member split c_account_2) #t)
- (if (eq? filter-mode 'exclude) (not (is-filter-member split c_account_2)) #t)
- (member txn-type (list TXN-TYPE-NONE TXN-TYPE-INVOICE))
- (not (xaccTransGetIsClosingTxn trans))
- (or (match? (xaccTransGetDescription trans))
- (match? (xaccTransGetNotes trans))
- (match? (xaccSplitGetMemo split))))))
- splits))
-
- ; We have to remove duplicates because the report will *sum* amounts in a transaction
- ; otherwise it will double count where transaction contains 2 splits in same account
- (set! splits (splits-filter-unique-transactions splits))
-
- (if (not (null? splits))
- (let ((table
- (make-split-table
- splits
- options
- accounts-tax-paid
- accounts-tax-collected
- accounts-sales
- accounts-purchases
- (get-subtotal-pred optname-prime-sortkey
- optname-prime-subtotal
- optname-prime-date-subtotal)
- (get-subtotal-pred optname-sec-sortkey
- optname-sec-subtotal
- optname-sec-date-subtotal)
- (get-subheading-renderer optname-prime-sortkey
- optname-prime-subtotal
- optname-prime-date-subtotal)
- (get-subheading-renderer optname-sec-sortkey
- optname-sec-subtotal
- optname-sec-date-subtotal)
- (get-subtotal-renderer optname-prime-sortkey
- optname-prime-subtotal
- optname-prime-date-subtotal)
- (get-subtotal-renderer optname-sec-sortkey
- optname-sec-subtotal
- optname-sec-date-subtotal))))
-
- (gnc:html-document-set-title! document
- report-title)
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-h3
- (display-date-interval begindate enddate))))
-
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-p
- "Input Tax accounts: "
- (if (null? accounts-tax-paid)
- (N_ "None")
- (string-join (map gnc-account-get-full-name accounts-tax-paid) ", ")))))
-
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-p
- "Output Tax accounts: "
- (if (null? accounts-tax-collected)
- (N_ "None")
- (string-join (map gnc-account-get-full-name accounts-tax-collected) ", ")))))
-
- (if (null? (append accounts-tax-collected accounts-tax-paid))
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-p
- "There are no input/output tax accounts set up. This is probably not what"
- " you want. "
- TAX-SETUP-DESC))))
-
- (gnc:html-document-add-object!
- document
- table)
- (qof-query-destroy query))
- ;; error condition: no splits found
- (let ((p (gnc:make-html-text)))
- (gnc:html-text-append!
- p
- (gnc:html-markup-h2
- (_ "No matching transactions found"))
- (gnc:html-markup-p
- (_ "No transactions were found that match the time interval and account selection specified in the Options panel.")))
- (gnc:html-document-add-object! document p))))
-
- ;; error condition: no accounts specified
-
- (if (null? c_account_0)
- (begin
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj)))
-
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-p
- (_
- "This report is useful to calculate periodic business tax payable/receivable from
- authorities. From <i>Edit report options</i> above, choose your Business Income and Business Expense accounts.
- Each transaction may contain, in addition to the accounts payable/receivable or bank accounts,
- a split to a tax account, e.g. Income:Sales -$1000, Liability:GST on Sales -$100, Asset:Bank $1100."))
- (gnc:html-markup-p
- (_
- "These tax accounts can either be populated using the standard register, or from Business Invoices and Bills
- which will require Business > Sales Tax Tables to be set up correctly. Please see the documentation."))))
-
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-p TAX-SETUP-DESC))))
-
- (begin
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-h2
- (N_ "No accounts were matched"))
- (gnc:html-markup-p
- (N_ "The account matcher specified in the report options did not match any accounts.")))))))
-
- (gnc:report-finished)
- document))
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-value option)
+ (gnc:error "gnc:lookup-option error: " section "/" name))))
+ (letrec*
+ ((monetary+ (lambda (a b)
+ (if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
+ (let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
+ (amount (+ (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b))))
+ (if same-currency?
+ (gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
+ (warn "incompatible currencies in monetary+: " a b)))
+ (warn "wrong arguments for monetary+: " a b))))
+ (myadd (lambda (X Y) (if X (if Y (monetary+ X Y) X) Y))) ; custom adder which understands #f values
+ (myneg (lambda (X) (and X (gnc:monetary-neg X)))) ; custom monetary negator which understands #f
+ (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))))
+ (split-adder (lambda (split accountlist)
+ (let* ((transaction (xaccSplitGetParent split))
+ (splits-in-transaction (xaccTransGetSplitList transaction))
+ (split-get-monetary (lambda (s)
+ (gnc:make-gnc-monetary
+ (split-currency s)
+ (if (xaccTransGetVoidStatus transaction)
+ (xaccSplitVoidFormerAmount s)
+ (xaccSplitGetAmount s)))))
+ (split-monetary-converted (lambda (s)
+ (gnc:exchange-by-pricedb-nearest
+ (split-get-monetary s)
+ (or common-currency
+ (split-currency split))
+ (time64CanonicalDayTime
+ (split-date s)))))
+ (include-split? (lambda (s) (member (xaccSplitGetAccount s) accountlist)))
+ (filtered-splits (filter include-split? splits-in-transaction))
+ (list-of-values (map split-monetary-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))))))
+ ;; Calculate sales amounts
+ (sales-without-tax (lambda (s) (myneg (split-adder s accounts-sales))))
+ (tax-on-sales (lambda (s) (myneg (split-adder s accounts-tax-collected))))
+ (total-sales (lambda (s) (myadd (tax-on-sales s) (sales-without-tax s))))
+ ;; Calculate purchase amounts
+ (purchases-without-tax (lambda (s) (split-adder s accounts-purchases)))
+ (tax-on-purchases (lambda (s) (split-adder s accounts-tax-paid)))
+ (total-purchases (lambda (s) (myadd (tax-on-purchases s) (purchases-without-tax s))))
+ ;; Calculate derived amounts
+ (bank-remittance (lambda (s) (myadd (total-sales s) (myneg (total-purchases s)))))
+ (net-income (lambda (s) (myadd (sales-without-tax s) (myneg (purchases-without-tax s)))))
+ (tax-payable (lambda (s) (myadd (tax-on-sales s) (myneg (tax-on-purchases s))))))
+ (append
+ ;; each column will be a vector
+ ;; (vector heading
+ ;; calculator-function ;; (calculator-function split) to obtain amount
+ ;; reverse-column? ;; to optionally reverse signs
+ ;; subtotal? ;; subtotal? to allow subtotals (ie irrelevant for running balance)
+ ;; start-dual-column? ;; #t for the left side of a dual column (i.e. debit/credit)
+ ;; friendly-heading-fn ;; retrieve friendly heading name for account debit/credit
+ (list (vector "TOTAL SALES"
+ total-sales
+ #t #t #f
+ (lambda (a) "")))
+ (if (opt-val gnc:pagename-display (N_ "Individual income columns"))
+ (map (lambda (acc) (vector (xaccAccountGetName acc)
+ (account-adder-neg acc)
+ #t #t #f
+ (lambda (a) "")))
+ accounts-sales)
+ (list (vector "Net Sales"
+ sales-without-tax
+ #t #t #f
+ (lambda (a) ""))))
+ (if (opt-val gnc:pagename-display (N_ "Individual tax columns"))
+ (map (lambda (acc) (vector (xaccAccountGetName acc)
+ (account-adder acc)
+ #t #t #f
+ (lambda (a) "")))
+ accounts-tax-collected)
+ (list (vector "Tax on Sales"
+ tax-on-sales
+ #t #t #f
+ (lambda (a) ""))))
+ (list (vector "TOTAL PURCHASES"
+ total-purchases
+ #f #t #f
+ (lambda (a) "")))
+ (if (opt-val gnc:pagename-display (N_ "Individual expense columns"))
+ (map (lambda (acc) (vector (xaccAccountGetName acc)
+ (account-adder acc)
+ #f #t #f
+ (lambda (a) "")))
+ accounts-purchases)
+ (list (vector "Net Purchases"
+ purchases-without-tax
+ #f #t #f
+ (lambda (a) ""))))
+ (if (opt-val gnc:pagename-display (N_ "Individual tax columns"))
+ (map (lambda (acc) (vector (xaccAccountGetName acc)
+ (account-adder acc)
+ #f #t #f
+ (lambda (a) "")))
+ accounts-tax-paid)
+ (list (vector "Tax on Purchases"
+ tax-on-purchases
+ #f #t #f
+ (lambda (a) ""))))
+ (if (opt-val gnc:pagename-display (N_ "Remittance amount"))
+ (list (vector "Remittance"
+ bank-remittance
+ #f #t #f
+ (lambda (a) "")))
+ '())
+ (if (opt-val gnc:pagename-display (N_ "Net Income"))
+ (list (vector "Net Income"
+ net-income
+ #f #t #f
+ (lambda (a) "")))
+ '())
+ (if (opt-val gnc:pagename-display (N_ "Tax payable"))
+ (list (vector "Tax Payable"
+ tax-payable
+ #f #t #f
+ (lambda (a) "")))
+ '()))))
;; Define the report.
(gnc:define-report
@@ -1820,5 +244,5 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
'menu-path (list gnc:menuname-income-expense)
'name reportname
'report-guid "5bf27f249a0d11e7abc4cec278b6b50a"
- 'options-generator trep-options-generator
- 'renderer trep-renderer)
+ 'options-generator gst-statement-options-generator
+ 'renderer income-gst-statement-renderer)
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 86ccf8b..d3496df 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -870,7 +870,10 @@ tags within description, notes or memo. ")
gnc:pagename-display (N_ "Sign Reverses")
"m1" (_ "Reverse amount display for certain account types.")
'global
- (keylist->vectorlist sign-reverse-list))))
+ (keylist->vectorlist sign-reverse-list)))
+
+ (gnc:register-trep-option
+ (gnc:make-internal-option "__trep" "unique-transactions" #f)))
(gnc:options-set-default-section options gnc:pagename-general)
options)
@@ -878,9 +881,13 @@ tags within description, notes or memo. ")
;; ;;;;;;;;;;;;;;;;;;;;
;; Here comes the big function that builds the whole table.
-(define (make-split-table splits options)
+(define (make-split-table splits options custom-calculated-cells)
- (define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name)))
+ (define (opt-val section name)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-value option)
+ (error (format #f "cannot find ~a ~a" section name)))))
(define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
(define (build-columns-used)
@@ -1059,7 +1066,7 @@ tags within description, notes or memo. ")
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (define calculated-cells
+ (define default-calculated-cells
(letrec
((damount (lambda (s) (if (gnc:split-voided? s)
(xaccSplitVoidFormerAmount s)
@@ -1149,6 +1156,14 @@ tags within description, notes or memo. ")
(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))
@@ -1588,7 +1603,7 @@ tags within description, notes or memo. ")
;; Here comes the renderer function for this report.
-(define (trep-renderer report-obj)
+(define* (trep-renderer report-obj #:key custom-calculated-cells empty-report-message)
(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)))
@@ -1710,9 +1725,17 @@ tags within description, notes or memo. ")
;; 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)))
+ ;; error condition: no accounts specified
+ (begin
+
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))
+
+ (and empty-report-message
+ (gnc:html-document-add-object!
+ document
+ empty-report-message)))
(if (member 'no-match infobox-display)
(gnc:html-document-add-object!
@@ -1738,7 +1761,10 @@ tags within description, notes or memo. ")
(eq? primary-order 'ascend)
(eq? secondary-order 'ascend)
#t)))
- (set! splits (qof-query-run query))
+
+ (if (opt-val "__trep" "unique-transactions")
+ (set! splits (xaccQueryGetSplitsUniqueTrans query))
+ (set! splits (qof-query-run query)))
(qof-query-destroy query)
@@ -1786,7 +1812,7 @@ tags within description, notes or memo. ")
document
(gnc:render-options-changed options))))
- (let ((table (make-split-table splits options)))
+ (let ((table (make-split-table splits options custom-calculated-cells)))
(gnc:html-document-set-title! document report-title)
@@ -1810,6 +1836,11 @@ tags within description, notes or memo. ")
document))
+(define trep-guid "2fe3b9833af044abb929a88d5a59620f")
+(export trep-guid)
+(export trep-renderer)
+(export trep-options-generator)
+
;; Define the report.
(gnc:define-report
'version 1
@@ -1822,6 +1853,6 @@ tags within description, notes or memo. ")
(gnc:define-report
'version 1
'name reportname
- 'report-guid "2fe3b9833af044abb929a88d5a59620f"
+ 'report-guid trep-guid
'options-generator trep-options-generator
'renderer trep-renderer)
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index 48d9bbd..09c2cc1 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -1721,7 +1721,13 @@
"Use Full Other Account Name?" (cons #f "Use Full Other Account Name")
"Void Transactions?" (cons "Filter" "Void Transactions")
"Void Transactions" (cons "Filter" "Void Transactions")
- "Account Substring" (cons "Filter" "Account Matcher")
+ "Account Substring" (cons "Filter" "Account Name Filter")
+ "Account Matcher" (cons "Filter" "Account Name Filter")
+ "Transaction Matcher" (cons "Filter" "Transaction Filter")
+ "Account Matcher uses regular expressions for extended matching"
+ (cons "Filter" "Use regular expressions for account name filter")
+ "Transaction Matcher uses regular expressions for extended matching"
+ (cons "Filter" "Use regular expressions for transaction filter")
))
(name-match (member name new-names-list)))
commit 88b3446299bda0b7706e47dc1c2c440f8c769e4b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jan 7 23:15:57 2018 +1100
ADD-API: gnc:option-make-internal!, gnc:unregister-option
This commit adds 2 additional helper calls, primarily useful for
derived reports.
gnc:option-make-internal! will hide an existing option. e.g.
a derived report can set the value for a Display/* option and
hide it from the user.
gnc:unregister-option will unregister option. This is primarily
useful for derived options e.g. another report copies from
transaction.scm and removes some options and recreates them with
different parameters.
For example, unregister existing option from section "Accounts"
name "Accounts", and recreate with different parameters e.g.
limited account types.
diff --git a/libgnucash/app-utils/app-utils.scm b/libgnucash/app-utils/app-utils.scm
index 732f730..326e914 100644
--- a/libgnucash/app-utils/app-utils.scm
+++ b/libgnucash/app-utils/app-utils.scm
@@ -104,7 +104,7 @@
(export gnc:render-options-changed)
(export gnc:options-make-end-date!)
(export gnc:options-make-date-interval!)
-
+(export gnc:option-make-internal!)
(export gnc:make-number-range-option)
(export gnc:make-number-plot-size-option)
(export gnc:plot-size-option-value-type)
@@ -131,6 +131,7 @@
(export gnc:new-options)
(export gnc:register-option)
+(export gnc:unregister-option)
(export gnc:options-register-callback)
(export gnc:options-register-c-callback)
(export gnc:options-unregister-callback-id)
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index cbd9812..48d9bbd 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -1764,6 +1764,16 @@
new-option
(lambda () (option-changed section name)))))
+ (define (unregister-option section name)
+ (let* ((section-hash (hash-ref option-hash section)))
+ (if (and section-hash
+ (hash-ref section-hash name))
+ (begin
+ (hash-remove! section-hash name)
+ (if (zero? (hash-count (const #t) section-hash))
+ (hash-remove! option-hash section)))
+ (gnc:error "options:unregister-option: no such option\n"))))
+
; Call (thunk option) for each option in the database
(define (options-for-each thunk)
(define (section-for-each section-hash thunk)
@@ -1899,6 +1909,7 @@
(case key
((lookup) lookup-option)
((register-option) register-option)
+ ((unregister-option) unregister-option)
((register-callback) register-callback)
((unregister-callback-id) unregister-callback-id)
((for-each) options-for-each)
@@ -1939,6 +1950,9 @@
((options 'lookup) section name)
#f))
+(define (gnc:unregister-option options section name)
+ ((options 'unregister-option) section name))
+
(define (gnc:generate-restore-forms options options-string)
((options 'generate-restore-forms) options-string))
@@ -2103,3 +2117,11 @@
)))
(gnc:options-make-end-date! options pagename name-to
(string-append sort-tag "b") info-to))
+
+(define (gnc:option-make-internal! options section name)
+ ;; this function will hide the option specified
+ ;; the option functionality is unchanged
+ (let ((opt (gnc:lookup-option options section name)))
+ (if opt
+ (vector-set! opt 3 'internal)
+ (error "gnc:option-make-internal! cannot find section / name"))))
commit 6004b55d16a0dc4a3b52baed6dd16d70281c054f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jan 27 21:46:42 2018 +0800
TR: remove unnecessary no-account-after-filtering step
This merges the initial 'no-account' warning and the
'no-account-after-filtering' warning. This reduces
the number of strings required.
The user can select some accounts, set an account name
filter which produces no accounts, and will see a
blank report with the gnc:render-options-changed
confirming that options were set, and the blank
filter is caused by the filter.
Example: http://i.imgur.com/eqq1Bpa.png
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 68af382..86ccf8b 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -108,10 +108,6 @@
(define NO-MATCHING-TRANS-TEXT (_ "No transactions were found that \
match the time interval and account selection specified \
in the Options panel."))
-(define NO-MATCHING-ACCT-HEADER (_ "No matching accounts found"))
-(define NO-MATCHING-ACCT-TEXT (_ "No account were found that match the \
-options specified in the Options panels."))
-
(define DATE-SORTING-TYPES (list 'date 'reconciled-date))
@@ -1711,25 +1707,17 @@ tags within description, notes or memo. ")
(if (or (null? c_account_1) (and-map not c_account_1))
- (if (null? c_account_0)
+ ;; error condition: no accounts specified or obtained after filtering
+ (begin
- ;; error condition: no accounts specified
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj)))
- ;; error condition: accounts were specified but none matched string/regex
- (begin
+ (if (member 'no-match infobox-display)
(gnc:html-document-add-object!
document
- (gnc:make-html-text
- (gnc:html-markup-h2 NO-MATCHING-ACCT-HEADER)
- (gnc:html-markup-p NO-MATCHING-ACCT-TEXT)))
-
- (if (member 'no-match infobox-display)
- (gnc:html-document-add-object!
- document
- (gnc:render-options-changed options)))))
+ (gnc:render-options-changed options))))
(begin
commit 3749ca528be1925d9ae648f9002e42ebe49d26eb
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jan 28 07:29:44 2018 +0800
TR: omit display of $0 in subtotals in other currencies.
Previously in dual-subtotal columns, the dual-subtotal would
attempt to print all commodities in the row. This meant
if user chose common-currency thereby triggering additional
commodities, the dual-subtotal would attempt to add amounts
in other commodities which would be 0, and display the 0
amount. This commit will modify the the dual-subtotal strategy
to only add column where a value actually exists.
This commit is a continuation of previous TR enhancement
(multiple data columns) where I have now understood how
to disable these $0 amounts in subtotals.
From: http://i.imgur.com/sqAHsPQ.png
To: http://i.imgur.com/n0R7xeV.png
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index e22bbe6..68af382 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1113,50 +1113,43 @@ tags within description, notes or memo. ")
;; calculator-function ;; (calculator-function split) to obtain amount
;; reverse-column? ;; to optionally reverse signs
;; subtotal? ;; subtotal? to allow subtotals (ie irrelevant for running balance)
- ;; (vector start-dual-column? ;; #t for the left side of a dual column (i.e. debit/credit)
- ;; merging-function)) ;; function to apply to dual-subtotal (+ / -)
+ ;; start-dual-column? ;; #t for the left side of a dual column (i.e. debit/credit)
+ ;; ;; which means the next column will be the right side
;; friendly-heading-fn ;; retrieve friendly heading name for account debit/credit
(if (column-uses? 'amount-single)
(list (vector (header-commodity (_ "Amount"))
- amount #t #t
- (vector #f #f)
+ amount #t #t #f
(lambda (a) "")))
'())
(if (column-uses? 'amount-double)
(list (vector (header-commodity (_ "Debit"))
- debit-amount #f #t
- (vector #t +)
+ debit-amount #f #t #t
friendly-debit)
(vector (header-commodity (_ "Credit"))
- credit-amount #f #t
- (vector #f -)
+ 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
- (vector #f #f)
+ 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
- (vector #t +)
+ original-debit-amount #f #t #t
friendly-debit)
(vector (_ "Credit")
- original-credit-amount #f #t
- (vector #f -)
+ original-credit-amount #f #t #f
friendly-credit))
'())
(if (column-uses? 'running-balance)
(list (vector (_ "Running Balance")
- running-balance #t #f
- (vector #f #f)
+ running-balance #t #f #f
(lambda (a) "")))
'()))))
@@ -1252,44 +1245,45 @@ tags within description, notes or memo. ")
(define (add-columns commodity)
(let ((start-dual-column? #f)
- (dual-subtotal 0))
+ (dual-subtotal #f))
(for-each (lambda (column merge-entry)
(let* ((mon (retrieve-commodity column commodity))
(column-amount (and mon (gnc:gnc-monetary-amount mon)))
- (merge? (vector-ref merge-entry 0))
- (merge-fn (vector-ref merge-entry 1)))
+ (merge? merge-entry))
(if merge?
- ;; We're merging. Run merge-fn (usu + or -)
- ;; and store total in dual-subtotal. Do NOT add column.
+ ;; We're merging. If a subtotal exists, store
+ ;; it in dual-subtotal. Do NOT add column to row.
(begin
- (if column-amount
- (set! dual-subtotal
- (merge-fn dual-subtotal column-amount)))
+ (set! dual-subtotal column-amount)
(set! start-dual-column? #t))
(if start-dual-column?
(begin
- ;; We've completed merging. Add this column amount
- ;; and add the columns.
+ ;; We've completed merging. Add the negated
+ ;; column amount and add the columns to row.
(if column-amount
(set! dual-subtotal
- (merge-fn dual-subtotal column-amount)))
- (if (positive? dual-subtotal)
- (begin
- (addto! row-contents
- (gnc:make-html-table-cell/markup
- "total-number-cell"
- (gnc:make-gnc-monetary commodity dual-subtotal)))
- (addto! row-contents ""))
- (begin
- (addto! row-contents "")
- (addto! row-contents
- (gnc:make-html-table-cell/markup
- "total-number-cell"
- (gnc:make-gnc-monetary
- commodity
- (- dual-subtotal))))))
+ (- (or dual-subtotal 0) column-amount)))
+ (cond ((not dual-subtotal)
+ (addto! row-contents "")
+ (addto! row-contents ""))
+ ((positive? dual-subtotal)
+ (addto! row-contents
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
+ (gnc:make-gnc-monetary
+ commodity
+ dual-subtotal)))
+ (addto! row-contents ""))
+ (else
+ (addto! row-contents "")
+ (addto! row-contents
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
+ (gnc:make-gnc-monetary
+ commodity
+ (- dual-subtotal))))))
(set! start-dual-column? #f)
- (set! dual-subtotal 0))
+ (set! dual-subtotal #f))
;; Default; not merging/completed merge. Just
;; display monetary amount
(addto! row-contents
commit 12f3099f59cac59e9dfde98492c5c122991736aa
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jan 12 16:45:22 2018 +1100
(infobox)->(gnc:render-options-changed) in options.scm
This commit will change (infobox) to a general-purpose
renderer for "all options changed by user" in options.scm
and can be inserted into any report. It reduces the
number of strings required.
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 669474e..e22bbe6 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -14,8 +14,6 @@
;; - add custom sorter in scheme
;; - common currency - optionally show original currency amount
;; and enable multiple data columns
-;; - add informational box, summarising options used, useful
-;; to troubleshoot reports
;; - add support for indenting for better grouping
;; - add defaults suitable for a reconciliation report
;;
@@ -1717,83 +1715,6 @@ tags within description, notes or memo. ")
(generic-less? X Y 'date 'none #t))
- ;; infobox
- (define (infobox)
- (define (highlight title . data)
- (string-append "<b>" title "</b>: " (string-join data " ") "<br>"))
- (define (bool->string tf)
- (if tf
- (_ "Enabled")
- (_ "Disabled")))
- (gnc:make-html-text
- (if (string-null? account-matcher)
- ""
- (string-append
- (highlight
- (string-append optname-account-matcher
- (if (opt-val pagename-filter optname-account-matcher-regex)
- (_ " regex")
- ""))
- account-matcher)
- (highlight
- (_ "Accounts produced")
- (string-join (map xaccAccountGetName c_account_1) ", "))))
- (if (eq? filter-mode 'none)
- ""
- (highlight
- (keylist-get-info filter-list filter-mode 'text)
- (string-join (map xaccAccountGetName c_account_2) ", ")))
- (if (string-null? transaction-matcher)
- ""
- (string-append
- (highlight
- (string-append optname-transaction-matcher
- (if (opt-val pagename-filter optname-transaction-matcher-regex)
- (_ " regex")
- ""))
- transaction-matcher)))
- (if reconcile-status-filter
- (highlight
- optname-reconcile-status
- (keylist-get-info reconcile-status-list reconcile-status-filter 'text))
- "")
- (if (eq? void-status 'non-void-only)
- ""
- (highlight
- optname-void-transactions
- (keylist-get-info show-void-list void-status 'text)))
- (if (eq? primary-key 'none)
- ""
- (highlight
- optname-prime-sortkey
- (keylist-get-info sortkey-list primary-key 'text)
- (keylist-get-info ascending-list primary-order 'text)))
- (if (eq? primary-key 'none)
- ""
- (if (member primary-key DATE-SORTING-TYPES)
- (highlight
- optname-prime-date-subtotal
- (keylist-get-info date-subtotal-list primary-date-subtotal 'text))
- (highlight
- optname-prime-subtotal
- (bool->string (opt-val pagename-sorting optname-prime-subtotal)))))
- (if (eq? secondary-key 'none)
- ""
- (highlight
- optname-sec-sortkey
- (keylist-get-info sortkey-list secondary-key 'text)
- (keylist-get-info ascending-list secondary-order 'text)))
- (if (eq? secondary-key 'none)
- ""
- (if (member secondary-key DATE-SORTING-TYPES)
- (highlight
- optname-sec-date-subtotal
- (keylist-get-info date-subtotal-list secondary-date-subtotal 'text))
- (highlight
- optname-sec-subtotal
- (bool->string (opt-val pagename-sorting optname-sec-subtotal)))))
- "<br>"))
-
(if (or (null? c_account_1) (and-map not c_account_1))
(if (null? c_account_0)
@@ -1814,7 +1735,7 @@ tags within description, notes or memo. ")
(if (member 'no-match infobox-display)
(gnc:html-document-add-object!
document
- (infobox)))))
+ (gnc:render-options-changed options)))))
(begin
@@ -1881,7 +1802,7 @@ tags within description, notes or memo. ")
(if (member 'no-match infobox-display)
(gnc:html-document-add-object!
document
- (infobox))))
+ (gnc:render-options-changed options))))
(let ((table (make-split-table splits options)))
@@ -1899,7 +1820,7 @@ tags within description, notes or memo. ")
(if (member 'match infobox-display)
(gnc:html-document-add-object!
document
- (infobox)))
+ (gnc:render-options-changed options)))
(gnc:html-document-add-object! document table)))))
diff --git a/libgnucash/app-utils/app-utils.scm b/libgnucash/app-utils/app-utils.scm
index 44fe75b..732f730 100644
--- a/libgnucash/app-utils/app-utils.scm
+++ b/libgnucash/app-utils/app-utils.scm
@@ -101,6 +101,7 @@
(export gnc:make-radiobutton-option)
(export gnc:make-radiobutton-callback-option)
(export gnc:make-list-option)
+(export gnc:render-options-changed)
(export gnc:options-make-end-date!)
(export gnc:options-make-date-interval!)
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index b6c4f96..cbd9812 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -1987,6 +1987,64 @@
(gnc:option-value src-option)))))
src-options)))
+(define* (gnc:render-options-changed options #:optional plaintext?)
+ ;;
+ ;; options -> string
+ ;;
+ ;; this function will generate an string of options that were changed by the user.
+ ;; by default, it produces an html string.
+ ;; the optional plaintext? = #t will ensure the output is suitable for console output
+ ;; omitting all html elements, and is expected to be used for unit tests only.
+ ;;
+ (let ((row-contents '()))
+ (define (disp d)
+ ;; this function will intelligently display the option value. the option-value is subject to various tests
+ ;; the or clause below will test for boolean, null, list, and pairs. each will trigger a custom function
+ ;; returning a string. the pair option is handled differently because its car will define the data type
+ ;; for its cdr which is either a symbol, time64 number, percent or pixels. if the option does not satisfy
+ ;; any of the above, the function attempts to pass it as a parameter to gnc-commodity-get-mnemonic, or
+ ;; xaccAccountGetName, or gnc-budget-get-name; success leads to application of these functions, failure
+ ;; then leads to a generic stringify function which will handle symbol/string/other types.
+ (define (try thunk arg)
+ ;; this helper function will attempt to run thunk with arg as a parameter. we will catch any
+ ;; 'wrong-type-arg exception, and return the #f value to the or evaluator below.
+ (catch 'wrong-type-arg
+ (lambda () (thunk arg))
+ (lambda (k . args) #f)))
+ (or (and (boolean? d) (if d (_ "Enabled") (_ "Disabled")))
+ (and (null? d) "null")
+ (and (list? d) (string-join (map disp d) ", "))
+ (and (pair? d) (string-append
+ (disp (car d)) " . "
+ (case (car d)
+ ((relative) (symbol->string (cdr d)))
+ ((absolute) (qof-print-date (cdr d)))
+ ((pixels percent) (number->string (cdr d)))
+ (else (format #f "unknown car of pair, cannot determine format for ~A" (cdr d))))))
+ (try gnc-commodity-get-mnemonic d)
+ (try xaccAccountGetName d)
+ (try gnc-budget-get-name d)
+ (format #f "~A" d)))
+ (define (disp-option-if-changed option)
+ ;; this function is called by gnc:options-for-each on each option, and will test whether default value
+ ;; has been changed and the option is not hidden, and display it using (disp val) as above.
+ (let* ((section (gnc:option-section option))
+ (name (gnc:option-name option))
+ (default-value (gnc:option-default-value option))
+ (value (gnc:option-value option))
+ (return-string (string-append (if plaintext? "" "<b>")
+ section " / " name
+ (if plaintext? "" "</b>")
+ ": "
+ (disp value))))
+ (if (not (or (equal? default-value value)
+ (char=? (string-ref section 0) #\_)))
+ (set! row-contents (cons return-string row-contents)))))
+ (gnc:options-for-each disp-option-if-changed options)
+ (string-append (string-join (reverse row-contents)
+ (if plaintext? "\n" "<br>"))
+ (if plaintext? "\n\n" "<br><br>"))))
+
(define (gnc:send-options db_handle options)
(gnc:options-for-each
(lambda (option)
commit 01e604d8eebf2ac262ea550e2f292bbafa2ef042
Author: christopherlam <christopher.lck at gmail.com>
Date: Thu Feb 1 15:08:28 2018 +0800
Use xaccSplitGetReconcile instead of (zero? date)
(zero? date) not a good test for reconcile status.
Use xaccSplitGetReconcile(split)=='y'.
This is a better test.
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index a8697cb..669474e 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -974,10 +974,9 @@ tags within description, notes or memo. ")
(lambda (split transaction-row?)
(gnc:make-html-table-cell/markup
"date-cell"
- (let ((date (xaccSplitGetDateReconciled split)))
- (if (zero? date)
- ""
- (qof-print-date date)))))))
+ (if (eq? (xaccSplitGetReconcile split) #\y)
+ (qof-print-date (xaccSplitGetDateReconciled split))
+ "")))))
(add-if (column-uses? 'num)
(vector (if (and BOOK-SPLIT-ACTION
Summary of changes:
.../standard-reports/income-gst-statement.scm | 1957 ++------------------
gnucash/report/standard-reports/transaction.scm | 268 ++-
libgnucash/app-utils/app-utils.scm | 4 +-
libgnucash/app-utils/options.scm | 82 +-
4 files changed, 402 insertions(+), 1909 deletions(-)
More information about the gnucash-changes
mailing list