gnucash stable: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Wed Apr 19 21:26:09 EDT 2023
Updated via https://github.com/Gnucash/gnucash/commit/a0f94ecd (commit)
via https://github.com/Gnucash/gnucash/commit/7b3702e7 (commit)
via https://github.com/Gnucash/gnucash/commit/1302c314 (commit)
via https://github.com/Gnucash/gnucash/commit/415438d0 (commit)
via https://github.com/Gnucash/gnucash/commit/8a8960c4 (commit)
from https://github.com/Gnucash/gnucash/commit/d9ba9a4c (commit)
commit a0f94ecd7508266c2ff65776d941174bfad79965
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Apr 20 09:00:39 2023 +0800
report/test/* untabify/delete-trailing-whitespace
diff --git a/gnucash/report/test/test-report-utilities.scm b/gnucash/report/test/test-report-utilities.scm
index 5aae0c80c5..e635da76ef 100644
--- a/gnucash/report/test/test-report-utilities.scm
+++ b/gnucash/report/test/test-report-utilities.scm
@@ -50,19 +50,19 @@
(q-start-date (NDayDelta q-start-date 5)))
(let* ((accounts (env-create-account-structure-alist env (list "Assets"
- (list (cons 'type ACCT-TYPE-ASSET))
- (list "Bank Account")
- (list "Wallet"))))
- (bank-account (cdr (assoc "Bank Account" accounts)))
- (wallet (cdr (assoc "Wallet" accounts))))
+ (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Bank Account")
+ (list "Wallet"))))
+ (bank-account (cdr (assoc "Bank Account" accounts)))
+ (wallet (cdr (assoc "Wallet" accounts))))
(env-create-daily-transactions env start-date end-date bank-account wallet)
(format #t "Created transactions for each day from ~a to ~a~%" (gnc-ctime start-date) (gnc-ctime end-date))
(let ((splits (gnc:account-get-trans-type-splits-interval (list bank-account wallet)
- ACCT-TYPE-ASSET
- q-start-date q-end-date)))
- ;; 10 is the right number (5 days, two splits per tx)
- (test-equal "length splits = 10"
+ ACCT-TYPE-ASSET
+ q-start-date q-end-date)))
+ ;; 10 is the right number (5 days, two splits per tx)
+ (test-equal "length splits = 10"
10
(length splits)))))
(teardown)))
diff --git a/gnucash/report/test/test-test-extras.scm b/gnucash/report/test/test-test-extras.scm
index 78cd693c6d..84328ffd93 100644
--- a/gnucash/report/test/test-test-extras.scm
+++ b/gnucash/report/test/test-test-extras.scm
@@ -28,12 +28,12 @@
(define (test-create-account-structure)
(let ((env (create-test-env)))
(let ((accounts (env-create-account-structure env (list "Assets"
- (list (cons 'type ACCT-TYPE-ASSET))
- (list "Bank Account")
- (list "Savings"
- (list "Instant")
- (list "30 day notice"))))))
+ (list (cons 'type ACCT-TYPE-ASSET))
+ (list "Bank Account")
+ (list "Savings"
+ (list "Instant")
+ (list "30 day notice"))))))
(format #t "Accounts ~a\n" accounts)
(and (= 3 (length accounts))
- (equal? "Assets" (xaccAccountGetName (car accounts)))
- ))))
+ (equal? "Assets" (xaccAccountGetName (car accounts)))
+ ))))
commit 7b3702e7e6f62fdea7370ab0d20d97fbf6a54dec
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Apr 20 09:00:32 2023 +0800
reports/standard/* untabify/delete-trailing-whitespace
diff --git a/gnucash/report/reports/standard/account-piecharts.scm b/gnucash/report/reports/standard/account-piecharts.scm
index a16e30aef3..439c6333e3 100644
--- a/gnucash/report/reports/standard/account-piecharts.scm
+++ b/gnucash/report/reports/standard/account-piecharts.scm
@@ -1,19 +1,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; account-piecharts.scm: shows piechart of accounts
-;;
-;; By Robert Merkel (rgmerk at mira.net)
+;;
+;; By Robert Merkel (rgmerk at mira.net)
;; and Christian Stimming <stimming at tu-harburg.de>
;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -43,13 +43,13 @@
;; The menu statusbar tips.
(define menutip-income
(N_ "Shows a piechart with the Income per given time interval"))
-(define menutip-expense
+(define menutip-expense
(N_ "Shows a piechart with the Expenses per given time interval"))
-(define menutip-assets
+(define menutip-assets
(N_ "Shows a piechart with the Assets balance at a given time"))
(define menutip-securities
(N_ "Shows a piechart with distribution of assets over securities"))
-(define menutip-liabilities
+(define menutip-liabilities
(N_ "Shows a piechart with the Liabilities \
balance at a given time"))
@@ -298,14 +298,14 @@ balance at a given time"))
(gnc:report-starting reportname)
;; Get all options
- (let ((to-date (gnc:time64-end-day-time
+ (let ((to-date (gnc:time64-end-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-to-date))))
(from-date (if do-intervals?
- (gnc:time64-start-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-from-date)))
+ (gnc:time64-start-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-from-date)))
'()))
(accounts (get-option gnc:pagename-accounts optname-accounts))
(account-levels
@@ -313,11 +313,11 @@ balance at a given time"))
(get-option gnc:pagename-accounts optname-levels)
'all))
(report-currency (get-option gnc:pagename-general
- optname-report-currency))
+ optname-report-currency))
(price-source (get-option gnc:pagename-general
optname-price-source))
- (report-title (get-option gnc:pagename-general
- gnc:optname-reportname))
+ (report-title (get-option gnc:pagename-general
+ gnc:optname-reportname))
(averaging-selection (if do-intervals?
(get-option gnc:pagename-general
optname-averaging)
@@ -327,14 +327,14 @@ balance at a given time"))
(show-total? (get-option gnc:pagename-display optname-show-total))
(show-percent? (get-option gnc:pagename-display optname-show-percent))
(max-slices (inexact->exact
- (get-option gnc:pagename-display optname-slices)))
+ (get-option gnc:pagename-display optname-slices)))
(height (get-option gnc:pagename-display optname-plot-height))
(width (get-option gnc:pagename-display optname-plot-width))
- (sort-method (get-option gnc:pagename-display optname-sort-method))
+ (sort-method (get-option gnc:pagename-display optname-sort-method))
(document (gnc:make-html-document))
(chart (gnc:make-html-chart))
- (topl-accounts (gnc:filter-accountlist-type
+ (topl-accounts (gnc:filter-accountlist-type
account-types
(gnc-account-get-children-sorted
(gnc-get-current-root-account)))))
@@ -343,7 +343,7 @@ balance at a given time"))
;; selection option.
(define (show-acct? a)
(member a accounts))
-
+
;; Calculates the net balance (profit or loss) of an account
;; over the selected reporting period. If subaccts? == #t, all
;; subaccount's balances are included as well. Returns a
@@ -356,7 +356,7 @@ balance at a given time"))
account to-date subaccts?)))
;; Define more helper variables.
- (let* ((exchange-fn (gnc:case-exchange-fn
+ (let* ((exchange-fn (gnc:case-exchange-fn
price-source report-currency to-date))
(tree-depth (if (equal? account-levels 'all)
(gnc:get-current-account-tree-depth)
@@ -410,7 +410,7 @@ balance at a given time"))
(collector->amount (profit-fn a subaccts?)))
(define (count-accounts current-depth accts)
- (if (< current-depth tree-depth)
+ (if (< current-depth tree-depth)
(let iter ((sum 0)
(remaining accts))
(if (null? remaining)
@@ -420,11 +420,11 @@ balance at a given time"))
(subaccts (count-accounts (1+ current-depth)
(gnc-account-get-children cur))))
(iter (+ sum (1+ subaccts)) tail))))
- (length (filter show-acct? accts))))
+ (length (filter show-acct? accts))))
;; Get base data to be plotted.
(define work-to-do (lambda () (count-accounts 1 topl-accounts)))
-
+
(define base-data (lambda ()
(get-data account-balance show-acct? work-to-do tree-depth
0 1 topl-accounts)))
@@ -434,15 +434,15 @@ balance at a given time"))
(if reverse-balance?
(cons (- (car pair)) (cdr pair))
pair))
- combined))
+ combined))
;; Now do the work here.
(if (not (null? accounts))
(begin
(set! combined
- (sort (filter (lambda (pair) (not (>= 0.0 (car pair))))
- (fix-signs (cdr (base-data))))
+ (sort (filter (lambda (pair) (not (>= 0.0 (car pair))))
+ (fix-signs (cdr (base-data))))
(sort-comparator sort-method show-fullname?)))
;; if too many slices, condense them to an 'other' slice
@@ -468,8 +468,8 @@ balance at a given time"))
(set! id (gnc:make-report report-guid options))
;; set the URL.
(set! other-anchor (gnc:report-anchor-text id))))))
-
- (if
+
+ (if
(not (null? combined))
(let ((urls (and depth-based?
(map
@@ -562,13 +562,13 @@ balance at a given time"))
(gnc:html-document-add-object!
document
- (gnc:html-make-empty-data-warning
- report-title (gnc:report-id report-obj)))))
+ (gnc:html-make-empty-data-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))))
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj))))
(gnc:report-finished)
document)))
diff --git a/gnucash/report/reports/standard/advanced-portfolio.scm b/gnucash/report/reports/standard/advanced-portfolio.scm
index 4d5d0767d7..7421dcddda 100644
--- a/gnucash/report/reports/standard/advanced-portfolio.scm
+++ b/gnucash/report/reports/standard/advanced-portfolio.scm
@@ -28,7 +28,7 @@
(define-module (gnucash reports standard advanced-portfolio))
(use-modules (gnucash engine))
-(use-modules (gnucash utilities))
+(use-modules (gnucash utilities))
(use-modules (gnucash core-utils))
(use-modules (gnucash app-utils))
(use-modules (gnucash report))
@@ -97,19 +97,19 @@ by preventing negative stock balances.<br/>")
(vector 'ignore-brokerage (N_ "Omit from report"))))
(gnc-register-simple-boolean-option options
- gnc:pagename-display optname-show-symbol "a"
- (N_ "Display the ticker symbols.")
- #t)
+ gnc:pagename-display optname-show-symbol "a"
+ (N_ "Display the ticker symbols.")
+ #t)
(gnc-register-simple-boolean-option options
- gnc:pagename-display optname-show-listing "b"
- (N_ "Display exchange listings.")
- #t)
+ gnc:pagename-display optname-show-listing "b"
+ (N_ "Display exchange listings.")
+ #t)
(gnc-register-simple-boolean-option options
- gnc:pagename-display optname-show-shares "c"
- (N_ "Display numbers of shares in accounts.")
- #t)
+ gnc:pagename-display optname-show-shares "c"
+ (N_ "Display numbers of shares in accounts.")
+ #t)
(gnc-register-number-range-option options
gnc:pagename-display optname-shares-digits
@@ -117,9 +117,9 @@ by preventing negative stock balances.<br/>")
0 9 1)
(gnc-register-simple-boolean-option options
- gnc:pagename-display optname-show-price "e"
- (N_ "Display share prices.")
- #t)
+ gnc:pagename-display optname-show-price "e"
+ (N_ "Display share prices.")
+ #t)
;; Account tab
(gnc-register-account-list-limited-option options
@@ -169,30 +169,30 @@ by preventing negative stock balances.<br/>")
;; sum up the contents of the b-list built by basis-builder below
(define (sum-basis b-list currency-frac)
(if (not (eqv? b-list '()))
- (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND)
- (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND)
- (gnc-numeric-zero)
- )
+ (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND)
+ (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND)
+ (gnc-numeric-zero)
+ )
)
;; sum up the total number of units in the b-list built by basis-builder below
(define (units-basis b-list)
(if (not (eqv? b-list '()))
- (gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
- units-denom GNC-RND-ROUND)
- (gnc-numeric-zero)
- )
+ (gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
+ units-denom GNC-RND-ROUND)
+ (gnc-numeric-zero)
+ )
)
;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs
;; I need to get a brain and use (map) for this.
(define (apply-basis-ratio b-list units-ratio value-ratio)
(if (not (eqv? b-list '()))
- (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND)
- (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))
- (apply-basis-ratio (cdr b-list) units-ratio value-ratio))
- '()
- )
+ (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND)
+ (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))
+ (apply-basis-ratio (cdr b-list) units-ratio value-ratio))
+ '()
+ )
)
;; this builds a list for basis calculation and handles average, fifo and lifo methods
@@ -209,34 +209,34 @@ by preventing negative stock balances.<br/>")
;; we have value and positive units, add units to basis
((and (not (gnc-numeric-zero-p b-value))
- (gnc-numeric-positive-p b-units))
+ (gnc-numeric-positive-p b-units))
(case b-method
- ((average-basis)
- (if (not (eqv? b-list '()))
- (list (cons (gnc-numeric-add b-units
- (caar b-list) units-denom GNC-RND-ROUND)
- (gnc-numeric-div
- (gnc-numeric-add b-value
- (gnc-numeric-mul (caar b-list)
- (cdar b-list)
- GNC-DENOM-AUTO GNC-DENOM-REDUCE)
- GNC-DENOM-AUTO GNC-DENOM-REDUCE)
- (let ((denom (gnc-numeric-add b-units
+ ((average-basis)
+ (if (not (eqv? b-list '()))
+ (list (cons (gnc-numeric-add b-units
+ (caar b-list) units-denom GNC-RND-ROUND)
+ (gnc-numeric-div
+ (gnc-numeric-add b-value
+ (gnc-numeric-mul (caar b-list)
+ (cdar b-list)
+ GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+ GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+ (let ((denom (gnc-numeric-add b-units
(caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
(if (zero? denom)
(throw 'div/0 (format #f "buying ~0,4f share units" b-units))
denom))
- price-denom GNC-RND-ROUND)))
- (append b-list
+ price-denom GNC-RND-ROUND)))
+ (append b-list
(list (cons b-units (gnc-numeric-div
b-value b-units price-denom GNC-RND-ROUND))))))
- (else (append b-list
+ (else (append b-list
(list (cons b-units (gnc-numeric-div
b-value b-units price-denom GNC-RND-ROUND)))))))
;; we have value and negative units, remove units from basis
((and (not (gnc-numeric-zero-p b-value))
- (gnc-numeric-negative-p b-units))
+ (gnc-numeric-negative-p b-units))
(if (not (eqv? b-list '()))
(case b-method
((fifo-basis)
@@ -278,38 +278,38 @@ by preventing negative stock balances.<br/>")
;; no value, just units, this is a split/merge...
((and (gnc-numeric-zero-p b-value)
- (not (gnc-numeric-zero-p b-units)))
- (let* ((current-units (units-basis b-list))
+ (not (gnc-numeric-zero-p b-units)))
+ (let* ((current-units (units-basis b-list))
;; If current-units is zero then so should be everything else.
- (units-ratio (if (zero? current-units) (gnc-numeric-zero)
+ (units-ratio (if (zero? current-units) (gnc-numeric-zero)
(gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
;; If the units ratio is zero the stock is worthless and the value should be zero too
- (value-ratio (if (gnc-numeric-zero-p units-ratio)
- (gnc-numeric-zero)
+ (value-ratio (if (gnc-numeric-zero-p units-ratio)
+ (gnc-numeric-zero)
(gnc-numeric-div 1/1 units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
- (gnc:debug "blist is " b-list " current units is "
- (gnc-numeric-to-string current-units)
- " value ratio is " (gnc-numeric-to-string value-ratio)
- " units ratio is " (gnc-numeric-to-string units-ratio))
- (apply-basis-ratio b-list units-ratio value-ratio)
- ))
+ (gnc:debug "blist is " b-list " current units is "
+ (gnc-numeric-to-string current-units)
+ " value ratio is " (gnc-numeric-to-string value-ratio)
+ " units ratio is " (gnc-numeric-to-string units-ratio))
+ (apply-basis-ratio b-list units-ratio value-ratio)
+ ))
- ;; If there are no units, just a value, then its a spin-off,
- ;; calculate a ratio for the values, but leave the units alone
- ;; with a ratio of 1
+ ;; If there are no units, just a value, then its a spin-off,
+ ;; calculate a ratio for the values, but leave the units alone
+ ;; with a ratio of 1
((and (gnc-numeric-zero-p b-units)
- (not (gnc-numeric-zero-p b-value)))
+ (not (gnc-numeric-zero-p b-value)))
(let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
(value-ratio (if (zero? current-value)
(throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value))
(gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
- (gnc:debug "this is a spinoff")
- (gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
- (apply-basis-ratio b-list 1/1 value-ratio))
+ (gnc:debug "this is a spinoff")
+ (gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
+ (apply-basis-ratio b-list 1/1 value-ratio))
)
;; when all else fails, just send the b-list back
@@ -358,23 +358,23 @@ by preventing negative stock balances.<br/>")
(define (table-add-stock-rows table accounts to-date
currency price-fn exchange-fn price-source
- include-empty show-symbol show-listing show-shares show-price
+ include-empty show-symbol show-listing show-shares show-price
basis-method prefer-pricelist handle-brokerage-fees
total-basis total-value
total-moneyin total-moneyout total-income total-gain
total-ugain total-brokerage)
(let ((share-print-info
- (gnc-share-print-info-places
- (inexact->exact (get-option gnc:pagename-display
- optname-shares-digits)))))
+ (gnc-share-print-info-places
+ (inexact->exact (get-option gnc:pagename-display
+ optname-shares-digits)))))
(define (table-add-stock-rows-internal accounts odd-row?)
(if (null? accounts) total-value
(let* ((row-style (if odd-row? "normal-row" "alternate-row"))
(current (car accounts))
(rest (cdr accounts))
- ;; commodity is the actual stock/thing we are looking at
+ ;; commodity is the actual stock/thing we are looking at
(commodity (xaccAccountGetCommodity current))
(ticker-symbol (gnc-commodity-get-mnemonic commodity))
(listing (gnc-commodity-get-namespace commodity))
@@ -390,23 +390,23 @@ by preventing negative stock balances.<br/>")
(gaincoll (gnc:make-commodity-collector))
- ;; the price of the commodity at the time of the report
+ ;; the price of the commodity at the time of the report
(price (price-fn commodity currency to-date))
- ;; the value of the commodity, expressed in terms of
- ;; the report's currency.
+ ;; the value of the commodity, expressed in terms of
+ ;; the report's currency.
(value (gnc:make-gnc-monetary currency (gnc-numeric-zero))) ;; Set later
(currency-frac (gnc-commodity-get-fraction currency))
- (pricing-txn #f)
- (use-txn #f)
- (basis-list '())
- ;; setup an alist for the splits we've already seen.
- (seen_trans '())
- ;; Account used to hold remainders from income reinvestments and
- ;; running total of amount moved there
- (drp-holding-account #f)
- (drp-holding-amount (gnc-numeric-zero))
- )
+ (pricing-txn #f)
+ (use-txn #f)
+ (basis-list '())
+ ;; setup an alist for the splits we've already seen.
+ (seen_trans '())
+ ;; Account used to hold remainders from income reinvestments and
+ ;; running total of amount moved there
+ (drp-holding-account #f)
+ (drp-holding-amount (gnc-numeric-zero))
+ )
(define (my-exchange-fn fromunits tocurrency)
(if (and (gnc-commodity-equiv currency tocurrency)
@@ -495,40 +495,40 @@ by preventing negative stock balances.<br/>")
" from " (gnc:monetary->string
(gnc:make-gnc-monetary commodity units)))
- (for-each
- ;; we're looking at each split we find in the account. these splits
- ;; could refer to the same transaction, so we have to examine each
- ;; split, determine what kind of split it is and then act accordingly.
- (lambda (split)
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
-
- (let* ((parent (xaccSplitGetParent split))
- (txn-date (xaccTransGetDate parent))
- (commod-currency (xaccTransGetCurrency parent))
- (commod-currency-frac (gnc-commodity-get-fraction commod-currency)))
-
- (if (and (<= txn-date to-date)
- (not (assoc-ref seen_trans (gncTransGetGUID parent))))
- (let ((trans-income (gnc-numeric-zero))
- (trans-brokerage (gnc-numeric-zero))
- (trans-shares (gnc-numeric-zero))
- (shares-bought (gnc-numeric-zero))
- (trans-sold (gnc-numeric-zero))
- (trans-bought (gnc-numeric-zero))
- (trans-spinoff (gnc-numeric-zero))
- (trans-drp-residual (gnc-numeric-zero))
- (trans-drp-account #f))
-
- (gnc:debug "Transaction " (xaccTransGetDescription parent))
- ;; Add this transaction to the list of processed transactions so we don't
- ;; do it again if there is another split in it for this account
- (set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans))
-
- ;; Go through all the splits in the transaction to get an overall idea of
- ;; what it does in terms of income, money in or out, shares bought or sold, etc.
- (for-each
- (lambda (s)
+ (for-each
+ ;; we're looking at each split we find in the account. these splits
+ ;; could refer to the same transaction, so we have to examine each
+ ;; split, determine what kind of split it is and then act accordingly.
+ (lambda (split)
+ (set! work-done (+ 1 work-done))
+ (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
+
+ (let* ((parent (xaccSplitGetParent split))
+ (txn-date (xaccTransGetDate parent))
+ (commod-currency (xaccTransGetCurrency parent))
+ (commod-currency-frac (gnc-commodity-get-fraction commod-currency)))
+
+ (if (and (<= txn-date to-date)
+ (not (assoc-ref seen_trans (gncTransGetGUID parent))))
+ (let ((trans-income (gnc-numeric-zero))
+ (trans-brokerage (gnc-numeric-zero))
+ (trans-shares (gnc-numeric-zero))
+ (shares-bought (gnc-numeric-zero))
+ (trans-sold (gnc-numeric-zero))
+ (trans-bought (gnc-numeric-zero))
+ (trans-spinoff (gnc-numeric-zero))
+ (trans-drp-residual (gnc-numeric-zero))
+ (trans-drp-account #f))
+
+ (gnc:debug "Transaction " (xaccTransGetDescription parent))
+ ;; Add this transaction to the list of processed transactions so we don't
+ ;; do it again if there is another split in it for this account
+ (set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans))
+
+ ;; Go through all the splits in the transaction to get an overall idea of
+ ;; what it does in terms of income, money in or out, shares bought or sold, etc.
+ (for-each
+ (lambda (s)
(let ((split-units (xaccSplitGetAmount s))
(split-value (xaccSplitGetValue s)))
@@ -587,32 +587,32 @@ by preventing negative stock balances.<br/>")
(set! trans-drp-residual (gnc-numeric-add trans-drp-residual split-value
commod-currency-frac GNC-RND-ROUND))
(set! trans-drp-account 'none))))))
- ))
- (xaccTransGetSplitList parent)
- )
-
- (gnc:debug "Income: " (gnc-numeric-to-string trans-income)
- " Brokerage: " (gnc-numeric-to-string trans-brokerage)
- " Shares traded: " (gnc-numeric-to-string trans-shares)
- " Shares bought: " (gnc-numeric-to-string shares-bought))
- (gnc:debug " Value sold: " (gnc-numeric-to-string trans-sold)
- " Value purchased: " (gnc-numeric-to-string trans-bought)
- " Spinoff value " (gnc-numeric-to-string trans-spinoff)
- " Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual))
-
- ;; We need to calculate several things for this transaction:
- ;; 1. Total income: this is already in trans-income
- ;; 2. Change in basis: calculated by loop below that looks at every
- ;; that acquires or disposes of shares
- ;; 3. Realized gain: also calculated below while calculating basis
- ;; 4. Money in to the account: this is the value of shares bought
- ;; except those purchased with reinvested income
- ;; 5. Money out: the money received by disposing of shares. This
- ;; is in trans-sold plus trans-spinoff
- ;; 6. Brokerage fees: this is in trans-brokerage
-
- ;; Income
- (dividendcoll 'add commod-currency trans-income)
+ ))
+ (xaccTransGetSplitList parent)
+ )
+
+ (gnc:debug "Income: " (gnc-numeric-to-string trans-income)
+ " Brokerage: " (gnc-numeric-to-string trans-brokerage)
+ " Shares traded: " (gnc-numeric-to-string trans-shares)
+ " Shares bought: " (gnc-numeric-to-string shares-bought))
+ (gnc:debug " Value sold: " (gnc-numeric-to-string trans-sold)
+ " Value purchased: " (gnc-numeric-to-string trans-bought)
+ " Spinoff value " (gnc-numeric-to-string trans-spinoff)
+ " Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual))
+
+ ;; We need to calculate several things for this transaction:
+ ;; 1. Total income: this is already in trans-income
+ ;; 2. Change in basis: calculated by loop below that looks at every
+ ;; that acquires or disposes of shares
+ ;; 3. Realized gain: also calculated below while calculating basis
+ ;; 4. Money in to the account: this is the value of shares bought
+ ;; except those purchased with reinvested income
+ ;; 5. Money out: the money received by disposing of shares. This
+ ;; is in trans-sold plus trans-spinoff
+ ;; 6. Brokerage fees: this is in trans-brokerage
+
+ ;; Income
+ (dividendcoll 'add commod-currency trans-income)
;; Brokerage fees. May be either ignored or part of basis, but that
;; will be dealt with elsewhere.
@@ -677,8 +677,8 @@ by preventing negative stock balances.<br/>")
(moneyoutcoll 'add commod-currency trans-spinoff)
;; Look at splits again to handle changes in basis and realized gains
- (for-each
- (lambda (s)
+ (for-each
+ (lambda (s)
(let
;; get the split's units and value
((split-units (xaccSplitGetAmount s))
@@ -693,30 +693,30 @@ by preventing negative stock balances.<br/>")
(same-account? current (xaccSplitGetAccount s)))
;; Split into subject account with non-zero amount. This is a purchase
;; or a sale, adjust the basis
- (let* ((split-value-currency (gnc:gnc-monetary-amount
- (my-exchange-fn (gnc:make-gnc-monetary
- commod-currency split-value) currency)))
- (orig-basis (sum-basis basis-list currency-frac))
- ;; proportion of the fees attributable to this split
- (fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares
- GNC-DENOM-AUTO GNC-DENOM-REDUCE))
- ;; Fees for this split in report currency
- (fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
- (gnc:make-gnc-monetary commod-currency
- (gnc-numeric-mul fee-ratio trans-brokerage
- commod-currency-frac GNC-RND-ROUND))
- currency)))
- (split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
- ;; Include brokerage fees in basis
- (gnc-numeric-add split-value-currency fees-currency
- currency-frac GNC-RND-ROUND)
- split-value-currency)))
+ (let* ((split-value-currency (gnc:gnc-monetary-amount
+ (my-exchange-fn (gnc:make-gnc-monetary
+ commod-currency split-value) currency)))
+ (orig-basis (sum-basis basis-list currency-frac))
+ ;; proportion of the fees attributable to this split
+ (fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares
+ GNC-DENOM-AUTO GNC-DENOM-REDUCE))
+ ;; Fees for this split in report currency
+ (fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
+ (gnc:make-gnc-monetary commod-currency
+ (gnc-numeric-mul fee-ratio trans-brokerage
+ commod-currency-frac GNC-RND-ROUND))
+ currency)))
+ (split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
+ ;; Include brokerage fees in basis
+ (gnc-numeric-add split-value-currency fees-currency
+ currency-frac GNC-RND-ROUND)
+ split-value-currency)))
(gnc:debug "going in to basis list " basis-list " " (gnc-numeric-to-string split-units) " "
(gnc-numeric-to-string split-value-with-fees))
- ;; adjust the basis
- (set! basis-list (basis-builder basis-list split-units split-value-with-fees
- basis-method currency-frac))
+ ;; adjust the basis
+ (set! basis-list (basis-builder basis-list split-units split-value-with-fees
+ basis-method currency-frac))
(gnc:debug "coming out of basis list " basis-list)
;; If it's a sale or the stock is worthless, calculate the gain
@@ -752,110 +752,110 @@ by preventing negative stock balances.<br/>")
currency-frac))
(gnc:debug "after spin-off basis list " basis-list))
)
- ))
- (xaccTransGetSplitList parent)
- )
- )
- )
- )
- )
- (xaccAccountGetSplitList current)
- )
-
- ;; Look for income and expense transactions that don't have a split in the
- ;; the account we're processing. We do this as follow
- ;; 1. Make sure the parent account is a currency-valued asset or bank account
- ;; 2. If so go through all the splits in that account
- ;; 3. If a split is part of a two split transaction where the other split is
- ;; to an income or expense account and the leaf name of that account is the
- ;; same as the leaf name of the account we're processing, add it to the
- ;; income or expense accumulator
- ;;
- ;; In other words with an account structure like
- ;;
- ;; Assets (type ASSET)
- ;; Broker (type ASSET)
- ;; Widget Stock (type STOCK)
- ;; Income (type INCOME)
- ;; Dividends (type INCOME)
- ;; Widget Stock (type INCOME)
- ;;
- ;; If you are producing a report on "Assets:Broker:Widget Stock" a
- ;; transaction that debits the Assets:Broker account and credits the
- ;; "Income:Dividends:Widget Stock" account will count as income in
- ;; the report even though it doesn't have a split in the account
- ;; being reported on.
-
- (let ((parent-account (gnc-account-get-parent current))
- (account-name (xaccAccountGetName current)))
- (if (and (not (null? parent-account))
- (member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
- (gnc-commodity-is-currency (xaccAccountGetCommodity parent-account)))
- (for-each
- (lambda (split)
- (let* ((other-split (xaccSplitGetOtherSplit split))
- ;; This is safe because xaccSplitGetAccount returns null for a null split
- (other-acct (xaccSplitGetAccount other-split))
- (parent (xaccSplitGetParent split))
- (txn-date (xaccTransGetDate parent)))
- (if (and (not (null? other-acct))
- (<= txn-date to-date)
- (string=? (xaccAccountGetName other-acct) account-name)
- (gnc-commodity-is-currency (xaccAccountGetCommodity other-acct)))
- ;; This is a two split transaction where the other split is to an
- ;; account with the same name as the current account. If it's an
- ;; income or expense account accumulate the value of the transaction
- (let ((val (xaccSplitGetValue split))
- (curr (xaccAccountGetCommodity other-acct)))
+ ))
+ (xaccTransGetSplitList parent)
+ )
+ )
+ )
+ )
+ )
+ (xaccAccountGetSplitList current)
+ )
+
+ ;; Look for income and expense transactions that don't have a split in the
+ ;; the account we're processing. We do this as follow
+ ;; 1. Make sure the parent account is a currency-valued asset or bank account
+ ;; 2. If so go through all the splits in that account
+ ;; 3. If a split is part of a two split transaction where the other split is
+ ;; to an income or expense account and the leaf name of that account is the
+ ;; same as the leaf name of the account we're processing, add it to the
+ ;; income or expense accumulator
+ ;;
+ ;; In other words with an account structure like
+ ;;
+ ;; Assets (type ASSET)
+ ;; Broker (type ASSET)
+ ;; Widget Stock (type STOCK)
+ ;; Income (type INCOME)
+ ;; Dividends (type INCOME)
+ ;; Widget Stock (type INCOME)
+ ;;
+ ;; If you are producing a report on "Assets:Broker:Widget Stock" a
+ ;; transaction that debits the Assets:Broker account and credits the
+ ;; "Income:Dividends:Widget Stock" account will count as income in
+ ;; the report even though it doesn't have a split in the account
+ ;; being reported on.
+
+ (let ((parent-account (gnc-account-get-parent current))
+ (account-name (xaccAccountGetName current)))
+ (if (and (not (null? parent-account))
+ (member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
+ (gnc-commodity-is-currency (xaccAccountGetCommodity parent-account)))
+ (for-each
+ (lambda (split)
+ (let* ((other-split (xaccSplitGetOtherSplit split))
+ ;; This is safe because xaccSplitGetAccount returns null for a null split
+ (other-acct (xaccSplitGetAccount other-split))
+ (parent (xaccSplitGetParent split))
+ (txn-date (xaccTransGetDate parent)))
+ (if (and (not (null? other-acct))
+ (<= txn-date to-date)
+ (string=? (xaccAccountGetName other-acct) account-name)
+ (gnc-commodity-is-currency (xaccAccountGetCommodity other-acct)))
+ ;; This is a two split transaction where the other split is to an
+ ;; account with the same name as the current account. If it's an
+ ;; income or expense account accumulate the value of the transaction
+ (let ((val (xaccSplitGetValue split))
+ (curr (xaccAccountGetCommodity other-acct)))
(cond ((split-account-type? other-split ACCT-TYPE-INCOME)
- (gnc:debug "More income " (gnc-numeric-to-string val))
- (dividendcoll 'add curr val))
+ (gnc:debug "More income " (gnc-numeric-to-string val))
+ (dividendcoll 'add curr val))
((split-account-type? other-split ACCT-TYPE-EXPENSE)
(gnc:debug "More expense " (gnc-numeric-to-string
(gnc-numeric-neg val)))
(brokeragecoll 'add curr (gnc-numeric-neg val)))
- )
- )
- )
- )
- )
- (xaccAccountGetSplitList parent-account)
- )
- )
- )
-
- (gnc:debug "pricing txn is " pricing-txn)
- (gnc:debug "use txn is " use-txn)
- (gnc:debug "prefer-pricelist is " prefer-pricelist)
- (gnc:debug "price is " price)
-
- (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
- currency-frac)))
- (gnc:debug "but the actual basis list is " basis-list)
+ )
+ )
+ )
+ )
+ )
+ (xaccAccountGetSplitList parent-account)
+ )
+ )
+ )
+
+ (gnc:debug "pricing txn is " pricing-txn)
+ (gnc:debug "use txn is " use-txn)
+ (gnc:debug "prefer-pricelist is " prefer-pricelist)
+ (gnc:debug "price is " price)
+
+ (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
+ currency-frac)))
+ (gnc:debug "but the actual basis list is " basis-list)
(if (eq? handle-brokerage-fees 'include-in-gain)
- (gaincoll 'minusmerge brokeragecoll #f))
+ (gaincoll 'minusmerge brokeragecoll #f))
- (if (or include-empty (not (gnc-numeric-zero-p units)))
- (let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my-exchange-fn))
- (moneyout (gnc:sum-collector-commodity moneyoutcoll currency my-exchange-fn))
+ (if (or include-empty (not (gnc-numeric-zero-p units)))
+ (let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my-exchange-fn))
+ (moneyout (gnc:sum-collector-commodity moneyoutcoll currency my-exchange-fn))
(brokerage (gnc:sum-collector-commodity brokeragecoll currency my-exchange-fn))
- (income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn))
- ;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well..
- (gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn))
- (ugain (gnc:make-gnc-monetary currency
- (gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency))
- (sum-basis basis-list (gnc-commodity-get-fraction currency))
- currency-frac GNC-RND-ROUND)))
- (bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain)
- (gnc:gnc-monetary-amount ugain)
- currency-frac GNC-RND-ROUND)))
- (totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount bothgain)
- (gnc:gnc-monetary-amount income)
- currency-frac GNC-RND-ROUND)))
-
- (activecols (list (gnc:html-account-anchor current)))
- )
+ (income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn))
+ ;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well..
+ (gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn))
+ (ugain (gnc:make-gnc-monetary currency
+ (gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency))
+ (sum-basis basis-list (gnc-commodity-get-fraction currency))
+ currency-frac GNC-RND-ROUND)))
+ (bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain)
+ (gnc:gnc-monetary-amount ugain)
+ currency-frac GNC-RND-ROUND)))
+ (totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount bothgain)
+ (gnc:gnc-monetary-amount income)
+ currency-frac GNC-RND-ROUND)))
+
+ (activecols (list (gnc:html-account-anchor current)))
+ )
;; If we're using the txn, warn the user
(if use-txn
@@ -864,80 +864,80 @@ by preventing negative stock balances.<br/>")
(set! warn-no-price #t)
))
- (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
- (total-moneyin 'merge moneyincoll #f)
- (total-moneyout 'merge moneyoutcoll #f)
+ (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
+ (total-moneyin 'merge moneyincoll #f)
+ (total-moneyout 'merge moneyoutcoll #f)
(total-brokerage 'merge brokeragecoll #f)
- (total-income 'merge dividendcoll #f)
- (total-gain 'merge gaincoll #f)
- (total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain))
- (total-basis 'add currency (sum-basis basis-list currency-frac))
-
- ;; build a list for the row based on user selections
- (if show-symbol (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol))))
- (if show-listing (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" listing))))
- (if show-shares (append! activecols (list (gnc:make-html-table-header-cell/markup
- "number-cell" (xaccPrintAmount units share-print-info)))))
- (if show-price (append! activecols (list (gnc:make-html-table-header-cell/markup
- "number-cell"
- (if use-txn
- (if pricing-txn
+ (total-income 'merge dividendcoll #f)
+ (total-gain 'merge gaincoll #f)
+ (total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain))
+ (total-basis 'add currency (sum-basis basis-list currency-frac))
+
+ ;; build a list for the row based on user selections
+ (if show-symbol (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol))))
+ (if show-listing (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" listing))))
+ (if show-shares (append! activecols (list (gnc:make-html-table-header-cell/markup
+ "number-cell" (xaccPrintAmount units share-print-info)))))
+ (if show-price (append! activecols (list (gnc:make-html-table-header-cell/markup
+ "number-cell"
+ (if use-txn
+ (if pricing-txn
(gnc:html-transaction-anchor pricing-txn price)
price)
- (gnc:html-price-anchor
- price (gnc:default-price-renderer
+ (gnc:html-price-anchor
+ price (gnc:default-price-renderer
(gnc-price-get-currency price)
(gnc-price-get-value price))))))))
- (append! activecols (list (if use-txn (if pricing-txn "*" "**") " ")
- (gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list
- currency-frac)))
- (gnc:make-html-table-header-cell/markup "number-cell" value)
- (gnc:make-html-table-header-cell/markup "number-cell" moneyin)
- (gnc:make-html-table-header-cell/markup "number-cell" moneyout)
- (gnc:make-html-table-header-cell/markup "number-cell" gain)
- (gnc:make-html-table-header-cell/markup "number-cell" ugain)
- (gnc:make-html-table-header-cell/markup "number-cell" bothgain)
- (gnc:make-html-table-header-cell/markup "number-cell"
- (let* ((moneyinvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount moneyin)))
- (bothgainvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount bothgain)))
+ (append! activecols (list (if use-txn (if pricing-txn "*" "**") " ")
+ (gnc:make-html-table-header-cell/markup
+ "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list
+ currency-frac)))
+ (gnc:make-html-table-header-cell/markup "number-cell" value)
+ (gnc:make-html-table-header-cell/markup "number-cell" moneyin)
+ (gnc:make-html-table-header-cell/markup "number-cell" moneyout)
+ (gnc:make-html-table-header-cell/markup "number-cell" gain)
+ (gnc:make-html-table-header-cell/markup "number-cell" ugain)
+ (gnc:make-html-table-header-cell/markup "number-cell" bothgain)
+ (gnc:make-html-table-header-cell/markup "number-cell"
+ (let* ((moneyinvalue (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount moneyin)))
+ (bothgainvalue (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount bothgain)))
)
- (if (= 0.0 moneyinvalue)
- ""
- (format #f "~,2f%" (* 100 (/ bothgainvalue moneyinvalue)))))
- )
- (gnc:make-html-table-header-cell/markup "number-cell" income)))
- (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
- (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage))))
- (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn)
- (gnc:make-html-table-header-cell/markup "number-cell"
- (let* ((moneyinvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount moneyin)))
- (totalreturnvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount totalreturn)))
+ (if (= 0.0 moneyinvalue)
+ ""
+ (format #f "~,2f%" (* 100 (/ bothgainvalue moneyinvalue)))))
+ )
+ (gnc:make-html-table-header-cell/markup "number-cell" income)))
+ (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
+ (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage))))
+ (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn)
+ (gnc:make-html-table-header-cell/markup "number-cell"
+ (let* ((moneyinvalue (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount moneyin)))
+ (totalreturnvalue (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount totalreturn)))
)
- (if (= 0.0 moneyinvalue)
- ""
- (format #f "~,2f%" (* 100 (/ totalreturnvalue moneyinvalue))))))
- )
- )
+ (if (= 0.0 moneyinvalue)
+ ""
+ (format #f "~,2f%" (* 100 (/ totalreturnvalue moneyinvalue))))))
+ )
+ )
- (gnc:html-table-append-row/markup!
- table
- row-style
- activecols)
+ (gnc:html-table-append-row/markup!
+ table
+ row-style
+ activecols)
(if (and (not use-txn) price) (gnc-price-unref price))
- (table-add-stock-rows-internal rest (not odd-row?))
- )
- (begin
- (if (and (not use-txn) price) (gnc-price-unref price))
- (table-add-stock-rows-internal rest odd-row?)
- )
+ (table-add-stock-rows-internal rest (not odd-row?))
+ )
+ (begin
+ (if (and (not use-txn) price) (gnc-price-unref price))
+ (table-add-stock-rows-internal rest odd-row?)
+ )
)
- )))
+ )))
(set! work-to-do (gnc:accounts-count-splits accounts))
(table-add-stock-rows-internal accounts #t)))
@@ -959,30 +959,30 @@ by preventing negative stock balances.<br/>")
gnc:optname-reportname))
(include-empty (get-option gnc:pagename-accounts
optname-zero-shares))
- (show-symbol (get-option gnc:pagename-display
- optname-show-symbol))
- (show-listing (get-option gnc:pagename-display
- optname-show-listing))
- (show-shares (get-option gnc:pagename-display
- optname-show-shares))
- (show-price (get-option gnc:pagename-display
- optname-show-price))
- (basis-method (get-option gnc:pagename-general
- optname-basis-method))
- (prefer-pricelist (get-option gnc:pagename-general
- optname-prefer-pricelist))
- (handle-brokerage-fees (get-option gnc:pagename-general
- optname-brokerage-fees))
-
- (total-basis (gnc:make-commodity-collector))
+ (show-symbol (get-option gnc:pagename-display
+ optname-show-symbol))
+ (show-listing (get-option gnc:pagename-display
+ optname-show-listing))
+ (show-shares (get-option gnc:pagename-display
+ optname-show-shares))
+ (show-price (get-option gnc:pagename-display
+ optname-show-price))
+ (basis-method (get-option gnc:pagename-general
+ optname-basis-method))
+ (prefer-pricelist (get-option gnc:pagename-general
+ optname-prefer-pricelist))
+ (handle-brokerage-fees (get-option gnc:pagename-general
+ optname-brokerage-fees))
+
+ (total-basis (gnc:make-commodity-collector))
(total-value (gnc:make-commodity-collector))
(total-moneyin (gnc:make-commodity-collector))
(total-moneyout (gnc:make-commodity-collector))
(total-income (gnc:make-commodity-collector))
(total-gain (gnc:make-commodity-collector)) ;; realized gain
- (total-ugain (gnc:make-commodity-collector)) ;; unrealized gain
+ (total-ugain (gnc:make-commodity-collector)) ;; unrealized gain
(total-brokerage (gnc:make-commodity-collector))
- ;;document will be the HTML document that we return.
+ ;;document will be the HTML document that we return.
(table (gnc:make-html-table))
(document (gnc:make-html-document)))
@@ -1004,61 +1004,61 @@ by preventing negative stock balances.<br/>")
((pricedb-before)
(lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-nearest-before-any-currency-t64
- pricedb foreign (time64CanonicalDayTime date))
+ pricedb foreign (time64CanonicalDayTime date))
domestic)))
((pricedb-nearest)
(lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-nearest-in-time-any-currency-t64
- pricedb foreign (time64CanonicalDayTime date)) domestic)))))
- (headercols (list (G_ "Account")))
- (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (G_ "Total"))))
- (sum-total-moneyin (gnc-numeric-zero))
- (sum-total-income (gnc-numeric-zero))
- (sum-total-both-gains (gnc-numeric-zero))
- (sum-total-gain (gnc-numeric-zero))
- (sum-total-ugain (gnc-numeric-zero))
- (sum-total-brokerage (gnc-numeric-zero))
- (sum-total-totalreturn (gnc-numeric-zero))) ;;end of let
-
- ;;begin building lists for which columns to display
+ pricedb foreign (time64CanonicalDayTime date)) domestic)))))
+ (headercols (list (G_ "Account")))
+ (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (G_ "Total"))))
+ (sum-total-moneyin (gnc-numeric-zero))
+ (sum-total-income (gnc-numeric-zero))
+ (sum-total-both-gains (gnc-numeric-zero))
+ (sum-total-gain (gnc-numeric-zero))
+ (sum-total-ugain (gnc-numeric-zero))
+ (sum-total-brokerage (gnc-numeric-zero))
+ (sum-total-totalreturn (gnc-numeric-zero))) ;;end of let
+
+ ;;begin building lists for which columns to display
(if show-symbol
- (begin (append! headercols (list (G_ "Symbol")))
- (append! totalscols (list " "))))
-
- (if show-listing
- (begin (append! headercols (list (G_ "Listing")))
- (append! totalscols (list " "))))
-
- (if show-shares
- (begin (append! headercols (list (G_ "Shares")))
- (append! totalscols (list " "))))
-
- (if show-price
- (begin (append! headercols (list (G_ "Price")))
- (append! totalscols (list " "))))
-
- (append! headercols (list " "
- (G_ "Basis")
- (G_ "Value")
- (G_ "Money In")
- (G_ "Money Out")
- (G_ "Realized Gain")
- (G_ "Unrealized Gain")
- (G_ "Total Gain")
- (G_ "Rate of Gain")
- (G_ "Income")))
-
- (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
- (append! headercols (list (G_ "Brokerage Fees"))))
-
- (append! headercols (list (G_ "Total Return")
- (G_ "Rate of Return")))
+ (begin (append! headercols (list (G_ "Symbol")))
+ (append! totalscols (list " "))))
+
+ (if show-listing
+ (begin (append! headercols (list (G_ "Listing")))
+ (append! totalscols (list " "))))
+
+ (if show-shares
+ (begin (append! headercols (list (G_ "Shares")))
+ (append! totalscols (list " "))))
+
+ (if show-price
+ (begin (append! headercols (list (G_ "Price")))
+ (append! totalscols (list " "))))
+
+ (append! headercols (list " "
+ (G_ "Basis")
+ (G_ "Value")
+ (G_ "Money In")
+ (G_ "Money Out")
+ (G_ "Realized Gain")
+ (G_ "Unrealized Gain")
+ (G_ "Total Gain")
+ (G_ "Rate of Gain")
+ (G_ "Income")))
+
+ (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
+ (append! headercols (list (G_ "Brokerage Fees"))))
+
+ (append! headercols (list (G_ "Total Return")
+ (G_ "Rate of Return")))
(append! totalscols (list " "))
(gnc:html-table-set-col-headers!
table
- headercols)
+ headercols)
(catch 'div/0
(lambda ()
@@ -1073,17 +1073,17 @@ by preventing negative stock balances.<br/>")
document (format #f OVERFLOW-ERROR reason))))
- (set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin currency exchange-fn))
- (set! sum-total-income (gnc:sum-collector-commodity total-income currency exchange-fn))
- (set! sum-total-gain (gnc:sum-collector-commodity total-gain currency exchange-fn))
- (set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency exchange-fn))
- (set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain)
- (gnc:gnc-monetary-amount sum-total-ugain)
- (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
- (set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage currency exchange-fn))
- (set! sum-total-totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-both-gains)
- (gnc:gnc-monetary-amount sum-total-income)
- (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
+ (set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin currency exchange-fn))
+ (set! sum-total-income (gnc:sum-collector-commodity total-income currency exchange-fn))
+ (set! sum-total-gain (gnc:sum-collector-commodity total-gain currency exchange-fn))
+ (set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency exchange-fn))
+ (set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain)
+ (gnc:gnc-monetary-amount sum-total-ugain)
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
+ (set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage currency exchange-fn))
+ (set! sum-total-totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-both-gains)
+ (gnc:gnc-monetary-amount sum-total-income)
+ (gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
(gnc:html-table-append-row/markup!
table
@@ -1092,52 +1092,52 @@ by preventing negative stock balances.<br/>")
(gnc:make-html-table-cell/size
1 17 (gnc:make-html-text (gnc:html-markup-hr)))))
- ;; finish building the totals columns, now that totals are complete
- (append! totalscols (list
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity total-basis currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity total-value currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" sum-total-moneyin)
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity total-moneyout currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" sum-total-gain)
- (gnc:make-html-table-cell/markup
- "total-number-cell" sum-total-ugain)
- (gnc:make-html-table-cell/markup
- "total-number-cell" sum-total-both-gains)
- (gnc:make-html-table-cell/markup
- "total-number-cell"
- (let* ((totalinvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount sum-total-moneyin)))
- (totalgainvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount sum-total-both-gains)))
- )
- (if (= 0.0 totalinvalue)
- ""
- (format #f "~,2f%" (* 100 (/ totalgainvalue totalinvalue))))))
- (gnc:make-html-table-cell/markup
- "total-number-cell" sum-total-income)))
- (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
- (append! totalscols (list
- (gnc:make-html-table-cell/markup
+ ;; finish building the totals columns, now that totals are complete
+ (append! totalscols (list
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:sum-collector-commodity total-basis currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:sum-collector-commodity total-value currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" sum-total-moneyin)
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:sum-collector-commodity total-moneyout currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" sum-total-gain)
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" sum-total-ugain)
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" sum-total-both-gains)
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
+ (let* ((totalinvalue (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount sum-total-moneyin)))
+ (totalgainvalue (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount sum-total-both-gains)))
+ )
+ (if (= 0.0 totalinvalue)
+ ""
+ (format #f "~,2f%" (* 100 (/ totalgainvalue totalinvalue))))))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" sum-total-income)))
+ (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
+ (append! totalscols (list
+ (gnc:make-html-table-cell/markup
"total-number-cell" sum-total-brokerage))))
- (append! totalscols (list
- (gnc:make-html-table-cell/markup
+ (append! totalscols (list
+ (gnc:make-html-table-cell/markup
"total-number-cell" sum-total-totalreturn)
- (gnc:make-html-table-cell/markup
- "total-number-cell"
- (let* ((totalinvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount sum-total-moneyin)))
- (totalreturnvalue (gnc-numeric-to-double
- (gnc:gnc-monetary-amount sum-total-totalreturn)))
- )
- (if (= 0.0 totalinvalue)
- ""
- (format #f "~,2f%" (* 100 (/ totalreturnvalue totalinvalue))))))
- ))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell"
+ (let* ((totalinvalue (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount sum-total-moneyin)))
+ (totalreturnvalue (gnc-numeric-to-double
+ (gnc:gnc-monetary-amount sum-total-totalreturn)))
+ )
+ (if (= 0.0 totalinvalue)
+ ""
+ (format #f "~,2f%" (* 100 (/ totalreturnvalue totalinvalue))))))
+ ))
(gnc:html-table-append-row/markup!
@@ -1150,8 +1150,8 @@ by preventing negative stock balances.<br/>")
(if warn-price-dirty
(gnc:html-document-append-objects! document
(list (gnc:make-html-text (G_ "* this commodity data was built using transaction pricing instead of the price list."))
- (gnc:make-html-text (gnc:html-markup-br))
- (gnc:make-html-text (G_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
+ (gnc:make-html-text (gnc:html-markup-br))
+ (gnc:make-html-text (G_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
(if warn-no-price
(gnc:html-document-append-objects! document
@@ -1159,11 +1159,11 @@ by preventing negative stock balances.<br/>")
(gnc:make-html-text (G_ "** this commodity has no price and a price of 1 has been used.")))))
)
- ;if no accounts selected.
+ ;if no accounts selected.
(gnc:html-document-add-object!
document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj))))
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj))))
(gnc:report-finished)
document)))
diff --git a/gnucash/report/reports/standard/balance-sheet.scm b/gnucash/report/reports/standard/balance-sheet.scm
index c528b870ab..9eb531da2a 100644
--- a/gnucash/report/reports/standard/balance-sheet.scm
+++ b/gnucash/report/reports/standard/balance-sheet.scm
@@ -168,7 +168,7 @@
ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE
ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE
ACCT-TYPE-TRADING)
- (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
(gnc:options-add-account-levels!
options gnc:pagename-accounts optname-depth-limit
"b" opthelp-depth-limit 3)
diff --git a/gnucash/report/reports/standard/budget-balance-sheet.scm b/gnucash/report/reports/standard/budget-balance-sheet.scm
index 3440e272b4..b215874267 100644
--- a/gnucash/report/reports/standard/budget-balance-sheet.scm
+++ b/gnucash/report/reports/standard/budget-balance-sheet.scm
@@ -9,16 +9,16 @@
;; David Montenegro <sunrise2000 at comcast.net>
;; Christian Stimming <stimming at tu-harburg.de>
;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -115,7 +115,7 @@
(gnc-register-string-option options
gnc:pagename-general optname-report-title
"a" opthelp-report-title (G_ reportname))
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-general optname-report-form
"c" opthelp-report-form #t)
@@ -123,7 +123,7 @@
(gnc-register-budget-option options
gnc:pagename-general optname-budget
"d" opthelp-budget (gnc-budget-get-default (gnc-get-current-book)))
-
+
;; accounts to work on
(gnc-register-account-list-option options
gnc:pagename-accounts optname-accounts
@@ -135,7 +135,7 @@
ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY
ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE
ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
- (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
(gnc:options-add-account-levels!
options gnc:pagename-accounts optname-depth-limit
@@ -143,23 +143,23 @@
(gnc-register-simple-boolean-option options
gnc:pagename-accounts optname-bottom-behavior
"c" opthelp-bottom-behavior #f)
-
+
;; all about currencies
(gnc:options-add-currency!
options pagename-commodities
- optname-report-commodity "a")
- (gnc:options-add-price-source!
+ optname-report-commodity "a")
+ (gnc:options-add-price-source!
options pagename-commodities
optname-price-source "b" 'pricedb-nearest)
(gnc-register-simple-boolean-option options
- pagename-commodities optname-show-foreign
+ pagename-commodities optname-show-foreign
"c" opthelp-show-foreign #t)
-
+
(gnc-register-simple-boolean-option options
pagename-commodities optname-show-rates
"d" opthelp-show-rates #f)
-
+
;; what to show for zero-balance accounts
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-show-zb-accts
@@ -180,21 +180,21 @@
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-use-rules
"e" opthelp-use-rules #f)
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-label-assets
"f" opthelp-label-assets #t)
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-total-assets
"g" opthelp-total-assets #t)
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-label-liabilities
"h" opthelp-label-liabilities #t)
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-total-liabilities
"i" opthelp-total-liabilities #t)
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-label-equity
"j" opthelp-label-equity #t)
@@ -205,10 +205,10 @@
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-new-existing
"l" opthelp-new-existing #t)
-
+
;; Set the accounts page as default option tab
(gnc:options-set-default-section options gnc:pagename-accounts)
-
+
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -249,22 +249,22 @@
(and initial budget (gnc:collector+ initial budget))))
(gnc:report-starting reportname)
-
+
;; get all option's values
(let* (
- (report-title (get-option gnc:pagename-general optname-report-title))
- (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
+ (report-title (get-option gnc:pagename-general optname-report-title))
+ (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
(budget (get-option gnc:pagename-general optname-budget))
(budget-valid? (and budget (not (null? budget))))
(date-t64 (if budget-valid? (gnc:budget-get-start-date budget) #f))
(report-form? (get-option gnc:pagename-general
optname-report-form))
(accounts (get-option gnc:pagename-accounts
- optname-accounts))
- (depth-limit (get-option gnc:pagename-accounts
- optname-depth-limit))
- (bottom-behavior (get-option gnc:pagename-accounts
- optname-bottom-behavior))
+ optname-accounts))
+ (depth-limit (get-option gnc:pagename-accounts
+ optname-depth-limit))
+ (bottom-behavior (get-option gnc:pagename-accounts
+ optname-bottom-behavior))
(report-commodity (get-option pagename-commodities
optname-report-commodity))
(price-source (get-option pagename-commodities
@@ -276,32 +276,32 @@
(parent-balance-mode (get-option gnc:pagename-display
optname-parent-balance-mode))
(parent-total-mode
- (assq-ref '((t . #t) (f . #f))
- (get-option gnc:pagename-display
- optname-parent-total-mode)))
+ (assq-ref '((t . #t) (f . #f))
+ (get-option gnc:pagename-display
+ optname-parent-total-mode)))
(show-zb-accts? (get-option gnc:pagename-display
- optname-show-zb-accts))
+ optname-show-zb-accts))
(omit-zb-bals? (get-option gnc:pagename-display
- optname-omit-zb-bals))
+ optname-omit-zb-bals))
(label-assets? (get-option gnc:pagename-display
- optname-label-assets))
+ optname-label-assets))
(total-assets? (get-option gnc:pagename-display
- optname-total-assets))
+ optname-total-assets))
(label-liabilities? (get-option gnc:pagename-display
- optname-label-liabilities))
+ optname-label-liabilities))
(total-liabilities? (get-option gnc:pagename-display
- optname-total-liabilities))
+ optname-total-liabilities))
(label-equity? (get-option gnc:pagename-display
- optname-label-equity))
+ optname-label-equity))
(total-equity? (get-option gnc:pagename-display
- optname-total-equity))
+ optname-total-equity))
(new-existing? (get-option gnc:pagename-display
optname-new-existing))
(use-links? (get-option gnc:pagename-display
- optname-account-links))
+ optname-account-links))
(use-rules? (get-option gnc:pagename-display
- optname-use-rules))
-
+ optname-use-rules))
+
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
(asset-accounts (assoc-ref split-up-accounts ACCT-TYPE-ASSET))
@@ -309,34 +309,34 @@
(income-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
(expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
(equity-accounts (assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
-
+
(doc (gnc:make-html-document))
- ;; this can occasionally put extra (blank) columns in our
- ;; table (when there is one account at the maximum depth and
- ;; it has at least one of its ancestors deselected), but this
- ;; is the only simple way to ensure that all three tables
- ;; (asset, liability, equity) have the same width.
+ ;; this can occasionally put extra (blank) columns in our
+ ;; table (when there is one account at the maximum depth and
+ ;; it has at least one of its ancestors deselected), but this
+ ;; is the only simple way to ensure that all three tables
+ ;; (asset, liability, equity) have the same width.
(tree-depth (if (equal? depth-limit 'all)
- (gnc:get-current-account-tree-depth)
- depth-limit))
+ (gnc:get-current-account-tree-depth)
+ depth-limit))
;; exchange rates calculation parameters
- (exchange-fn
- (gnc:case-exchange-fn price-source report-commodity date-t64))
+ (exchange-fn
+ (gnc:case-exchange-fn price-source report-commodity date-t64))
(price-fn (gnc:case-price-fn price-source report-commodity date-t64)))
-
+
(define (add-subtotal-line table pos-label neg-label signed-balance)
(let* ((neg? (and signed-balance neg-label
- (negative?
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- signed-balance report-commodity exchange-fn)))))
- (label (if neg? (or neg-label pos-label) pos-label))
- (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
- (gnc:html-table-add-labeled-amount-line!
+ (negative?
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ signed-balance report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
+ (gnc:html-table-add-labeled-amount-line!
table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
- (gnc:sum-collector-commodity balance report-commodity exchange-fn)
+ (gnc:sum-collector-commodity balance report-commodity exchange-fn)
(1- (* tree-depth 2)) 1 "total-number-cell")))
;; Wrapper around gnc:html-table-append-ruler! since we call it so
@@ -348,10 +348,10 @@
(cond
((null? accounts)
;; No accounts selected.
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-no-account-warning
- reportname (gnc:report-id report-obj))))
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-no-account-warning
+ reportname (gnc:report-id report-obj))))
((not budget-valid?)
;; No budget selected.
(gnc:html-document-add-object!
@@ -390,24 +390,24 @@
(retained-earnings #f)
(liability-plus-equity #f)
-
- (table-env #f) ;; parameters for :make-
- (params #f) ;; and -add-account-
+
+ (table-env #f) ;; parameters for :make-
+ (params #f) ;; and -add-account-
(asset-table #f) ;; gnc:html-acct-table
(liability-table #f) ;; gnc:html-acct-table
(equity-table #f) ;; gnc:html-acct-table
;; Create the account tables below where their
;; percentage time can be tracked.
- (left-table (gnc:make-html-table)) ;; gnc:html-table
- (right-table (if report-form? left-table
- (gnc:make-html-table)))
+ (left-table (gnc:make-html-table)) ;; gnc:html-table
+ (right-table (if report-form? left-table
+ (gnc:make-html-table)))
(budget-name (gnc-budget-get-name budget))
- )
-
+ )
+
- (gnc:report-percent-done 4)
+ (gnc:report-percent-done 4)
;; Get asset account balances (positive).
@@ -432,7 +432,7 @@
account)))
- (gnc:report-percent-done 6)
+ (gnc:report-percent-done 6)
;; Get liability account balances (negative).
@@ -457,7 +457,7 @@
account)))
- (gnc:report-percent-done 8)
+ (gnc:report-percent-done 8)
;; Get equity account balances (negative).
@@ -497,11 +497,11 @@
(set! new-liabilities
(gnc:commodity-collector-get-negated liability-repayments))
- ;; Total liabilities.
- (set! liability-balance
+ ;; Total liabilities.
+ (set! liability-balance
(gnc:collector+ existing-liabilities new-liabilities))
- (gnc:report-percent-done 12)
+ (gnc:report-percent-done 12)
;; Total existing retained earnings.
;; existing retained earnings = initial income - initial expenses
@@ -511,7 +511,7 @@
(gnc:budget-accountlist-get-initial-balance budget income-accounts)
(gnc:budget-accountlist-get-initial-balance budget expense-accounts))))
- (gnc:report-percent-done 14)
+ (gnc:report-percent-done 14)
;; Total new retained earnings.
(set! new-retained-earnings
@@ -523,7 +523,7 @@
(set! retained-earnings
(gnc:collector+ existing-retained-earnings new-retained-earnings))
- (gnc:report-percent-done 16)
+ (gnc:report-percent-done 16)
;; Total existing assets.
(set! existing-assets
@@ -544,10 +544,10 @@
liability-repayments))
;; Total assets.
- (set! asset-balance
+ (set! asset-balance
(gnc:collector+ existing-assets allocated-assets unallocated-assets))
- (gnc:report-percent-done 18)
+ (gnc:report-percent-done 18)
;; Calculate unrealized gains.
(let* ((get-total-value-fn
@@ -566,7 +566,7 @@
(gnc:collector- existing-assets asset-basis)
(gnc:collector- existing-liabilities liability-basis))))
- (gnc:report-percent-done 22)
+ (gnc:report-percent-done 22)
;; Total existing equity; negative.
(set! existing-equity
@@ -582,47 +582,47 @@
new-retained-earnings))
;; Total equity.
- (set! equity-balance
+ (set! equity-balance
(gnc:collector+ existing-equity new-equity))
;; Total liability + equity.
- (set! liability-plus-equity
+ (set! liability-plus-equity
(gnc:collector+ liability-balance equity-balance))
- (gnc:report-percent-done 30)
-
- (gnc:html-document-set-title!
+ (gnc:report-percent-done 30)
+
+ (gnc:html-document-set-title!
doc (string-append company-name " " report-title " " budget-name))
- (set! table-env
- (list
- (list 'start-date #f)
- (list 'end-date #f)
- (list 'display-tree-depth tree-depth)
- (list 'depth-limit-behavior (if bottom-behavior
- 'flatten
- 'summarize))
- (list 'report-commodity report-commodity)
- (list 'exchange-fn exchange-fn)
- (list 'parent-account-subtotal-mode parent-total-mode)
- (list 'zero-balance-mode (if show-zb-accts?
- 'show-leaf-acct
- 'omit-leaf-acct))
- (list 'account-label-mode (if use-links?
- 'anchor
- 'name))
- )
- )
- (set! params
- (list
- (list 'parent-account-balance-mode parent-balance-mode)
- (list 'zero-balance-display-mode (if omit-zb-bals?
- 'omit-balance
- 'show-balance))
- (list 'multicommodity-mode (if show-fcur? 'table #f))
- (list 'rule-mode use-rules?)
- )
- )
+ (set! table-env
+ (list
+ (list 'start-date #f)
+ (list 'end-date #f)
+ (list 'display-tree-depth tree-depth)
+ (list 'depth-limit-behavior (if bottom-behavior
+ 'flatten
+ 'summarize))
+ (list 'report-commodity report-commodity)
+ (list 'exchange-fn exchange-fn)
+ (list 'parent-account-subtotal-mode parent-total-mode)
+ (list 'zero-balance-mode (if show-zb-accts?
+ 'show-leaf-acct
+ 'omit-leaf-acct))
+ (list 'account-label-mode (if use-links?
+ 'anchor
+ 'name))
+ )
+ )
+ (set! params
+ (list
+ (list 'parent-account-balance-mode parent-balance-mode)
+ (list 'zero-balance-display-mode (if omit-zb-bals?
+ 'omit-balance
+ 'show-balance))
+ (list 'multicommodity-mode (if show-fcur? 'table #f))
+ (list 'rule-mode use-rules?)
+ )
+ )
(let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60))))
(gnc:html-table-append-row! left-table space)
@@ -630,13 +630,13 @@
(gnc:html-table-append-row! right-table space)))
(gnc:report-percent-done 80)
- (if label-assets? (add-subtotal-line left-table (G_ "Assets") #f #f))
- (set! asset-table
+ (if label-assets? (add-subtotal-line left-table (G_ "Assets") #f #f))
+ (set! asset-table
(gnc:make-html-acct-table/env/accts
(append table-env (list (list 'get-balance-fn asset-get-balance-fn)))
asset-accounts))
- (gnc:html-table-add-account-balances left-table asset-table params)
+ (gnc:html-table-add-account-balances left-table asset-table params)
(if total-assets?
(begin
(if new-existing?
@@ -652,23 +652,23 @@
(add-subtotal-line
left-table (G_ "Total Assets") #f asset-balance)))
-
- (if report-form?
- (add-rule left-table))
- (if report-form?
- (add-rule left-table))
-
- (gnc:report-percent-done 85)
- (if label-liabilities?
- (add-subtotal-line right-table (G_ "Liabilities") #f #f))
+
+ (if report-form?
+ (add-rule left-table))
+ (if report-form?
+ (add-rule left-table))
+
+ (gnc:report-percent-done 85)
+ (if label-liabilities?
+ (add-subtotal-line right-table (G_ "Liabilities") #f #f))
(set! liability-table
(gnc:make-html-acct-table/env/accts
(append table-env
(list (list 'get-balance-fn liability-get-balance-fn)))
liability-accounts))
- (gnc:html-table-add-account-balances
- right-table liability-table params)
- (if total-liabilities?
+ (gnc:html-table-add-account-balances
+ right-table liability-table params)
+ (if total-liabilities?
(begin
(if new-existing?
(begin
@@ -681,22 +681,22 @@
(add-subtotal-line
right-table (G_ "New Liabilities") #f new-liabilities)))
- (add-subtotal-line
+ (add-subtotal-line
right-table (G_ "Total Liabilities") #f liability-balance)))
-
- (add-rule right-table)
-
- (gnc:report-percent-done 88)
- (if label-equity?
- (add-subtotal-line
- right-table (G_ "Equity") #f #f))
- (set! equity-table
- (gnc:make-html-acct-table/env/accts
+
+ (add-rule right-table)
+
+ (gnc:report-percent-done 88)
+ (if label-equity?
+ (add-subtotal-line
+ right-table (G_ "Equity") #f #f))
+ (set! equity-table
+ (gnc:make-html-acct-table/env/accts
(append table-env
(list (list 'get-balance-fn equity-get-balance-fn)))
equity-accounts))
- (gnc:html-table-add-account-balances
- right-table equity-table params)
+ (gnc:html-table-add-account-balances
+ right-table equity-table params)
;; we omit retianed earnings from the balance report, if zero, since
;; they are not present on normal balance sheets
@@ -729,7 +729,7 @@
unrealized-gain))
- (if total-equity?
+ (if total-equity?
(begin
(if new-existing?
(begin
@@ -739,52 +739,52 @@
(add-subtotal-line
right-table (G_ "New Equity") #f new-equity)))
- (add-subtotal-line
+ (add-subtotal-line
right-table (G_ "Total Equity") #f equity-balance)))
-
- (add-rule right-table)
-
+
+ (add-rule right-table)
+
(add-subtotal-line
right-table
(gnc:html-string-sanitize (G_ "Total Liabilities & Equity"))
#f
liability-plus-equity)
-
- (gnc:html-document-add-object!
- doc
- (if report-form?
- left-table
- (let* ((build-table (gnc:make-html-table))
- )
- (gnc:html-table-append-row!
- build-table
- (list
- (gnc:make-html-table-cell left-table)
- (gnc:make-html-table-cell right-table)
- )
- )
- (gnc:html-table-set-style!
- build-table "td"
- 'attribute '("align" "left")
- 'attribute '("valign" "top"))
- build-table
- )
- )
- )
-
+
+ (gnc:html-document-add-object!
+ doc
+ (if report-form?
+ left-table
+ (let* ((build-table (gnc:make-html-table))
+ )
+ (gnc:html-table-append-row!
+ build-table
+ (list
+ (gnc:make-html-table-cell left-table)
+ (gnc:make-html-table-cell right-table)
+ )
+ )
+ (gnc:html-table-set-style!
+ build-table "td"
+ 'attribute '("align" "left")
+ 'attribute '("valign" "top"))
+ build-table
+ )
+ )
+ )
+
;; add currency information if requested
- (gnc:report-percent-done 90)
+ (gnc:report-percent-done 90)
(if show-rates?
- (gnc:html-document-add-object!
+ (gnc:html-document-add-object!
doc ;;(gnc:html-markup-p)
(gnc:html-make-rates-table report-commodity price-fn accounts)))
- (gnc:report-percent-done 100)))))
-
+ (gnc:report-percent-done 100)))))
+
(gnc:report-finished)
-
+
doc))
-(gnc:define-report
+(gnc:define-report
'version 1
'name reportname
'report-guid "ecc35ea9dbfa4e20ba389fc85d59cb69"
diff --git a/gnucash/report/reports/standard/budget-income-statement.scm b/gnucash/report/reports/standard/budget-income-statement.scm
index 87fb10e1d6..4f7ec01f30 100644
--- a/gnucash/report/reports/standard/budget-income-statement.scm
+++ b/gnucash/report/reports/standard/budget-income-statement.scm
@@ -1,32 +1,32 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-income-statement.scm: income statement (a.k.a. Profit & Loss)
-;;
+;;
;; Copyright (c) the following:
;;
;; Forest Bond <forest at alittletooquiet.net>
;; David Montenegro <sunrise2000 at comcast.net>
;;
;; * BUGS:
-;;
+;;
;; Line & column alignments may still not conform with
;; textbook accounting practice (they're close though!).
-;;
+;;
;; Progress bar functionality is currently mostly broken.
-;;
+;;
;; The variables in this code could use more consistent naming.
-;;
+;;
;; See also all the "FIXME"s in the code.
-;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -164,7 +164,7 @@
;; defined globally somewhere so we could reference it here. However, it
;; only appears to be defined currently in src/gnome/glade/budget.glade.
1 1 60 1)
-
+
(gnc-register-number-range-option options
gnc:pagename-general optname-budget-period-end
"f" opthelp-budget-period-end
@@ -172,16 +172,16 @@
;; defined globally somewhere so we could reference it here. However, it
;; only appears to be defined currently in src/gnome/glade/budget.glade.
1 1 60 1)
-
+
;; accounts to work on
(gnc-register-account-list-option options
gnc:pagename-accounts optname-accounts
"a"
opthelp-accounts
(gnc:filter-accountlist-type
- ;; select, by default, only income and expense accounts
- (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
- (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
+ ;; select, by default, only income and expense accounts
+ (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
(gnc:options-add-account-levels!
options gnc:pagename-accounts optname-depth-limit
@@ -189,24 +189,24 @@
(gnc-register-simple-boolean-option options
gnc:pagename-accounts optname-bottom-behavior
"c" opthelp-bottom-behavior #f)
-
+
;; all about currencies
(gnc:options-add-currency!
options pagename-commodities
optname-report-commodity "a")
-
- (gnc:options-add-price-source!
+
+ (gnc:options-add-price-source!
options pagename-commodities
optname-price-source "b" 'pricedb-nearest)
-
+
(gnc-register-simple-boolean-option options
- pagename-commodities optname-show-foreign
+ pagename-commodities optname-show-foreign
"c" opthelp-show-foreign #t)
-
+
(gnc-register-simple-boolean-option options
pagename-commodities optname-show-rates
"d" opthelp-show-rates #f)
-
+
;; what to show for zero-balance accounts
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-show-zb-accts
@@ -227,14 +227,14 @@
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-use-rules
"e" opthelp-use-rules #f)
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-label-revenue
"f" opthelp-label-revenue #t)
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-total-revenue
"g" opthelp-total-revenue #t)
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-label-expense
"h" opthelp-label-expense #t)
@@ -249,10 +249,10 @@
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-standard-order
"k" opthelp-standard-order #t)
-
+
;; Set the accounts page as default option tab
(gnc:options-set-default-section options gnc:pagename-accounts)
-
+
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -264,7 +264,7 @@
(define (get-option pagename optname)
(gnc-optiondb-lookup-value
(gnc:report-options report-obj) pagename optname))
-
+
(define (get-assoc-account-balances-budget
budget accountlist period-start period-end get-balance-fn)
(gnc:get-assoc-account-balances
@@ -276,11 +276,11 @@
(if (gnc-reverse-balance account) (gnc:collector- bal) bal)))
(gnc:report-starting reportname)
-
+
;; get all option's values
(let* (
- (report-title (get-option gnc:pagename-general optname-report-title))
- (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
+ (report-title (get-option gnc:pagename-general optname-report-title))
+ (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
(budget (get-option gnc:pagename-general optname-budget))
(budget-valid? (and budget (not (null? budget))))
(use-budget-period-range?
@@ -308,11 +308,11 @@
(if use-budget-period-range? period-start 0))
#f))
(accounts (get-option gnc:pagename-accounts
- optname-accounts))
- (depth-limit (get-option gnc:pagename-accounts
- optname-depth-limit))
- (bottom-behavior (get-option gnc:pagename-accounts
- optname-bottom-behavior))
+ optname-accounts))
+ (depth-limit (get-option gnc:pagename-accounts
+ optname-depth-limit))
+ (bottom-behavior (get-option gnc:pagename-accounts
+ optname-bottom-behavior))
(report-commodity (get-option pagename-commodities
optname-report-commodity))
(price-source (get-option pagename-commodities
@@ -324,62 +324,62 @@
(parent-balance-mode (get-option gnc:pagename-display
optname-parent-balance-mode))
(parent-total-mode
- (assq-ref '((t . #t) (f . #f))
- (get-option gnc:pagename-display
- optname-parent-total-mode)))
+ (assq-ref '((t . #t) (f . #f))
+ (get-option gnc:pagename-display
+ optname-parent-total-mode)))
(show-zb-accts? (get-option gnc:pagename-display
- optname-show-zb-accts))
+ optname-show-zb-accts))
(omit-zb-bals? (get-option gnc:pagename-display
- optname-omit-zb-bals))
+ optname-omit-zb-bals))
(label-revenue? (get-option gnc:pagename-display
- optname-label-revenue))
+ optname-label-revenue))
(total-revenue? (get-option gnc:pagename-display
- optname-total-revenue))
+ optname-total-revenue))
(label-expense? (get-option gnc:pagename-display
- optname-label-expense))
+ optname-label-expense))
(total-expense? (get-option gnc:pagename-display
- optname-total-expense))
+ optname-total-expense))
(use-links? (get-option gnc:pagename-display
- optname-account-links))
+ optname-account-links))
(use-rules? (get-option gnc:pagename-display
- optname-use-rules))
- (two-column? (get-option gnc:pagename-display
- optname-two-column))
- (standard-order? (get-option gnc:pagename-display
- optname-standard-order))
-
+ optname-use-rules))
+ (two-column? (get-option gnc:pagename-display
+ optname-two-column))
+ (standard-order? (get-option gnc:pagename-display
+ optname-standard-order))
+
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
- (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
- (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
-
+ (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
+ (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
+
(doc (gnc:make-html-document))
- ;; this can occasionally put extra (blank) columns in our
- ;; table (when there is one account at the maximum depth and
- ;; it has at least one of its ancestors deselected), but this
- ;; is the only simple way to ensure that both tables
- ;; (revenue, expense) have the same width.
+ ;; this can occasionally put extra (blank) columns in our
+ ;; table (when there is one account at the maximum depth and
+ ;; it has at least one of its ancestors deselected), but this
+ ;; is the only simple way to ensure that both tables
+ ;; (revenue, expense) have the same width.
(tree-depth (if (equal? depth-limit 'all)
- (gnc:get-current-account-tree-depth)
- depth-limit))
+ (gnc:get-current-account-tree-depth)
+ depth-limit))
;; exchange rates calculation parameters
- (exchange-fn
- (gnc:case-exchange-fn price-source report-commodity date-t64))
+ (exchange-fn
+ (gnc:case-exchange-fn price-source report-commodity date-t64))
(price-fn (gnc:case-price-fn price-source report-commodity date-t64)))
-
+
(define (add-subtotal-line table pos-label neg-label signed-balance)
(let* ((neg? (and signed-balance neg-label
- (negative?
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- signed-balance report-commodity exchange-fn)))))
- (label (if neg? (or neg-label pos-label) pos-label))
- (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
- (gnc:html-table-add-labeled-amount-line!
- table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
- (gnc:sum-collector-commodity balance report-commodity exchange-fn)
- (1- (* tree-depth 2)) 1 "total-number-cell")))
+ (negative?
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ signed-balance report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
+ (gnc:html-table-add-labeled-amount-line!
+ table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
+ (gnc:sum-collector-commodity balance report-commodity exchange-fn)
+ (1- (* tree-depth 2)) 1 "total-number-cell")))
(cond
((null? accounts)
@@ -569,9 +569,9 @@
(gnc:html-document-add-object!
doc (gnc:html-make-rates-table report-commodity price-fn accounts)))
(gnc:report-percent-done 100))))
-
+
(gnc:report-finished)
-
+
doc))
(define is-reportname (N_ "Budget Income Statement"))
@@ -588,7 +588,7 @@
(budget-income-statement-renderer-internal report-obj is-reportname))
-(gnc:define-report
+(gnc:define-report
'version 1
'name is-reportname
'report-guid "583c313fcc484efc974c4c844404f454"
@@ -599,7 +599,7 @@
;; Also make a "Profit & Loss" report, even if it's the exact same one,
;; just relabeled.
-(gnc:define-report
+(gnc:define-report
'version 1
'name pnl-reportname
'report-guid "e5fa5ce805e840ecbeca4dba3fa4ead9"
diff --git a/gnucash/report/reports/standard/equity-statement.scm b/gnucash/report/reports/standard/equity-statement.scm
index e30c652282..2d5354db92 100644
--- a/gnucash/report/reports/standard/equity-statement.scm
+++ b/gnucash/report/reports/standard/equity-statement.scm
@@ -1,41 +1,41 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; equity-statement.scm: statement of owner's equity (net worth)
-;;
+;;
;; By David Montenegro 2004.06.23 <sunrise2000 at comcast.net>
-;;
+;;
;; * Based on balance-sheet.scm by Robert Merkel <rgmerk at mira.net>
-;;
+;;
;; * BUGS:
-;;
+;;
;; The multicurrency support has NOT been tested and IS ALPHA. I
;; really don't if I used the correct exchange functions. Search
;; code for regexp "*exchange-fn".
-;;
+;;
;; I have also made the educated assumption <grin> that a decrease
;; in the value of a liability or equity also represents an
;; unrealized loss. I *think* that is right, but am not sure.
-;;
+;;
;; This code makes the assumption that you want your equity
;; statement to no more than daily resolution.
-;;
+;;
;; The Accounts option panel needs a way to select (and select by
;; default) capital and draw accounts. There really should be a
;; contra account type or attribute....
-;;
+;;
;; The variables in this code could use more consistent naming.
-;;
+;;
;; See also any "FIXME"s in the code.
;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -96,22 +96,22 @@
;; options generator
(define (equity-statement-options-generator)
(let* ((options (gnc-new-optiondb)))
-
+
(gnc-register-string-option options
(N_ "General") optname-report-title
"a" opthelp-report-title (G_ reportname))
-
+
;; date at which to report balance
(gnc:options-add-date-interval!
- options gnc:pagename-general
+ options gnc:pagename-general
optname-start-date optname-end-date "c")
-
+
;; accounts to work on
(gnc-register-account-list-option options
gnc:pagename-accounts optname-accounts
"a"
opthelp-accounts
- (gnc:filter-accountlist-type
+ (gnc:filter-accountlist-type
(list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CREDIT
ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY
ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY
@@ -119,31 +119,31 @@
ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE
ACCT-TYPE-TRADING)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
-
+
;; all about currencies
(gnc:options-add-currency!
options pagename-commodities
optname-report-commodity "a")
-
- (gnc:options-add-price-source!
+
+ (gnc:options-add-price-source!
options pagename-commodities
optname-price-source "b" 'pricedb-nearest)
-
+
(gnc-register-simple-boolean-option options
- pagename-commodities optname-show-foreign
+ pagename-commodities optname-show-foreign
"c" opthelp-show-foreign #t)
-
+
(gnc-register-simple-boolean-option options
pagename-commodities optname-show-rates
"d" opthelp-show-rates #f)
-
+
;; some detailed formatting options
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-use-rules
"f" opthelp-use-rules #f)
-
+
;; closing entry match criteria
- ;;
+ ;;
;; N.B.: transactions really should have a field where we can put
;; transaction types like "Adjusting/Closing/Correcting Entries"
(gnc-register-string-option options
@@ -155,10 +155,10 @@
(gnc-register-simple-boolean-option options
pagename-entries optname-closing-regexp
"c" opthelp-closing-regexp #f)
-
+
;; Set the accounts page as default option tab
(gnc:options-set-default-section options gnc:pagename-accounts)
-
+
options))
(define (account-get-total-flow direction target-account-list from-date to-date)
@@ -190,30 +190,30 @@
(define (get-option pagename optname)
(gnc-optiondb-lookup-value
(gnc:report-options report-obj) pagename optname))
-
+
(gnc:report-starting reportname)
-
+
;; get all option's values
(let* (
- (report-title (get-option gnc:pagename-general optname-report-title))
- (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
- ;; this code makes the assumption that you want your equity
- ;; statement to no more than daily resolution
+ (report-title (get-option gnc:pagename-general optname-report-title))
+ (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
+ ;; this code makes the assumption that you want your equity
+ ;; statement to no more than daily resolution
(start-date-printable (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-start-date)))
+ (get-option gnc:pagename-general
+ optname-start-date)))
(start-date (gnc:time64-end-day-time
- (gnc:time64-previous-day start-date-printable)))
- (end-date (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-end-date))))
+ (gnc:time64-previous-day start-date-printable)))
+ (end-date (gnc:time64-end-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-end-date))))
;;(end-date-printable (gnc:date-option-absolute-time
;; (get-option gnc:pagename-general
;; optname-end-date)))
- ;; why dont we use this? why use any -printable at all?
+ ;; why dont we use this? why use any -printable at all?
(accounts (get-option gnc:pagename-accounts
- optname-accounts))
+ optname-accounts))
(report-commodity (get-option pagename-commodities
optname-report-commodity))
(price-source (get-option pagename-commodities
@@ -221,14 +221,14 @@
(show-rates? (get-option pagename-commodities
optname-show-rates))
(use-rules? (get-option gnc:pagename-display
- optname-use-rules))
- (closing-str (get-option pagename-entries
- optname-closing-pattern))
- (closing-cased (get-option pagename-entries
- optname-closing-casing))
- (closing-regexp (get-option pagename-entries
- optname-closing-regexp))
-
+ optname-use-rules))
+ (closing-str (get-option pagename-entries
+ optname-closing-pattern))
+ (closing-cased (get-option pagename-entries
+ optname-closing-casing))
+ (closing-regexp (get-option pagename-entries
+ optname-closing-regexp))
+
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
(asset-accounts
@@ -242,28 +242,28 @@
(equity-accounts
(assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
- (closing-pattern
- (list (list 'str closing-str)
- (list 'cased closing-cased)
- (list 'regexp closing-regexp)
- (list 'positive #f)
- (list 'closing #t)))
+ (closing-pattern
+ (list (list 'str closing-str)
+ (list 'cased closing-cased)
+ (list 'regexp closing-regexp)
+ (list 'positive #f)
+ (list 'closing #t)))
(doc (gnc:make-html-document))
;; exchange rates calculation parameters
- (start-exchange-fn
- (gnc:case-exchange-fn
- price-source report-commodity start-date))
- (end-exchange-fn
- (gnc:case-exchange-fn
- price-source report-commodity end-date))
+ (start-exchange-fn
+ (gnc:case-exchange-fn
+ price-source report-commodity start-date))
+ (end-exchange-fn
+ (gnc:case-exchange-fn
+ price-source report-commodity end-date))
(start-price-fn (gnc:case-price-fn price-source report-commodity start-date))
(end-price-fn (gnc:case-price-fn price-source report-commodity end-date)))
(define (unrealized-gains-at-date book-balance exchange-fn date)
(define cost-fn
- (gnc:case-exchange-fn 'average-cost report-commodity date))
+ (gnc:case-exchange-fn 'average-cost report-commodity date))
(gnc:monetaries-add
(gnc:sum-collector-commodity book-balance report-commodity exchange-fn)
(gnc:monetary-neg
@@ -275,23 +275,23 @@
(define (get-end-balance-fn account)
(gnc:account-get-comm-balance-at-date account end-date #f))
- (gnc:html-document-set-title!
+ (gnc:html-document-set-title!
doc (gnc:format (G_ "${company-name} ${report-title} For Period Covering ${start} to ${end}")
'company-name company-name
'report-title report-title
'start (qof-print-date start-date-printable)
'end (qof-print-date end-date)))
-
+
(if (null? accounts)
-
+
;; error condition: no accounts specified is this *really*
- ;; necessary?? i'd be fine with an all-zero income statement
- ;; that would, technically, be correct....
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-no-account-warning
- reportname (gnc:report-id report-obj)))
-
+ ;; necessary?? i'd be fine with an all-zero income statement
+ ;; that would, technically, be correct....
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-no-account-warning
+ reportname (gnc:report-id report-obj)))
+
;; Get all the balances for each account group.
(let* ((start-asset-balance
(gnc:accounts-get-comm-total-assets
@@ -311,11 +311,11 @@
(neg-pre-start-retained-earnings
(gnc:accountlist-get-comm-balance-at-date-with-closing
- income-expense-accounts start-date))
+ income-expense-accounts start-date))
(neg-pre-end-retained-earnings
(gnc:accountlist-get-comm-balance-at-date-with-closing
- income-expense-accounts end-date))
+ income-expense-accounts end-date))
(income-expense-closing
(gnc:account-get-trans-type-balance-interval-with-closing
@@ -324,7 +324,7 @@
(net-income
(gnc:collector-
income-expense-closing
- (gnc:accountlist-get-comm-balance-interval-with-closing
+ (gnc:accountlist-get-comm-balance-interval-with-closing
income-expense-accounts start-date end-date)))
(neg-start-equity-balance
@@ -337,9 +337,9 @@
(start-book-balance
(gnc:collector+ start-asset-balance
- neg-start-liability-balance
- neg-start-equity-balance
- neg-pre-start-retained-earnings))
+ neg-start-liability-balance
+ neg-start-equity-balance
+ neg-pre-start-retained-earnings))
(end-book-balance
(gnc:collector+ end-asset-balance
@@ -347,18 +347,18 @@
neg-end-equity-balance
neg-pre-end-retained-earnings))
- (start-unrealized-gains
+ (start-unrealized-gains
(unrealized-gains-at-date start-book-balance
- start-exchange-fn
- start-date))
+ start-exchange-fn
+ start-date))
- (net-unrealized-gains
+ (net-unrealized-gains
(gnc:collector- (unrealized-gains-at-date end-book-balance
end-exchange-fn
end-date)
start-unrealized-gains))
- (equity-closing
+ (equity-closing
(gnc:account-get-trans-type-balance-interval-with-closing
equity-accounts closing-pattern start-date end-date))
@@ -366,16 +366,16 @@
(gnc:collector- neg-end-equity-balance
equity-closing))
- (net-investment
+ (net-investment
(gnc:collector- neg-start-equity-balance
neg-pre-closing-equity))
;; calculate investments & draws...
- ;; do a transaction query and classify the splits by dr/cr.
- ;; assume that positive shares on an equity account are debits
- ;; withdrawals = investments - (investments - withdrawals)
- ;; investments = withdrawals + (investments - withdrawals)
- (withdrawals
+ ;; do a transaction query and classify the splits by dr/cr.
+ ;; assume that positive shares on an equity account are debits
+ ;; withdrawals = investments - (investments - withdrawals)
+ ;; investments = withdrawals + (investments - withdrawals)
+ (withdrawals
(account-get-total-flow 'in equity-accounts start-date end-date))
(investments
@@ -387,37 +387,37 @@
net-unrealized-gains
(gnc:collector- withdrawals)))
- (start-total-equity
+ (start-total-equity
(gnc:collector- start-unrealized-gains
neg-start-equity-balance
neg-pre-start-retained-earnings))
- (end-total-equity
+ (end-total-equity
(gnc:collector+ start-total-equity
capital-increase))
- ;; Create the account table below where its
- ;; percentage time can be tracked.
- (build-table (gnc:make-html-table)) ;; gnc:html-table
- (period-for (string-append " " (G_ "for Period"))))
+ ;; Create the account table below where its
+ ;; percentage time can be tracked.
+ (build-table (gnc:make-html-table)) ;; gnc:html-table
+ (period-for (string-append " " (G_ "for Period"))))
- ;; a helper to add a line to our report
- (define (add-report-line
+ ;; a helper to add a line to our report
+ (define (add-report-line
table pos-label neg-label amount col
- exchange-fn rule? row-style)
- (let* ((neg? (and amount neg-label
- (negative?
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- amount report-commodity exchange-fn)))))
- (label (if neg? (or neg-label pos-label) pos-label))
- (pos-bal (if neg? (gnc:collector- amount) amount)))
- (gnc:html-table-add-labeled-amount-line!
+ exchange-fn rule? row-style)
+ (let* ((neg? (and amount neg-label
+ (negative?
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ amount report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (pos-bal (if neg? (gnc:collector- amount) amount)))
+ (gnc:html-table-add-labeled-amount-line!
table 3 row-style rule? label 0 1 "text-cell"
- (gnc:sum-collector-commodity pos-bal report-commodity exchange-fn)
+ (gnc:sum-collector-commodity pos-bal report-commodity exchange-fn)
(1+ col) 1 "number-cell")))
- (gnc:report-percent-done 30)
+ (gnc:report-percent-done 30)
(gnc:html-table-append-row!
build-table (make-list 2 (gnc:make-html-table-cell/min-width 60)))
@@ -467,38 +467,38 @@
1 end-exchange-fn #f "primary-subheading")
(gnc:html-document-add-object! doc build-table)
-
+
;; add currency information if requested
- (gnc:report-percent-done 90)
+ (gnc:report-percent-done 90)
(when show-rates?
- (let* ((curr-tbl (gnc:make-html-table))
- (headers (list
- (qof-print-date start-date-printable)
- (qof-print-date end-date)))
- (then (gnc:html-make-rates-table
- report-commodity start-price-fn accounts))
- (now (gnc:html-make-rates-table
+ (let* ((curr-tbl (gnc:make-html-table))
+ (headers (list
+ (qof-print-date start-date-printable)
+ (qof-print-date end-date)))
+ (then (gnc:html-make-rates-table
+ report-commodity start-price-fn accounts))
+ (now (gnc:html-make-rates-table
report-commodity end-price-fn accounts)))
- (gnc:html-table-set-col-headers! curr-tbl headers)
- (gnc:html-table-set-style!
- curr-tbl "table" 'attribute '("border" "1"))
- (gnc:html-table-set-style!
- then "table" 'attribute '("border" "0"))
- (gnc:html-table-set-style!
- now "table" 'attribute '("border" "0"))
- (gnc:html-table-append-ruler! build-table 3)
- (gnc:html-table-append-row! curr-tbl (list then now))
- (gnc:html-document-add-object! doc curr-tbl)))
-
- (gnc:report-percent-done 100)))
-
+ (gnc:html-table-set-col-headers! curr-tbl headers)
+ (gnc:html-table-set-style!
+ curr-tbl "table" 'attribute '("border" "1"))
+ (gnc:html-table-set-style!
+ then "table" 'attribute '("border" "0"))
+ (gnc:html-table-set-style!
+ now "table" 'attribute '("border" "0"))
+ (gnc:html-table-append-ruler! build-table 3)
+ (gnc:html-table-append-row! curr-tbl (list then now))
+ (gnc:html-document-add-object! doc curr-tbl)))
+
+ (gnc:report-percent-done 100)))
+
(gnc:report-finished)
-
+
doc
)
)
-(gnc:define-report
+(gnc:define-report
'version 1
'name reportname
'report-guid "c2a996c8970f43448654ca84f17dda24"
diff --git a/gnucash/report/reports/standard/income-statement.scm b/gnucash/report/reports/standard/income-statement.scm
index e93abe4c23..08db21b96d 100644
--- a/gnucash/report/reports/standard/income-statement.scm
+++ b/gnucash/report/reports/standard/income-statement.scm
@@ -1,33 +1,33 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; income-statement.scm: income statement (a.k.a. Profit & Loss)
-;;
+;;
;; By David Montenegro <sunrise2000 at comcast.net>
;; 2004.07.13 - 2004.07.14
;;
;; * BUGS:
-;;
+;;
;; This code makes the assumption that you want your income
;; statement to no more than daily resolution.
-;;
+;;
;; Line & column alignments may still not conform with
;; textbook accounting practice (they're close though!).
-;;
+;;
;; Progress bar functionality is currently mostly broken.
-;;
+;;
;; The variables in this code could use more consistent naming.
-;;
+;;
;; See also all the "FIXME"s in the code.
-;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -135,21 +135,21 @@
(gnc-register-string-option options
gnc:pagename-general optname-report-title
"a" opthelp-report-title (G_ reportname))
-
+
;; period over which to report income
(gnc:options-add-date-interval!
- options gnc:pagename-general
+ options gnc:pagename-general
optname-start-date optname-end-date "c")
-
+
;; accounts to work on
(gnc-register-account-list-option options
gnc:pagename-accounts optname-accounts
"a"
opthelp-accounts
- (gnc:filter-accountlist-type
- ;; select, by default, only income and expense accounts
- (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
- (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
+ (gnc:filter-accountlist-type
+ ;; select, by default, only income and expense accounts
+ (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
(gnc:options-add-account-levels!
options gnc:pagename-accounts optname-depth-limit
@@ -157,20 +157,20 @@
(gnc-register-simple-boolean-option options
gnc:pagename-accounts optname-bottom-behavior
"c" opthelp-bottom-behavior #f)
-
+
;; all about currencies
(gnc:options-add-currency!
options pagename-commodities
optname-report-commodity "a")
-
- (gnc:options-add-price-source!
+
+ (gnc:options-add-price-source!
options pagename-commodities
optname-price-source "b" 'pricedb-nearest)
(gnc-register-simple-boolean-option options
- pagename-commodities optname-show-foreign
+ pagename-commodities optname-show-foreign
"c" opthelp-show-foreign #t)
-
+
(gnc-register-simple-boolean-option options
pagename-commodities optname-show-rates
"d" opthelp-show-rates #f)
@@ -195,21 +195,21 @@
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-use-rules
"f" opthelp-use-rules #f)
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-label-revenue
"g" opthelp-label-revenue #t)
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-total-revenue
"h" opthelp-total-revenue #t)
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-label-trading
"h1" opthelp-label-trading #t)
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-total-trading
"h2" opthelp-total-trading #t)
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-label-expense
"i" opthelp-label-expense #t)
@@ -224,9 +224,9 @@
(gnc-register-simple-boolean-option options
gnc:pagename-display optname-standard-order
"l" opthelp-standard-order #t)
-
+
;; closing entry match criteria
- ;;
+ ;;
;; N.B.: transactions really should have a field where we can put
;; transaction types like "Adjusting/Closing/Correcting Entries"
(gnc-register-string-option options
@@ -238,10 +238,10 @@
(gnc-register-simple-boolean-option options
pagename-entries optname-closing-regexp
"c" opthelp-closing-regexp #f)
-
+
;; Set the accounts page as default option tab
(gnc:options-set-default-section options gnc:pagename-accounts)
-
+
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -255,28 +255,28 @@
(gnc:report-options report-obj) pagename optname))
(gnc:report-starting reportname)
-
+
;; get all option's values
(let* (
- (report-title (get-option gnc:pagename-general optname-report-title))
- (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
+ (report-title (get-option gnc:pagename-general optname-report-title))
+ (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) ""))
(start-date-printable (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-start-date)))
+ (get-option gnc:pagename-general
+ optname-start-date)))
(start-date (gnc:time64-start-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-start-date))))
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-start-date))))
(end-date (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-end-date))))
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-end-date))))
(accounts (get-option gnc:pagename-accounts
- optname-accounts))
- (depth-limit (get-option gnc:pagename-accounts
- optname-depth-limit))
- (bottom-behavior (get-option gnc:pagename-accounts
- optname-bottom-behavior))
+ optname-accounts))
+ (depth-limit (get-option gnc:pagename-accounts
+ optname-depth-limit))
+ (bottom-behavior (get-option gnc:pagename-accounts
+ optname-bottom-behavior))
(report-commodity (get-option pagename-commodities
optname-report-commodity))
(price-source (get-option pagename-commodities
@@ -288,63 +288,63 @@
(parent-balance-mode (get-option gnc:pagename-display
optname-parent-balance-mode))
(parent-total-mode
- (assq-ref '((t . #t) (f . #f))
- (get-option gnc:pagename-display
- optname-parent-total-mode)))
+ (assq-ref '((t . #t) (f . #f))
+ (get-option gnc:pagename-display
+ optname-parent-total-mode)))
(show-zb-accts? (get-option gnc:pagename-display
- optname-show-zb-accts))
+ optname-show-zb-accts))
(omit-zb-bals? (get-option gnc:pagename-display
- optname-omit-zb-bals))
+ optname-omit-zb-bals))
(label-revenue? (get-option gnc:pagename-display
- optname-label-revenue))
+ optname-label-revenue))
(total-revenue? (get-option gnc:pagename-display
- optname-total-revenue))
+ optname-total-revenue))
(label-trading? (get-option gnc:pagename-display
- optname-label-trading))
+ optname-label-trading))
(total-trading? (get-option gnc:pagename-display
- optname-total-trading))
+ optname-total-trading))
(label-expense? (get-option gnc:pagename-display
- optname-label-expense))
+ optname-label-expense))
(total-expense? (get-option gnc:pagename-display
- optname-total-expense))
+ optname-total-expense))
(use-links? (get-option gnc:pagename-display
- optname-account-links))
+ optname-account-links))
(use-rules? (get-option gnc:pagename-display
- optname-use-rules))
- (closing-str (get-option pagename-entries
- optname-closing-pattern))
- (closing-cased (get-option pagename-entries
- optname-closing-casing))
- (closing-regexp (get-option pagename-entries
- optname-closing-regexp))
- (two-column? (get-option gnc:pagename-display
- optname-two-column))
- (standard-order? (get-option gnc:pagename-display
- optname-standard-order))
- (closing-pattern
- (list (list 'str closing-str)
- (list 'cased closing-cased)
- (list 'regexp closing-regexp)
- (list 'closing #t)))
+ optname-use-rules))
+ (closing-str (get-option pagename-entries
+ optname-closing-pattern))
+ (closing-cased (get-option pagename-entries
+ optname-closing-casing))
+ (closing-regexp (get-option pagename-entries
+ optname-closing-regexp))
+ (two-column? (get-option gnc:pagename-display
+ optname-two-column))
+ (standard-order? (get-option gnc:pagename-display
+ optname-standard-order))
+ (closing-pattern
+ (list (list 'str closing-str)
+ (list 'cased closing-cased)
+ (list 'regexp closing-regexp)
+ (list 'closing #t)))
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
- (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
- (trading-accounts (assoc-ref split-up-accounts ACCT-TYPE-TRADING))
- (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
-
+ (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
+ (trading-accounts (assoc-ref split-up-accounts ACCT-TYPE-TRADING))
+ (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
+
(doc (gnc:make-html-document))
- ;; this can occasionally put extra (blank) columns in our
- ;; table (when there is one account at the maximum depth and
- ;; it has at least one of its ancestors deselected), but this
- ;; is the only simple way to ensure that both tables
- ;; (revenue, expense) have the same width.
+ ;; this can occasionally put extra (blank) columns in our
+ ;; table (when there is one account at the maximum depth and
+ ;; it has at least one of its ancestors deselected), but this
+ ;; is the only simple way to ensure that both tables
+ ;; (revenue, expense) have the same width.
(tree-depth (if (equal? depth-limit 'all)
- (gnc:get-current-account-tree-depth)
- depth-limit))
+ (gnc:get-current-account-tree-depth)
+ depth-limit))
;; exchange rates calculation parameters
- (exchange-fn
- (gnc:case-exchange-fn price-source report-commodity end-date))
+ (exchange-fn
+ (gnc:case-exchange-fn price-source report-commodity end-date))
(price-fn (gnc:case-price-fn price-source report-commodity end-date)))
;; Wrapper to call gnc:html-table-add-labeled-amount-line!
@@ -563,7 +563,7 @@
(income-statement-renderer-internal report-obj pnl-reportname))
-(gnc:define-report
+(gnc:define-report
'version 1
'name is-reportname
'report-guid "0b81a3bdfd504aff849ec2e8630524bc"
@@ -573,7 +573,7 @@
;; Also make a "Profit & Loss" report, even if it's the exact same one,
;; just relabeled.
-(gnc:define-report
+(gnc:define-report
'version 1
'name pnl-reportname
'report-guid "8758ba23984c40dea5527f5f0ca2779e"
diff --git a/gnucash/report/reports/standard/portfolio.scm b/gnucash/report/reports/standard/portfolio.scm
index 09ac1287a8..19432a30f0 100644
--- a/gnucash/report/reports/standard/portfolio.scm
+++ b/gnucash/report/reports/standard/portfolio.scm
@@ -95,9 +95,9 @@
exchange-fn price-fn include-empty collector)
(let ((share-print-info
- (gnc-share-print-info-places
- (inexact->exact (get-option gnc:pagename-general
- optname-shares-digits)))))
+ (gnc-share-print-info-places
+ (inexact->exact (get-option gnc:pagename-general
+ optname-shares-digits)))))
(define (table-add-stock-rows-internal accounts odd-row?)
(if (null? accounts) collector
@@ -123,30 +123,30 @@
(value (exchange-fn (gnc:make-gnc-monetary commodity units)
currency)))
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
- (if (or include-empty (not (gnc-numeric-zero-p units)))
- (begin (collector 'add currency (gnc:gnc-monetary-amount value))
- (gnc:html-table-append-row/markup!
- table
- row-style
- (list (gnc:html-account-anchor current)
- (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol)
- (gnc:make-html-table-header-cell/markup "text-cell" listing)
- (gnc:make-html-table-header-cell/markup
- "number-cell"
- (xaccPrintAmount units share-print-info))
- (gnc:make-html-table-header-cell/markup
- "number-cell"
+ (set! work-done (+ 1 work-done))
+ (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
+ (if (or include-empty (not (gnc-numeric-zero-p units)))
+ (begin (collector 'add currency (gnc:gnc-monetary-amount value))
+ (gnc:html-table-append-row/markup!
+ table
+ row-style
+ (list (gnc:html-account-anchor current)
+ (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol)
+ (gnc:make-html-table-header-cell/markup "text-cell" listing)
+ (gnc:make-html-table-header-cell/markup
+ "number-cell"
+ (xaccPrintAmount units share-print-info))
+ (gnc:make-html-table-header-cell/markup
+ "number-cell"
(gnc:html-price-anchor price price-monetary))
- (gnc:make-html-table-header-cell/markup
- "number-cell" value)))
- ;;(display (format #f "Shares: ~6d " (gnc-numeric-to-double units)))
- ;;(display units) (newline)
- (if price (gnc-price-unref price))
- (table-add-stock-rows-internal rest (not odd-row?)))
- (begin (if price (gnc-price-unref price))
- (table-add-stock-rows-internal rest odd-row?))))))
+ (gnc:make-html-table-header-cell/markup
+ "number-cell" value)))
+ ;;(display (format #f "Shares: ~6d " (gnc-numeric-to-double units)))
+ ;;(display units) (newline)
+ (if price (gnc-price-unref price))
+ (table-add-stock-rows-internal rest (not odd-row?)))
+ (begin (if price (gnc-price-unref price))
+ (table-add-stock-rows-internal rest odd-row?))))))
(set! work-to-do (length accounts))
(table-add-stock-rows-internal accounts #t)))
@@ -185,7 +185,7 @@
(gnc-accounts-and-all-descendants accounts)
currency))
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
- (exchange-fn (gnc:case-exchange-fn price-source currency to-date))
+ (exchange-fn (gnc:case-exchange-fn price-source currency to-date))
(price-fn
(case price-source
((weighted-average average-cost)
@@ -277,8 +277,8 @@
;if no accounts selected.
(gnc:html-document-add-object!
document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj))))
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj))))
(gnc:report-finished)
document)))
diff --git a/gnucash/report/reports/standard/price-scatter.scm b/gnucash/report/reports/standard/price-scatter.scm
index 1aef71ea26..4c14c69e6b 100644
--- a/gnucash/report/reports/standard/price-scatter.scm
+++ b/gnucash/report/reports/standard/price-scatter.scm
@@ -154,7 +154,7 @@
(currency-accounts
(filter gnc:account-has-shares? (gnc-account-get-descendants-sorted
(gnc-get-current-root-account))))
- (invert (get-option pagename-price optname-invert))
+ (invert (get-option pagename-price optname-invert))
(amount-commodity (if invert price-commodity report-currency))
(base-commodity (if invert report-currency price-commodity))
(int-label (car (assq-ref intervals interval)))
diff --git a/gnucash/report/reports/standard/taxinvoice.scm b/gnucash/report/reports/standard/taxinvoice.scm
index b74ab513df..0991f9bbc0 100644
--- a/gnucash/report/reports/standard/taxinvoice.scm
+++ b/gnucash/report/reports/standard/taxinvoice.scm
@@ -1,4 +1,3 @@
-
;; $Author: chris $ $Date: 2009/07/29 09:31:44 $ $Revision: 1.33 $
;; Modified by Dmitry Smirnov <onlyjob at member.fsf.org> 16 Feb 2012
;;
@@ -69,48 +68,48 @@
(define headingpage2 (N_ "Headings 2"))
(define notespage (N_ "Notes"))
(define displaypage (N_ "Display"))
-(define elementspage (N_ "Elements"))
-; option names
-(define optname-col-date (N_ "column: Date"))
-(define optname-col-taxrate (N_ "column: Tax Rate"))
-(define optname-col-units (N_ "column: Units"))
-(define optname-row-address (N_ "row: Address"))
-(define optname-row-contact (N_ "row: Contact"))
-(define optname-row-invoice-number (N_ "row: Invoice Number"))
-(define optname-row-company-name (N_ "row: Company Name"))
-(define optname-invoice-number-text (N_ "Invoice number text"))
-(define optname-to-text (N_ "To text"))
-(define optname-ref-text (N_ "Ref text"))
-(define optname-jobname-text (N_ "Job Name text"))
-(define optname-jobnumber-text (N_ "Job Number text"))
-(define optname-jobname-show (N_ "Show Job name"))
-(define optname-jobnumber-show (N_ "Show Job number"))
-(define optname-netprice (N_ "Show net price"))
-(define optname-invnum-next-to-title (N_ "Invoice number next to title"))
-(define optname-border-collapse (N_ "table-border-collapse"))
-(define optname-border-color-th (N_ "table-header-border-color"))
-(define optname-border-color-td (N_ "table-cell-border-color"))
-(define optname-extra-css (N_ "Embedded CSS"))
-(define optname-report-title (N_ "Report Title"))
-(define optname-template-file (N_ "Template file"))
-(define optname-css-file (N_ "CSS stylesheet file"))
-(define optname-heading-font (N_ "Heading font"))
-(define optname-text-font (N_ "Text font"))
-(define optname-logofile (N_ "Logo filename"))
-(define optname-logo-width (N_ "Logo width"))
-(define optname-units (N_ "Units"))
-(define optname-qty (N_ "Qty"))
-(define optname-unit-price (N_ "Unit Price"))
-(define optname-disc-rate (N_ "Discount Rate"))
-(define optname-disc-amount (N_ "Discount Amount"))
-(define optname-net-price (N_ "Net Price"))
-(define optname-tax-rate (N_ "Tax Rate"))
-(define optname-tax-amount (N_ "Tax Amount"))
-(define optname-total-price (N_ "Total Price"))
-(define optname-subtotal (N_ "Sub-total"))
-(define optname-amount-due (N_ "Amount Due"))
-(define optname-payment-recd (N_ "Payment received text"))
-(define optname-extra-notes (N_ "Extra Notes"))
+(define elementspage (N_ "Elements"))
+; option names
+(define optname-col-date (N_ "column: Date"))
+(define optname-col-taxrate (N_ "column: Tax Rate"))
+(define optname-col-units (N_ "column: Units"))
+(define optname-row-address (N_ "row: Address"))
+(define optname-row-contact (N_ "row: Contact"))
+(define optname-row-invoice-number (N_ "row: Invoice Number"))
+(define optname-row-company-name (N_ "row: Company Name"))
+(define optname-invoice-number-text (N_ "Invoice number text"))
+(define optname-to-text (N_ "To text"))
+(define optname-ref-text (N_ "Ref text"))
+(define optname-jobname-text (N_ "Job Name text"))
+(define optname-jobnumber-text (N_ "Job Number text"))
+(define optname-jobname-show (N_ "Show Job name"))
+(define optname-jobnumber-show (N_ "Show Job number"))
+(define optname-netprice (N_ "Show net price"))
+(define optname-invnum-next-to-title (N_ "Invoice number next to title"))
+(define optname-border-collapse (N_ "table-border-collapse"))
+(define optname-border-color-th (N_ "table-header-border-color"))
+(define optname-border-color-td (N_ "table-cell-border-color"))
+(define optname-extra-css (N_ "Embedded CSS"))
+(define optname-report-title (N_ "Report Title"))
+(define optname-template-file (N_ "Template file"))
+(define optname-css-file (N_ "CSS stylesheet file"))
+(define optname-heading-font (N_ "Heading font"))
+(define optname-text-font (N_ "Text font"))
+(define optname-logofile (N_ "Logo filename"))
+(define optname-logo-width (N_ "Logo width"))
+(define optname-units (N_ "Units"))
+(define optname-qty (N_ "Qty"))
+(define optname-unit-price (N_ "Unit Price"))
+(define optname-disc-rate (N_ "Discount Rate"))
+(define optname-disc-amount (N_ "Discount Amount"))
+(define optname-net-price (N_ "Net Price"))
+(define optname-tax-rate (N_ "Tax Rate"))
+(define optname-tax-amount (N_ "Tax Amount"))
+(define optname-total-price (N_ "Total Price"))
+(define optname-subtotal (N_ "Sub-total"))
+(define optname-amount-due (N_ "Amount Due"))
+(define optname-payment-recd (N_ "Payment received text"))
+(define optname-extra-notes (N_ "Extra Notes"))
(define (options-generator)
;; Options
@@ -122,55 +121,55 @@
;; Elements page options
(gnc-register-simple-boolean-option options
- elementspage optname-col-date "a" (N_ "Display the date?") #t)
+ elementspage optname-col-date "a" (N_ "Display the date?") #t)
(gnc-register-simple-boolean-option options
- elementspage optname-col-taxrate "b" (N_ "Display the Tax Rate?") #t)
+ elementspage optname-col-taxrate "b" (N_ "Display the Tax Rate?") #t)
(gnc-register-simple-boolean-option options
- elementspage optname-col-units "c" (N_ "Display the Units?") #t)
+ elementspage optname-col-units "c" (N_ "Display the Units?") #t)
(gnc-register-simple-boolean-option options
- elementspage optname-row-contact "d" (N_ "Display the contact?") #t)
+ elementspage optname-row-contact "d" (N_ "Display the contact?") #t)
(gnc-register-simple-boolean-option options
- elementspage optname-row-address "e" (N_ "Display the address?") #t)
+ elementspage optname-row-address "e" (N_ "Display the address?") #t)
(gnc-register-simple-boolean-option options
- elementspage optname-row-invoice-number "f" (N_ "Display the Invoice Number?") #t)
+ elementspage optname-row-invoice-number "f" (N_ "Display the Invoice Number?") #t)
(gnc-register-simple-boolean-option options
- elementspage optname-row-company-name "g" (N_ "Display the Company Name?") #t)
+ elementspage optname-row-company-name "g" (N_ "Display the Company Name?") #t)
(gnc-register-simple-boolean-option options
- elementspage optname-invnum-next-to-title "h" (N_ "Invoice Number next to title?") #f)
+ elementspage optname-invnum-next-to-title "h" (N_ "Invoice Number next to title?") #f)
(gnc-register-simple-boolean-option options
- elementspage optname-jobname-show "i" (N_ "Display Job name?") #t)
+ elementspage optname-jobname-show "i" (N_ "Display Job name?") #t)
(gnc-register-simple-boolean-option options
- elementspage optname-jobnumber-show "j" (N_ "Invoice Job number?") #f)
+ elementspage optname-jobnumber-show "j" (N_ "Invoice Job number?") #f)
(gnc-register-simple-boolean-option options
- elementspage optname-netprice "k" (N_ "Show net price?") #f)
+ elementspage optname-netprice "k" (N_ "Show net price?") #f)
;; Display options
(gnc-register-string-option options
- displaypage optname-template-file "a"
+ displaypage optname-template-file "a"
(N_ "The file name of the eguile template part of this report. This file should either be in your .gnucash directory, or else in its proper place within the GnuCash installation directories.")
"taxinvoice.eguile.scm")
(gnc-register-string-option options
- displaypage optname-css-file "b"
- (N_ "The file name of the CSS stylesheet to use with this report. This file should either be in your .gnucash directory, or else in its proper place within the GnuCash installation directories.")
+ displaypage optname-css-file "b"
+ (N_ "The file name of the CSS stylesheet to use with this report. This file should either be in your .gnucash directory, or else in its proper place within the GnuCash installation directories.")
"taxinvoice.css")
(gnc-register-font-option options
- displaypage optname-heading-font "c"
+ displaypage optname-heading-font "c"
(N_ "Font to use for the main heading.") "Sans Bold 18")
(gnc-register-font-option options
- displaypage optname-text-font "d"
+ displaypage optname-text-font "d"
(N_ "Font to use for everything else.") "Sans 10")
(gnc-register-pixmap-option options
- displaypage optname-logofile "e"
- (N_ "Name of a file containing a logo to be used on the report.")
+ displaypage optname-logofile "e"
+ (N_ "Name of a file containing a logo to be used on the report.")
"")
(gnc-register-string-option options
displaypage optname-logo-width "f" (N_ "Width of the logo in CSS format, e.g. 10% or 32px. Leave blank to display the logo at its natural width. The height of the logo will be scaled accordingly.") "")
(gnc-register-simple-boolean-option options
- displaypage optname-border-collapse "g" (N_ "Border-collapse?") #f)
+ displaypage optname-border-collapse "g" (N_ "Border-collapse?") #f)
(gnc-register-string-option options
- displaypage optname-border-color-th "h" (N_ "CSS color.") "black")
+ displaypage optname-border-color-th "h" (N_ "CSS color.") "black")
(gnc-register-string-option options
- displaypage optname-border-color-td "i" (N_ "CSS color.") "black")
+ displaypage optname-border-color-td "i" (N_ "CSS color.") "black")
;; Heading options
(gnc-register-string-option options
@@ -199,32 +198,32 @@
(gnc-register-string-option options
headingpage2 optname-amount-due "b" "" (G_ "Amount Due"))
(gnc-register-string-option options
- headingpage2 optname-payment-recd "c" ""
+ headingpage2 optname-payment-recd "c" ""
(G_ "Payment received, thank you!"))
(gnc-register-string-option options
- headingpage2 optname-invoice-number-text
+ headingpage2 optname-invoice-number-text
"d" "" (G_ "Invoice number:"))
(gnc-register-string-option options
- headingpage2 optname-to-text
+ headingpage2 optname-to-text
"e" "" (G_ "To:"))
(gnc-register-string-option options
- headingpage2 optname-ref-text
+ headingpage2 optname-ref-text
"f" "" (G_ "Your ref:"))
(gnc-register-string-option options
- headingpage2 optname-jobnumber-text
+ headingpage2 optname-jobnumber-text
"g" "" (G_ "Job number:"))
(gnc-register-string-option options
- headingpage2 optname-jobname-text
+ headingpage2 optname-jobname-text
"h" "" (G_ "Job name:"))
(gnc-register-text-option options
notespage optname-extra-notes "a"
- (G_ "Notes added at end of invoice -- may contain HTML markup.")
+ (G_ "Notes added at end of invoice -- may contain HTML markup.")
(G_ "Thank you for your patronage!"))
(gnc-register-text-option options
notespage optname-extra-css "b"
- (N_ "Embedded CSS.") "h1.coyname { text-align: left; }")
+ (N_ "Embedded CSS.") "h1.coyname { text-align: left; }")
(gnc:options-set-default-section options gnc:pagename-general)
options))
@@ -233,7 +232,7 @@
;;; Create the report
(define (report-renderer report-obj)
- ;; Create and return the report as either an HTML string
+ ;; Create and return the report as either an HTML string
;; or an <html-document>
(define (opt-value section name)
(gnc-optiondb-lookup-value (gnc:report-options report-obj) section name))
@@ -249,8 +248,8 @@
(opt-value displaypage optname-heading-font)))
(opt-text-font (font-name-to-style-info-eguile
(opt-value displaypage optname-text-font)))
- (opt-logofile (opt-value displaypage optname-logofile))
- (opt-logo-width (opt-value displaypage optname-logo-width))
+ (opt-logofile (opt-value displaypage optname-logofile))
+ (opt-logo-width (opt-value displaypage optname-logo-width))
(opt-col-date (opt-value elementspage optname-col-date))
(opt-col-taxrate (opt-value elementspage optname-col-taxrate))
(opt-col-units (opt-value elementspage optname-col-units))
@@ -284,8 +283,8 @@
(opt-ref-text (opt-value headingpage2 optname-ref-text))
(opt-jobnumber-text (opt-value headingpage2 optname-jobnumber-text))
(opt-jobname-text (opt-value headingpage2 optname-jobname-text))
- (opt-extra-css (opt-value notespage optname-extra-css))
- (opt-extra-notes (opt-value notespage optname-extra-notes))
+ (opt-extra-css (opt-value notespage optname-extra-css))
+ (opt-extra-notes (opt-value notespage optname-extra-notes))
(html (eguile-file-to-string
opt-template-file
(the-environment))))
diff --git a/gnucash/report/reports/standard/test/test-cash-flow.scm b/gnucash/report/reports/standard/test/test-cash-flow.scm
index bae6e5528c..7588af6bbb 100644
--- a/gnucash/report/reports/standard/test/test-cash-flow.scm
+++ b/gnucash/report/reports/standard/test/test-cash-flow.scm
@@ -13,10 +13,10 @@
(define structure
(list "Root" (list (cons 'type ACCT-TYPE-ASSET))
- (list "Asset"
- (list "Bank")
- (list "Wallet"))
- (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))))
+ (list "Asset"
+ (list "Bank")
+ (list "Wallet"))
+ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))))
(define (NDayDelta t64 n)
(let* ((day-secs (* 60 60 24 n)) ; n days in seconds is n times 60 sec/min * 60 min/h * 24 h/day
@@ -29,118 +29,118 @@
(define (test-one-tx-in-cash-flow)
(let* ((env (create-test-env))
- (account-alist (env-create-account-structure-alist env structure))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist)))
- (today (gnc-localtime (current-time)))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (today (gnc-localtime (current-time)))
(to-date-t64 (gnc-dmy2time64-end (tm:mday today) (+ 1 (tm:mon today)) (+ 1900 (tm:year today))))
(from-date-t64 (NDayDelta to-date-t64 1))
- (report-currency (gnc-default-report-currency))
- )
+ (report-currency (gnc-default-report-currency))
+ )
(env-create-transaction env to-date-t64 bank-account expense-account 100/1)
(let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list bank-account))
- (cons 'to-date-t64 to-date-t64)
- (cons 'from-date-t64 from-date-t64)
- (cons 'report-currency report-currency)
- (cons 'include-trading-accounts #f)
- (cons 'to-report-currency to-report-currency)))))
+ (cons 'to-date-t64 to-date-t64)
+ (cons 'from-date-t64 from-date-t64)
+ (cons 'report-currency report-currency)
+ (cons 'include-trading-accounts #f)
+ (cons 'to-report-currency to-report-currency)))))
(let* ((money-in-collector (cdr (assq 'money-in-collector result)))
- (money-out-collector (cdr (assq 'money-out-collector result)))
- (money-in-alist (cdr (assq 'money-in-alist result)))
- (money-out-alist (cdr (assq 'money-out-alist result)))
- (expense-acc-in-collector (cadr (assoc expense-account money-in-alist))))
- (and (or (null? money-out-alist)
+ (money-out-collector (cdr (assq 'money-out-collector result)))
+ (money-in-alist (cdr (assq 'money-in-alist result)))
+ (money-out-alist (cdr (assq 'money-out-alist result)))
+ (expense-acc-in-collector (cadr (assoc expense-account money-in-alist))))
+ (and (or (null? money-out-alist)
(begin (format #t "The money-out-alist is not null.~%") #f))
- (or (equal? 10000/100
- (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector
- report-currency exchange-fn)))
+ (or (equal? 10000/100
+ (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector
+ report-currency exchange-fn)))
(begin (format #t "Failed expense-acc-in-collector ~a expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector
- report-currency exchange-fn))) #f))
- (or (equal? 10000/100
- (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
- report-currency exchange-fn)))
+ report-currency exchange-fn))) #f))
+ (or (equal? 10000/100
+ (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
+ report-currency exchange-fn)))
(begin (format #t "Failed money-in-collector ~a expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
- report-currency exchange-fn))) #f))
- (or (equal? 0/1
- (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
- report-currency exchange-fn)))
+ report-currency exchange-fn))) #f))
+ (or (equal? 0/1
+ (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
+ report-currency exchange-fn)))
(begin (format #t "Failed sum-collector-commodity ~a expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
report-currency exchange-fn))) #f))
(begin (format #t "test-one-tx-in-cash-flow success~%") #t)
- )))))
+ )))))
(define (test-one-tx-skip-cash-flow)
(let* ((env (create-test-env))
- (account-alist (env-create-account-structure-alist env structure))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist)))
- (today (gnc-localtime (current-time)))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (today (gnc-localtime (current-time)))
(to-date-t64 (gnc-dmy2time64-end (tm:mday today) (+ 1 (tm:mon today)) (+ 1900 (tm:year today))))
(from-date-t64 (NDayDelta to-date-t64 1))
- (report-currency (gnc-default-report-currency))
- )
+ (report-currency (gnc-default-report-currency))
+ )
(env-create-transaction env to-date-t64 bank-account wallet-account 100/1)
(let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list wallet-account bank-account))
- (cons 'to-date-t64 to-date-t64)
- (cons 'from-date-t64 from-date-t64)
- (cons 'report-currency report-currency)
- (cons 'include-trading-accounts #f)
- (cons 'to-report-currency to-report-currency)))))
+ (cons 'to-date-t64 to-date-t64)
+ (cons 'from-date-t64 from-date-t64)
+ (cons 'report-currency report-currency)
+ (cons 'include-trading-accounts #f)
+ (cons 'to-report-currency to-report-currency)))))
(let* ((money-in-collector (cdr (assq 'money-in-collector result)))
- (money-out-collector (cdr (assq 'money-out-collector result)))
- (money-in-alist (cdr (assq 'money-in-alist result)))
- (money-out-alist (cdr (assq 'money-out-alist result))))
- (and (null? money-in-alist)
- (null? money-out-alist)
- (equal? 0/1
- (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
- report-currency exchange-fn)))
- (equal? 0/1
- (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
- report-currency exchange-fn)))
+ (money-out-collector (cdr (assq 'money-out-collector result)))
+ (money-in-alist (cdr (assq 'money-in-alist result)))
+ (money-out-alist (cdr (assq 'money-out-alist result))))
+ (and (null? money-in-alist)
+ (null? money-out-alist)
+ (equal? 0/1
+ (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
+ report-currency exchange-fn)))
+ (equal? 0/1
+ (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
+ report-currency exchange-fn)))
(begin (format #t "test-one-tx-skip-cash-flow success~%") #t)
)))))
(define (test-both-way-cash-flow)
(let* ((env (create-test-env))
- (account-alist (env-create-account-structure-alist env structure))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist)))
- (today (gnc-localtime (current-time)))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank-account (cdr (assoc "Bank" account-alist)))
+ (wallet-account (cdr (assoc "Wallet" account-alist)))
+ (expense-account (cdr (assoc "Expenses" account-alist)))
+ (today (gnc-localtime (current-time)))
(to-date-t64 (gnc-dmy2time64-end (tm:mday today) (+ 1 (tm:mon today)) (+ 1900 (tm:year today))))
(from-date-t64 (NDayDelta to-date-t64 1))
- (report-currency (gnc-default-report-currency))
- )
+ (report-currency (gnc-default-report-currency))
+ )
(env-create-transaction env to-date-t64 bank-account expense-account 100/1)
(env-create-transaction env to-date-t64 expense-account bank-account 50/1)
(let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list wallet-account bank-account))
- (cons 'to-date-t64 to-date-t64)
- (cons 'from-date-t64 from-date-t64)
- (cons 'report-currency report-currency)
- (cons 'include-trading-accounts #f)
- (cons 'to-report-currency to-report-currency)))))
+ (cons 'to-date-t64 to-date-t64)
+ (cons 'from-date-t64 from-date-t64)
+ (cons 'report-currency report-currency)
+ (cons 'include-trading-accounts #f)
+ (cons 'to-report-currency to-report-currency)))))
(let* ((money-in-collector (cdr (assq 'money-in-collector result)))
- (money-out-collector (cdr (assq 'money-out-collector result)))
- (money-in-alist (cdr (assq 'money-in-alist result)))
- (money-out-alist (cdr (assq 'money-out-alist result)))
- (expense-acc-in-collector (cadr (assoc expense-account money-in-alist)))
- (expense-acc-out-collector (cadr (assoc expense-account money-out-alist)))
- (expenses-in-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector
- report-currency
- exchange-fn)))
- (expenses-out-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-out-collector
- report-currency
- exchange-fn))))
- (and (equal? 10000/100 expenses-in-total)
- (equal? 5000/100 expenses-out-total)
- (equal? 10000/100
- (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
- report-currency exchange-fn)))
- (equal? 5000/100
- (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
- report-currency exchange-fn)))
+ (money-out-collector (cdr (assq 'money-out-collector result)))
+ (money-in-alist (cdr (assq 'money-in-alist result)))
+ (money-out-alist (cdr (assq 'money-out-alist result)))
+ (expense-acc-in-collector (cadr (assoc expense-account money-in-alist)))
+ (expense-acc-out-collector (cadr (assoc expense-account money-out-alist)))
+ (expenses-in-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector
+ report-currency
+ exchange-fn)))
+ (expenses-out-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-out-collector
+ report-currency
+ exchange-fn))))
+ (and (equal? 10000/100 expenses-in-total)
+ (equal? 5000/100 expenses-out-total)
+ (equal? 10000/100
+ (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector
+ report-currency exchange-fn)))
+ (equal? 5000/100
+ (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector
+ report-currency exchange-fn)))
(begin (format #t "test-both-way-cash-flow success~%") #t)
)))))
diff --git a/gnucash/report/reports/standard/view-column.scm b/gnucash/report/reports/standard/view-column.scm
index 757a83727b..f8ed02b493 100644
--- a/gnucash/report/reports/standard/view-column.scm
+++ b/gnucash/report/reports/standard/view-column.scm
@@ -1,17 +1,17 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; view-column.scm : simple multi-column table view.
+;; view-column.scm : simple multi-column table view.
;; Copyright 2001 Bill Gribble <grib at gnumatic.com>
-;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -29,7 +29,7 @@
(define-module (gnucash reports standard view-column))
(use-modules (gnucash engine))
(use-modules (ice-9 match))
-(use-modules (gnucash utilities))
+(use-modules (gnucash utilities))
(use-modules (gnucash core-utils))
(use-modules (gnucash app-utils))
(use-modules (gnucash report))
@@ -40,25 +40,25 @@
;; the report-list is edited by a special add-on page for the
;; options editor.
(gnc-register-report-placement-option options "__general" "report-list")
-
+
(gnc-register-number-range-option options
(N_ "General") (N_ "Number of columns") "a"
(N_ "Number of columns before wrapping to a new row.")
1 0 20 1)
-
+
options))
(define (render-view report)
(let* ((view-doc (gnc:make-html-document))
- (options (gnc:report-options report))
- (reports (gnc-optiondb-lookup-value options "__general" "report-list"))
- (table-width
- (gnc-optiondb-lookup-value options (N_ "General") (N_ "Number of columns")))
- (column-allocs (make-hash-table 11))
- (column-tab (gnc:make-html-table))
- (current-row '())
- (current-width 0)
- (current-row-num 0))
+ (options (gnc:report-options report))
+ (reports (gnc-optiondb-lookup-value options "__general" "report-list"))
+ (table-width
+ (gnc-optiondb-lookup-value options (N_ "General") (N_ "Number of columns")))
+ (column-allocs (make-hash-table 11))
+ (column-tab (gnc:make-html-table))
+ (current-row '())
+ (current-width 0)
+ (current-row-num 0))
;; we really would rather do something smart here with the
;; report's cached text if possible. For the moment, we'll have
@@ -73,18 +73,18 @@
;; actually used in a row; items with non-1 rowspans will take
;; up cells in the row without actually being in the row.
(let* ((subreport (gnc-report-find (car report-info)))
- (colspan (cadr report-info))
- (rowspan (caddr report-info))
- (toplevel-cell (gnc:make-html-table-cell/size rowspan colspan))
- (report-table (gnc:make-html-table))
- (contents-cell (gnc:make-html-table-cell)))
-
- ;; set the report's style properly ... this way it will
- ;; also get marked as dirty when the stylesheet is edited.
- (gnc:report-set-stylesheet!
- subreport (gnc:report-stylesheet report))
-
- ;; render the report body ... capture error if report crashes.
+ (colspan (cadr report-info))
+ (rowspan (caddr report-info))
+ (toplevel-cell (gnc:make-html-table-cell/size rowspan colspan))
+ (report-table (gnc:make-html-table))
+ (contents-cell (gnc:make-html-table-cell)))
+
+ ;; set the report's style properly ... this way it will
+ ;; also get marked as dirty when the stylesheet is edited.
+ (gnc:report-set-stylesheet!
+ subreport (gnc:report-stylesheet report))
+
+ ;; render the report body ... capture error if report crashes.
(gnc:html-table-cell-append-objects!
contents-cell
(match (gnc:apply-with-error-handling
@@ -96,80 +96,80 @@
(G_ "An error occurred while running the report.")
(gnc:html-markup "pre" captured-error)))))
- ;; increment the alloc number for each occupied row
- (let loop ((row current-row-num))
- (let ((allocation (hash-ref column-allocs row 0)))
- (hash-set! column-allocs row (+ colspan allocation))
- (if (< (+ 1 (- row current-row-num)) rowspan)
- (loop (+ 1 row)))))
-
- (gnc:html-table-cell-set-style!
- toplevel-cell "td"
- 'attribute (list "valign" "top")
- 'inheritable? #f)
-
- ;; put the report in the contents-cell
- (gnc:html-table-append-row! report-table (list contents-cell))
-
- ;; and a parameter editor link
- (gnc:html-table-append-row!
- report-table
- (list (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc-build-url
- URL-TYPE-OPTIONS
- (format #f "report-id=~a" (car report-info))
- "")
- (G_ "Edit Options"))
- " "
- (gnc:html-markup-anchor
- (gnc-build-url
- URL-TYPE-REPORT
- (format #f "id=~a" (car report-info))
- "")
- (G_ "Single Report")))))
-
- ;; add the report-table to the toplevel-cell
- (gnc:html-table-cell-append-objects!
- toplevel-cell report-table)
-
- (set! current-row (append current-row (list toplevel-cell)))
- (set! current-width (+ current-width colspan))
- (if (>= current-width table-width)
- (begin
- (gnc:html-table-append-row! column-tab current-row)
- ;; cells above with non-1 rowspan can force 'pre-allocation'
- ;; of space on this row
- (set! current-row-num (+ 1 current-row-num))
- (set! current-width (hash-ref column-allocs current-row-num))
- (if (not current-width) (set! current-width 0))
- (set! current-row '())))))
+ ;; increment the alloc number for each occupied row
+ (let loop ((row current-row-num))
+ (let ((allocation (hash-ref column-allocs row 0)))
+ (hash-set! column-allocs row (+ colspan allocation))
+ (if (< (+ 1 (- row current-row-num)) rowspan)
+ (loop (+ 1 row)))))
+
+ (gnc:html-table-cell-set-style!
+ toplevel-cell "td"
+ 'attribute (list "valign" "top")
+ 'inheritable? #f)
+
+ ;; put the report in the contents-cell
+ (gnc:html-table-append-row! report-table (list contents-cell))
+
+ ;; and a parameter editor link
+ (gnc:html-table-append-row!
+ report-table
+ (list (gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc-build-url
+ URL-TYPE-OPTIONS
+ (format #f "report-id=~a" (car report-info))
+ "")
+ (G_ "Edit Options"))
+ " "
+ (gnc:html-markup-anchor
+ (gnc-build-url
+ URL-TYPE-REPORT
+ (format #f "id=~a" (car report-info))
+ "")
+ (G_ "Single Report")))))
+
+ ;; add the report-table to the toplevel-cell
+ (gnc:html-table-cell-append-objects!
+ toplevel-cell report-table)
+
+ (set! current-row (append current-row (list toplevel-cell)))
+ (set! current-width (+ current-width colspan))
+ (if (>= current-width table-width)
+ (begin
+ (gnc:html-table-append-row! column-tab current-row)
+ ;; cells above with non-1 rowspan can force 'pre-allocation'
+ ;; of space on this row
+ (set! current-row-num (+ 1 current-row-num))
+ (set! current-width (hash-ref column-allocs current-row-num))
+ (if (not current-width) (set! current-width 0))
+ (set! current-row '())))))
reports)
-
+
(if (not (null? current-row))
- (gnc:html-table-append-row! column-tab current-row))
-
+ (gnc:html-table-append-row! column-tab current-row))
+
;; make sure the table is nice and big
- (gnc:html-table-set-style!
+ (gnc:html-table-set-style!
column-tab "table"
'attribute (list "width" "100%"))
-
+
(gnc:html-document-add-object! view-doc column-tab)
;; and we're done.
view-doc))
(define (options-changed-cb report)
(let* ((options (gnc:report-options report))
- (reports
- (gnc-optiondb-lookup-value options "__general" "report-list")))
- (for-each
+ (reports
+ (gnc-optiondb-lookup-value options "__general" "report-list")))
+ (for-each
(lambda (child)
(gnc:report-set-dirty?! (gnc-report-find (car child)) #t))
reports)))
(define (cleanup-options report)
(let* ((options (gnc:report-options report))
- (report-opt (gnc-lookup-option options "__general" "report-list")))
+ (report-opt (gnc-lookup-option options "__general" "report-list")))
(let loop ((reports (GncOption-get-value report-opt)) (new-reports '()))
(match reports
(() (GncOption-set-value report-opt (reverse new-reports)))
@@ -177,7 +177,7 @@
(loop rest (cons (list child rowspan colspan #f) new-reports)))))))
;; define the view now.
-(gnc:define-report
+(gnc:define-report
'version 1
'name (N_ "Multicolumn View")
'report-guid "d8ba4a2e89e8479ca9f6eccdeb164588"
@@ -185,5 +185,5 @@
'menu-path (list gnc:menuname-multicolumn)
'renderer render-view
'options-generator make-options
- 'options-cleanup-cb cleanup-options
+ 'options-cleanup-cb cleanup-options
'options-changed-cb options-changed-cb)
commit 1302c31498301e9948d5eafe9798197959e8d5f0
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Apr 20 09:00:19 2023 +0800
reports/locale-specific/* untabify/delete-trailing-whitespace
diff --git a/gnucash/report/reports/locale-specific/de_DE/taxtxf.scm b/gnucash/report/reports/locale-specific/de_DE/taxtxf.scm
index a27da6a49b..f122b4a7f7 100644
--- a/gnucash/report/reports/locale-specific/de_DE/taxtxf.scm
+++ b/gnucash/report/reports/locale-specific/de_DE/taxtxf.scm
@@ -9,7 +9,7 @@
;; exports TXF files for import to TaxCut, TurboTax, etc. for the US
;; tax TXF format. I modified this heavily so that it might become
;; useful for the German Umsatzsteuer-Voranmeldung.
-;;
+;;
;; The report in this file extracts the amounts that belong to the
;; Kennzahlen (from txf-de_DE.scm) as assigned to the different
;; accounts, and will write it to some XML file as required by
@@ -68,7 +68,7 @@
(define-module (gnucash reports locale-specific de_DE taxtxf))
(use-modules (gnucash engine))
-(use-modules (gnucash utilities))
+(use-modules (gnucash utilities))
(use-modules (gnucash core-utils)) ; for gnc:version and (G_ ...)
(use-modules (gnucash app-utils))
(use-modules (gnucash locale de_DE tax))
@@ -85,7 +85,7 @@
(vector-set! level-collector i (gnc:make-commodity-collector)))
level-collector))
-(define MAX-LEVELS 16) ; Maximum Account Levels
+(define MAX-LEVELS 16) ; Maximum Account Levels
(define levelx-collector (make-level-collector MAX-LEVELS))
@@ -110,7 +110,7 @@
;; between early-date and late-date
(define (split-report-make-date-filter-predicate begin-date
end-date)
- (lambda (split)
+ (lambda (split)
(let ((t
(xaccTransGetDate
(xaccSplitGetParent split))))
@@ -139,9 +139,9 @@
(define (tax-options-generator)
(define options (gnc-new-optiondb))
- ;; date at which to report
+ ;; date at which to report
(gnc:options-add-date-interval!
- options gnc:pagename-general
+ options gnc:pagename-general
(N_ "From") (N_ "To") "a")
(gnc-register-multichoice-option options
@@ -163,7 +163,7 @@
gnc:pagename-accounts (N_ "Select Accounts (none = all)")
"d" (N_ "Select accounts.")
'())
-
+
(gnc-register-simple-boolean-option options
gnc:pagename-display (N_ "Suppress $0.00 values")
"f" (N_ "$0.00 valued Accounts won't be printed.") #t)
@@ -179,11 +179,11 @@
;; Render txf information
(define crlf (string #\return #\newline)) ; TurboTax seems to want these
-(define txf-last-payer "") ; if same as current, inc txf-l-count
- ; this only works if different
- ; codes from the same payer are
- ; grouped in the accounts list
-(define txf-l-count 0) ; count repeated N codes
+(define txf-last-payer "") ; if same as current, inc txf-l-count
+ ; this only works if different
+ ; codes from the same payer are
+ ; grouped in the accounts list
+(define txf-l-count 0) ; count repeated N codes
;; stores assigned txf codes so we can check for duplicates
(define txf-dups-alist '())
@@ -210,7 +210,7 @@
(string->symbol (if (string-null? pns) "keine" pns))))
;; check for duplicate txf codes
-(define (txf-check-dups account)
+(define (txf-check-dups account)
(let* ((code (gnc:account-get-txf-code account))
(item (assoc-ref txf-dups-alist code))
(payer (gnc:account-get-txf-payer-source account)))
@@ -229,8 +229,8 @@
(if (> cnt 1)
(let* ((acc (cadr x))
(txf (gnc:account-get-txf acc)))
- (cons (string-append
- "Kennzahl \""
+ (cons (string-append
+ "Kennzahl \""
(symbol->string
(gnc:account-get-txf-code acc))
"\" hat Duplikate in "
@@ -302,69 +302,69 @@
#f))
;; Only formats 1,3 implemented now! Others are treated as 1.
(format (gnc:get-txf-format code (eq? type ACCT-TYPE-INCOME)))
- (value (string-append
- (if (eq? type ACCT-TYPE-INCOME) ;; negate expenses. FIXME: Necessary?
- ""
- "-")
- (number->string
- (gnc-numeric-num
- (gnc-numeric-convert account-value (cond
- ((eq? format 2) 1)
- (else 100))
- 3))))) ;; 3 is the GNC_HOW_TRUNC truncation rounding
- (payer-src (gnc:account-get-txf-payer-source account))
+ (value (string-append
+ (if (eq? type ACCT-TYPE-INCOME) ;; negate expenses. FIXME: Necessary?
+ ""
+ "-")
+ (number->string
+ (gnc-numeric-num
+ (gnc-numeric-convert account-value (cond
+ ((eq? format 2) 1)
+ (else 100))
+ 3))))) ;; 3 is the GNC_HOW_TRUNC truncation rounding
+ (payer-src (gnc:account-get-txf-payer-source account))
(account-name (let* ((named-acct
- (if (eq? payer-src 'parent)
- (gnc-account-get-parent account)
- account))
- (name (xaccAccountGetName named-acct)))
- (if (not (string-null? name))
- name
- (begin
- (display
- (string-append
- "Failed to get name for account: "
- (gncAccountGetGUID named-acct)
- (if (not (eq? account named-acct))
- (string-append
- " which is the parent of "
- (gncAccountGetGUID account)))
- "\n"))
- "<NONE> -- See the Terminal Output"))))
+ (if (eq? payer-src 'parent)
+ (gnc-account-get-parent account)
+ account))
+ (name (xaccAccountGetName named-acct)))
+ (if (not (string-null? name))
+ name
+ (begin
+ (display
+ (string-append
+ "Failed to get name for account: "
+ (gncAccountGetGUID named-acct)
+ (if (not (eq? account named-acct))
+ (string-append
+ " which is the parent of "
+ (gncAccountGetGUID account)))
+ "\n"))
+ "<NONE> -- See the Terminal Output"))))
(action (if (eq? type ACCT-TYPE-INCOME)
(case code
((N286 N488) "ReinvD")
(else "Ertraege"))
"Aufwendungen"))
(category-key (if (eq? type ACCT-TYPE-INCOME)
- (gnc:txf-get-category-key
+ (gnc:txf-get-category-key
txf-income-categories code "")
(gnc:txf-get-category-key
txf-expense-categories code "")))
(value-name (if (equal? "ReinvD" action)
- (string-append
+ (string-append
(substring value 1 (string-length value))
" " account-name)
account-name))
(l-value (if (= format 3)
(begin
- (set! txf-l-count
+ (set! txf-l-count
(if (equal? txf-last-payer account-name)
txf-l-count
(+ 1 txf-l-count)))
(set! txf-last-payer account-name)
(number->string txf-l-count))
"1")))
- ;(display "render-txf-account \n")
- ;(display-backtrace (make-stack #t) (current-output-port))
+ ;(display "render-txf-account \n")
+ ;(display-backtrace (make-stack #t) (current-output-port))
- ;; FIXME: Here the actual rendering of one account entry is
- ;; done. Use the German format here.
+ ;; FIXME: Here the actual rendering of one account entry is
+ ;; done. Use the German format here.
(list " <Kennzahl Nr=\""
- category-key
- "\">"
+ category-key
+ "\">"
value
- "</Kennzahl>" crlf))
+ "</Kennzahl>" crlf))
; (case format
; ((3) (list "P" account-name crlf))
; (else (if (and x? (txf-special-split? code))
@@ -372,17 +372,17 @@
; '())))
; (if x?
; (list "X" x-date-str " " (fill-clamp-sp account-name 31)
-; (fill-clamp-sp action 7)
+; (fill-clamp-sp action 7)
; (fill-clamp-sp value-name 82)
; (fill-clamp category-key 15) crlf)
; '())
; "^" crlf))
- "")))
+ "")))
;; Render any level
(define (render-level-x-account table level max-level account lx-value
suppress-0 full-names txf-date)
- (let* ((account-name (if txf-date ; special split
+ (let* ((account-name (if txf-date ; special split
(gnc-print-time64 txf-date "%d.%m.%Y")
(if (or full-names (equal? level 1))
(gnc-account-get-full-name account)
@@ -406,7 +406,7 @@
(gnc:make-html-table-cell #f)))
(end-cells (make-list (- level 1) (gnc:make-html-table-cell #f))))
- (if (and blue? (not txf-date)) ; check for duplicate txf codes
+ (if (and blue? (not txf-date)) ; check for duplicate txf codes
(txf-check-dups account))
(if (or (not suppress-0) (= level 1)
@@ -450,21 +450,21 @@
;; the number of account generations: children, grandchildren etc.
(define (num-generations account gen)
(if (eq? (gnc-account-n-children account) 0)
- (if (and (xaccAccountGetTaxRelated account)
- (txf-special-split? (gnc:account-get-txf-code account)))
- (+ gen 1) ; Est Fed Tax has a extra generation
- gen) ; no kids, return input
- (apply max (map (lambda (x) (num-generations x (1+ gen)))
+ (if (and (xaccAccountGetTaxRelated account)
+ (txf-special-split? (gnc:account-get-txf-code account)))
+ (+ gen 1) ; Est Fed Tax has a extra generation
+ gen) ; no kids, return input
+ (apply max (map (lambda (x) (num-generations x (1+ gen)))
(or (gnc-account-get-children-sorted account) '())))))
(gnc:report-starting reportname)
- (let* ((from-value (gnc:date-option-absolute-time
+ (let* ((from-value (gnc:date-option-absolute-time
(get-option gnc:pagename-general "From")))
(to-value (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
+ (gnc:date-option-absolute-time
(get-option gnc:pagename-general "To"))))
(alt-period (get-option gnc:pagename-general "Alternate Period"))
- (suppress-0 (get-option gnc:pagename-display
+ (suppress-0 (get-option gnc:pagename-display
"Suppress $0.00 values"))
(full-names (get-option gnc:pagename-display
"Print Full account names"))
@@ -474,7 +474,7 @@
;; If no selected accounts, check all.
(selected-accounts (if (not (null? user-sel-accnts))
valid-user-sel-accnts
- (validate (reverse
+ (validate (reverse
(gnc-account-get-children-sorted
(gnc-get-current-root-account))))))
(book (gnc-get-current-book))
@@ -483,19 +483,19 @@
selected-accounts))
0))
(max-level (min MAX-LEVELS (max 1 generations)))
- (work-to-do 0)
- (work-done 0)
+ (work-to-do 0)
+ (work-done 0)
;; Alternate dates are relative to from-date
(from-date (gnc-localtime from-value))
(from-value (gnc:time64-start-day-time
(let ((bdtm from-date))
- (if (member alt-period
+ (if (member alt-period
'(last-year 1st-last 2nd-last
3rd-last 4th-last))
(set-tm:year bdtm (- (tm:year bdtm) 1)))
(set-tm:mday bdtm 1)
- (if (< (gnc:date-get-year bdtm)
+ (if (< (gnc:date-get-year bdtm)
tax-qtr-real-qtr-year)
(case alt-period
((1st-est 1st-last last-year) ; Jan 1
@@ -521,7 +521,7 @@
(to-value (gnc:time64-end-day-time
(let ((bdtm from-date))
- (if (member alt-period
+ (if (member alt-period
'(last-year 1st-last 2nd-last
3rd-last 4th-last))
(set-tm:year bdtm (- (tm:year bdtm) 1)))
@@ -529,7 +529,7 @@
;; The exact same code, in from-value, further above,
;; only subtraces one! Go figure!
;; So, we add one back below!
- (if (member alt-period
+ (if (member alt-period
'(last-year 1st-last 2nd-last
3rd-last 4th-last))
(set-tm:year bdtm (+ (tm:year bdtm) 1)))
@@ -543,7 +543,7 @@
((3rd-est 3rd-last) ; Aug 31
(set-tm:mon bdtm 7))
((4th-est 4th-last last-year) ; Dec 31
- (set-tm:mon bdtm 11))
+ (set-tm:mon bdtm 11))
(else (set! bdtm (gnc-localtime to-value))))
;; Tax quaters equal Real quarters
(case alt-period
@@ -557,7 +557,7 @@
(set-tm:mon bdtm 8))
((4th-est 4th-last last-year) ; Dec 31
(set-tm:mon bdtm 11))
- (else
+ (else
(set! bdtm (gnc-localtime to-value)))))
(set-tm:isdst bdtm -1)
(gnc-mktime bdtm))))
@@ -571,7 +571,7 @@
(define (txf-special-splits-period account from-value to-value)
(if (and (xaccAccountGetTaxRelated account)
(txf-special-split? (gnc:account-get-txf-code account)))
- (let*
+ (let*
((full-year?
(let ((bdto (gnc-localtime to-value))
(bdfrom (gnc-localtime from-value)))
@@ -603,10 +603,10 @@
to-value)))
(list from-est to-est full-year?))
#f))
-
+
;; for quarterly estimated tax payments, we need to go one level down
;; and get data from splits
- (define (handle-txf-special-splits level account from-est to-est
+ (define (handle-txf-special-splits level account from-est to-est
full-year? to-value)
(let*
((split-filter-pred (split-report-make-date-filter-predicate
@@ -615,12 +615,12 @@
(lev (if (>= max-level (+ 1 level))
(+ 1 level)
level)))
- (map (lambda (spl)
+ (map (lambda (spl)
(let* ((date (xaccTransGetDate
(xaccSplitGetParent spl)))
(amount (xaccSplitGetAmount spl))
;; TurboTax 1999 and 2000 ignore dates after Dec 31
- (fudge-date (if (and full-year?
+ (fudge-date (if (and full-year?
(< to-value date))
to-value
date)))
@@ -630,30 +630,30 @@
(render-txf-account account amount
#t fudge-date #t date))))
split-list)))
-
+
(define (count-accounts level accounts)
(if (< level max-level)
- (let ((sum 0))
- (for-each (lambda (x)
- (if (gnc:account-is-inc-exp? x)
- (set! sum (+ sum (+ 1 (count-accounts (+ 1 level)
- (gnc-account-get-children x)))))
- 0))
- accounts)
- sum)
- (length accounts)))
+ (let ((sum 0))
+ (for-each (lambda (x)
+ (if (gnc:account-is-inc-exp? x)
+ (set! sum (+ sum (+ 1 (count-accounts (+ 1 level)
+ (gnc-account-get-children x)))))
+ 0))
+ accounts)
+ sum)
+ (length accounts)))
(define (handle-level-x-account level account)
(let ((type (xaccAccountGetType account)))
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (* 100 (if (> work-to-do 0)
- (/ work-done work-to-do)
- 1)))
+ (set! work-done (+ 1 work-done))
+ (gnc:report-percent-done (* 100 (if (> work-to-do 0)
+ (/ work-done work-to-do)
+ 1)))
(if (gnc:account-is-inc-exp? account)
(let* ((children (gnc-account-get-children-sorted account))
- (to-special #f) ; clear special-splits-period
+ (to-special #f) ; clear special-splits-period
(from-special #f)
- (childrens-output
+ (childrens-output
(if (null? children)
(let* ((splits-period (txf-special-splits-period
account from-value to-value)))
@@ -666,7 +666,7 @@
to-special
full-year?
to-value))
-
+
'()))
(map (lambda (x)
@@ -675,7 +675,7 @@
'()))
(reverse children))))
- (account-balance
+ (account-balance
(if (xaccAccountGetTaxRelated account)
(if to-special
(gnc:account-get-balance-interval
@@ -709,7 +709,7 @@
max-level account
account-balance
suppress-0 full-names #f)
- (list
+ (list
;(if (not to-special)
; (render-txf-account account account-balance
; #f #f #t from-value)
@@ -737,10 +737,10 @@
(let ((from-date (gnc-print-time64 from-value "%d.%m.%Y"))
(to-date (gnc-print-time64 to-value "%d.%m.%Y"))
- (to-year (gnc-print-time64 to-value "%Y"))
+ (to-year (gnc-print-time64 to-value "%Y"))
(today-date (gnc-print-time64 (time64CanonicalDayTime (current-time))
"%d.%m.%Y"))
- (tax-nr (gnc:book-get-option-value book gnc:*tax-label* gnc:*tax-nr-label*)))
+ (tax-nr (gnc:book-get-option-value book gnc:*tax-label* gnc:*tax-nr-label*)))
;; Now, the main body
;; Reset all the balance collectors
@@ -752,7 +752,7 @@
(set! txf-l-count 0)
(set! work-to-do (count-accounts 1 selected-accounts))
- (if (not tax-mode?) ; Do Txf mode
+ (if (not tax-mode?) ; Do Txf mode
(begin
(gnc:html-document-set-export-string
doc (call-with-output-string
@@ -768,40 +768,40 @@
"</WinstonAusgang>")
port "taxtxf-de.scm - "))))
doc)
- (begin ; else do tax report
- (gnc:html-document-set-style!
+ (begin ; else do tax report
+ (gnc:html-document-set-style!
doc "blue"
'tag "font"
'attribute (list "color" "#0000ff"))
-
- (gnc:html-document-set-style!
+
+ (gnc:html-document-set-style!
doc "income"
'tag "font"
'attribute (list "color" "#0000ff"))
-
- (gnc:html-document-set-style!
+
+ (gnc:html-document-set-style!
doc "expense"
'tag "font"
'attribute (list "color" "#ff0000"))
-
+
(gnc:html-document-set-style!
doc "account-header"
'tag "th"
'attribute (list "align" "left"))
-
+
(gnc:html-document-set-title! doc report-name)
-
- (gnc:html-document-add-object!
- doc (gnc:make-html-text
- (gnc:html-markup
+
+ (gnc:html-document-add-object!
+ doc (gnc:make-html-text
+ (gnc:html-markup
"center"
(gnc:html-markup-p
(gnc:html-markup/format
(G_ "Period from ~a to ~a") from-date to-date)))))
-
+
(gnc:html-document-add-object!
doc (gnc:make-html-text
- (gnc:html-markup
+ (gnc:html-markup
"center"
(gnc:html-markup
"blue"
@@ -810,15 +810,15 @@
Diese XML-Datei enthält dann die geschlüsselten USt-Kennzahlen und zu diesen die summierten Werte für den ELSTER-Export.<br>
Bei Umsätzen werden nur voll Beträge ausgewiesen, bei Steuerkennzahlen auch die Dezimalstellen, aber ohne Komma.<br>
Klicken Sie auf »Exportieren« , um den Export durchzuführen.")))))
-
+
(txf-print-dups doc)
-
+
(gnc:html-document-add-object! doc table)
-
+
(set! txf-dups-alist '())
(map (lambda (x) (handle-level-x-account 1 x))
selected-accounts)
-
+
(if (null? selected-accounts)
(gnc:html-document-add-object!
doc
@@ -827,7 +827,7 @@ Klicken Sie auf »Exportieren« , um den Export durchzuführen.")))))
"Keine Steuer-relevanten Konten gefunden.<br>
Gehen Sie zu Bearbeiten -> Optionen Steuerbericht, um Konten entsprechend einzurichten."))))
- (gnc:report-finished)
+ (gnc:report-finished)
doc)))))
(gnc:define-report
diff --git a/gnucash/report/reports/locale-specific/us/taxtxf.scm b/gnucash/report/reports/locale-specific/us/taxtxf.scm
index fcfb2fcc08..e479e00424 100644
--- a/gnucash/report/reports/locale-specific/us/taxtxf.scm
+++ b/gnucash/report/reports/locale-specific/us/taxtxf.scm
@@ -654,7 +654,7 @@
USD-currency
;; Use midday as the transaction time so it matches a price
;; on the same day. Otherwise it uses midnight which will
- ;; likely match a price on the previous day
+ ;; likely match a price on the previous day
(time64CanonicalDayTime lookup-date))
)
(begin ;; otherwise set flag and set to zero
@@ -1039,7 +1039,7 @@
(define (process-account-transaction-detail table account split-list
split-details? full-names? currency-conversion-date to-value
transaction-details? suppress-action-memo?
- shade-alternate-transactions? splits-period full-year? from-value
+ shade-alternate-transactions? splits-period full-year? from-value
tax-mode? show-TXF-data? USD-currency account-type
tax-code acct-full-name acct-beg-bal-collector
acct-end-bal-collector copy tax-entity-type)
commit 415438d0d72c03537ceb74e30003c3c930a4969f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Apr 20 09:00:04 2023 +0800
reports/example/* untabify/delete-trailing-whitespace
diff --git a/gnucash/report/reports/example/average-balance.scm b/gnucash/report/reports/example/average-balance.scm
index f5f0ec1354..5bf9e2d83f 100644
--- a/gnucash/report/reports/example/average-balance.scm
+++ b/gnucash/report/reports/example/average-balance.scm
@@ -2,7 +2,7 @@
;; average-balance.scm
;; Report history of account balance and other info
;;
-;; Author makes no implicit or explicit guarantee of accuracy of
+;; Author makes no implicit or explicit guarantee of accuracy of
;; these calculations and accepts no responsibility for direct
;; or indirect losses incurred as a result of using this software.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -86,7 +86,7 @@
"c" (N_ "Do transaction report on this account.")
(let ((current-accounts '()))
;; If some accounts were selected, use those
- (cond ((not (null? current-accounts))
+ (cond ((not (null? current-accounts))
current-accounts)
(else
;; otherwise get some accounts -- here as an
@@ -112,7 +112,7 @@
(gnc-register-list-option options
gnc:pagename-display (N_ "Plot Type")
"c" (N_ "The type of graph to generate.") "AvgBalPlot"
- (list
+ (list
(vector 'AvgBalPlot (N_ "Average"))
(vector 'GainPlot (N_ "Profit"))
(vector 'GLPlot (N_ "Gain/Loss"))))
@@ -127,14 +127,14 @@
options))
;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Some utilities for generating the data
+;; Some utilities for generating the data
;;;;;;;;;;;;;;;;;;;;;;;;;
(define columns
;; Watch out -- these names should be consistent with the display
;; option where you choose them, otherwise users are confused.
- (list (G_ "Period start") (G_ "Period end") (G_ "Average")
- (G_ "Maximum") (G_ "Minimum") (G_ "Gain")
+ (list (G_ "Period start") (G_ "Period end") (G_ "Average")
+ (G_ "Maximum") (G_ "Minimum") (G_ "Gain")
(G_ "Loss") (G_ "Profit") ))
@@ -263,17 +263,17 @@
(gnc-optiondb-lookup-value (gnc:report-options report-obj) section name))
(gnc:report-starting reportname)
- (let* ((report-title (get-option gnc:pagename-general
+ (let* ((report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(begindate (gnc:time64-start-day-time
- (gnc:date-option-absolute-time
+ (gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-from-date))))
- (enddate (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
+ (enddate (gnc:time64-end-day-time
+ (gnc:date-option-absolute-time
(get-option gnc:pagename-general optname-to-date))))
(stepsize (gnc:deltasym-to-delta
(get-option gnc:pagename-general optname-stepsize)))
- (report-currency (get-option gnc:pagename-general
+ (report-currency (get-option gnc:pagename-general
optname-report-currency))
(price-source (get-option gnc:pagename-general
optname-price-source))
@@ -290,8 +290,8 @@
(document (gnc:make-html-document))
- (commodity-list #f)
- (exchange-fn #f)
+ (commodity-list #f)
+ (exchange-fn #f)
(all-zeros? #t))
;;(warn commodity-list)
@@ -307,40 +307,40 @@
;; routine needs to send progress reports, or the price
;; lookup should be distributed and done when actually
;; needed so as to amortize the cpu time properly.
- (gnc:report-percent-done 1)
- (set! commodity-list (gnc:accounts-get-commodities
+ (gnc:report-percent-done 1)
+ (set! commodity-list (gnc:accounts-get-commodities
accounts report-currency))
- (gnc:report-percent-done 5)
- (set! exchange-fn (gnc:case-exchange-time-fn
- price-source report-currency
+ (gnc:report-percent-done 5)
+ (set! exchange-fn (gnc:case-exchange-time-fn
+ price-source report-currency
commodity-list enddate
- 5 20))
- (gnc:report-percent-done 20)
+ 5 20))
+ (gnc:report-percent-done 20)
- ;; initialize the query to find splits in the right
+ ;; initialize the query to find splits in the right
;; date range and accounts
(qof-query-set-book query (gnc-get-current-book))
- ;; for balance purposes, we don't need to do this, but it cleans up
- ;; the table display.
+ ;; for balance purposes, we don't need to do this, but it cleans up
+ ;; the table display.
(xaccQueryAddClearedMatch
query (logand CLEARED-ALL (lognot CLEARED-VOIDED)) QOF-QUERY-AND)
- ;; add accounts to the query (include subaccounts
+ ;; add accounts to the query (include subaccounts
;; if requested)
- (gnc:report-percent-done 25)
+ (gnc:report-percent-done 25)
(xaccQueryAddAccountMatch query accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND)
-
- ;; match splits between start and end dates
+
+ ;; match splits between start and end dates
(xaccQueryAddDateMatchTT
query #t begindate #t enddate QOF-QUERY-AND)
(qof-query-set-sort-order query
- (list SPLIT-TRANS TRANS-DATE-POSTED)
- (list QUERY-DEFAULT-SORT)
- '())
-
- (gnc:report-percent-done 40)
+ (list SPLIT-TRANS TRANS-DATE-POSTED)
+ (list QUERY-DEFAULT-SORT)
+ '())
+
+ (gnc:report-percent-done 40)
(let* ((splits (qof-query-run query))
(daily-dates (gnc:make-date-list begindate enddate DayDelta))
@@ -380,9 +380,9 @@
internal-included exchange-fn report-currency))))
(gnc:report-percent-done 70)
-
- ;; make a plot (optionally)... if both plot and table,
- ;; plot comes first.
+
+ ;; make a plot (optionally)... if both plot and table,
+ ;; plot comes first.
(if show-plot?
(let ((barchart (gnc:make-html-chart))
(height (get-option gnc:pagename-display optname-plot-height))
@@ -391,7 +391,7 @@
(if (memq 'AvgBalPlot plot-type)
(let
((number-data
- (map
+ (map
(lambda (row) (list-ref row 2)) data)))
(if (not (every zero? number-data))
(begin
@@ -402,7 +402,7 @@
(set! all-zeros? #f)))))
(if (memq 'GainPlot plot-type)
- (let ((number-data
+ (let ((number-data
(map (lambda (row) (list-ref row 7)) data)))
(if (not (every zero? number-data))
(begin
@@ -413,11 +413,11 @@
(set! all-zeros? #f)))))
(if (memq 'GLPlot plot-type)
- (let ((debit-data
+ (let ((debit-data
(map (lambda (row) (list-ref row 5)) data))
(credit-data
(map (lambda (row) (list-ref row 6)) data)))
- ;; debit column
+ ;; debit column
(if (not (and
(every zero? debit-data)
(every zero? credit-data)))
@@ -431,7 +431,7 @@
credit-data
"#FF4136")
(set! all-zeros? #f)))))
-
+
(if (not all-zeros?)
(begin
(gnc:html-chart-set-currency-iso!
@@ -447,12 +447,12 @@
(gnc:html-document-add-object! document barchart))
(gnc:html-document-add-object!
document
- (gnc:html-make-empty-data-warning
+ (gnc:html-make-empty-data-warning
report-title (gnc:report-id report-obj))))))
-
+
;; make a table (optionally)
- (gnc:report-percent-done 80)
- (if show-table?
+ (gnc:report-percent-done 80)
+ (if show-table?
(let ((table (gnc:make-html-table))
(scu (gnc-commodity-get-fraction report-currency)))
(gnc:html-table-set-col-headers!
@@ -478,10 +478,10 @@
(gnc:html-document-add-object! document table))))
;; if there are no accounts selected...
- (gnc:html-document-add-object!
+ (gnc:html-document-add-object!
document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj))))
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj))))
(gnc:report-finished)
document))
diff --git a/gnucash/report/reports/example/daily-reports.scm b/gnucash/report/reports/example/daily-reports.scm
index 57772cd2ab..5219a421f7 100644
--- a/gnucash/report/reports/example/daily-reports.scm
+++ b/gnucash/report/reports/example/daily-reports.scm
@@ -6,16 +6,16 @@
;; based on account-piecharts.scm by Robert Merkel (rgmerk at mira.net)
;; and Christian Stimming <stimming at tu-harburg.de>
;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -40,7 +40,7 @@
;; The menu statusbar tips.
(define menutip-income
(N_ "Shows a piechart with the total income for each day of the week"))
-(define menutip-expense
+(define menutip-expense
(N_ "Shows a piechart with the total expenses for each day of the week"))
;; The names here are used 1. for internal identification, 2. as
@@ -171,8 +171,8 @@
;; routine needs to send progress reports, or the price
;; lookup should be distributed and done when actually
;; needed so as to amortize the cpu time properly.
- (gnc:report-percent-done 1)
- (set! commodity-list (gnc:accounts-get-commodities
+ (gnc:report-percent-done 1)
+ (set! commodity-list (gnc:accounts-get-commodities
(gnc-accounts-and-all-descendants accounts)
report-currency))
(gnc:report-percent-done 5)
@@ -212,7 +212,7 @@
;; get the query results
(set! splits (qof-query-run query))
(qof-query-destroy query)
- (gnc:report-percent-done 40)
+ (gnc:report-percent-done 40)
;; each split is analyzed... the amount is converted to
;; report-currency, and the date modulo 7 used to find
@@ -232,7 +232,7 @@
(gnc:report-percent-done 60)
- (let* ((zipped-list (filter (lambda (p)
+ (let* ((zipped-list (filter (lambda (p)
(not (zero? (cadr p))))
(zip days-of-week daily-totals)))
(labels (map (lambda (p)
diff --git a/gnucash/report/reports/example/sample-report.scm b/gnucash/report/reports/example/sample-report.scm
index 3850846aff..14646c50c5 100644
--- a/gnucash/report/reports/example/sample-report.scm
+++ b/gnucash/report/reports/example/sample-report.scm
@@ -169,7 +169,7 @@
"c" opthelp-report-title (N_ "Report Title Default"))
;; Setting a default section is optional but set in most reports.
- ;; If not set, the default section will be the first section.
+ ;; If not set, the default section will be the first section.
(gnc:options-set-default-section options "Tab B")
(GncOptionDBPtr-set-default-section optiondb "Tab B")
;; We still need to return the function wrapper instead of the GncOptionDBPtr for all of the options functions in the reports system.
@@ -465,4 +465,4 @@ new, totally cool report, consult the mailing list ~a.")
;; The rendering function defined above.
'renderer sample-report-renderer)
-
\ No newline at end of file
+
commit 8a8960c43ad56104734cc9b7c7ddd56c73ed6307
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Apr 20 08:59:41 2023 +0800
report/* untabify/delete-trailing-whitespace
diff --git a/gnucash/report/html-acct-table.scm b/gnucash/report/html-acct-table.scm
index 4aa51f8e59..3720e5e4d3 100644
--- a/gnucash/report/html-acct-table.scm
+++ b/gnucash/report/html-acct-table.scm
@@ -1,22 +1,22 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; html-acct-table.scm : generate a multi-columnar list of accounts
;; including utilities to convert to <html-table> form
-;;
+;;
;; By David Montenegro 2004.06.23 <sunrise2000 at comcast.net>
-;;
+;;
;; Borrowed largely from html-table.scm by Bill Gribble <grib at gnumatic.com>
;; and html-utilities.scm by Christian Stimming <stimming at tu-harburg.de>
-;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -25,19 +25,19 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
+;;
;;
;; DESCRIPTION
-;;
+;;
;; The html-acct-table object is a utility object, not an html object.
;; It is used to collect and then render a table whose leftmost column(s)
;; are a list or chart of accounts.
-;;
+;;
;; You start by creating the object and initializing it with a list of
;; accounts and a few assorted parameters. It generates a table, which
;; can be read using accessor functions, containing information which
;; makes it easy(ier) to create a great variety of html-table forms.
-;;
+;;
;; add-accounts add-account-balances
;; account-list ------------> html-acct-table ----------> html-table
;;
@@ -71,7 +71,7 @@
;;
;;
;; ARGUMENTS
-;;
+;;
;; For boolean arguments, #t and #f have their usual meanings. If a
;; boolean argument is not set, a default value may be assumed. For
;; non-boolean arguments, values may be specified. When #f is
@@ -80,20 +80,20 @@
;; specified for such an argument, it generally means to use that
;; functionality, but just accept whatever default functionality that
;; option may have.
-;;
+;;
;; The list of accounts which are to be placed in the
;; gnc:html-acct-table object can be controlled with the
;; gnc:make-html-acct-table/accts, gnc:make-html-acct-table/env/accts,
;; and gnc:html-table-add-accts! functions. But you should only use
;; one of these methods to add accounts.
-;;
+;;
;; The gnc:html-acct-table parameters should be set BEFORE adding the
;; account list. They can be set with gnc:make-html-acct-table/env
;; or gnc:make-html-acct-table/accts/env and fetched with
;; gnc:html-acct-table-env; accept the following parameters:
-;;
+;;
;; display-tree-depth: integer 'unlimited ['all] #f
-;;
+;;
;; the number of levels of accounts to display
;; 'unlimited, 'all, and #f impose no depth limit.
;; the default is 'all. [CAS: ISTM, the default is actually #f,
@@ -102,9 +102,9 @@
;; parameter to a large integer value has the strange side-effect
;; of pushing the balances column far right, even when the account
;; tree is relatively shallow.]
-;;
+;;
;; depth-limit-behavior: ['summarize] 'flatten 'truncate
-;;
+;;
;; when the display tree reaches its depth limit, this option
;; tells gnc:html-acct-table what to do. 'summarize tells it
;; to omit accounts below the depth limit and summarize their
@@ -113,13 +113,13 @@
;; subaccount, all the way down the tree, but to position
;; them, in the chart, at the depth limit. the default value
;; is 'summarize
-;;
+;;
;; initial-indent: integer
-;;
+;;
;; the number of table cells to indent the first level of
;; accounts displayed. this is merely a convenience. the
;; default initial-indent is 0.
-;;
+;;
;; account-less-p: binary_predicate #t #f
;;
;; used for sorting accounts, below each parent account, into
@@ -130,14 +130,14 @@
;; default sorting function is gnc:account-code-less-p.
;;
;; start-date: time64
-;;
+;;
;; the starting date of the reporting period over which to
;; report balances for this account. if start-date is #f,
;; will be no limit on how early a counted transaction may
;; occur.
-;;
+;;
;; end-date: time64
-;;
+;;
;; the ending date of the reporting period over which to
;; report balances for this account. if end-date is #f, there
;; will be no limit on how late a counted transaction may
@@ -146,9 +146,9 @@
;; possibility that this may match transactions which haven't
;; occurred, yet. [CAS: I don't think end-date of #f works.
;; It bombs.]
-;;
+;;
;; report-commodity: commodity
-;;
+;;
;; the commodity into which to convert any balances containing
;; foreign currencies. the balance will be converted using
;; the exchange function exchange-fn. the default is the
@@ -173,7 +173,7 @@
;; account's exchange-fn.
;;
;; exchange-fn: commodity_exchange_function
-;;
+;;
;; the commodity exchange function (you know, that weighted
;; average, most recent, nearest in time fun stuff) used to
;; convert balances which are not exclusively in the report
@@ -199,37 +199,37 @@
;; header cell will be automatically set appropriately. this
;; is for convenience only; gnc:html-acct-table does not use
;; this data.
-;;
+;;
;; account-label-mode: 'name 'anchor
-;;
+;;
;; tells whether to render account labels as hyperlinks or
;; text. stylesheets, really, should be able to remove
;; link markup.
-;;
+;;
;; parent-account-subtotal-mode: #t #f
-;;
+;;
;; indicates whether or not to add a line, recursively
;; subtotalling an account and its descendents, for any
;; account with children (non-leaf account). if #t, a
;; subtotal row will be created for each non-leaf account.
;; if #f, no non-leaf account subtotal rows will be
;; created. the default is #f.
-;;
+;;
;; zero-balance-mode: 'show-leaf-acct 'omit-leaf-acct
-;;
+;;
;; indicates what to do with accounts with zero balance. if
;; 'omit-leaf-acct, no account row will be generated for any
;; account having a balance of zero. otherwise, a row will be
;; generated for the account.
-;;
+;;
;; balance-mode: 'pre-closing 'post-closing
;;
;; indicates whether or not to ignore adjusting/closing
;; entries when computing account balances. 'pre-closing
;; ignores, 'post-closing counts closing entries.
-;;
+;;
;; closing-pattern: alist of 'str 'cased 'regexp
-;;
+;;
;; a pattern alist, as accepted by
;; gnc:account-get-trans-type-balance-interval, matching
;; closing transactions to be ignored when balance-mode is
@@ -237,47 +237,47 @@
;;
;; report-budget: budget
;;
-;; (optional) a budget used to ignore accounts with zero
-;; budget or balance (if zb-balance-mode is set to omit).
-;;
+;; (optional) a budget used to ignore accounts with zero
+;; budget or balance (if zb-balance-mode is set to omit).
+;;
;; account-type: unimplemented
;; account-class: unimplemented
;; row-thunk: unimplemented (for gnc:html-acct-table-render)
;; row-list: unimplemented (list of all the rows ever added)
-;;
+;;
;; The html-acct-table object lets you generate, store, and access the
;; following parameters:
-;;
+;;
;; account: Account
-;;
+;;
;; the account in the current row
-;;
+;;
;; account-parent: Account #f
-;;
+;;
;; the parent account of the current account, if one exists.
;; #f if the current account has no parent.
-;;
+;;
;; account-guid: guid
-;;
+;;
;; the guid of the account in the current row, as returned by
;; gncAccountGetGUID.
-;;
+;;
;; account-desc: string?
-;;
+;;
;; the account description of the account in the current row,
;; as returned by xaccAccountGetDescription.
-;;
+;;
;; account-notes: string?
-;;
+;;
;; the account notes of the account in the current row, as
;; returned by xaccAccountGetNotes.
-;;
+;;
;; account-path: string
-;;
+;;
;; the full name of the account in the current row. i.e., if
;; the name of the account is "Assets:Current Assets:Cash",
;; the value will be "Assets:Current Assets:Cash".
-;;
+;;
;; account-name: string
;;
;; the "basename" of the account in the current row. i.e., if
@@ -285,31 +285,31 @@
;; the value will be "Cash".
;;
;; account-code: string
-;;
+;;
;; the account of the account in the current row, as returned
;; by xaccAccountGetCode.
-;;
+;;
;; account-anchor: text(maybe?)
-;;
+;;
;; a link to the account in the current row
-;;
+;;
;; account-label: string
-;;
+;;
;; the text used to label the account in the current row. if
;; account-label-mode is 'name, this consists of account-name
;; prepended, if row-type is 'subtotal-row, by "Total ". if
;; account-label-mode is 'anchor, this consists of
;; account-anchor prepended, if row-type is 'subtotal-row, by
;; "Total ".
-;;
+;;
;; account-depth: integer
-;;
+;;
;; the depth at which the account in the current row resides
;; in the account tree. note that this may differ from
;; display-depth when depth-limit-behavior is 'flatten.
;; unlike in gnc:html-build-acct-table, the first level of
;; accounts is level 0.
-;;
+;;
;; logical-depth: integer
;;
;; the depth at which the account in the current row resides
@@ -319,7 +319,7 @@
;; selected account has an unselected ancestor.
;;
;; display-depth: integer
-;;
+;;
;; the depth at which the account in the current row resides
;; in the display tree. note that this may differ from
;; account-depth when depth-limit-behavior is 'flatten.
@@ -327,18 +327,18 @@
;; accounts is level 0. this means that display-depth is also
;; the number of empty cells which should precede the account
;; name in the gnc:html-table being generated.
-;;
+;;
;; indented-depth: integer
-;;
+;;
;; the depth at which the account in the current row resides
;; in the indented display tree. also account-depth plus
;; indent. CAS: I think *display-depth* plus indent would
;; make more sense. Then it's like an absolute column index.
-;;
+;;
;; logical-cols: integer
-;;
+;;
;; the number of columns in which account labels were placed.
-;;
+;;
;; label-cols: integer
;;
;; the number of columns in the group of account columns to
@@ -347,74 +347,74 @@
;; table.
;;
;; account-cols: integer
-;;
+;;
;; the number of columns in the group of account columns. if
;; display-tree-depth is #f, this is the value of label-cols
;; plus any indent. if display-tree-depth is set, this is the
;; value of display-tree-depth, plus indent.
-;;
+;;
;; account-colspan: integer
-;;
+;;
;; the number of table columns which the account label of the
;; account in the current row should span in the
;; gnc:html-table being generated.
-;;
+;;
;; account-children: list of Accounts
-;;
+;;
;; a list of all children of the account in the current row.
-;;
+;;
;; account-bal: commodity-collector
-;;
+;;
;; the balance of the account in the current row, exclusive of
;; any balances in any subaccounts. this is for convenience.
-;;
+;;
;; recursive-bal: commodity-collector
-;;
+;;
;; the balance of the account in the current row, recursively
;; including all balances in any *selected* subaccounts. this
;; is for convenience.
-;;
+;;
;; CAS: I think these next two are wrong because they are really of
;; type gnc:monetary, not commodity-collectors.
;;
;; report-comm-account-bal: commodity-collector
-;;
+;;
;; the balance of the account in the current row, exclusive of
;; any balances in any subaccounts, converted to
;; report-commodity using exchange-fn. this is for
;; convenience.
-;;
+;;
;; report-comm-recursive-bal: commodity-collector
-;;
+;;
;; the balance of the account in the current row, recursively
;; including all balances in any *selected* subaccounts,
;; converted to report-commodity using exchange-fn. this is
;; for convenience.
-;;
+;;
;; account-commodity: commodity
-;;
+;;
;; returns the default commodity of the account in the current
-;; row, as returned by xaccAccountGetCommodity.
-;;
+;; row, as returned by xaccAccountGetCommodity.
+;;
;; account-type: account_type
-;;
+;;
;; returns the type of the account in the current row
-;;
+;;
;; account-type-string: string
-;;
+;;
;; returns the type of the account in the current row as a
;; string
-;;
-;; row-type: 'account-row 'subtotal-row
-;;
+;;
+;; row-type: 'account-row 'subtotal-row
+;;
;; indicates the nature of the current row. 'account-row
;; indicates that the current row represents an account
;; balance. 'subtotal-row indicates that it represents a
;; subtotal.
-;;
-;;
+;;
+;;
;; DIFFERENCES FROM PARAMETERS USED BY gnc:html-build-acct-table
-;;
+;;
;; The show-subaccounts? option of gnc:html-build-acct-table, which
;; used to select an accounts recursively like the "-R" option to ls,
;; has been removed. I find it both confusing, as a user, and
@@ -431,7 +431,7 @@
;; selection that which is closest to what the report user is likely
;; to select. It is my hope that a recursive account selection widget
;; will soon be implemented.
-;;
+;;
;; The group-types? option of gnc:html-build-acct-table, which
;; would display accounts by account type and supply header and
;; total lines for each type (see source), has been removed.
@@ -450,10 +450,10 @@
;; project. Since much of the code for this has already been written
;; (in gnc:html-build-acct-table), when the time comes, this
;; functionality should not be difficult to add.
-;;
-;;
+;;
+;;
;; INTERNALS
-;;
+;;
;; Internally, html-acct-table uses an html-table object to store
;; data. Since the html-acct-table object is arguably a more general
;; class than html-table, one might think that the html-table object
@@ -461,7 +461,7 @@
;; manipulation, and access. The html-table class, as it happens, was
;; written first, so the decision was made to use it rather than
;; redesign the horse around the carriage.
-;;
+;;
;; It may also be possible to have made html-acct-table a markup/style
;; sheet pair. To do this, the html-acct-table (which would
;; essentially be a markup object) would have to store thunks and call
@@ -471,12 +471,12 @@
;; object means that one can use it in a report generator in a
;; programmatic manner, keeping clear the separation between report
;; generation and stylization.
-;;
+;;
;; The first cell in each row of the html-table consist of an a-list
;; of row-parameters. These parameters are described in PARAMETERS
;; above. Any remaining cells in the row represent data set by the
;; user. This class simply maps its contents to the html-table.
-;;
+;;
(define-module (gnucash report html-acct-table))
@@ -547,13 +547,13 @@
(define (gnc:html-acct-table-add-accounts! acct-table accounts)
- ;;
+ ;;
;; This is where most of the html-acct-table functionality ends up....
- ;;
+ ;;
;; This function traverses the (current) account tree, adding
;; information about the selected accounts to acct-table.
- ;;
-
+ ;;
+
;; helper for fetching values from the key/val environment alist
(define (get-val alist key)
(let ((lst (assoc-ref alist key)))
@@ -572,45 +572,45 @@
(append (gnc:html-acct-table-get-row-env acct-table row) env)))
(let* ((env (gnc:_html-acct-table-env_ acct-table))
- ;; establish all input parameters and their defaults
- (depth-limit (let ((lim (get-val env 'display-tree-depth)))
+ ;; establish all input parameters and their defaults
+ (depth-limit (let ((lim (get-val env 'display-tree-depth)))
(and (number? lim) lim)))
- (limit-behavior (or (get-val env 'depth-limit-behavior) 'summarize))
- (indent (or (get-val env 'initial-indent) 0))
- (less-p (let ((pred (get-val env 'account-less-p)))
- (if (eq? pred #t) gnc:account-code-less-p pred)))
- (start-date (get-val env 'start-date))
- (end-date (or (get-val env 'end-date)
- (gnc:get-today)))
- (report-commodity (or (get-val env 'report-commodity)
- (gnc-default-report-currency)))
+ (limit-behavior (or (get-val env 'depth-limit-behavior) 'summarize))
+ (indent (or (get-val env 'initial-indent) 0))
+ (less-p (let ((pred (get-val env 'account-less-p)))
+ (if (eq? pred #t) gnc:account-code-less-p pred)))
+ (start-date (get-val env 'start-date))
+ (end-date (or (get-val env 'end-date)
+ (gnc:get-today)))
+ (report-commodity (or (get-val env 'report-commodity)
+ (gnc-default-report-currency)))
;; BUG: other code expects a real function here, maybe
;; someone was thinking price-source?
- (exchange-fn (get-val env 'exchange-fn))
+ (exchange-fn (get-val env 'exchange-fn))
(get-balance-fn (get-val env 'get-balance-fn))
- (column-header (let ((cell (get-val env 'column-header)))
- (if (eq? cell #t)
- (gnc:make-html-table-cell "Account name")
- cell)))
- (subtotal-mode (get-val env 'parent-account-subtotal-mode))
- (zero-mode (let ((mode (get-val env 'zero-balance-mode)))
- (if (boolean? mode) 'show-leaf-acct mode)))
- (label-mode (or (get-val env 'account-label-mode) 'anchor))
- (balance-mode (or (get-val env 'balance-mode) 'post-closing))
- (closing-pattern (or (get-val env 'closing-pattern)
- (list
- (list 'str (G_ "Closing Entries"))
- (list 'cased #f)
- (list 'regexp #f)
- (list 'closing #t))))
- (report-budget (or (get-val env 'report-budget) #f))
- ;; local variables
- (toplvl-accts
- (gnc-account-get-children-sorted (gnc-get-current-root-account)))
- (acct-depth-reached 0)
- (logi-depth-reached (if depth-limit (- depth-limit 1) 0))
- (disp-depth-reached 0)
- )
+ (column-header (let ((cell (get-val env 'column-header)))
+ (if (eq? cell #t)
+ (gnc:make-html-table-cell "Account name")
+ cell)))
+ (subtotal-mode (get-val env 'parent-account-subtotal-mode))
+ (zero-mode (let ((mode (get-val env 'zero-balance-mode)))
+ (if (boolean? mode) 'show-leaf-acct mode)))
+ (label-mode (or (get-val env 'account-label-mode) 'anchor))
+ (balance-mode (or (get-val env 'balance-mode) 'post-closing))
+ (closing-pattern (or (get-val env 'closing-pattern)
+ (list
+ (list 'str (G_ "Closing Entries"))
+ (list 'cased #f)
+ (list 'regexp #f)
+ (list 'closing #t))))
+ (report-budget (or (get-val env 'report-budget) #f))
+ ;; local variables
+ (toplvl-accts
+ (gnc-account-get-children-sorted (gnc-get-current-root-account)))
+ (acct-depth-reached 0)
+ (logi-depth-reached (if depth-limit (- depth-limit 1) 0))
+ (disp-depth-reached 0)
+ )
;; the following function was adapted from html-utilities.scm
@@ -849,9 +849,9 @@
(define (gnc:html-acct-table-set-row-env! acct-table row env)
(gnc:html-acct-table-set-cell! acct-table row -1 env))
-;;
+;;
;; Here are some standard functions to help process gnc:html-acct-tables.
-;;
+;;
(define (gnc:html-make-nbsps n)
(let lp ((n n) (res '()))
@@ -872,57 +872,57 @@
(define (gnc:html-table-add-labeled-amount-line!
;; function to add a label and/or amount (which we'll call a "line")
;; to the end of a gnc:html-table. all depths are zero-indexed.
- html-table
+ html-table
table-width ;; if #f defaults to (amount-depth + amount-colspan)
row-markup ;; optional
total-rule? ;; Place an <hr> in the cell previous to label?
- label ;; the actual label text
+ label ;; the actual label text
label-depth ;; defaults to zero
label-colspan ;; defaults to one
label-markup ;; optional
- amount ;; a <gnc:monetary> or #f
+ amount ;; a <gnc:monetary> or #f
amount-depth ;; defaults to (label-depth + label-colspan)
amount-colspan ;; defaults to one
amount-markup) ;; optional
(let* ((lbl-depth (or label-depth 0))
- (lbl-colspan 1)
- (amt-depth (or amount-depth (+ lbl-depth lbl-colspan)))
- (amt-colspan 1)
- (tbl-width (or table-width (+ amt-depth amt-colspan)))
- (row
- (append
- (list
- (if label-markup ;; the actual label
- (gnc:make-html-table-cell/size/markup
- 1 1 label-markup (gnc:make-html-text (gnc:html-make-nbsps lbl-depth)) label)
- (gnc:make-html-table-cell/size
- 1 1 (gnc:make-html-text (gnc:html-make-nbsps lbl-depth)) label))
- )
- (gnc:html-make-empty-cells ;; padding after label
+ (lbl-colspan 1)
+ (amt-depth (or amount-depth (+ lbl-depth lbl-colspan)))
+ (amt-colspan 1)
+ (tbl-width (or table-width (+ amt-depth amt-colspan)))
+ (row
+ (append
+ (list
+ (if label-markup ;; the actual label
+ (gnc:make-html-table-cell/size/markup
+ 1 1 label-markup (gnc:make-html-text (gnc:html-make-nbsps lbl-depth)) label)
+ (gnc:make-html-table-cell/size
+ 1 1 (gnc:make-html-text (gnc:html-make-nbsps lbl-depth)) label))
+ )
+ (gnc:html-make-empty-cells ;; padding after label
(+ (- amt-depth (floor (/ tbl-width 2)))
(if total-rule? -1 0)
)
)
- (if total-rule? ;; include <hr>?
- (list (gnc:make-html-table-cell
- (gnc:make-html-text (gnc:html-markup-hr))))
- (list)
- )
- (list
- (if amount-markup ;; the amount
- (gnc:make-html-table-cell/size/markup
- 1 amt-colspan amount-markup amount)
- (gnc:make-html-table-cell/size
- 1 amt-colspan amount))
- )
- (gnc:html-make-empty-cells ;; padding out to full width
- (- tbl-width (+ amt-depth amt-colspan)))
- )
+ (if total-rule? ;; include <hr>?
+ (list (gnc:make-html-table-cell
+ (gnc:make-html-text (gnc:html-markup-hr))))
+ (list)
+ )
+ (list
+ (if amount-markup ;; the amount
+ (gnc:make-html-table-cell/size/markup
+ 1 amt-colspan amount-markup amount)
+ (gnc:make-html-table-cell/size
+ 1 amt-colspan amount))
+ )
+ (gnc:html-make-empty-cells ;; padding out to full width
+ (- tbl-width (+ amt-depth amt-colspan)))
+ )
) ;; end of row
- )
+ )
(if row-markup
- (gnc:html-table-append-row/markup! html-table row-markup row)
- (gnc:html-table-append-row! html-table row))))
+ (gnc:html-table-append-row/markup! html-table row-markup row)
+ (gnc:html-table-append-row! html-table row))))
(define (gnc-commodity-table amount report-commodity exchange-fn)
;; this creates a small two-column table listing each commodity
@@ -939,9 +939,9 @@
(for-each
(lambda (bal)
(gnc:html-table-append-row!
- table (list (gnc:make-html-table-cell/markup "number-cell" bal)
+ table (list (gnc:make-html-table-cell/markup "number-cell" bal)
spacer
- (gnc:make-html-table-cell/markup
+ (gnc:make-html-table-cell/markup
"number-cell" (exchange-fn bal report-commodity)))))
list-of-balances)
(gnc:html-table-set-style! table "table"
@@ -949,60 +949,60 @@
'attribute (list "cellpadding" "0"))
table))
-;;
+;;
;; This function adds all the lines from a gnc:html-acct-table to a
;; gnc:html-table in "labeled amount" form. IOW, it uses
;; gnc:html-table-add-labeled-amount-line!
-;;
+;;
;; The returned gnc:html-table is similar to what
;; gnc:html-build-acct-table used to (and still should) produce.
-;;
+;;
;; this function accepts the following additional parameters:
;; parent-account-balance-mode: 'immediate-bal 'recursive-bal ['omit-bal/#f]
;; zero-balance-display-mode: ['show-balance] 'omit-balance
;; multicommodity-mode: [#f] 'table/#t
;; rule-mode: #t [#f] (not meant to affect subtotal rules)
-;;
+;;
(define (gnc:html-table-add-account-balances
html-table ;; can be #f to create a new table
acct-table
params)
(let* ((num-rows (gnc:html-acct-table-num-rows acct-table))
- (rownum 0)
- (html-table (or html-table (gnc:make-html-table)))
- (get-val (lambda (alist key)
- (let ((lst (assoc-ref alist key)))
- (if lst (car lst) lst))))
- )
-
+ (rownum 0)
+ (html-table (or html-table (gnc:make-html-table)))
+ (get-val (lambda (alist key)
+ (let ((lst (assoc-ref alist key)))
+ (if lst (car lst) lst))))
+ )
+
(while (< rownum num-rows)
- (let* ((env (append
- (gnc:html-acct-table-get-row-env acct-table rownum)
- params))
- (acct (get-val env 'account))
- (children (get-val env 'account-children))
- (label (get-val env 'account-label))
- (acct-name (get-val env 'account-name)) ;; for diagnostics...
- (report-commodity (get-val env 'report-commodity))
- (exchange-fn (get-val env 'exchange-fn))
- (account-cols (get-val env 'account-cols))
- (logical-cols (get-val env 'logical-cols))
- (label-cols (get-val env 'label-cols))
- (logical-depth (get-val env 'logical-depth))
- (display-depth (get-val env 'display-depth))
- (display-tree-depth (get-val env 'display-tree-depth))
- (row-type (get-val env 'row-type))
- (rule-mode (and (equal? row-type 'subtotal-row)
- (get-val env 'rule-mode)))
- (row-markup (and (equal? row-type 'subtotal-row)
- "primary-subheading"))
- (multicommodity-mode (get-val env 'multicommodity-mode))
- (limit-behavior
- (or (get-val env 'depth-limit-behavior)
- 'summarize))
- (parent-acct-bal-mode
- (or (get-val env 'parent-account-balance-mode)
- 'omit-bal))
+ (let* ((env (append
+ (gnc:html-acct-table-get-row-env acct-table rownum)
+ params))
+ (acct (get-val env 'account))
+ (children (get-val env 'account-children))
+ (label (get-val env 'account-label))
+ (acct-name (get-val env 'account-name)) ;; for diagnostics...
+ (report-commodity (get-val env 'report-commodity))
+ (exchange-fn (get-val env 'exchange-fn))
+ (account-cols (get-val env 'account-cols))
+ (logical-cols (get-val env 'logical-cols))
+ (label-cols (get-val env 'label-cols))
+ (logical-depth (get-val env 'logical-depth))
+ (display-depth (get-val env 'display-depth))
+ (display-tree-depth (get-val env 'display-tree-depth))
+ (row-type (get-val env 'row-type))
+ (rule-mode (and (equal? row-type 'subtotal-row)
+ (get-val env 'rule-mode)))
+ (row-markup (and (equal? row-type 'subtotal-row)
+ "primary-subheading"))
+ (multicommodity-mode (get-val env 'multicommodity-mode))
+ (limit-behavior
+ (or (get-val env 'depth-limit-behavior)
+ 'summarize))
+ (parent-acct-bal-mode
+ (or (get-val env 'parent-account-balance-mode)
+ 'omit-bal))
(bal-method
;; figure out how to calculate our balance:
@@ -1041,31 +1041,31 @@
(gnc:sum-collector-commodity amt report-commodity exchange-fn))))
(indented-depth (get-val env 'indented-depth))
- (account-colspan (get-val env 'account-colspan))
- )
+ (account-colspan (get-val env 'account-colspan))
+ )
;; for each row do:
- (gnc:html-table-add-labeled-amount-line!
- html-table
- (+ account-cols logical-cols) ;; table-width
- row-markup ;; row-markup
+ (gnc:html-table-add-labeled-amount-line!
+ html-table
+ (+ account-cols logical-cols) ;; table-width
+ row-markup ;; row-markup
rule-mode
- label
+ label
indented-depth
account-colspan ;; label-colspan
"anchor-cell" ;; label-markup
- amount
- (+ account-cols (- 0 1)
- (- logical-cols display-depth)
- ) ;; amount-depth
- 1 ;; amount-colspan
+ amount
+ (+ account-cols (- 0 1)
+ (- logical-cols display-depth)
+ ) ;; amount-depth
+ 1 ;; amount-colspan
"number-cell" ;; amount-markup
)
- (set! rownum (+ rownum 1)) ;; increment rownum
- )
- ) ;; end of while
+ (set! rownum (+ rownum 1)) ;; increment rownum
+ )
+ ) ;; end of while
html-table
)
)
diff --git a/gnucash/report/html-table.scm b/gnucash/report/html-table.scm
index c62bae3fd1..d8d4b9047c 100644
--- a/gnucash/report/html-table.scm
+++ b/gnucash/report/html-table.scm
@@ -1,20 +1,20 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; html-table.scm : generate HTML programmatically, with support
-;; for simple style elements.
+;; for simple style elements.
;; Copyright 2000 Bill Gribble <grib at gnumatic.com>
-;;
+;;
;; * 2004.06.18: David Montenegro, added gnc:html-table-get-cell
-;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -100,13 +100,13 @@
(export gnc:html-table-render)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
+;;
;; NB: In this code, "markup" and "/markup" *do not* refer to
;; style information. Rather, they let you override the tag
;; associated with an html-table row or cell. Style
;; information is stored in addition to this "markup" (in
;; an entirely different record field).
-;;
+;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type <html-table>
@@ -171,7 +171,7 @@
(define gnc:html-table-cell-set-style-internal! html-table-cell-set-style!)
(define (gnc:make-html-table-cell . objects)
- (gnc:make-html-table-cell-internal 1 1 "td" objects
+ (gnc:make-html-table-cell-internal 1 1 "td" objects
(gnc:make-html-style-table)))
(define (gnc:make-html-table-cell/size rowspan colspan . objects)
@@ -179,7 +179,7 @@
objects (gnc:make-html-style-table)))
(define (gnc:make-html-table-cell/markup markup . objects)
- (gnc:make-html-table-cell-internal 1 1 markup objects
+ (gnc:make-html-table-cell-internal 1 1 markup objects
(gnc:make-html-style-table)))
(define (gnc:make-html-table-cell/size/markup rowspan colspan markup . objects)
@@ -193,11 +193,11 @@
cell))
(define (gnc:make-html-table-header-cell . objects)
- (gnc:make-html-table-cell-internal 1 1 "th" objects
+ (gnc:make-html-table-cell-internal 1 1 "th" objects
(gnc:make-html-style-table)))
(define (gnc:make-html-table-header-cell/markup markup . objects)
- (gnc:make-html-table-cell-internal 1 1 markup objects
+ (gnc:make-html-table-cell-internal 1 1 markup objects
(gnc:make-html-style-table)))
(define (gnc:make-html-table-header-cell/size rowspan colspan . objects)
@@ -212,7 +212,7 @@
(gnc:html-style-table-set! styletable tag newstyle)))
(define (gnc:html-table-cell-append-objects! cell . objects)
- (gnc:html-table-cell-set-data-internal!
+ (gnc:html-table-cell-set-data-internal!
cell (append (gnc:html-table-cell-data cell) objects)))
(define (gnc:html-table-cell-render cell doc)
@@ -253,14 +253,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:make-html-table)
- (gnc:make-html-table-internal
- #f ;; col-headers
- #f ;; row-headers
- #f ;; caption
+ (gnc:make-html-table-internal
+ #f ;; col-headers
+ #f ;; row-headers
+ #f ;; caption
'() ;; data (stored in reverse row-major order)
0 ;; num-rows
(gnc:make-html-style-table) ;; style
- (make-hash-table 21) ;; hash of col number to col-style
+ (make-hash-table 21) ;; hash of col number to col-style
(make-hash-table 21) ;; hash of row number to row-style
(make-hash-table 21) ;; hash of row number to row markup
(gnc:make-html-style-table) ;; col-headers-style
@@ -337,11 +337,11 @@
(define (gnc:html-table-prepend-row/markup! table markup newrow)
(gnc:html-table-prepend-row! table newrow)
(gnc:html-table-set-row-markup! table 0 markup))
-
+
(define (gnc:html-table-append-row! table newrow)
(let* ((current-num-rows (gnc:html-table-num-rows table))
- (new-num-rows (1+ current-num-rows)))
+ (new-num-rows (1+ current-num-rows)))
(gnc:html-table-set-num-rows-internal! table new-num-rows)
(gnc:html-table-set-data! table
(cons (if (list? newrow) newrow (list newrow))
diff --git a/gnucash/report/html-utilities.scm b/gnucash/report/html-utilities.scm
index 10d914b76b..12ae13761c 100644
--- a/gnucash/report/html-utilities.scm
+++ b/gnucash/report/html-utilities.scm
@@ -1,19 +1,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; html-utilities.scm: Useful functions when using the HTML generator.
-;;
+;;
;; Modified slightly by David Montenegro 2004.06.18.
-;;
+;;
;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -72,7 +72,7 @@
(export gnc:html-js-include)
(export gnc:html-css-include)
-;; returns a list with n #f (empty cell) values
+;; returns a list with n #f (empty cell) values
(define (gnc:html-make-empty-cell) #f)
(define (gnc:html-make-empty-cells n)
(if (> n 0)
@@ -101,13 +101,13 @@
(define (gnc:report-anchor-text report-id)
(gnc-build-url URL-TYPE-REPORT
- (string-append "id=" (number->string report-id))
- ""))
+ (string-append "id=" (number->string report-id))
+ ""))
(define (gnc:price-anchor-text price)
(gnc-build-url URL-TYPE-PRICE
- (string-append "price-guid=" (gncPriceGetGUID price))
- ""))
+ (string-append "price-guid=" (gncPriceGetGUID price))
+ ""))
(define (guid-ref idstr type guid)
(gnc-build-url type (string-append idstr guid) ""))
@@ -166,19 +166,19 @@
;; according to 'optionlist'. Each element of optionlist is a list of
;; section, name, and value of the function.
(define (gnc:make-report-anchor reportname src-report
- optionlist)
+ optionlist)
(let ((src-options (gnc:report-options src-report))
- (options (gnc:make-report-options reportname)))
+ (options (gnc:make-report-options reportname)))
(if options
- (begin
- (gnc:options-copy-values src-options options)
- (for-each
- (lambda (l)
+ (begin
+ (gnc:options-copy-values src-options options)
+ (for-each
+ (lambda (l)
(gnc-set-option (gnc:optiondb options) (car l) (cadr l) (caddr l)))
- optionlist)
- (let ((id (gnc:make-report reportname options)))
- (gnc:report-anchor-text id)))
- (warn "gnc:make-report-anchor: No such report: " reportname))))
+ optionlist)
+ (let ((id (gnc:make-report reportname options)))
+ (gnc:report-anchor-text id)))
+ (warn "gnc:make-report-anchor: No such report: " reportname))))
;; returns the account name as html-text and anchor to the register.
@@ -215,9 +215,9 @@
(gnc:make-html-text (if price
(gnc:html-markup-anchor
(gnc:price-anchor-text price)
- (if value
- value
- (gnc-price-get-value price)))
+ (if value
+ value
+ (gnc-price-get-value price)))
value)))
(define (gnc:assign-colors num-colors)
@@ -400,6 +400,3 @@
(format #f
"<link rel=\"stylesheet\" type=\"text/css\" href=~s />\n"
(make-uri (gnc-resolve-file-path file))))
-
-
-
diff --git a/gnucash/report/options-utilities.scm b/gnucash/report/options-utilities.scm
index 88161fe3a7..eb81c1272f 100644
--- a/gnucash/report/options-utilities.scm
+++ b/gnucash/report/options-utilities.scm
@@ -1,18 +1,18 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; options-utilities.scm: Useful option helper functions.
-;;
+;;
;; By Christian Stimming <stimming at tu-harburg.de>
;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -46,21 +46,21 @@
;; This is one single end-date of a report.
(define (gnc:options-add-report-date!
- options pagename optname sort-tag)
+ options pagename optname sort-tag)
(gnc-register-end-date-option (gnc:optiondb options) pagename optname sort-tag
- (N_ "Select a date to report on.")))
+ (N_ "Select a date to report on.")))
;; This is a date-interval for a report.
(define (gnc:options-add-date-interval!
- options pagename name-from name-to sort-tag)
+ options pagename name-from name-to sort-tag)
(gnc:options-make-date-interval! options pagename
- name-from (N_ "Start of reporting period.")
- name-to (N_ "End of reporting period.")
- sort-tag))
+ name-from (N_ "Start of reporting period.")
+ name-to (N_ "End of reporting period.")
+ sort-tag))
;; A date interval multichoice option.
-(define (gnc:options-add-interval-choice!
- options pagename optname sort-tag default)
+(define (gnc:options-add-interval-choice!
+ options pagename optname sort-tag default)
(gnc-register-multichoice-option (gnc:optiondb options)
pagename optname
sort-tag (N_ "The amount of time between data points.")
@@ -76,9 +76,9 @@
;; A multichoice option intended to chose the account level. Different
;; from the other functions the help string can still be given. Used
;; below.
-(define (gnc:options-add-account-levels!
- options pagename name-display-depth
- sort-tag help-string default-depth)
+(define (gnc:options-add-account-levels!
+ options pagename name-display-depth
+ sort-tag help-string default-depth)
(gnc-register-multichoice-option
(gnc:optiondb options)
pagename name-display-depth sort-tag help-string
@@ -93,20 +93,20 @@
(vector 6 "6"))))
;; These help for selecting a bunch of accounts.
-(define (gnc:options-add-account-selection!
- options pagename
- name-display-depth name-show-subaccounts name-accounts
- sort-tag default-depth default-accounts default-show-subaccounts)
+(define (gnc:options-add-account-selection!
+ options pagename
+ name-display-depth name-show-subaccounts name-accounts
+ sort-tag default-depth default-accounts default-show-subaccounts)
(gnc:options-add-account-levels!
- options pagename name-display-depth
+ options pagename name-display-depth
(string-append sort-tag "a")
- (N_ "Show accounts to this depth, overriding any other option.")
+ (N_ "Show accounts to this depth, overriding any other option.")
default-depth)
-
+
(gnc-register-simple-boolean-option (gnc:optiondb options)
pagename name-show-subaccounts
(string-append sort-tag "b")
- (N_ "Override account-selection and show sub-accounts of all selected accounts?")
+ (N_ "Override account-selection and show sub-accounts of all selected accounts?")
default-show-subaccounts)
;; Semantics of the account selection, as used in the
@@ -122,7 +122,7 @@
;; To let the user select a currency for the report.
(define (gnc:options-add-currency!
- options pagename name-report-currency sort-tag)
+ options pagename name-report-currency sort-tag)
(gnc-register-currency-option (gnc:optiondb options)
pagename name-report-currency
sort-tag
@@ -131,7 +131,7 @@
;; A multichoice option for the source of prices
(define (gnc:options-add-price-source!
- options pagename optname sort-tag default)
+ options pagename optname sort-tag default)
(gnc-register-multichoice-option
(gnc:optiondb options)
pagename optname
@@ -145,9 +145,9 @@
;; The width- and height- options for charts
(define (gnc:options-add-plot-size!
- options pagename
- name-width name-height sort-tag
- default-width default-height)
+ options pagename
+ name-width name-height sort-tag
+ default-width default-height)
(let* ((widthv (evaluate default-width))
(heightv (evaluate default-height))
(width (if (pair? widthv) (cdr widthv) widthv))
@@ -166,9 +166,9 @@
;; A multicoice option for the marker of a scatter plot.
(define (gnc:options-add-marker-choice!
- options pagename optname sort-tag default)
+ options pagename optname sort-tag default)
(gnc-register-multichoice-option (gnc:optiondb options)
- pagename optname
+ pagename optname
sort-tag
(N_ "Choose the marker for each data point.")
(symbol->string (evaluate default))
@@ -184,9 +184,9 @@
(vector 'filledsquare (N_ "Filled square")))))
(define (gnc:options-add-sort-method!
- options pagename optname sort-tag default)
+ options pagename optname sort-tag default)
(gnc-register-multichoice-option (gnc:optiondb options)
- pagename optname
+ pagename optname
sort-tag
(N_ "Choose the method for sorting accounts.")
(symbol->string (evaluate default))
@@ -198,12 +198,12 @@
;; These control the calculation and view mode of subtotal balances
(define (gnc:options-add-subtotal-view!
- options pagename
- optname-parent-balance-mode optname-parent-total-mode
- sort-tag)
+ options pagename
+ optname-parent-balance-mode optname-parent-total-mode
+ sort-tag)
;; what to show for non-leaf accounts
(gnc-register-multichoice-option (gnc:optiondb options)
- pagename
+ pagename
;; usually the option name is: (N_ "Parent account balances")
optname-parent-balance-mode
(string-append sort-tag "a")
diff --git a/gnucash/report/report-utilities.scm b/gnucash/report/report-utilities.scm
index 5ecb9917a1..97b15f21c9 100644
--- a/gnucash/report/report-utilities.scm
+++ b/gnucash/report/report-utilities.scm
@@ -1,15 +1,15 @@
;; report-utilities.scm -- Reporting utilities
;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
@@ -126,7 +126,7 @@
;; html-renderer.
(define (gnc:monetary->string value)
(xaccPrintAmount
- (gnc:gnc-monetary-amount value)
+ (gnc:gnc-monetary-amount value)
(gnc-commodity-print-info (gnc:gnc-monetary-commodity value) #t)))
;; True if the account is of type currency, stock, or mutual-fund
@@ -160,9 +160,9 @@
;; Returns only those accounts out of the list <accounts> which have
;; one of the type identifiers in typelist.
(define (gnc:filter-accountlist-type typelist accounts)
- (filter (lambda (a)
- (and (not (null? a)) (member (xaccAccountGetType a) typelist)))
- accounts))
+ (filter (lambda (a)
+ (and (not (null? a)) (member (xaccAccountGetType a) typelist)))
+ accounts))
;; Decompose a given list of accounts 'accounts' into an alist
;; according to their types. Each element of alist is a list, whose
@@ -171,29 +171,29 @@
;; category.
(define (gnc:decompose-accountlist accounts)
(map (lambda (x) (cons
- (car x)
- (gnc:filter-accountlist-type (cdr x) accounts)))
+ (car x)
+ (gnc:filter-accountlist-type (cdr x) accounts)))
(list
- (cons ACCT-TYPE-ASSET
- (list ACCT-TYPE-ASSET ACCT-TYPE-BANK ACCT-TYPE-CASH
+ (cons ACCT-TYPE-ASSET
+ (list ACCT-TYPE-ASSET ACCT-TYPE-BANK ACCT-TYPE-CASH
ACCT-TYPE-CHECKING ACCT-TYPE-SAVINGS
ACCT-TYPE-MONEYMRKT ACCT-TYPE-RECEIVABLE
ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL
ACCT-TYPE-CURRENCY))
- (cons ACCT-TYPE-LIABILITY
+ (cons ACCT-TYPE-LIABILITY
(list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE ACCT-TYPE-CREDIT
ACCT-TYPE-CREDITLINE))
- (cons ACCT-TYPE-EQUITY (list ACCT-TYPE-EQUITY))
- (cons ACCT-TYPE-INCOME (list ACCT-TYPE-INCOME))
- (cons ACCT-TYPE-EXPENSE (list ACCT-TYPE-EXPENSE))
- (cons ACCT-TYPE-TRADING (list ACCT-TYPE-TRADING)))))
+ (cons ACCT-TYPE-EQUITY (list ACCT-TYPE-EQUITY))
+ (cons ACCT-TYPE-INCOME (list ACCT-TYPE-INCOME))
+ (cons ACCT-TYPE-EXPENSE (list ACCT-TYPE-EXPENSE))
+ (cons ACCT-TYPE-TRADING (list ACCT-TYPE-TRADING)))))
;; Returns the name of the account type as a string, and in its plural
;; form (as opposed to xaccAccountGetTypeStr which gives the
;; singular form of the word).
(define (gnc:account-get-type-string-plural type)
(assoc-ref
- (list
+ (list
(cons ACCT-TYPE-BANK (G_ "Bank"))
(cons ACCT-TYPE-CASH (G_ "Cash"))
(cons ACCT-TYPE-CREDIT (G_ "Credits"))
@@ -218,7 +218,7 @@
;; 'accounts', excluding the 'exclude-commodity'.
(define (gnc:accounts-get-commodities accounts exclude-commodity)
(delete exclude-commodity
- (sort-and-delete-duplicates
+ (sort-and-delete-duplicates
(map xaccAccountGetCommodity accounts)
(lambda (a b)
(gnc:string-locale<? (gnc-commodity-get-unique-name a)
@@ -266,10 +266,10 @@
(let ((value 0))
(lambda (action amount)
(case action
- ((add) (if (number? amount)
+ ((add) (if (number? amount)
(set! value (+ amount value))))
- ((total) value)
- (else (gnc:warn "bad value-collector action: " action))))))
+ ((total) value)
+ (else (gnc:warn "bad value-collector action: " action))))))
;; A commodity collector. This is intended to handle multiple
;; currencies' amounts. The amounts are accumulated via 'add, the
@@ -287,7 +287,7 @@
;; Note amounts are rounded to the commodity's SCU.
;;
;; The functions:
-;; 'add <commodity> <amount>: Add the given amount to the
+;; 'add <commodity> <amount>: Add the given amount to the
;; appropriate currencies' total balance.
;; 'format <fn> #f: Call the function <fn> (where fn takes two
;; arguments) for each commodity with the arguments <commodity>
@@ -296,11 +296,11 @@
;; 'merge <commodity-collector> #f: Merge the given other
;; commodity-collector into this one, adding all currencies'
;; balances, respectively.
-;; 'minusmerge <commodity-collector> #f: Merge the given other
+;; 'minusmerge <commodity-collector> #f: Merge the given other
;; commodity-collector into this one (like above) but subtract
;; the other's currencies' balance from this one's balance,
;; respectively.
-;; 'reset #f #f: Delete everything that has been accumulated
+;; 'reset #f #f: Delete everything that has been accumulated
;; (even the fact that any commodity showed up at all).
;; 'getpair <commodity> signreverse?: Returns the two-element-list
;; with the <commodity> and its corresponding balance. If
@@ -316,32 +316,32 @@
(define (gnc:make-commodity-collector)
;; the association list of (commodity . value-collector) pairs.
(let ((commoditylist '()))
-
+
;; helper function to add a (commodity . value) pair to our list.
;; If no pair with this commodity exists, we will create one.
(define (add-commodity-value commodity value)
(let ((pair (assoc commodity commoditylist)))
- (unless pair
- (set! pair (list commodity (gnc:make-value-collector)))
- (set! commoditylist (cons pair commoditylist)))
- ((cadr pair) 'add value)))
-
+ (unless pair
+ (set! pair (list commodity (gnc:make-value-collector)))
+ (set! commoditylist (cons pair commoditylist)))
+ ((cadr pair) 'add value)))
+
;; helper function to walk an association list, adding each
;; (commodity . collector) pair to our list at the appropriate
;; place
(define (add-commodity-clist clist)
(cond ((null? clist) '())
- (else (add-commodity-value
- (caar clist)
- ((cadar clist) 'total #f))
- (add-commodity-clist (cdr clist)))))
+ (else (add-commodity-value
+ (caar clist)
+ ((cadar clist) 'total #f))
+ (add-commodity-clist (cdr clist)))))
(define (minus-commodity-clist clist)
(cond ((null? clist) '())
- (else (add-commodity-value
- (caar clist)
- (- ((cadar clist) 'total #f)))
- (minus-commodity-clist (cdr clist)))))
+ (else (add-commodity-value
+ (caar clist)
+ (- ((cadar clist) 'total #f)))
+ (minus-commodity-clist (cdr clist)))))
;; helper function walk the association list doing a callback on
;; each key-value pair.
@@ -356,29 +356,29 @@
(define (getpair c sign?)
(let* ((pair (assoc c commoditylist))
(total (if pair ((cadr pair) 'total #f) 0)))
- (list c (if sign? (- total) total))))
+ (list c (if sign? (- total) total))))
;; helper function which is given a commodity and returns a
;; <gnc:monetary> value, whose amount may be 0.
(define (getmonetary c sign?)
(let* ((pair (assoc c commoditylist))
(total (if pair ((cadr pair) 'total #f) 0)))
- (gnc:make-gnc-monetary c (if sign? (- total) total))))
-
+ (gnc:make-gnc-monetary c (if sign? (- total) total))))
+
;; Dispatch function
(lambda (action commodity amount)
(case action
- ((add) (add-commodity-value commodity amount))
- ((merge) (add-commodity-clist
+ ((add) (add-commodity-value commodity amount))
+ ((merge) (add-commodity-clist
(commodity 'list #f #f)))
- ((minusmerge) (minus-commodity-clist
+ ((minusmerge) (minus-commodity-clist
(commodity 'list #f #f)))
- ((format) (process-commodity-list commodity commoditylist))
- ((reset) (set! commoditylist '()))
- ((getpair) (getpair commodity amount))
- ((getmonetary) (getmonetary commodity amount))
- ((list) commoditylist) ; this one is only for internal use
- (else (gnc:warn "bad commodity-collector action: " action))))))
+ ((format) (process-commodity-list commodity commoditylist))
+ ((reset) (set! commoditylist '()))
+ ((getpair) (getpair commodity amount))
+ ((getmonetary) (getmonetary commodity amount))
+ ((list) commoditylist) ; this one is only for internal use
+ (else (gnc:warn "bad commodity-collector action: " action))))))
(define (gnc:commodity-collector-get-negated collector)
(let ((negated (gnc:make-commodity-collector)))
@@ -508,7 +508,7 @@
(let ((head-result (split->elt (car splits))))
(lp (cdr splits) rest (cons head-result result) head-result))))))))
-;; This works similar as above but returns a commodity-collector,
+;; This works similar as above but returns a commodity-collector,
;; thus takes care of children accounts with different currencies.
(define (gnc:account-get-comm-balance-at-date
account date include-children?)
@@ -575,10 +575,10 @@
;; (e.g. gnc-reverse-balance) should return #t if the
;; account's balance sign should get reversed. Returns a
;; commodity-collector.
-(define (gnc:accounts-get-balance-helper
- accounts get-balance-fn reverse-balance-fn)
+(define (gnc:accounts-get-balance-helper
+ accounts get-balance-fn reverse-balance-fn)
(let ((collector (gnc:make-commodity-collector)))
- (for-each
+ (for-each
(lambda (acct)
(collector
(if (reverse-balance-fn acct) 'minusmerge 'merge)
@@ -592,11 +592,11 @@
;; the get-balance-fn. Intended for usage with a balance sheet, hence
;; a) the income/expense accounts are ignored, and b) no signs are
;; reversed at all. Returns a commodity-collector.
-(define (gnc:accounts-get-comm-total-assets accounts
- get-balance-fn)
+(define (gnc:accounts-get-comm-total-assets accounts
+ get-balance-fn)
(gnc:accounts-get-balance-helper
(filter (lambda (a) (not (gnc:account-is-inc-exp? a)))
- accounts)
+ accounts)
get-balance-fn
(lambda(x) #f)))
@@ -636,17 +636,17 @@
(define (gnc:report-starting report-name)
(gnc-window-show-progress (format #f
- (G_ "Building '~a' report …")
- (G_ report-name))
- 0))
+ (G_ "Building '~a' report …")
+ (G_ report-name))
+ 0))
(define (gnc:report-render-starting report-name)
(gnc-window-show-progress (format #f
- (G_ "Rendering '~a' report …")
- (if (string-null? report-name)
- (G_ "Untitled")
- (G_ report-name)))
- 0))
+ (G_ "Rendering '~a' report …")
+ (if (string-null? report-name)
+ (G_ "Untitled")
+ (G_ report-name)))
+ 0))
(define (gnc:report-percent-done percent)
(if (> percent 100)
@@ -702,7 +702,7 @@
;; Return the splits that match an account list, date range, and (optionally) type
;; where type is defined as an alist like:
;; '((str "match me") (cased #f) (regexp #f) (closing #f))
-;; where str, cased, and regexp define a pattern match on transaction deseriptions
+;; where str, cased, and regexp define a pattern match on transaction deseriptions
;; and "closing" matches transactions created by the book close command. If "closing"
;; is given as #t then only closing transactions will be returned, if it is #f then
;; only non-closing transactions will be returned, and if it is omitted then both
Summary of changes:
gnucash/report/html-acct-table.scm | 474 +++++------
gnucash/report/html-table.scm | 54 +-
gnucash/report/html-utilities.scm | 63 +-
gnucash/report/options-utilities.scm | 86 +-
gnucash/report/report-utilities.scm | 146 ++--
gnucash/report/reports/example/average-balance.scm | 94 +--
gnucash/report/reports/example/daily-reports.scm | 30 +-
gnucash/report/reports/example/sample-report.scm | 4 +-
.../reports/locale-specific/de_DE/taxtxf.scm | 240 +++---
.../report/reports/locale-specific/us/taxtxf.scm | 4 +-
.../report/reports/standard/account-piecharts.scm | 80 +-
.../report/reports/standard/advanced-portfolio.scm | 884 ++++++++++-----------
gnucash/report/reports/standard/balance-sheet.scm | 2 +-
.../reports/standard/budget-balance-sheet.scm | 366 ++++-----
.../reports/standard/budget-income-statement.scm | 168 ++--
.../report/reports/standard/equity-statement.scm | 282 +++----
.../report/reports/standard/income-statement.scm | 190 ++---
gnucash/report/reports/standard/portfolio.scm | 58 +-
gnucash/report/reports/standard/price-scatter.scm | 2 +-
gnucash/report/reports/standard/taxinvoice.scm | 153 ++--
.../reports/standard/test/test-cash-flow.scm | 174 ++--
gnucash/report/reports/standard/view-column.scm | 190 ++---
gnucash/report/test/test-report-utilities.scm | 18 +-
gnucash/report/test/test-test-extras.scm | 14 +-
24 files changed, 1886 insertions(+), 1890 deletions(-)
More information about the gnucash-changes
mailing list