mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Bill Gribble's reporting patch.
* src/gnome/gnc-html-history.{h,c}: add destroy callback. part of
report memory management cleanup
* src/gnome/window-report.c: set report dirty flag when options
apply or reload is clicked. Store report object in window
struct while it's visible.
* src/scm/qif-import/qif-file.scm: expand detection of opening
balance transactions.
* src/scm/qif-import/qif-parse.scm: fix regexp bug in miscincx and
miscexpx category parsing (thanks carol!)
* src/scm/qif-import/qif-to-gnc.scm: use correct amount for
non-stock investment transactions (dividends etc). Use fuzzy
equality predicate for inexact numbers.
* src/scm/report.scm: Add dirty flag and 'children' (other reports
created by this report... nobody uses it yet) to report struct.
Add function to clean up report when it's erased from the window
history. Add some debugging timing bits to the report-run
function. Display cached HTML if not dirty.
* src/scm/report.scm: WARNING! Change prototype of report
rendering functions... they take a <report> object as argument
instead of an options object. This is necessary for memory
management stuff when reports create other reports.
* src/scm/report/account-summary.scm: fix to use new renderer
signature
* src/scm/report/average-balance.scm: fix to use new renderer
signature
* src/scm/report/hello-world.scm: fix to use new renderer
signature
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3571 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
39
ChangeLog
39
ChangeLog
@@ -1,3 +1,42 @@
|
||||
2001-02-01 Bill Gribble <grib@billgribble.com>
|
||||
|
||||
* src/gnome/gnc-html-history.{h,c}: add destroy callback. part of
|
||||
report memory management cleanup
|
||||
|
||||
* src/gnome/window-report.c: set report dirty flag when options
|
||||
apply or reload is clicked. Store report object in window
|
||||
struct while it's visible.
|
||||
|
||||
* src/scm/qif-import/qif-file.scm: expand detection of opening
|
||||
balance transactions.
|
||||
|
||||
* src/scm/qif-import/qif-parse.scm: fix regexp bug in miscincx and
|
||||
miscexpx category parsing (thanks carol!)
|
||||
|
||||
* src/scm/qif-import/qif-to-gnc.scm: use correct amount for
|
||||
non-stock investment transactions (dividends etc). Use fuzzy
|
||||
equality predicate for inexact numbers.
|
||||
|
||||
* src/scm/report.scm: Add dirty flag and 'children' (other reports
|
||||
created by this report... nobody uses it yet) to report struct.
|
||||
Add function to clean up report when it's erased from the window
|
||||
history. Add some debugging timing bits to the report-run
|
||||
function. Display cached HTML if not dirty.
|
||||
|
||||
* src/scm/report.scm: WARNING! Change prototype of report
|
||||
rendering functions... they take a <report> object as argument
|
||||
instead of an options object. This is necessary for memory
|
||||
management stuff when reports create other reports.
|
||||
|
||||
* src/scm/report/account-summary.scm: fix to use new renderer
|
||||
signature
|
||||
|
||||
* src/scm/report/average-balance.scm: fix to use new renderer
|
||||
signature
|
||||
|
||||
* src/scm/report/hello-world.scm: fix to use new renderer
|
||||
signature
|
||||
|
||||
2001-01-30 Bill Gribble <grib@billgribble.com>
|
||||
|
||||
* src/scm/report/stylesheet-{plain,fancy}.scm: add a new boolean
|
||||
|
||||
83
doc/examples/divx.qif
Normal file
83
doc/examples/divx.qif
Normal file
@@ -0,0 +1,83 @@
|
||||
!Option:AutoSwitch
|
||||
!Account
|
||||
NChecking
|
||||
DOur checking
|
||||
TBank
|
||||
^
|
||||
!Type:Bank
|
||||
D3/29' 0
|
||||
Pthis is an opening balance. no really.
|
||||
T1000.00
|
||||
CX
|
||||
L[Checking]
|
||||
^
|
||||
D3/29' 0
|
||||
U36.00
|
||||
T36.00
|
||||
CX
|
||||
L[Schwab]
|
||||
^
|
||||
D6/22/95
|
||||
U938.19
|
||||
T938.19
|
||||
CX
|
||||
PGPay
|
||||
LG Inc:gross
|
||||
SG Inc:gross
|
||||
$1,833.69
|
||||
SG Inc:fedtax
|
||||
$-297.48
|
||||
SG Inc:ficatax
|
||||
$-113.69
|
||||
SG Inc:meditax
|
||||
$-26.58
|
||||
SG Inc:401K
|
||||
$-274.93
|
||||
S[G Stock]
|
||||
$-183.29
|
||||
SG Inc:misc
|
||||
$-17.30
|
||||
S[G Stock]
|
||||
$17.77
|
||||
^
|
||||
!Account
|
||||
NG Stock
|
||||
Dstock
|
||||
TOth A
|
||||
^
|
||||
!Type:Oth A
|
||||
D6/22/95
|
||||
U165.52
|
||||
T165.52
|
||||
PGPay
|
||||
L[Checking]
|
||||
^
|
||||
!Account
|
||||
NSchwab
|
||||
DSchwab
|
||||
TInvst
|
||||
^
|
||||
!Type:Invst
|
||||
D1/11' 0
|
||||
NDivX
|
||||
YAdobe
|
||||
CR
|
||||
U0.75
|
||||
T0.75
|
||||
L[Checking]
|
||||
$0.75
|
||||
^
|
||||
D2/28' 0
|
||||
NIntIncX
|
||||
YSchwab M Mkt
|
||||
U62.93
|
||||
T62.93
|
||||
L[Checking]
|
||||
$62.93
|
||||
^
|
||||
D3/29' 0
|
||||
NMiscIncX
|
||||
U36.00
|
||||
T36.00
|
||||
LC Inc:fedtax|[Schwab]
|
||||
^
|
||||
@@ -30,6 +30,10 @@ struct _gnc_html_history {
|
||||
GList * nodes;
|
||||
GList * current_node;
|
||||
GList * last_node;
|
||||
|
||||
/* call this whenever a node is destroyed */
|
||||
gnc_html_history_destroy_cb destroy_cb;
|
||||
gpointer destroy_cb_data;
|
||||
};
|
||||
|
||||
/********************************************************************
|
||||
@@ -56,6 +60,10 @@ gnc_html_history_destroy(gnc_html_history * hist) {
|
||||
GList * n;
|
||||
|
||||
for(n = hist->nodes; n ; n=n->next) {
|
||||
if(hist->destroy_cb) {
|
||||
(hist->destroy_cb)((gnc_html_history_node *)n->data,
|
||||
hist->destroy_cb_data);
|
||||
}
|
||||
gnc_html_history_node_destroy((gnc_html_history_node *)n->data);
|
||||
}
|
||||
g_list_free(hist->nodes);
|
||||
@@ -66,6 +74,18 @@ gnc_html_history_destroy(gnc_html_history * hist) {
|
||||
g_free(hist);
|
||||
}
|
||||
|
||||
/********************************************************************
|
||||
* gnc_html_history_set_node_destroy_cb
|
||||
********************************************************************/
|
||||
|
||||
void
|
||||
gnc_html_history_set_node_destroy_cb(gnc_html_history * hist,
|
||||
gnc_html_history_destroy_cb cb,
|
||||
gpointer cb_data) {
|
||||
hist->destroy_cb = cb;
|
||||
hist->destroy_cb_data = cb_data;
|
||||
}
|
||||
|
||||
static int
|
||||
g_strcmp(char * a, char * b) {
|
||||
if(!a && b) {
|
||||
@@ -98,12 +118,20 @@ gnc_html_history_append(gnc_html_history * hist,
|
||||
if((hn->type == node->type) &&
|
||||
!g_strcmp(hn->location, node->location) &&
|
||||
!g_strcmp(hn->label, node->label)) {
|
||||
if(hist->destroy_cb) {
|
||||
(hist->destroy_cb)((gnc_html_history_node *)n->data,
|
||||
hist->destroy_cb_data);
|
||||
}
|
||||
gnc_html_history_node_destroy(node);
|
||||
return;
|
||||
}
|
||||
|
||||
/* blow away the history after this point, if there is one */
|
||||
for(n=hist->current_node->next; n; n=n->next) {
|
||||
if(hist->destroy_cb) {
|
||||
(hist->destroy_cb)((gnc_html_history_node *)n->data,
|
||||
hist->destroy_cb_data);
|
||||
}
|
||||
gnc_html_history_node_destroy((gnc_html_history_node *)n->data);
|
||||
}
|
||||
g_list_free(hist->current_node->next);
|
||||
|
||||
@@ -34,6 +34,9 @@ struct _gnc_html_history_node {
|
||||
gchar * label;
|
||||
};
|
||||
|
||||
typedef void (* gnc_html_history_destroy_cb)(gnc_html_history_node * n,
|
||||
gpointer user_data);
|
||||
|
||||
gnc_html_history * gnc_html_history_new(void);
|
||||
void gnc_html_history_destroy(gnc_html_history * hist);
|
||||
|
||||
@@ -44,6 +47,9 @@ gnc_html_history_node * gnc_html_history_forward(gnc_html_history * h);
|
||||
gnc_html_history_node * gnc_html_history_back(gnc_html_history * h);
|
||||
int gnc_html_history_forward_p(gnc_html_history * h);
|
||||
int gnc_html_history_back_p(gnc_html_history * h);
|
||||
void gnc_html_history_set_node_destroy_cb(gnc_html_history * h,
|
||||
gnc_html_history_destroy_cb cb,
|
||||
gpointer cb_data);
|
||||
|
||||
gnc_html_history_node * gnc_html_history_node_new(URLType type,
|
||||
const gchar * location,
|
||||
@@ -52,6 +58,7 @@ gnc_html_history_node * gnc_html_history_node_new(URLType type,
|
||||
void gnc_html_history_node_destroy(gnc_html_history_node *
|
||||
node);
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
@@ -38,18 +38,20 @@
|
||||
#include "query-user.h"
|
||||
|
||||
struct _gnc_report_window {
|
||||
GtkWidget * toplevel;
|
||||
GtkWidget * paned;
|
||||
GtkWidget * toplevel;
|
||||
GtkWidget * paned;
|
||||
|
||||
GtkWidget * popup;
|
||||
GtkWidget * back_widg;
|
||||
GtkWidget * fwd_widg;
|
||||
GtkWidget * popup;
|
||||
GtkWidget * back_widg;
|
||||
GtkWidget * fwd_widg;
|
||||
|
||||
GNCOptionWin * option_dialog;
|
||||
GNCOptionDB * odb;
|
||||
|
||||
SCM scm_report;
|
||||
SCM scm_options;
|
||||
|
||||
gnc_html * html;
|
||||
gnc_html * html;
|
||||
};
|
||||
|
||||
/* all open report windows... makes cleanup easier */
|
||||
@@ -116,7 +118,10 @@ gnc_report_window_stop_button_cb(GtkWidget * w, gpointer data) {
|
||||
|
||||
static int
|
||||
gnc_report_window_reload_button_cb(GtkWidget * w, gpointer data) {
|
||||
gnc_report_window * report = data;
|
||||
gnc_report_window * report = data;
|
||||
SCM dirty_report = gh_eval_str("gnc:report-set-dirty?!");
|
||||
|
||||
gh_call2(dirty_report, report->scm_report, SCM_BOOL_T);
|
||||
gnc_html_reload(report->html);
|
||||
return TRUE;
|
||||
}
|
||||
@@ -137,8 +142,11 @@ gnc_report_window_set_fwd_button(gnc_report_window * win, int enabled) {
|
||||
static void
|
||||
gnc_options_dialog_apply_cb(GNCOptionWin * propertybox,
|
||||
gpointer user_data) {
|
||||
SCM dirty_report = gh_eval_str("gnc:report-set-dirty?!");
|
||||
gnc_report_window * win = user_data;
|
||||
|
||||
gnc_option_db_commit(win->odb);
|
||||
gh_call2(dirty_report, win->scm_report, SCM_BOOL_T);
|
||||
gnc_html_reload(win->html);
|
||||
}
|
||||
|
||||
@@ -229,6 +237,10 @@ gnc_report_window_load_cb(gnc_html * html, URLType type,
|
||||
win->scm_options = inst_options;
|
||||
scm_protect_object(win->scm_options);
|
||||
|
||||
scm_unprotect_object(win->scm_report);
|
||||
win->scm_report = inst_report;
|
||||
scm_protect_object(win->scm_report);
|
||||
|
||||
if(gnc_html_history_forward_p(gnc_html_get_history(win->html))) {
|
||||
gnc_report_window_set_fwd_button(win, TRUE);
|
||||
}
|
||||
@@ -295,6 +307,27 @@ gnc_report_window_print_cb(GtkWidget * w, gpointer data) {
|
||||
gnc_html_print(win->html);
|
||||
}
|
||||
|
||||
static void
|
||||
gnc_report_window_history_destroy_cb(gnc_html_history_node * node,
|
||||
gpointer user_data) {
|
||||
static SCM remover = SCM_BOOL_F;
|
||||
int report_id;
|
||||
|
||||
if(remover == SCM_BOOL_F) {
|
||||
remover = gh_eval_str("gnc:report-remove-by-id");
|
||||
}
|
||||
|
||||
if(node &&
|
||||
(node->type == URL_TYPE_REPORT) &&
|
||||
!strncmp("id=", node->location, 3)) {
|
||||
sscanf(node->location+3, "%d", &report_id);
|
||||
printf("unreffing report %d and children\n", report_id);
|
||||
gh_call1(remover, gh_int2scm(report_id));
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
/********************************************************************
|
||||
* gnc_report_window_new
|
||||
@@ -387,9 +420,16 @@ gnc_report_window_new(GtkWidget * container) {
|
||||
GNOMEUIINFO_END
|
||||
};
|
||||
|
||||
report->html = gnc_html_new();
|
||||
report->scm_options = SCM_BOOL_F;
|
||||
report->html = gnc_html_new();
|
||||
report->scm_options = SCM_BOOL_F;
|
||||
report->scm_report = SCM_BOOL_F;
|
||||
|
||||
gnc_html_history_set_node_destroy_cb(gnc_html_get_history(report->html),
|
||||
gnc_report_window_history_destroy_cb,
|
||||
(gpointer)report);
|
||||
|
||||
scm_protect_object(report->scm_options);
|
||||
scm_protect_object(report->scm_report);
|
||||
|
||||
if(container) {
|
||||
report->toplevel = container;
|
||||
|
||||
@@ -25,7 +25,7 @@
|
||||
(define gnc:reldate-list '())
|
||||
|
||||
(define (gnc:timepair->secs tp)
|
||||
(inexact->exact
|
||||
(inexact->exact
|
||||
(+ (car tp)
|
||||
(/ (cdr tp) 1000000000))))
|
||||
|
||||
@@ -254,6 +254,13 @@
|
||||
(define (gnc:timepair-delta t1 t2)
|
||||
(- (gnc:timepair->secs t2) (gnc:timepair->secs t1)))
|
||||
|
||||
;; find float difference between times
|
||||
(define (gnc:time-elapsed t1 t2)
|
||||
(+ (- (car t2)
|
||||
(car t1))
|
||||
(/ (- (cdr t2)
|
||||
(cdr t1)) 1000000.0)))
|
||||
|
||||
;; timepair manipulation functions
|
||||
;; hack alert - these should probably be put somewhere else
|
||||
;; and be implemented PROPERLY rather than hackily
|
||||
|
||||
@@ -204,7 +204,8 @@
|
||||
(if first-xtn
|
||||
(let ((opening-balance-payee
|
||||
(qif-file:process-opening-balance-xtn
|
||||
self current-xtn qstate-type)))
|
||||
self current-account-name current-xtn
|
||||
qstate-type)))
|
||||
(if (not current-account-name)
|
||||
(set! current-account-name
|
||||
opening-balance-payee))
|
||||
@@ -376,30 +377,33 @@
|
||||
;; even if the payee isn't "Opening Balance", we know that if there's
|
||||
;; no default from-account by this time, we need to set one. In that
|
||||
;; case, we set the default account based on the file name.
|
||||
;;
|
||||
;; If we DO know the account already, and this is a tranfer to it,
|
||||
;; it's also an opening balance regardless of the payee.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (qif-file:process-opening-balance-xtn self xtn type)
|
||||
(define (qif-file:process-opening-balance-xtn self acct-name xtn type)
|
||||
(let ((payee (qif-xtn:payee xtn))
|
||||
(category (qif-split:category
|
||||
(car (qif-xtn:splits xtn))))
|
||||
(category (qif-split:category (car (qif-xtn:splits xtn))))
|
||||
(cat-is-acct? (qif-split:category-is-account?
|
||||
(car (qif-xtn:splits xtn))))
|
||||
(security (qif-xtn:security-name xtn))
|
||||
(acct-name #f))
|
||||
(if (and payee (string? payee)
|
||||
(not security)
|
||||
(string=? (string-remove-trailing-space payee)
|
||||
"Opening Balance")
|
||||
cat-is-acct?)
|
||||
(security (qif-xtn:security-name xtn)))
|
||||
(if (or (and (not acct-name)
|
||||
(not security)
|
||||
payee (string? payee)
|
||||
(string=? (string-remove-trailing-space payee)
|
||||
"Opening Balance")
|
||||
cat-is-acct?)
|
||||
(and acct-name (string? acct-name)
|
||||
(string=? acct-name category)
|
||||
(not security)))
|
||||
;; this is an explicit "Opening Balance" transaction. we need
|
||||
;; to change the category to point to the equity account that
|
||||
;; the opening balance comes from.
|
||||
(begin
|
||||
(qif-split:set-category-private!
|
||||
(car (qif-xtn:splits xtn))
|
||||
(default-equity-account))
|
||||
(qif-split:set-category-is-account?!
|
||||
(car (qif-xtn:splits xtn)) #t)
|
||||
(qif-split:set-category-private! (car (qif-xtn:splits xtn))
|
||||
(default-equity-account))
|
||||
(qif-split:set-category-is-account?! (car (qif-xtn:splits xtn)) #t)
|
||||
(set! acct-name category)))
|
||||
acct-name))
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
;(gnc:support "qif-import/qif-parse.scm")
|
||||
|
||||
(define qif-category-compiled-rexp
|
||||
(make-regexp "^ *(\\[)?([^]/]*)(]?)(/?)([^\|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$"))
|
||||
(make-regexp "^ *(\\[)?([^]/\\|]*)(]?)(/?)([^\|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$"))
|
||||
|
||||
(define qif-date-compiled-rexp
|
||||
(make-regexp "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+).*$|^ *([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9]).*$"))
|
||||
@@ -27,35 +27,39 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; qif-split:parse-category
|
||||
;; this one just gets nastier and nastier.
|
||||
;; ATM we return a list of 3 elements: parsed category name
|
||||
;; (without [] if it was an account name), bool stating if it
|
||||
;; was an account name, and string representing the class name
|
||||
;; (or #f if no class).
|
||||
;; ATM we return a list of 6 elements:
|
||||
;; parsed category name (without [] if it was an account name)
|
||||
;; bool stating if it was an account name
|
||||
;; class of account or #f
|
||||
;; string representing the "miscx category" if any
|
||||
;; bool if miscx category is an account
|
||||
;; class of miscx cat or #f
|
||||
;; gosh, I love regular expressions.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (qif-split:parse-category self value)
|
||||
(let ((match (regexp-exec qif-category-compiled-rexp value)))
|
||||
(if match
|
||||
(begin
|
||||
(list (match:substring match 2)
|
||||
(if (and (match:substring match 1)
|
||||
(match:substring match 3))
|
||||
#t #f)
|
||||
(if (match:substring match 4)
|
||||
(match:substring match 5)
|
||||
#f)
|
||||
;; miscx category name
|
||||
(if (match:substring match 6)
|
||||
(match:substring match 8)
|
||||
#f)
|
||||
;; is it an account?
|
||||
(if (and (match:substring match 7)
|
||||
(match:substring match 9))
|
||||
#t #f)
|
||||
(if (match:substring match 10)
|
||||
(match:substring match 11)
|
||||
#f)))
|
||||
(let ((rv
|
||||
(list (match:substring match 2)
|
||||
(if (and (match:substring match 1)
|
||||
(match:substring match 3))
|
||||
#t #f)
|
||||
(if (match:substring match 4)
|
||||
(match:substring match 5)
|
||||
#f)
|
||||
;; miscx category name
|
||||
(if (match:substring match 6)
|
||||
(match:substring match 8)
|
||||
#f)
|
||||
;; is it an account?
|
||||
(if (and (match:substring match 7)
|
||||
(match:substring match 9))
|
||||
#t #f)
|
||||
(if (match:substring match 10)
|
||||
(match:substring match 11)
|
||||
#f))))
|
||||
rv)
|
||||
(begin
|
||||
(display "qif-split:parse-category : can't parse ")
|
||||
(display value) (newline)
|
||||
|
||||
@@ -14,6 +14,9 @@
|
||||
(define GNC-DENOM-REDUCE 32)
|
||||
(define GNC-DENOM-LCD 48)
|
||||
|
||||
(define (gnc:qif-fuzzy= num-1 num-2)
|
||||
(< (abs (- num-1 num-2)) .00000001))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; find-or-make-acct:
|
||||
;; given a colon-separated account path, return an Account* to
|
||||
@@ -529,8 +532,8 @@
|
||||
(gnc:split-set-share-amount gnc-far-split (n- xtn-amt)))
|
||||
|
||||
((xout miscexp miscexpx margint margintx)
|
||||
(gnc:split-set-value gnc-near-split (n- split-amt))
|
||||
(gnc:split-set-share-amount gnc-near-split (n- split-amt))
|
||||
(gnc:split-set-value gnc-near-split (n- xtn-amt))
|
||||
(gnc:split-set-share-amount gnc-near-split (n- xtn-amt))
|
||||
(gnc:split-set-value gnc-far-split xtn-amt)
|
||||
(gnc:split-set-share-amount gnc-far-split xtn-amt))
|
||||
|
||||
@@ -778,10 +781,10 @@
|
||||
;; we might be done if this-amt is either equal
|
||||
;; to the split amount or the group amount.
|
||||
(cond
|
||||
((= this-amt amount)
|
||||
((gnc:qif-fuzzy= this-amt amount)
|
||||
(set! how
|
||||
(cons 'one-to-one (list split))))
|
||||
((and group-amt (= this-amt group-amt))
|
||||
((and group-amt (gnc:qif-fuzzy= this-amt group-amt))
|
||||
(set! how
|
||||
(cons 'one-to-many (list split))))
|
||||
(#t
|
||||
@@ -797,7 +800,7 @@
|
||||
;; now we're out of the loop. if 'how' isn't set,
|
||||
;; we can still have a many-to-one match.
|
||||
(if (and (not how)
|
||||
(= this-group-amt amount))
|
||||
(gnc:qif-fuzzy= this-group-amt amount))
|
||||
(begin
|
||||
(set! how
|
||||
(cons 'many-to-one same-acct-splits))))))
|
||||
|
||||
@@ -383,7 +383,7 @@
|
||||
(set! splits (gnc:glist->list
|
||||
(gnc:query-get-splits query)
|
||||
<gnc:Split*>))
|
||||
(gnc:free-query query);
|
||||
(gnc:free-query query)
|
||||
|
||||
(if (and splits (not (null? splits)))
|
||||
(set! balance (gnc:numeric-to-double
|
||||
@@ -418,7 +418,7 @@
|
||||
(set! splits (gnc:glist->list
|
||||
(gnc:query-get-splits query)
|
||||
<gnc:Split*>))
|
||||
(gnc:free-query query);
|
||||
(gnc:free-query query)
|
||||
|
||||
(if (and splits (not (null? splits)))
|
||||
(balance-collector 'add (gnc:account-get-commodity account)
|
||||
@@ -540,8 +540,8 @@
|
||||
(gnc:glist->list
|
||||
(gnc:query-get-splits query)
|
||||
<gnc:Split*>)))
|
||||
(gnc:free-query query);
|
||||
|
||||
(gnc:free-query query)
|
||||
|
||||
;; Now go through all splits and add up all value-amounts
|
||||
;; and share-amounts
|
||||
(for-each
|
||||
@@ -619,4 +619,3 @@
|
||||
;; not a durable solution
|
||||
100 GNC-RND-ROUND)))
|
||||
'())))))
|
||||
|
||||
|
||||
@@ -144,7 +144,7 @@
|
||||
options))))
|
||||
|
||||
(define <report>
|
||||
(make-record-type "<report>" '(type id options ctext)))
|
||||
(make-record-type "<report>" '(type id options children dirty? ctext)))
|
||||
|
||||
(define gnc:report-type
|
||||
(record-accessor <report> 'type))
|
||||
@@ -164,6 +164,22 @@
|
||||
(define gnc:report-set-options!
|
||||
(record-modifier <report> 'options))
|
||||
|
||||
(define gnc:report-children
|
||||
(record-accessor <report> 'children))
|
||||
|
||||
(define gnc:report-set-children!
|
||||
(record-modifier <report> 'children))
|
||||
|
||||
(define (gnc:report-add-child! report child)
|
||||
(gnc:report-set-children! report
|
||||
(cons child (gnc:report-children report))))
|
||||
|
||||
(define gnc:report-dirty?
|
||||
(record-accessor <report> 'dirty?))
|
||||
|
||||
(define gnc:report-set-dirty?!
|
||||
(record-modifier <report> 'dirty?))
|
||||
|
||||
(define gnc:report-ctext
|
||||
(record-accessor <report> 'ctext))
|
||||
|
||||
@@ -171,7 +187,7 @@
|
||||
(record-modifier <report> 'ctext))
|
||||
|
||||
(define (gnc:make-report template-name . rest)
|
||||
(let ((r ((record-constructor <report>) template-name #f #f #f))
|
||||
(let ((r ((record-constructor <report>) template-name #f #f '() #t #f))
|
||||
(template (hash-ref *gnc:_report-templates_* template-name))
|
||||
(id *gnc:_report-next-serial_*))
|
||||
(gnc:report-set-id! r id)
|
||||
@@ -185,11 +201,17 @@
|
||||
(hash-set! *gnc:_reports_* (gnc:report-id r) r)
|
||||
id))
|
||||
|
||||
(define (gnc:report-remove-by-id id)
|
||||
(let ((r (hash-ref *gnc:_reports_* id)))
|
||||
(for-each
|
||||
(lambda (child)
|
||||
(gnc:report-remove-by-id (gnc:report-id child)))
|
||||
(gnc:report-children r))
|
||||
(hash-remove! *gnc:_reports_* id)))
|
||||
|
||||
(define (gnc:find-report id)
|
||||
(hash-ref *gnc:_reports_* id))
|
||||
|
||||
|
||||
(define (gnc:report-run id)
|
||||
(define (dumper key . args)
|
||||
(let ((stack (make-stack #t dumper)))
|
||||
@@ -207,29 +229,57 @@
|
||||
#f)))
|
||||
|
||||
(define (gnc:report-run-unsafe id)
|
||||
(let ((report (gnc:find-report id)))
|
||||
(let ((report (gnc:find-report id))
|
||||
(start-time #f)
|
||||
(end-time #f))
|
||||
(if report
|
||||
(let ((template (hash-ref *gnc:_report-templates_*
|
||||
(gnc:report-type report))))
|
||||
(if template
|
||||
(let* ((renderer (gnc:report-template-renderer template))
|
||||
(doc (renderer (gnc:report-options report)))
|
||||
(stylesheet-name
|
||||
(symbol->string (gnc:option-value
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report)
|
||||
(_ "General") (_ "Stylesheet")))))
|
||||
(stylesheet
|
||||
(gnc:html-style-sheet-find stylesheet-name))
|
||||
(html #f))
|
||||
(gnc:html-document-set-style-sheet! doc stylesheet)
|
||||
(set! html (gnc:html-document-render doc))
|
||||
(display html)
|
||||
(gnc:report-set-ctext! report html)
|
||||
html)
|
||||
#f))
|
||||
(if (and (not (gnc:report-dirty? report))
|
||||
(gnc:report-ctext report))
|
||||
;; if there's clean cached text, return it
|
||||
(begin
|
||||
(display "using cached text.\n")
|
||||
(gnc:report-ctext report))
|
||||
|
||||
;; otherwise, rerun the report
|
||||
(let ((template (hash-ref *gnc:_report-templates_*
|
||||
(gnc:report-type report))))
|
||||
(if template
|
||||
(let* ((renderer (gnc:report-template-renderer template))
|
||||
(stylesheet-name
|
||||
(symbol->string (gnc:option-value
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report)
|
||||
(_ "General") (_ "Stylesheet")))))
|
||||
(stylesheet
|
||||
(gnc:html-style-sheet-find stylesheet-name))
|
||||
(doc #f)
|
||||
(html #f))
|
||||
(display "rerunning report.\n")
|
||||
|
||||
(if (gnc:debugging?)
|
||||
(set! start-time (gettimeofday)))
|
||||
(set! doc (renderer report))
|
||||
(if (gnc:debugging?)
|
||||
(begin
|
||||
(set! end-time (gettimeofday))
|
||||
(display "time to generate report: ")
|
||||
(display (gnc:time-elapsed start-time end-time))
|
||||
(newline)
|
||||
(set! start-time (gettimeofday))))
|
||||
|
||||
(gnc:html-document-set-style-sheet! doc stylesheet)
|
||||
(set! html (gnc:html-document-render doc))
|
||||
(if (gnc:debugging?)
|
||||
(begin
|
||||
(set! end-time (gettimeofday))
|
||||
(display "time to render report to HTML: ")
|
||||
(display (gnc:time-elapsed start-time end-time))
|
||||
(newline)))
|
||||
|
||||
(gnc:report-set-ctext! report html)
|
||||
(gnc:report-set-dirty?! report #f)
|
||||
html)
|
||||
#f)))
|
||||
#f)))
|
||||
|
||||
|
||||
|
||||
(gnc:hook-add-dangler gnc:*main-window-opened-hook* gnc:report-menu-setup)
|
||||
|
||||
@@ -290,10 +290,11 @@
|
||||
;; set up the document and add the table
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (accsum-renderer options)
|
||||
(define (accsum-renderer report-obj)
|
||||
(define (get-option optname)
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options (_ "General") optname)))
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report-obj) (_ "General") optname)))
|
||||
|
||||
(let ((accounts (get-option (_ "Account")))
|
||||
(display-depth (get-option (_ "Account Display Depth")))
|
||||
|
||||
@@ -228,11 +228,11 @@
|
||||
;; Renderer
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (renderer options)
|
||||
(define (renderer report-obj)
|
||||
(let* ((opt-val
|
||||
(lambda (sec value)
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option options sec value))))
|
||||
(gnc:lookup-option (gnc:report-options report-obj) sec value))))
|
||||
(begindate (gnc:date-option-absolute-time
|
||||
(opt-val (_ "General") (_ "From"))))
|
||||
(enddate (gnc:timepair-end-day-time
|
||||
|
||||
@@ -207,11 +207,11 @@ option like this.")
|
||||
;; includes all the relevant Scheme code. The option database passed
|
||||
;; to the function is one created by the options-generator function
|
||||
;; defined above.
|
||||
(define (hello-world-renderer options)
|
||||
(define (hello-world-renderer report-obj)
|
||||
|
||||
;; These are some helper functions for looking up option values.
|
||||
(define (get-op section name)
|
||||
(gnc:lookup-option options section name))
|
||||
(gnc:lookup-option (gnc:report-options report-obj) section name))
|
||||
|
||||
(define (op-value section name)
|
||||
(gnc:option-value (get-op section name)))
|
||||
|
||||
Reference in New Issue
Block a user