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

Merge branch 'maint'

Browse Source
This commit is contained in:
Christopher Lam 2019-12-02 23:38:15 +08:00
commit 948a5f4588
23 changed files with 806 additions and 750 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
bindings/python/example_scripts/account_analysis.py
View File

@ -38,7 +38,7 @@ import csv
from gnucash import Session, GncNumeric, Split from gnucash import Session, GncNumeric, Split
# Invoke this script like the following example # Invoke this script like the following example
# $ gnucash-env python account_analysis.py gnucash_file.gnucash \ # $ python3 account_analysis.py gnucash_file.gnucash \
# 2010 1 monthly 12 \ # 2010 1 monthly 12 \
# debits-show credits-show Assets 'Test Account' # debits-show credits-show Assets 'Test Account'
# #
@ -156,9 +156,9 @@ def main():
print('usage: account_analysis.py {book url} {start year} {start month, numeric} {period type: monthly, quarterly, or yearly} {number of periods to show, from start year and month} {whether to show debits: debits-show for true, all other values false} {whether to show credits: credits-show for true, all other values false} {space separated account path, as many nested levels as desired} ') print('usage: account_analysis.py {book url} {start year} {start month, numeric} {period type: monthly, quarterly, or yearly} {number of periods to show, from start year and month} {whether to show debits: debits-show for true, all other values false} {whether to show credits: credits-show for true, all other values false} {space separated account path, as many nested levels as desired} ')
print('examples:\n') print('examples:\n')
print("The following example analyzes 12 months of 'Assets:Test Account' from /home/username/test.gnucash, starting in January of 2010, and shows both credits and debits") print("The following example analyzes 12 months of 'Assets:Test Account' from /home/username/test.gnucash, starting in January of 2010, and shows both credits and debits")
print("gnucash-env python account_analysis.py '/home/username/test.gnucash' 2010 1 monthly 12 debits-show credits-show Assets 'Test Account'\n") print("python3 account_analysis.py '/home/username/test.gnucash' 2010 1 monthly 12 debits-show credits-show Assets 'Test Account'\n")
print("The following example analyzes 2 quarters of 'Liabilities:First Level:Second Level' from /home/username/test.gnucash, starting March 2011, and shows credits but not debits") print("The following example analyzes 2 quarters of 'Liabilities:First Level:Second Level' from /home/username/test.gnucash, starting March 2011, and shows credits but not debits")
print("gnucash-env python account_analysis.py '/home/username/test.gnucash' 2011 3 quarterly 2 debits-noshow credits-show Liabilities 'First Level' 'Second Level") print("python3 account_analysis.py '/home/username/test.gnucash' 2011 3 quarterly 2 debits-noshow credits-show Liabilities 'First Level' 'Second Level")
return return
try: try:

8
bindings/python/example_scripts/new_book_with_opening_balances.py
View File

@ -51,11 +51,11 @@ from datetime import date
# mutual, and trading, you'll have to put the opening balance in yourself # mutual, and trading, you'll have to put the opening balance in yourself
# #
# Invocation examples: # Invocation examples:
# gnucash-env python new_book_with_opening_balances.py \ # python3 new_book_with_opening_balances.py \
# '/home/mark/test.gnucash' # '/home/mark/test.gnucash'
# 'sqlite3:///home/mark/new_test.gnucash' # 'sqlite3:///home/mark/new_test.gnucash'
# #
# gnucash-env python new_book_with_opening_balances.py \ # python3 new_book_with_opening_balances.py \
# '/home/mark/test.gnucash' \ # '/home/mark/test.gnucash' \
# 'xml:///crypthome/mark/parit-financial-system/new_test.gnucash' # 'xml:///crypthome/mark/parit-financial-system/new_test.gnucash'
# #
@ -293,8 +293,8 @@ def main():
print('not enough parameters') print('not enough parameters')
print('usage: new_book_with_opening_balances.py {source_book_url} {destination_book_url}') print('usage: new_book_with_opening_balances.py {source_book_url} {destination_book_url}')
print('examples:') print('examples:')
print("gnucash-env python new_book_with_opening_balances.py '/home/username/test.gnucash' 'sqlite3:///home/username/new_test.gnucash'") print("python3 new_book_with_opening_balances.py '/home/username/test.gnucash' 'sqlite3:///home/username/new_test.gnucash'")
print("gnucash-env python new_book_with_opening_balances.py '/home/username/test.gnucash' 'xml:///crypthome/username/finances/new_test.gnucash'") print("python3 new_book_with_opening_balances.py '/home/username/test.gnucash' 'xml:///crypthome/username/finances/new_test.gnucash'")
return return
#have everything in a try block to unable us to release our hold on stuff to the extent possible #have everything in a try block to unable us to release our hold on stuff to the extent possible

5
bindings/python/example_scripts/priceDB_test.py
View File

@ -5,8 +5,9 @@
# before running this. # before running this.
# Adding to a calling bash script would be better # Adding to a calling bash script would be better
# Although calling it from here would be even better! # Although calling it from here would be even better!
# OR: export PYTHONPATH=$HOME/progs/lib/python2.6/site-packages # OR: export PYTHONPATH=<path-to-gnucash-inst-dir>/lib/python3.7/site-packages:$PYTHONPATH
# Then: gnucash-env ipython # You may have to adjust the above path to your local system (lib->lib64, python3.7->...)
# Then: ipython3
# The account file is not saved but always use a disposable copy. # The account file is not saved but always use a disposable copy.
# Change, FILE, CURRENCY and STOCK to those defined in your test account. # Change, FILE, CURRENCY and STOCK to those defined in your test account.

5
bindings/python/example_scripts/price_database_example.py
View File

@ -5,8 +5,9 @@
# before running this. # before running this.
# Adding to a calling bash script would be better # Adding to a calling bash script would be better
# Although calling it from here would be even better! # Although calling it from here would be even better!
# OR: export PYTHONPATH=$HOME/progs/lib/python2.6/site-packages # OR: export PYTHONPATH=<path-to-gnucash-inst-dir>/lib/python3.7/site-packages:$PYTHONPATH
# Then: gnucash-env ipython # You may have to adjust the above path to your local system (lib->lib64, python3.7->...)
# Then: ipython3
# The account file is not saved but always use a disposable copy. # The account file is not saved but always use a disposable copy.
# Thanks for contributions by Christoph Holtermann and Mark Jenkins # Thanks for contributions by Christoph Holtermann and Mark Jenkins

16
bindings/python/example_scripts/rest-api/gnucash_simple.py
View File

@ -34,14 +34,14 @@ def addressToDict(address):
return None return None
else: else:
simple_address = {} simple_address = {}
simple_address['name'] = address.GetName(); simple_address['name'] = address.GetName()
simple_address['line_1'] = address.GetAddr1(); simple_address['line_1'] = address.GetAddr1()
simple_address['line_2'] = address.GetAddr2(); simple_address['line_2'] = address.GetAddr2()
simple_address['line_3'] = address.GetAddr3(); simple_address['line_3'] = address.GetAddr3()
simple_address['line_4'] = address.GetAddr4(); simple_address['line_4'] = address.GetAddr4()
simple_address['phone'] = address.GetPhone(); simple_address['phone'] = address.GetPhone()
simple_address['fax'] = address.GetFax(); simple_address['fax'] = address.GetFax()
simple_address['email'] = address.GetEmail(); simple_address['email'] = address.GetEmail()
return simple_address return simple_address

4
bindings/python/example_scripts/simple_business_create.py
View File

@ -24,7 +24,7 @@
# Creates a new book file (or *overwrites* an existing one) that has elements # Creates a new book file (or *overwrites* an existing one) that has elements
# in it for business use -- intended as a demonstration program. # in it for business use -- intended as a demonstration program.
# Syntax: # Syntax:
# gnucash-env python simple_business_create.py \ # python3 simple_business_create.py \
# sqlite3:///home/blah/blah.gnucash # sqlite3:///home/blah/blah.gnucash
# #
# Specifically, this sets up a simple tree, creates a customer, job, # Specifically, this sets up a simple tree, creates a customer, job,
@ -65,7 +65,7 @@ if len(argv) < 2:
print('not enough parameters') print('not enough parameters')
print('usage: simple_business_create.py {new_book_url}') print('usage: simple_business_create.py {new_book_url}')
print('example:') print('example:')
print("gnucash-env python simple_business_create.py sqlite3:///home/blah/blah.gnucash") print("python3 simple_business_create.py sqlite3:///home/blah/blah.gnucash")
exit() exit()

2
bindings/python/example_scripts/simple_invoice_insert.py
View File

@ -30,7 +30,7 @@
# this to become an invoice importer for your own books # this to become an invoice importer for your own books
# #
# Syntax: # Syntax:
# gnucash-env python simple_invoice_insert.py \ # python3 simple_invoice_insert.py \
# /home/blah/blah.gnucash # /home/blah/blah.gnucash
# dda2ec8e3e63c7715097f852851d6b22 1001 'The Goods' 201.43 # dda2ec8e3e63c7715097f852851d6b22 1001 'The Goods' 201.43
# #

2
bindings/python/example_scripts/test_imbalance_transaction.py
View File

@ -45,7 +45,7 @@ if len(argv) < 2:
print('not enough parameters') print('not enough parameters')
print('usage: test_imbalance_transaction.py {book_url}') print('usage: test_imbalance_transaction.py {book_url}')
print('examples:') print('examples:')
print("gnucash-env python test_imbalance_transaction.py '/home/username/test.gnucash'") print("python3 test_imbalance_transaction.py '/home/username/test.gnucash'")
exit() exit()

6
bindings/python/gnucash_core.py
View File

