diff --git a/ChangeLog b/ChangeLog index c8852248b49..cf056fad89c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,37 @@ +2001-06-02 Dave Peticolas + + * 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 * po/gnc-glossary.txt: Updated glossary, 15 new terms, and lots of diff --git a/src/SplitLedger.c b/src/SplitLedger.c index 6fc8b1ae733..db0d7efa206 100644 --- a/src/SplitLedger.c +++ b/src/SplitLedger.c @@ -590,7 +590,7 @@ gnc_split_get_value_denom (Split *split) denom = xaccAccountGetCurrencySCU (xaccSplitGetAccount (split)); if (denom == 0) { - gnc_commodity *commodity = gnc_locale_default_currency (); + gnc_commodity *commodity = gnc_default_currency (); denom = gnc_commodity_get_fraction (commodity); if (denom == 0) denom = 100; @@ -607,7 +607,7 @@ gnc_split_get_quantity_denom (Split *split) denom = xaccAccountGetCommoditySCU (xaccSplitGetAccount (split)); if (denom == 0) { - gnc_commodity *commodity = gnc_locale_default_currency (); + gnc_commodity *commodity = gnc_default_currency (); denom = gnc_commodity_get_fraction (commodity); if (denom == 0) denom = 100; @@ -644,7 +644,7 @@ sr_set_cell_fractions (SplitRegister *reg, Split *split) xaccSetPriceCellFraction (reg->sharesCell, 10000); - commodity = gnc_locale_default_currency (); + commodity = gnc_default_currency (); fraction = gnc_commodity_get_fraction (commodity); xaccSetPriceCellFraction (reg->debitCell, fraction); @@ -3681,7 +3681,7 @@ xaccSRGetEntryHandler (VirtualLocation virt_loc, currency = xaccTransGetCurrency (trans); if (!currency) - currency = gnc_locale_default_currency (); + currency = gnc_default_currency (); imbalance = gnc_numeric_convert (imbalance, gnc_commodity_get_fraction (currency), diff --git a/src/engine/gnc-book.c b/src/engine/gnc-book.c index a601122f158..7e17b24bca7 100644 --- a/src/engine/gnc-book.c +++ b/src/engine/gnc-book.c @@ -463,14 +463,15 @@ gnc_book_backup_file(GNCBook *book) } g_free(bin_bkup); } - + timestamp = xaccDateUtilGetStampNow (); backup = g_new (char, strlen (datafile) + strlen (timestamp) + 6); strcpy (backup, datafile); strcat (backup, "."); strcat (backup, timestamp); strcat (backup, ".xac"); - free (timestamp); + g_free (timestamp); + if(link(datafile, backup) != 0) { gnc_book_push_error( diff --git a/src/gnc-ui-util.c b/src/gnc-ui-util.c index c2d6eabf289..9d3c35d99b3 100644 --- a/src/gnc-ui-util.c +++ b/src/gnc-ui-util.c @@ -520,7 +520,7 @@ gnc_find_or_create_equity_account (GNCEquityType equity_type, } if (!base_name_exists && - gnc_commodity_equiv (currency, gnc_locale_default_currency ())) + gnc_commodity_equiv (currency, gnc_default_currency ())) { g_free (name); name = g_strdup (base_name); @@ -777,7 +777,7 @@ gnc_default_print_info (gboolean use_symbol) lc = gnc_localeconv (); - info.commodity = gnc_locale_default_currency (); + info.commodity = gnc_default_currency (); info.max_decimal_places = lc->frac_digits; info.min_decimal_places = lc->frac_digits; diff --git a/src/gnome/dialog-account.c b/src/gnome/dialog-account.c index ccd173e85dc..8ccf4c33048 100644 --- a/src/gnome/dialog-account.c +++ b/src/gnome/dialog-account.c @@ -1849,9 +1849,7 @@ gnc_ui_new_account_window_internal (Account *base_account, gnc_resume_gui_refresh (); - commodity = gnc_lookup_currency_option ("International", - "Default Currency", - gnc_locale_default_currency ()); + commodity = gnc_default_currency (); gnc_commodity_edit_set_commodity (GNC_COMMODITY_EDIT (aw->currency_edit), commodity); diff --git a/src/gnome/dialog-fincalc.c b/src/gnome/dialog-fincalc.c index 1a54bc9ede8..71d5ab14c8b 100644 --- a/src/gnome/dialog-fincalc.c +++ b/src/gnome/dialog-fincalc.c @@ -32,6 +32,7 @@ #include "finvar.h" #include "glade-gnc-dialogs.h" #include "glade-support.h" +#include "global-options.h" #include "gnc-amount-edit.h" #include "gnc-commodity.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); - commodity = gnc_locale_default_currency (); + commodity = gnc_default_currency (); total = gnc_numeric_mul (npp, pmt, gnc_commodity_get_fraction (commodity), GNC_RND_ROUND); @@ -501,7 +502,7 @@ gnc_ui_fincalc_dialog_create(void) GtkWidget *hbox; GtkWidget *edit; - commodity = gnc_locale_default_currency (); + commodity = gnc_default_currency (); fcd = g_new0(FinCalcDialog, 1); diff --git a/src/gnome/dialog-price-editor.c b/src/gnome/dialog-price-editor.c index 4e8d0981801..b21b023f2c8 100644 --- a/src/gnome/dialog-price-editor.c +++ b/src/gnome/dialog-price-editor.c @@ -31,6 +31,7 @@ #include "dialog-utils.h" #include "glade-gnc-dialogs.h" #include "glade-support.h" +#include "global-options.h" #include "gnc-amount-edit.h" #include "gnc-commodity-edit.h" #include "gnc-component-manager.h" @@ -301,7 +302,7 @@ price_to_gui (PricesDialog *pdb_dialog) else { commodity = NULL; - currency = gnc_locale_default_currency (); + currency = gnc_default_currency (); date.tv_sec = time (NULL); date.tv_nsec = 0; source = ""; diff --git a/src/gnome/druid-qif-import.c b/src/gnome/druid-qif-import.c index 1c321ab6d2d..54ebec1fb8f 100644 --- a/src/gnome/druid-qif-import.c +++ b/src/gnome/druid-qif-import.c @@ -256,7 +256,7 @@ gnc_ui_qif_import_druid_make(void) { gnc_ui_update_commodity_picker(retval->currency_picker, GNC_COMMODITY_NS_ISO, gnc_commodity_get_printname - (gnc_locale_default_currency())); + (gnc_default_currency())); if(!retval->show_doc_pages) { gnome_druid_set_page(GNOME_DRUID(retval->druid), diff --git a/src/gnome/window-main-summarybar.c b/src/gnome/window-main-summarybar.c index 50c0fb6d6ce..19884a7165e 100644 --- a/src/gnome/window-main-summarybar.c +++ b/src/gnome/window-main-summarybar.c @@ -260,10 +260,7 @@ gnc_ui_accounts_recurse (AccountGroup *group, GList **currency_list, GList *list; GList *node; - default_currency = - gnc_lookup_currency_option("International", - "Default Currency", - gnc_locale_default_currency ()); + default_currency = gnc_default_currency (); if (euro) { @@ -366,10 +363,7 @@ gnc_main_window_summary_refresh (GNCMainSummary * summary) GList *current; gboolean euro; - default_currency = - gnc_lookup_currency_option("International", - "Default Currency", - gnc_locale_default_currency ()); + default_currency = gnc_default_currency (); euro = gnc_lookup_boolean_option("International", "Enable EURO support", @@ -460,10 +454,7 @@ gnc_main_window_summary_new (void) { GNCMainSummary * retval = g_new0(GNCMainSummary, 1); GtkWidget * summarybar; GNCCurrencyItem * def_item; - gnc_commodity * default_currency = - gnc_lookup_currency_option ("International", - "Default Currency", - gnc_locale_default_currency ()); + gnc_commodity * default_currency = gnc_default_currency (); retval->hbox = gtk_hbox_new (FALSE, 5); retval->totals_combo = gtk_select_new (); diff --git a/src/scm/options-utilities.scm b/src/scm/options-utilities.scm index 7365596dcb1..a06780ef8ad 100644 --- a/src/scm/options-utilities.scm +++ b/src/scm/options-utilities.scm @@ -199,9 +199,7 @@ pagename name-report-currency sort-tag (N_ "Select the currency to display the values of this report in.") - (gnc:option-value - (gnc:lookup-global-option "International" - "Default Currency"))))) + (gnc:default-currency)))) ;; These are common options for the selection of the report's ;; currency/commodity. diff --git a/src/scm/prefs.scm b/src/scm/prefs.scm index 959f8482d59..52176af8559 100644 --- a/src/scm/prefs.scm +++ b/src/scm/prefs.scm @@ -168,8 +168,7 @@ (gnc:make-simple-boolean-option (N_ "International") (N_ "Enable EURO support") "d" (N_ "Enables support for the European Union EURO currency") - (gnc:is-euro-currency - (gnc:locale-default-currency)))) + (gnc:is-euro-currency (gnc:default-currency)))) ;;; Register options diff --git a/src/scm/report/price-scatter.scm b/src/scm/report/price-scatter.scm index 5d5b73386ec..0d9a03013bb 100644 --- a/src/scm/report/price-scatter.scm +++ b/src/scm/report/price-scatter.scm @@ -63,14 +63,14 @@ (gnc:options-add-currency! options pagename-price optname-report-currency "d") - + (add-option (gnc:make-commodity-option pagename-price optname-price-commodity "e" (N_ "Calculate the price of this commodity.") - (gnc:locale-default-currency))) - + (gnc:default-currency))) + (add-option (gnc:make-multichoice-option pagename-price optname-price-source diff --git a/src/scm/report/transaction-report.scm b/src/scm/report/transaction-report.scm index c758e5171be..67706384b68 100644 --- a/src/scm/report/transaction-report.scm +++ b/src/scm/report/transaction-report.scm @@ -36,7 +36,8 @@ (let-syntax ((addto! (syntax-rules () - ((_ alist element) (set! alist (cons element alist)))))) + ((_ alist element) + (set! alist (cons element alist)))))) (let ((pagename-sorting (N_ "Sorting")) (optname-prime-sortkey (N_ "Primary Key")) @@ -105,10 +106,10 @@ (define (render-account-full-name-subheading split table width subheading-style) (let ((account (gnc:split-get-account split))) - (add-subheading-row (gnc:make-html-text (gnc:html-markup-anchor - (gnc:account-anchor-text account) - (gnc:account-get-full-name - account))) + (add-subheading-row (gnc:make-html-text + (gnc:html-markup-anchor + (gnc:account-anchor-text account) + (gnc:account-get-full-name account))) table width subheading-style))) (define (render-account-code-subheading split table @@ -149,11 +150,11 @@ (gnc:html-table-append-row/markup! table subtotal-style - (list (gnc:make-html-table-cell/size 1 (- width 1) - subtotal-string) - (gnc:make-html-table-cell/markup - "total-number-cell" - (car currency-totals)))) + (list (gnc:make-html-table-cell/size 1 (- width 1) + subtotal-string) + (gnc:make-html-table-cell/markup + "total-number-cell" + (car currency-totals)))) (for-each (lambda (currency) (gnc:html-table-append-row/markup! table @@ -182,8 +183,9 @@ (define (render-corresponding-account-name-subtotal table width split total-collector subtotal-style) - (add-subtotal-row table width (total-string - (gnc:split-get-corr-account-full-name split)) + (add-subtotal-row table width + (total-string + (gnc:split-get-corr-account-full-name split)) total-collector subtotal-style)) (define (render-corresponding-account-code-subtotal @@ -326,7 +328,9 @@ (account (gnc:split-get-account split)) (account-type (gw:enum--val->sym (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)) (split-value (gnc:make-gnc-monetary currency @@ -372,7 +376,8 @@ (if (used-price column-vector) (addto! 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) (addto! row-contents (gnc:make-html-table-cell/markup "number-cell" @@ -395,7 +400,8 @@ "number-cell" (gnc:make-gnc-monetary currency (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)) (define (trep-options-generator) @@ -436,7 +442,8 @@ (gnc:get-current-group))) (first-account (gnc:group-get-account (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)) (else ())))) #f #t)) @@ -590,477 +597,482 @@ (list (N_ "Account") "e" (N_ "Display the account?") #f) (list (N_ "Use Full Account Name?") "f" (N_ "Display the full account name") #t) - (list (N_ "Other Account")"g" - (N_ "Display the other account? \ -(if this is a split transaction, this parameter is guessed).") #f) - (list (N_ "Shares") "h" (N_ "Display the number of shares?") #f) - (list (N_ "Price") "i" "Display the shares price?" #f) - ;; note the "Amount" multichoice option in between here - (list (N_ "Running Balance") "k" (N_ "Display a running balance") #f) - (list (N_ "Totals") "l" (N_ "Display the totals?") #t))) - - (gnc:register-trep-option - (gnc:make-multichoice-option - gnc:pagename-display (N_ "Amount") - "j" (N_ "Display the amount?") - 'single - (list - (vector 'none (N_ "None") (N_ "No amount display")) - (vector 'single (N_ "Single") (N_ "Single Column Display")) - (vector 'double (N_ "Double") (N_ "Two Column Display"))))) + (list (N_ "Other Account") "g" + (N_ "Display the other account?\ + (if this is a split transaction, this parameter is guessed).") #f) + (list (N_ "Shares") "h" (N_ "Display the number of shares?") #f) + (list (N_ "Price") "i" "Display the shares price?" #f) + ;; note the "Amount" multichoice option in between here + (list (N_ "Running Balance") "k" (N_ "Display a running balance") #f) + (list (N_ "Totals") "l" (N_ "Display the totals?") #t))) + + (gnc:register-trep-option + (gnc:make-multichoice-option + gnc:pagename-display (N_ "Amount") + "j" (N_ "Display the amount?") + 'single + (list + (vector 'none (N_ "None") (N_ "No amount display")) + (vector 'single (N_ "Single") (N_ "Single Column Display")) + (vector 'double (N_ "Double") (N_ "Two Column Display"))))) - (gnc:register-trep-option - (gnc:make-multichoice-option - gnc:pagename-display (N_ "Sign Reverses?") - "m" "Reverse amount display for certain account types" - 'credit-accounts - (list - (vector 'none (N_ "None") (N_ "Don't change any displayed amounts")) - (vector 'income-expense (N_ "Income and Expense") - (N_ "Reverse amount display for Income and Expense Accounts")) - (vector 'credit-accounts (N_ "Credit Accounts") - (N_ "Reverse amount display for Liability, Equity, Credit Card,\ + (gnc:register-trep-option + (gnc:make-multichoice-option + gnc:pagename-display (N_ "Sign Reverses?") + "m" "Reverse amount display for certain account types" + 'credit-accounts + (list + (vector 'none (N_ "None") (N_ "Don't change any displayed amounts")) + (vector 'income-expense (N_ "Income and Expense") + (N_ "Reverse amount display for Income and Expense Accounts")) + (vector 'credit-accounts (N_ "Credit Accounts") + (N_ "Reverse amount display for Liability, Equity, Credit Card,\ and Income accounts"))))) - (gnc:options-set-default-section gnc:*transaction-report-options* - gnc:pagename-general) - - gnc:*transaction-report-options*) - - - (define (display-date-interval begin end) - (let ((begin-string (strftime "%x" (localtime (car begin)))) - (end-string (strftime "%x" (localtime (car end))))) - (sprintf #f (_ "From %s To %s") begin-string end-string))) - - (define (get-primary-subtotal-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Primary Subtotals/headings")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - - (define (get-secondary-subtotal-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Secondary Subtotals/headings")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - - (define (get-grand-total-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Grand Total")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - - (define (get-odd-row-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Split Odd")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - - (define (get-even-row-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Split Even")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - - - ;; ;;;;;;;;;;;;;;;;;;;; - ;; Here comes the big function that builds the whole table. - (define (make-split-table splits options - primary-subtotal-pred - secondary-subtotal-pred - primary-subheading-renderer - secondary-subheading-renderer - primary-subtotal-renderer - secondary-subtotal-renderer) + (gnc:options-set-default-section gnc:*transaction-report-options* + gnc:pagename-general) + + gnc:*transaction-report-options*) + + + (define (display-date-interval begin end) + (let ((begin-string (strftime "%x" (localtime (car begin)))) + (end-string (strftime "%x" (localtime (car end))))) + (sprintf #f (_ "From %s To %s") begin-string end-string))) + + (define (get-primary-subtotal-style options) + (let ((bgcolor (gnc:lookup-option options + (N_ "Colors") + (N_ "Primary Subtotals/headings")))) + (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) + + (define (get-secondary-subtotal-style options) + (let ((bgcolor (gnc:lookup-option options + (N_ "Colors") + (N_ "Secondary Subtotals/headings")))) + (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) + + (define (get-grand-total-style options) + (let ((bgcolor (gnc:lookup-option options + (N_ "Colors") + (N_ "Grand Total")))) + (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) + + (define (get-odd-row-style options) + (let ((bgcolor (gnc:lookup-option options + (N_ "Colors") + (N_ "Split Odd")))) + (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) + + (define (get-even-row-style options) + (let ((bgcolor (gnc:lookup-option options + (N_ "Colors") + (N_ "Split Even")))) + (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) + + + ;; ;;;;;;;;;;;;;;;;;;;; + ;; Here comes the big function that builds the whole table. + (define (make-split-table splits options + primary-subtotal-pred + secondary-subtotal-pred + primary-subheading-renderer + secondary-subheading-renderer + primary-subtotal-renderer + secondary-subtotal-renderer) - (define (get-account-types-to-reverse options) - (cdr (assq (gnc:option-value - (gnc:lookup-option options - (N_ "Display") - (N_ "Sign Reverses?"))) - account-types-to-reverse-assoc-list))) + (define (get-account-types-to-reverse options) + (cdr (assq (gnc:option-value + (gnc:lookup-option options + (N_ "Display") + (N_ "Sign Reverses?"))) + account-types-to-reverse-assoc-list))) - (define (transaction-report-multi-rows-p options) - (eq? (gnc:option-value - (gnc:lookup-option options gnc:pagename-general (N_ "Style"))) - 'multi-line)) - - (define (add-other-split-rows split table used-columns - row-style account-types-to-reverse) - (define (other-rows-driver split parent table used-columns i) - (let ((current (gnc:transaction-get-split parent i))) - (cond ((not current) #f) - ((equal? current split) - (other-rows-driver split parent table used-columns (+ i 1))) - (else (begin - (add-split-row table current used-columns - row-style account-types-to-reverse #f) - (other-rows-driver split parent table used-columns - (+ i 1))))))) - - (other-rows-driver split (gnc:split-get-parent split) - table used-columns 0)) - - (define (do-rows-with-subtotals splits - table - used-columns - width - multi-rows? - odd-row? - 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) - (if (null? splits) - (begin - (gnc:html-table-append-row/markup! - table - def:grand-total-style - (list - (gnc:make-html-table-cell/size - 1 width (gnc:make-html-text (gnc:html-markup-hr))))) - - (render-grand-total table width total-collector)) - - (let* ((current (car splits)) - (current-row-style (if multi-rows? def:normal-row-style - (if odd-row? def:normal-row-style - def:alternate-row-style))) - (rest (cdr splits)) - (next (if (null? rest) #f - (car rest))) - (split-value (add-split-row - table - current - used-columns - current-row-style - account-types-to-reverse - #t))) - (if multi-rows? - (add-other-split-rows - current table used-columns def:alternate-row-style account-types-to-reverse)) - - (primary-subtotal-collector 'add - (gnc:gnc-monetary-commodity - split-value) - (gnc:gnc-monetary-amount split-value)) - (secondary-subtotal-collector 'add - (gnc:gnc-monetary-commodity - split-value) - (gnc:gnc-monetary-amount - split-value)) - (total-collector 'add - (gnc:gnc-monetary-commodity split-value) - (gnc:gnc-monetary-amount split-value)) - - (if (and primary-subtotal-pred - (or (not next) - (and next - (not (primary-subtotal-pred current next))))) - (begin - (if secondary-subtotal-pred - - (begin - (secondary-subtotal-renderer table width current - secondary-subtotal-collector - def:secondary-subtotal-style) - (secondary-subtotal-collector 'reset #f #f))) - - (primary-subtotal-renderer table width current - primary-subtotal-collector - def:primary-subtotal-style) - - (primary-subtotal-collector 'reset #f #f) - - (if next - (begin - (primary-subheading-renderer - next table width def:primary-subtotal-style) - - (if secondary-subtotal-pred - (secondary-subheading-renderer - next - table - width def:secondary-subtotal-style))))) - - (if (and secondary-subtotal-pred - (or (not 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))))) - - (do-rows-with-subtotals rest - table - used-columns - width - multi-rows? - (not odd-row?) - 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)) - (used-columns (build-column-used options)) - (width (num-columns-required used-columns)) - (multi-rows? (transaction-report-multi-rows-p options)) - (account-types-to-reverse - (get-account-types-to-reverse options))) - - (gnc:html-table-set-col-headers! - table - (make-heading-list used-columns)) - ;; (gnc:warn "Splits:" splits) - (if (not (null? splits)) - (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)) - - (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)))) + (define (transaction-report-multi-rows-p options) + (eq? (gnc:option-value + (gnc:lookup-option options gnc:pagename-general (N_ "Style"))) + 'multi-line)) + + (define (add-other-split-rows split table used-columns + row-style account-types-to-reverse) + (define (other-rows-driver split parent table used-columns i) + (let ((current (gnc:transaction-get-split parent i))) + (cond ((not current) #f) + ((equal? current split) + (other-rows-driver split parent table used-columns (+ i 1))) + (else (begin + (add-split-row table current used-columns + row-style account-types-to-reverse #f) + (other-rows-driver split parent table used-columns + (+ i 1))))))) + + (other-rows-driver split (gnc:split-get-parent split) + table used-columns 0)) + + (define (do-rows-with-subtotals splits + table + used-columns + width + multi-rows? + odd-row? + 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) + (if (null? splits) + (begin + (gnc:html-table-append-row/markup! + table + def:grand-total-style + (list + (gnc:make-html-table-cell/size + 1 width (gnc:make-html-text (gnc:html-markup-hr))))) + + (render-grand-total table width total-collector)) + + (let* ((current (car splits)) + (current-row-style (if multi-rows? def:normal-row-style + (if odd-row? def:normal-row-style + def:alternate-row-style))) + (rest (cdr splits)) + (next (if (null? rest) #f + (car rest))) + (split-value (add-split-row + table + current + used-columns + current-row-style + account-types-to-reverse + #t))) + (if multi-rows? + (add-other-split-rows + current table used-columns def:alternate-row-style + account-types-to-reverse)) + + (primary-subtotal-collector 'add + (gnc:gnc-monetary-commodity + split-value) + (gnc:gnc-monetary-amount + split-value)) + (secondary-subtotal-collector 'add + (gnc:gnc-monetary-commodity + split-value) + (gnc:gnc-monetary-amount + split-value)) + (total-collector 'add + (gnc:gnc-monetary-commodity split-value) + (gnc:gnc-monetary-amount split-value)) + + (if (and primary-subtotal-pred + (or (not next) + (and next + (not (primary-subtotal-pred current next))))) + (begin + (if secondary-subtotal-pred + + (begin + (secondary-subtotal-renderer + table width current + secondary-subtotal-collector + def:secondary-subtotal-style) + (secondary-subtotal-collector 'reset #f #f))) + + (primary-subtotal-renderer table width current + primary-subtotal-collector + def:primary-subtotal-style) + + (primary-subtotal-collector 'reset #f #f) + + (if next + (begin + (primary-subheading-renderer + next table width def:primary-subtotal-style) + + (if secondary-subtotal-pred + (secondary-subheading-renderer + next + table + width def:secondary-subtotal-style))))) + + (if (and secondary-subtotal-pred + (or (not 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))))) + + (do-rows-with-subtotals rest + table + used-columns + width + multi-rows? + (not odd-row?) + 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)) + (used-columns (build-column-used options)) + (width (num-columns-required used-columns)) + (multi-rows? (transaction-report-multi-rows-p options)) + (account-types-to-reverse + (get-account-types-to-reverse options))) + + (gnc:html-table-set-col-headers! + table + (make-heading-list used-columns)) + ;; (gnc:warn "Splits:" splits) + (if (not (null? splits)) + (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)) + + (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)) - - ;; ;;;;;;;;;;;;;;;;;;;; - ;; Here comes the renderer function for this report. - (define (trep-renderer report-obj) - - (define options (gnc:report-options report-obj)) - - (define (opt-val section name) - (gnc:option-value - (gnc:lookup-option options section name))) - - (define comp-funcs-assoc-list - ;; Defines the different sorting keys, together with the - ;; subtotal functions. Each entry: (cons - ;; 'sorting-key-option-value (vector 'query-sorting-key - ;; subtotal-function subtotal-renderer)) - (list (cons 'account-name (vector - 'by-account-full-name - split-account-full-name-same-p - render-account-full-name-subheading - render-account-full-name-subtotal)) - (cons 'account-code (vector - 'by-account-code - split-account-code-same-p - render-account-code-subheading - render-account-code-subtotal)) - (cons 'exact-time (vector 'by-date #f #f #f)) - (cons 'date (vector - 'by-date-rounded #f #f #f)) - (cons 'corresponding-acc-name - (vector 'by-corr-account-full-name - split-same-corr-account-full-name-p - render-corresponding-account-name-subheading - render-corresponding-account-name-subtotal)) - (cons 'corresponding-acc-code - (vector 'by-corr-account-code - split-same-corr-account-code-p - render-corresponding-account-code-subheading - render-corresponding-account-code-subtotal)) - (cons 'amount (vector 'by-amount #f #f #f)) - (cons 'description (vector 'by-desc #f #f #f)) - (cons 'number (vector 'by-num #f #f #f)) - (cons 'memo (vector 'by-memo #f #f #f)) - (cons 'none (vector 'by-none #f #f #f)))) - - (define date-comp-funcs-assoc-list - ;; Extra list for date option. Each entry: (cons - ;; 'date-subtotal-option-value (vector subtotal-function - ;; subtotal-renderer)) - (list - (cons 'none (vector #f #f #f)) - (cons 'monthly (vector split-same-month-p render-month-subheading - render-month-subtotal)) - (cons 'yearly (vector split-same-year-p render-year-subheading - render-year-subtotal)))) - - (define (get-subtotalstuff-helper - name-sortkey name-subtotal name-date-subtotal - comp-index date-index) - ;; The value of the sorting-key multichoice option. - (let ((sortkey (opt-val pagename-sorting name-sortkey))) - (if (member sortkey (list 'date 'exact-time)) - ;; If sorting by date, look up the value of the - ;; date-subtotalling multichoice option and return the - ;; corresponding funcs in the assoc-list. - (vector-ref - (cdr (assq (opt-val pagename-sorting name-date-subtotal) - date-comp-funcs-assoc-list)) - date-index) - ;; For everything else: 1. check whether sortkey has - ;; subtotalling enabled at all, 2. check whether the - ;; enable-subtotal boolean option is #t, 3. look up the - ;; appropriate funcs in the assoc-list. - (and (member sortkey subtotal-enabled) - (and (opt-val pagename-sorting name-subtotal) - (vector-ref - (cdr (assq sortkey comp-funcs-assoc-list)) - comp-index)))))) + table)) + + ;; ;;;;;;;;;;;;;;;;;;;; + ;; Here comes the renderer function for this report. + (define (trep-renderer report-obj) + + (define options (gnc:report-options report-obj)) + + (define (opt-val section name) + (gnc:option-value + (gnc:lookup-option options section name))) + + (define comp-funcs-assoc-list + ;; Defines the different sorting keys, together with the + ;; subtotal functions. Each entry: (cons + ;; 'sorting-key-option-value (vector 'query-sorting-key + ;; subtotal-function subtotal-renderer)) + (list (cons 'account-name (vector + 'by-account-full-name + split-account-full-name-same-p + render-account-full-name-subheading + render-account-full-name-subtotal)) + (cons 'account-code (vector + 'by-account-code + split-account-code-same-p + render-account-code-subheading + render-account-code-subtotal)) + (cons 'exact-time (vector 'by-date #f #f #f)) + (cons 'date (vector + 'by-date-rounded #f #f #f)) + (cons 'corresponding-acc-name + (vector 'by-corr-account-full-name + split-same-corr-account-full-name-p + render-corresponding-account-name-subheading + render-corresponding-account-name-subtotal)) + (cons 'corresponding-acc-code + (vector 'by-corr-account-code + split-same-corr-account-code-p + render-corresponding-account-code-subheading + render-corresponding-account-code-subtotal)) + (cons 'amount (vector 'by-amount #f #f #f)) + (cons 'description (vector 'by-desc #f #f #f)) + (cons 'number (vector 'by-num #f #f #f)) + (cons 'memo (vector 'by-memo #f #f #f)) + (cons 'none (vector 'by-none #f #f #f)))) + + (define date-comp-funcs-assoc-list + ;; Extra list for date option. Each entry: (cons + ;; 'date-subtotal-option-value (vector subtotal-function + ;; subtotal-renderer)) + (list + (cons 'none (vector #f #f #f)) + (cons 'monthly (vector split-same-month-p render-month-subheading + render-month-subtotal)) + (cons 'yearly (vector split-same-year-p render-year-subheading + render-year-subtotal)))) + + (define (get-subtotalstuff-helper + name-sortkey name-subtotal name-date-subtotal + comp-index date-index) + ;; The value of the sorting-key multichoice option. + (let ((sortkey (opt-val pagename-sorting name-sortkey))) + (if (member sortkey (list 'date 'exact-time)) + ;; If sorting by date, look up the value of the + ;; date-subtotalling multichoice option and return the + ;; corresponding funcs in the assoc-list. + (vector-ref + (cdr (assq (opt-val pagename-sorting name-date-subtotal) + date-comp-funcs-assoc-list)) + date-index) + ;; For everything else: 1. check whether sortkey has + ;; subtotalling enabled at all, 2. check whether the + ;; enable-subtotal boolean option is #t, 3. look up the + ;; appropriate funcs in the assoc-list. + (and (member sortkey subtotal-enabled) + (and (opt-val pagename-sorting name-subtotal) + (vector-ref + (cdr (assq sortkey comp-funcs-assoc-list)) + comp-index)))))) - (define (get-query-sortkey sort-option-value) - (vector-ref - (cdr (assq sort-option-value comp-funcs-assoc-list)) - 0)) - - (define (get-subtotal-pred - name-sortkey name-subtotal name-date-subtotal) - (get-subtotalstuff-helper - name-sortkey name-subtotal name-date-subtotal - 1 0)) - - (define (get-subheading-renderer - name-sortkey name-subtotal name-date-subtotal) - (get-subtotalstuff-helper - name-sortkey name-subtotal name-date-subtotal - 2 1)) - - (define (get-subtotal-renderer - name-sortkey name-subtotal name-date-subtotal) - (get-subtotalstuff-helper - name-sortkey name-subtotal name-date-subtotal - 3 2)) - - (let ((document (gnc:make-html-document)) - (c_accounts (opt-val gnc:pagename-accounts "Accounts")) - (begindate (gnc:timepair-start-day-time - (gnc:date-option-absolute-time - (opt-val gnc:pagename-general "From")))) - (enddate (gnc:timepair-end-day-time - (gnc:date-option-absolute-time - (opt-val gnc:pagename-general "To")))) - (report-title (opt-val - gnc:pagename-general - gnc:optname-reportname)) - (primary-key (opt-val pagename-sorting optname-prime-sortkey)) - (primary-order (opt-val pagename-sorting "Primary Sort Order")) - (secondary-key (opt-val pagename-sorting optname-sec-sortkey)) - (secondary-order (opt-val pagename-sorting "Secondary Sort Order")) - (splits '()) - (query (gnc:malloc-query))) + (define (get-query-sortkey sort-option-value) + (vector-ref + (cdr (assq sort-option-value comp-funcs-assoc-list)) + 0)) + + (define (get-subtotal-pred + name-sortkey name-subtotal name-date-subtotal) + (get-subtotalstuff-helper + name-sortkey name-subtotal name-date-subtotal + 1 0)) + + (define (get-subheading-renderer + name-sortkey name-subtotal name-date-subtotal) + (get-subtotalstuff-helper + name-sortkey name-subtotal name-date-subtotal + 2 1)) + + (define (get-subtotal-renderer + name-sortkey name-subtotal name-date-subtotal) + (get-subtotalstuff-helper + name-sortkey name-subtotal name-date-subtotal + 3 2)) + + (let ((document (gnc:make-html-document)) + (c_accounts (opt-val gnc:pagename-accounts "Accounts")) + (begindate (gnc:timepair-start-day-time + (gnc:date-option-absolute-time + (opt-val gnc:pagename-general "From")))) + (enddate (gnc:timepair-end-day-time + (gnc:date-option-absolute-time + (opt-val gnc:pagename-general "To")))) + (report-title (opt-val + gnc:pagename-general + gnc:optname-reportname)) + (primary-key (opt-val pagename-sorting optname-prime-sortkey)) + (primary-order (opt-val pagename-sorting "Primary Sort Order")) + (secondary-key (opt-val pagename-sorting optname-sec-sortkey)) + (secondary-order (opt-val pagename-sorting "Secondary Sort Order")) + (splits '()) + (query (gnc:malloc-query))) - ;;(warn "accts in trep-renderer:" c_accounts) - (if (not (or (null? c_accounts) (and-map not c_accounts))) - (begin - (gnc:query-set-group query (gnc:get-current-group)) - (gnc:query-add-account-match query - (gnc:list->glist c_accounts) - 'acct-match-any 'query-and) - (gnc:query-add-date-match-timepair - query #t begindate #t enddate 'query-and) - (gnc:query-set-sort-order query - (get-query-sortkey primary-key) - (get-query-sortkey secondary-key) - 'by-none) - (gnc:query-set-sort-increasing query - (eq? primary-order 'ascend) - (eq? secondary-order 'ascend) - #t) - - (set! splits (gnc:glist->list (gnc:query-get-splits query) - )) - ;;(gnc:warn "Splits in trep-renderer:" splits) - (if (not (null? splits)) - (let ((table - (make-split-table - splits - options - (get-subtotal-pred optname-prime-sortkey - optname-prime-subtotal - optname-prime-date-subtotal) - (get-subtotal-pred optname-sec-sortkey - optname-sec-subtotal - optname-sec-date-subtotal) - (get-subheading-renderer optname-prime-sortkey - optname-prime-subtotal - optname-prime-date-subtotal) - (get-subheading-renderer optname-sec-sortkey - optname-sec-subtotal - optname-sec-date-subtotal) - (get-subtotal-renderer optname-prime-sortkey - optname-prime-subtotal - optname-prime-date-subtotal) - (get-subtotal-renderer optname-sec-sortkey - optname-sec-subtotal - optname-sec-date-subtotal)))) - - (gnc:html-document-set-title! document - report-title) - (gnc:html-document-add-object! - document - (gnc:make-html-text - (gnc:html-markup-h3 - (display-date-interval begindate enddate)))) - (gnc:html-document-add-object! - document - table) - (gnc:free-query query)) - ;; error condition: no splits found - (let ((p (gnc:make-html-text))) - (gnc:html-text-append! - p - (gnc:html-markup-h2 - (_ "No matching transactions found")) - (gnc:html-markup-p - (_ "No transactions were found that \ + ;;(warn "accts in trep-renderer:" c_accounts) + (if (not (or (null? c_accounts) (and-map not c_accounts))) + (begin + (gnc:query-set-group query (gnc:get-current-group)) + (gnc:query-add-account-match query + (gnc:list->glist c_accounts) + 'acct-match-any 'query-and) + (gnc:query-add-date-match-timepair + query #t begindate #t enddate 'query-and) + (gnc:query-set-sort-order query + (get-query-sortkey primary-key) + (get-query-sortkey secondary-key) + 'by-none) + (gnc:query-set-sort-increasing query + (eq? primary-order 'ascend) + (eq? secondary-order 'ascend) + #t) + + (set! splits (gnc:glist->list (gnc:query-get-splits query) + )) + ;;(gnc:warn "Splits in trep-renderer:" splits) + (if (not (null? splits)) + (let ((table + (make-split-table + splits + options + (get-subtotal-pred optname-prime-sortkey + optname-prime-subtotal + optname-prime-date-subtotal) + (get-subtotal-pred optname-sec-sortkey + optname-sec-subtotal + optname-sec-date-subtotal) + (get-subheading-renderer optname-prime-sortkey + optname-prime-subtotal + optname-prime-date-subtotal) + (get-subheading-renderer optname-sec-sortkey + optname-sec-subtotal + optname-sec-date-subtotal) + (get-subtotal-renderer optname-prime-sortkey + optname-prime-subtotal + optname-prime-date-subtotal) + (get-subtotal-renderer optname-sec-sortkey + optname-sec-subtotal + optname-sec-date-subtotal)))) + + (gnc:html-document-set-title! document + report-title) + (gnc:html-document-add-object! + document + (gnc:make-html-text + (gnc:html-markup-h3 + (display-date-interval begindate enddate)))) + (gnc:html-document-add-object! + document + table) + (gnc:free-query query)) + ;; error condition: no splits found + (let ((p (gnc:make-html-text))) + (gnc:html-text-append! + p + (gnc:html-markup-h2 + (_ "No matching transactions found")) + (gnc:html-markup-p + (_ "No transactions were found that \ 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! - document - (gnc:html-make-no-account-warning report-title))) + (gnc:html-document-add-object! + document + (gnc:html-make-no-account-warning report-title))) - document)) + document)) - ;; Define the report. - (gnc:define-report + ;; Define the 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)))