diff --git a/ChangeLog b/ChangeLog index 2f56be9d5a..db9c77ae1c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,26 @@ +2001-03-21 Dave Peticolas + + * src/scm/report-utilities.scm + (gnc:accounts-get-comm-total-income): new func + (gnc:accounts-get-comm-total-expense): new func + + * src/scm/report/income-expense-graph.scm: allow user to display + both income & expense side-by-side + + * src/scm/report/pnl.scm: use sprintf to make title + + * src/guile/guile-util.c (gnc_get_debit_string): use g_strdup + (gnc_get_credit_string): use g_strdup + + * src/gnome/gnc-html.c: add guid type to register anchor + + * src/scm/report/register.scm: work on display + + * src/engine/Query.c (xaccQueryGetSplitsUniqueTrans): fix bug + + * src/gnome/window-register.c: add arguments to report window + for title & debit/credit strings + 2001-03-20 Christian Stimming * src/scm/report/income-expense-graph.scm, diff --git a/src/SplitLedger.c b/src/SplitLedger.c index 07bfbd7c52..14993c724b 100644 --- a/src/SplitLedger.c +++ b/src/SplitLedger.c @@ -3911,16 +3911,37 @@ sr_type_to_account_type(SplitRegisterType sr_type) } } -static char * -sr_get_debit_string (SplitRegister *reg) +const char * +xaccSRGetDebitString (SplitRegister *reg) { - return gnc_get_debit_string (sr_type_to_account_type (reg->type)); + if (!reg) + return NULL; + + reg->debit_str = gnc_get_debit_string (sr_type_to_account_type (reg->type)); + + if (reg->debit_str) + return reg->debit_str; + + reg->debit_str = g_strdup (_("Debit")); + + return reg->debit_str; } -static char * -sr_get_credit_string (SplitRegister *reg) +const char * +xaccSRGetCreditString (SplitRegister *reg) { - return gnc_get_credit_string (sr_type_to_account_type (reg->type)); + if (reg->credit_str) + return reg->credit_str; + + reg->credit_str = + gnc_get_credit_string (sr_type_to_account_type (reg->type)); + + if (reg->credit_str) + return reg->credit_str; + + reg->credit_str = g_strdup (_("Credit")); + + return reg->credit_str; } const char * @@ -3961,30 +3982,10 @@ xaccSRGetLabelHandler (VirtualLocation virt_loc, gpointer user_data) return _("Memo"); case CRED_CELL: - if (reg->credit_str) - return reg->credit_str; - - reg->credit_str = sr_get_credit_string (reg); - - if (reg->credit_str) - return reg->credit_str; - - reg->credit_str = g_strdup (_("Credit")); - - return reg->credit_str; + return xaccSRGetCreditString (reg); case DEBT_CELL: - if (reg->debit_str) - return reg->debit_str; - - reg->debit_str = sr_get_debit_string (reg); - - if (reg->debit_str) - return reg->debit_str; - - reg->debit_str = g_strdup (_("Debit")); - - return reg->debit_str; + return xaccSRGetDebitString (reg); case PRIC_CELL: if (!use_security_cells (reg, virt_loc)) @@ -4006,12 +4007,9 @@ xaccSRGetLabelHandler (VirtualLocation virt_loc, gpointer user_data) return reg->tcredit_str; { - char *string = sr_get_credit_string (reg); + const char *string = xaccSRGetCreditString (reg); if (string) - { reg->tcredit_str = g_strdup_printf (_("Tot %s"), string); - g_free (string); - } } if (reg->tcredit_str) @@ -4026,12 +4024,9 @@ xaccSRGetLabelHandler (VirtualLocation virt_loc, gpointer user_data) return reg->tdebit_str; { - char *string = sr_get_debit_string (reg); + const char *string = xaccSRGetDebitString (reg); if (string) - { reg->tdebit_str = g_strdup_printf (_("Tot %s"), string); - g_free (string); - } } if (reg->tdebit_str) diff --git a/src/SplitLedger.h b/src/SplitLedger.h index 0fcb0e035f..7557ad8c4b 100644 --- a/src/SplitLedger.h +++ b/src/SplitLedger.h @@ -197,6 +197,10 @@ void xaccSRExpandCurrentTrans (SplitRegister *reg, gboolean expand); /* Return TRUE if current trans is expanded and style is REG_STYLE_LEDGER. */ gboolean xaccSRCurrentTransExpanded (SplitRegister *reg); +/* Return the debit and credit strings used in the register. */ +const char * xaccSRGetDebitString (SplitRegister *reg); +const char * xaccSRGetCreditString (SplitRegister *reg); + /* Private functions, for MultiLedger.c only */ gboolean xaccSRFullRefreshOK (SplitRegister *reg); void xaccSRLoadXferCells (SplitRegister *reg, Account *base_account); diff --git a/src/engine/Query.c b/src/engine/Query.c index 0b8c465c1a..0071dd221c 100644 --- a/src/engine/Query.c +++ b/src/engine/Query.c @@ -1126,7 +1126,6 @@ xaccQueryGetSplitsUniqueTrans(Query *q) } } - g_list_free (splits); g_hash_table_destroy (trans_hash); return g_list_reverse (result); diff --git a/src/gnome/gnc-html.c b/src/gnome/gnc-html.c index 55edae7022..a7ea3a42be 100644 --- a/src/gnome/gnc-html.c +++ b/src/gnome/gnc-html.c @@ -909,8 +909,11 @@ gnc_html_submit_cb(GtkHTML * html, const gchar * method, static void gnc_html_open_register(gnc_html * html, const gchar * location) { - Account * acct; - RegWindow * reg; + RegWindow * reg = NULL; + Split * split = NULL; + Account * acct; + Transaction * trans; + GList * node; /* href="gnc-register:account=My Bank Account" */ if(!strncmp("account=", location, 8)) { @@ -920,6 +923,61 @@ gnc_html_open_register(gnc_html * html, const gchar * location) { reg = regWindowSimple(acct); gnc_register_raise(reg); } + /* href="gnc-register:guid=12345678901234567890123456789012" */ + else if(!strncmp("guid=", location, 5)) { + GUID guid; + + if (!string_to_guid(location + 5, &guid)) + { + PWARN ("Bad guid: %s", location + 5); + return; + } + + switch (xaccGUIDType (&guid)) + { + case GNC_ID_NONE: + case GNC_ID_NULL: + PWARN ("No such entity: %s", location + 5); + return; + + case GNC_ID_ACCOUNT: + acct = xaccAccountLookup (&guid); + reg = regWindowSimple(acct); + break; + + case GNC_ID_TRANS: + trans = xaccTransLookup (&guid); + split = NULL; + + for (node = xaccTransGetSplitList (trans); node; node = node->next) + { + split = node->data; + if (xaccSplitGetAccount (split)) + break; + } + + if (!split) + return; + + reg = regWindowSimple (xaccSplitGetAccount (split)); + break; + + case GNC_ID_SPLIT: + split = xaccSplitLookup (&guid); + if (!split) + return; + + reg = regWindowSimple (xaccSplitGetAccount (split)); + break; + + default: + return; + } + + gnc_register_raise(reg); + if (split) + gnc_register_jump_to_split (reg, split); + } else { gnc_warning_dialog(_("Badly formed gnc-register: URL.")); } diff --git a/src/gnome/window-register.c b/src/gnome/window-register.c index 4da1826d58..5c8f0e1464 100644 --- a/src/gnome/window-register.c +++ b/src/gnome/window-register.c @@ -1795,18 +1795,18 @@ gnc_register_get_parent(xaccLedgerDisplay *ledger) return regData->window; } -static void -gnc_reg_set_window_name(RegWindow *regData) +static char * +gnc_reg_get_name (RegWindow *regData, gboolean for_window) { - SplitRegister *reg; Account *leader; - gchar *windowname; + SplitRegister *reg; + gboolean single_account; gchar *account_name; gchar *reg_name; - gboolean single_account; + gchar *name; if (regData == NULL) - return; + return NULL; reg = xaccLedgerDisplayGetSR (regData->ledger); @@ -1814,19 +1814,31 @@ gnc_reg_set_window_name(RegWindow *regData) { case GENERAL_LEDGER: case INCOME_LEDGER: - reg_name = _("General Ledger"); + if (for_window) + reg_name = _("General Ledger"); + else + reg_name = _("General Ledger Report"); single_account = FALSE; break; case PORTFOLIO_LEDGER: - reg_name = _("Portfolio"); + if (for_window) + reg_name = _("Portfolio"); + else + reg_name = _("Portfolio Report"); single_account = FALSE; break; case SEARCH_LEDGER: - reg_name = _("Search Results"); + if (for_window) + reg_name = _("Search Results"); + else + reg_name = _("Search Results Report"); single_account = FALSE; break; default: - reg_name = _("Register"); + if (for_window) + reg_name = _("Register"); + else + reg_name = _("Register Report"); single_account = TRUE; break; } @@ -1835,18 +1847,33 @@ gnc_reg_set_window_name(RegWindow *regData) if ((leader != NULL) && single_account) { - account_name = xaccAccountGetFullName(leader, gnc_get_account_separator()); + account_name = xaccAccountGetFullName (leader, + gnc_get_account_separator ()); - windowname = g_strconcat(account_name, " - ", reg_name, NULL); + name = g_strconcat (account_name, " - ", reg_name, NULL); g_free(account_name); } else - windowname = g_strdup(reg_name); + name = g_strdup (reg_name); - gtk_window_set_title(GTK_WINDOW(regData->window), windowname); + return name; +} - g_free(windowname); +static void +gnc_reg_set_window_name (RegWindow *regData) +{ + SplitRegister *reg; + gchar *windowname; + + if (regData == NULL) + return; + + windowname = gnc_reg_get_name (regData, TRUE); + + gtk_window_set_title (GTK_WINDOW(regData->window), windowname); + + g_free (windowname); } static void @@ -2980,26 +3007,46 @@ report_helper (RegWindow *regData, SCM func) { SplitRegister *reg = xaccLedgerDisplayGetSR (regData->ledger); Query *query; - SCM query_type; - SCM query_scm; - SCM journal_scm; + char *str; + SCM qtype; + SCM args; + SCM arg; - query_type = gh_eval_str(""); - g_return_if_fail (query_type != SCM_UNDEFINED); + g_return_if_fail (gh_procedure_p (func)); + + args = SCM_EOL; + + arg = gh_str02scm (xaccSRGetCreditString (reg)); + args = gh_cons (arg, args); + + arg = gh_str02scm (xaccSRGetDebitString (reg)); + args = gh_cons (arg, args); + + str = gnc_reg_get_name (regData, FALSE); + arg = gh_str02scm (str); + args = gh_cons (arg, args); + g_free (str); + + arg = gh_bool2scm (reg->style == REG_STYLE_JOURNAL); + args = gh_cons (arg, args); + + qtype = gh_eval_str(""); + g_return_if_fail (qtype != SCM_UNDEFINED); query = xaccLedgerDisplayGetQuery (regData->ledger); g_return_if_fail (query != NULL); query = xaccQueryCopy (query); - query_scm = gw_wcp_assimilate_ptr (query, query_type); - g_return_if_fail (query_scm != SCM_UNDEFINED); + arg = gw_wcp_assimilate_ptr (query, qtype); + args = gh_cons (arg, args); + if (arg == SCM_UNDEFINED) + { + xaccFreeQuery (query); + return; + } - journal_scm = gh_bool2scm (reg->style == REG_STYLE_JOURNAL); - - g_return_if_fail (gh_procedure_p (func)); - - gh_call2 (func, query_scm, journal_scm); + gh_apply (func, args); } /********************************************************************\ diff --git a/src/scm/html-utilities.scm b/src/scm/html-utilities.scm index 218d3fd633..b43870dfb9 100644 --- a/src/scm/html-utilities.scm +++ b/src/scm/html-utilities.scm @@ -34,8 +34,23 @@ (define (gnc:account-anchor-text acct) (string-append - "gnc-register:account=" - (gnc:account-get-full-name acct))) + "gnc-register:guid=" + (gnc:account-get-guid acct))) + +(define (gnc:split-anchor-text split) + (string-append + "gnc-register:guid=" + (gnc:split-get-guid split))) + +(define (gnc:transaction-anchor-text trans) + (string-append + "gnc-register:guid=" + (gnc:transaction-get-guid trans))) + +(define (gnc:report-anchor-text report-id) + (string-append + "gnc-report:id=" + (number->string report-id))) ;; returns the account name as html-text and anchor to the register. (define (gnc:html-account-anchor acct) @@ -43,10 +58,15 @@ (gnc:account-anchor-text acct) (gnc:account-get-name acct)))) -(define (gnc:report-anchor-text report-id) - (string-append - "gnc-report:id=" - (number->string report-id))) +(define (gnc:html-split-anchor split text) + (gnc:make-html-text (gnc:html-markup-anchor + (gnc:split-anchor-text split) + text))) + +(define (gnc:html-transaction-anchor trans text) + (gnc:make-html-text (gnc:html-markup-anchor + (gnc:transaction-anchor-text trans) + text))) (define (gnc:assign-colors num-colors) (define base-colors '("red" "orange" "yellow" "green" diff --git a/src/scm/report-utilities.scm b/src/scm/report-utilities.scm index 019a2876c2..16d4c4198c 100644 --- a/src/scm/report-utilities.scm +++ b/src/scm/report-utilities.scm @@ -487,6 +487,26 @@ get-balance-fn (lambda(x) #t))) +;; Adds all accounts' balances, where the balances are determined with +;; the get-balance-fn. Only the income accounts are regarded, and +;; the result is sign reversed. Returns a commodity-collector. +(define (gnc:accounts-get-comm-total-income accounts + get-balance-fn) + (gnc:accounts-get-balance-helper + (gnc:filter-accountlist-type '(income) accounts) + get-balance-fn + (lambda(x) #t))) + +;; Adds all accounts' balances, where the balances are determined with +;; the get-balance-fn. Only the expense accounts are regarded, and +;; the result is sign reversed. Returns a commodity-collector. +(define (gnc:accounts-get-comm-total-expense accounts + get-balance-fn) + (gnc:accounts-get-balance-helper + (gnc:filter-accountlist-type '(expense) accounts) + get-balance-fn + (lambda(x) #t))) + ;; Adds all accounts' balances, where the balances are determined with ;; the get-balance-fn. Intended for usage with a balance sheet, hence ;; a) the income/expense accounts are ignored, and b) no signs are diff --git a/src/scm/report/income-expense-graph.scm b/src/scm/report/income-expense-graph.scm index 286b5bd1f6..27954b8205 100644 --- a/src/scm/report/income-expense-graph.scm +++ b/src/scm/report/income-expense-graph.scm @@ -9,6 +9,7 @@ (gnc:depend "date-utilities.scm") (let ((pagename-general (N_ "General")) + (optname-show-net (N_ "Show Net Profit")) (optname-from-date (N_ "From")) (optname-to-date (N_ "To")) (optname-accounts (N_ "Accounts")) @@ -18,7 +19,6 @@ (pagename-display (N_ "Display Format")) (optname-plot-width (N_ "Plot Width")) (optname-plot-height (N_ "Plot Height"))) - (define (options-generator) (let* ((options (gnc:new-options)) @@ -28,10 +28,16 @@ (lambda (new-option) (gnc:register-option options new-option)))) + (add-option + (gnc:make-simple-boolean-option + pagename-general optname-show-net + "a" (N_ "Show a single bar with net profit instead of + side-by-side bars with income and expense") #f)) + (gnc:options-add-date-interval! options pagename-general - optname-from-date optname-to-date "a") - + optname-from-date optname-to-date "aa") + (add-option (gnc:make-multichoice-option pagename-general optname-stepsize @@ -56,7 +62,7 @@ (list #t (filter gnc:account-is-inc-exp? accounts))) #t)) - + (add-option (gnc:make-currency-option pagename-general optname-report-currency @@ -96,8 +102,31 @@ (define (op-value section name) (gnc:option-value (get-op section name))) - - (let* ((to-date-tp (gnc:timepair-end-day-time + + (define (collector-fn accounts income?) + (lambda (date-list-entry) + (let ((start-date (car date-list-entry)) + (end-date (cadr date-list-entry))) + ((if income? + gnc:accounts-get-comm-total-income + gnc:accounts-get-comm-total-expense) + accounts + (lambda (account) + (gnc:account-get-comm-balance-interval account + start-date + end-date + #f)))))) + + (define (collector-to-double-fn report-currency exchange-fn) + (lambda (commodity-collector) + (gnc:numeric-to-double + (gnc:gnc-monetary-amount + (gnc:sum-collector-commodity commodity-collector + report-currency + exchange-fn))))) + + (let* ((show-net? (op-value pagename-general optname-show-net)) + (to-date-tp (gnc:timepair-end-day-time (vector-ref (op-value pagename-general optname-to-date) 1))) (from-date-tp (gnc:timepair-start-day-time @@ -105,7 +134,8 @@ optname-from-date) 1))) (interval (op-value pagename-general optname-stepsize)) (accounts (op-value pagename-general optname-accounts)) - (report-currency (op-value pagename-general optname-report-currency)) + (report-currency (op-value pagename-general + optname-report-currency)) (height (op-value pagename-display optname-plot-height)) (width (op-value pagename-display optname-plot-width)) @@ -122,29 +152,16 @@ (gnc:timepair-end-day-time (decdate to-date-tp DayDelta)) (eval interval))) - (profit-collector-fn - (lambda (date-list-entry) - (let ((start-date (car date-list-entry)) - (end-date (cadr date-list-entry))) - (gnc:accounts-get-comm-total-profit - accounts - (lambda (account) - (gnc:account-get-comm-balance-interval - account - start-date - end-date - #f)))))) - (profit-collector-list - (map profit-collector-fn dates-list)) - (double-list - (map (lambda (commodity-collector) - ;;(- - (gnc:numeric-to-double - (gnc:gnc-monetary-amount - (gnc:sum-collector-commodity - commodity-collector report-currency - exchange-fn-internal))));;) - profit-collector-list)) + (income-collector-fn (collector-fn accounts #t)) + (expense-collector-fn (collector-fn accounts #f)) + (income-collector-list (map income-collector-fn dates-list)) + (expense-collector-list (map expense-collector-fn dates-list)) + (income-list + (map (collector-to-double-fn report-currency exchange-fn-internal) + income-collector-list)) + (expense-list + (map (collector-to-double-fn report-currency exchange-fn-internal) + expense-collector-list)) (date-string-list (map (lambda (date-list-item) (gnc:timepair-to-datestring @@ -159,13 +176,25 @@ (gnc:timepair-to-datestring to-date-tp))) (gnc:html-barchart-set-width! chart width) (gnc:html-barchart-set-height! chart height) - (gnc:html-barchart-append-column! chart double-list) (gnc:html-barchart-set-row-labels! chart date-string-list) - (gnc:html-barchart-set-row-labels-rotated?! chart #t) - (gnc:html-barchart-set-col-labels! chart (list (_ "Net Profit"))) - (gnc:html-barchart-set-col-colors! chart (list "red")) (gnc:html-barchart-set-y-axis-label! chart (gnc:commodity-get-mnemonic report-currency)) + (gnc:html-barchart-set-row-labels-rotated?! chart #t) + + (if show-net? + (begin + (gnc:html-barchart-append-column! chart + (map + income-list expense-list)) + (gnc:html-barchart-set-col-labels! chart (list (_ "Net Profit"))) + (gnc:html-barchart-set-col-colors! chart (list "red"))) + (begin + (gnc:html-barchart-append-column! chart income-list) + (gnc:html-barchart-append-column! chart (map - expense-list)) + (gnc:html-barchart-set-col-labels! chart + (list (_ "Income") + (_ "Expense"))) + (gnc:html-barchart-set-col-colors! chart (list "blue" "red")))) + (gnc:html-document-add-object! document chart) ; (gnc:html-document-add-object! diff --git a/src/scm/report/income-or-expense-pie.scm b/src/scm/report/income-or-expense-pie.scm index a6893fa161..e740259747 100644 --- a/src/scm/report/income-or-expense-pie.scm +++ b/src/scm/report/income-or-expense-pie.scm @@ -97,7 +97,8 @@ (vector-ref (op-value pagename-general optname-from-date) 1))) (accounts (op-value pagename-general optname-accounts)) - (report-currency (op-value pagename-general optname-report-currency)) + (report-currency (op-value pagename-general + optname-report-currency)) (max-slices (op-value pagename-display optname-slices)) (height (op-value pagename-display optname-plot-height)) diff --git a/src/scm/report/pnl.scm b/src/scm/report/pnl.scm index d86d55ed40..f4af070e56 100644 --- a/src/scm/report/pnl.scm +++ b/src/scm/report/pnl.scm @@ -121,10 +121,10 @@ (doc (gnc:make-html-document))) (gnc:html-document-set-title! - doc (string-append (_ "Profit and Loss") " " - (gnc:timepair-to-datestring from-date-tp) - " " (_ "to") " " - (gnc:timepair-to-datestring to-date-tp))) + doc (sprintf #f + (_ "Profit and Loss - %s to %s") + (gnc:timepair-to-datestring from-date-tp) + (gnc:timepair-to-datestring to-date-tp))) (if (not (null? accounts)) ;; if no max. tree depth is given we have to find the ;; maximum existing depth diff --git a/src/scm/report/register.scm b/src/scm/report/register.scm index d983150da6..2d2f949a46 100644 --- a/src/scm/report/register.scm +++ b/src/scm/report/register.scm @@ -27,22 +27,20 @@ (vector-ref columns-used 2)) (define (used-account columns-used) (vector-ref columns-used 3)) - (define (used-other-account columns-used) - (vector-ref columns-used 4)) (define (used-shares columns-used) - (vector-ref columns-used 5)) + (vector-ref columns-used 4)) (define (used-price columns-used) - (vector-ref columns-used 6)) + (vector-ref columns-used 5)) (define (used-amount-single columns-used) - (vector-ref columns-used 7)) + (vector-ref columns-used 6)) (define (used-amount-double-positive columns-used) - (vector-ref columns-used 8)) + (vector-ref columns-used 7)) (define (used-amount-double-negative columns-used) - (vector-ref columns-used 9)) + (vector-ref columns-used 8)) (define (used-running-balance columns-used) - (vector-ref columns-used 10)) + (vector-ref columns-used 9)) - (define columns-used-size 11) + (define columns-used-size 10) (define (num-columns-required columns-used) (do ((i 0 (+ i 1)) @@ -54,11 +52,8 @@ (define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name))) - (let ((column-list (make-vector 11 #f))) - (define (opt-val section name) - (gnc:option-value - (gnc:lookup-option options section name))) + (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")) @@ -67,27 +62,23 @@ (vector-set! column-list 2 #t)) (if (opt-val (N_ "Display") (N_ "Account")) (vector-set! column-list 3 #t)) - (if (opt-val (N_ "Display") (N_ "Other Account")) - (vector-set! column-list 4 #t)) (if (opt-val (N_ "Display") (N_ "Shares")) - (vector-set! column-list 5 #t)) - + (vector-set! column-list 4 #t)) (if (opt-val (N_ "Display") (N_ "Price")) - (vector-set! column-list 6 #t)) - + (vector-set! column-list 5 #t)) (let ((amount-setting (opt-val (N_ "Display") (N_ "Amount")))) (if (eq? amount-setting 'single) - (vector-set! column-list 7 #t)) + (vector-set! column-list 6 #t)) (if (eq? amount-setting 'double) (begin - (vector-set! column-list 8 #t) - (vector-set! column-list 9 #t)))) + (vector-set! column-list 7 #t) + (vector-set! column-list 8 #t)))) (if (opt-val (N_ "Display") (N_ "Running Balance")) - (vector-set! column-list 10 #t)) + (vector-set! column-list 9 #t)) column-list)) - (define (make-heading-list column-vector) + (define (make-heading-list column-vector debit-string credit-string) (let ((heading-list '())) (gnc:debug "Column-vector" column-vector) (if (used-date column-vector) @@ -98,24 +89,22 @@ (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"))) + (addto! heading-list debit-string)) (if (used-amount-double-negative column-vector) - (addto! heading-list (N_ "Credit"))) + (addto! heading-list credit-string)) (if (used-running-balance column-vector) (addto! heading-list (N_ "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 + transaction-info? split-info?) (let* ((row-contents '()) (parent (gnc:split-get-parent split)) (account (gnc:split-get-account split)) @@ -125,52 +114,74 @@ (if (used-date column-vector) (addto! row-contents - (if transaction-row? + (if transaction-info? (gnc:timepair-to-datestring (gnc:transaction-get-date-posted parent)) " "))) (if (used-num column-vector) (addto! row-contents - (if transaction-row? + (if transaction-info? (gnc:transaction-get-num parent) " "))) (if (used-description column-vector) (addto! row-contents - (if transaction-row? + (if transaction-info? (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))) + (addto! row-contents + (if split-info? + (gnc:account-get-name account) + " "))) (if (used-shares column-vector) - (addto! row-contents (gnc:split-get-share-amount split))) + (addto! row-contents + (if split-info? + (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)))) + (addto! row-contents + (if split-info? + (gnc:make-gnc-monetary + currency (gnc:split-get-share-price split)) + " "))) (if (used-amount-single column-vector) (addto! row-contents - (gnc:make-html-table-header-cell/markup "number-cell" - split-value))) + (if split-info? + (gnc:html-split-anchor + split + (gnc:make-html-table-header-cell/markup "number-cell" + split-value)) + " "))) (if (used-amount-double-positive column-vector) (if (gnc:numeric-positive-p (gnc:gnc-monetary-amount split-value)) (addto! row-contents - (gnc:make-html-table-header-cell/markup "number-cell" - split-value)) + (if split-info? + (gnc:make-html-table-header-cell/markup + "number-cell" + (gnc:html-split-anchor split split-value)) + " ")) (addto! row-contents " "))) (if (used-amount-double-negative column-vector) (if (gnc:numeric-negative-p (gnc:gnc-monetary-amount split-value)) (addto! row-contents - (gnc:make-html-table-header-cell/markup - "number-cell" (gnc:monetary-neg split-value))) + (if split-info? + (gnc:make-html-table-header-cell/markup + "number-cell" + (gnc:html-split-anchor + split (gnc:monetary-neg split-value))) + " ")) (addto! row-contents " "))) (if (used-running-balance column-vector) (addto! row-contents - (gnc:make-html-table-header-cell/markup - "number-cell" - (gnc:make-gnc-monetary currency - (gnc:split-get-balance split))))) + (if transaction-info? + (gnc:make-html-table-header-cell/markup + "number-cell" + (gnc:html-split-anchor + split + (gnc:make-gnc-monetary currency + (gnc:split-get-balance split)))) + " "))) + (gnc:html-table-append-row! table (reverse row-contents)) (apply set-last-row-style! (cons table (cons "tr" row-style))) split-value)) @@ -191,6 +202,16 @@ (gnc:make-internal-option "__reg" "query" #f)) (gnc:register-reg-option (gnc:make-internal-option "__reg" "journal" #f)) + (gnc:register-reg-option + (gnc:make-internal-option "__reg" "debit-string" (_ "Debit"))) + (gnc:register-reg-option + (gnc:make-internal-option "__reg" "credit-string" (_ "Credit"))) + + (gnc:register-reg-option + (gnc:make-string-option + (N_ "Report Options") (N_ "Title") + "a" (N_ "The title of the report") + (N_ "Register Report"))) (gnc:register-reg-option (gnc:make-simple-boolean-option @@ -217,12 +238,6 @@ (N_ "Display") (N_ "Account") "g" (N_ "Display the account?") #t)) - (gnc:register-reg-option - (gnc:make-simple-boolean-option - (N_ "Display") (N_ "Other Account") - "h" (N_ "Display the other account? - (if this is a split transaction, this parameter is guessed).") #f)) - (gnc:register-reg-option (gnc:make-simple-boolean-option (N_ "Display") (N_ "Shares") @@ -243,11 +258,6 @@ (vector 'single (N_ "Single") (N_ "Single Column Display")) (vector 'double (N_ "Double") (N_ "Two Column Display"))))) - (gnc:register-reg-option - (gnc:make-simple-boolean-option - (N_ "Display") (N_ "Headers") - "j" (N_ "Display the headers?") #t)) - (gnc:register-reg-option (gnc:make-simple-boolean-option (N_ "Display") (N_ "Running Balance") @@ -284,8 +294,7 @@ 255 #f)) - (gnc:options-set-default-section gnc:*report-options* - "Report Options") + (gnc:options-set-default-section gnc:*report-options* "Report Options") gnc:*report-options*) @@ -312,7 +321,10 @@ (N_ "Split Even")))) (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - (define (make-split-table splits options) + (define (make-split-table splits options debit-string credit-string) + (define (opt-val section name) + (gnc:option-value (gnc:lookup-option options section name))) + (define (add-subtotal-row table width subtotal-collector subtotal-style) (let ((currency-totals (subtotal-collector 'format gnc:make-gnc-monetary #f)) @@ -334,22 +346,17 @@ (cons table (cons "tr" subtotal-style)))) currency-totals))) - (define (reg-report-journal? options) - (gnc:option-value - (gnc:lookup-option options "__reg" "journal"))) + (define (reg-report-journal?) + (opt-val "__reg" "journal")) (define (add-other-split-rows split table used-columns row-style) (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 row-style #f) - (other-rows-driver split parent table used-columns - (+ i 1))))))) + (if current + (begin + (add-split-row table current used-columns row-style #f #t) + (other-rows-driver split parent table + used-columns (+ i 1)))))) (other-rows-driver split (gnc:split-get-parent split) table used-columns 0)) @@ -374,12 +381,13 @@ (rest (cdr splits)) (next (if (null? rest) #f (car rest))) - (split-value (add-split-row - table - current - used-columns - current-row-style - #t))) + (split-value (add-split-row table + current + used-columns + current-row-style + #t + (not multi-rows?)))) + (if multi-rows? (add-other-split-rows current table used-columns alternate-row-style)) @@ -402,7 +410,7 @@ (let* ((table (gnc:make-html-table)) (used-columns (build-column-used options)) (width (num-columns-required used-columns)) - (multi-rows? (reg-report-journal? options)) + (multi-rows? (reg-report-journal?)) (grand-total-style (get-grand-total-style options)) (odd-row-style @@ -412,7 +420,7 @@ (gnc:html-table-set-col-headers! table - (make-heading-list used-columns)) + (make-heading-list used-columns debit-string credit-string)) (do-rows-with-subtotals splits table @@ -435,7 +443,10 @@ (splits '()) (table '()) (query (opt-val "__reg" "query")) - (journal? (opt-val "__reg" "journal"))) + (journal? (opt-val "__reg" "journal")) + (debit-string (opt-val "__reg" "debit-string")) + (credit-string (opt-val "__reg" "credit-string")) + (title (opt-val "Report Options" "Title"))) (gnc:query-set-group query (gnc:get-current-group)) @@ -445,9 +456,11 @@ (gnc:query-get-splits query)) )) - (set! table (make-split-table splits (gnc:report-options report-obj))) + (set! table (make-split-table splits + (gnc:report-options report-obj) + debit-string credit-string)) - (gnc:html-document-set-title! document (_ "Register Report")) + (gnc:html-document-set-title! document title) ; (gnc:html-document-add-object! ; document ; (gnc:make-html-text @@ -465,16 +478,25 @@ 'renderer reg-renderer 'in-menu? #f)) -(define (gnc:apply-register-report func query journal?) +(define (gnc:apply-register-report func query journal? title + debit-string credit-string) (let* ((options (gnc:make-report-options "Register")) - (qo (gnc:lookup-option options "__reg" "query")) - (jo (gnc:lookup-option options "__reg" "journal"))) - (gnc:option-set-value qo query) - (gnc:option-set-value jo journal?) + (query-op (gnc:lookup-option options "__reg" "query")) + (journal-op (gnc:lookup-option options "__reg" "journal")) + (title-op (gnc:lookup-option options "Report Options" "Title")) + (debit-op (gnc:lookup-option options "__reg" "debit-string")) + (credit-op (gnc:lookup-option options "__reg" "credit-string"))) + + (gnc:option-set-value query-op query) + (gnc:option-set-value journal-op journal?) + (gnc:option-set-value title-op title) + (gnc:option-set-value debit-op debit-string) + (gnc:option-set-value credit-op credit-string) + (func (gnc:make-report "Register" options)))) -(define (gnc:show-register-report query journal?) - (gnc:apply-register-report gnc:report-window query journal?)) +(define (gnc:show-register-report . rest) + (apply gnc:apply-register-report (cons gnc:report-window rest))) -(define (gnc:print-register-report query journal?) - (gnc:apply-register-report gnc:print-report query journal?)) +(define (gnc:print-register-report . rest) + (apply gnc:apply-register-report (const gnc:print-report rest))) diff --git a/src/scm/report/transaction-report.scm b/src/scm/report/transaction-report.scm index 2b31b7afcb..4b51efb96a 100644 --- a/src/scm/report/transaction-report.scm +++ b/src/scm/report/transaction-report.scm @@ -168,10 +168,6 @@ (gnc:option-value (gnc:lookup-option options section name))) (let ((column-list (make-vector 11 #f))) - - (define (opt-val section name) - (gnc:option-value - (gnc:lookup-option options section name))) (if (opt-val (N_ "Display") (N_ "Date")) (vector-set! column-list 0 #t)) (if (opt-val (N_ "Display") (N_ "Num")) @@ -500,11 +496,6 @@ (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")