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

Christian Stimming's report patch.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3663 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-02-15 09:01:19 +00:00
parent b9fbee7fd6
commit d66d8d2fc3
7 changed files with 358 additions and 311 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
ChangeLog
View File

@ -1,3 +1,20 @@
2001-02-15 Christian Stimming <stimming@tuhh.de>
* src/scm/report-utilities.scm: Added functions to filter accounts
by type, and helpers for calculating balances.
* src/scm/commodity-utilities.scm: (gnc:make-exchange-function)
now uses <gnc-monetary>.
* src/scm/html-utilities.scm: (gnc:html-build-acct-table) major
code cleanup. Added new function to generate a <html-table> of
exchange rates.
* src/scm/options-utilities.scm: Added function for another
option.
* src/scm/report/{pnl,account-summary}.scm: Added options.
2001-02-15 James LewisMoss <jimdres@mindspring.com>
* src/engine/Account.h: Add prototype for SetSlots.

48
src/scm/commodity-utilities.scm
View File

@ -109,7 +109,8 @@
;; If neither the currency of otherlist nor of
;; pair was found in reportlist then we can't
;; resolve the exchange rate to this currency.
(warn "can't calculate rate for "
(warn "gnc:resolve-unknown-comm:"
"can't calculate rate for "
(gnc:commodity-value->string
(list (car pair) ((caadr pair) 'total #f)))
" = "
@ -123,7 +124,8 @@
;; went wrong inside
;; gnc:get-exchange-totals. FIXME: Find a
;; better thing to do in this case.
(warn "Oops - exchange rate ambiguity error: "
(warn "gnc:resolve-unknown-comm:"
"Oops - exchange rate ambiguity error: "
(gnc:commodity-value->string
(list (car pair) ((caadr pair) 'total #f)))
" = "
@ -265,30 +267,30 @@
(gnc:get-exchange-totals report-commodity end-date)))
;; This one returns the ready-to-use function for calculation of the
;; exchange rates. The returned function in turn returns a pair
;; commodity - value which instantly can be plugged into
;; gnc:commodity-amount->string .
;; exchange rates. The returned function takes a <gnc-monetary> and
;; the domestic-commodity, exchanges the amount in the domestic
;; currency and returns a <gnc-monetary>.
(define (gnc:make-exchange-function exchange-alist)
(let ((exchangelist exchange-alist))
(lambda (foreign-pair domestic)
(cons domestic
(cons
(let ((pair (assoc (car foreign-pair) exchangelist)))
(if (not pair)
(gnc:numeric-zero)
(gnc:numeric-mul (cadr foreign-pair) (cadr pair)
;; FIXME: the constant 100 here is
;; not a durable solution --
;; anyone has a better idea?
100 GNC-RND-ROUND)))
'())))))
(lambda (foreign domestic)
(gnc:make-gnc-monetary
domestic
(let ((pair (assoc (gnc:gnc-monetary-commodity foreign)
exchangelist)))
(if (not pair)
(gnc:numeric-zero)
(gnc:numeric-mul (gnc:gnc-monetary-amount foreign)
(cadr pair)
;; FIXME: the constant 100 here is
;; not a durable solution --
;; anyone has a better idea?
100 GNC-RND-ROUND)))))))
;; Adds all different commodities in the commodity-collector <foreign>
;; by using the exchange rates of <exchange-fn> to calculate the
;; exchange rates to the commodity <domestic>. Returns the
;; two-element-list with the domestic commodity and its corresponding
;; balance, like (gnc:commodity* gnc:numeric).
;; exchange rates to the commodity <domestic>. Returns a
;; <gnc-monetary> with the domestic commodity and its corresponding
;; balance.
(define (gnc:sum-collector-commodity foreign domestic exchange-fn)
(let ((balance (make-commodity-collector)))
(foreign
@ -297,7 +299,9 @@
(if (gnc:commodity-equiv? domestic curr)
(balance 'add domestic val)
(balance 'add domestic
(cadr (exchange-fn (list curr val) domestic)))))
(gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary curr val)
domestic)))))
#f)
(balance 'getmonetary domestic #f)))

378
src/scm/html-utilities.scm
View File

@ -120,69 +120,37 @@
(string<? (gnc:account-get-code a)
(gnc:account-get-code b)))))
;; just a trivial helper...
(define (identity a) a)
;; The following functions are defined inside build-acct-table
;; to avoid passing tons of arguments which are constant anyway
;; inside this function.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; functions for table without foreign commodities
;; function for table without foreign commodities
;; Returns a list which makes up a row in the table. current-depth
;; determines the number of empty cells, my-name is the
;; html-object to be displayed as name, and my-balance is a
;; gnc-monetary to be displayed in the balance column.
(define (make-row-helper current-depth my-name my-balance)
(append
(gnc:html-make-empty-cells (- current-depth 1))
(list (gnc:make-html-table-cell/size
1 (+ 1 (- tree-depth current-depth))
my-name))
(gnc:html-make-empty-cells (- tree-depth current-depth))
;; the account balance
(list my-balance)
(gnc:html-make-empty-cells (- current-depth 1))))
;; Returns a list which makes up a row in the table. The account
;; balance calculation is done here, but the row/cell setup is
;; done in the helper function.
(define (make-row acct current-depth)
(make-row-helper
current-depth
(gnc:html-account-anchor acct)
;; get the account balance, then exchange everything into the
;; report-commodity via gnc:sum-collector-commodity. If the
;; account-reverse-balance? returns true, then the sign gets
;; reversed, otherwise the value is left unchanged.
((if (gnc:account-reverse-balance? acct)
gnc:monetary-neg
identity)
(gnc:sum-collector-commodity (my-get-balance acct)
report-commodity exchange-fn))))
;; Adds rows to the table. Therefore it goes through the list of
;; accounts, runs make-row on each account. If tree-depth and
;; current-depth require, it will recursively call itself on the
;; list of children accounts. Is used if no foreign commodity is
;; shown.
(define (traverse-accounts! accnts current-depth)
(if (<= current-depth tree-depth)
(for-each (lambda (acct)
(begin
(if (show-acct? acct)
(gnc:html-table-append-row!
table
(make-row acct current-depth)))
(traverse-accounts!
(gnc:account-get-immediate-subaccounts acct)
(+ 1 current-depth))))
(sort-fn accnts))))
;; Adds one row to the table. current-depth determines the number
;; of empty cells, my-name is the html-object to be displayed as
;; name, my-balance is a gnc-monetary to be displayed in the
;; balance column, and if reverse-balance? is #t the balance will
;; be displayed with the sign reversed.
(define (add-row-helper!
current-depth my-name my-balance reverse-balance?)
(gnc:html-table-append-row!
table
(append
(gnc:html-make-empty-cells (- current-depth 1))
(list (gnc:make-html-table-cell/size
1 (+ 1 (- tree-depth current-depth))
my-name))
(gnc:html-make-empty-cells (- tree-depth current-depth))
;; the account balance
(list (if reverse-balance?
(gnc:monetary-neg my-balance)
my-balance))
(gnc:html-make-empty-cells (- current-depth 1)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; functions for table with foreign commodities visible
;; function for table with foreign commodities visible
;; Adds all appropriate rows to the table which belong to one
;; balance, i.e. one row for each commodity. (Note: Multiple
;; commodities come e.g. from subaccounts with different
@ -192,11 +160,15 @@
;; account. balance (a commodity-collector) is the balance to be
;; printed. If reverse-balance? == #t then the balance's signs get
;; reversed.
(define (add-commodity-row-helper!
(define (add-commodity-rows!
current-depth my-name my-commodity balance reverse-balance?)
(begin
;; the first row for each account: shows the name and the
;; balance in the report-commodity
;; Adds one row to the table. my-name is the html-object
;; displayed in the name column; foreign-balance is the
;; <gnc-monetary> for the foreign column or #f if to be left
;; empty; domestic-balance is the <gnc-monetary> for the
;; domestic column.
(define (commodity-row-helper!
my-name foreign-balance domestic-balance)
(gnc:html-table-append-row!
table
(append
@ -205,156 +177,120 @@
1 (+ 1 (- tree-depth current-depth))
my-name))
(gnc:html-make-empty-cells (* 2 (- tree-depth current-depth)))
(if (or do-subtot?
(gnc:commodity-equiv? my-commodity report-commodity))
;; usual case: the account balance in terms of report
;; commodity
(list
(car (gnc:html-make-empty-cells 1))
(gnc:commodity-value->string
(balance 'getpair report-commodity reverse-balance?)))
;; special case if do-subtot? was false and it is in a
;; different commodity than the report: then the
;; foreign commodity gets displayed in this line
;; rather then the following lines (loop below).
(let ((my-balance
(balance 'getpair my-commodity reverse-balance)))
(list
(gnc:commodity-value->string my-balance)
(gnc:commodity-value->string
(exchange-fn my-balance report-commodity)))))
(gnc:html-make-empty-cells (* 2 (- current-depth 1)))))
;; The additional rows: show no name, but the foreign currency
;; balance and its corresponding value in the
;; report-currency. One row for each non-report-currency. Is
;; only used when do-subtot? == #f (otherwise this balance has
;; only one commodity).
(if do-subtot?
(balance
'format
(lambda (curr val)
(if (gnc:commodity-equiv? curr report-commodity)
'()
(gnc:html-table-append-row!
table
(append
;; print no account name
(gnc:html-make-empty-cells tree-depth)
(gnc:html-make-empty-cells
(* 2 (- tree-depth current-depth)))
;; print the account balance in the respective
;; commodity
(list
(gnc:commodity-value->string
(list curr (if reverse-balance?
(gnc:numeric-neg val) val)))
(gnc:commodity-value->string
(exchange-fn
(list curr (if reverse-balance?
(gnc:numeric-neg val) val))
report-commodity)))
(gnc:html-make-empty-cells
(* 2 (- current-depth 1)))))))
#f))))
(list (if (not foreign-balance)
(car (gnc:html-make-empty-cells 1))
foreign-balance)
domestic-balance)
(gnc:html-make-empty-cells (* 2 (- current-depth 1))))))
;;;;;;;;;;
;; the first row for each account: shows the name and the
;; balance in the report-commodity
(if (or do-subtot?
(gnc:commodity-equiv? my-commodity report-commodity))
;; usual case: the account balance in terms of report
;; commodity
(commodity-row-helper!
my-name #f
(balance 'getmonetary report-commodity reverse-balance?))
;; special case if do-subtot? was false and it is in a
;; different commodity than the report: then the
;; foreign commodity gets displayed in this line
;; rather then the following lines (loop below).
(let ((my-balance (balance 'getmonetary
my-commodity reverse-balance?)))
(commodity-row-helper!
my-name
my-balance
(exchange-fn my-balance report-commodity))))
;; The additional rows: show no name, but the foreign currency
;; balance and its corresponding value in the
;; report-currency. One row for each non-report-currency. Is
;; only used when do-subtot? == #f (otherwise this balance has
;; only one commodity).
(if do-subtot?
(balance
'format
(lambda (curr val)
(if (gnc:commodity-equiv? curr report-commodity)
'()
(let ((bal
(if reverse-balance?
(gnc:monetary-neg (gnc:make-gnc-monetary curr val))
(gnc:make-gnc-monetary curr val))))
(commodity-row-helper!
;; print no account name
(car (gnc:html-make-empty-cells 1))
;; print the account balance in the respective
;; commodity
bal
(exchange-fn bal report-commodity)))))
#f)))
;; Adds all appropriate rows to the table which belong to one
;; account. Uses the above helper function, i.e. here the
;; necessary values only are "extracted" from the account. Is used
;; only if options "show foreign commodities" == #t.
(define (add-commodity-rows! acct current-depth)
(add-commodity-row-helper! current-depth
(gnc:html-account-anchor acct)
(gnc:account-get-commodity acct)
(my-get-balance acct)
(gnc:account-reverse-balance? acct)))
;; The same as above (traverse-accounts!), but for showing foreign
;; currencies/commodities.
(define (traverse-accounts-fcur! accnts current-depth)
;; necessary values only are "extracted" from the account.
(define (add-account-rows! acct current-depth)
(if show-other-curr?
(add-commodity-rows! current-depth
(gnc:html-account-anchor acct)
(gnc:account-get-commodity acct)
(my-get-balance acct)
(gnc:account-reverse-balance? acct))
(add-row-helper!
current-depth
(gnc:html-account-anchor acct)
(gnc:sum-collector-commodity (my-get-balance acct)
report-commodity exchange-fn)
(gnc:account-reverse-balance? acct))))
;; Adds rows to the table. Therefore it goes through the list of
;; accounts, runs add-account-rows! on each account. If
;; tree-depth and current-depth require, it will recursively call
;; itself on the list of children accounts.
(define (traverse-accounts! accnts current-depth)
(if (<= current-depth tree-depth)
(for-each (lambda (acct)
(begin
(if (show-acct? acct)
(add-commodity-rows! acct current-depth))
(traverse-accounts-fcur!
(add-account-rows! acct current-depth))
(traverse-accounts!
(gnc:account-get-immediate-subaccounts acct)
(+ 1 current-depth))))
(sort-fn accnts))))
;; First iteration -- make the case destinction for
;; show-other-curr?.
(define (start-traverse-accounts l d)
(if show-other-curr?
(traverse-accounts-fcur! l d)
(traverse-accounts! l d)))
;;;;;;;;;;;;;;
;; Helper functions for the grouping of accounts according to their types.
;; Returns only those accounts out of the list l which have one of
;; the type identifiers in typelist.
(define (filter-accountlist-type typelist l)
(filter (lambda (a)
(member (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type a) #f)
typelist) )
accounts))
;; Decompose a given list of accounts accts into different lists,
;; each with the name of that category as first element.
(define (decompose-accountlist accts)
(map (lambda (x) (cons
(car x)
(filter-accountlist-type (cdr x) accts)))
(list
(cons (_ "Assets")
'(asset bank cash checking savings money-market
stock mutual-fund currency))
(cons (_ "Liabilities") '(liability equity credit-line))
(cons (_ "Income") '(income))
(cons (_ "Expense") '(expense)))))
;; Generalization for a subtotal or the total balance.
(define (add-subtotal-row!
current-depth subtotal-name balance)
(if show-other-curr?
(add-commodity-row-helper! current-depth subtotal-name
report-commodity balance #f)
(add-commodity-rows! current-depth subtotal-name
report-commodity balance #f)
;; Show no other currencies. Therefore just calculate
;; one total via sum-collector-commodity and show it.
(gnc:html-table-append-row!
table
(make-row-helper current-depth subtotal-name
(gnc:sum-collector-commodity
balance report-commodity
exchange-fn)))))
(add-row-helper! current-depth subtotal-name
(gnc:sum-collector-commodity
balance report-commodity exchange-fn)
#f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; start the recursive account processing
(if group-types?
;; do a subtotal for each group
;; Print a subtotal for each group.
(for-each
(lambda (accts)
(if (and (not (null? accts)) (not (null? (cdr accts))))
(begin
(add-subtotal-row!
1 (car accts)
(let ((coll (make-commodity-collector)))
(for-each (lambda (x)
(coll (if (gnc:account-reverse-balance? x)
'minusmerge 'merge)
(my-get-balance x) #f))
(cdr accts))
coll))
(start-traverse-accounts (cdr accts) 2))))
(decompose-accountlist topl-accounts))
(gnc:accounts-get-balance-helper
(cdr accts) my-get-balance gnc:account-reverse-balance?))
(traverse-accounts! (cdr accts) 2))))
(gnc:decompose-accountlist (lset-intersection
equal? accounts topl-accounts)))
;; No extra grouping.
(start-traverse-accounts topl-accounts 1))
(traverse-accounts! topl-accounts 1))
;; Show the total sum.
(if show-total?
@ -374,6 +310,17 @@
'attribute '("align" "right")
'attribute '("valign" "top"))
;; set some column headers
(gnc:html-table-set-col-headers!
table
(list (gnc:make-html-table-header-cell/size
1 tree-depth (_ "Account name"))
(gnc:make-html-table-header-cell/size
1 (if show-other-curr?
(* 2 tree-depth)
tree-depth)
(_ "Balance"))))
;; there are tree-depth account name columns.
(let loop ((col 0))
(gnc:html-table-set-col-style!
@ -385,25 +332,50 @@
table))
;; Print the exchangerate-list alist into the given html-txt object
;; txt-object, where the report's commodity is common-commodity.
(define (gnc:html-print-exchangerates!
txt-object common-commodity alist)
(for-each
(lambda (pair)
(gnc:html-text-append!
txt-object
(gnc:html-markup-p
(_ "Exchange rate ")
(gnc:commodity-value->string
(list (car pair) (gnc:numeric-create 1 1)))
" = "
(gnc:commodity-value->string
(list common-commodity
;; convert to 6 significant figures
(gnc:numeric-convert
(cadr pair)
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 6) GNC-RND-ROUND)))))))
alist))
;; Returns a html-object which is a table of all exchange rates.
;; Where the report's commodity is common-commodity.
(define (gnc:html-make-exchangerates
common-commodity rate-alist accounts show-always?)
(let ((comm-list (delete-duplicates
(sort (map gnc:account-get-commodity accounts)
(lambda (a b)
(string<? (gnc:commodity-get-mnemonic a)
(gnc:commodity-get-mnemonic b))))))
(table (gnc:make-html-table))
(any-printed? #f))
;; Do something with each exchange rate.
(for-each
(lambda (pair)
(if (or show-always?
(member (car pair) comm-list))
(begin
(set! any-printed? #t)
(gnc:html-table-append-row!
table
(list
(gnc:make-gnc-monetary (car pair) (gnc:numeric-create 1 1))
;; convert the foreign commodity to 6 significant digits
(gnc:make-gnc-monetary
common-commodity
(gnc:numeric-convert (cadr pair) GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 6)
GNC-RND-ROUND))))))))
rate-alist)
;; Set some style
(gnc:html-table-set-style!
table "td"
'attribute '("align" "right")
'attribute '("valign" "top"))
(if any-printed?
;; set some column headers
(gnc:html-table-set-col-headers!
table
(list (gnc:make-html-table-header-cell/size
1 2 (_ "Exchange rate ")))))
table))

14
src/scm/options-utilities.scm
View File

@ -94,7 +94,9 @@
(list->vector
(list 4 "4" (_ "Fourth-level")))
(list->vector
(list 5 "5" (_ "Fifth-level"))))))
(list 5 "5" (_ "Fourth-level")))
(list->vector
(list 6 "6" (_ "Sixth-level"))))))
(gnc:register-option
options
@ -128,6 +130,16 @@
pagename optname
sort-tag (_ "Include sub-account balances in printed balance?") #t)))
;; The single checkbox whether to group the accounts into main
;; categories and ahow a subtotal for those.
(define (gnc:options-add-group-accounts!
options pagename optname sort-tag default?)
(gnc:register-option
options
(gnc:make-simple-boolean-option
pagename optname
sort-tag (_ "Group the accounts in main categories?") default?)))
;; These are common options for the selection of the report's
;; currency/commodity.
(define (gnc:options-add-currency-selection!

71
src/scm/report-utilities.scm
View File

@ -56,6 +56,30 @@
#f)))
(member type '(income expense))))
;; Returns only those accounts out of the list <accounts> which have
;; one of the type identifiers in typelist.
(define (gnc:filter-accountlist-type typelist accounts)
(filter (lambda (a)
(member (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type a) #f)
typelist) )
accounts))
;; Decompose a given list of accounts accts into different lists
;; according to their types, each with the name of that category as
;; first element.
(define (gnc:decompose-accountlist accounts)
(map (lambda (x) (cons
(car x)
(gnc:filter-accountlist-type (cdr x) accounts)))
(list
(cons (_ "Assets")
'(asset bank cash checking savings money-market
stock mutual-fund currency))
(cons (_ "Liabilities") '(liability equity credit-line))
(cons (_ "Income") '(income))
(cons (_ "Expense") '(expense)))))
;; Returns the depth of the current account heirarchy, that is, the
;; maximum level of subaccounts in the current-group.
(define (gnc:get-current-group-depth)
@ -73,6 +97,7 @@
(accounts-get-children-depth
(gnc:group-get-account-list (gnc:get-current-group))))
;;
(define (gnc:account-separator-char)
(let ((option (gnc:lookup-option gnc:*options-entries*
"General" "Account Separator")))
@ -310,7 +335,8 @@
clist))
;; helper function which is given a commodity and returns, if
;; existing, a list (gnc:commodity gnc:numeric)
;; existing, a list (gnc:commodity gnc:numeric). If the second
;; argument was #t, the sign gets reversed.
(define (getpair c sign?)
(let ((pair (assoc c commoditylist)))
(cons c (cons
@ -322,7 +348,8 @@
'()))))
;; helper function which is given a commodity and returns, if
;; existing, a <gnc:monetary> value.
;; existing, a <gnc:monetary> value. If the second argument was
;; #t, the sign gets reversed.
(define (getmonetary c sign?)
(let ((pair (assoc c commoditylist)))
(gnc:make-gnc-monetary
@ -421,19 +448,33 @@
(gnc:account-get-balance-at-date account date #f))
group)))
;; Adds all accounts' balances, where the balances are determined with
;; the get-balance-fn. The reverse-balance-fn
;; (e.g. gnc:account-reverse-balance?) should return #t if the
;; account's balance sign should get reversed. Returns a
;; commodity-collector.
(define (gnc:accounts-get-balance-helper
accounts get-balance-fn reverse-balance-fn)
(let ((collector (make-commodity-collector)))
(for-each
(lambda (acct)
(collector (if (reverse-balance-fn acct)
'minusmerge
'merge)
(get-balance-fn acct) #f))
accounts)
collector))
;; Adds all accounts' balances, where the balances are determined with
;; the get-balance-fn. Intended for usage with a profit and loss
;; report, hence a) only the income/expense accounts are regarded, and
;; b) the result is sign reversed. Returns a commodity-collector.
(define (gnc:accounts-get-comm-total-profit accounts
get-balance-fn)
(let ((collector (make-commodity-collector)))
(for-each
(lambda (acct)
(collector 'minusmerge (get-balance-fn acct) #f))
(filter gnc:account-is-inc-exp?
accounts))
collector))
(gnc:accounts-get-balance-helper
(gnc:filter-accountlist-type '(income expense) accounts)
get-balance-fn
(lambda(x) #t)))
;; Adds all accounts' balances, where the balances are determined with
;; the get-balance-fn. Intended for usage with a balance sheet, hence
@ -441,13 +482,11 @@
;; reversed at all. Returns a commodity-collector.
(define (gnc:accounts-get-comm-total-assets accounts
get-balance-fn)
(let ((collector (make-commodity-collector)))
(for-each
(lambda (acct)
(collector 'merge (get-balance-fn acct) #f))
(filter (lambda (a) (not (gnc:account-is-inc-exp? a)))
accounts))
collector))
(gnc:accounts-get-balance-helper
(filter (lambda (a) (not (gnc:account-is-inc-exp? a)))
accounts)
get-balance-fn
(lambda(x) #f)))
;; returns a commodity-collector
(define (gnc:group-get-comm-balance-at-date group date)

91
src/scm/report/account-summary.scm
View File

@ -38,11 +38,15 @@
(let ((pagename-general (N_ "General"))
(optname-date (N_ "Date"))
(optname-display-depth (N_ "Account Display Depth"))
(optname-show-foreign (N_ "Show Foreign Currencies"))
(optname-report-currency (N_ "Report's currency"))
(pagename-accounts (N_ "Accounts"))
(optname-show-subaccounts (N_ "Always show sub-accounts"))
(optname-accounts (N_ "Account"))
(optname-include-subbalances (N_ "Include Sub-Account balances"))
(optname-show-foreign (N_ "Show Foreign Currencies"))
(optname-report-currency (N_ "Report's currency")))
(optname-group-accounts (N_ "Group the accouts"))
(optname-include-subbalances (N_ "Include Sub-Account balances")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; options generator
@ -58,26 +62,33 @@
(gnc:options-add-report-date!
options pagename-general optname-date "a")
;; all about currencies
(gnc:options-add-currency-selection!
options pagename-general
optname-show-foreign optname-report-currency
"b")
;; accounts to work on
(gnc:options-add-account-selection!
options pagename-general
options pagename-accounts
optname-display-depth optname-show-subaccounts
optname-accounts "b" 2
optname-accounts "a" 1
(lambda ()
(let ((current-accounts (gnc:get-current-accounts)))
(cond ((not (null? current-accounts)) current-accounts)
(else
(gnc:group-get-account-list (gnc:get-current-group)))))))
;; with or without grouping
(gnc:options-add-group-accounts!
options pagename-accounts optname-group-accounts "b" #f)
;; with or without subaccounts
(gnc:options-add-include-subaccounts!
options pagename-general optname-include-subbalances "c")
options pagename-accounts optname-include-subbalances "c")
;; all about currencies
(gnc:options-add-currency-selection!
options pagename-general
optname-show-foreign optname-report-currency
"f")
;; Set the general page as default option tab
(gnc:options-set-default-section options pagename-general)
options))
@ -87,23 +98,26 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (accsum-renderer report-obj)
(define (get-option optname)
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) pagename-general optname)))
(gnc:report-options report-obj) pagename optname)))
(let ((display-depth (get-option optname-display-depth))
(show-subaccts? (get-option optname-show-subaccounts))
(accounts (get-option optname-accounts))
(do-subtotals? (get-option optname-include-subbalances))
(show-fcur? (get-option optname-show-foreign))
(report-currency (get-option optname-report-currency))
;; FIXME: So which splits are actually included and which
;; are not?? Permanent repair (?): Change the semantics of
;; the date-option to return not the first but the last
;; second of the desired day.
(let ((display-depth (get-option pagename-accounts
optname-display-depth ))
(show-subaccts? (get-option pagename-accounts
optname-show-subaccounts))
(accounts (get-option pagename-accounts optname-accounts))
(do-grouping? (get-option pagename-accounts
optname-group-accounts))
(do-subtotals? (get-option pagename-accounts
optname-include-subbalances))
(show-fcur? (get-option pagename-general optname-show-foreign))
(report-currency (get-option pagename-general
optname-report-currency))
(date-tp (gnc:timepair-end-day-time
(vector-ref (get-option optname-date) 1)))
(vector-ref (get-option pagename-general
optname-date) 1)))
(doc (gnc:make-html-document))
(txt (gnc:make-html-text)))
@ -111,9 +125,10 @@
(if (not (null? accounts))
;; if no max. tree depth is given we have to find the
;; maximum existing depth
(let* ((tree-depth (if (equal? display-depth 'all)
(gnc:get-current-group-depth)
display-depth))
(let* ((tree-depth (+ (if (equal? display-depth 'all)
(gnc:get-current-group-depth)
display-depth)
(if do-grouping? 1 0)))
(exchange-alist (gnc:make-exchange-alist
report-currency date-tp))
(exchange-fn (gnc:make-exchange-function exchange-alist))
@ -122,29 +137,21 @@
#f date-tp
tree-depth show-subaccts? accounts
#t gnc:accounts-get-comm-total-assets
(_ "Net Assets") #t do-subtotals?
(_ "Net Assets") do-grouping? do-subtotals?
show-fcur? report-currency exchange-fn)))
;; set some column headers
(gnc:html-table-set-col-headers!
table
(list (gnc:make-html-table-header-cell/size
1 tree-depth (_ "Account name"))
(gnc:make-html-table-header-cell/size
1 (if show-fcur?
(* 2 tree-depth)
tree-depth)
(_ "Balance"))))
;; add the table
(gnc:html-document-add-object! doc table)
;; add the currency information
(gnc:html-print-exchangerates!
txt report-currency exchange-alist)
;(gnc:html-print-exchangerates!
; txt report-currency exchange-alist)
;;(if show-fcur?
(gnc:html-document-add-object! doc txt))
(gnc:html-document-add-object!
doc ;;(gnc:html-markup-p
(gnc:html-make-exchangerates
report-currency exchange-alist accounts #f)));;)
;; error condition: no accounts specified
(let ((p (gnc:make-html-text)))

50
src/scm/report/pnl.scm
View File

@ -39,6 +39,7 @@
(optname-display-depth (N_ "Account Display Depth"))
(optname-show-subaccounts (N_ "Always show sub-accounts"))
(optname-accounts (N_ "Account"))
(optname-group-accounts (N_ "Group the accouts"))
(optname-include-subbalances (N_ "Include Sub-Account balances"))
;; (pagename-currencies (N_ "Currencies")) too little options :)
@ -55,27 +56,31 @@
options pagename-general
optname-from-date optname-to-date "a")
;; all about currencies
(gnc:options-add-currency-selection!
options pagename-currencies
optname-show-foreign optname-report-currency
"b")
;; accounts to work on
(gnc:options-add-account-selection!
options pagename-accounts
optname-display-depth optname-show-subaccounts
optname-accounts "b" 2
optname-accounts "a" 2
;; FIXME: get income/expense accounts
(lambda ()
(filter
gnc:account-is-inc-exp?
(gnc:group-get-account-list (gnc:get-current-group)))))
;; with or without grouping
(gnc:options-add-group-accounts!
options pagename-accounts optname-group-accounts "b" #t)
;; with or without subaccounts
(gnc:options-add-include-subaccounts!
options pagename-accounts optname-include-subbalances "c")
;; all about currencies
(gnc:options-add-currency-selection!
options pagename-currencies
optname-show-foreign optname-report-currency
"d")
;; Set the general page as default option tab
(gnc:options-set-default-section options pagename-general)
@ -99,6 +104,8 @@
optname-show-subaccounts))
(accounts (get-option pagename-accounts
optname-accounts))
(do-grouping? (get-option pagename-accounts
optname-group-accounts))
(do-subtotals? (get-option pagename-accounts
optname-include-subbalances))
(show-fcur? (get-option pagename-currencies
@ -123,7 +130,8 @@
;; if no max. tree depth is given we have to find the
;; maximum existing depth
(let* ((tree-depth (if (equal? display-depth 'all)
(gnc:get-current-group-depth)
(+ (gnc:get-current-group-depth)
(if do-grouping? 1 0))
display-depth))
;; calculate the exchange rates
(exchange-alist (gnc:make-exchange-alist
@ -134,29 +142,17 @@
from-date-tp to-date-tp
tree-depth show-subaccts? accounts
#t gnc:accounts-get-comm-total-profit
(_ "Profit") #t do-subtotals?
(_ "Profit") do-grouping? do-subtotals?
show-fcur? report-currency exchange-fn)))
;; set some column headers
(gnc:html-table-set-col-headers!
table
(list (gnc:make-html-table-header-cell/size
1 tree-depth (_ "Account name"))
(gnc:make-html-table-header-cell/size
1 (if show-fcur?
(* 2 tree-depth)
tree-depth)
(_ "Balance"))))
;; add the table
(gnc:html-document-add-object! doc table)
;; add the currency information
(gnc:html-print-exchangerates!
txt report-currency exchange-alist)
;;(if show-fcur?
(gnc:html-document-add-object! doc txt))
;; add currency information
(gnc:html-document-add-object!
doc ;;(gnc:html-markup-p
(gnc:html-make-exchangerates
report-currency exchange-alist accounts #f)));;)
;; error condition: no accounts specified
(let ((p (gnc:make-html-text)))