From cd6070bb00202e248b4ff905956905f9385f2d70 Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Tue, 20 Mar 2001 11:27:14 +0000 Subject: [PATCH] * 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 --- ChangeLog | 39 +++++++ HACKING | 2 - src/engine/Transaction.c | 12 ++- src/gnome/gnc-html-guppi.c | 29 +++--- src/gnome/gnc-html.c | 16 +-- src/gnome/window-register.c | 68 +++++++++++-- src/gnome/window-report.c | 18 +++- src/gnome/window-report.h | 1 + src/scm/html-piechart.scm | 2 +- src/scm/html-utilities.scm | 19 +++- src/scm/report/income-expense-graph.scm | 90 ++++++++-------- src/scm/report/income-or-expense-pie.scm | 124 ++++++++++++++--------- src/scm/report/register.scm | 36 +++++-- src/scm/report/stylesheet-plain.scm | 8 +- src/scm/report/transaction-report.scm | 30 ++++-- 15 files changed, 334 insertions(+), 160 deletions(-) diff --git a/ChangeLog b/ChangeLog index ba4d40fd16..14a615d64e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,44 @@ +2001-03-20 Dave Peticolas + + * 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 + * 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 diff --git a/HACKING b/HACKING index 85098610c3..84622ec04f 100644 --- a/HACKING +++ b/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 diff --git a/src/engine/Transaction.c b/src/engine/Transaction.c index 9fed459a35..627f141339 100644 --- a/src/engine/Transaction.c +++ b/src/engine/Transaction.c @@ -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 diff --git a/src/gnome/gnc-html-guppi.c b/src/gnome/gnc-html-guppi.c index f38402d6c3..d645ff5120 100644 --- a/src/gnome/gnc-html-guppi.c +++ b/src/gnome/gnc-html-guppi.c @@ -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++; diff --git a/src/gnome/gnc-html.c b/src/gnome/gnc-html.c index 7eaa0613c8..55edae7022 100644 --- a/src/gnome/gnc-html.c +++ b/src/gnome/gnc-html.c @@ -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; diff --git a/src/gnome/window-register.c b/src/gnome/window-register.c index f808d48b8b..4da1826d58 100644 --- a/src/gnome/window-register.c +++ b/src/gnome/window-register.c @@ -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(""); 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 * * * diff --git a/src/gnome/window-report.c b/src/gnome/window-report.c index 6b61a10364..1bc8544247 100644 --- a/src/gnome/window-report.c +++ b/src/gnome/window-report.c @@ -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); +} diff --git a/src/gnome/window-report.h b/src/gnome/window-report.h index 386e4090fa..15f940de83 100644 --- a/src/gnome/window-report.h +++ b/src/gnome/window-report.h @@ -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 diff --git a/src/scm/html-piechart.scm b/src/scm/html-piechart.scm index 1c7889041f..911d6f0fd0 100644 --- a/src/scm/html-piechart.scm +++ b/src/scm/html-piechart.scm @@ -219,7 +219,7 @@ (> (string-length colors) 0)) (begin (push " \n"))) (if (and (string? labels) (> (string-length labels) 0)) diff --git a/src/scm/html-utilities.scm b/src/scm/html-utilities.scm index 0beef0e49c..5eeb765f52 100644 --- a/src/scm/html-utilities.scm +++ b/src/scm/html-utilities.scm @@ -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)) - diff --git a/src/scm/report/income-expense-graph.scm b/src/scm/report/income-expense-graph.scm index 0b0711654b..21a39be7c7 100644 --- a/src/scm/report/income-expense-graph.scm +++ b/src/scm/report/income-expense-graph.scm @@ -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)) diff --git a/src/scm/report/income-or-expense-pie.scm b/src/scm/report/income-or-expense-pie.scm index 4f27bd8715..f3110d38d9 100644 --- a/src/scm/report/income-or-expense-pie.scm +++ b/src/scm/report/income-or-expense-pie.scm @@ -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--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)))) diff --git a/src/scm/report/register.scm b/src/scm/report/register.scm index adf641285e..0407cbb81e 100644 --- a/src/scm/report/register.scm +++ b/src/scm/report/register.scm @@ -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?)) diff --git a/src/scm/report/stylesheet-plain.scm b/src/scm/report/stylesheet-plain.scm index fc22f0ff9c..5cd2b7933d 100644 --- a/src/scm/report/stylesheet-plain.scm +++ b/src/scm/report/stylesheet-plain.scm @@ -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" diff --git a/src/scm/report/transaction-report.scm b/src/scm/report/transaction-report.scm index 1467434aea..70a078119c 100644 --- a/src/scm/report/transaction-report.scm +++ b/src/scm/report/transaction-report.scm @@ -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))