mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
* 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 * 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
This commit is contained in:
Dave Peticolas
parent
76d96f764a
commit
cd6070bb00
39
ChangeLog
39
ChangeLog
@ -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
2
HACKING
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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++;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 *
|
||||
* *
|
||||
|
||||
@ -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);
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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))
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
(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-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)))
|
||||
(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))))
|
||||
|
||||
@ -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?))
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user