aherman
/
gnucash
mirror of https://github.com/Gnucash/gnucash
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

* src/scm/report/income-expense-graph.scm: work on display

Browse Source 
* src/scm/html-utilities.scm (gnc:account-anchor-text): new func

	* src/gnome/gnc-html.c: check for null args

	* src/scm/report/income-or-expense-pie.scm: work on display

	* src/scm/html-utilities.scm: add function for assigning colors

	* src/gnome/gnc-html-guppi.c: fix callback pointer

	* src/engine/Transaction.c (xaccSplitGetCorrAccountName): i18n
	(xaccSplitGetCorrAccountCode): i18n

	* src/guile/gnucash.c.in (gnucash_lowlev_app_init): update
	last stable version

	* src/scm/report.scm: more work on display

	* src/scm/report/register.scm: add api for printing a
	register report. more work on display

	* src/gnome/window-report.c (gnc_print_report): add api
	for printing reports

	* src/gnome/gnc-html.c: check for no urltype callback

	* src/scm/report/stylesheet-plain.scm: add some more space
	between table cells

	* src/gnome/window-register.c: add support for printing reports

	* src/guile/gnc.gwp: add print report api

	* src/gnome/gnc-html.c: use PWARN, not printf


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3806 57a11ea4-9604-0410-9ed3-97b8803252fd
zzzoldreleases/1.6
Dave Peticolas 26 years ago
parent 76d96f764a
commit cd6070bb00
15 changed files with 334 additions and 160 deletions
Show Stats Download Patch File Download Diff File

39
ChangeLog
Unescape View File

@ -1,5 +1,44 @@
2001-03-20 Dave Peticolas <dave@krondo.com>
* src/scm/report/income-expense-graph.scm: work on display
* src/scm/html-utilities.scm (gnc:account-anchor-text): new func
* src/gnome/gnc-html.c: check for null args
* src/scm/report/income-or-expense-pie.scm: work on display
* src/scm/html-utilities.scm: add function for assigning colors
2001-03-19 Dave Peticolas <dave@krondo.com>
* src/gnome/gnc-html-guppi.c: fix callback pointer
* src/engine/Transaction.c (xaccSplitGetCorrAccountName): i18n
(xaccSplitGetCorrAccountCode): i18n
* src/guile/gnucash.c.in (gnucash_lowlev_app_init): update
last stable version
* src/scm/report.scm: more work on display
* src/scm/report/register.scm: add api for printing a
register report. more work on display
* src/gnome/window-report.c (gnc_print_report): add api
for printing reports
* src/gnome/gnc-html.c: check for no urltype callback
* src/scm/report/stylesheet-plain.scm: add some more space
between table cells
* src/gnome/window-register.c: add support for printing reports
* src/guile/gnc.gwp: add print report api
* src/gnome/gnc-html.c: use PWARN, not printf
* rpm/gnucash.spec.in: add finance-quote-helper as executable
2001-03-19 Derek Atkins <warlord@MIT.EDU>

2
HACKING
Unescape View File

@ -47,8 +47,6 @@ C:
* All gnucash functions and global variables are prefixed with gnc_
* All private functions are enclosed in __ (i.e. _gnc_do_not_call_)
* Use static functions whenever possible
* Use const whenever possible

12
src/engine/Transaction.c
Unescape View File

