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

2001-06-02 Dave Peticolas <dave@krondo.com>

Browse Source 
* src/scm/report/price-scatter.scm: same as below

	* src/scm/prefs.scm: same as below

	* src/gnc-ui-util.c: same as below

	* src/gnome/druid-qif-import.c: same as below

	* src/gnome/dialog-price-editor.c: same as below

	* src/gnome/dialog-fincalc.c: same as below

	* src/SplitLedger.c: use gnc_default_currency instead
	of gnc_locale_default_currency.

	* src/scm/options-utilities.scm: use new func

	* src/scm/report/transaction-report.scm: handle splits with no
	account

	* src/gnome/dialog-account.c: use new func

	* src/gnome/window-main-summarybar.c: use new func

	* src/guile/gnc.gwp: wrap new func below

	* src/guile/global-options.c (gnc_default_currency): new func
	to return user-set default currency

	* src/engine/gnc-book.c (gnc_book_backup_file): use g_free
	instead of free.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4377 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-06-02 21:15:40 +00:00
parent 18b559e084
commit e078856530
13 changed files with 499 additions and 464 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
ChangeLog
View File

@ -1,3 +1,37 @@
2001-06-02 Dave Peticolas <dave@krondo.com>
* src/scm/report/price-scatter.scm: same as below
* src/scm/prefs.scm: same as below
* src/gnc-ui-util.c: same as below
* src/gnome/druid-qif-import.c: same as below
* src/gnome/dialog-price-editor.c: same as below
* src/gnome/dialog-fincalc.c: same as below
* src/SplitLedger.c: use gnc_default_currency instead
of gnc_locale_default_currency.
* src/scm/options-utilities.scm: use new func
* src/scm/report/transaction-report.scm: handle splits with no
account
* src/gnome/dialog-account.c: use new func
* src/gnome/window-main-summarybar.c: use new func
* src/guile/gnc.gwp: wrap new func below
* src/guile/global-options.c (gnc_default_currency): new func
to return user-set default currency
* src/engine/gnc-book.c (gnc_book_backup_file): use g_free
instead of free.
2001-06-02 Christian Stimming <stimming@tuhh.de> 2001-06-02 Christian Stimming <stimming@tuhh.de>
* po/gnc-glossary.txt: Updated glossary, 15 new terms, and lots of * po/gnc-glossary.txt: Updated glossary, 15 new terms, and lots of

8
src/SplitLedger.c
View File

