IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

* src/scm/report-utilities.scm

Browse Source 
(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


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3813 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-03-21 10:36:55 +00:00
parent 629d05e08a
commit 6a7acc416d
13 changed files with 425 additions and 216 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
ChangeLog
View File

@ -1,3 +1,26 @@
2001-03-21 Dave Peticolas <dave@krondo.com>
* 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 <stimming@tuhh.de>
* src/scm/report/income-expense-graph.scm,

67
src/SplitLedger.c
View File

@ -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)

4
src/SplitLedger.h
View File

@ -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);

1
src/engine/Query.c
View File

@ -1126,7 +1126,6 @@ xaccQueryGetSplitsUniqueTrans(Query *q)
}
}
g_list_free (splits);
g_hash_table_destroy (trans_hash);
return g_list_reverse (result);

62
src/gnome/gnc-html.c
View File

@ -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."));
}

101
src/gnome/window-register.c
View File

@ -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("<gnc:Query*>");
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("<gnc:Query*>");
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);
}
/********************************************************************\

32
src/scm/html-utilities.scm
View File

@ -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"

20
src/scm/report-utilities.scm
View File

@ -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

97
src/scm/report/income-expense-graph.scm
View File

@ -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!

3
src/scm/report/income-or-expense-pie.scm
View File

@ -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))

8
src/scm/report/pnl.scm
View File

@ -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

214
src/scm/report/register.scm
View File

@ -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))
<gnc:Split*>))
(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)))

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

@ -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")