From d59749ed68312a2ef393839eed9c28d450b92f7e Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Thu, 12 Apr 2001 07:12:39 +0000 Subject: [PATCH] Robert Graham Merkel's patch. * src/engine/Transaction.[ch] (xaccSplitGetCorrAccountFullName): new functions. (xaccSplitCompareAccountNames): rename to xaccSplitCompareAccountFullNames and compare using full names. (xaccSplitCompareOtherAccountNames): renaming as above. * src/engine/Query.[ch]: rename sort enumeration values. * src/guile/gnc.gwp: update to match above changes. * src/scm/report-utilities.scm (gnc:split-get-corr-account-full-name): new function. * src/scm/report/transaction-report.scm: use above changes to sort and optionally display full account names. Fix unrelated bugs with sorting options. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3948 57a11ea4-9604-0410-9ed3-97b8803252fd --- ChangeLog | 18 +++ src/engine/Query.c | 13 +- src/engine/Query.h | 4 +- src/engine/Transaction.c | 54 ++++++- src/engine/Transaction.h | 5 +- src/scm/report-utilities.scm | 5 + src/scm/report/transaction-report.scm | 221 +++++++++++++++++--------- 7 files changed, 222 insertions(+), 98 deletions(-) diff --git a/ChangeLog b/ChangeLog index ac4b7b26fb..c494851bae 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,21 @@ +2001-04-12 Robert Graham Merkel + + * src/engine/Transaction.[ch] (xaccSplitGetCorrAccountFullName): new + functions. (xaccSplitCompareAccountNames): rename + to xaccSplitCompareAccountFullNames and compare using full names. + (xaccSplitCompareOtherAccountNames): renaming as above. + + * src/engine/Query.[ch]: rename sort enumeration values. + + * src/guile/gnc.gwp: update to match above changes. + + * src/scm/report-utilities.scm (gnc:split-get-corr-account-full-name): + new function. + + * src/scm/report/transaction-report.scm: use above changes to sort + and optionally display full account names. Fix unrelated bugs with + sorting options. + 2001-04-11 Dave Peticolas * src/scm/report/hello-world.scm: add a menu tip as an example diff --git a/src/engine/Query.c b/src/engine/Query.c index adf67600e1..d875370f62 100644 --- a/src/engine/Query.c +++ b/src/engine/Query.c @@ -811,16 +811,15 @@ split_cmp_func(sort_type_t how, gconstpointer ga, gconstpointer gb) } break; - case BY_ACCOUNT_NAME: - return xaccSplitCompareAccountCodes(sa,sb); - break; - + case BY_ACCOUNT_FULL_NAME: + return xaccSplitCompareAccountFullNames(sa, sb); + case BY_ACCOUNT_CODE: - return xaccSplitCompareAccountNames(sa, sb); + return xaccSplitCompareAccountCodes(sa, sb); break; - case BY_CORR_ACCOUNT_NAME: - return xaccSplitCompareOtherAccountNames(sa, sb); + case BY_CORR_ACCOUNT_FULL_NAME: + return xaccSplitCompareOtherAccountFullNames(sa, sb); case BY_CORR_ACCOUNT_CODE: return xaccSplitCompareOtherAccountCodes(sa, sb); diff --git a/src/engine/Query.h b/src/engine/Query.h index e61fb6dca0..7b9ec13243 100644 --- a/src/engine/Query.h +++ b/src/engine/Query.h @@ -50,9 +50,9 @@ typedef enum { BY_MEMO, BY_DESC, BY_RECONCILE, - BY_ACCOUNT_NAME, + BY_ACCOUNT_FULL_NAME, BY_ACCOUNT_CODE, - BY_CORR_ACCOUNT_NAME, + BY_CORR_ACCOUNT_FULL_NAME, BY_CORR_ACCOUNT_CODE, BY_NONE } sort_type_t; diff --git a/src/engine/Transaction.c b/src/engine/Transaction.c index 00045f289e..1c1cd818ca 100644 --- a/src/engine/Transaction.c +++ b/src/engine/Transaction.c @@ -2006,6 +2006,27 @@ xaccSplitGetCorrAccountName(Split *sa) } } +char * +xaccSplitGetCorrAccountFullName(Split *sa, char separator) +{ + static const char *split_const = NULL; + Split *other_split; + Account *other_split_acc; + + if(get_corr_account_split(sa, &other_split)) + { + if (!split_const) + split_const = _("-- Split Transaction --"); + + return g_strdup(split_const); + } + else + { + other_split_acc = xaccSplitGetAccount(other_split); + return xaccAccountGetFullName(other_split_acc, separator); + } +} + const char * xaccSplitGetCorrAccountCode(Split *sa) { @@ -2028,19 +2049,28 @@ xaccSplitGetCorrAccountCode(Split *sa) } int -xaccSplitCompareAccountNames(Split *sa, Split *sb) +xaccSplitCompareAccountFullNames(Split *sa, Split *sb) { Account *aa, *ab; + char *full_a, *full_b; + int retval; 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)); + full_a = xaccAccountGetFullName(aa, ':'); + full_b = xaccAccountGetFullName(ab, ':'); + /* for comparison purposes it doesn't matter what we use as a separator */ + retval = safe_strcmp(full_a, full_b); + g_free(full_a); + g_free(full_b); + return retval; + } + int xaccSplitCompareAccountCodes(Split *sa, Split *sb) { @@ -2056,16 +2086,24 @@ xaccSplitCompareAccountCodes(Split *sa, Split *sb) } int -xaccSplitCompareOtherAccountNames(Split *sa, Split *sb) +xaccSplitCompareOtherAccountFullNames(Split *sa, Split *sb) { - const char *ca, *cb; + char *ca, *cb; + int retval; if (!sa && !sb) return 0; if (!sa) return -1; if (!sb) return 1; - ca = xaccSplitGetCorrAccountName(sa); - cb = xaccSplitGetCorrAccountName(sb); - return safe_strcmp(ca, cb); + /* doesn't matter what separator we use + * as long as they are the same + */ + + ca = xaccSplitGetCorrAccountFullName(sa, ':'); + cb = xaccSplitGetCorrAccountFullName(sb, ':'); + retval = safe_strcmp(ca, cb); + g_free(ca); + g_free(cb); + return retval; } int diff --git a/src/engine/Transaction.h b/src/engine/Transaction.h index 5842c18fce..980f1af89c 100644 --- a/src/engine/Transaction.h +++ b/src/engine/Transaction.h @@ -522,9 +522,9 @@ int xaccSplitDateOrder (Split *sa, Split *sb); * of comparisons also induces guile slowdowns. */ -int xaccSplitCompareAccountNames(Split *sa, Split *sb); +int xaccSplitCompareAccountFullNames(Split *sa, Split *sb); int xaccSplitCompareAccountCodes(Split *sa, Split *sb); -int xaccSplitCompareOtherAccountNames(Split *sa, Split *sb); +int xaccSplitCompareOtherAccountFullNames(Split *sa, Split *sb); int xaccSplitCompareOtherAccountCodes(Split *sa, Split *sb); @@ -538,6 +538,7 @@ int xaccSplitCompareOtherAccountCodes(Split *sa, Split *sb); * is silly. */ +char * xaccSplitGetCorrAccountFullName(Split *sa, char seperator); const char * xaccSplitGetCorrAccountName(Split *sa); const char * xaccSplitGetCorrAccountCode(Split *sa); diff --git a/src/scm/report-utilities.scm b/src/scm/report-utilities.scm index abb24513f5..8b9e33cb44 100644 --- a/src/scm/report-utilities.scm +++ b/src/scm/report-utilities.scm @@ -161,6 +161,11 @@ separator (gnc:account-get-name account))))))) +(define (gnc:split-get-corr-account-full-name split) + (let ((separator (string-ref (gnc:account-separator-char) 0))) + (gnc:split-get-corr-account-full-name-internal split separator))) + + ;; get children that are the direct descendant of this acct (define (gnc:account-get-immediate-subaccounts acct) (define (acctptr-eq? a1 a2) diff --git a/src/scm/report/transaction-report.scm b/src/scm/report/transaction-report.scm index c6f2004efa..c0ac22b047 100644 --- a/src/scm/report/transaction-report.scm +++ b/src/scm/report/transaction-report.scm @@ -16,14 +16,14 @@ (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 (split-account-full-name-same-p a b) + (= (gnc:split-compare-account-full-names a b) 0)) (define (split-account-code-same-p a b) (= (gnc:split-compare-account-codes a b) 0)) - (define (split-same-corr-account-p a b) - (= (gnc:split-compare-other-account-names a b) 0)) + (define (split-same-corr-account-full-name-p a b) + (= (gnc:split-compare-other-account-full-names a b) 0)) (define (split-same-corr-account-code-p a b) (= (gnc:split-compare-other-account-codes a b) 0)) @@ -42,66 +42,73 @@ (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 (set-last-row-style! table tag . rest) - (let ((arg-list - (cons table - (cons (- (gnc:html-table-num-rows table) 1) (cons tag rest))))) - (apply gnc:html-table-set-row-style! arg-list))) - - (define (add-subheading-row data table width subheading-style) - (let ((heading-cell (gnc:make-html-table-cell data))) - (gnc:html-table-cell-set-colspan! heading-cell width) - (gnc:html-table-append-row! - table - (list heading-cell)) - (apply set-last-row-style! - (cons table (cons "tr" subheading-style))))) - - (define (render-account-name-subheading split table width subheading-style) - (add-subheading-row (gnc:account-get-name - (gnc:split-get-account split)) - table width subheading-style)) - - (define (render-account-code-subheading split table width subheading-style) - (add-subheading-row (gnc:account-get-code - (gnc:split-get-account split)) - table width subheading-style)) - - (define (render-corresponding-account-name-subheading - split table width subheading-style) - (add-subheading-row (gnc:split-get-corr-account-name split) - table width subheading-style)) - - - (define (render-corresponding-account-code-subheading - split table width subheading-style) - (add-subheading-row (gnc:split-get-corr-account-code split) - table width subheading-style)) - - (define (render-month-subheading split table width subheading-style) - (add-subheading-row (strftime "%B %Y" (gnc:timepair->date - (gnc:transaction-get-date-posted - (gnc:split-get-parent split)))) - table width subheading-style)) + (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 (render-year-subheading split table width subheading-style) - (add-subheading-row (strftime "%Y" (gnc:timepair->date - (gnc:transaction-get-date-posted - (gnc:split-get-parent split)))) - table width subheading-style)) + (define (set-last-row-style! table tag . rest) + (let ((arg-list + (cons table + (cons (- (gnc:html-table-num-rows table) 1) (cons tag rest))))) + (apply gnc:html-table-set-row-style! arg-list))) + + (define (add-subheading-row data table width subheading-style) + (let ((heading-cell (gnc:make-html-table-cell data))) + (gnc:html-table-cell-set-colspan! heading-cell width) + (gnc:html-table-append-row! + table + (list heading-cell)) + (apply set-last-row-style! + (cons table (cons "tr" subheading-style))))) + + (define (render-account-full-name-subheading + split table width subheading-style) + (add-subheading-row (gnc:account-get-full-name + (gnc:split-get-account split)) + table width subheading-style)) + + (define (render-account-code-subheading split table width subheading-style) + (add-subheading-row (gnc:account-get-code + (gnc:split-get-account split)) + table width subheading-style)) + + (define (render-corresponding-account-name-subheading + split table width subheading-style) + (add-subheading-row (gnc:split-get-corr-account-full-name split) + table width subheading-style)) + + + (define (render-corresponding-account-code-subheading + split table width subheading-style) + (add-subheading-row (gnc:split-get-corr-account-code split) + table width subheading-style)) + + (define (render-month-subheading split table width subheading-style) + (add-subheading-row (strftime "%B %Y" (gnc:timepair->date + (gnc:transaction-get-date-posted + (gnc:split-get-parent split)))) + table width subheading-style)) + + (define (render-year-subheading split table width subheading-style) + (add-subheading-row (strftime "%Y" (gnc:timepair->date + (gnc:transaction-get-date-posted + (gnc:split-get-parent split)))) + table width subheading-style)) + + (let () + + (define account-types-to-reverse-assoc-list + (list (cons 'none '()) + (cons 'income-expense '(income expense)) + (cons 'credit-accounts '(liability equity credit income)))) - (let () (define comp-funcs-assoc-list (list (cons 'account-name (vector - 'by-account-name - split-account-name-same-p - render-account-name-subheading)) + 'by-account-full-name + split-account-full-name-same-p + render-account-full-name-subheading)) (cons 'account-code (vector 'by-account-code split-account-code-same-p @@ -115,14 +122,14 @@ split-same-year-p render-year-subheading)) (cons 'corresponding-acc-name - (vector 'by-corr-account-name #f #f)) + (vector 'by-corr-account-full-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 + (vector 'by-corr-account-full-name + split-same-corr-account-full-name-p render-corresponding-account-name-subheading)) - (cons 'correspoinding-acc-code-subtotal + (cons 'corresponding-acc-code-subtotal (vector 'by-corr-account-code split-same-corr-account-code-p @@ -154,9 +161,11 @@ (define (used-amount-double-negative columns-used) (vector-ref columns-used 9)) (define (used-running-balance columns-used) - (vector-ref columns-used 10)) + (vector-ref columns-used 10)) + (define (used-account-full-name columns-used) + (vector-ref columns-used 11)) - (define columns-used-size 11) + (define columns-used-size 12) (define (num-columns-required columns-used) (do ((i 0 (+ i 1)) @@ -168,7 +177,7 @@ (define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name))) - (let ((column-list (make-vector 11 #f))) + (let ((column-list (make-vector columns-used-size #f))) (if (opt-val (N_ "Display") (N_ "Date")) (vector-set! column-list 0 #t)) (if (opt-val (N_ "Display") (N_ "Num")) @@ -192,6 +201,8 @@ (vector-set! column-list 9 #t)))) (if (opt-val (N_ "Display") (N_ "Running Balance")) (vector-set! column-list 10 #t)) + (if (opt-val (N_ "Display") (N_ "Use Full Account Name?")) + (vector-set! column-list 11 #t)) ; (gnc:debug "Column list:" column-list) column-list)) @@ -224,13 +235,23 @@ (addto! heading-list (_ "Balance"))) (reverse heading-list))) - (define (add-split-row table split column-vector row-style transaction-row?) + (define (add-split-row table split column-vector row-style account-types-to-reverse transaction-row?) (let* ((row-contents '()) (parent (gnc:split-get-parent split)) (account (gnc:split-get-account split)) + (account-type (gw:enum--val->sym (gnc:account-get-type account) #f)) (currency (gnc:account-get-commodity account)) (damount (gnc:split-get-share-amount split)) - (split-value (gnc:make-gnc-monetary currency damount))) + (dummy1 (begin + (gnc:debug "account-type" account-type) + (gnc:debug "account-types-to-reverse" account-types-to-reverse) + (gnc:debug "member result" (member account-type account-types-to-reverse)) + #f)) + (split-value (gnc:make-gnc-monetary + currency + (if (member account-type account-types-to-reverse) + (gnc:numeric-neg damount) + damount)))) (if (used-date column-vector) (addto! row-contents @@ -249,9 +270,17 @@ (gnc:transaction-get-description parent) " "))) (if (used-account column-vector) - (addto! row-contents (gnc:account-get-name account))) + (if (used-account-full-name column-vector) + (addto! row-contents (gnc:account-get-full-name account)) + (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-account-full-name column-vector) + + (addto! row-contents (gnc:split-get-corr-account-full-name + split)) + (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) @@ -348,16 +377,16 @@ (N_ "Sort by account transferred from/to's name")) (vector 'corresponding-acc-name-subtotal - (N_ "Transfer from/to (w/subtotal) by code ") + (N_ "Transfer from/to (w/subtotal)") (N_ "Sort and subtotal by account transferred - from/to's code")) + from/to's name")) (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_ "Transfer from/to (w/subtotal) by code") (N_ "Sort and subtotal by account transferred from/to's code")) @@ -446,6 +475,11 @@ (N_ "Display") (N_ "Account") "g" (N_ "Display the account?") #t)) + (gnc:register-trep-option + (gnc:make-simple-boolean-option + (N_ "Display") (N_ "Use Full Account Name?") + "ga" (N_ "Display the full account name") #t)) + (gnc:register-trep-option (gnc:make-simple-boolean-option (N_ "Display") (N_ "Other Account") @@ -482,6 +516,19 @@ (N_ "Display") (N_ "Totals") "l" (N_ "Display the totals?") #t)) + (gnc:register-trep-option + (gnc:make-multichoice-option + (N_ "Display") (N_ "Sign Reverses?") + "m" "Reverse amount display for certain account types" + 'income-expense + (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:register-trep-option (gnc:make-color-option (N_ "Colors") (N_ "Primary Subtotals/headings") @@ -596,7 +643,7 @@ comp-funcs-assoc-list)) 1)) - (define (get-primary-subheading-renderer option) + (define (get-primary-subheading-renderer options) (vector-ref (cdr (assq (gnc:option-value (gnc:lookup-option options @@ -605,7 +652,7 @@ comp-funcs-assoc-list)) 2)) - (define (get-secondary-subheading-renderer option) + (define (get-secondary-subheading-renderer options) (vector-ref (cdr (assq (gnc:option-value (gnc:lookup-option options @@ -614,12 +661,20 @@ comp-funcs-assoc-list)) 2)) + (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 (N_ "General") (N_ "Style"))) 'multi-line)) - (define (add-other-split-rows split table used-columns row-style) + (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))) (gnc:debug "i" i) @@ -628,7 +683,7 @@ ((equal? current split) (other-rows-driver split parent table used-columns (+ i 1))) (else (begin - (add-split-row table current used-columns row-style #f) + (add-split-row table current used-columns row-style account-types-to-reverse #f) (other-rows-driver split parent table used-columns (+ i 1))))))) @@ -641,6 +696,7 @@ width multi-rows? odd-row? + account-types-to-reverse primary-subtotal-pred secondary-subtotal-pred primary-subheading-renderer @@ -675,6 +731,7 @@ current used-columns current-row-style + account-types-to-reverse #t))) (if multi-rows? (add-other-split-rows @@ -717,6 +774,7 @@ width multi-rows? (not odd-row?) + account-types-to-reverse primary-subtotal-pred secondary-subtotal-pred primary-subheading-renderer @@ -749,8 +807,11 @@ (odd-row-style (get-odd-row-style options)) (even-row-style - (get-even-row-style options))) + (get-even-row-style options)) + (account-types-to-reverse + (get-account-types-to-reverse options))) + (gnc:debug "account-types-to-reverse " account-types-to-reverse) (gnc:html-table-set-col-headers! table (make-heading-list used-columns)) @@ -762,7 +823,9 @@ (secondary-subheading-renderer (car splits) table widthsecondary-subtotal-style))) (do-rows-with-subtotals splits table used-columns width - multi-rows? #t primary-subtotal-pred + multi-rows? #t + account-types-to-reverse + primary-subtotal-pred secondary-subtotal-pred primary-subheading-renderer secondary-subheading-renderer