IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

reports/standard/* untabify/delete-trailing-whitespace

Browse Source
This commit is contained in:
Christopher Lam 2023-04-20 09:00:32 +08:00
parent 1302c31498
commit 7b3702e7e6
12 changed files with 1251 additions and 1252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
gnucash/report/reports/standard/account-piecharts.scm
View File

@ -1,19 +1,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; account-piecharts.scm: shows piechart of accounts
;;
;; By Robert Merkel (rgmerk@mira.net)
;;
;; By Robert Merkel (rgmerk@mira.net)
;; and Christian Stimming <stimming@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)))

842
gnucash/report/reports/standard/advanced-portfolio.scm
View File

File diff suppressed because it is too large Load Diff

2
gnucash/report/reports/standard/balance-sheet.scm
View File

@ -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)

366
gnucash/report/reports/standard/budget-balance-sheet.scm
View File

@ -9,16 +9,16 @@
;; David Montenegro <sunrise2000@comcast.net>
;; Christian Stimming <stimming@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"

168
gnucash/report/reports/standard/budget-income-statement.scm
View File

@ -1,32 +1,32 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-income-statement.scm: income statement (a.k.a. Profit & Loss)
;;
;;
;; Copyright (c) the following:
;;
;; Forest Bond <forest@alittletooquiet.net>
;; David Montenegro <sunrise2000@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"

282
gnucash/report/reports/standard/equity-statement.scm
View File

@ -1,41 +1,41 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; equity-statement.scm: statement of owner's equity (net worth)
;;
;;
;; By David Montenegro 2004.06.23 <sunrise2000@comcast.net>
;;
;;
;; * Based on balance-sheet.scm by Robert Merkel <rgmerk@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"

190
gnucash/report/reports/standard/income-statement.scm
View File

@ -1,33 +1,33 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; income-statement.scm: income statement (a.k.a. Profit & Loss)
;;
;;
;; By David Montenegro <sunrise2000@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"

58
gnucash/report/reports/standard/portfolio.scm
View File

@ -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)))

2
gnucash/report/reports/standard/price-scatter.scm
View File

@ -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)))

153
gnucash/report/reports/standard/taxinvoice.scm
View File

@ -1,4 +1,3 @@
;; $Author: chris $ $Date: 2009/07/29 09:31:44 $ $Revision: 1.33 $
;; Modified by Dmitry Smirnov <onlyjob@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))))

174
gnucash/report/reports/standard/test/test-cash-flow.scm
View File

@ -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)
)))))

186
gnucash/report/reports/standard/view-column.scm
View File

@ -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@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)))
(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.
;; 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")))))
;; 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)))))
;; 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 '())))))
(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)