diff --git a/ChangeLog b/ChangeLog index 948e4bd36c..123d6b3cd3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,35 @@ +2001-02-25 Robert Graham Merkel + + * src/engine/Query.[ch]: added support for sorting by account names and + codes, as well as names and codes for the "other" split in the transaction. + also, modified (xaccQuerySetSortIncreasing) so you can sort in different + orders for the three criteria specified. + + * src/engine/Transaction.[ch]: Added new functions for comparing splits + on account names and codes. + + * src/engine/reconcile-list.c (gnc_reconcile_list_set_sort_order): modified + to use new query sorting interface. + + * src/scm/report/transaction-report-2.scm: New file. Transaction + report rewritten for our new improved HTML generator. Most + functionality is now present, but the layout is "homely". Will + fix later. + + * src/scm/report/transaction-report.scm: Old transaction report, + removed. + + * src/scm/report/report-list.scm: added new transaction report. + + * src/scm/report-utilities.scm: modified for new query sorting interface. + + * src/doc/design/multicurrency.discussion.txt: The log of an IRC + discussion between cstim and myself about his currency-collector + code. Included because it's the only documentation we have on + this material. + + * src/doc/design/.cvsignore: ignore additional generated files. + 2001-02-24 Rob Browning * configure.in (AC_ARG_ENABLE): add --enable-error-on-warning. diff --git a/src/doc/design/.cvsignore b/src/doc/design/.cvsignore index 476cc6fa0c..289d39dcb9 100644 --- a/src/doc/design/.cvsignore +++ b/src/doc/design/.cvsignore @@ -12,6 +12,9 @@ gnucash-design.tp gnucash-design.vr gnucash-design.fn gnucash-design.cp +gnucash-design.ps +gnucash-design.dvi +gnucash-design.aux *.info *.info-* *.html diff --git a/src/doc/multicurrency-discussion.txt b/src/doc/multicurrency-discussion.txt new file mode 100644 index 0000000000..07ab9baff6 --- /dev/null +++ b/src/doc/multicurrency-discussion.txt @@ -0,0 +1,202 @@ + goonie: well... + How about this: + goonie: You can print each value as a gnc-monetary + goonie: this? + cstim: don't worry, go on with your outline. + How are you printing balances right now? + I guess you plug a gnc-numeric into the html code. + If you do a s/gnc-numeric/gnc-monetary/ + ... then everything would be multi-currency compilant + Of course the gnc-monetary needs the actual currency specified. + Would that lead to problems + ? + Definition of gnc-monetary is in src/scm/gnc-numeric.scm + Cool. + Right now every gnc-monetary is printed like $500.23, DEM 123.45, CHF 456.32 + I think that should work fine. + but the formatting of gnc-monetary could be modified by any style sheet. + goonie: ok. + You also had some code for calculating totals in multiple currencies? + goonie: ouch. Yes. But that gets complicated quickly. + Yes, it does. + goonie: You will need to use a commodity-collector from report-utilities.scm + OK, cool, I think I can figure it out. +< goonie: You will need to use a commodity-collector from report-utilities.scm + OK, cool, I think I can figure it out. + If you want the total of only one commodity, you can use the 'getpair action of commodity-collector... + but if you want to show (correctly) all of the currencies, you will have a lot of trouble. + Basically, I have the "reference implementation" in html-utilities.scm . + OK, excellent. + You can see how I print just one balance... + in the big function gnc:html-build-acct-table, line 297, where I print the total sum. + That would be a starting point to see how a balance with a bunch of commodities gets printed. + cstim: taking it up a level for a second, how would you prefer a total for a collection of splits in different currencies to be displayed? + what do you mean by "total for splits"? + OK, consider a transaction report for the account Expenses:Beer for the period 1/1/2001 to 2/1/2001 (UK date format ;) + and let's say I've had beer in Australia, the US, Germany, and Hong Kong during that period. +* cstim prefers to have the beer in Germany... + further, let's assume that my "native currency" is AUD. + cstim: try some of the Australian specialty beers. + yes + cstim: but even VB or Carlton Draught is an improvement on soap suds . . . er, Budweiser. + but back to Gnucash matters . . . +<-- dres has quit (Connection reset by peer) + yes + now there's several possibilities for doing the totals here . . . + wait wait + what accounts and what splits are you thinking of? + or in other words, what are your sorting/account/viewing parameters? + Only one account selected, sorted by date, say (we'll discuss subtotals in a sec). + goonie: One account means that there is only one currency, right? + dave_p: hang on, let me just check . . . + s/dave_p/cstim + oh +* cstim screwed up his homework about pole-zero plots + dave_p: what's the status of currency-in-transaction? + s/dave_p/???/ + nope, really dave_p this time :) + dave_p is away: I'm doin' stuff + AFAIK an account has a commodity and a transaction has a commodity. + correct. + gnc:account-get-commodity, gnc:transaction-get-commodity + However, read the comments in TransactionP.h + /* The common_currency field indicates the currency type that + * all of the splits in this transaction share in common. This + * field is going to replace the currency field in the account + * structures. +* cstim is reading + yeah, that's right. + So, in the short term, your assumption is correct. + In the long term, not the case. + What I would usually call the "currency" of an account is in Gnucash acctually called "security". + gnc:account-get-commodity will return this security of the account. + Gotta love terminology. + The reason for the differentiation is for stock/mutual fund accounts, IIRC. + info IIRC? + If I Recall Correctly. + oh + BTW, is cvs down? Seems like... + Yes. + It's driving the rest of us nuts too . + The more recent comments about commodities are in Transaction.h, line 229 ff. + or Account.h, line 203ff. + Yep, so the situation I described above can't happen right now, but will be possible in the near future. + Which brings us back to how should we display things: + A total for each currency. +* cstim doesn't yet understand the situation. + What account would that be? + The account Expenses:Beer. + What security will it have? + AUD + okay. + go ahead + OK, say that there's only four transactions in that account for the period in question: + $2 in AUD, 5 USD, 1 EURO, and 12 HKD being the values. + What should we display as the total(s)? + Or more to the point, what options do we need to offer? + waitwait. + Expenses:beer has security AUD. +--> dres (dres@user-2ivf2cm.dialup.mindspring.com) has joined #gnucash + have I pointed out that having a modem connection sucks recently? :) + So there is one Transaction between Cash:USD and the beer. + And one between Cash:Euro and the beer. + And one between (what the heck is) Cash:HKD and the beer. + Hong Kong Dollar, BTW. + hong kong dollars? + yep, they have their own currency. + smart of them. + And, say, those Transaction have the transaction-commodity according to the Cash:* + yep. + But the split which belongs to Exp:Beer has only one value + and that value represents the beer expense in AUD. + i.e. in the split's account's security. + hang on . . . let me think this through carefully . . . + ok, lets get things straight: Each split has two fields, value and damount +* goonie is thinking this through. + Quote from a grib posting last October: + - Eliminate the 'share price' field from the Split structure and + replace it with a 'value' field. The 'value' is a translation of + the Split's 'damount' (which is the amount of the Account's + security involved) into the Transaction's balancing currency. + the last sentence is the one that matters. + /* value is the amount of the account's currency involved, + * damount is the amount of the account's security. For + * bank-type accounts, currency == security and + * value == damount. */ + gnc_numeric value; + gnc_numeric damount; + from src/engine/TransactionP.h + that's outdated. + In the long run: value is the amount of the transaction-commodity involved, damount is the amount of the account-commodity involved. + OK, but the value returned from gnc:split-get-value is the value rather than the damount. + sorry for the long delay, I was reading code to make sure I understood what was going on. + value being the one denominated in the transaction-commodity. + That's right. gnc:split-get-value gives you the value, whereas gnc:split-get-share-amount gives you the damount + Maybe that functions need some name change in the future. + perhaps. + the trouble is that there are so many things that need names in gnucash, that you start to run out :) + :) + We could gnc:split-get-share-amount => gnc:split-get-damount + whatever. + My point for the Beer is + let's have some. + beer doesn't need a point. it just is. + oops. + I would expect that the transaction report uses gnc:split-get-share-amount + which in this case gives you already the amounts exchanged into AUD and everything's fine. + You would prefer that over the transaction-specific value, then? + Well, if I want the list for one specific account, then I would expect all amounts to be in that account's commodity, i.e. the account-commodity (formerly known as security :) + yep. + But then the problem just arises in a different light if you have multiple accounts, sorted by date, say. + I would recommend a name change for gnc:split-get-share-amount. + multiple accounts. + okay, let's talk about that. + what scenario do you think of? + cstim: could you mail Dave wrt function renaming? + I'll send a mail to the ML + OK, let's say you've selected Expenses:Champagne (in Francs), Expenses:Saki (in Yen), and Expenses:VB (in Aussie dollars), and you want a report for all those transactions for the past month, sorted by date. + You have Cash:Francs, Cash:Yen and Cash:Aussie accounts with the expected currencies. + what's VB? + Victoria Bitter (Australian Beer). + okay. + well... + If you want a distinctively Australian Alcoholic beverage, s/VB/Sparkling Red + Lets have some. +* goonie offers cstim a glass of fine Rutherglen sparkling red. + Transaction report: but it doesn't make much sense to show a total sum for that anyway, does it_ + s/_/?/ + oh well, it might. + Option 1) display a total for each currency in the report. + exactly. + Option 2) shows the total for only one currency, the report-currency. + Option 3) somehow gets the right exchange rate so that it also ends up with only one total. + I'd recommend option 2 for now. + For option one you basically would have to copy the code out of the html-build-acct-table function cited above. + So, what happens to transactions not in the report-currency in option 2) - they aren't totalled? + Maybe with the tons of comments it is do-able + goonie: yes, they dissolve in heat and aren't totalled. + OK, I think I can implement 1) and 2). 3 (which might have to be split into 3a, 3b . . . ) can probably wait. + Well, I could implement a "quickie" 3a that just grabs a current exchange rate and does the conversion on it. + again, for 1) you "just" have to copy ~100 lines of code from html-utilities.scm and adapt them to your table structure. + that has all sorts of problems, but might be useful if taken with a grain of salt. + OK. + oh, a quick 3) costs you about 5 lines of extra cost. + I think I can cope with that :) + just look into pnl.scm and see how they (i.e. I) use gnc:make-exchange-alist and gnc:make-exchange-function + both from src/scm/commodity-utilities.scm + OK, cool. + Thanks for your help. + what did you mean by "quickie" 3a that just grabs a current exchange rate " + a dialog box? a parameter? gnc-prices? + gnc-prices. + or a parameter. + something other than digging through a bunch of historical data trying to figure out what the exchange rate was at the time of particular transactions. + parameter: Bad. gnc-prices: Goood. I'd be happy if someone could implement that to augment the current code in commodity-utilities.scm + Oh, the exchange rate at the time of a particular *transaction* is easy -- + -- that's just the fraction value/damount . + not always - what if the transaction is (say) yen/yen but you want to display in dollars? + for instance, our glass of saki, paid for in cash yen. + Yes, right. currently the commodity-utilities stuff uses a weighted average over the history. But using the last known exchange rate instead may be useful at times. + Maybe I'll implmement something like that + maybe if i have time :) +diff -up 'gnucash/src/engine/Query.c' 'gnucash_transaction_report/src/engine/Query.c' diff --git a/src/engine/Query.c b/src/engine/Query.c index 6f8ed73219..6e9762dc88 100644 --- a/src/engine/Query.c +++ b/src/engine/Query.c @@ -59,7 +59,9 @@ struct _querystruct { sort_type_t primary_sort; sort_type_t secondary_sort; sort_type_t tertiary_sort; - gboolean sort_increasing; + gboolean primary_increasing; + gboolean secondary_increasing; + gboolean tertiary_increasing; int max_splits; /* cache the results so we don't have to run the whole search @@ -211,7 +213,9 @@ xaccInitQuery(Query * q, QueryTerm * initial_term) { q->secondary_sort = BY_NONE; q->tertiary_sort = BY_NONE; - q->sort_increasing = TRUE; + q->primary_increasing = TRUE; + q->secondary_increasing = TRUE; + q->tertiary_increasing = TRUE; } @@ -447,7 +451,9 @@ xaccQueryCopy(Query *q) { copy->secondary_sort = q->secondary_sort; copy->tertiary_sort = q->tertiary_sort; - copy->sort_increasing = q->sort_increasing; + copy->primary_increasing = q->primary_increasing; + copy->secondary_increasing = q->secondary_increasing; + copy->tertiary_increasing = q->tertiary_increasing; copy->max_splits = q->max_splits; copy->changed = q->changed; @@ -703,7 +709,7 @@ split_cmp_func(sort_type_t how, gconstpointer ga, gconstpointer gb) Transaction * tb; unsigned long n1; unsigned long n2; - char *da, *db; + const char *da, *db; gnc_numeric fa, fb; if (sa && !sb) return -1; @@ -804,6 +810,20 @@ split_cmp_func(sort_type_t how, gconstpointer ga, gconstpointer gb) } break; + case BY_ACCOUNT_NAME: + return xaccSplitCompareAccountCodes(sa,sb); + break; + + case BY_ACCOUNT_CODE: + return xaccSplitCompareAccountNames(sa, sb); + break; + + case BY_CORR_ACCOUNT_NAME: + return xaccSplitCompareOtherAccountNames(sa, sb); + + case BY_CORR_ACCOUNT_CODE: + return xaccSplitCompareOtherAccountCodes(sa, sb); + case BY_NONE: return 0; break; @@ -815,15 +835,10 @@ split_cmp_func(sort_type_t how, gconstpointer ga, gconstpointer gb) static int split_sort_func(gconstpointer a, gconstpointer b) { int retval; - int multiplier; + assert(split_sort_query); - if (split_sort_query->sort_increasing) - multiplier = 1; - else - multiplier = -1; - retval = split_cmp_func(split_sort_query->primary_sort, a, b); if((retval == 0) && (split_sort_query->secondary_sort != BY_NONE)) { @@ -831,14 +846,14 @@ split_sort_func(gconstpointer a, gconstpointer b) { if((retval == 0) && (split_sort_query->tertiary_sort != BY_NONE)) { retval = split_cmp_func(split_sort_query->tertiary_sort, a, b); - return retval * multiplier; + return split_sort_query->tertiary_increasing ? retval : - retval; } else { - return retval * multiplier; + return split_sort_query->secondary_increasing ? retval : - retval; } } else { - return retval * multiplier; + return split_sort_query->primary_increasing ? retval : - retval; } } @@ -2221,9 +2236,14 @@ xaccQuerySetSortOrder(Query * q, sort_type_t primary, * xaccQuerySetSortIncreasing *******************************************************************/ void -xaccQuerySetSortIncreasing(Query * q, gboolean increasing) +xaccQuerySetSortIncreasing(Query * q, gboolean prim_increasing, + gboolean sec_increasing, + gboolean tert_increasing) { - q->sort_increasing = increasing; + q->primary_increasing = prim_increasing; + q->secondary_increasing = sec_increasing; + q->tertiary_increasing = tert_increasing; + return; } /******************************************************************* diff --git a/src/engine/Query.h b/src/engine/Query.h index 322f47eac4..f53066e2cc 100644 --- a/src/engine/Query.h +++ b/src/engine/Query.h @@ -50,6 +50,10 @@ typedef enum { BY_MEMO, BY_DESC, BY_RECONCILE, + BY_ACCOUNT_NAME, + BY_ACCOUNT_CODE, + BY_CORR_ACCOUNT_NAME, + BY_CORR_ACCOUNT_CODE, BY_NONE } sort_type_t; @@ -287,7 +291,9 @@ void xaccQueryAddPredicate (Query * q, PredicateData *pred, QueryOp op); void xaccQuerySetSortOrder(Query * q, sort_type_t primary, sort_type_t secondary, sort_type_t tertiary); -void xaccQuerySetSortIncreasing(Query * q, gboolean increasing); +void xaccQuerySetSortIncreasing(Query * q, gboolean prim_increasing, + gboolean sec_increasing, + gboolean tert_increasing); void xaccQuerySetMaxSplits(Query * q, int n); int xaccQueryGetMaxSplits(Query * q); diff --git a/src/engine/Transaction.c b/src/engine/Transaction.c index 6b319e56c8..52e6fda2e9 100644 --- a/src/engine/Transaction.c +++ b/src/engine/Transaction.c @@ -1822,7 +1822,137 @@ xaccTransOrder (Transaction *ta, Transaction *tb) return 0; } +static gboolean +get_corr_account_split(Split *sa, Split **retval) +{ + + Split *current_split; + GList *split_list; + Transaction * ta; + gnc_numeric sa_balance, current_balance; + gboolean sa_balance_positive, current_balance_positive, seen_different = FALSE; + *retval = NULL; + g_return_val_if_fail(sa, TRUE); + ta = xaccSplitGetParent(sa); + + sa_balance = xaccSplitGetBalance(sa); + sa_balance_positive = gnc_numeric_positive_p(sa_balance); + + for(split_list = xaccTransGetSplitList(ta);split_list; split_list = split_list->next) + { + current_split = split_list->data; + if(current_split != sa) + { + current_balance = xaccSplitGetBalance(current_split); + current_balance_positive = gnc_numeric_positive_p(current_balance); + if((sa_balance_positive && !current_balance_positive) || + (!sa_balance_positive && current_balance_positive)) + { + if(seen_different) + { + *retval = NULL; + return TRUE; + } + else + { + seen_different = TRUE; + *retval = current_split; + } + } + } + } + return FALSE; +} + +const char * +xaccSplitGetCorrAccountName(Split *sa) +{ + static const char *split_const = "Split"; + Split *other_split; + Account *other_split_acc; + + if(get_corr_account_split(sa, &other_split)) + { + return split_const; + } + else + { + other_split_acc = xaccSplitGetAccount(other_split); + return xaccAccountGetName(other_split_acc); + } +} + +const char * +xaccSplitGetCorrAccountCode(Split *sa) +{ + static const char *split_const = "Split"; + Split *other_split; + Account *other_split_acc; + if(get_corr_account_split(sa, &other_split)) + { + return split_const; + } + else + { + other_split_acc = xaccSplitGetAccount(other_split); + return xaccAccountGetName(other_split_acc); + } +} + +int +xaccSplitCompareAccountNames(Split *sa, Split *sb) +{ + Account *aa, *ab; + if (!sa && !sb) return 0; + if (!sa) return -1; + if (!sb) return 1; + + aa = xaccSplitGetAccount(sa); + ab = xaccSplitGetAccount(sb); + + return safe_strcmp(xaccAccountGetName(aa), xaccAccountGetName(ab)); +} + +int +xaccSplitCompareAccountCodes(Split *sa, Split *sb) +{ + Account *aa, *ab; + if (!sa && !sb) return 0; + if (!sa) return -1; + if (!sb) return 1; + + aa = xaccSplitGetAccount(sa); + ab = xaccSplitGetAccount(sb); + + return safe_strcmp(xaccAccountGetName(aa), xaccAccountGetName(ab)); +} + +int +xaccSplitCompareOtherAccountNames(Split *sa, Split *sb) +{ + const char *ca, *cb; + if (!sa && !sb) return 0; + if (!sa) return -1; + if (!sb) return 1; + + ca = xaccSplitGetCorrAccountName(sa); + cb = xaccSplitGetCorrAccountName(sb); + return safe_strcmp(ca, cb); +} + +int +xaccSplitCompareOtherAccountCodes(Split *sa, Split *sb) +{ + const char *ca, *cb; + if (!sa && !sb) return 0; + if (!sa) return -1; + if (!sb) return 1; + + ca = xaccSplitGetCorrAccountCode(sa); + cb = xaccSplitGetCorrAccountCode(sb); + return safe_strcmp(ca, cb); +} /********************************************************************\ \********************************************************************/ diff --git a/src/engine/Transaction.h b/src/engine/Transaction.h index 91ef2abbc2..f4a3096feb 100644 --- a/src/engine/Transaction.h +++ b/src/engine/Transaction.h @@ -506,6 +506,36 @@ int xaccSplitDateOrder (Split *sa, Split *sb); * Miscellaneous utility routines. \********************************************************************/ +/* + * These functions compare two splits by different criteria. The *Other* + * functions attempt to find the split on the other side of a transaction + * and compare on it. They return similar to strcmp. + * + * These functions were added because converting strings to guile + * for comparisons in the transaction report is terribly inefficient. + * More may be added here in future if it turns out that other types + * of comparisons also induces guile slowdowns. + */ + +int xaccSplitCompareAccountNames(Split *sa, Split *sb); +int xaccSplitCompareAccountCodes(Split *sa, Split *sb); +int xaccSplitCompareOtherAccountNames(Split *sa, Split *sb); +int xaccSplitCompareOtherAccountCodes(Split *sa, Split *sb); + + +/* + * These functions take a split, get the corresponding split on the + * "other side" of the transaction, and extract either the name or code + * of that split, reverting to returning a constant "Split" if the + * transaction has more than one split on the "other side". These + * were added for the transaction report, and is in C because the code + * was already written in C for the above functions and duplication + * is silly. + */ + +const char * xaccSplitGetCorrAccountName(Split *sa); +const char * xaccSplitGetCorrAccountCode(Split *sa); + /* * The xaccGetAccountByName() is a convenience routine that * is essentially identical to xaccGetPeerAccountFromName(), diff --git a/src/gnome/reconcile-list.c b/src/gnome/reconcile-list.c index df8d081cb5..e7b5d1dff4 100644 --- a/src/gnome/reconcile-list.c +++ b/src/gnome/reconcile-list.c @@ -622,7 +622,7 @@ gnc_reconcile_list_set_sort_order (GNCReconcileList *list, sort_type_t key) if (list->list_type == RECLIST_DEBIT) return; - xaccQuerySetSortIncreasing (list->query, !(key == BY_AMOUNT)); + xaccQuerySetSortIncreasing (list->query, !(key == BY_AMOUNT), !(key == BY_AMOUNT), !(key == BY_AMOUNT)); } static void diff --git a/src/scm/report-utilities.scm b/src/scm/report-utilities.scm index fcd8432723..46fc80086b 100644 --- a/src/scm/report-utilities.scm +++ b/src/scm/report-utilities.scm @@ -389,7 +389,7 @@ (gnc:query-add-single-account-match query account 'query-and) (gnc:query-add-date-match-timepair query #f date #t date 'query-and) (gnc:query-set-sort-order query 'by-date 'by-standard 'by-none) - (gnc:query-set-sort-increasing query #t) + (gnc:query-set-sort-increasing query #t #t #t) (gnc:query-set-max-splits query 1) (set! splits (gnc:glist->list @@ -424,7 +424,7 @@ (gnc:query-add-single-account-match query account 'query-and) (gnc:query-add-date-match-timepair query #f date #t date 'query-and) (gnc:query-set-sort-order query 'by-date 'by-standard 'by-none) - (gnc:query-set-sort-increasing query #t) + (gnc:query-set-sort-increasing query #t #t #t) (gnc:query-set-max-splits query 1) (set! splits (gnc:glist->list diff --git a/src/scm/report/Makefile.am b/src/scm/report/Makefile.am index 2a8e37b9fa..eab41978a6 100644 --- a/src/scm/report/Makefile.am +++ b/src/scm/report/Makefile.am @@ -8,8 +8,8 @@ gncscm_DATA = \ hello-world.scm \ report-list.scm \ stylesheet-plain.scm \ - stylesheet-fancy.scm - + stylesheet-fancy.scm \ + transaction-report-2.scm EXTRA_DIST = \ .cvsignore \ ${gncscm_DATA} diff --git a/src/scm/report/report-list.scm b/src/scm/report/report-list.scm index 7aeb9ef529..5205fa0640 100644 --- a/src/scm/report/report-list.scm +++ b/src/scm/report/report-list.scm @@ -10,6 +10,7 @@ (gnc:depend "report/average-balance.scm") (gnc:depend "report/pnl.scm") (gnc:depend "report/hello-world.scm") +(gnc:depend "report/transaction-report.scm") ;; style sheets (gnc:depend "report/stylesheet-plain.scm") diff --git a/src/scm/report/transaction-report.scm b/src/scm/report/transaction-report.scm index 028c316d9b..c43408aa9b 100644 --- a/src/scm/report/transaction-report.scm +++ b/src/scm/report/transaction-report.scm @@ -1,442 +1,282 @@ +(require 'record) +(gnc:support "report/transaction-report.scm") +(gnc:depend "report-html.scm") +(gnc:depend "date-utilities.scm") + ;; -*-scheme-*- ;; transaction-report.scm ;; Report on all transactions in account(s) ;; original report by Robert Merkel (rgmerk@mira.net) ;; redone from scratch by Bryan Larsen (blarsen@ada-works.com) - -(gnc:support "report/transaction-report.scm") -(gnc:depend "report-utilities.scm") -(gnc:depend "date-utilities.scm") -(gnc:depend "html-generator.scm") +;; totally rewritten for new report generation code by Robert Merkel (let () + + (define-syntax addto! + (syntax-rules () + ((_ alist element) (set! alist (cons element alist))))) + + (define (split-account-name-same-p a b) + (= (gnc:split-compare-account-names a b) 0)) - (define (gnc:split-get-sign-adjusted-value split) - (let ((acc (gnc:split-get-account split)) - (unsigned-value (d-gnc:split-get-value split))) - (gnc:debug "Adjusting value" - unsigned-value (gnc:account-reverse-balance? acc)) - (if (gnc:account-reverse-balance? acc) - (- unsigned-value) - unsigned-value))) + (define (split-account-code-same-p a b) + (= (gnc:split-compare-account-codes a b) 0)) - (define (make-account-subheading acc-name from-date) - (let* ((separator (string-ref (gnc:account-separator-char) 0)) - (acc (gnc:get-account-from-full-name - (gnc:get-current-group) - acc-name - separator)) - (unsigned-balance (d-gnc:account-get-balance-at-date - acc - from-date - #f)) - (signed-balance (if (gnc:account-reverse-balance? acc) - (- unsigned-balance) - unsigned-balance))) + (define (split-same-corr-account-p a b) + (= (gnc:split-compare-other-account-names a b) 0)) - (string-append acc-name - " (" - (_ "Opening Balance") - " " - (gnc:amount->string signed-balance - (gnc:account-value-print-info acc #f)) - ")" - ))) + (define (split-same-corr-account-code-p a b) + (= (gnc:split-compare-other-account-codes a b) 0)) - (define (make-split-report-spec options) - (remove-if-not - (lambda (x) x) - (list - (if - (gnc:option-value - (gnc:lookup-option options "Display" "Date")) - (make-report-spec - (_ "Date") - (lambda (split) - (gnc:transaction-get-date-posted - (gnc:split-get-parent split))) - (lambda (date) - (html-left-cell (html-string (gnc:print-date date)))) - #f ; total-proc - #f ; subtotal-html-proc - #f ; total-html-proc - #t ; first-last-preference - #f ; subs-list-proc - #f) - #f) - - (if - (gnc:option-value - (gnc:lookup-option options "Display" "Num")) - (make-report-spec - (_ "Num") - (lambda (split) - (gnc:transaction-get-num - (gnc:split-get-parent split))) - (lambda (num) (html-left-cell (html-string num))) - #f ; total-proc - #f ; subtotal-html-proc - #f ; total-html-proc - #t ; first-last-preference - #f ; subs-list-proc - #f) ; subentry-html-proc - #f) - - (if - (gnc:option-value - (gnc:lookup-option options "Display" "Description")) - (make-report-spec - (_ "Description") - (lambda (split) - (gnc:transaction-get-description - (gnc:split-get-parent split))) - (lambda (desc) (html-left-cell (html-string desc))) - #f ; total-proc - #f ; subtotal-html-proc - #f ; total-html-proc - #t ; first-last-preference - #f ; subs-list-proc - #f) ; subentry-html-proc - #f) - - (if - (gnc:option-value - (gnc:lookup-option options "Display" "Memo")) - (make-report-spec - (_ "Memo") - gnc:split-get-memo - (lambda (memo) (html-left-cell (html-string memo))) - #f ; total-proc - #f ; subtotal-html-proc - #f ; total-html-proc - #t ; first-last-preference - (lambda (split) - (map gnc:split-get-memo (gnc:split-get-other-splits split))) - (lambda (memo) (html-left-cell (html-string memo)))) - #f) - - (if - (gnc:option-value - (gnc:lookup-option options "Display" "Account")) - (make-report-spec - (_ "Account") - (lambda (split) - (gnc:account-get-full-name - (gnc:split-get-account split))) - (lambda (account-name) (html-left-cell (html-string account-name))) - #f ; total-proc - #f ; subtotal-html-proc - #f ; total-html-proc - #t ; first-last-preference - (lambda (split) - (map - (lambda (other) - (gnc:account-get-full-name (gnc:split-get-account other))) - (gnc:split-get-other-splits split))) - (lambda (account-name) (html-left-cell (html-string account-name)))) - #f) - - (if - (gnc:option-value - (gnc:lookup-option options "Display" "Other Account")) - (make-report-spec - (_ "Other Account") - (lambda (split) - (let ((others (gnc:split-get-other-splits split))) - (if (null? others) - "" - (gnc:account-get-full-name - (gnc:split-get-account (car others)))))) - (lambda (account-name) (html-left-cell (html-string account-name))) - #f ; total-proc - #f ; subtotal-html-proc - #f ; total-html-proc - #t ; first-last-preference - #f - #f) - #f) - - (if - (gnc:option-value - (gnc:lookup-option options "Display" "Shares")) - (make-report-spec - (_ "Shares") - (lambda (split) - (d-gnc:split-get-share-amount split)) - (lambda (num) (html-right-cell (html-string num))) - + ; total-proc - #f ; subtotal-html-proc - (lambda (num) (html-right-cell (html-string num))) ; total-html-proc - #t ; first-last-preference - #f ; subs-list-proc - #f) ; subentry-html-proc - #f) - - (if - (gnc:option-value - (gnc:lookup-option options "Display" "Price")) - (make-report-spec - (_ "Price") - (lambda (split) - (d-gnc:split-get-share-price split)) - (lambda (num) (html-right-cell (html-string num))) - #f ; total-proc - #f ; subtotal-html-proc - #f ; total-html-proc - #t ; first-last-preference - #f ; subs-list-proc - #f) ; subentry-html-proc - #f) - - (if - (eq? (gnc:option-value - (gnc:lookup-option options "Display" "Amount")) 'single) - (make-report-spec - (_ "Amount") - gnc:split-get-sign-adjusted-value - (lambda (value) (html-right-cell (html-currency value))) - + ; total-proc - (lambda (value) - (html-right-cell (html-strong (html-currency value)))) - (lambda (value) - (html-right-cell (html-strong (html-currency value)))) - #t ; first-last-preference - (lambda (split) - (map gnc:split-get-sign-adjusted-value - (gnc:split-get-other-splits split))) - (lambda (value) - (html-right-cell (html-ital (html-currency value))))) - #f) - - (if - (eq? (gnc:option-value - (gnc:lookup-option options "Display" "Amount")) 'double) - (make-report-spec - (_ "Debit") - (lambda (split) - (max 0 (gnc:split-get-sign-adjusted-value split))) - (lambda (value) - (cond ((> value 0.0) (html-right-cell (html-currency value))) - (else (html-right-cell (html-ital (html-string " ")))))) -; (lambda (value) -; (if (> value 0) (html-right-cell (html-currency value))) -; (html-right-cell (html-ital (html-string " ")))) - + ; total-proc - (lambda (value) - (html-right-cell (html-strong (html-currency value)))) - (lambda (value) - (html-right-cell (html-strong (html-currency value)))) - #t ; first-last-preference - (lambda (split) - (map gnc:split-get-sign-adjusted-value - (gnc:split-get-other-splits split))) - ; (lambda (value) -; (if (> value 0) (html-right-cell (html-ital (html-currency value))) -; (html-right-cell (html-ital (html-string " "))))) - (lambda (value) - (cond ((> value 0.0) (html-right-cell - (html-ital(html-currency value)))) - (else (html-right-cell (html-ital (html-string " "))))))) - #f) - - (if - (eq? (gnc:option-value - (gnc:lookup-option options "Display" "Amount")) 'double) - (make-report-spec - (_ "Credit") - (lambda (split) - (max 0 (- (gnc:split-get-sign-adjusted-value split)))) -; (lambda (value) (html-right-cell (html-currency value))) - (lambda (value) -; (display value) -; (display (> value 0.0)) -; (display "\n") - (cond ((> value 0.0) (html-right-cell (html-currency value))) - (else (html-right-cell (html-ital (html-string " ")))))) - + ; total-proc - (lambda (value) - (html-right-cell (html-strong (html-currency value)))) - (lambda (value) - (html-right-cell (html-strong (html-currency value)))) - #t ; first-last-preference - (lambda (split) - (map gnc:split-get-sign-adjusted-value - (gnc:split-get-other-splits split))) - (lambda (value) - (cond ((< value 0) - (html-right-cell (html-ital (html-currency (- value))))) - (else (html-right-cell (html-ital (html-string " "))))))) - #f) - - (if - (eq? (gnc:option-value - (gnc:lookup-option options "Display" "Amount")) 'double) - (make-report-spec - (_ "Total") - gnc:split-get-sign-adjusted-value - ;(lambda (value) (html-right-cell (html-currency value))) - ;(lambda (value) (html-right-cell (html-string "hello"))) - #f - + ; total-proc - (lambda (value) - (html-right-cell (html-strong (html-currency value)))) - (lambda (value) - (html-right-cell (html-strong (html-currency value)))) - #t ; first-last-preference - #f ; - #f) - #f)))) - - (define (split-report-get-sort-spec-entry key ascending? begindate) - (case key - ((account) - (make-report-sort-spec - (lambda (split) (gnc:account-get-full-name - (gnc:split-get-account split))) - (if ascending? string-ci?) - string-ci=? - string-ci=? - (lambda (x) (make-account-subheading x begindate)))) - - ((date) - (make-report-sort-spec - (lambda (split) - (gnc:transaction-get-date-posted (gnc:split-get-parent split))) - (if ascending? - gnc:timepair-later-date - gnc:timepair-earlier-date) - gnc:timepair-eq-date - #f - #f)) - - ((date-monthly) - (make-report-sort-spec - (lambda (split) - (gnc:transaction-get-date-posted (gnc:split-get-parent split))) - (if ascending? - gnc:timepair-later-date - gnc:timepair-earlier-date) - gnc:timepair-eq-date - (lambda (a b) - (= (gnc:timepair-get-month a) - (gnc:timepair-get-month b))) - (lambda (date) - (gnc:date-get-month-string (localtime (gnc:timepair->secs date)))))) - - ((date-yearly) - (make-report-sort-spec - (lambda (split) - (gnc:transaction-get-date-posted (gnc:split-get-parent split))) - (if ascending? - gnc:timepair-later-date - gnc:timepair-earlier-date) - gnc:timepair-eq-date - (lambda (a b) - (= (gnc:timepair-get-year a) - (gnc:timepair-get-year b))) - (lambda (date) - (number->string (gnc:timepair-get-year date))))) - - ((time) - (make-report-sort-spec - (lambda (split) - (gnc:transaction-get-date-entered (gnc:split-get-parent split))) - (if ascending? - gnc:timepair-later - gnc:timepair-earlier) - gnc:timepair-eq - #f - #f)) - - ((description) - (make-report-sort-spec - (lambda (split) - (gnc:transaction-get-description (gnc:split-get-parent split))) - (if ascending? string-ci?) - string-ci=? - #f - #f)) - - ((number) - (make-report-sort-spec - (lambda (split) - (gnc:transaction-get-num (gnc:split-get-parent split))) - (if ascending? string-ci?) - string-ci=? - #f - #f)) - - ((memo) - (make-report-sort-spec - gnc:split-get-memo - (if ascending? string-ci?) - stri1ng-ci=? - #f - #f)) - - ((corresponding-acc) - (make-report-sort-spec - (lambda (split) - (gnc:account-get-full-name - (gnc:split-get-account - (car (append - (gnc:split-get-other-splits split) ;;may return null - (list split)))))) - (if ascending? string-ci?) - string-ci=? - #f - #f)) - - ((corresponding-acc-subtotal) - (make-report-sort-spec - (lambda (split) - (gnc:account-get-full-name - (gnc:split-get-account - (car (append - (gnc:split-get-other-splits split) - (list split)))))) - (if ascending? string-ci?) - string-ci=? - string-ci=? - (lambda (x) x))) - - ((amount) - (make-report-sort-spec - gnc:split-get-sign-adjusted-value - (if ascending? < >) - = - #f - #f)) - - ((none) #f) - (else (gnc:error "invalid sort argument")))) + (define (timepair-same-year tp-a tp-b) + (= (tm:year (gnc:timepair->date tp-a)) + (tm:year (gnc:timepair->date tp-b)))) + + (define (timepair-same-month tp-a tp-b) + (and (timepair-same-year tp-a tp-b) + (= (tm:mon (gnc:timepair->date tp-a)) + (tm:mon (gnc:timepair->date tp-b))))) + + (define (split-same-month-p a b) + (let ((tp-a (gnc:transaction-get-date-entered (gnc:split-get-parent a))) + (tp-b (gnc:transaction-get-date-entered (gnc:split-get-parent b)))) + (timepair-same-month tp-a tp-b))) + (define (split-same-year-p a b) + (let ((tp-a (gnc:transaction-get-date-entered (gnc:split-get-parent a))) + (tp-b (gnc:transaction-get-date-entered (gnc:split-get-parent b)))) + (timepair-same-year tp-a tp-b))) - (define (make-split-list account split-filter-pred) - (let ((num-splits (gnc:account-get-split-count account))) - (let loop ((index 0) - (split (gnc:account-get-split account 0)) - (slist '())) - (if (= index num-splits) - (reverse slist) - (loop (+ index 1) - (gnc:account-get-split account (+ index 1)) - (if (split-filter-pred split) - (cons split slist) - slist)))))) + (define (render-account-name-subheading split table) + (gnc:html-table-append-row! + table + (list (gnc:account-get-name (gnc:split-get-account split))))) - ;; returns a predicate that returns true only if a split is - ;; between early-date and late-date - (define (split-report-make-date-filter-predicate begin-date-tp - end-date-tp) - (lambda (split) - (let ((tp - (gnc:transaction-get-date-posted - (gnc:split-get-parent split)))) - (and (gnc:timepair-ge-date tp begin-date-tp) - (gnc:timepair-le-date tp end-date-tp))))) + (define (render-account-code-subheading split table) + (gnc:html-table-append-row! + table + (list (gnc:account-get-code (gnc:split-get-account split))))) - ;; register a configuration option for the transaction report + (define (render-corresponding-account-name-subheading split table) + (gnc:html-table-append-row! + table (list (gnc:split-get-corr-account-name split)))) + + (define (render-corresponding-account-code-subheading split table) + (gnc:html-table-append-row! + table (list (gnc:split-get-corr-account-code split)))) + + (define (render-month-subheading split table) + (gnc:html-table-append-row! + table (list (strftime "%B %Y" (gnc:timepair->date + (gnc:transaction-get-date-entered + (gnc:split-get-parent split))))))) + + (define (render-year-subheading split table) + (gnc:html-table-append-row! + table (list (strftime "%Y" (gnc:timepair->date + (gnc:transaction-get-date-entered + (gnc:split-get-parent split))))))) + (let () + + (define comp-funcs-assoc-list + (list (cons 'account-name (vector + 'by-account-name + split-account-name-same-p + render-account-name-subheading)) + (cons 'account-code (vector + 'by-account-code + split-account-code-same-p + render-account-code-subheading)) + (cons 'date (vector 'by-date #f #f)) + (cons 'date-monthly + (vector 'by-date + split-same-month-p render-month-subheading)) + (cons 'date-yearly + (vector 'by-date split-same-year-p render-year-subheading)) + (cons 'corresponding-acc-name + (vector 'by-corr-account-name #f #f)) + (cons 'corresponding-acc-code + (vector 'by-corr-account-code #f #f)) + (cons 'corresponding-acc-name-subtotal + (vector 'by-corr-account-name + split-same-corr-account-p + render-corresponding-account-name-subheading)) + (cons 'correspoinding-acc-code-subtotal + (vector + 'by-corr-account-code + split-same-corr-account-code-p + render-corresponding-account-code-subheading)) + (cons 'amount (vector 'by-amount #f #f)) + (cons 'description (vector 'by-desc #f #f)) + (cons 'number (vector 'by-num #f #f)) + (cons 'memo (vector 'by-memo #f #f)) + (cons 'none (vector 'by-none #f #f)))) + + (define + (make-record-type "" + (list 'date + 'num + 'description + 'account + 'other-account + 'shares + 'price + 'amount-single + 'amount-double-positive + 'amount-double-negative + 'running-balance))) + + (define (used-date columns-used) + ((record-accessor 'date) columns-used)) + (define (used-num columns-used) + ((record-accessor 'num) columns-used)) + (define (used-description columns-used) + ((record-accessor 'description) columns-used)) + (define (used-account columns-used) + ((record-accessor 'account) columns-used)) + (define (used-other-account columns-used) + ((record-accessor 'other-account) columns-used)) + (define (used-shares columns-used) + ((record-accessor 'shares) columns-used)) + (define (used-price columns-used) + ((record-accessor 'price) columns-used)) + (define (used-amount-single columns-used) + ((record-accessor 'amount-single) columns-used)) + (define (used-amount-double-positive columns-used) + ((record-accessor + 'amount-double-positive) columns-used)) + (define (used-amount-double-negative columns-used) + ((record-accessor + 'amount-double-negative) columns-used)) + (define (used-running-balance columns-used) + ((record-accessor 'running-balance) columns-used)) + + + (define (build-column-used options) + (define (opt-val section name) + (gnc:option-value + (gnc:lookup-option options section name))) + (define (columns-used-set-field record field value) + ((record-modifier field) record value)) + + (let ((column-list + ((record-constructor ) + #f #f #f #f #f #f #f #f #f #f #f))) + + (define (opt-val section name) + (gnc:option-value + (gnc:lookup-option options section name))) + (if (opt-val (N_ "Display") (N_ "Date")) + (columns-used-set-field column-list 'date #t)) + (if (opt-val (N_ "Display") (N_ "Num")) + (columns-used-set-field column-list 'num #t)) + (if (opt-val (N_ "Display") (N_ "Description")) + (columns-used-set-field column-list 'description #t)) + (if (opt-val (N_ "Display") (N_ "Account")) + (columns-used-set-field column-list 'account #t)) + (if (opt-val (N_ "Display") (N_ "Other Account")) + (columns-used-set-field column-list 'other-account #t)) + (if (opt-val (N_ "Display") (N_ "Shares")) + (columns-used-set-field column-list 'shares #t)) + + (if (opt-val (N_ "Display") (N_ "Price")) + (columns-used-set-field column-list 'price #t)) +; (gnc:warn "Amount Display" (opt-val (N_ "Display") (N_ "Amount"))) + + (let ((amount-setting (opt-val (N_ "Display") (N_ "Amount")))) + (if (eq? amount-setting 'single) + (columns-used-set-field column-list 'amount-single #t)) + (if (eq? amount-setting 'double) + (begin + (columns-used-set-field column-list + 'amount-double-positive #t) + (columns-used-set-field column-list + 'amount-double-negative #t))) + #f) + (if (opt-val (N_ "Display") (N_ "Running Balance")) + (columns-used-set-field column-list 'running-balance #t)) + ; (gnc:debug "Column list:" column-list) + column-list)) + + + (define (make-heading-list column-vector) + (let ((heading-list '())) + (gnc:debug "Column-vector" column-vector) + (if (used-date column-vector) + (addto! heading-list (N_ "Date"))) + (if (used-num column-vector) + (addto! heading-list (N_ "Num"))) + (if (used-description column-vector) + (addto! heading-list (N_ "Description"))) + (if (used-account column-vector) + (addto! heading-list (N_ "Account"))) + (if (used-other-account column-vector) + (addto! heading-list (N_ "Transfer from/to"))) + (if (used-shares column-vector) + (addto! heading-list (N_ "Shares"))) + (if (used-price column-vector) + (addto! heading-list (N_ "Price"))) + (if (used-amount-single column-vector) + (addto! heading-list (N_ "Amount"))) + ;; FIXME: Proper labels: what? + (if (used-amount-double-positive column-vector) + (addto! heading-list (N_ "Debit"))) + (if (used-amount-double-negative column-vector) + (addto! heading-list (N_ "Credit"))) + (if (used-running-balance column-vector) + (addto! heading-list (N_ "Balance"))) + (reverse heading-list))) + + (define (add-split-row table split column-vector) + (let* ((row-contents '()) + (parent (gnc:split-get-parent split)) + (account (gnc:split-get-account split)) + (currency (gnc:account-get-commodity account)) + (damount (gnc:split-get-share-amount split)) + (split-value (gnc:make-gnc-monetary currency damount))) + + + (if (used-date column-vector) + (addto! row-contents (gnc:timepair-to-datestring + (gnc:transaction-get-date-entered parent)))) + + + (if (used-num column-vector) + (addto! row-contents (gnc:transaction-get-num parent))) + + (if (used-description column-vector) + (addto! row-contents (gnc:transaction-get-description parent))) + (if (used-account column-vector) + (addto! row-contents (gnc:account-get-name account))) + (if (used-other-account column-vector) + (addto! row-contents (gnc:split-get-corr-account-name split))) + (if (used-shares column-vector) + (addto! row-contents (gnc:split-get-share-amount split))) + (if (used-price column-vector) + (addto! + row-contents + (gnc:make-gnc-monetary currency (gnc:split-get-share-price split)))) + (if (used-amount-single column-vector) + (addto! row-contents split-value)) + (if (used-amount-double-positive column-vector) + (if (gnc:numeric-positive-p split-amount) + (addto! row-contents split-amount) + (addto! row-contents " "))) + (if (used-amount-double-negative column-vector) + (if (gnc:numeric-negative-p split-amount) + (addto! row-contents (gnc:monetary-neg split-amount)) + (addto! row-contents " "))) + (if (used-running-balance column-vector) + (addto! row-contents + (gnc:make-gnc-monetary currency + (gnc:split-get-balance split)))) + (gnc:html-table-append-row! table (reverse row-contents)) + split-value)) + + (define (lookup-sort-key sort-option) + (vector-ref (cdr (assq sort-option comp-funcs-assoc-list)) 0)) + (define (lookup-subtotal-pred sort-option) + (vector-ref (cdr (assq sort-option comp-funcs-assoc-list)) 1)) (define (trep-options-generator) (define gnc:*transaction-report-options* (gnc:new-options)) (define (gnc:register-trep-option new-option) @@ -454,7 +294,7 @@ (set-tm:min bdtime 0) (set-tm:hour bdtime 0) (set-tm:mday bdtime 1) - (set-tm:mon bdtime 0) + (set-tm:mon bdtime 0) (let ((time (car (mktime bdtime)))) (cons 'absolute (cons time 0))))) #f 'absolute #f)) @@ -496,131 +336,122 @@ (list ;#(merged ; "Merged" ; "Display N-1 lines") - (list->vector - (list 'multi-line + (vector 'multi-line (N_ "Multi-Line") - (N_ "Display N lines"))) - (list->vector - (list 'single + (N_ "Display N lines")) + (vector 'single (N_ "Single") - (N_ "Display 1 line")))))) - - (gnc:register-trep-option - (gnc:make-simple-boolean-option - (N_ "Report Options") (N_ "Only positive Entries") - "da" (N_ "Display only positive Entries?") #f)) - + (N_ "Display 1 line"))))) (let ((key-choice-list - (list (list->vector - (list 'account - (N_ "Account (w/subtotal)") - (N_ "Sort & subtotal by account"))) - (list->vector - (list 'date + (list (vector 'account-name + (N_ "Account Name(w/subtotal)") + (N_ "Sort & subtotal by account name")) + (vector 'account-code + (N_ "Account Code (w/subtotal)") + (N_ "Sort & subtotal by account code")) + (vector 'date (N_ "Date") - (N_ "Sort by date"))) - (list->vector - (list 'date-monthly + (N_ "Sort by date")) + (vector 'date-monthly (N_ "Date (subtotal monthly)") - (N_ "Sort by date & subtotal each month"))) - (list->vector - (list 'date-yearly + (N_ "Sort by date & subtotal each month")) + + (vector 'date-yearly (N_ "Date (subtotal yearly)") - (N_ "Sort by date & subtotal each year"))) - (list->vector - (list 'time - (N_ "Time") - (N_ "Sort by exact entry time"))) - (list->vector - (list 'corresponding-acc + (N_ "Sort by date & subtotal each year")) + + + (vector 'corresponding-acc-name (N_ "Transfer from/to") - (N_ "Sort by account transferred from/to's name"))) - (list->vector - (list 'corresponding-acc-subtotal + (N_ "Sort by account transferred from/to's name")) + + (vector 'corresponding-acc-name-subtotal + (N_ "Transfer from/to (w/subtotal) by code ") + (N_ "Sort and subtotal by account transferred from/to's code")) + + (vector 'corresponding-acc-code + (N_ "Transfer from/to code") + (N_ "Sort by account transferred from/to's code")) + + (vector 'corresponding-acc-code-subtotal (N_ "Transfer from/to (w/subtotal)") - (N_ "Sort and subtotal by account transferred from/to's name"))) - (list->vector - (list 'amount + (N_ "Sort and subtotal by account transferred from/to's code")) + + (vector 'amount (N_ "Amount") - (N_ "Sort by amount"))) - (list->vector - (list 'description + (N_ "Sort by amount")) + + (vector 'description (N_ "Description") - (N_ "Sort by description"))) - (list->vector - (list 'number + (N_ "Sort by description")) + + (vector 'number (N_ "Number") - (N_ "Sort by check/transaction number"))) - (list->vector - (list 'memo + (N_ "Sort by check/transaction number")) + + (vector 'memo (N_ "Memo") - (N_ "Sort by memo"))) - (list->vector - (list 'none + (N_ "Sort by memo")) + + (vector 'none (N_ "None") - (N_ "Do not sort")))))) + (N_ "Do not sort"))))) - ;; primary sorting criterion + ;; primary sorting criterion (gnc:register-trep-option (gnc:make-multichoice-option (N_ "Sorting") (N_ "Primary Key") "a" (N_ "Sort by this criterion first") - 'account + 'account-name key-choice-list)) - + (gnc:register-trep-option (gnc:make-multichoice-option (N_ "Sorting") (N_ "Primary Sort Order") "b" (N_ "Order of primary sorting") 'ascend (list - (list->vector - (list 'ascend - (N_ "Ascending") - (N_ "smallest to largest, earliest to latest"))) - (list->vector - (list 'descend - (N_ "Descending") - (N_ "largest to smallest, latest to earliest")))))) - + (vector 'ascend + (N_ "Ascending") + (N_ "smallest to largest, earliest to latest")) + (vector 'descend + (N_ "Descending") + (N_ "largest to smallest, latest to earliest"))))) + (gnc:register-trep-option (gnc:make-multichoice-option (N_ "Sorting") (N_ "Secondary Key") "c" (N_ "Sort by this criterion second") 'date - key-choice-list)) - + key-choice-list))) + (gnc:register-trep-option (gnc:make-multichoice-option (N_ "Sorting") (N_ "Secondary Sort Order") "d" (N_ "Order of Secondary sorting") 'ascend (list - (list->vector - (list 'ascend - (N_ "Ascending") - (N_ "smallest to largest, earliest to latest"))) - (list->vector - (list 'descend - (N_ "Descending") - (N_ "largest to smallest, latest to earliest"))))))) - - (gnc:register-trep-option - (gnc:make-simple-boolean-option - (N_ "Display") (N_ "Date") - "b" (N_ "Display the date?") #t)) - - (gnc:register-trep-option + (vector 'ascend + (N_ "Ascending") + (N_ "smallest to largest, earliest to latest")) + (vector 'descend + (N_ "Descending") + (N_ "largest to smallest, latest to earliest"))))) + + (gnc:register-trep-option + (gnc:make-simple-boolean-option + (N_ "Display") (N_ "Date") + "b" (N_ "Display the date?") #t)) + + (gnc:register-trep-option (gnc:make-simple-boolean-option (N_ "Display") (N_ "Num") "c" (N_ "Display the cheque number?") #t)) - (gnc:register-trep-option (gnc:make-simple-boolean-option (N_ "Display") (N_ "Description") "d" (N_ "Display the description?") #t)) - (gnc:register-trep-option (gnc:make-simple-boolean-option (N_ "Display") (N_ "Memo") @@ -652,112 +483,273 @@ "i" (N_ "Display the amount?") 'single (list - (list->vector - (list 'none (N_ "None") (N_ "No amount display"))) - (list->vector - (list 'single (N_ "Single") (N_ "Single Column Display"))) - (list->vector - (list 'double (N_ "Double") (N_ "Two Column Display")))))) - + (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-simple-boolean-option (N_ "Display") (N_ "Headers") "j" (N_ "Display the headers?") #t)) + (gnc:register-trep-option + (gnc:make-simple-boolean-option + (N_ "Display") (N_ "Running Balance") + "k" (N_ "Display a running balance") #f)) + (gnc:register-trep-option (gnc:make-simple-boolean-option (N_ "Display") (N_ "Totals") - "k" (N_ "Display the totals?") #t)) + "l" (N_ "Display the totals?") #t)) (gnc:options-set-default-section gnc:*transaction-report-options* "Report Options") - gnc:*transaction-report-options*) + 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))))) + (string-append (_ "From") " " begin-string (_"To") " " end-string))) - (define (gnc:trep-renderer options) - - (let* ((begindate - (gnc:date-option-absolute-time - (gnc:option-value - (gnc:lookup-option options "Report Options" "From")))) - (enddate - (gnc:date-option-absolute-time - (gnc:option-value - (gnc:lookup-option options "Report Options" "To")))) - (tr-report-account-op - (gnc:lookup-option options "Report Options" "Account")) - (tr-report-primary-key-op - (gnc:lookup-option options "Sorting" "Primary Key")) - (tr-report-primary-order-op - (gnc:lookup-option options "Sorting" "Primary Sort Order")) - (tr-report-secondary-key-op - (gnc:lookup-option options "Sorting" "Secondary Key")) - (tr-report-secondary-order-op - (gnc:lookup-option options "Sorting" "Secondary Sort Order")) - (tr-report-style-op - (gnc:lookup-option options "Report Options" "Style")) - (accounts (gnc:option-value tr-report-account-op)) - (date-filter-pred (split-report-make-date-filter-predicate - begindate - (gnc:timepair-end-day-time - enddate))) - (filter-pred - (if (gnc:option-value - (gnc:lookup-option options "Report Options" - "Only positive Entries")) - (lambda (split) - (and (date-filter-pred split) - (> (gnc:split-get-sign-adjusted-value split) 0))) - date-filter-pred)) - (s1 (split-report-get-sort-spec-entry - (gnc:option-value tr-report-primary-key-op) - (eq? (gnc:option-value tr-report-primary-order-op) 'ascend) - begindate)) - (s2 (split-report-get-sort-spec-entry - (gnc:option-value tr-report-secondary-key-op) - (eq? (gnc:option-value tr-report-secondary-order-op) 'ascend) - begindate)) - (s2b (if s2 (list s2) '())) - (sort-specs (if s1 (cons s1 s2b) s2b)) - (split-list - (apply - append - (map - (lambda (account) - (make-split-list account filter-pred)) - accounts))) - (split-report-specs (make-split-report-spec options))) - - (list - (html-start-document-title (_ "Transaction Report") #f) - (html-start-table) - (if (gnc:option-value (gnc:lookup-option options "Display" "Headers")) - (html-table-headers split-report-specs) - '()) + (define (make-account-subheading acc-name from-date) + (let* ((separator (string-ref (gnc:account-separator-char) 0)) + (acc (gnc:get-account-from-full-name + (gnc:get-current-group) + acc-name + separator)) + (unsigned-balance (d-gnc:account-get-balance-at-date + acc + from-date + #f)) + (signed-balance (if (gnc:account-reverse-balance? acc) + (- unsigned-balance) + unsigned-balance))) + (string-append acc-name + " (" + (_ "Opening Balance") + " " + (gnc:amount->string signed-balance + (gnc:account-value-print-info acc #f)) + ")" + ))) - (html-table-render-entries - split-list - split-report-specs - sort-specs - (case (gnc:option-value tr-report-style-op) - ((multi-line) - html-table-entry-render-entries-first) - ((merged) - html-table-entry-render-subentries-merged) - ((single) - html-table-entry-render-entries-only)) - (lambda (split) - (length - (gnc:split-get-other-splits split)))) - (if (gnc:option-value (gnc:lookup-option options "Display" "Totals")) - (html-table-totals split-list split-report-specs) - '()) - (html-end-table) - (html-end-document)))) + (define (make-split-table splits options) + (define (add-subtotal-row table split used-columns subtotal-collector) + (let ((currency-totals (subtotal-collector + 'format gnc:make-gnc-monetary #f))) +; (gnc:warn "Subtotal-collector" subtotal-collector) +; (gnc:warn "Currency-totals:" currency-totals) + (for-each (lambda (currency) + (gnc:html-table-append-row! table (list currency))) + currency-totals))) + + (define (get-primary-subtotal-pred options) + (vector-ref (cdr + (assq (gnc:option-value + (gnc:lookup-option options + (N_ "Sorting") + (N_ "Primary Key"))) + comp-funcs-assoc-list)) + 1)) + (define (get-secondary-subtotal-pred options) + (vector-ref (cdr + (assq (gnc:option-value + (gnc:lookup-option options + (N_ "Sorting") + (N_ "Secondary Key"))) + comp-funcs-assoc-list)) + 1)) + + (define (get-primary-subheading-renderer option) + (vector-ref (cdr + (assq (gnc:option-value + (gnc:lookup-option options + (N_ "Sorting") + (N_ "Primary Key"))) + comp-funcs-assoc-list)) + 2)) + + (define (get-secondary-subheading-renderer option) + (vector-ref (cdr + (assq (gnc:option-value + (gnc:lookup-option options + (N_ "Sorting") + (N_ "Secondary Key"))) + comp-funcs-assoc-list)) + 2)) + + (define (transaction-report-multi-rows-p options) + (eq? (gnc:option-value + (gnc:lookup-option options (N_ "Report Options") (N_ "Style"))) + 'multi-line)) + + (define (add-other-split-rows split table used-columns) + (define (other-rows-driver split parent table used-columns i) + (let ((current (gnc:transaction-get-split parent i))) + (gnc:debug "i" i) + (gnc:debug "current" current) + (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) + (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 + multi-rows? + primary-subtotal-pred + secondary-subtotal-pred + primary-subheading-renderer + secondary-subheading-renderer + primary-subtotal-collector + secondary-subtotal-collector + total-collector) + (if (null? splits) #f + (let* ((current (car splits)) + + (rest (cdr splits)) + (next (if (null? rest) #f + (car rest))) + (split-value (add-split-row table current used-columns))) + (if multi-rows? + (add-other-split-rows current table used-columns)) + (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 secondary-subtotal-pred + (or (not next) + (and next + (not (secondary-subtotal-pred current next))))) + (begin (add-subtotal-row table current used-columns + secondary-subtotal-collector) + (set! secondary-subtotal-collector + (make-commodity-collector)) + (if next + (secondary-subheading-renderer current table)))) + (if (and primary-subtotal-pred + (or (not next) + (and next + (not (primary-subtotal-pred current next))))) + (begin (add-subtotal-row table current used-columns + primary-subtotal-collector) + (set! primary-subtotal-collector + (make-commodity-collector)) + (if next + (primary-subheading-renderer next table)))) + (do-rows-with-subtotals rest + table + used-columns + multi-rows? + primary-subtotal-pred + secondary-subtotal-pred + primary-subheading-renderer + secondary-subheading-renderer + primary-subtotal-collector + secondary-subtotal-collector + total-collector)))) + + (let ((table (gnc:make-html-table)) + (used-columns (build-column-used options)) + (multi-rows? (transaction-report-multi-rows-p options)) + (primary-subtotal-pred (get-primary-subtotal-pred options)) + (secondary-subtotal-pred (get-secondary-subtotal-pred options)) + (primary-subheading-renderer + (get-primary-subheading-renderer options)) + (secondary-subheading-renderer + (get-secondary-subheading-renderer options))) + (gnc:html-table-set-col-headers! + table + (make-heading-list used-columns)) +; (gnc:warn "Splits:" splits) + (do-rows-with-subtotals splits table used-columns + multi-rows? primary-subtotal-pred + secondary-subtotal-pred + primary-subheading-renderer + secondary-subheading-renderer + (make-commodity-collector) + (make-commodity-collector) + (make-commodity-collector)) + table)) + + (define (trep-renderer report-obj) + (define (opt-val section name) + (gnc:option-value + (gnc:lookup-option (gnc:report-options report-obj) section name))) + + (let ((document (gnc:make-html-document)) + (c_accounts (opt-val "Report Options" "Account")) + (begindate (gnc:date-option-absolute-time + (opt-val "Report Options" "From"))) + (enddate (gnc:date-option-absolute-time + (opt-val "Report Options" "To"))) + (primary-key (opt-val "Sorting" "Primary Key")) + (primary-order (opt-val "Sorting" "Primary Sort Order")) + (secondary-key (opt-val "Sorting" "Secondary Key")) + (secondary-order (opt-val "Sorting" "Secondary Sort Order")) + (splits '()) + (table '()) + (query (gnc:malloc-query))) + + (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 + (lookup-sort-key primary-key) + (lookup-sort-key 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) + (set! table (make-split-table splits (gnc:report-options report-obj))) + + (gnc:html-document-set-title! document (_ "Transaction Report")) + (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) + + document)) (gnc:define-report - 'version 1 - 'name (_ "Transaction Report") + + ;; The version of this report. + 'version 2 + + ;; The name of this report. This will be used, among other things, + ;; for making its menu item in the main menu. You need to use the + ;; untranslated value here! + 'name (N_ "Transaction Report") + + ;; The options generator function defined above. 'options-generator trep-options-generator - 'renderer gnc:trep-renderer)) + + ;; The rendering function defined above. + 'renderer trep-renderer)))