@ -590,7 +590,7 @@ gnc_split_get_value_denom (Split *split)
denom = xaccAccountGetCurrencySCU (xaccSplitGetAccount (split)); denom = xaccAccountGetCurrencySCU (xaccSplitGetAccount (split));
if (denom == 0) if (denom == 0)
{ {
gnc_commodity *commodity = gnc_locale_default_currency (); gnc_commodity *commodity = gnc_default_currency ();
denom = gnc_commodity_get_fraction (commodity); denom = gnc_commodity_get_fraction (commodity);
if (denom == 0) if (denom == 0)
denom = 100; denom = 100;
@ -607,7 +607,7 @@ gnc_split_get_quantity_denom (Split *split)
denom = xaccAccountGetCommoditySCU (xaccSplitGetAccount (split)); denom = xaccAccountGetCommoditySCU (xaccSplitGetAccount (split));
if (denom == 0) if (denom == 0)
{ {
gnc_commodity *commodity = gnc_locale_default_currency (); gnc_commodity *commodity = gnc_default_currency ();
denom = gnc_commodity_get_fraction (commodity); denom = gnc_commodity_get_fraction (commodity);
if (denom == 0) if (denom == 0)
denom = 100; denom = 100;
@ -644,7 +644,7 @@ sr_set_cell_fractions (SplitRegister *reg, Split *split)
xaccSetPriceCellFraction (reg->sharesCell, 10000); xaccSetPriceCellFraction (reg->sharesCell, 10000);
commodity = gnc_locale_default_currency (); commodity = gnc_default_currency ();
fraction = gnc_commodity_get_fraction (commodity); fraction = gnc_commodity_get_fraction (commodity);
xaccSetPriceCellFraction (reg->debitCell, fraction); xaccSetPriceCellFraction (reg->debitCell, fraction);
@ -3681,7 +3681,7 @@ xaccSRGetEntryHandler (VirtualLocation virt_loc,
currency = xaccTransGetCurrency (trans); currency = xaccTransGetCurrency (trans);
if (!currency) if (!currency)
currency = gnc_locale_default_currency (); currency = gnc_default_currency ();
imbalance = gnc_numeric_convert (imbalance, imbalance = gnc_numeric_convert (imbalance,
gnc_commodity_get_fraction (currency), gnc_commodity_get_fraction (currency),

5
src/engine/gnc-book.c
View File

@ -463,14 +463,15 @@ gnc_book_backup_file(GNCBook *book)
} }
g_free(bin_bkup); g_free(bin_bkup);
} }
timestamp = xaccDateUtilGetStampNow (); timestamp = xaccDateUtilGetStampNow ();
backup = g_new (char, strlen (datafile) + strlen (timestamp) + 6); backup = g_new (char, strlen (datafile) + strlen (timestamp) + 6);
strcpy (backup, datafile); strcpy (backup, datafile);
strcat (backup, "."); strcat (backup, ".");
strcat (backup, timestamp); strcat (backup, timestamp);
strcat (backup, ".xac"); strcat (backup, ".xac");
free (timestamp); g_free (timestamp);
if(link(datafile, backup) != 0) if(link(datafile, backup) != 0)
{ {
gnc_book_push_error( gnc_book_push_error(

4
src/gnc-ui-util.c
View File

@ -520,7 +520,7 @@ gnc_find_or_create_equity_account (GNCEquityType equity_type,
} }
if (!base_name_exists && if (!base_name_exists &&
gnc_commodity_equiv (currency, gnc_locale_default_currency ())) gnc_commodity_equiv (currency, gnc_default_currency ()))
{ {
g_free (name); g_free (name);
name = g_strdup (base_name); name = g_strdup (base_name);
@ -777,7 +777,7 @@ gnc_default_print_info (gboolean use_symbol)
lc = gnc_localeconv (); lc = gnc_localeconv ();
info.commodity = gnc_locale_default_currency (); info.commodity = gnc_default_currency ();
info.max_decimal_places = lc->frac_digits; info.max_decimal_places = lc->frac_digits;
info.min_decimal_places = lc->frac_digits; info.min_decimal_places = lc->frac_digits;

4
src/gnome/dialog-account.c
View File

@ -1849,9 +1849,7 @@ gnc_ui_new_account_window_internal (Account *base_account,
gnc_resume_gui_refresh (); gnc_resume_gui_refresh ();
commodity = gnc_lookup_currency_option ("International", commodity = gnc_default_currency ();
"Default Currency",
gnc_locale_default_currency ());
gnc_commodity_edit_set_commodity (GNC_COMMODITY_EDIT (aw->currency_edit), gnc_commodity_edit_set_commodity (GNC_COMMODITY_EDIT (aw->currency_edit),
commodity); commodity);

5
src/gnome/dialog-fincalc.c
View File

@ -32,6 +32,7 @@
#include "finvar.h" #include "finvar.h"
#include "glade-gnc-dialogs.h" #include "glade-gnc-dialogs.h"
#include "glade-support.h" #include "glade-support.h"
#include "global-options.h"
#include "gnc-amount-edit.h" #include "gnc-amount-edit.h"
#include "gnc-commodity.h" #include "gnc-commodity.h"
#include "gnc-component-manager.h" #include "gnc-component-manager.h"
@ -148,7 +149,7 @@ fi_to_gui(FinCalcDialog *fcd)
pmt = double_to_gnc_numeric (fcd->financial_info.pmt, 100000, GNC_RND_ROUND); pmt = double_to_gnc_numeric (fcd->financial_info.pmt, 100000, GNC_RND_ROUND);
commodity = gnc_locale_default_currency (); commodity = gnc_default_currency ();
total = gnc_numeric_mul (npp, pmt, gnc_commodity_get_fraction (commodity), total = gnc_numeric_mul (npp, pmt, gnc_commodity_get_fraction (commodity),
GNC_RND_ROUND); GNC_RND_ROUND);
@ -501,7 +502,7 @@ gnc_ui_fincalc_dialog_create(void)
GtkWidget *hbox; GtkWidget *hbox;
GtkWidget *edit; GtkWidget *edit;
commodity = gnc_locale_default_currency (); commodity = gnc_default_currency ();
fcd = g_new0(FinCalcDialog, 1); fcd = g_new0(FinCalcDialog, 1);

3
src/gnome/dialog-price-editor.c
View File

@ -31,6 +31,7 @@
#include "dialog-utils.h" #include "dialog-utils.h"
#include "glade-gnc-dialogs.h" #include "glade-gnc-dialogs.h"
#include "glade-support.h" #include "glade-support.h"
#include "global-options.h"
#include "gnc-amount-edit.h" #include "gnc-amount-edit.h"
#include "gnc-commodity-edit.h" #include "gnc-commodity-edit.h"
#include "gnc-component-manager.h" #include "gnc-component-manager.h"
@ -301,7 +302,7 @@ price_to_gui (PricesDialog *pdb_dialog)
else else
{ {
commodity = NULL; commodity = NULL;
currency = gnc_locale_default_currency (); currency = gnc_default_currency ();
date.tv_sec = time (NULL); date.tv_sec = time (NULL);
date.tv_nsec = 0; date.tv_nsec = 0;
source = ""; source = "";

2
src/gnome/druid-qif-import.c
View File

@ -256,7 +256,7 @@ gnc_ui_qif_import_druid_make(void) {
gnc_ui_update_commodity_picker(retval->currency_picker, gnc_ui_update_commodity_picker(retval->currency_picker,
GNC_COMMODITY_NS_ISO, GNC_COMMODITY_NS_ISO,
gnc_commodity_get_printname gnc_commodity_get_printname
(gnc_locale_default_currency())); (gnc_default_currency()));
if(!retval->show_doc_pages) { if(!retval->show_doc_pages) {
gnome_druid_set_page(GNOME_DRUID(retval->druid), gnome_druid_set_page(GNOME_DRUID(retval->druid),

15
src/gnome/window-main-summarybar.c
View File

@ -260,10 +260,7 @@ gnc_ui_accounts_recurse (AccountGroup *group, GList **currency_list,
GList *list; GList *list;
GList *node; GList *node;
default_currency = default_currency = gnc_default_currency ();
gnc_lookup_currency_option("International",
"Default Currency",
gnc_locale_default_currency ());
if (euro) if (euro)
{ {
@ -366,10 +363,7 @@ gnc_main_window_summary_refresh (GNCMainSummary * summary)
GList *current; GList *current;
gboolean euro; gboolean euro;
default_currency = default_currency = gnc_default_currency ();
gnc_lookup_currency_option("International",
"Default Currency",
gnc_locale_default_currency ());
euro = gnc_lookup_boolean_option("International", euro = gnc_lookup_boolean_option("International",
"Enable EURO support", "Enable EURO support",
@ -460,10 +454,7 @@ gnc_main_window_summary_new (void) {
GNCMainSummary * retval = g_new0(GNCMainSummary, 1); GNCMainSummary * retval = g_new0(GNCMainSummary, 1);
GtkWidget * summarybar; GtkWidget * summarybar;
GNCCurrencyItem * def_item; GNCCurrencyItem * def_item;
gnc_commodity * default_currency = gnc_commodity * default_currency = gnc_default_currency ();
gnc_lookup_currency_option ("International",
"Default Currency",
gnc_locale_default_currency ());
retval->hbox = gtk_hbox_new (FALSE, 5); retval->hbox = gtk_hbox_new (FALSE, 5);
retval->totals_combo = gtk_select_new (); retval->totals_combo = gtk_select_new ();

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

@ -199,9 +199,7 @@
pagename name-report-currency pagename name-report-currency
sort-tag sort-tag
(N_ "Select the currency to display the values of this report in.") (N_ "Select the currency to display the values of this report in.")
(gnc:option-value (gnc:default-currency))))
(gnc:lookup-global-option "International"
"Default Currency")))))
;; These are common options for the selection of the report's ;; These are common options for the selection of the report's
;; currency/commodity. ;; currency/commodity.

3
src/scm/prefs.scm
View File

@ -168,8 +168,7 @@
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
(N_ "International") (N_ "Enable EURO support") (N_ "International") (N_ "Enable EURO support")
"d" (N_ "Enables support for the European Union EURO currency") "d" (N_ "Enables support for the European Union EURO currency")
(gnc:is-euro-currency (gnc:is-euro-currency (gnc:default-currency))))
(gnc:locale-default-currency))))
;;; Register options ;;; Register options

6
src/scm/report/price-scatter.scm
View File

@ -63,14 +63,14 @@
(gnc:options-add-currency! (gnc:options-add-currency!
options pagename-price optname-report-currency "d") options pagename-price optname-report-currency "d")
(add-option (add-option
(gnc:make-commodity-option (gnc:make-commodity-option
pagename-price optname-price-commodity pagename-price optname-price-commodity
"e" "e"
(N_ "Calculate the price of this commodity.") (N_ "Calculate the price of this commodity.")
(gnc:locale-default-currency))) (gnc:default-currency)))
(add-option (add-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
pagename-price optname-price-source pagename-price optname-price-source

870
src/scm/report/transaction-report.scm
View File

@ -36,7 +36,8 @@
(let-syntax ((addto! (let-syntax ((addto!
(syntax-rules () (syntax-rules ()
((_ alist element) (set! alist (cons element alist)))))) ((_ alist element)
(set! alist (cons element alist))))))
(let ((pagename-sorting (N_ "Sorting")) (let ((pagename-sorting (N_ "Sorting"))
(optname-prime-sortkey (N_ "Primary Key")) (optname-prime-sortkey (N_ "Primary Key"))
@ -105,10 +106,10 @@
(define (render-account-full-name-subheading (define (render-account-full-name-subheading
split table width subheading-style) split table width subheading-style)
(let ((account (gnc:split-get-account split))) (let ((account (gnc:split-get-account split)))
(add-subheading-row (gnc:make-html-text (gnc:html-markup-anchor (add-subheading-row (gnc:make-html-text
(gnc:account-anchor-text account) (gnc:html-markup-anchor
(gnc:account-get-full-name (gnc:account-anchor-text account)
account))) (gnc:account-get-full-name account)))
table width subheading-style))) table width subheading-style)))
(define (render-account-code-subheading split table (define (render-account-code-subheading split table
@ -149,11 +150,11 @@
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
subtotal-style subtotal-style
(list (gnc:make-html-table-cell/size 1 (- width 1) (list (gnc:make-html-table-cell/size 1 (- width 1)
subtotal-string) subtotal-string)
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"total-number-cell" "total-number-cell"
(car currency-totals)))) (car currency-totals))))
(for-each (lambda (currency) (for-each (lambda (currency)
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
@ -182,8 +183,9 @@
(define (render-corresponding-account-name-subtotal (define (render-corresponding-account-name-subtotal
table width split total-collector subtotal-style) table width split total-collector subtotal-style)
(add-subtotal-row table width (total-string (add-subtotal-row table width
(gnc:split-get-corr-account-full-name split)) (total-string
(gnc:split-get-corr-account-full-name split))
total-collector subtotal-style)) total-collector subtotal-style))
(define (render-corresponding-account-code-subtotal (define (render-corresponding-account-code-subtotal
@ -326,7 +328,9 @@
(account (gnc:split-get-account split)) (account (gnc:split-get-account split))
(account-type (gw:enum-<gnc:AccountType>-val->sym (account-type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type account) #f)) (gnc:account-get-type account) #f))
(currency (gnc:account-get-commodity account)) (currency (if account
(gnc:account-get-commodity account)
(gnc:default-currency)))
(damount (gnc:split-get-share-amount split)) (damount (gnc:split-get-share-amount split))
(split-value (gnc:make-gnc-monetary (split-value (gnc:make-gnc-monetary
currency currency
@ -372,7 +376,8 @@
(if (used-price column-vector) (if (used-price column-vector)
(addto! (addto!
row-contents row-contents
(gnc:make-gnc-monetary currency (gnc:split-get-share-price split)))) (gnc:make-gnc-monetary currency
(gnc:split-get-share-price split))))
(if (used-amount-single column-vector) (if (used-amount-single column-vector)
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup "number-cell" (gnc:make-html-table-cell/markup "number-cell"
@ -395,7 +400,8 @@
"number-cell" "number-cell"
(gnc:make-gnc-monetary currency (gnc:make-gnc-monetary currency
(gnc:split-get-balance split))))) (gnc:split-get-balance split)))))
(gnc:html-table-append-row/markup! table row-style (reverse row-contents)) (gnc:html-table-append-row/markup! table row-style
(reverse row-contents))
split-value)) split-value))
(define (trep-options-generator) (define (trep-options-generator)
@ -436,7 +442,8 @@
(gnc:get-current-group))) (gnc:get-current-group)))
(first-account (gnc:group-get-account (first-account (gnc:group-get-account
(gnc:get-current-group) 0))) (gnc:get-current-group) 0)))
(cond ((not (null? current-accounts)) (list (car current-accounts))) (cond ((not (null? current-accounts))
(list (car current-accounts)))
((> num-accounts 0) (list first-account)) ((> num-accounts 0) (list first-account))
(else ())))) (else ()))))
#f #t)) #f #t))
@ -590,477 +597,482 @@
(list (N_ "Account") "e" (N_ "Display the account?") #f) (list (N_ "Account") "e" (N_ "Display the account?") #f)
(list (N_ "Use Full Account Name?") "f" (list (N_ "Use Full Account Name?") "f"
(N_ "Display the full account name") #t) (N_ "Display the full account name") #t)
(list (N_ "Other Account")"g" (list (N_ "Other Account") "g"
(N_ "Display the other account? \ (N_ "Display the other account?\
(if this is a split transaction, this parameter is guessed).") #f) (if this is a split transaction, this parameter is guessed).") #f)
(list (N_ "Shares") "h" (N_ "Display the number of shares?") #f) (list (N_ "Shares") "h" (N_ "Display the number of shares?") #f)
(list (N_ "Price") "i" "Display the shares price?" #f) (list (N_ "Price") "i" "Display the shares price?" #f)
;; note the "Amount" multichoice option in between here ;; note the "Amount" multichoice option in between here
(list (N_ "Running Balance") "k" (N_ "Display a running balance") #f) (list (N_ "Running Balance") "k" (N_ "Display a running balance") #f)
(list (N_ "Totals") "l" (N_ "Display the totals?") #t))) (list (N_ "Totals") "l" (N_ "Display the totals?") #t)))
(gnc:register-trep-option (gnc:register-trep-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
gnc:pagename-display (N_ "Amount") gnc:pagename-display (N_ "Amount")
"j" (N_ "Display the amount?") "j" (N_ "Display the amount?")
'single 'single
(list (list
(vector 'none (N_ "None") (N_ "No amount display")) (vector 'none (N_ "None") (N_ "No amount display"))
(vector 'single (N_ "Single") (N_ "Single Column Display")) (vector 'single (N_ "Single") (N_ "Single Column Display"))
(vector 'double (N_ "Double") (N_ "Two Column Display"))))) (vector 'double (N_ "Double") (N_ "Two Column Display")))))
(gnc:register-trep-option (gnc:register-trep-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
gnc:pagename-display (N_ "Sign Reverses?") gnc:pagename-display (N_ "Sign Reverses?")
"m" "Reverse amount display for certain account types" "m" "Reverse amount display for certain account types"
'credit-accounts 'credit-accounts
(list (list
(vector 'none (N_ "None") (N_ "Don't change any displayed amounts")) (vector 'none (N_ "None") (N_ "Don't change any displayed amounts"))
(vector 'income-expense (N_ "Income and Expense") (vector 'income-expense (N_ "Income and Expense")
(N_ "Reverse amount display for Income and Expense Accounts")) (N_ "Reverse amount display for Income and Expense Accounts"))
(vector 'credit-accounts (N_ "Credit Accounts") (vector 'credit-accounts (N_ "Credit Accounts")
(N_ "Reverse amount display for Liability, Equity, Credit Card,\ (N_ "Reverse amount display for Liability, Equity, Credit Card,\
and Income accounts"))))) and Income accounts")))))
(gnc:options-set-default-section gnc:*transaction-report-options* (gnc:options-set-default-section gnc:*transaction-report-options*
gnc:pagename-general) gnc:pagename-general)
gnc:*transaction-report-options*) gnc:*transaction-report-options*)
(define (display-date-interval begin end) (define (display-date-interval begin end)
(let ((begin-string (strftime "%x" (localtime (car begin)))) (let ((begin-string (strftime "%x" (localtime (car begin))))
(end-string (strftime "%x" (localtime (car end))))) (end-string (strftime "%x" (localtime (car end)))))
(sprintf #f (_ "From %s To %s") begin-string end-string))) (sprintf #f (_ "From %s To %s") begin-string end-string)))
(define (get-primary-subtotal-style options) (define (get-primary-subtotal-style options)
(let ((bgcolor (gnc:lookup-option options (let ((bgcolor (gnc:lookup-option options
(N_ "Colors") (N_ "Colors")
(N_ "Primary Subtotals/headings")))) (N_ "Primary Subtotals/headings"))))
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
(define (get-secondary-subtotal-style options) (define (get-secondary-subtotal-style options)
(let ((bgcolor (gnc:lookup-option options (let ((bgcolor (gnc:lookup-option options
(N_ "Colors") (N_ "Colors")
(N_ "Secondary Subtotals/headings")))) (N_ "Secondary Subtotals/headings"))))
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
(define (get-grand-total-style options) (define (get-grand-total-style options)
(let ((bgcolor (gnc:lookup-option options (let ((bgcolor (gnc:lookup-option options
(N_ "Colors") (N_ "Colors")
(N_ "Grand Total")))) (N_ "Grand Total"))))
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
(define (get-odd-row-style options) (define (get-odd-row-style options)
(let ((bgcolor (gnc:lookup-option options (let ((bgcolor (gnc:lookup-option options
(N_ "Colors") (N_ "Colors")
(N_ "Split Odd")))) (N_ "Split Odd"))))
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
(define (get-even-row-style options) (define (get-even-row-style options)
(let ((bgcolor (gnc:lookup-option options (let ((bgcolor (gnc:lookup-option options
(N_ "Colors") (N_ "Colors")
(N_ "Split Even")))) (N_ "Split Even"))))
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
;; ;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;
;; Here comes the big function that builds the whole table. ;; Here comes the big function that builds the whole table.
(define (make-split-table splits options (define (make-split-table splits options
primary-subtotal-pred primary-subtotal-pred
secondary-subtotal-pred secondary-subtotal-pred
primary-subheading-renderer primary-subheading-renderer
secondary-subheading-renderer secondary-subheading-renderer
primary-subtotal-renderer primary-subtotal-renderer
secondary-subtotal-renderer) secondary-subtotal-renderer)
(define (get-account-types-to-reverse options) (define (get-account-types-to-reverse options)
(cdr (assq (gnc:option-value (cdr (assq (gnc:option-value
(gnc:lookup-option options (gnc:lookup-option options
(N_ "Display") (N_ "Display")
(N_ "Sign Reverses?"))) (N_ "Sign Reverses?")))
account-types-to-reverse-assoc-list))) account-types-to-reverse-assoc-list)))
(define (transaction-report-multi-rows-p options) (define (transaction-report-multi-rows-p options)
(eq? (gnc:option-value (eq? (gnc:option-value
(gnc:lookup-option options gnc:pagename-general (N_ "Style"))) (gnc:lookup-option options gnc:pagename-general (N_ "Style")))
'multi-line)) 'multi-line))
(define (add-other-split-rows split table used-columns (define (add-other-split-rows split table used-columns
row-style account-types-to-reverse) row-style account-types-to-reverse)
(define (other-rows-driver split parent table used-columns i) (define (other-rows-driver split parent table used-columns i)
(let ((current (gnc:transaction-get-split parent i))) (let ((current (gnc:transaction-get-split parent i)))
(cond ((not current) #f) (cond ((not current) #f)
((equal? current split) ((equal? current split)
(other-rows-driver split parent table used-columns (+ i 1))) (other-rows-driver split parent table used-columns (+ i 1)))
(else (begin (else (begin
(add-split-row table current used-columns (add-split-row table current used-columns
row-style account-types-to-reverse #f) row-style account-types-to-reverse #f)
(other-rows-driver split parent table used-columns (other-rows-driver split parent table used-columns
(+ i 1))))))) (+ i 1)))))))
(other-rows-driver split (gnc:split-get-parent split) (other-rows-driver split (gnc:split-get-parent split)
table used-columns 0)) table used-columns 0))
(define (do-rows-with-subtotals splits (define (do-rows-with-subtotals splits
table table
used-columns used-columns
width width
multi-rows? multi-rows?
odd-row? odd-row?
account-types-to-reverse account-types-to-reverse
primary-subtotal-pred primary-subtotal-pred
secondary-subtotal-pred secondary-subtotal-pred
primary-subheading-renderer primary-subheading-renderer
secondary-subheading-renderer secondary-subheading-renderer
primary-subtotal-renderer primary-subtotal-renderer
secondary-subtotal-renderer secondary-subtotal-renderer
primary-subtotal-collector primary-subtotal-collector
secondary-subtotal-collector secondary-subtotal-collector
total-collector) total-collector)
(if (null? splits) (if (null? splits)
(begin (begin
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
def:grand-total-style def:grand-total-style
(list (list
(gnc:make-html-table-cell/size (gnc:make-html-table-cell/size
1 width (gnc:make-html-text (gnc:html-markup-hr))))) 1 width (gnc:make-html-text (gnc:html-markup-hr)))))
(render-grand-total table width total-collector)) (render-grand-total table width total-collector))
(let* ((current (car splits)) (let* ((current (car splits))
(current-row-style (if multi-rows? def:normal-row-style (current-row-style (if multi-rows? def:normal-row-style
(if odd-row? def:normal-row-style (if odd-row? def:normal-row-style
def:alternate-row-style))) def:alternate-row-style)))
(rest (cdr splits)) (rest (cdr splits))
(next (if (null? rest) #f (next (if (null? rest) #f
(car rest))) (car rest)))
(split-value (add-split-row (split-value (add-split-row
table table
current current
used-columns used-columns
current-row-style current-row-style
account-types-to-reverse account-types-to-reverse
#t))) #t)))
(if multi-rows? (if multi-rows?
(add-other-split-rows (add-other-split-rows
current table used-columns def:alternate-row-style account-types-to-reverse)) current table used-columns def:alternate-row-style
account-types-to-reverse))
(primary-subtotal-collector 'add (primary-subtotal-collector 'add
(gnc:gnc-monetary-commodity (gnc:gnc-monetary-commodity
split-value) split-value)
(gnc:gnc-monetary-amount split-value)) (gnc:gnc-monetary-amount
(secondary-subtotal-collector 'add split-value))
(gnc:gnc-monetary-commodity (secondary-subtotal-collector 'add
split-value) (gnc:gnc-monetary-commodity
(gnc:gnc-monetary-amount split-value)
split-value)) (gnc:gnc-monetary-amount
(total-collector 'add split-value))
(gnc:gnc-monetary-commodity split-value) (total-collector 'add
(gnc:gnc-monetary-amount split-value)) (gnc:gnc-monetary-commodity split-value)
(gnc:gnc-monetary-amount split-value))
(if (and primary-subtotal-pred (if (and primary-subtotal-pred
(or (not next) (or (not next)
(and next (and next
(not (primary-subtotal-pred current next))))) (not (primary-subtotal-pred current next)))))
(begin (begin
(if secondary-subtotal-pred (if secondary-subtotal-pred
(begin (begin
(secondary-subtotal-renderer table width current (secondary-subtotal-renderer
secondary-subtotal-collector table width current
def:secondary-subtotal-style) secondary-subtotal-collector
(secondary-subtotal-collector 'reset #f #f))) def:secondary-subtotal-style)
(secondary-subtotal-collector 'reset #f #f)))
(primary-subtotal-renderer table width current (primary-subtotal-renderer table width current
primary-subtotal-collector primary-subtotal-collector
def:primary-subtotal-style) def:primary-subtotal-style)
(primary-subtotal-collector 'reset #f #f) (primary-subtotal-collector 'reset #f #f)
(if next (if next
(begin (begin
(primary-subheading-renderer (primary-subheading-renderer
next table width def:primary-subtotal-style) next table width def:primary-subtotal-style)
(if secondary-subtotal-pred (if secondary-subtotal-pred
(secondary-subheading-renderer (secondary-subheading-renderer
next next
table table
width def:secondary-subtotal-style))))) width def:secondary-subtotal-style)))))
(if (and secondary-subtotal-pred (if (and secondary-subtotal-pred
(or (not next) (or (not next)
(and next (and next
(not (secondary-subtotal-pred
current next)))))
(begin (secondary-subtotal-renderer
table width current
secondary-subtotal-collector
def:secondary-subtotal-style)
(secondary-subtotal-collector 'reset #f #f)
(if next
(secondary-subheading-renderer
next table width
def:secondary-subtotal-style)))))
(not (secondary-subtotal-pred current next))))) (do-rows-with-subtotals rest
(begin (secondary-subtotal-renderer table width current table
secondary-subtotal-collector used-columns
def:secondary-subtotal-style) width
(secondary-subtotal-collector 'reset #f #f) multi-rows?
(if next (not odd-row?)
(secondary-subheading-renderer account-types-to-reverse
next table width def:secondary-subtotal-style))))) primary-subtotal-pred
secondary-subtotal-pred
primary-subheading-renderer
secondary-subheading-renderer
primary-subtotal-renderer
secondary-subtotal-renderer
primary-subtotal-collector
secondary-subtotal-collector
total-collector))))
(do-rows-with-subtotals rest (let* ((table (gnc:make-html-table))
table (used-columns (build-column-used options))
used-columns (width (num-columns-required used-columns))
width (multi-rows? (transaction-report-multi-rows-p options))
multi-rows? (account-types-to-reverse
(not odd-row?) (get-account-types-to-reverse options)))
account-types-to-reverse
primary-subtotal-pred
secondary-subtotal-pred
primary-subheading-renderer
secondary-subheading-renderer
primary-subtotal-renderer
secondary-subtotal-renderer
primary-subtotal-collector
secondary-subtotal-collector
total-collector))))
(let* ((table (gnc:make-html-table)) (gnc:html-table-set-col-headers!
(used-columns (build-column-used options)) table
(width (num-columns-required used-columns)) (make-heading-list used-columns))
(multi-rows? (transaction-report-multi-rows-p options)) ;; (gnc:warn "Splits:" splits)
(account-types-to-reverse (if (not (null? splits))
(get-account-types-to-reverse options))) (begin
(if primary-subheading-renderer
(primary-subheading-renderer
(car splits) table width def:primary-subtotal-style))
(if secondary-subheading-renderer
(secondary-subheading-renderer
(car splits) table width def:secondary-subtotal-style))
(gnc:html-table-set-col-headers! (do-rows-with-subtotals splits table used-columns width
table multi-rows? #t
(make-heading-list used-columns)) account-types-to-reverse
;; (gnc:warn "Splits:" splits) primary-subtotal-pred
(if (not (null? splits)) secondary-subtotal-pred
(begin primary-subheading-renderer
(if primary-subheading-renderer secondary-subheading-renderer
(primary-subheading-renderer primary-subtotal-renderer
(car splits) table width def:primary-subtotal-style)) secondary-subtotal-renderer
(if secondary-subheading-renderer (gnc:make-commodity-collector)
(secondary-subheading-renderer (gnc:make-commodity-collector)
(car splits) table width def:secondary-subtotal-style)) (gnc:make-commodity-collector))))
(do-rows-with-subtotals splits table used-columns width
multi-rows? #t
account-types-to-reverse
primary-subtotal-pred
secondary-subtotal-pred
primary-subheading-renderer
secondary-subheading-renderer
primary-subtotal-renderer
secondary-subtotal-renderer
(gnc:make-commodity-collector)
(gnc:make-commodity-collector)
(gnc:make-commodity-collector))))
table)) table))
;; ;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;
;; Here comes the renderer function for this report. ;; Here comes the renderer function for this report.
(define (trep-renderer report-obj) (define (trep-renderer report-obj)
(define options (gnc:report-options report-obj)) (define options (gnc:report-options report-obj))
(define (opt-val section name) (define (opt-val section name)
(gnc:option-value (gnc:option-value
(gnc:lookup-option options section name))) (gnc:lookup-option options section name)))
(define comp-funcs-assoc-list (define comp-funcs-assoc-list
;; Defines the different sorting keys, together with the ;; Defines the different sorting keys, together with the
;; subtotal functions. Each entry: (cons ;; subtotal functions. Each entry: (cons
;; 'sorting-key-option-value (vector 'query-sorting-key ;; 'sorting-key-option-value (vector 'query-sorting-key
;; subtotal-function subtotal-renderer)) ;; subtotal-function subtotal-renderer))
(list (cons 'account-name (vector (list (cons 'account-name (vector
'by-account-full-name 'by-account-full-name
split-account-full-name-same-p split-account-full-name-same-p
render-account-full-name-subheading render-account-full-name-subheading
render-account-full-name-subtotal)) render-account-full-name-subtotal))
(cons 'account-code (vector (cons 'account-code (vector
'by-account-code 'by-account-code
split-account-code-same-p split-account-code-same-p
render-account-code-subheading render-account-code-subheading
render-account-code-subtotal)) render-account-code-subtotal))
(cons 'exact-time (vector 'by-date #f #f #f)) (cons 'exact-time (vector 'by-date #f #f #f))
(cons 'date (vector (cons 'date (vector
'by-date-rounded #f #f #f)) 'by-date-rounded #f #f #f))
(cons 'corresponding-acc-name (cons 'corresponding-acc-name
(vector 'by-corr-account-full-name (vector 'by-corr-account-full-name
split-same-corr-account-full-name-p split-same-corr-account-full-name-p
render-corresponding-account-name-subheading render-corresponding-account-name-subheading
render-corresponding-account-name-subtotal)) render-corresponding-account-name-subtotal))
(cons 'corresponding-acc-code (cons 'corresponding-acc-code
(vector 'by-corr-account-code (vector 'by-corr-account-code
split-same-corr-account-code-p split-same-corr-account-code-p
render-corresponding-account-code-subheading render-corresponding-account-code-subheading
render-corresponding-account-code-subtotal)) render-corresponding-account-code-subtotal))
(cons 'amount (vector 'by-amount #f #f #f)) (cons 'amount (vector 'by-amount #f #f #f))
(cons 'description (vector 'by-desc #f #f #f)) (cons 'description (vector 'by-desc #f #f #f))
(cons 'number (vector 'by-num #f #f #f)) (cons 'number (vector 'by-num #f #f #f))
(cons 'memo (vector 'by-memo #f #f #f)) (cons 'memo (vector 'by-memo #f #f #f))
(cons 'none (vector 'by-none #f #f #f)))) (cons 'none (vector 'by-none #f #f #f))))
(define date-comp-funcs-assoc-list (define date-comp-funcs-assoc-list
;; Extra list for date option. Each entry: (cons ;; Extra list for date option. Each entry: (cons
;; 'date-subtotal-option-value (vector subtotal-function ;; 'date-subtotal-option-value (vector subtotal-function
;; subtotal-renderer)) ;; subtotal-renderer))
(list (list
(cons 'none (vector #f #f #f)) (cons 'none (vector #f #f #f))
(cons 'monthly (vector split-same-month-p render-month-subheading (cons 'monthly (vector split-same-month-p render-month-subheading
render-month-subtotal)) render-month-subtotal))
(cons 'yearly (vector split-same-year-p render-year-subheading (cons 'yearly (vector split-same-year-p render-year-subheading
render-year-subtotal)))) render-year-subtotal))))
(define (get-subtotalstuff-helper (define (get-subtotalstuff-helper
name-sortkey name-subtotal name-date-subtotal name-sortkey name-subtotal name-date-subtotal
comp-index date-index) comp-index date-index)
;; The value of the sorting-key multichoice option. ;; The value of the sorting-key multichoice option.
(let ((sortkey (opt-val pagename-sorting name-sortkey))) (let ((sortkey (opt-val pagename-sorting name-sortkey)))
(if (member sortkey (list 'date 'exact-time)) (if (member sortkey (list 'date 'exact-time))
;; If sorting by date, look up the value of the ;; If sorting by date, look up the value of the
;; date-subtotalling multichoice option and return the ;; date-subtotalling multichoice option and return the
;; corresponding funcs in the assoc-list. ;; corresponding funcs in the assoc-list.
(vector-ref (vector-ref
(cdr (assq (opt-val pagename-sorting name-date-subtotal) (cdr (assq (opt-val pagename-sorting name-date-subtotal)
date-comp-funcs-assoc-list)) date-comp-funcs-assoc-list))
date-index) date-index)
;; For everything else: 1. check whether sortkey has ;; For everything else: 1. check whether sortkey has
;; subtotalling enabled at all, 2. check whether the ;; subtotalling enabled at all, 2. check whether the
;; enable-subtotal boolean option is #t, 3. look up the ;; enable-subtotal boolean option is #t, 3. look up the
;; appropriate funcs in the assoc-list. ;; appropriate funcs in the assoc-list.
(and (member sortkey subtotal-enabled) (and (member sortkey subtotal-enabled)
(and (opt-val pagename-sorting name-subtotal) (and (opt-val pagename-sorting name-subtotal)
(vector-ref (vector-ref
(cdr (assq sortkey comp-funcs-assoc-list)) (cdr (assq sortkey comp-funcs-assoc-list))
comp-index)))))) comp-index))))))
(define (get-query-sortkey sort-option-value) (define (get-query-sortkey sort-option-value)
(vector-ref (vector-ref
(cdr (assq sort-option-value comp-funcs-assoc-list)) (cdr (assq sort-option-value comp-funcs-assoc-list))
0)) 0))
(define (get-subtotal-pred (define (get-subtotal-pred
name-sortkey name-subtotal name-date-subtotal) name-sortkey name-subtotal name-date-subtotal)
(get-subtotalstuff-helper (get-subtotalstuff-helper
name-sortkey name-subtotal name-date-subtotal name-sortkey name-subtotal name-date-subtotal
1 0)) 1 0))
(define (get-subheading-renderer (define (get-subheading-renderer
name-sortkey name-subtotal name-date-subtotal) name-sortkey name-subtotal name-date-subtotal)
(get-subtotalstuff-helper (get-subtotalstuff-helper
name-sortkey name-subtotal name-date-subtotal name-sortkey name-subtotal name-date-subtotal
2 1)) 2 1))
(define (get-subtotal-renderer (define (get-subtotal-renderer
name-sortkey name-subtotal name-date-subtotal) name-sortkey name-subtotal name-date-subtotal)
(get-subtotalstuff-helper (get-subtotalstuff-helper
name-sortkey name-subtotal name-date-subtotal name-sortkey name-subtotal name-date-subtotal
3 2)) 3 2))
(let ((document (gnc:make-html-document)) (let ((document (gnc:make-html-document))
(c_accounts (opt-val gnc:pagename-accounts "Accounts")) (c_accounts (opt-val gnc:pagename-accounts "Accounts"))
(begindate (gnc:timepair-start-day-time (begindate (gnc:timepair-start-day-time
(gnc:date-option-absolute-time (gnc:date-option-absolute-time
(opt-val gnc:pagename-general "From")))) (opt-val gnc:pagename-general "From"))))
(enddate (gnc:timepair-end-day-time (enddate (gnc:timepair-end-day-time
(gnc:date-option-absolute-time (gnc:date-option-absolute-time
(opt-val gnc:pagename-general "To")))) (opt-val gnc:pagename-general "To"))))
(report-title (opt-val (report-title (opt-val
gnc:pagename-general gnc:pagename-general
gnc:optname-reportname)) gnc:optname-reportname))
(primary-key (opt-val pagename-sorting optname-prime-sortkey)) (primary-key (opt-val pagename-sorting optname-prime-sortkey))
(primary-order (opt-val pagename-sorting "Primary Sort Order")) (primary-order (opt-val pagename-sorting "Primary Sort Order"))
(secondary-key (opt-val pagename-sorting optname-sec-sortkey)) (secondary-key (opt-val pagename-sorting optname-sec-sortkey))
(secondary-order (opt-val pagename-sorting "Secondary Sort Order")) (secondary-order (opt-val pagename-sorting "Secondary Sort Order"))
(splits '()) (splits '())
(query (gnc:malloc-query))) (query (gnc:malloc-query)))
;;(warn "accts in trep-renderer:" c_accounts) ;;(warn "accts in trep-renderer:" c_accounts)
(if (not (or (null? c_accounts) (and-map not c_accounts))) (if (not (or (null? c_accounts) (and-map not c_accounts)))
(begin (begin
(gnc:query-set-group query (gnc:get-current-group)) (gnc:query-set-group query (gnc:get-current-group))
(gnc:query-add-account-match query (gnc:query-add-account-match query
(gnc:list->glist c_accounts) (gnc:list->glist c_accounts)
'acct-match-any 'query-and) 'acct-match-any 'query-and)
(gnc:query-add-date-match-timepair (gnc:query-add-date-match-timepair
query #t begindate #t enddate 'query-and) query #t begindate #t enddate 'query-and)
(gnc:query-set-sort-order query (gnc:query-set-sort-order query
(get-query-sortkey primary-key) (get-query-sortkey primary-key)
(get-query-sortkey secondary-key) (get-query-sortkey secondary-key)
'by-none) 'by-none)
(gnc:query-set-sort-increasing query (gnc:query-set-sort-increasing query
(eq? primary-order 'ascend) (eq? primary-order 'ascend)
(eq? secondary-order 'ascend) (eq? secondary-order 'ascend)
#t) #t)
(set! splits (gnc:glist->list (gnc:query-get-splits query) (set! splits (gnc:glist->list (gnc:query-get-splits query)
<gnc:Split*>)) <gnc:Split*>))
;;(gnc:warn "Splits in trep-renderer:" splits) ;;(gnc:warn "Splits in trep-renderer:" splits)
(if (not (null? splits)) (if (not (null? splits))
(let ((table (let ((table
(make-split-table (make-split-table
splits splits
options options
(get-subtotal-pred optname-prime-sortkey (get-subtotal-pred optname-prime-sortkey
optname-prime-subtotal optname-prime-subtotal
optname-prime-date-subtotal) optname-prime-date-subtotal)
(get-subtotal-pred optname-sec-sortkey (get-subtotal-pred optname-sec-sortkey
optname-sec-subtotal optname-sec-subtotal
optname-sec-date-subtotal) optname-sec-date-subtotal)
(get-subheading-renderer optname-prime-sortkey (get-subheading-renderer optname-prime-sortkey
optname-prime-subtotal optname-prime-subtotal
optname-prime-date-subtotal) optname-prime-date-subtotal)
(get-subheading-renderer optname-sec-sortkey (get-subheading-renderer optname-sec-sortkey
optname-sec-subtotal optname-sec-subtotal
optname-sec-date-subtotal) optname-sec-date-subtotal)
(get-subtotal-renderer optname-prime-sortkey (get-subtotal-renderer optname-prime-sortkey
optname-prime-subtotal optname-prime-subtotal
optname-prime-date-subtotal) optname-prime-date-subtotal)
(get-subtotal-renderer optname-sec-sortkey (get-subtotal-renderer optname-sec-sortkey
optname-sec-subtotal optname-sec-subtotal
optname-sec-date-subtotal)))) optname-sec-date-subtotal))))
(gnc:html-document-set-title! document (gnc:html-document-set-title! document
report-title) report-title)
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-h3 (gnc:html-markup-h3
(display-date-interval begindate enddate)))) (display-date-interval begindate enddate))))
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
table) table)
(gnc:free-query query)) (gnc:free-query query))
;; error condition: no splits found ;; error condition: no splits found
(let ((p (gnc:make-html-text))) (let ((p (gnc:make-html-text)))
(gnc:html-text-append! (gnc:html-text-append!
p p
(gnc:html-markup-h2 (gnc:html-markup-h2
(_ "No matching transactions found")) (_ "No matching transactions found"))
(gnc:html-markup-p (gnc:html-markup-p
(_ "No transactions were found that \ (_ "No transactions were found that \
match the given time interval and account selection."))) match the given time interval and account selection.")))
(gnc:html-document-add-object! document p)))) (gnc:html-document-add-object! document p))))
;; error condition: no accounts specified ;; error condition: no accounts specified
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:html-make-no-account-warning report-title))) (gnc:html-make-no-account-warning report-title)))
document)) document))
;; Define the report. ;; Define the report.
(gnc:define-report (gnc:define-report
'version 2 'version 2
'name (N_ "Transaction Report") 'name (N_ "Transaction Report")
'options-generator trep-options-generator 'options-generator trep-options-generator
'renderer trep-renderer))) 'renderer trep-renderer)))