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:
Dave Peticolas
2001-02-02 02:14:48 +00:00
parent f50b8c3cf6
commit 11b3630d99
14 changed files with 356 additions and 91 deletions

View File

@@ -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
View 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]
^

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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