@ -619,7 +619,7 @@ methods_return_instance(GncLot, gnclot_dict)
# Transaction # Transaction
Transaction.add_methods_with_prefix('xaccTrans') Transaction.add_methods_with_prefix('xaccTrans')
Transaction.add_method('gncTransGetGUID', 'GetGUID'); Transaction.add_method('gncTransGetGUID', 'GetGUID')
Transaction.add_method('xaccTransGetDescription', 'GetDescription') Transaction.add_method('xaccTransGetDescription', 'GetDescription')
Transaction.add_method('xaccTransDestroy', 'Destroy') Transaction.add_method('xaccTransDestroy', 'Destroy')
@ -648,7 +648,7 @@ Transaction.decorate_functions(
# Split # Split
Split.add_methods_with_prefix('xaccSplit') Split.add_methods_with_prefix('xaccSplit')
Split.add_method('gncSplitGetGUID', 'GetGUID'); Split.add_method('gncSplitGetGUID', 'GetGUID')
Split.add_method('xaccSplitDestroy', 'Destroy') Split.add_method('xaccSplitDestroy', 'Destroy')
split_dict = { split_dict = {
@ -677,7 +677,7 @@ Split.parent = property( Split.GetParent, Split.SetParent )
# Account # Account
Account.add_methods_with_prefix('xaccAccount') Account.add_methods_with_prefix('xaccAccount')
Account.add_methods_with_prefix('gnc_account_') Account.add_methods_with_prefix('gnc_account_')
Account.add_method('gncAccountGetGUID', 'GetGUID'); Account.add_method('gncAccountGetGUID', 'GetGUID')
Account.add_method('xaccAccountGetPlaceholder', 'GetPlaceholder') Account.add_method('xaccAccountGetPlaceholder', 'GetPlaceholder')
account_dict = { account_dict = {

3
gnucash/import-export/import-account-matcher.c
View File

@ -86,7 +86,8 @@ static gpointer test_acct_online_id_match(Account *acct, gpointer param_online_i
const gchar * current_online_id = gnc_import_get_acc_online_id(acct); const gchar * current_online_id = gnc_import_get_acc_online_id(acct);
if ( (current_online_id != NULL if ( (current_online_id != NULL
&& param_online_id != NULL ) && param_online_id != NULL )
&& strcmp( current_online_id, param_online_id ) == 0 ) && strncmp( current_online_id, param_online_id,
strlen( current_online_id ) ) == 0 )
{ {
return (gpointer *) acct; return (gpointer *) acct;
} }

357
gnucash/report/html-acct-table.scm
View File

@ -610,7 +610,6 @@
) )
;; the following function was adapted from html-utilities.scm ;; the following function was adapted from html-utilities.scm
;;
;; helper to calculate the balances for all required accounts ;; helper to calculate the balances for all required accounts
(define (calculate-balances accts start-date end-date get-balance-fn) (define (calculate-balances accts start-date end-date get-balance-fn)
@ -667,19 +666,18 @@
(define (traverse-accounts! accts acct-depth logi-depth new-balances) (define (traverse-accounts! accts acct-depth logi-depth new-balances)
(define (use-acct? acct) (define (use-acct? acct)
;; BUG? when depth-limit is not integer but boolean? (and (or (eq? limit-behavior 'flatten)
(and (or (eq? limit-behavior 'flatten)
(< logi-depth depth-limit)) (< logi-depth depth-limit))
(member acct accounts))) (member acct accounts)))
;; helper function to return a cached balance from a list of ;; helper function to return a cached balance from a list of
;; ( acct . balance ) cells ;; ( acct . balance ) cells
(define (get-balance acct-balances acct) (define (get-balance acct-balances acct)
(let ((this-collector (gnc:make-commodity-collector)) (let ((this-collector (gnc:make-commodity-collector))
(acct-coll (hash-ref acct-balances (gncAccountGetGUID acct) (acct-coll (hash-ref acct-balances (gncAccountGetGUID acct)
(gnc:make-commodity-collector)))) (gnc:make-commodity-collector))))
(this-collector 'merge acct-coll #f) (this-collector 'merge acct-coll #f)
this-collector)) this-collector))
;; helper function that returns a cached balance from a list of ;; helper function that returns a cached balance from a list of
;; ( acct . balance) cells for the given account *and* its ;; ( acct . balance) cells for the given account *and* its
@ -690,217 +688,151 @@
(lambda (acct) (lambda (acct)
(this-collector 'merge (get-balance acct-balances acct) #f)) (this-collector 'merge (get-balance acct-balances acct) #f))
(gnc:accounts-and-all-descendants (list account))) (gnc:accounts-and-all-descendants (list account)))
this-collector)) this-collector))
(let ((disp-depth (if (integer? depth-limit) (let lp ((accounts (if less-p (sort accts less-p) accts))
(min (- depth-limit 1) logi-depth) (row-added? #f)
logi-depth)) (disp-depth (if (integer? depth-limit)
(row-added? #f)) (min (1- depth-limit) logi-depth)
logi-depth)))
(for-each (cond
(lambda (acct)
(let* ((subaccts (gnc-account-get-children-sorted acct))
;; assign output parameters
(account acct)
(account-name (xaccAccountGetName acct))
(account-code (xaccAccountGetCode acct))
(account-path (gnc-account-get-full-name acct))
(account-anchor (gnc:html-account-anchor acct))
(account-parent (gnc-account-get-parent acct))
(account-children subaccts)
(account-depth acct-depth)
(logical-depth logi-depth)
(account-commodity (xaccAccountGetCommodity acct))
(account-type (xaccAccountGetType acct))
;; N.B.: xaccAccountGetTypeStr really should be
;; called gnc:account-type-get-string
(account-type-string (xaccAccountGetTypeStr
(xaccAccountGetType acct)))
(account-guid (gncAccountGetGUID acct))
(account-description (xaccAccountGetDescription acct))
(account-notes (xaccAccountGetNotes acct))
;; These next two are commodity-collectors.
(account-bal (get-balance
new-balances acct))
(recursive-bal (get-balance-sub
new-balances acct))
;; These next two are of type <gnc:monetary>, right?
(report-comm-account-bal
(gnc:sum-collector-commodity
account-bal report-commodity exchange-fn))
(report-comm-recursive-bal
(gnc:sum-collector-commodity
recursive-bal report-commodity exchange-fn))
(grp-env
(append env
(list
(list 'initial-indent indent)
(list 'account account)
(list 'account-name account-name)
(list 'account-code account-code)
(list 'account-type account-type)
(list 'account-type-string account-type-string)
(list 'account-guid account-guid)
(list 'account-description account-description)
(list 'account-notes account-notes)
(list 'account-path account-path)
(list 'account-parent account-parent)
(list 'account-children account-children)
(list 'account-depth account-depth)
(list 'logical-depth logical-depth)
(list 'account-commodity account-commodity)
(list 'account-anchor account-anchor)
(list 'account-bal account-bal)
(list 'recursive-bal recursive-bal)
(list 'report-comm-account-bal
report-comm-account-bal)
(list 'report-comm-recursive-bal
report-comm-recursive-bal)
(list 'report-commodity report-commodity)
(list 'exchange-fn exchange-fn)
)))
(row-env #f)
(label (case label-mode
((anchor) account-anchor)
((name) (gnc:make-html-text account-name))))
(row #f)
(children-displayed? #f)
)
(set! acct-depth-reached (max acct-depth-reached acct-depth)) ((null? accounts) row-added?)
(set! logi-depth-reached (max logi-depth-reached logi-depth))
(set! disp-depth-reached (max disp-depth-reached disp-depth))
(or (not (use-acct? acct)) (else
;; ok, so we'll consider parent accounts with zero (let* ((acct (car accounts))
;; recursive-bal to be zero balance leaf accounts (subaccts (gnc-account-get-children-sorted acct))
(and (gnc-commodity-collector-allzero? recursive-bal)
(or (not report-budget)
(gnc-numeric-zero-p
(gnc:budget-account-get-rolledup-net
report-budget account #f #f)))
(equal? zero-mode 'omit-leaf-acct))
(begin
(set! row-env
(append grp-env
(list
(list 'account-label label)
(list 'row-type 'account-row)
(list 'display-depth disp-depth)
(list 'indented-depth
(+ disp-depth indent))
)
))
(set! row (add-row row-env))
)
)
;; Recurse:
;; Dive into an account even if it isn't selected!
;; why? because some subaccts may be selected.
(set! children-displayed?
(traverse-accounts! subaccts
(+ acct-depth 1)
(if (use-acct? acct)
(+ logi-depth 1)
logi-depth)
new-balances))
;; record whether any children were displayed ;; These next two are commodity-collectors.
(if row (append-to-row row (list (list 'children-displayed? children-displayed?)))) (account-bal (get-balance new-balances acct))
(recursive-bal (get-balance-sub new-balances acct))
;; after the return from recursion: subtotals ;; These next two are of type <gnc:monetary>
(or (not (use-acct? acct)) (report-comm-account-bal
(not subtotal-mode) (gnc:sum-collector-commodity
;; ditto that remark concerning zero recursive-bal... account-bal report-commodity exchange-fn))
(and (gnc-commodity-collector-allzero? recursive-bal) (report-comm-recursive-bal
(equal? zero-mode 'omit-leaf-acct)) (gnc:sum-collector-commodity
;; ignore use-acct for subtotals...? recursive-bal report-commodity exchange-fn))
;; (not (use-acct? acct))
(not children-displayed?) (grp-env
(let* ((lbl-txt (gnc:make-html-text (_ "Total") " "))) (cons*
(apply gnc:html-text-append! lbl-txt (list 'initial-indent indent)
(gnc:html-text-body label)) (list 'account acct)
(if (equal? subtotal-mode 'canonically-tabbed) (list 'account-name (xaccAccountGetName acct))
(set! disp-depth (+ disp-depth 1)) (list 'account-code (xaccAccountGetCode acct))
(set! disp-depth-reached (list 'account-type (xaccAccountGetType acct))
(max disp-depth-reached disp-depth)) (list 'account-type-string (xaccAccountGetTypeStr
) (xaccAccountGetType acct)))
(set! row-env (list 'account-guid (gncAccountGetGUID acct))
(append grp-env (list 'account-description (xaccAccountGetDescription acct))
(list (list 'account-notes (xaccAccountGetNotes acct))
(list 'account-label lbl-txt) (list 'account-path (gnc-account-get-full-name acct))
(list 'row-type 'subtotal-row) (list 'account-parent (gnc-account-get-parent acct))
(list 'display-depth disp-depth) (list 'account-children subaccts)
(list 'indented-depth (list 'account-depth acct-depth)
(+ disp-depth indent)) (list 'logical-depth logi-depth)
) (list 'account-commodity (xaccAccountGetCommodity acct))
)) (list 'account-anchor (gnc:html-account-anchor acct))
(add-row row-env) (list 'account-bal account-bal)
) (list 'recursive-bal recursive-bal)
) (list 'report-comm-account-bal report-comm-account-bal)
(if (or row-added? children-displayed? row) (set! row-added? #t)) (list 'report-comm-recursive-bal report-comm-recursive-bal)
)) ;; end of (lambda (acct) ...) (list 'report-commodity report-commodity)
;; lambda is applied to each item in the (sorted) account list (list 'exchange-fn exchange-fn)
(if less-p env))
(sort accts less-p) (label (case label-mode
accts) ((anchor) (gnc:html-account-anchor acct))
) ;; end of for-each ((name) (gnc:make-html-text (xaccAccountGetName acct)))))
row-added? (row #f)
) (children-displayed? #f))
) ;; end of definition of traverse-accounts!
(set! acct-depth-reached (max acct-depth-reached acct-depth))
(set! logi-depth-reached (max logi-depth-reached logi-depth))
(set! disp-depth-reached (max disp-depth-reached disp-depth))
(unless (or (not (use-acct? acct))
;; ok, so we'll consider parent accounts with zero
;; recursive-bal to be zero balance leaf accounts
(and (gnc-commodity-collector-allzero? recursive-bal)
(eq? zero-mode 'omit-leaf-acct)
(or (not report-budget)
(zero? (gnc:budget-account-get-rolledup-net
report-budget acct #f #f)))))
(set! row
(add-row
(cons* (list 'account-label label)
(list 'row-type 'account-row)
(list 'display-depth disp-depth)
(list 'indented-depth (+ disp-depth indent))
grp-env))))
;; Recurse:
;; Dive into an account even if it isn't selected!
;; why? because some subaccts may be selected.
(set! children-displayed?
(traverse-accounts! subaccts
(1+ acct-depth)
(if (use-acct? acct)
(1+ logi-depth)
logi-depth)
new-balances))
;; record whether any children were displayed
(when row
(append-to-row
row (list (list 'children-displayed? children-displayed?))))
;; after the return from recursion: subtotals
(unless (or (not (use-acct? acct))
(not subtotal-mode)
(not children-displayed?)
(and (gnc-commodity-collector-allzero? recursive-bal)
(eq? zero-mode 'omit-leaf-acct)))
(let ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
(apply gnc:html-text-append! lbl-txt (gnc:html-text-body label))
(if (eq? subtotal-mode 'canonically-tabbed)
(set! disp-depth (+ disp-depth 1))
(set! disp-depth-reached (max disp-depth-reached disp-depth)))
(add-row
(cons* (list 'account-label lbl-txt)
(list 'row-type 'subtotal-row)
(list 'display-depth disp-depth)
(list 'indented-depth (+ disp-depth indent))
grp-env))))
(lp (cdr accounts)
(or row-added? children-displayed? row)
disp-depth))))))
;; do it ;; do it
(traverse-accounts! toplvl-accts 0 0 (traverse-accounts!
(calculate-balances accounts start-date end-date get-balance-fn)) toplvl-accts 0 0
(calculate-balances accounts start-date end-date get-balance-fn))
;; now set the account-colspan entries ;; now set the account-colspan entries
;; he he... (let ((x 0)) (while (< x 5) (display x) (set! x (+ x 1)))) (let lp ((row 0)
;; now I know how to loop in scheme... yay! (rows (gnc:html-acct-table-num-rows acct-table)))
(let ((row 0) (when (< row rows)
(rows (gnc:html-acct-table-num-rows acct-table))) (let* ((orig-env (gnc:html-acct-table-get-row-env acct-table row))
(while (< row rows) (display-depth (get-val orig-env 'display-depth))
(let* ((orig-env (depth-limit (get-val orig-env 'display-tree-depth))
(gnc:html-acct-table-get-row-env acct-table row)) (indent (get-val orig-env 'initial-indent))
(display-depth (get-val orig-env 'display-depth)) (indented-depth (get-val orig-env 'indented-depth))
(depth-limit (get-val orig-env 'display-tree-depth)) (subtotal-mode (get-val orig-env 'parent-account-subtotal-mode))
(indent (get-val orig-env 'initial-indent)) (label-cols (+ disp-depth-reached 1))
(indented-depth (get-val orig-env 'indented-depth)) ;; these parameters *should* always, by now, be set...
(subtotal-mode (new-env
(get-val orig-env 'parent-account-subtotal-mode)) (cons*
(label-cols (+ disp-depth-reached 1)) (list 'account-colspan (- label-cols display-depth))
(logical-cols (if depth-limit (list 'label-cols label-cols)
(min (list 'account-cols (+ indent (max label-cols (or depth-limit 0))))
(+ logi-depth-reached 1) (list 'logical-cols (min (+ logi-depth-reached)
;; BUG? when depth-limit is not integer? (or depth-limit +inf.0)))
depth-limit) orig-env)))
(+ logi-depth-reached 1))) (gnc:html-acct-table-set-row-env! acct-table row new-env)
(colspan (- label-cols display-depth)) (lp (1+ row) rows))))))
;; these parameters *should* always, by now, be set...
(new-env
(append
orig-env
(list
(list 'account-colspan colspan)
(list 'label-cols label-cols)
(list 'logical-cols logical-cols)
(list 'account-cols
(+ indent
(max label-cols
(if depth-limit depth-limit 0)
)
)
)
)
))
)
(gnc:html-acct-table-set-row-env! acct-table row new-env)
(set! row (+ row 1))))
)
;; done
)
)
(define (gnc:html-acct-table-num-rows acct-table) (define (gnc:html-acct-table-num-rows acct-table)
(gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table))) (gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table)))
@ -908,12 +840,9 @@
(define (gnc:html-acct-table-get-cell acct-table row col) (define (gnc:html-acct-table-get-cell acct-table row col)
;; we'll only ever store one object in an html-table-cell ;; we'll only ever store one object in an html-table-cell
;; returns the first object stored in that cell ;; returns the first object stored in that cell
(let* ((cell (gnc:html-table-get-cell (and-let* ((cell (gnc:html-table-get-cell
(gnc:_html-acct-table-matrix_ acct-table) (gnc:_html-acct-table-matrix_ acct-table) row (1+ col))))
row (+ col 1)))) (car (gnc:html-table-cell-data cell))))
(and cell (car (gnc:html-table-cell-data cell)))
)
)
(define (gnc:html-acct-table-set-cell! acct-table row col obj) (define (gnc:html-acct-table-set-cell! acct-table row col obj)
(gnc:html-table-set-cell! (gnc:html-table-set-cell!

3
gnucash/report/html-text.scm
View File

@ -182,6 +182,9 @@
(gnc:html-markup "li" obj)) (gnc:html-markup "li" obj))
items))) items)))
(define (gnc:html-markup-ol lst)
(apply gnc:html-markup "ol"
(map (lambda (elt) (gnc:html-markup "li" elt)) lst)))
(define (gnc:html-markup-anchor href . rest) (define (gnc:html-markup-anchor href . rest)
(apply gnc:html-markup/attr (apply gnc:html-markup/attr

34
gnucash/report/html-utilities.scm
View File

@ -91,29 +91,17 @@
(define (gnc:owner-report-text owner acc) (define (gnc:owner-report-text owner acc)
(let* ((end-owner (gncOwnerGetEndOwner owner)) (let* ((end-owner (gncOwnerGetEndOwner owner))
(type (gncOwnerGetType end-owner)) (type (gncOwnerGetType end-owner)))
(ref #f)) (gnc-build-url
URL-TYPE-OWNERREPORT
(cond (string-append
((eqv? type GNC-OWNER-CUSTOMER) (cond ((eqv? type GNC-OWNER-CUSTOMER) "owner=c:")
(set! ref "owner=c:")) ((eqv? type GNC-OWNER-VENDOR) "owner=v:")
((eqv? type GNC-OWNER-EMPLOYEE) "owner=e:")
((eqv? type GNC-OWNER-VENDOR) (else "unknown-type="))
(set! ref "owner=v:")) (gncOwnerReturnGUID end-owner)
(if (null? acc) "" (string-append "&acct=" (gncAccountGetGUID acc))))
((eqv? type GNC-OWNER-EMPLOYEE) "")))
(set! ref "owner=e:"))
(else (set! ref "unknown-type=")))
(if ref
(begin
(set! ref (string-append ref (gncOwnerReturnGUID end-owner)))
(if (not (null? acc))
(set! ref (string-append ref "&acct="
(gncAccountGetGUID acc))))
(gnc-build-url URL-TYPE-OWNERREPORT ref ""))
ref)))
;; Make a new report and return the anchor to it. The new report of ;; Make a new report and return the anchor to it. The new report of
;; type 'reportname' will have the option values copied from ;; type 'reportname' will have the option values copied from

24
gnucash/report/report-utilities.scm
View File

@ -868,6 +868,16 @@
account-balances) account-balances)
total)) total))
(define (gnc:multiline-to-html-text str)
;; simple function - splits string containing #\newline into
;; substrings, and convert to a gnc:make-html-text construct which
;; adds gnc:html-markup-br after each substring.
(let loop ((list-of-substrings (string-split str #\newline))
(result '()))
(if (null? list-of-substrings)
(apply gnc:make-html-text (if (null? result) '() (reverse (cdr result))))
(loop (cdr list-of-substrings)
(cons* (gnc:html-markup-br) (car list-of-substrings) result)))))
;; *************************************************************************** ;; ***************************************************************************
;; Business Functions ;; Business Functions
@ -1008,6 +1018,18 @@
(gnc-lot-get-notes lot) (gnc-lot-get-notes lot)
(gnc-lot-get-balance lot) (gnc-lot-get-balance lot)
(gnc-lot-count-splits lot))) (gnc-lot-count-splits lot)))
(define (record->str rec)
(let ((rtd (record-type-descriptor rec)))
(define (fld->str fld)
(format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) rec))))
(format #f "Rec:~a{~a}"
(record-type-name rtd)
(string-join (map fld->str (record-type-fields rtd)) ", "))))
(define (hash-table->str hash)
(string-append
"Hash(" (string-join
(hash-map->list (lambda (k v) (format #f "~a=~a" k v)) hash) ",")
")"))
(define (try proc) (define (try proc)
;; Try proc with d as a parameter, catching exceptions to return ;; Try proc with d as a parameter, catching exceptions to return
;; #f to the (or) evaluator below. ;; #f to the (or) evaluator below.
@ -1043,6 +1065,8 @@
(try owner->str) (try owner->str)
(try invoice->str) (try invoice->str)
(try lot->str) (try lot->str)
(try hash-table->str)
(try record->str)
(object->string d))) (object->string d)))
(define (pair->num pair) (define (pair->num pair)

2
gnucash/report/report.scm
View File

@ -649,6 +649,7 @@
(export gnc:html-markup-h3) (export gnc:html-markup-h3)
(export gnc:html-markup-br) (export gnc:html-markup-br)
(export gnc:html-markup-hr) (export gnc:html-markup-hr)
(export gnc:html-markup-ol)
(export gnc:html-markup-ul) (export gnc:html-markup-ul)
(export gnc:html-markup-anchor) (export gnc:html-markup-anchor)
(export gnc:html-markup-img) (export gnc:html-markup-img)
@ -717,6 +718,7 @@
(export gnc:get-assoc-account-balances) (export gnc:get-assoc-account-balances)
(export gnc:select-assoc-account-balance) (export gnc:select-assoc-account-balance)
(export gnc:get-assoc-account-balances-total) (export gnc:get-assoc-account-balances-total)
(export gnc:multiline-to-html-text)
(export make-file-url) (export make-file-url)
(export gnc:strify) (export gnc:strify)
(export gnc:pk) (export gnc:pk)

248
gnucash/report/reports/standard/balsheet-pnl.scm
View File

@ -38,10 +38,11 @@
;; the column-data record. the gnc:account-accumulate-at-dates will ;; the column-data record. the gnc:account-accumulate-at-dates will
;; create a record for each report-date with split-data as follows: ;; create a record for each report-date with split-data as follows:
(define-record-type :col-datum (define-record-type :col-datum
(make-datum last-split split-balance) (make-datum last-split split-balance split-value-balance)
col-datum? col-datum?
(last-split col-datum-get-last-split) (last-split col-datum-get-last-split)
(split-balance col-datum-get-split-balance)) (split-balance col-datum-get-split-balance)
(split-value-balance col-datum-get-split-value-balance))
(define FOOTER-TEXT (define FOOTER-TEXT
(gnc:make-html-text (gnc:make-html-text
@ -785,14 +786,20 @@ also show overall period profit & loss."))
(map (map
(lambda (acc) (lambda (acc)
(let* ((comm (xaccAccountGetCommodity acc)) (let* ((comm (xaccAccountGetCommodity acc))
(val-coll (gnc:make-commodity-collector))
(amt->monetary (lambda (amt) (gnc:make-gnc-monetary comm amt)))) (amt->monetary (lambda (amt) (gnc:make-gnc-monetary comm amt))))
(cons acc (cons acc
(gnc:account-accumulate-at-dates (gnc:account-accumulate-at-dates
acc report-dates acc report-dates
#:nosplit->elt (make-datum #f (amt->monetary 0)) #:nosplit->elt (make-datum #f (amt->monetary 0)
(gnc:make-commodity-collector))
#:split->elt #:split->elt
(lambda (s) (lambda (s)
(make-datum s (amt->monetary (xaccSplitGetBalance s)))))))) (val-coll 'add
(xaccTransGetCurrency (xaccSplitGetParent s))
(xaccSplitGetValue s))
(make-datum s (amt->monetary (xaccSplitGetBalance s))
(gnc:collector+ val-coll)))))))
accounts)) accounts))
;; an alist of (cons account account-balances) whereby ;; an alist of (cons account account-balances) whereby
@ -902,6 +909,15 @@ also show overall period profit & loss."))
(maxindent (1+ (apply max (cons 0 (map gnc-account-get-current-depth (maxindent (1+ (apply max (cons 0 (map gnc-account-get-current-depth
accounts)))))) accounts))))))
(define (sum-balances-of-accounts alist accts adder)
(let ((balances
(fold (lambda (a b) (if (member (car a) accts) (cons (cdr a) b) b))
'() alist)))
(list->vector
(if (null? balances)
(map (const (adder)) report-dates)
(apply map adder balances)))))
(gnc:html-document-set-title! (gnc:html-document-set-title!
doc (with-output-to-string doc (with-output-to-string
(lambda () (lambda ()
@ -910,7 +926,7 @@ also show overall period profit & loss."))
(if (or incr (eq? report-type 'pnl)) (if (or incr (eq? report-type 'pnl))
(format #t (_ "~a to ~a") (format #t (_ "~a to ~a")
(qof-print-date startdate) (qof-print-date enddate)) (qof-print-date startdate) (qof-print-date enddate))
(qof-print-date enddate))))) (display (qof-print-date enddate))))))
(if (eq? (get-option gnc:pagename-general optname-options-summary) 'always) (if (eq? (get-option gnc:pagename-general optname-options-summary) 'always)
(gnc:html-document-add-object! (gnc:html-document-add-object!
@ -945,28 +961,36 @@ also show overall period profit & loss."))
(split (vector-ref date-splits col-idx))) (split (vector-ref date-splits col-idx)))
(gnc:split-anchor-text split)))) (gnc:split-anchor-text split))))
;; a vector of collectors whereby collector is the sum of
;; asset and liabilities at report dates
(asset-liability-balances (asset-liability-balances
(let ((asset-liab-balances (sum-balances-of-accounts
(map cdr (filter accounts-balances asset-liability gnc:monetaries-add))
(lambda (acc-balances)
(member (car acc-balances) asset-liability))
accounts-balances))))
(if (null? asset-liab-balances)
(map (const (gnc:make-commodity-collector)) report-dates)
(apply map gnc:monetaries-add asset-liab-balances))))
;; a vector of collectors whereby collector is the sum of
;; incomes and expenses at report dates
(income-expense-balances (income-expense-balances
(let ((inc-exp-balances (sum-balances-of-accounts
(map cdr accounts-balances income-expense gnc:monetaries-add))
(filter
(lambda (acc-balances)
(member (car acc-balances) income-expense))
accounts-balances))))
(if (null? inc-exp-balances)
(map (const (gnc:make-commodity-collector)) report-dates)
(map gnc:commodity-collector-get-negated
(apply map gnc:monetaries-add inc-exp-balances)))))
;; an alist of (cons account list-of-collectors) whereby each
;; collector is the split-value-balances at report
;; dates. split-value-balance determined by transaction currency.
(accounts-value-balances
(map
(lambda (acc)
(cons acc (let ((cols-data (assoc-ref accounts-cols-data acc)))
(map col-datum-get-split-value-balance cols-data))))
accounts))
;; a vector of collectors whereby each collector is the sum
;; of asset and liability split-value-balances at report
;; dates
(asset-liability-value-balances
(sum-balances-of-accounts
accounts-value-balances asset-liability gnc:collector+))
;; converts monetaries to common currency
(monetaries->exchanged (monetaries->exchanged
(lambda (monetaries target-currency price-source date) (lambda (monetaries target-currency price-source date)
(let ((exchange-fn (gnc:case-exchange-fn (let ((exchange-fn (gnc:case-exchange-fn
@ -978,30 +1002,35 @@ also show overall period profit & loss."))
(exchange-fn mon target-currency)) (exchange-fn mon target-currency))
(monetaries 'format gnc:make-gnc-monetary #f))))))) (monetaries 'format gnc:make-gnc-monetary #f)))))))
;; the unrealized gain calculator retrieves the
;; asset-and-liability report-date balance and
;; value-balance, and calculates the difference,
;; converted to report currency.
(unrealized-gain-fn (unrealized-gain-fn
(lambda (col-idx) (lambda (col-idx)
(and common-currency (and-let* (common-currency
(let* ((date (case price-source (date (case price-source
((pricedb-latest) (current-time)) ((pricedb-latest) (current-time))
(else (list-ref report-dates col-idx)))) (else (list-ref report-dates col-idx))))
(asset-liability-balance (asset-liability-balance
(list-ref asset-liability-balances col-idx)) (vector-ref asset-liability-balances col-idx))
(asset-liability-basis (asset-liability-basis
(gnc:accounts-get-comm-total-assets (vector-ref asset-liability-value-balances col-idx))
asset-liability (unrealized (gnc:collector- asset-liability-basis
(lambda (acc) asset-liability-balance)))
(gnc:account-get-comm-value-at-date acc date #f)))) (monetaries->exchanged
(unrealized (gnc:collector- asset-liability-basis unrealized common-currency price-source date))))
asset-liability-balance)))
(monetaries->exchanged ;; the retained earnings calculator retrieves the
unrealized common-currency price-source date))))) ;; income-and-expense report-date balance, and converts
;; to report currency.
(retained-earnings-fn (retained-earnings-fn
(lambda (col-idx) (lambda (col-idx)
(let* ((date (case price-source (let* ((date (case price-source
((pricedb-latest) (current-time)) ((pricedb-latest) (current-time))
(else (list-ref report-dates col-idx)))) (else (list-ref report-dates col-idx))))
(income-expense-balance (income-expense-balance
(list-ref income-expense-balances col-idx))) (vector-ref income-expense-balances col-idx)))
(if (and common-currency (if (and common-currency
(every has-price? (every has-price?
(gnc:accounts-get-commodities income-expense #f))) (gnc:accounts-get-commodities income-expense #f)))
@ -1012,26 +1041,30 @@ also show overall period profit & loss."))
gnc:monetary-neg gnc:monetary-neg
(income-expense-balance 'format gnc:make-gnc-monetary #f)))))) (income-expense-balance 'format gnc:make-gnc-monetary #f))))))
(chart (and include-chart? incr (chart (and-let* (include-chart?
(gnc:make-report-anchor incr
networth-barchart-uuid report-obj (curr (or common-currency book-main-currency))
(list (list "General" "Start Date" (cons 'absolute startdate)) (price (or price-source 'pricedb-nearest)))
(list "General" "End Date" (cons 'absolute enddate)) (gnc:make-report-anchor
(list "General" "Report's currency" networth-barchart-uuid report-obj
(or common-currency book-main-currency)) (list (list "General" "Start Date" (cons 'absolute startdate))
(list "General" "Step Size" incr) (list "General" "End Date" (cons 'absolute enddate))
(list "General" "Price Source" (list "General" "Report's currency" curr)
(or price-source 'pricedb-nearest)) (list "General" "Step Size" incr)
(list "Accounts" "Accounts" asset-liability))))) (list "General" "Price Source" price)
(get-col-header-fn (lambda (accounts col-idx) (list "Accounts" "Accounts" asset-liability)))))
(let* ((date (list-ref report-dates col-idx))
(header (qof-print-date date)) (get-col-header-fn
(cell (gnc:make-html-table-cell/markup (lambda (accounts col-idx)
"total-label-cell" header))) (let* ((date (list-ref report-dates col-idx))
(gnc:html-table-cell-set-style! (header (qof-print-date date))
cell "total-label-cell" (cell (gnc:make-html-table-cell/markup
'attribute '("style" "text-align:right")) "total-label-cell" header)))
cell))) (gnc:html-table-cell-set-style!
cell "total-label-cell"
'attribute '("style" "text-align:right"))
cell)))
(add-to-table (lambda* (table title accounts #:key (add-to-table (lambda* (table title accounts #:key
(get-col-header-fn #f) (get-col-header-fn #f)
(show-accounts? #t) (show-accounts? #t)
@ -1085,11 +1118,14 @@ also show overall period profit & loss."))
(add-to-table (add-to-table
multicol-table-right (_ "Equity") multicol-table-right (_ "Equity")
(append equity-accounts (append equity-accounts
(list (if common-currency
(vector (_ "Unrealized Gains") (list (vector (_ "Unrealized Gains")
unrealized-gain-fn) unrealized-gain-fn))
(vector (_ "Retained Earnings") '())
retained-earnings-fn))) (if (null? income-expense)
'()
(list (vector (_ "Retained Earnings")
retained-earnings-fn))))
#:negate-amounts? #t) #:negate-amounts? #t)
(if (and common-currency show-rates?) (if (and common-currency show-rates?)
@ -1127,6 +1163,7 @@ also show overall period profit & loss."))
(cons (car balancelist) (last balancelist)) (cons (car balancelist) (last balancelist))
(cons (list-ref balancelist idx) (cons (list-ref balancelist idx)
(list-ref balancelist (1+ idx)))))) (list-ref balancelist (1+ idx))))))
(closing-entries (let ((query (qof-query-create-for-splits))) (closing-entries (let ((query (qof-query-create-for-splits)))
(qof-query-set-book query (gnc-get-current-book)) (qof-query-set-book query (gnc-get-current-book))
(xaccQueryAddAccountMatch (xaccQueryAddAccountMatch
@ -1140,6 +1177,7 @@ also show overall period profit & loss."))
(let ((splits (qof-query-run query))) (let ((splits (qof-query-run query)))
(qof-query-destroy query) (qof-query-destroy query)
splits))) splits)))
;; this function will query the above closing-entries for ;; this function will query the above closing-entries for
;; splits within the date range, and produce the total ;; splits within the date range, and produce the total
;; amount for these closing entries ;; amount for these closing entries
@ -1155,52 +1193,49 @@ also show overall period profit & loss."))
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
(xaccAccountGetCommodity account) (xaccAccountGetCommodity account)
(apply + (map xaccSplitGetAmount account-closing-splits)))))) (apply + (map xaccSplitGetAmount account-closing-splits))))))
(get-cell-monetary-fn (get-cell-monetary-fn
(lambda (account col-idx) (lambda (account col-idx)
(let ((account-balance-list (assoc account accounts-balances))) (let* ((balances (assoc-ref accounts-balances account))
(and account-balance-list (monetarypair (col-idx->monetarypair balances col-idx)))
(let ((monetarypair (col-idx->monetarypair (monetary-less
(cdr account-balance-list) (cdr monetarypair)
col-idx))) (car monetarypair)
(monetary-less (closing-adjustment account col-idx)))))
(cdr monetarypair)
(car monetarypair)
(closing-adjustment account col-idx)))))))
(get-cell-anchor-fn (lambda (account col-idx) (get-cell-anchor-fn
(define datepair (col-idx->datepair col-idx)) (lambda (account col-idx)
(gnc:make-report-anchor (let ((datepair (col-idx->datepair col-idx))
trep-uuid report-obj (show-orig? (and common-currency #t))
(list (curr (or common-currency book-main-currency))
(list "General" "Start Date" (delta (or incr 'MonthDelta))
(cons 'absolute (car datepair))) (price (or price-source 'pricedb-nearest))
(list "General" "End Date" (accts (if (pair? account) account (list account))))
(cons 'absolute (cdr datepair))) (gnc:make-report-anchor
(list "General" "Show original currency amount" trep-uuid report-obj
(and common-currency #t)) (list
(list "General" "Common Currency" (list "General" "Start Date" (cons 'absolute (car datepair)))
common-currency) (list "General" "End Date" (cons 'absolute (cdr datepair)))
(list "General" "Report's currency" (list "General" "Show original currency amount" show-orig?)
(or common-currency book-main-currency)) (list "General" "Common Currency" common-currency)
(list "Display" "Amount" 'double) (list "General" "Report's currency" curr)
(list "Accounts" "Accounts" (list "Display" "Amount" 'double)
(if (pair? account) (list "Accounts" "Accounts" accts))))))
account
(list account))))))) (chart
(and-let* (include-chart?
(curr (or common-currency book-main-currency))
(delta (or incr 'MonthDelta))
(price (or price-source 'pricedb-nearest)))
(gnc:make-report-anchor
pnl-barchart-uuid report-obj
(list (list "General" "Start Date" (cons 'absolute startdate))
(list "General" "End Date" (cons 'absolute enddate))
(list "General" "Report's currency" curr)
(list "General" "Step Size" delta)
(list "General" "Price Source" price)
(list "Accounts" "Accounts" income-expense)))))
(chart (and include-chart?
(gnc:make-report-anchor
pnl-barchart-uuid report-obj
(list (list "General" "Start Date"
(cons 'absolute startdate))
(list "General" "End Date"
(cons 'absolute enddate))
(list "General" "Report's currency"
(or common-currency book-main-currency))
(list "General" "Step Size" (or incr 'MonthDelta))
(list "General" "Price Source"
(or price-source 'pricedb-nearest))
(list "Accounts" "Accounts" income-expense)))))
(get-col-header-fn (get-col-header-fn
(lambda (accounts col-idx) (lambda (accounts col-idx)
(let* ((datepair (col-idx->datepair col-idx)) (let* ((datepair (col-idx->datepair col-idx))
@ -1215,6 +1250,7 @@ also show overall period profit & loss."))
cell "total-label-cell" cell "total-label-cell"
'attribute '("style" "text-align:right")) 'attribute '("style" "text-align:right"))
cell))) cell)))
(add-to-table (lambda* (table title accounts #:key (add-to-table (lambda* (table title accounts #:key
(get-col-header-fn #f) (get-col-header-fn #f)
(show-accounts? #t) (show-accounts? #t)

15
gnucash/report/reports/standard/customer-summary.scm
View File

@ -178,17 +178,6 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-expand string character replace-string)
(with-output-to-string
(lambda ()
(string-for-each
(lambda (c)
(display
(if (char=? c character)
replace-string
c)))
string))))
(define (query owner account-list start-date end-date) (define (query owner account-list start-date end-date)
(let* ((q (qof-query-create-for-splits)) (let* ((q (qof-query-create-for-splits))
(guid (and owner (guid (and owner
@ -213,6 +202,7 @@
;; guid QOF-QUERY-OR) ;; guid QOF-QUERY-OR)
(xaccQueryAddAccountMatch q account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND) (xaccQueryAddAccountMatch q account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
(xaccQueryAddDateMatchTT q #t start-date #t end-date QOF-QUERY-AND) (xaccQueryAddDateMatchTT q #t start-date #t end-date QOF-QUERY-AND)
(xaccQueryAddClosingTransMatch q #f QOF-QUERY-AND)
(qof-query-set-book q (gnc-get-current-book)) (qof-query-set-book q (gnc-get-current-book))
(let ((result (qof-query-run q))) (let ((result (qof-query-run q)))
(qof-query-destroy q) (qof-query-destroy q)
@ -231,8 +221,7 @@
'attribute (list "cellspacing" 0) 'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0)) 'attribute (list "cellpadding" 0))
(if name (gnc:html-table-append-row! table (list name))) (if name (gnc:html-table-append-row! table (list name)))
(if addy (gnc:html-table-append-row! (if addy (gnc:html-table-append-row! table (gnc:multiline-to-html-text addy)))
table (list (string-expand addy #\newline "<br/>"))))
(gnc:html-table-append-row! (gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format))) table (list (gnc-print-time64 (gnc:get-today) date-format)))
(let ((table-outer (gnc:make-html-table))) (let ((table-outer (gnc:make-html-table)))

10
gnucash/report/reports/standard/invoice.scm
View File

@ -176,15 +176,7 @@
keylist)) keylist))
(define (multiline-to-html-text str) (define (multiline-to-html-text str)
;; simple function - splits string containing #\newline into (gnc:multiline-to-html-text str))
;; substrings, and convert to a gnc:make-html-text construct which
;; adds gnc:html-markup-br after each substring.
(let loop ((list-of-substrings (string-split str #\newline))
(result '()))
(if (null? list-of-substrings)
(apply gnc:make-html-text (if (null? result) '() (reverse (cdr result))))
(loop (cdr list-of-substrings)
(cons* (gnc:html-markup-br) (car list-of-substrings) result)))))
(define (options-generator variant) (define (options-generator variant)

36
gnucash/report/reports/standard/job-report.scm
View File

@ -414,24 +414,6 @@
(options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE (options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE
(_ "Expense Report") #t)) (_ "Expense Report") #t))
(define (string-expand string character replace-string)
(define (car-line chars)
(take-while (lambda (c) (not (eqv? c character))) chars))
(define (cdr-line chars)
(let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars)))
(if (null? rest)
'()
(cdr rest))))
(define (line-helper chars)
(if (null? chars)
""
(let ((first (car-line chars))
(rest (cdr-line chars)))
(string-append (list->string first)
(if (null? rest) "" replace-string)
(line-helper rest)))))
(line-helper (string->list string)))
(define (setup-query q owner account end-date) (define (setup-query q owner account end-date)
(let* ((guid (gncOwnerReturnGUID owner))) (let* ((guid (gncOwnerReturnGUID owner)))
@ -462,13 +444,15 @@
'attribute (list "border" 0) 'attribute (list "border" 0)
'attribute (list "cellspacing" 0) 'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0)) 'attribute (list "cellpadding" 0))
(gnc:html-table-append-row! (gnc:html-table-append-row!
table table
(list (list (gnc:multiline-to-html-text
(string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>"))) (gnc:owner-get-name-and-address-dep owner))))
(gnc:html-table-append-row! (gnc:html-table-append-row!
table table (gnc:make-html-text (gnc:html-markup-br)))
(list "<br/>"))
(gnc:html-table-set-last-row-style! (gnc:html-table-set-last-row-style!
table "td" table "td"
'attribute (list "valign" "top")) 'attribute (list "valign" "top"))
@ -505,10 +489,10 @@
'attribute (list "cellspacing" 0) 'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0)) 'attribute (list "cellpadding" 0))
(gnc:html-table-append-row! table (list (if name name ""))) (gnc:html-table-append-row! table (list (or name "")))
(gnc:html-table-append-row! table (list (string-expand
(if addy addy "") (gnc:html-table-append-row! table (list (gnc:multiline-to-html-text (or addy ""))))
#\newline "<br/>")))
(gnc:html-table-append-row! (gnc:html-table-append-row!
table (list (gnc-print-time64 (current-time) date-format))) table (list (gnc-print-time64 (current-time) date-format)))
table)) table))

6
gnucash/report/reports/standard/new-aging.scm
View File

@ -224,10 +224,6 @@ exist but have no suitable transactions."))
((if (eq? sort-order 'increasing) string<? string>?) ((if (eq? sort-order 'increasing) string<? string>?)
(gncOwnerGetName a) (gncOwnerGetName b))) (gncOwnerGetName a) (gncOwnerGetName b)))
(define (html-markup-ol lst)
(apply gnc:html-markup "ol"
(map (lambda (elt) (gnc:html-markup "li" elt)) lst)))
;; set default title ;; set default title
(gnc:html-document-set-title! document report-title) (gnc:html-document-set-title! document report-title)
@ -339,7 +335,7 @@ exist but have no suitable transactions."))
document document
(gnc:make-html-text (gnc:make-html-text
(_ "Please note some transactions were not processed") (_ "Please note some transactions were not processed")
(html-markup-ol (gnc:html-markup-ol
(map (map
(lambda (invalid-split) (lambda (invalid-split)
(gnc:html-markup-anchor (gnc:html-markup-anchor

39
gnucash/report/reports/standard/owner-report.scm
View File

@ -625,24 +625,6 @@
(define (employee-options-generator) (define (employee-options-generator)
(options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE #t)) (options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE #t))
(define (string-expand string character replace-string)
(define (car-line chars)
(take-while (lambda (c) (not (eqv? c character))) chars))
(define (cdr-line chars)
(let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars)))
(if (null? rest)
'()
(cdr rest))))
(define (line-helper chars)
(if (null? chars)
""
(let ((first (car-line chars))
(rest (cdr-line chars)))
(string-append (list->string first)
(if (null? rest) "" replace-string)
(line-helper rest)))))
(line-helper (string->list string)))
(define (setup-query q owner account end-date) (define (setup-query q owner account end-date)
(let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner)))) (let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
@ -673,16 +655,17 @@
'attribute (list "border" 0) 'attribute (list "border" 0)
'attribute (list "cellspacing" 0) 'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0)) 'attribute (list "cellpadding" 0))
(gnc:html-table-append-row! (gnc:html-table-append-row!
table table (gnc:multiline-to-html-text (gnc:owner-get-name-and-address-dep owner)))
(list
(string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
(gnc:html-table-append-row! (gnc:html-table-append-row!
table table (gnc:make-html-text (gnc:html-markup-br)))
(list "<br/>"))
(gnc:html-table-set-last-row-style! (gnc:html-table-set-last-row-style!
table "td" table "td"
'attribute (list "valign" "top")) 'attribute (list "valign" "top"))
table)) table))
(define (make-date-row! table label date) (define (make-date-row! table label date)
@ -716,12 +699,14 @@
'attribute (list "cellspacing" 0) 'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0)) 'attribute (list "cellpadding" 0))
(gnc:html-table-append-row! table (list (if name name ""))) (gnc:html-table-append-row! table (list (or name "")))
(gnc:html-table-append-row! table (list (string-expand
(if addy addy "") (gnc:html-table-append-row!
#\newline "<br/>"))) table (list (gnc:multiline-to-html-text (or addy ""))))
(gnc:html-table-append-row! (gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format))) table (list (gnc-print-time64 (gnc:get-today) date-format)))
table)) table))
(define (make-break! document) (define (make-break! document)

707
gnucash/report/reports/standard/test/test-balsheet-pnl.scm
View File

@ -3,6 +3,8 @@
(use-modules (tests test-engine-extras)) (use-modules (tests test-engine-extras))
(use-modules (gnucash reports standard balance-sheet)) (use-modules (gnucash reports standard balance-sheet))
(use-modules (gnucash reports standard income-statement)) (use-modules (gnucash reports standard income-statement))
(use-modules (gnucash reports standard balsheet-pnl))
(use-modules (gnucash reports standard transaction))
(use-modules (gnucash report stylesheets plain)) ; For the default stylesheet, required for rendering (use-modules (gnucash report stylesheets plain)) ; For the default stylesheet, required for rendering
(use-modules (gnucash report)) (use-modules (gnucash report))
(use-modules (tests test-report-extras)) (use-modules (tests test-report-extras))
@ -15,6 +17,8 @@
(define balance-sheet-uuid "c4173ac99b2b448289bf4d11c731af13") (define balance-sheet-uuid "c4173ac99b2b448289bf4d11c731af13")
(define pnl-uuid "0b81a3bdfd504aff849ec2e8630524bc") (define pnl-uuid "0b81a3bdfd504aff849ec2e8630524bc")
(define multicol-balsheet-uuid "065d5d5a77ba11e8b31e83ada73c5eea")
(define multicol-pnl-uuid "0e94fd0277ba11e8825d43e27232c9d4")
;; Explicitly set locale to make the report output predictable ;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C") (setlocale LC_ALL "C")
@ -23,7 +27,11 @@
(test-runner-factory gnc:test-runner) (test-runner-factory gnc:test-runner)
(test-begin "balsheet and profit&loss") (test-begin "balsheet and profit&loss")
(null-test) (null-test)
(balsheet-pnl-tests) (create-test-data)
(balance-sheet-tests)
(pnl-tests)
(multicol-balsheet-tests)
(multicol-pnl-tests)
(test-end "balsheet and profit&loss")) (test-end "balsheet and profit&loss"))
(define (options->sxml uuid options test-title) (define (options->sxml uuid options test-title)
@ -80,7 +88,7 @@
(let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid))) (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
(test-assert "null-test" (options->sxml balance-sheet-uuid balance-sheet-options "null-test")))) (test-assert "null-test" (options->sxml balance-sheet-uuid balance-sheet-options "null-test"))))
(define (balsheet-pnl-tests) (define (create-test-data)
;; This function will perform implementation testing on the transaction report. ;; This function will perform implementation testing on the transaction report.
(let* ((env (create-test-env)) (let* ((env (create-test-env))
(account-alist (env-create-account-structure-alist env structure)) (account-alist (env-create-account-structure-alist env structure))
@ -95,23 +103,7 @@
(bank2creditcard (cdr (assoc "CreditCard" account-alist))) (bank2creditcard (cdr (assoc "CreditCard" account-alist)))
(equity (cdr (assoc "Equity" account-alist))) (equity (cdr (assoc "Equity" account-alist)))
(income (cdr (assoc "Income" account-alist))) (income (cdr (assoc "Income" account-alist)))
(income-GBP (cdr (assoc "Income-GBP" account-alist))) (income-GBP (cdr (assoc "Income-GBP" account-alist))))
(YEAR (gnc:time64-get-year (gnc:get-today))))
(define (default-balsheet-testing-options)
(let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
(set-option! balance-sheet-options "General" "Balance Sheet Date" (cons 'absolute (gnc-dmy2time64 1 1 1971)))
(set-option! balance-sheet-options "Accounts" "Levels of Subaccounts" 'all)
(set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t)
balance-sheet-options))
(define (default-pnl-testing-options)
(let ((pnl-options (gnc:make-report-options pnl-uuid)))
(set-option! pnl-options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1980)))
(set-option! pnl-options "General" "End Date" (cons 'absolute (gnc-dmy2time64 1 1 1981)))
(set-option! pnl-options "Accounts" "Levels of Subaccounts" 'all)
(set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
pnl-options))
;; $100 in Savings account ;; $100 in Savings account
(env-transfer env 01 01 1970 equity bank1savings 100) (env-transfer env 01 01 1970 equity bank1savings 100)
@ -169,300 +161,423 @@
;; a couple INCOME transactions, a decade later ;; a couple INCOME transactions, a decade later
(env-transfer env 01 01 1980 income bank1current 250) (env-transfer env 01 01 1980 income bank1current 250)
(env-transfer env 01 01 1980 income-GBP foreignsavings 500) (env-transfer env 01 01 1980 income-GBP foreignsavings 500)
(env-transfer-foreign env 01 02 1980 income-GBP bank1current 100 170 #:description "earn 100GBP into $170") (env-transfer-foreign env 01 02 1980 income-GBP bank1current 100 170 #:description "earn 100GBP into $170")))
;; Finally we can begin testing balsheet (define (balance-sheet-tests)
(display "\n\n balsheet tests\n\n") (define (default-balsheet-testing-options)
(let* ((balance-sheet-options (default-balsheet-testing-options)) (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
(sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-default"))) (set-option! balance-sheet-options "General" "Balance Sheet Date" (cons 'absolute (gnc-dmy2time64 1 1 1971)))
(test-equal "total assets = $116,009" (set-option! balance-sheet-options "Accounts" "Levels of Subaccounts" 'all)
(list "$116,009.00")
(sxml->table-row-col sxml 1 15 6))
(test-equal "total liabilities = $9,500.00"
(list "$9,500.00")
(sxml->table-row-col sxml 1 23 6))
(test-equal "total equity = $106,509.00"
(list "$106,509.00")
(sxml->table-row-col sxml 1 28 6))
(set-option! balance-sheet-options "Commodities" "Price Source" 'weighted-average)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-weighted-average")))
(test-equal "weighted average assets = $114,071.66"
(list "$114,071.66")
(sxml->table-row-col sxml 1 15 6)))
(set-option! balance-sheet-options "Commodities" "Price Source" 'average-cost)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-average-cost")))
(test-equal "average-cost assets = $113,100"
(list "$113,100.00")
(sxml->table-row-col sxml 1 15 6)))
(set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-nearest)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-nearest")))
(test-equal "pricedb-nearest assets = $116,009"
(list "$116,009.00")
(sxml->table-row-col sxml 1 15 6)))
(set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-latest)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-latest")))
(test-equal "pricedb-latest assets = $122,049"
(list "$122,049.00")
(sxml->table-row-col sxml 1 15 6)))
;; set multilevel subtotal style
;; verifies amount in EVERY line of the report.
(set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
(set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-multilevel")))
(test-equal "multilevel. root = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "multilevel. assets = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 4 5))
(test-equal "multilevel. bank1 = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 5 4))
(test-equal "multilevel. bonds = $2,000.00"
(list "$2,000.00")
(sxml->table-row-col sxml 1 6 3))
(test-equal "multilevel. current = $2609.00"
(list "$2,609.00")
(sxml->table-row-col sxml 1 7 3))
(test-equal "multilevel. empty = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 8 3))
(test-equal "multilevel. savings = $100.00"
(list "$100.00")
(sxml->table-row-col sxml 1 9 3))
(test-equal "multilevel. total bank1 = $4709"
(list "$4,709.00")
(sxml->table-row-col sxml 1 10 4))
(test-equal "multilevel. broker = $2,000.00"
(list "$2,000.00")
(sxml->table-row-col sxml 1 11 4))
(test-equal "multilevel. funds = $15,000.00"
(list "30 FUNDS" "$15,000.00" "$15,000.00")
(sxml->table-row-col sxml 1 12 3))
(test-equal "multilevel. total broker = $17,000.00"
(list "$17,000.00")
(sxml->table-row-col sxml 1 13 4))
(test-equal "multilevel. foreign = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 14 4))
(test-equal "multilevel. foreignsavings = #200.00 = $340"
(list "#200.00" "$340.00" "$340.00")
(sxml->table-row-col sxml 1 15 3))
(test-equal "multilevel. total foreign = $340"
(list "$340.00")
(sxml->table-row-col sxml 1 16 4))
(test-equal "multilevel. house = $100,000"
(list "$100,000.00")
(sxml->table-row-col sxml 1 17 4))
(test-equal "multilevel. total asset = $122,049"
(list "$122,049.00")
(sxml->table-row-col sxml 1 18 5))
(test-equal "multilevel. total root = $122,049"
(list "$122,049.00")
(sxml->table-row-col sxml 1 19 6))
(test-equal "multilevel. total assets = $122,049"
(list "$122,049.00")
(sxml->table-row-col sxml 1 20 6)))
;; set recursive-subtotal subtotal style
(set-option! balance-sheet-options "Display" "Parent account balances" 'recursive-bal)
(set-option! balance-sheet-options "Display" "Parent account subtotals" 'f)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-recursive")))
(test-equal "recursive. root = $760+15000+104600"
(list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "recursive. assets = $760+15000+104600"
(list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
(sxml->table-row-col sxml 1 4 5))
(test-equal "recursive. bank1 = $4,709.00"
(list "$4,709.00")
(sxml->table-row-col sxml 1 5 4))
(test-equal "recursive. bonds = $2,000.00"
(list "$2,000.00")
(sxml->table-row-col sxml 1 6 3))
(test-equal "recursive. current = $2609.00"
(list "$2,609.00")
(sxml->table-row-col sxml 1 7 3))
(test-equal "recursive. empty = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 8 3))
(test-equal "recursive. savings = $100.00"
(list "$100.00")
(sxml->table-row-col sxml 1 9 3))
(test-equal "recursive. broker = $15000+2000.00"
(list "30 FUNDS" "$15,000.00" "$2,000.00" "$2,000.00")
(sxml->table-row-col sxml 1 10 4))
(test-equal "recursive. funds = $15,000.00"
(list "30 FUNDS" "$15,000.00" "$15,000.00")
(sxml->table-row-col sxml 1 11 3))
(test-equal "recursive. foreign = $340.00"
(list "#200.00" "$340.00")
(sxml->table-row-col sxml 1 12 4))
(test-equal "recursive. foreignsavings = #200.00 = $340"
(list "#200.00" "$340.00" "$340.00")
(sxml->table-row-col sxml 1 13 3))
(test-equal "recursive. house = $100,000"
(list "$100,000.00")
(sxml->table-row-col sxml 1 14 4))
(test-equal "recursive. total assets = $122,049.00"
(list "$122,049.00")
(sxml->table-row-col sxml 1 15 6)))
(set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #f)
(set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #f)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-disable show-fcur show-rates")))
(test-equal "show-fcur disabled"
(list "$122,049.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "show-rates disabled"
'()
(sxml->table-row-col sxml 2 #f #f)))
(set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #t)
(set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t) (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-enable show-fcur show-rates"))) balance-sheet-options))
(test-equal "show-fcur enabled" (display "\n\n balsheet tests\n\n")
(list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00") (let* ((balance-sheet-options (default-balsheet-testing-options))
(sxml->table-row-col sxml 1 3 6)) (sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-default")))
(test-equal "show-rates enabled"
(list "1 FUNDS" "$500.00" "#1.00" "$1.70")
(sxml->table-row-col sxml 2 #f #f)))
;;make-multilevel (test-equal "total assets = $116,009"
(set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal) (list "$116,009.00")
(set-option! balance-sheet-options "Display" "Parent account subtotals" 't) (sxml->table-row-col sxml 1 15 6))
(test-equal "total liabilities = $9,500.00"
(list "$9,500.00")
(sxml->table-row-col sxml 1 23 6))
(test-equal "total equity = $106,509.00"
(list "$106,509.00")
(sxml->table-row-col sxml 1 28 6))
(set-option! balance-sheet-options "Display" "Omit zero balance figures" #t) (set-option! balance-sheet-options "Commodities" "Price Source" 'weighted-average)
(set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #f) (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-weighted-average")))
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#f omit-zb-bals=#t"))) (test-equal "weighted average assets = $114,071.66"
(test-equal "omit-zb-bals=#t" (list "$114,071.66")
'() (sxml->table-row-col sxml 1 15 6)))
(sxml->table-row-col sxml 1 3 5))
(test-equal "incl-zb-accts=#f"
'("Savings" "$100.00") ;i.e.skips "Empty" account with $0.00
(sxml->table-row-col sxml 1 8 #f)))
(set-option! balance-sheet-options "Display" "Omit zero balance figures" #f) (set-option! balance-sheet-options "Commodities" "Price Source" 'average-cost)
(set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #t) (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-average-cost")))
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#t omit-zb-bals=#f"))) (test-equal "average-cost assets = $113,100"
(test-equal "omit-zb-bals=#f" (list "$113,100.00")
(list "$0.00") (sxml->table-row-col sxml 1 15 6)))
(sxml->table-row-col sxml 1 3 6))
(test-equal "incl-zb-accts=#t"
'("Empty" "$0.00")
(sxml->table-row-col sxml 1 8 #f)))
)
(display "\n\n pnl tests\n\n") (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-nearest)
(let* ((pnl-options (default-pnl-testing-options)) (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-nearest")))
(sxml (options->sxml pnl-uuid pnl-options "pnl-default"))) (test-equal "pricedb-nearest assets = $116,009"
(test-equal "total revenue = $1,270.00" (list "$116,009.00")
(sxml->table-row-col sxml 1 15 6)))
(set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-latest)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-latest")))
(test-equal "pricedb-latest assets = $122,049"
(list "$122,049.00")
(sxml->table-row-col sxml 1 15 6)))
;; set multilevel subtotal style
;; verifies amount in EVERY line of the report.
(set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
(set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-multilevel")))
(test-equal "multilevel. root = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "multilevel. assets = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 4 5))
(test-equal "multilevel. bank1 = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 5 4))
(test-equal "multilevel. bonds = $2,000.00"
(list "$2,000.00")
(sxml->table-row-col sxml 1 6 3))
(test-equal "multilevel. current = $2609.00"
(list "$2,609.00")
(sxml->table-row-col sxml 1 7 3))
(test-equal "multilevel. empty = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 8 3))
(test-equal "multilevel. savings = $100.00"
(list "$100.00")
(sxml->table-row-col sxml 1 9 3))
(test-equal "multilevel. total bank1 = $4709"
(list "$4,709.00")
(sxml->table-row-col sxml 1 10 4))
(test-equal "multilevel. broker = $2,000.00"
(list "$2,000.00")
(sxml->table-row-col sxml 1 11 4))
(test-equal "multilevel. funds = $15,000.00"
(list "30 FUNDS" "$15,000.00" "$15,000.00")
(sxml->table-row-col sxml 1 12 3))
(test-equal "multilevel. total broker = $17,000.00"
(list "$17,000.00")
(sxml->table-row-col sxml 1 13 4))
(test-equal "multilevel. foreign = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 14 4))
(test-equal "multilevel. foreignsavings = #200.00 = $340"
(list "#200.00" "$340.00" "$340.00")
(sxml->table-row-col sxml 1 15 3))
(test-equal "multilevel. total foreign = $340"
(list "$340.00")
(sxml->table-row-col sxml 1 16 4))
(test-equal "multilevel. house = $100,000"
(list "$100,000.00")
(sxml->table-row-col sxml 1 17 4))
(test-equal "multilevel. total asset = $122,049"
(list "$122,049.00")
(sxml->table-row-col sxml 1 18 5))
(test-equal "multilevel. total root = $122,049"
(list "$122,049.00")
(sxml->table-row-col sxml 1 19 6))
(test-equal "multilevel. total assets = $122,049"
(list "$122,049.00")
(sxml->table-row-col sxml 1 20 6)))
;; set recursive-subtotal subtotal style
(set-option! balance-sheet-options "Display" "Parent account balances" 'recursive-bal)
(set-option! balance-sheet-options "Display" "Parent account subtotals" 'f)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-recursive")))
(test-equal "recursive. root = $760+15000+104600"
(list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "recursive. assets = $760+15000+104600"
(list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
(sxml->table-row-col sxml 1 4 5))
(test-equal "recursive. bank1 = $4,709.00"
(list "$4,709.00")
(sxml->table-row-col sxml 1 5 4))
(test-equal "recursive. bonds = $2,000.00"
(list "$2,000.00")
(sxml->table-row-col sxml 1 6 3))
(test-equal "recursive. current = $2609.00"
(list "$2,609.00")
(sxml->table-row-col sxml 1 7 3))
(test-equal "recursive. empty = $0.00"
(list "$0.00")
(sxml->table-row-col sxml 1 8 3))
(test-equal "recursive. savings = $100.00"
(list "$100.00")
(sxml->table-row-col sxml 1 9 3))
(test-equal "recursive. broker = $15000+2000.00"
(list "30 FUNDS" "$15,000.00" "$2,000.00" "$2,000.00")
(sxml->table-row-col sxml 1 10 4))
(test-equal "recursive. funds = $15,000.00"
(list "30 FUNDS" "$15,000.00" "$15,000.00")
(sxml->table-row-col sxml 1 11 3))
(test-equal "recursive. foreign = $340.00"
(list "#200.00" "$340.00")
(sxml->table-row-col sxml 1 12 4))
(test-equal "recursive. foreignsavings = #200.00 = $340"
(list "#200.00" "$340.00" "$340.00")
(sxml->table-row-col sxml 1 13 3))
(test-equal "recursive. house = $100,000"
(list "$100,000.00")
(sxml->table-row-col sxml 1 14 4))
(test-equal "recursive. total assets = $122,049.00"
(list "$122,049.00")
(sxml->table-row-col sxml 1 15 6)))
(set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #f)
(set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #f)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-disable show-fcur show-rates")))
(test-equal "show-fcur disabled"
(list "$122,049.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "show-rates disabled"
'()
(sxml->table-row-col sxml 2 #f #f)))
(set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #t)
(set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-enable show-fcur show-rates")))
(test-equal "show-fcur enabled"
(list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "show-rates enabled"
(list "1 FUNDS" "$500.00" "#1.00" "$1.70")
(sxml->table-row-col sxml 2 #f #f)))
;;make-multilevel
(set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
(set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
(set-option! balance-sheet-options "Display" "Omit zero balance figures" #t)
(set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #f)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#f omit-zb-bals=#t")))
(test-equal "omit-zb-bals=#t"
'()
(sxml->table-row-col sxml 1 3 5))
(test-equal "incl-zb-accts=#f"
'("Savings" "$100.00") ;i.e.skips "Empty" account with $0.00
(sxml->table-row-col sxml 1 8 #f)))
(set-option! balance-sheet-options "Display" "Omit zero balance figures" #f)
(set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #t)
(let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#t omit-zb-bals=#f")))
(test-equal "omit-zb-bals=#f"
(list "$0.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "incl-zb-accts=#t"
'("Empty" "$0.00")
(sxml->table-row-col sxml 1 8 #f)))))
(define (pnl-tests)
(define (default-pnl-testing-options)
(let ((pnl-options (gnc:make-report-options pnl-uuid)))
(set-option! pnl-options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1980)))
(set-option! pnl-options "General" "End Date" (cons 'absolute (gnc-dmy2time64 1 1 1981)))
(set-option! pnl-options "Accounts" "Levels of Subaccounts" 'all)
(set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
pnl-options))
(display "\n\n pnl tests\n\n")
(let* ((pnl-options (default-pnl-testing-options))
(sxml (options->sxml pnl-uuid pnl-options "pnl-default")))
(test-equal "total revenue = $1,270.00"
(list "$1,270.00")
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
sxml))
(test-equal "total expenses = $0.00"
(list "$0.00")
((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
sxml))
(set-option! pnl-options "Commodities" "Price Source" 'weighted-average)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average")))
(test-equal "weighted average revenue = $1160.36"
(list "$1,160.36")
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
sxml)))
(set-option! pnl-options "Commodities" "Price Source" 'average-cost)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost")))
(test-equal "average-cost revenue = $976"
(list "$976.00")
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
sxml)))
(set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest")))
(test-equal "pricedb-nearest revenue = $1270"
(list "$1,270.00") (list "$1,270.00")
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
sxml)))
(set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest")))
(test-equal "pricedb-latest revenue = $1270"
(list "$1,270.00")
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
sxml)))
;; set multilevel subtotal style
;; verifies amount in EVERY line of the report.
(set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
(set-option! pnl-options "Display" "Parent account subtotals" 't)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel")))
(test-equal "multilevel. income = -$250.00"
(list "-$250.00")
((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*))
sxml)) sxml))
(test-equal "total expenses = $0.00" (test-equal "multilevel. income-GBP = -#600"
(list "-#600.00" "-$1,020.00")
((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*))
sxml))
(test-equal "multilevel. total income = -$1,270.00"
(list "-$1,270.00")
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
sxml))
(test-equal "multilevel. total revenue = $1,270.00"
(list "$1,270.00")
((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*))
sxml))
(test-equal "multilevel. expenses = $0.00"
(list "$0.00") (list "$0.00")
((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*)) ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
sxml)) sxml))
(test-equal "multilevel. net-income = $1,270"
(list "$1,270.00")
((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*))
sxml)))
(set-option! pnl-options "Commodities" "Price Source" 'weighted-average) ;; set recursive-subtotal subtotal style
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average"))) (set-option! pnl-options "Display" "Parent account balances" 'recursive-bal)
(test-equal "weighted average revenue = $1160.36" (set-option! pnl-options "Display" "Parent account subtotals" 'f)
(list "$1,160.36") (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive")))
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) (test-equal "recursive. income = $1020+250"
sxml))) (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
(sxml->table-row-col sxml 1 3 6))
(test-equal "recursive. income-gbp = $1020"
(list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00")
(sxml->table-row-col sxml 1 4 5))
(test-equal "recursive. total revenue = $1270"
(list "$1,270.00" "$1,270.00")
(sxml->table-row-col sxml 1 5 6)))
(set-option! pnl-options "Commodities" "Price Source" 'average-cost) (set-option! pnl-options "Commodities" "Show Foreign Currencies" #f)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost"))) (set-option! pnl-options "Commodities" "Show Exchange Rates" #f)
(test-equal "average-cost revenue = $976" (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates")))
(list "$976.00") (test-equal "show-fcur disabled"
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) (list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00")
sxml))) (sxml->table-row-col sxml 1 3 6))
(test-equal "show-rates disabled"
'()
(sxml->table-row-col sxml 2 #f #f)))
(set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest) (set-option! pnl-options "Commodities" "Show Foreign Currencies" #t)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest"))) (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
(test-equal "pricedb-nearest revenue = $1270" (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates")))
(list "$1,270.00") (test-equal "show-fcur enabled"
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
sxml))) (sxml->table-row-col sxml 1 3 6))
(test-equal "show-rates enabled"
(list "#1.00" "$1.70")
(sxml->table-row-col sxml 2 #f #f)))
(set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest) ;;make-multilevel
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest"))) (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
(test-equal "pricedb-latest revenue = $1270" (set-option! pnl-options "Display" "Parent account subtotals" 't)))
(list "$1,270.00")
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
sxml)))
;; set multilevel subtotal style (define (multicol-balsheet-tests)
;; verifies amount in EVERY line of the report. (define (default-testing-options)
(set-option! pnl-options "Display" "Parent account balances" 'immediate-bal) (let ((options (gnc:make-report-options multicol-balsheet-uuid)))
(set-option! pnl-options "Display" "Parent account subtotals" 't) (set-option! options "General" "Start Date"
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel"))) (cons 'absolute (gnc-dmy2time64 1 1 1970)))
(test-equal "multilevel. income = -$250.00" (set-option! options "General" "End Date"
(list "-$250.00") (cons 'absolute (gnc-dmy2time64 1 1 1972)))
((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*)) (set-option! options "General" "Enable dual columns" #f)
sxml)) (set-option! options "General" "Disable amount indenting" #t)
(test-equal "multilevel. income-GBP = -#600" (set-option! options "Display" "Account full name instead of indenting" #t)
(list "-#600.00" "-$1,020.00") (set-option! options "Accounts" "Levels of Subaccounts" 'all)
((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*)) (set-option! options "Commodities" "Show Exchange Rates" #t)
sxml)) options))
(test-equal "multilevel. total income = -$1,270.00" (display "\n\n multicol-balsheet tests\n\n")
(list "-$1,270.00") (let* ((multi-bs-options (default-testing-options))
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*)) (sxml (options->sxml multicol-balsheet-uuid multi-bs-options
sxml)) "multicol-balsheet-default")))
(test-equal "multilevel. total revenue = $1,270.00" (test-equal "default row headers"
(list "$1,270.00") '("Asset" "Root" "Root.Asset" "Root.Asset.Bank1" "Root.Asset.Bank1.Bonds"
((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*)) "Root.Asset.Bank1.Current" "Root.Asset.Bank1.Empty" "Root.Asset.Bank1.Savings"
sxml)) "Root.Asset.Broker" "Root.Asset.Broker" "Root.Asset.Broker.Funds"
(test-equal "multilevel. expenses = $0.00" "Root.Asset.ForeignBank" "Root.Asset.ForeignBank.ForeignSavings"
(list "$0.00") "Root.Asset.House" "Total For Asset" "Liability" "Root.Liability"
((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*)) "Root.Liability.Bank2" "Root.Liability.Bank2.CreditCard"
sxml)) "Root.Liability.Bank2.Loan" "Total For Liability" "Equity" "Root.Equity"
(test-equal "multilevel. net-income = $1,270" "Retained Earnings" "Total For Equity")
(list "$1,270.00") (sxml->table-row-col sxml 1 #f 1))
((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*)) (test-equal "default balances"
sxml))) '("#200.00" "$106,709.00" "30 FUNDS" "#200.00" "$106,709.00" "30 FUNDS"
"$4,709.00" "$2,000.00" "$2,609.00" "$0.00" "$100.00" "$2,000.00"
"30 FUNDS" "$2,000.00" "30 FUNDS" "#200.00" "#200.00" "$100,000.00"
"30 FUNDS" "#200.00" "$106,709.00" "$9,500.00" "$9,500.00" "$500.00"
"$9,000.00" "$9,500.00" "$103,600.00" "$0.00" "#0.00" "$103,600.00"
"#0.00")
(sxml->table-row-col sxml 1 #f 2))
;; set recursive-subtotal subtotal style ;; the following tests many parts of multicolumn balance sheet:
(set-option! pnl-options "Display" "Parent account balances" 'recursive-bal) ;; multiple-dates balances, unrealized-gain calculator, pricelists
(set-option! pnl-options "Display" "Parent account subtotals" 'f) (set-option! multi-bs-options "General" "Period duration" 'YearDelta)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive"))) (set-option! multi-bs-options "Commodities" "Common Currency" #t)
(test-equal "recursive. income = $1020+250" (set-option! multi-bs-options "Commodities" "Report's currency" USD)
(list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00") (let ((sxml (options->sxml multicol-balsheet-uuid multi-bs-options
(sxml->table-row-col sxml 1 3 6)) "multicol-balsheet-halfyear")))
(test-equal "recursive. income-gbp = $1020" (test-equal "bal-1/1/70"
(list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00") '("01/01/70" "$113,100.00" "$113,100.00" "$8,970.00" "$2,000.00" "$6,870.00"
(sxml->table-row-col sxml 1 4 5)) "$0.00" "$100.00" "$4,000.00" "$2,000.00" "$2,000.00" "10 FUNDS " "$130.00"
(test-equal "recursive. total revenue = $1270" "$130.00" "#100.00 " "$100,000.00" "$113,100.00" "$9,500.00" "$9,500.00"
(list "$1,270.00" "$1,270.00") "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$0.00" "$0.00"
(sxml->table-row-col sxml 1 5 6))) "$103,600.00" "1 FUNDS $200.00" "#1.00 $1.30")
(sxml->table-row-col sxml 1 #f 2))
(test-equal "bal-1/1/71"
'("01/01/71" "$116,009.00" "$116,009.00" "$4,709.00" "$2,000.00" "$2,609.00"
"$0.00" "$100.00" "$11,000.00" "$2,000.00" "$9,000.00" "30 FUNDS " "$300.00"
"$300.00" "#200.00 " "$100,000.00" "$116,009.00" "$9,500.00" "$9,500.00"
"$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$2,909.00" "$0.00"
"$106,509.00" "1 FUNDS $300.00" "#1.00 $1.50")
(sxml->table-row-col sxml 1 #f 3))
(test-equal "bal-1/1/72"
'("01/01/72" "$117,529.00" "$117,529.00" "$4,709.00" "$2,000.00" "$2,609.00"
"$0.00" "$100.00" "$12,500.00" "$2,000.00" "$10,500.00" "30 FUNDS " "$320.00"
"$320.00" "#200.00 " "$100,000.00" "$117,529.00" "$9,500.00" "$9,500.00"
"$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$4,429.00" "$0.00"
"$108,029.00" "1 FUNDS $350.00" "#1.00 $1.60")
(sxml->table-row-col sxml 1 #f 4)))))
(set-option! pnl-options "Commodities" "Show Foreign Currencies" #f) (define (multicol-pnl-tests)
(set-option! pnl-options "Commodities" "Show Exchange Rates" #f) (define (default-testing-options)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates"))) (let ((options (gnc:make-report-options multicol-pnl-uuid)))
(test-equal "show-fcur disabled" (set-option! options "General" "Start Date"
(list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00") (cons 'absolute (gnc-dmy2time64 1 1 1980)))
(sxml->table-row-col sxml 1 3 6)) (set-option! options "General" "End Date"
(test-equal "show-rates disabled" (cons 'absolute (gnc-dmy2time64 31 3 1980)))
'() (set-option! options "General" "Enable dual columns" #f)
(sxml->table-row-col sxml 2 #f #f))) (set-option! options "General" "Disable amount indenting" #t)
(set-option! options "Display" "Account full name instead of indenting" #t)
(set-option! options "Accounts" "Levels of Subaccounts" 'all)
(set-option! options "Commodities" "Show Exchange Rates" #t)
options))
(display "\n\n multicol-pnl tests\n\n")
(let* ((multi-bs-options (default-testing-options))
(sxml (options->sxml multicol-pnl-uuid multi-bs-options
"multicol-pnl-default")))
(test-equal "default row headers"
'("Income" "Root.Income" "Root.Income" "Root.Income.Income-GBP"
"Total For Income")
(sxml->table-row-col sxml 1 #f 1))
(test-equal "default pnl"
'("$250.00" "#600.00" "$250.00" "#600.00" "$250.00" "#600.00")
(sxml->table-row-col sxml 1 #f 2))
(set-option! pnl-options "Commodities" "Show Foreign Currencies" #t) ;; the following tests many parts of multicolumn pnl:
(set-option! pnl-options "Commodities" "Show Exchange Rates" #t) ;; multiple-dates pnl
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates"))) (set-option! multi-bs-options "General" "Period duration" 'MonthDelta)
(test-equal "show-fcur enabled" (set-option! multi-bs-options "Commodities" "Common Currency" #t)
(list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00") (set-option! multi-bs-options "Commodities" "Report's currency" USD)
(sxml->table-row-col sxml 1 3 6)) (let ((sxml (options->sxml multicol-pnl-uuid multi-bs-options
(test-equal "show-rates enabled" "multicol-pnl-halfyear")))
(list "#1.00" "$1.70") (test-equal "pnl-1/80"
(sxml->table-row-col sxml 2 #f #f))) '("01/01/80" " to 01/31/80" "$1,100.00" "$250.00" "$850.00" "#500.00 "
"$1,100.00" "#1.00 $1.70")
;;make-multilevel (sxml->table-row-col sxml 1 #f 2))
(set-option! pnl-options "Display" "Parent account balances" 'immediate-bal) (test-equal "pnl-2/80"
(set-option! pnl-options "Display" "Parent account subtotals" 't) '("02/01/80" " to 02/29/80" "$170.00" "$0.00" "$170.00" "#100.00 "
))) "$170.00" "#1.00 $1.70")
(sxml->table-row-col sxml 1 #f 3))
(test-equal "pnl-3/80"
'("03/01/80" " to 03/31/80" "$0.00" "$0.00" "$0.00" "#0.00 "
"$0.00" "#1.00 $1.70")
(sxml->table-row-col sxml 1 #f 4)))))

10
gnucash/report/test/test-report-utilities.scm
View File

@ -151,6 +151,16 @@
(test-equal "gnc:strify <val-coll 10>" (test-equal "gnc:strify <val-coll 10>"
"coll<10>" "coll<10>"
(gnc:strify coll))) (gnc:strify coll)))
(let ((ht (make-hash-table)))
(test-equal "gnc:strify Hash()"
"Hash()"
(gnc:strify ht))
(hash-set! ht 'one "uno")
(test-equal "gnc:strify Hash(one=uno)"
"Hash(one=uno)"
(gnc:strify ht)))
(test-end "debugging tools")) (test-end "debugging tools"))
(define (test-commodity-collector) (define (test-commodity-collector)