@ -45,6 +45,7 @@
#include "gnc-engine-util.h"
#include "gnc-engine.h"
#include "gnc-event-p.h"
#include "messages.h"
/*
@ -1967,12 +1968,15 @@ get_corr_account_split(Split *sa, Split **retval)
const char *
xaccSplitGetCorrAccountName(Split *sa)
{
static const char *split_const = "Split";
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");
return split_const;
}
else
@ -1985,11 +1989,15 @@ xaccSplitGetCorrAccountName(Split *sa)
const char *
xaccSplitGetCorrAccountCode(Split *sa)
{
static const char *split_const = "Split";
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");
return split_const;
}
else

29
src/gnome/gnc-html-guppi.c
Unescape View File

@ -221,14 +221,13 @@ guppi_generic_callback(gnc_html * html, GPtrArray * array, gint index) {
char * url = g_ptr_array_index(array, index);
if(!url) return;
if(url[0] == '\0') return;
type = gnc_html_parse_url(html, url, &location, &label);
gnc_html_show_url(html, type, location, label, 0);
g_free(location);
g_free(label);
return;
}
static void
@ -411,7 +410,7 @@ gnc_html_embedded_piechart(gnc_html * parent, int w, int h,
if((param = g_hash_table_lookup(params, "legend_urls_1")) != NULL) {
arglist[argind].name = "legend_callback1";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = &guppi_slice_1_callback;
GTK_VALUE_POINTER(arglist[argind]) = &guppi_legend_1_callback;
argind++;
arglist[argind].name = "legend_callback1_data";
arglist[argind].type = GTK_TYPE_POINTER;
@ -423,11 +422,11 @@ gnc_html_embedded_piechart(gnc_html * parent, int w, int h,
g_free(callbacks);
}
if((param = g_hash_table_lookup(params, "legend_urls_2")) != NULL) {
arglist[argind].name = "legend_callback1";
arglist[argind].name = "legend_callback2";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = &guppi_legend_2_callback;
argind++;
arglist[argind].name = "legend_callback1_data";
arglist[argind].name = "legend_callback2_data";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = chart;
argind++;
@ -437,11 +436,11 @@ gnc_html_embedded_piechart(gnc_html * parent, int w, int h,
g_free(callbacks);
}
if((param = g_hash_table_lookup(params, "legend_urls_3")) != NULL) {
arglist[argind].name = "legend_callback1";
arglist[argind].name = "legend_callback3";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = &guppi_legend_3_callback;
argind++;
arglist[argind].name = "legend_callback1_data";
arglist[argind].name = "legend_callback3_data";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = chart;
argind++;
@ -450,7 +449,7 @@ gnc_html_embedded_piechart(gnc_html * parent, int w, int h,
chart->legend_3_callbacks = convert_string_array(callbacks, datasize);
g_free(callbacks);
}
piechart = guppi_object_newv("pie", w, h,
argind, arglist);
@ -623,7 +622,7 @@ gnc_html_embedded_barchart(gnc_html * parent,
if((param = g_hash_table_lookup(params, "legend_urls_1")) != NULL) {
arglist[argind].name = "legend_callback1";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = &guppi_slice_1_callback;
GTK_VALUE_POINTER(arglist[argind]) = &guppi_legend_1_callback;
argind++;
arglist[argind].name = "legend_callback1_data";
arglist[argind].type = GTK_TYPE_POINTER;
@ -636,11 +635,11 @@ gnc_html_embedded_barchart(gnc_html * parent,
g_free(callbacks);
}
if((param = g_hash_table_lookup(params, "legend_urls_2")) != NULL) {
arglist[argind].name = "legend_callback1";
arglist[argind].name = "legend_callback2";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = &guppi_legend_2_callback;
argind++;
arglist[argind].name = "legend_callback1_data";
arglist[argind].name = "legend_callback2_data";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = chart;
argind++;
@ -651,11 +650,11 @@ gnc_html_embedded_barchart(gnc_html * parent,
g_free(callbacks);
}
if((param = g_hash_table_lookup(params, "legend_urls_3")) != NULL) {
arglist[argind].name = "legend_callback1";
arglist[argind].name = "legend_callback3";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = &guppi_legend_3_callback;
argind++;
arglist[argind].name = "legend_callback1_data";
arglist[argind].name = "legend_callback3_data";
arglist[argind].type = GTK_TYPE_POINTER;
GTK_VALUE_POINTER(arglist[argind]) = chart;
argind++;

16
src/gnome/gnc-html.c
Unescape View File

@ -870,12 +870,11 @@ gnc_html_submit_cb(GtkHTML * html, const gchar * method,
cb(gnchtml, method, action_parts[0], action_parts[1], form_data);
}
else {
printf("no handler for gnc-network action '%s'\n",
action);
PWARN ("no handler for gnc-network action '%s'\n", action);
}
}
else {
printf("tried to split on ? but failed...\n");
PWARN ("tried to split on ? but failed...\n");
}
}
}
@ -1020,9 +1019,15 @@ gnc_html_show_url(gnc_html * html, URLType type,
GtkHTMLStream * handle;
int newwin;
if (!html) return;
if (!location) return;
/* make sure it's OK to show this URL type in this window */
if(newwin_hint == 0) {
newwin = !((html->urltype_cb)(type));
if (html->urltype_cb)
newwin = !((html->urltype_cb)(type));
else
newwin = 0;
}
else {
newwin = 1;
@ -1071,8 +1076,7 @@ gnc_html_show_url(gnc_html * html, URLType type,
/* FIXME : handle newwin = 1 */
gnc_html_history_append(html->history,
gnc_html_history_node_new(type,
location, label));
gnc_html_history_node_new(type, location, label));
handle = gtk_html_begin(GTK_HTML(html->html));
gnc_html_load_to_stream(html, handle, type, location, label);
break;

68
src/gnome/window-register.c
Unescape View File

@ -140,6 +140,7 @@ static void recordCB(GtkWidget *w, gpointer data);
static void cancelCB(GtkWidget *w, gpointer data);
static void closeCB(GtkWidget *w, gpointer data);
static void reportCB(GtkWidget *w, gpointer data);
static void printReportCB(GtkWidget *w, gpointer data);
static void dateCB(GtkWidget *w, gpointer data);
static void expand_trans_cb(GtkWidget *widget, gpointer data);
static void new_trans_cb(GtkWidget *widget, gpointer data);
@ -912,6 +913,15 @@ gnc_register_create_tool_bar (RegWindow *regData)
GNOME_APP_PIXMAP_STOCK, GNOME_STOCK_PIXMAP_BOOK_GREEN,
0, 0, NULL
},
{
GNOME_APP_UI_ITEM,
N_("Print"),
N_("Print a report for this register"),
printReportCB,
NULL, NULL,
GNOME_APP_PIXMAP_STOCK, GNOME_STOCK_PIXMAP_PRINT,
0, 0, NULL
},
GNOMEUIINFO_SEPARATOR,
{
GNOME_APP_UI_ITEM,
@ -1337,6 +1347,14 @@ gnc_register_create_menu_bar(RegWindow *regData, GtkWidget *statusbar)
GNOME_APP_PIXMAP_NONE, NULL,
0, 0, NULL
},
{
GNOME_APP_UI_ITEM,
N_("Print"),
N_("Print a report for this register"),
printReportCB, NULL, NULL,
GNOME_APP_PIXMAP_NONE, NULL,
0, 0, NULL
},
GNOMEUIINFO_SEPARATOR,
{
GNOME_APP_UI_ITEM,
@ -2957,23 +2975,14 @@ closeCB (GtkWidget *widget, gpointer data)
xaccLedgerDisplayClose (regData->ledger);
}
/********************************************************************\
* reportCB *
* *
* Args: widget - the widget that called us *
* data - regData - the data struct for this register *
* Return: none *
\********************************************************************/
static void
reportCB (GtkWidget *widget, gpointer data)
report_helper (RegWindow *regData, SCM func)
{
RegWindow *regData = data;
SplitRegister *reg = xaccLedgerDisplayGetSR (regData->ledger);
Query *query;
SCM query_type;
SCM query_scm;
SCM journal_scm;
SCM func;
query_type = gh_eval_str("<gnc:Query*>");
g_return_if_fail (query_type != SCM_UNDEFINED);
@ -2988,12 +2997,49 @@ reportCB (GtkWidget *widget, gpointer data)
journal_scm = gh_bool2scm (reg->style == REG_STYLE_JOURNAL);
func = gh_eval_str ("gnc:show-register-report");
g_return_if_fail (gh_procedure_p (func));
gh_call2 (func, query_scm, journal_scm);
}
/********************************************************************\
* reportCB *
* *
* Args: widget - the widget that called us *
* data - regData - the data struct for this register *
* Return: none *
\********************************************************************/
static void
reportCB (GtkWidget *widget, gpointer data)
{
RegWindow *regData = data;
SCM func;
func = gh_eval_str ("gnc:show-register-report");
g_return_if_fail (gh_procedure_p (func));
report_helper (regData, func);
}
/********************************************************************\
* printReportCB *
* *
* Args: widget - the widget that called us *
* data - regData - the data struct for this register *
* Return: none *
\********************************************************************/
static void
printReportCB (GtkWidget *widget, gpointer data)
{
RegWindow *regData = data;
SCM func;
func = gh_eval_str ("gnc:print-register-report");
g_return_if_fail (gh_procedure_p (func));
report_helper (regData, func);
}
/********************************************************************\
* dateCB *
* *

18
src/gnome/window-report.c
Unescape View File

@ -588,9 +588,25 @@ gnc_report_window_show_report(gnc_report_window * report, int report_id) {
g_free(location);
}
void
reportWindow(int report_id) {
gnc_report_window * win = gnc_report_window_new(NULL);
gnc_report_window_show_report(win, report_id);
}
void
gnc_print_report (int report_id)
{
gnc_html *html;
char * location;
html = gnc_html_new ();
location = g_strdup_printf("id=%d", report_id);
gnc_html_show_url(html, URL_TYPE_REPORT, location, NULL, FALSE);
g_free(location);
gnc_html_print (html);
gnc_html_destroy (html);
}

1
src/gnome/window-report.h
Unescape View File

@ -39,5 +39,6 @@ void gnc_report_window_show_report(gnc_report_window * rw, int id);
gnc_html * gnc_report_window_get_html(gnc_report_window * rw);
void reportWindow(int id);
void gnc_print_report (int report_id);
#endif

2
src/scm/html-piechart.scm
Unescape View File

@ -219,7 +219,7 @@
(> (string-length colors) 0))
(begin
(push " <param name=\"colors\" value=\"")
(dispaly colors)
(push colors)
(push "\">\n")))
(if (and (string? labels)
(> (string-length labels) 0))

19
src/scm/html-utilities.scm
Unescape View File

@ -32,14 +32,26 @@
(cons #f (gnc:html-make-empty-cells (- n 1)))
'()))
(define (gnc:account-anchor-text acct)
(string-append
"gnc-register:account="
(gnc:account-get-full-name acct)))
;; returns the account name as html-text and anchor to the register.
(define (gnc:html-account-anchor acct)
(gnc:make-html-text (gnc:html-markup-anchor
(string-append
"gnc-register:account="
(gnc:account-get-full-name acct))
(gnc:account-anchor-text acct)
(gnc:account-get-name acct))))
(define (gnc:assign-colors num-colors)
(define base-colors '("red" "orange" "yellow" "green"
"blue" "purple" "violet"))
(if (<= num-colors 0)
'()
(cons (list-ref base-colors
(modulo (- num-colors 1) (length base-colors)))
(gnc:assign-colors (- num-colors 1)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:html-build-acct-table
;;
@ -431,4 +443,3 @@
1 2 (_ "Exchange rate ")))))
table))

90
src/scm/report/income-expense-graph.scm
Unescape View File

@ -1,19 +1,15 @@
;; -*-scheme-*-
;; income-expense-graph.scm
;; Display a simple time series for graphs
;; by Robert Merkel (rgmerk@mira.net)
(gnc:support "report/income-expense-graph.scm")
(gnc:depend "report-html.scm")
(gnc:depend "date-utilities.scm")
(let ()
(define (options-generator)
(let* ((options (gnc:new-options))
;; This is just a helper function for making options.
@ -26,7 +22,7 @@
options "Report Options"
(N_ "From") (N_ "To")
"d")
(add-option
(gnc:make-account-list-option
(N_ "Report Options") (N_ "Accounts")
@ -35,7 +31,7 @@
(lambda ()
(filter
gnc:account-is-inc-exp?
(gnc:group-get-account-list (gnc:get-current-group))))
(gnc:group-get-subaccounts (gnc:get-current-group))))
gnc:account-is-inc-exp?
#t))
@ -46,7 +42,7 @@
"c"
"Select the display value for the currency"
(gnc:locale-default-currency)))
(add-option
(gnc:make-multichoice-option
(N_ "Report Options") (N_ "Step Size")
@ -70,8 +66,8 @@
"b" (N_ "Height of plot in pixels.") 400
100 1000 0 1))
(gnc:options-set-default-section options "Report Options")
(gnc:options-set-default-section options "Report Options")
options))
;; This is the rendering function. It accepts a database of options
@ -81,8 +77,7 @@
;; to the function is one created by the options-generator function
;; defined above.
(define (inc-exp-graph-renderer report-obj)
;; These are some helper functions for looking up option values.
(define (get-op section name)
(gnc:lookup-option (gnc:report-options report-obj) section name))
@ -90,8 +85,7 @@
(define (op-value section name)
(gnc:option-value (get-op section name)))
(let* (
(report-currency (op-value "Report Options" "Report Currency"))
(let* ((report-currency (op-value "Report Options" "Report Currency"))
(height (op-value "Display Format" "Plot Height"))
(width (op-value "Display Format" "Plot Width"))
(accounts (op-value "Report Options" "Accounts"))
@ -107,72 +101,76 @@
(exchange-alist (gnc:make-exchange-alist
report-currency to-date-tp))
(exchange-fn-internal (gnc:make-exchange-function exchange-alist))
(exchange-fn (lambda (foriegn) (exchange-fn-internal foriegn report-currency)))
(dates-list (gnc:dateloop (gnc:timepair-start-day-time from-date-tp)
(gnc:timepair-end-day-time
(decdate to-date-tp DayDelta))
(eval interval)))
(exchange-fn (lambda (foriegn)
(exchange-fn-internal foriegn report-currency)))
(dates-list (gnc:dateloop
(gnc:timepair-start-day-time from-date-tp)
(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
#t))))))
(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
(cadr (commodity-collector 'getpair report-currency #t)))))
(cadr (commodity-collector 'getpair
report-currency #t)))))
profit-collector-list))
(date-string-list
(date-string-list
(map (lambda (date-list-item)
(gnc:timepair-to-datestring
(gnc:timepair-to-datestring
(car date-list-item)))
dates-list)))
; (gnc:warn "dates-list" dates-list)
(gnc:warn "double-list" double-list)
(gnc:warn "date-string-list" date-string-list)
(gnc:html-barchart-set-title! chart (N_ "Income/Expense Chart"))
(gnc:html-barchart-set-subtitle! chart (string-append
(gnc:timepair-to-datestring from-date-tp)
" " (N_ "to") " "
(gnc:timepair-to-datestring to-date-tp)))
(gnc:html-barchart-set-subtitle!
chart (sprintf #f
(_ "%s to %s")
(gnc:timepair-to-datestring from-date-tp)
(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-col-labels! chart date-string-list)
(gnc:html-barchart-set-y-axis-label! chart (gnc:commodity-get-mnemonic report-currency))
(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-document-add-object! document chart)
; (gnc:html-document-add-object!
; document ;;(gnc:html-markup-p
; (gnc:html-make-exchangerates
; report-currency exchange-alist accounts #f))
document))
;; Here we define the actual report with gnc:define-report
(gnc:define-report
;; The version of this report.
'version 1
;; 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_ "Income/Expense Graph")
;; The options generator function defined above.
'options-generator options-generator
;; The rendering function defined above.
'renderer inc-exp-graph-renderer))

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

@ -4,13 +4,10 @@
;; Display expenses/incomes from various accounts as a pie chart
;; by Robert Merkel (rgmerk@mira.net)
(gnc:support "report/income-or-expense-pie.scm")
(gnc:depend "report-html.scm")
(gnc:depend "date-utilities.scm")
(let ()
;; Note the options-generator has a boolean argument, which
@ -23,62 +20,66 @@
(lambda (new-option)
(gnc:register-option options new-option))))
(gnc:options-add-date-interval!
options "Report Options"
(N_ "From") (N_ "To")
"d")
(add-option
(gnc:make-number-range-option
(N_ "Report Options") (N_ "Maximum Slices")
"a" (N_ "Maximum number of slices in pie") 7
2 20 0 1))
(add-option
(gnc:make-account-list-option
(N_ "Report Options") (N_ "Accounts")
"b"
"Select accounts to calculate income on"
(N_ "Select accounts to calculate income on")
(lambda ()
(gnc:filter-accountlist-type
(if is-income? '(income) '(expense))
(gnc:group-get-account-list (gnc:get-current-group))))
(gnc:group-get-subaccounts (gnc:get-current-group))))
(lambda (account)
(let ((type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-type account)
(gnc:account-get-type account)
#f)))
(member type (if is-income? '(income) '(expense)))))
#t))
(add-option
(gnc:make-currency-option
"Report Options"
"Report Currency"
(N_ "Report Options") (N_ "Report Currency")
"c"
"Select the display value for the currency"
(N_ "Select the display value for the currency")
(gnc:locale-default-currency)))
(gnc:options-add-date-interval!
options "Report Options"
(N_ "From") (N_ "To")
"d")
(add-option
(gnc:make-number-range-option
(N_ "Display Format") (N_ "Plot Width")
"a" (N_ "Width of plot in pixels.") 400
"a" (N_ "Width of plot in pixels.") 500
100 1000 0 1))
(add-option
(gnc:make-number-range-option
(N_ "Display Format") (N_ "Plot Height")
"b" (N_ "Height of plot in pixels.") 400
"b" (N_ "Height of plot in pixels.") 250
100 1000 0 1))
(gnc:options-set-default-section options "Report Options")
options))
;; Similar arrangement to the options-generator.
(define (income-or-expense-pie-renderer report-obj is-income?)
;; These are some helper functions for looking up option values.
(define (get-op section name)
(gnc:lookup-option (gnc:report-options report-obj) section name))
(define (op-value section name)
(gnc:option-value (get-op section name)))
(let* (
(report-currency (op-value "Report Options" "Report Currency"))
(let* ((max-slices (op-value "Report Options" "Maximum Slices"))
(report-currency (op-value "Report Options" "Report Currency"))
(height (op-value "Display Format" "Plot Height"))
(width (op-value "Display Format" "Plot Width"))
(accounts (op-value "Report Options" "Accounts"))
@ -99,51 +100,82 @@
account
from-date-tp
to-date-tp
#t)))
#f)))
(profit-collector-list
(map profit-collector-fn accounts))
;;; FIXME: better currency handling here
(double-list
(map (lambda (commodity-collector)
(abs (gnc:numeric-to-double
(cadr (commodity-collector 'getpair report-currency #t)))))
(cadr (commodity-collector 'getpair
report-currency #t)))))
profit-collector-list))
(account-name-list (map gnc:account-get-name accounts)))
(gnc:warn "account-name-list" account-name-list)
(gnc:html-piechart-set-title! chart (if is-income?
(N_ "Income by Account")
(N_ "Expenses by Account")))
(gnc:html-piechart-set-subtitle! chart (string-append
(gnc:timepair-to-datestring from-date-tp)
" " (N_ "to") " "
(gnc:timepair-to-datestring to-date-tp)))
(combined (zip double-list accounts))
(accounts-or-names '()))
(set! combined
(filter (lambda (pair) (not (= 0.0 (car pair))))
combined))
(set! combined
(sort combined
(lambda (a b) (> (car a) (car b)))))
(if (> (length combined) max-slices)
(let* ((start (take combined (- max-slices 1)))
(finish (drop combined (- max-slices 1)))
(sum (apply + (unzip1 finish))))
(set! combined
(append start
(list (list sum (_ "Other")))))))
(call-with-values (lambda () (unzip2 combined))
(lambda (ds as)
(set! double-list ds)
(set! accounts-or-names as)))
(gnc:html-piechart-set-title!
chart (if is-income?
(N_ "Income by Account")
(N_ "Expenses by Account")))
(gnc:html-piechart-set-subtitle!
chart (sprintf #f
(_ "%s to %s")
(gnc:timepair-to-datestring from-date-tp)
(gnc:timepair-to-datestring to-date-tp)))
(gnc:html-piechart-set-width! chart width)
(gnc:html-piechart-set-height! chart height)
(gnc:html-piechart-set-data! chart double-list)
(gnc:html-piechart-set-labels! chart account-name-list)
(gnc:html-piechart-set-labels!
chart
(map (lambda (a) (if (string? a) a (gnc:account-get-full-name a)))
accounts-or-names))
(gnc:html-piechart-set-colors! chart
(gnc:assign-colors (length combined)))
(let ((urls (map (lambda (a)
(if (string? a) "" (gnc:account-anchor-text a)))
accounts-or-names)))
(gnc:html-piechart-set-button-1-slice-urls! chart urls)
(gnc:html-piechart-set-button-1-legend-urls! chart urls))
(gnc:html-document-add-object! document chart)
document))
(gnc:define-report
'version 1
'name (N_ "Income Breakdown Piechart")
'options-generator (lambda () (options-generator #t))
'renderer (lambda (report-obj) (income-or-expense-pie-renderer report-obj #t)))
'renderer (lambda (report-obj)
(income-or-expense-pie-renderer report-obj #t)))
(gnc:define-report
'version 1
'name (N_ "Expense Breakdown Piechart")
'options-generator (lambda () (options-generator #f))
'renderer (lambda (report-obj) (income-or-expense-pie-renderer report-obj #f))))
'renderer (lambda (report-obj)
(income-or-expense-pie-renderer report-obj #f))))

36
src/scm/report/register.scm
Unescape View File

@ -115,7 +115,7 @@
(addto! heading-list (N_ "Balance")))
(reverse heading-list)))
(define (add-split-row table split column-vector row-style)
(define (add-split-row table split column-vector row-style transaction-row?)
(let* ((row-contents '())
(parent (gnc:split-get-parent split))
(account (gnc:split-get-account split))
@ -124,14 +124,21 @@
(split-value (gnc:make-gnc-monetary currency damount)))
(if (used-date column-vector)
(addto! row-contents (gnc:timepair-to-datestring
(gnc:transaction-get-date-posted parent))))
(addto! row-contents
(if transaction-row?
(gnc:timepair-to-datestring
(gnc:transaction-get-date-posted parent))
" ")))
(if (used-num column-vector)
(addto! row-contents (gnc:transaction-get-num parent)))
(addto! row-contents
(if transaction-row?
(gnc:transaction-get-num parent)
" ")))
(if (used-description column-vector)
(addto! row-contents (gnc:transaction-get-description parent)))
(addto! row-contents
(if transaction-row?
(gnc:transaction-get-description parent)
" ")))
(if (used-account column-vector)
(addto! row-contents (gnc:account-get-name account)))
(if (used-other-account column-vector)
@ -340,7 +347,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)
(add-split-row table current used-columns row-style #f)
(other-rows-driver split parent table used-columns
(+ i 1)))))))
@ -371,7 +378,8 @@
table
current
used-columns
current-row-style)))
current-row-style
#t)))
(if multi-rows?
(add-other-split-rows
current table used-columns alternate-row-style))
@ -457,11 +465,17 @@
'renderer reg-renderer
'in-menu? #f))
(define (gnc:show-register-report query journal?)
(define (gnc:apply-register-report func query journal?)
(let* ((template (hash-ref *gnc:_report-templates_* "Register"))
(options (gnc:report-template-new-options template))
(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?)
(gnc:report-window (gnc:make-report "Register" options))))
(func (gnc:make-report "Register" options))))
(define (gnc:show-register-report query journal?)
(gnc:apply-register-report gnc:report-window query journal?))
(define (gnc:print-register-report query journal?)
(gnc:apply-register-report gnc:print-report query journal?))

8
src/scm/report/stylesheet-plain.scm
Unescape View File

@ -53,12 +53,12 @@
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell spacing") "c" (N_ "Space between table cells")
1 0 20 0 1))
4 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
(N_ "Table cell padding") "d" (N_ "Space between table cells")
1 0 20 0 1))
0 0 20 0 1))
(opt-register
(gnc:make-number-range-option
(N_ "Tables")
@ -86,7 +86,7 @@
(gnc:html-document-set-style!
ssdoc "body"
'attribute (list "bgcolor" bgcolor))
(if (and bgpixmap
(not (string=? bgpixmap "")))
(gnc:html-document-set-style!
@ -98,7 +98,7 @@
'attribute (list "border" border)
'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding))
(gnc:html-document-set-style!
ssdoc "number-cell"
'tag "td"

30
src/scm/report/transaction-report.scm
Unescape View File

@ -130,7 +130,7 @@
(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))))
(cons 'none (vector 'by-none #f #f))))
(define (used-date columns-used)
(vector-ref columns-used 0))
@ -229,8 +229,8 @@
(if (used-running-balance column-vector)
(addto! heading-list (N_ "Balance")))
(reverse heading-list)))
(define (add-split-row table split column-vector row-style)
(define (add-split-row table split column-vector row-style transaction-row?)
(let* ((row-contents '())
(parent (gnc:split-get-parent split))
(account (gnc:split-get-account split))
@ -239,14 +239,21 @@
(split-value (gnc:make-gnc-monetary currency damount)))
(if (used-date column-vector)
(addto! row-contents (gnc:timepair-to-datestring
(gnc:transaction-get-date-posted parent))))
(addto! row-contents
(if transaction-row?
(gnc:timepair-to-datestring
(gnc:transaction-get-date-posted parent))
" ")))
(if (used-num column-vector)
(addto! row-contents (gnc:transaction-get-num parent)))
(addto! row-contents
(if transaction-row?
(gnc:transaction-get-num parent)
" ")))
(if (used-description column-vector)
(addto! row-contents (gnc:transaction-get-description parent)))
(addto! row-contents
(if transaction-row?
(gnc:transaction-get-description parent)
" ")))
(if (used-account column-vector)
(addto! row-contents (gnc:account-get-name account)))
(if (used-other-account column-vector)
@ -676,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)
(add-split-row table current used-columns row-style #f)
(other-rows-driver split parent table used-columns
(+ i 1)))))))
@ -722,7 +729,8 @@
table
current
used-columns
current-row-style)))
current-row-style
#t)))
(if multi-rows?
(add-other-split-rows
current table used-columns alternate-row-style))

Write Preview
Loading…
Cancel
Save