mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
2001-05-01 Robert Graham Merkel <rgmerk@mira.net>
* src/engine/Query.{ch}: added date-granularity sorting functionality
to queries.
* src/engine/date.[ch] (timespecCanonicalDayTime): new function
migrated from the scheme code.
* src/guile/gnc.gwp: added wrappers for the above.
* src/scm/date-utilities.scm (gnc:timepair-canonical-day-time):
removed, replaced by new C function.
* src/scm/report/*.scm: added checks for "no-accounts-selected".
* src/scm/report/average-balance-2.scm: New (temporary) file.
The average balance report with a rewritten calculation engine.
* src/scm/report/register.scm: Modified to use global styles
* src/scm/report/transaction-report.scm: use improved sorting ability,
get report title from options.
* src/scm/html-utilities.scm (gnc:html-make-no-account-warning): new
function. (remove-last-empty-row): minor changes.
* src/scm/report-utilities.scm: added the ability to get "numitems"
out of a stats collector for debugging purposes.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4093 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
parent
7a6e0a9b42
commit
9be6dfbca6
29
ChangeLog
29
ChangeLog
@ -1,3 +1,32 @@
|
|||||||
|
2001-05-01 Robert Graham Merkel <rgmerk@mira.net>
|
||||||
|
|
||||||
|
* src/engine/Query.{ch}: added date-granularity sorting functionality
|
||||||
|
to queries.
|
||||||
|
|
||||||
|
* src/engine/date.[ch] (timespecCanonicalDayTime): new function
|
||||||
|
migrated from the scheme code.
|
||||||
|
|
||||||
|
* src/guile/gnc.gwp: added wrappers for the above.
|
||||||
|
|
||||||
|
* src/scm/date-utilities.scm (gnc:timepair-canonical-day-time):
|
||||||
|
removed, replaced by new C function.
|
||||||
|
|
||||||
|
* src/scm/report/*.scm: added checks for "no-accounts-selected".
|
||||||
|
|
||||||
|
* src/scm/report/average-balance-2.scm: New (temporary) file.
|
||||||
|
The average balance report with a rewritten calculation engine.
|
||||||
|
|
||||||
|
* src/scm/report/register.scm: Modified to use global styles
|
||||||
|
|
||||||
|
* src/scm/report/transaction-report.scm: use improved sorting ability,
|
||||||
|
get report title from options.
|
||||||
|
|
||||||
|
* src/scm/html-utilities.scm (gnc:html-make-no-account-warning): new
|
||||||
|
function. (remove-last-empty-row): minor changes.
|
||||||
|
|
||||||
|
* src/scm/report-utilities.scm: added the ability to get "numitems"
|
||||||
|
out of a stats collector for debugging purposes.
|
||||||
|
|
||||||
2001-04-30 Christian Stimming <stimming@tuhh.de>
|
2001-04-30 Christian Stimming <stimming@tuhh.de>
|
||||||
|
|
||||||
* src/scm/report/net-worth-timeseries.scm,
|
* src/scm/report/net-worth-timeseries.scm,
|
||||||
|
|||||||
@ -702,6 +702,18 @@ date_cmp_func(Timespec *t1, Timespec *t2) {
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* compared by dates but return 0 if on same day */
|
||||||
|
|
||||||
|
static int
|
||||||
|
date_rounded_cmp_func(Timespec *t1, Timespec *t2)
|
||||||
|
{
|
||||||
|
Timespec canon_t1, canon_t2;
|
||||||
|
canon_t1 = timespecCanonicalDayTime(*t1);
|
||||||
|
canon_t2 = timespecCanonicalDayTime(*t2);
|
||||||
|
return date_cmp_func(&canon_t1, &canon_t2);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
static int
|
static int
|
||||||
split_cmp_func(sort_type_t how, gconstpointer ga, gconstpointer gb)
|
split_cmp_func(sort_type_t how, gconstpointer ga, gconstpointer gb)
|
||||||
{
|
{
|
||||||
@ -739,16 +751,32 @@ split_cmp_func(sort_type_t how, gconstpointer ga, gconstpointer gb)
|
|||||||
|
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
case BY_DATE_ROUNDED:
|
||||||
|
return date_rounded_cmp_func(&(ta->date_posted), &(tb->date_posted));
|
||||||
|
|
||||||
|
break;
|
||||||
|
|
||||||
|
|
||||||
case BY_DATE_ENTERED:
|
case BY_DATE_ENTERED:
|
||||||
return date_cmp_func(&(ta->date_entered), &(tb->date_entered));
|
return date_cmp_func(&(ta->date_entered), &(tb->date_entered));
|
||||||
|
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
case BY_DATE_ENTERED_ROUNDED:
|
||||||
|
return date_rounded_cmp_func(&(ta->date_entered), &(tb->date_entered));
|
||||||
|
|
||||||
|
break;
|
||||||
|
|
||||||
case BY_DATE_RECONCILED:
|
case BY_DATE_RECONCILED:
|
||||||
return date_cmp_func(&(sa->date_reconciled), &(sb->date_reconciled));
|
return date_cmp_func(&(sa->date_reconciled), &(sb->date_reconciled));
|
||||||
|
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
case BY_DATE_RECONCILED_ROUNDED:
|
||||||
|
return date_rounded_cmp_func(&(sa->date_reconciled), &(sb->date_reconciled));
|
||||||
|
|
||||||
|
break;
|
||||||
|
|
||||||
case BY_NUM:
|
case BY_NUM:
|
||||||
/* sort on transaction number */
|
/* sort on transaction number */
|
||||||
da = ta->num;
|
da = ta->num;
|
||||||
|
|||||||
@ -43,8 +43,11 @@ typedef enum {
|
|||||||
typedef enum {
|
typedef enum {
|
||||||
BY_STANDARD=1,
|
BY_STANDARD=1,
|
||||||
BY_DATE,
|
BY_DATE,
|
||||||
|
BY_DATE_ROUNDED,
|
||||||
BY_DATE_ENTERED,
|
BY_DATE_ENTERED,
|
||||||
|
BY_DATE_ENTERED_ROUNDED,
|
||||||
BY_DATE_RECONCILED,
|
BY_DATE_RECONCILED,
|
||||||
|
BY_DATE_RECONCILED_ROUNDED,
|
||||||
BY_NUM,
|
BY_NUM,
|
||||||
BY_AMOUNT,
|
BY_AMOUNT,
|
||||||
BY_MEMO,
|
BY_MEMO,
|
||||||
|
|||||||
@ -128,6 +128,29 @@ timespec_abs(const Timespec *t)
|
|||||||
|
|
||||||
return retval;
|
return retval;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* timespecCanonicalDayTime
|
||||||
|
* given a timepair contains any time on a certain day (local time)
|
||||||
|
* converts it to be midday that day.
|
||||||
|
*/
|
||||||
|
|
||||||
|
Timespec
|
||||||
|
timespecCanonicalDayTime(Timespec t)
|
||||||
|
{
|
||||||
|
struct tm tm, *result;
|
||||||
|
Timespec retval;
|
||||||
|
time_t t_secs = t.tv_sec + (t.tv_nsec / NANOS_PER_SECOND);
|
||||||
|
result = localtime(&t_secs);
|
||||||
|
tm = *result;
|
||||||
|
tm.tm_sec = 0;
|
||||||
|
tm.tm_min = 0;
|
||||||
|
tm.tm_hour = 12;
|
||||||
|
tm.tm_isdst = -1;
|
||||||
|
retval.tv_sec = mktime(&tm);
|
||||||
|
retval.tv_nsec = 0;
|
||||||
|
return retval;
|
||||||
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* setDateFormat
|
* setDateFormat
|
||||||
|
|||||||
@ -92,6 +92,13 @@ Timespec timespec_diff(const Timespec *ta, const Timespec *tb);
|
|||||||
*/
|
*/
|
||||||
Timespec timespec_abs(const Timespec *t);
|
Timespec timespec_abs(const Timespec *t);
|
||||||
|
|
||||||
|
/*
|
||||||
|
* convert a timepair on a certain day (localtime) to
|
||||||
|
* the timepair representing midday on that day
|
||||||
|
*/
|
||||||
|
|
||||||
|
Timespec timespecCanonicalDayTime(Timespec t);
|
||||||
|
|
||||||
void setDateFormat(DateFormat df);
|
void setDateFormat(DateFormat df);
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|||||||
@ -153,6 +153,8 @@
|
|||||||
(define (incdate adate delta)(moddate + adate delta ))
|
(define (incdate adate delta)(moddate + adate delta ))
|
||||||
|
|
||||||
;; Time comparison, true if t2 is later than t1
|
;; Time comparison, true if t2 is later than t1
|
||||||
|
;; FIXME: RENAME THIS FUNCTION!!!!
|
||||||
|
|
||||||
(define (gnc:timepair-later t1 t2)
|
(define (gnc:timepair-later t1 t2)
|
||||||
(cond ((< (car t1) (car t2)) #t)
|
(cond ((< (car t1) (car t2)) #t)
|
||||||
((= (car t1) (car t2)) (< (cdr t2) (cdr t2)))
|
((= (car t1) (car t2)) (< (cdr t2) (cdr t2)))
|
||||||
@ -163,6 +165,9 @@
|
|||||||
(define (gnc:timepair-earlier t1 t2)
|
(define (gnc:timepair-earlier t1 t2)
|
||||||
(gnc:timepair-later t2 t1))
|
(gnc:timepair-later t2 t1))
|
||||||
|
|
||||||
|
(define (gnc:timepair-gt t1 t2)
|
||||||
|
(gnc:timepair-earlier t1 t2))
|
||||||
|
|
||||||
;; t1 <= t2
|
;; t1 <= t2
|
||||||
(define (gnc:timepair-le t1 t2)
|
(define (gnc:timepair-le t1 t2)
|
||||||
(cond ((< (car t1) (car t2)) #t)
|
(cond ((< (car t1) (car t2)) #t)
|
||||||
@ -296,15 +301,6 @@
|
|||||||
;; given a timepair contains any time on a certain day (local time)
|
;; given a timepair contains any time on a certain day (local time)
|
||||||
;; converts it to be midday that day.
|
;; converts it to be midday that day.
|
||||||
|
|
||||||
(define (gnc:timepair-canonical-day-time tp)
|
|
||||||
(let ((bdt (gnc:timepair->date tp)))
|
|
||||||
(set-tm:sec bdt 0)
|
|
||||||
(set-tm:min bdt 0)
|
|
||||||
(set-tm:hour bdt 12)
|
|
||||||
(set-tm:isdst bdt -1)
|
|
||||||
(let ((newtime (car (mktime bdt))))
|
|
||||||
(cons newtime 0))))
|
|
||||||
|
|
||||||
(define (gnc:timepair-start-day-time tp)
|
(define (gnc:timepair-start-day-time tp)
|
||||||
(let ((bdt (gnc:timepair->date tp)))
|
(let ((bdt (gnc:timepair->date tp)))
|
||||||
(set-tm:sec bdt 0)
|
(set-tm:sec bdt 0)
|
||||||
|
|||||||
@ -393,15 +393,14 @@
|
|||||||
;; depends on the structure of html-table-data, i.e. if those are
|
;; depends on the structure of html-table-data, i.e. if those are
|
||||||
;; changed then this might break.
|
;; changed then this might break.
|
||||||
(define (remove-last-empty-row)
|
(define (remove-last-empty-row)
|
||||||
(if (not (null? (gnc:html-table-data table)))
|
(if (and (not (null? (gnc:html-table-data table)))
|
||||||
(if (not (or-map
|
(not (or-map
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(if (gnc:html-table-cell? e)
|
(if (gnc:html-table-cell? e)
|
||||||
(car (gnc:html-table-cell-data e))
|
(car (gnc:html-table-cell-data e))
|
||||||
e))
|
e))
|
||||||
(car (gnc:html-table-data table))))
|
(car (gnc:html-table-data table)))))
|
||||||
(gnc:html-table-remove-last-row! table))))
|
(gnc:html-table-remove-last-row! table)))
|
||||||
|
|
||||||
|
|
||||||
;; Wrapper for gnc:html-acct-table-row-helper!
|
;; Wrapper for gnc:html-acct-table-row-helper!
|
||||||
(define (add-row-helper!
|
(define (add-row-helper!
|
||||||
@ -654,3 +653,12 @@
|
|||||||
(_ "Exchange rates")))))))
|
(_ "Exchange rates")))))))
|
||||||
|
|
||||||
table))
|
table))
|
||||||
|
|
||||||
|
(define (gnc:html-make-no-account-warning)
|
||||||
|
(let ((p (gnc:make-html-text)))
|
||||||
|
(gnc:html-text-append!
|
||||||
|
p
|
||||||
|
(gnc:html-markup-h2 (_ "No accounts selected"))
|
||||||
|
(gnc:html-markup-p
|
||||||
|
(_ "This report requires accounts to be selected.")))
|
||||||
|
p))
|
||||||
@ -222,6 +222,7 @@
|
|||||||
(if (< amount min)
|
(if (< amount min)
|
||||||
(set! min amount))
|
(set! min amount))
|
||||||
(set! totalitems (+ 1 totalitems))))))
|
(set! totalitems (+ 1 totalitems))))))
|
||||||
|
(getnumitems (lambda () totalitems))
|
||||||
(gettotal (lambda () value))
|
(gettotal (lambda () value))
|
||||||
(getaverage (lambda () (/ value totalitems)))
|
(getaverage (lambda () (/ value totalitems)))
|
||||||
(getmax (lambda () max))
|
(getmax (lambda () max))
|
||||||
@ -236,6 +237,7 @@
|
|||||||
('add (adder value))
|
('add (adder value))
|
||||||
('total (gettotal))
|
('total (gettotal))
|
||||||
('average (getaverage))
|
('average (getaverage))
|
||||||
|
('numitems (getnumitems))
|
||||||
('getmax (getmax))
|
('getmax (getmax))
|
||||||
('getmin (getmin))
|
('getmin (getmin))
|
||||||
('reset (reset-all))
|
('reset (reset-all))
|
||||||
|
|||||||
@ -5,6 +5,7 @@ gncscm_DATA = \
|
|||||||
account-piecharts.scm \
|
account-piecharts.scm \
|
||||||
account-summary.scm \
|
account-summary.scm \
|
||||||
average-balance.scm \
|
average-balance.scm \
|
||||||
|
average-balance-2.scm \
|
||||||
balance-sheet.scm \
|
balance-sheet.scm \
|
||||||
category-barchart.scm \
|
category-barchart.scm \
|
||||||
hello-world.scm \
|
hello-world.scm \
|
||||||
|
|||||||
@ -251,138 +251,145 @@ balance at a given time"))
|
|||||||
(filter show-acct? accts))))
|
(filter show-acct? accts))))
|
||||||
|
|
||||||
;; Now do the work here.
|
;; Now do the work here.
|
||||||
(set! combined
|
|
||||||
(sort (filter (lambda (pair) (not (= 0.0 (car pair))))
|
|
||||||
(traverse-accounts
|
|
||||||
1 topl-accounts))
|
|
||||||
(lambda (a b) (> (car a) (car b)))))
|
|
||||||
|
|
||||||
;; if too many slices, condense them to an 'other' slice
|
(if (not (null? accounts))
|
||||||
;; and add a link to a new pie report with just those
|
(begin
|
||||||
;; accounts
|
|
||||||
(if (> (length combined) max-slices)
|
|
||||||
(let* ((start (take combined (- max-slices 1)))
|
|
||||||
(finish (drop combined (- max-slices 1)))
|
|
||||||
(sum (apply + (unzip1 finish))))
|
|
||||||
(set! combined
|
(set! combined
|
||||||
(append start
|
(sort (filter (lambda (pair) (not (= 0.0 (car pair))))
|
||||||
(list (list sum (_ "Other")))))
|
(traverse-accounts
|
||||||
(let ((options (gnc:make-report-options reportname))
|
1 topl-accounts))
|
||||||
(id #f))
|
(lambda (a b) (> (car a) (car b)))))
|
||||||
;; now copy all the options
|
|
||||||
(gnc:options-copy-values (gnc:report-options report-obj)
|
;; if too many slices, condense them to an 'other' slice
|
||||||
options)
|
;; and add a link to a new pie report with just those
|
||||||
;; and set the destination accounts
|
;; accounts
|
||||||
(gnc:option-set-value
|
(if (> (length combined) max-slices)
|
||||||
(gnc:lookup-option options gnc:pagename-accounts
|
(let* ((start (take combined (- max-slices 1)))
|
||||||
optname-accounts)
|
(finish (drop combined (- max-slices 1)))
|
||||||
(map cadr finish))
|
(sum (apply + (unzip1 finish))))
|
||||||
(set! id (gnc:make-report reportname options))
|
(set! combined
|
||||||
(gnc:report-add-child-by-id! report-obj id)
|
(append start
|
||||||
(gnc:report-set-parent! (gnc:find-report id) report-obj)
|
(list (list sum (_ "Other")))))
|
||||||
|
(let ((options (gnc:make-report-options reportname))
|
||||||
;; set the URL.
|
(id #f))
|
||||||
(set! other-anchor (gnc:report-anchor-text id)))))
|
;; now copy all the options
|
||||||
|
(gnc:options-copy-values (gnc:report-options report-obj)
|
||||||
;; set the URLs; the slices are links to other reports
|
options)
|
||||||
(let
|
;; and set the destination accounts
|
||||||
((urls
|
(gnc:option-set-value
|
||||||
(map
|
(gnc:lookup-option options gnc:pagename-accounts
|
||||||
(lambda (pair)
|
optname-accounts)
|
||||||
(if (string? (cadr pair))
|
(map cadr finish))
|
||||||
other-anchor
|
(set! id (gnc:make-report reportname options))
|
||||||
(let* ((acct (cadr pair))
|
(gnc:report-add-child-by-id! report-obj id)
|
||||||
(subaccts
|
(gnc:report-set-parent! (gnc:find-report id) report-obj)
|
||||||
(gnc:account-get-immediate-subaccounts acct)))
|
|
||||||
(if (null? subaccts)
|
;; set the URL.
|
||||||
;; if leaf-account, make this an anchor
|
(set! other-anchor (gnc:report-anchor-text id)))))
|
||||||
;; to the register.
|
|
||||||
(gnc:account-anchor-text (cadr pair))
|
;; set the URLs; the slices are links to other reports
|
||||||
;; if non-leaf account, make this a link
|
(let
|
||||||
;; to another report which is run on the
|
((urls
|
||||||
;; immediate subaccounts of this account
|
(map
|
||||||
;; (and including this account).
|
(lambda (pair)
|
||||||
(gnc:make-report-anchor
|
(if (string? (cadr pair))
|
||||||
reportname
|
other-anchor
|
||||||
report-obj
|
(let* ((acct (cadr pair))
|
||||||
(list
|
(subaccts
|
||||||
(list gnc:pagename-accounts optname-accounts
|
(gnc:account-get-immediate-subaccounts acct)))
|
||||||
(cons acct subaccts))
|
(if (null? subaccts)
|
||||||
(list gnc:pagename-accounts optname-levels
|
;; if leaf-account, make this an anchor
|
||||||
(+ 1 tree-depth))
|
;; to the register.
|
||||||
(list gnc:pagename-general
|
(gnc:account-anchor-text (cadr pair))
|
||||||
gnc:optname-reportname
|
;; if non-leaf account, make this a link
|
||||||
((if show-fullname?
|
;; to another report which is run on the
|
||||||
gnc:account-get-full-name
|
;; immediate subaccounts of this account
|
||||||
gnc:account-get-name) acct))))))))
|
;; (and including this account).
|
||||||
combined)))
|
(gnc:make-report-anchor
|
||||||
(gnc:html-piechart-set-button-1-slice-urls!
|
reportname
|
||||||
chart urls)
|
report-obj
|
||||||
(gnc:html-piechart-set-button-1-legend-urls!
|
(list
|
||||||
chart urls))
|
(list gnc:pagename-accounts optname-accounts
|
||||||
|
(cons acct subaccts))
|
||||||
(gnc:html-piechart-set-title!
|
(list gnc:pagename-accounts optname-levels
|
||||||
chart report-title)
|
(+ 1 tree-depth))
|
||||||
(gnc:html-piechart-set-width! chart width)
|
(list gnc:pagename-general
|
||||||
(gnc:html-piechart-set-height! chart height)
|
gnc:optname-reportname
|
||||||
(gnc:html-piechart-set-data! chart (unzip1 combined))
|
((if show-fullname?
|
||||||
(gnc:html-piechart-set-colors! chart
|
gnc:account-get-full-name
|
||||||
(gnc:assign-colors (length combined)))
|
gnc:account-get-name) acct))))))))
|
||||||
|
combined)))
|
||||||
(gnc:html-piechart-set-subtitle!
|
(gnc:html-piechart-set-button-1-slice-urls!
|
||||||
chart (string-append
|
chart urls)
|
||||||
(if do-intervals?
|
(gnc:html-piechart-set-button-1-legend-urls!
|
||||||
(sprintf #f
|
chart urls))
|
||||||
(_ "%s to %s")
|
|
||||||
(gnc:timepair-to-datestring from-date-tp)
|
(gnc:html-piechart-set-title!
|
||||||
(gnc:timepair-to-datestring to-date-tp))
|
chart report-title)
|
||||||
(sprintf #f
|
(gnc:html-piechart-set-width! chart width)
|
||||||
(_ "Balance at %s")
|
(gnc:html-piechart-set-height! chart height)
|
||||||
(gnc:timepair-to-datestring to-date-tp)))
|
(gnc:html-piechart-set-data! chart (unzip1 combined))
|
||||||
(if show-total?
|
(gnc:html-piechart-set-colors! chart
|
||||||
(let ((total (apply + (unzip1 combined))))
|
(gnc:assign-colors (length combined)))
|
||||||
(sprintf #f ": %s"
|
|
||||||
(gnc:amount->string total print-info)))
|
(gnc:html-piechart-set-subtitle!
|
||||||
|
chart (string-append
|
||||||
"")))
|
(if do-intervals?
|
||||||
|
(sprintf #f
|
||||||
(let ((legend-labels
|
(_ "%s to %s")
|
||||||
(map
|
(gnc:timepair-to-datestring from-date-tp)
|
||||||
(lambda (pair)
|
(gnc:timepair-to-datestring to-date-tp))
|
||||||
(string-append
|
(sprintf #f
|
||||||
(if (string? (cadr pair))
|
(_ "Balance at %s")
|
||||||
(cadr pair)
|
(gnc:timepair-to-datestring to-date-tp)))
|
||||||
((if show-fullname?
|
(if show-total?
|
||||||
gnc:account-get-full-name
|
(let ((total (apply + (unzip1 combined))))
|
||||||
gnc:account-get-name) (cadr pair)))
|
(sprintf #f ": %s"
|
||||||
(if show-total?
|
(gnc:amount->string total print-info)))
|
||||||
(string-append
|
|
||||||
" - "
|
"")))
|
||||||
(gnc:amount->string (car pair) print-info))
|
|
||||||
"")))
|
(let ((legend-labels
|
||||||
combined)))
|
(map
|
||||||
(gnc:html-piechart-set-labels! chart legend-labels))
|
(lambda (pair)
|
||||||
|
(string-append
|
||||||
(gnc:html-document-add-object! document chart)
|
(if (string? (cadr pair))
|
||||||
|
(cadr pair)
|
||||||
(if (gnc:option-value
|
((if show-fullname?
|
||||||
(gnc:lookup-global-option "General"
|
gnc:account-get-full-name
|
||||||
"Display \"Tip of the Day\""))
|
gnc:account-get-name) (cadr pair)))
|
||||||
(gnc:html-document-add-object!
|
(if show-total?
|
||||||
document
|
(string-append
|
||||||
(gnc:make-html-text
|
" - "
|
||||||
(gnc:html-markup-p
|
(gnc:amount->string (car pair) print-info))
|
||||||
"Double-click on any legend box or pie slice opens either the \
|
"")))
|
||||||
|
combined)))
|
||||||
|
(gnc:html-piechart-set-labels! chart legend-labels))
|
||||||
|
|
||||||
|
(gnc:html-document-add-object! document chart)
|
||||||
|
|
||||||
|
(if (gnc:option-value
|
||||||
|
(gnc:lookup-global-option "General"
|
||||||
|
"Display \"Tip of the Day\""))
|
||||||
|
(gnc:html-document-add-object!
|
||||||
|
document
|
||||||
|
(gnc:make-html-text
|
||||||
|
(gnc:html-markup-p
|
||||||
|
"Double-click on any legend box or pie slice opens either the \
|
||||||
register or, if the account has subaccounts, opens \
|
register or, if the account has subaccounts, opens \
|
||||||
another piechart report with precisely those subaccounts.")
|
another piechart report with precisely those subaccounts.")
|
||||||
(gnc:html-markup-p "Dragging with left button \
|
(gnc:html-markup-p "Dragging with left button \
|
||||||
lets you drag single slices out of the pie. \
|
lets you drag single slices out of the pie. \
|
||||||
Dragging with right button lets you rotate the pie. ")
|
Dragging with right button lets you rotate the pie. ")
|
||||||
(gnc:html-markup-p "Remove this text by disabling \
|
(gnc:html-markup-p "Remove this text by disabling \
|
||||||
the global Preference \"Display Tip of the Day\"."))))
|
the global Preference \"Display Tip of the Day\".")))))
|
||||||
|
|
||||||
document)))
|
(gnc:html-document-add-object!
|
||||||
|
document
|
||||||
|
(gnc:html-make-no-account-warning)))
|
||||||
|
|
||||||
|
document)))
|
||||||
|
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (l)
|
(lambda (l)
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
@ -390,10 +397,10 @@ the global Preference \"Display Tip of the Day\"."))))
|
|||||||
'name (car l)
|
'name (car l)
|
||||||
'menu-path (if (caddr l)
|
'menu-path (if (caddr l)
|
||||||
(list gnc:menuname-income-expense)
|
(list gnc:menuname-income-expense)
|
||||||
(list gnc:menuname-asset-liability))
|
(list gnc:menuname-asset-liability))
|
||||||
'menu-name (cadddr l)
|
'menu-name (cadddr l)
|
||||||
'menu-tip (car (cddddr l))
|
'menu-tip (car (cddddr l))
|
||||||
'options-generator (lambda () (options-generator (cadr l)
|
'options-generator (lambda () (options-generator (cadr l)
|
||||||
(caddr l)))
|
(caddr l)))
|
||||||
'renderer (lambda (report-obj)
|
'renderer (lambda (report-obj)
|
||||||
(piechart-renderer report-obj
|
(piechart-renderer report-obj
|
||||||
|
|||||||
@ -171,14 +171,8 @@
|
|||||||
report-currency exchange-fn accounts)));;)
|
report-currency exchange-fn accounts)));;)
|
||||||
|
|
||||||
;; error condition: no accounts specified
|
;; error condition: no accounts specified
|
||||||
(let ((p (gnc:make-html-text)))
|
(gnc:html-document-add-object! doc (gnc:html-make-no-account-warning))))
|
||||||
(gnc:html-text-append!
|
doc)
|
||||||
p
|
|
||||||
(gnc:html-markup-h2 (_ "No accounts selected"))
|
|
||||||
(gnc:html-markup-p
|
|
||||||
(_ "This report requires accounts to be selected.")))
|
|
||||||
(gnc:html-document-add-object! doc p)))
|
|
||||||
doc))
|
|
||||||
|
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
'version 1
|
'version 1
|
||||||
|
|||||||
443
src/scm/report/average-balance-2.scm
Normal file
443
src/scm/report/average-balance-2.scm
Normal file
@ -0,0 +1,443 @@
|
|||||||
|
;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; average-balance-2.scm
|
||||||
|
;; Report history of account balance and other info
|
||||||
|
;;
|
||||||
|
;; Author makes no implicit or explicit guarantee of accuracy of
|
||||||
|
;; these calculations and accepts no responsibility for direct
|
||||||
|
;; or indirect losses incurred as a result of using this software.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(gnc:support "report/average-balance-2.scm")
|
||||||
|
|
||||||
|
(gnc:depend "report-html.scm")
|
||||||
|
(gnc:depend "report-utilities.scm")
|
||||||
|
(gnc:depend "date-utilities.scm")
|
||||||
|
|
||||||
|
(let ((optname-subacct (N_ "Include Sub-Accounts"))
|
||||||
|
(optname-report-currency (N_ "Report Currency")))
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Options
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define (options-generator)
|
||||||
|
(let* ((options (gnc:new-options))
|
||||||
|
;; register a configuration option for the report
|
||||||
|
(register-option
|
||||||
|
(lambda (new-option)
|
||||||
|
(gnc:register-option options new-option))))
|
||||||
|
|
||||||
|
(gnc:options-add-date-interval!
|
||||||
|
options gnc:pagename-general (N_ "From") (N_ "To") "a")
|
||||||
|
|
||||||
|
;; account(s) to do report on
|
||||||
|
(register-option
|
||||||
|
(gnc:make-account-list-option
|
||||||
|
gnc:pagename-accounts (N_ "Accounts")
|
||||||
|
"d" (N_ "Do transaction report on this account")
|
||||||
|
(lambda ()
|
||||||
|
;; FIXME : gnc:get-current-accounts disappeared
|
||||||
|
(let ((current-accounts '()))
|
||||||
|
;; If some accounts were selected, use those
|
||||||
|
(cond ((not (null? current-accounts))
|
||||||
|
current-accounts)
|
||||||
|
(else
|
||||||
|
;; otherwise get some accounts -- here as an
|
||||||
|
;; example we get the asset and liability stuff
|
||||||
|
(gnc:filter-accountlist-type
|
||||||
|
'(bank cash credit asset liability equity)
|
||||||
|
;; or: '(bank cash checking savings stock
|
||||||
|
;; mutual-fund money-market)
|
||||||
|
(gnc:group-get-subaccounts (gnc:get-current-group)))))))
|
||||||
|
#f #t))
|
||||||
|
|
||||||
|
(gnc:options-add-interval-choice!
|
||||||
|
options gnc:pagename-general (N_ "Step Size") "b" 'TwoWeekDelta)
|
||||||
|
|
||||||
|
(register-option
|
||||||
|
(gnc:make-simple-boolean-option
|
||||||
|
gnc:pagename-accounts optname-subacct
|
||||||
|
"e" (N_ "Include sub-accounts of all selected accounts") #t))
|
||||||
|
|
||||||
|
;; Report currency
|
||||||
|
(gnc:options-add-currency!
|
||||||
|
options gnc:pagename-general optname-report-currency "f")
|
||||||
|
|
||||||
|
(register-option
|
||||||
|
(gnc:make-simple-boolean-option
|
||||||
|
gnc:pagename-display (N_ "Show table")
|
||||||
|
"a" (N_ "Display a table of the selected data.") #f))
|
||||||
|
|
||||||
|
(register-option
|
||||||
|
(gnc:make-simple-boolean-option
|
||||||
|
gnc:pagename-display (N_ "Show plot")
|
||||||
|
"b" (N_ "Display a graph of the selected data.") #t))
|
||||||
|
|
||||||
|
(register-option
|
||||||
|
(gnc:make-list-option
|
||||||
|
gnc:pagename-display (N_ "Plot Type")
|
||||||
|
"c" (N_ "The type of graph to generate") (list 'AvgBalPlot)
|
||||||
|
(list (list->vector
|
||||||
|
(list 'AvgBalPlot (N_ "Average") (N_ "Average Balance")))
|
||||||
|
(list->vector
|
||||||
|
(list 'GainPlot (N_ "Net Gain") (N_ "Net Gain")))
|
||||||
|
(list->vector
|
||||||
|
(list 'GLPlot (N_ "Gain/Loss") (N_ "Gain And Loss"))))))
|
||||||
|
|
||||||
|
(gnc:options-add-plot-size!
|
||||||
|
options gnc:pagename-display (N_ "Plot Width") (N_ "Plot Height")
|
||||||
|
"d" 400 400)
|
||||||
|
|
||||||
|
;; Set the general page as default option tab
|
||||||
|
(gnc:options-set-default-section options gnc:pagename-general)
|
||||||
|
|
||||||
|
options))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Some utilities for generating the data
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define columns
|
||||||
|
(list (_ "Period start") (_ "Period end") (_ "Avg Bal")
|
||||||
|
(_ "Max Bal") (_ "Min Bal") (_ "Total In")
|
||||||
|
(_ "Total Out") (_ "Net Change") ))
|
||||||
|
|
||||||
|
;; analyze-splits crunches a split list into a set of period
|
||||||
|
;; summaries. Each summary is a list of (start-date end-date
|
||||||
|
;; avg-bal max-bal min-bal total-in total-out net) if multiple
|
||||||
|
;; accounts are selected the balance is the sum for all. Each
|
||||||
|
;; balance in a foreign currency will be converted to a double in
|
||||||
|
;; the report-currency by means of the collector->double
|
||||||
|
;; function.
|
||||||
|
|
||||||
|
;; FIXME: the exchange rate should change every time interval, of
|
||||||
|
;; course, but right now we assume the very last exchange rate to be
|
||||||
|
;; constant over the whole report period. Note that this might get
|
||||||
|
;; *really* complicated.
|
||||||
|
|
||||||
|
(define (analyze-splits splits start-bal
|
||||||
|
start-date end-date interval collector->double)
|
||||||
|
(let ((interval-list
|
||||||
|
(gnc:make-date-interval-list start-date end-date interval))
|
||||||
|
(start-bal-double (collector->double start-bal))
|
||||||
|
(data-rows '()))
|
||||||
|
|
||||||
|
(define (output-row interval-start
|
||||||
|
interval-end
|
||||||
|
stats-accum
|
||||||
|
minmax-accum
|
||||||
|
gain-loss-accum)
|
||||||
|
(set! data-rows
|
||||||
|
(cons
|
||||||
|
(list (gnc:timepair-to-datestring interval-start)
|
||||||
|
(gnc:timepair-to-datestring interval-end)
|
||||||
|
(/ (stats-accum 'total #f)
|
||||||
|
(gnc:timepair-delta interval-start
|
||||||
|
interval-end))
|
||||||
|
(minmax-accum 'getmax #f)
|
||||||
|
(minmax-accum 'getmin #f)
|
||||||
|
(gain-loss-accum 'debits #f)
|
||||||
|
(gain-loss-accum 'credits #f)
|
||||||
|
(- (gain-loss-accum 'debits #f)
|
||||||
|
(gain-loss-accum 'credits #f)))
|
||||||
|
data-rows)))
|
||||||
|
|
||||||
|
;; Returns a double which is the split value, correctly
|
||||||
|
;; exchanged to the current report-currency.
|
||||||
|
(define (get-split-value split)
|
||||||
|
(let ((coll (gnc:make-commodity-collector)))
|
||||||
|
(coll 'add (gnc:account-get-commodity (gnc:split-get-account split))
|
||||||
|
(gnc:split-get-amount split))
|
||||||
|
;; FIXME: not as efficient as it would be possible because I
|
||||||
|
;; only have the collector->double conversion at hand.
|
||||||
|
(collector->double coll)))
|
||||||
|
|
||||||
|
;; calculate the statistics for one interval - returns a list
|
||||||
|
;; containing the following:
|
||||||
|
;; min-max acculumator
|
||||||
|
;; average-accumulator
|
||||||
|
;; gain-loss accumulator
|
||||||
|
;; final balance for this interval
|
||||||
|
;; splits remaining to be processed.
|
||||||
|
|
||||||
|
;; note that it is assumed that every split in in the list
|
||||||
|
;; has a date >= from
|
||||||
|
|
||||||
|
(define (process-interval splits from to start-balance)
|
||||||
|
|
||||||
|
(let ((minmax-accum (gnc:make-stats-collector))
|
||||||
|
(stats-accum (gnc:make-stats-collector))
|
||||||
|
(gain-loss-accum (gnc:make-drcr-collector))
|
||||||
|
(last-balance start-balance)
|
||||||
|
(last-balance-time from))
|
||||||
|
|
||||||
|
|
||||||
|
(define (update-stats split-amt split-time)
|
||||||
|
(let ((time-difference (gnc:timepair-delta
|
||||||
|
last-balance-time
|
||||||
|
split-time)))
|
||||||
|
(stats-accum 'add (* last-balance time-difference))
|
||||||
|
(set! last-balance (+ last-balance split-amt))
|
||||||
|
(set! last-balance-time split-time)
|
||||||
|
(minmax-accum 'add last-balance)
|
||||||
|
(gain-loss-accum 'add split-amt)))
|
||||||
|
|
||||||
|
(define (split-recurse)
|
||||||
|
(if (or (null? splits) (gnc:timepair-gt
|
||||||
|
(gnc:transaction-get-date-posted
|
||||||
|
(gnc:split-get-parent
|
||||||
|
(car splits))) to))
|
||||||
|
#f
|
||||||
|
(let*
|
||||||
|
((split (car splits))
|
||||||
|
(split-amt (gnc:split-get-amount split))
|
||||||
|
(split-time (gnc:transaction-get-date-posted
|
||||||
|
(gnc:split-get-parent split))))
|
||||||
|
|
||||||
|
|
||||||
|
(gnc:debug "split " split)
|
||||||
|
(gnc:debug "split-time " split-time)
|
||||||
|
(gnc:debug "split-amt " split-amt)
|
||||||
|
(gnc:debug "splits " splits)
|
||||||
|
(update-stats (gnc:numeric-to-double split-amt) split-time)
|
||||||
|
(set! splits (cdr splits))
|
||||||
|
(split-recurse))))
|
||||||
|
|
||||||
|
; the minmax accumulator
|
||||||
|
|
||||||
|
(minmax-accum 'add start-balance)
|
||||||
|
|
||||||
|
|
||||||
|
(if (not (null? splits))
|
||||||
|
(split-recurse))
|
||||||
|
|
||||||
|
;; insert a null transaction at the end of the interval
|
||||||
|
(update-stats 0.0 to)
|
||||||
|
(list minmax-accum stats-accum gain-loss-accum last-balance splits)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(for-each
|
||||||
|
(lambda (interval)
|
||||||
|
(let*
|
||||||
|
|
||||||
|
((interval-results
|
||||||
|
(process-interval
|
||||||
|
splits
|
||||||
|
(car interval)
|
||||||
|
(cadr interval)
|
||||||
|
start-bal-double))
|
||||||
|
(min-max-accum (car interval-results))
|
||||||
|
(stats-accum (cadr interval-results))
|
||||||
|
(gain-loss-accum (caddr interval-results))
|
||||||
|
(last-bal (cadddr interval-results))
|
||||||
|
(rest-splits (list-ref interval-results 4)))
|
||||||
|
|
||||||
|
(set! start-bal-double last-bal)
|
||||||
|
(set! splits rest-splits)
|
||||||
|
(output-row (car interval)
|
||||||
|
(cadr interval)
|
||||||
|
stats-accum
|
||||||
|
min-max-accum gain-loss-accum)))
|
||||||
|
interval-list)
|
||||||
|
|
||||||
|
|
||||||
|
(reverse data-rows)))
|
||||||
|
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Renderer
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define (renderer report-obj)
|
||||||
|
(let* ((opt-val
|
||||||
|
(lambda (sec value)
|
||||||
|
(gnc:option-value
|
||||||
|
(gnc:lookup-option (gnc:report-options report-obj) sec value))))
|
||||||
|
(report-title (opt-val gnc:pagename-general gnc:optname-reportname))
|
||||||
|
(begindate (gnc:timepair-start-day-time
|
||||||
|
(gnc:date-option-absolute-time
|
||||||
|
(opt-val gnc:pagename-general (N_ "From")))))
|
||||||
|
(enddate (gnc:timepair-end-day-time
|
||||||
|
(gnc:date-option-absolute-time
|
||||||
|
(opt-val gnc:pagename-general (N_ "To")))))
|
||||||
|
(stepsize (eval (opt-val gnc:pagename-general (N_ "Step Size"))))
|
||||||
|
(accounts (opt-val gnc:pagename-accounts (N_ "Accounts")))
|
||||||
|
(dosubs? (opt-val gnc:pagename-accounts optname-subacct))
|
||||||
|
(report-currency (opt-val gnc:pagename-general
|
||||||
|
optname-report-currency))
|
||||||
|
(plot-type (opt-val gnc:pagename-display (N_ "Plot Type")))
|
||||||
|
(show-plot? (opt-val gnc:pagename-display (N_ "Show plot")))
|
||||||
|
(show-table? (opt-val gnc:pagename-display (N_ "Show table")))
|
||||||
|
(document (gnc:make-html-document))
|
||||||
|
(exchange-alist (gnc:make-exchange-alist
|
||||||
|
report-currency enddate))
|
||||||
|
(exchange-fn (gnc:make-exchange-function exchange-alist))
|
||||||
|
(beforebegindate (gnc:timepair-end-day-time
|
||||||
|
(gnc:timepair-previous-day begindate)))
|
||||||
|
;; startbal will be a commodity-collector
|
||||||
|
(startbal '()))
|
||||||
|
|
||||||
|
(define (collector->double commodity-collector)
|
||||||
|
(gnc:numeric-to-double
|
||||||
|
(gnc:gnc-monetary-amount
|
||||||
|
(gnc:sum-collector-commodity commodity-collector
|
||||||
|
report-currency
|
||||||
|
exchange-fn))))
|
||||||
|
|
||||||
|
(gnc:html-document-set-title! document report-title)
|
||||||
|
|
||||||
|
(if (not (null? accounts))
|
||||||
|
(let ((query (gnc:malloc-query))
|
||||||
|
(splits '())
|
||||||
|
(data '()))
|
||||||
|
|
||||||
|
;; initialize the query to find splits in the right
|
||||||
|
;; date range and accounts
|
||||||
|
(gnc:query-set-group query (gnc:get-current-group))
|
||||||
|
|
||||||
|
;; add accounts to the query (include subaccounts
|
||||||
|
;; if requested)
|
||||||
|
(if dosubs?
|
||||||
|
(let ((subaccts '()))
|
||||||
|
(for-each
|
||||||
|
(lambda (acct)
|
||||||
|
(let ((this-acct-subs
|
||||||
|
(gnc:account-get-all-subaccounts acct)))
|
||||||
|
(if (list? this-acct-subs)
|
||||||
|
(set! subaccts
|
||||||
|
(append subaccts this-acct-subs)))))
|
||||||
|
accounts)
|
||||||
|
;; Beware: delete-duplicates is an O(n^2)
|
||||||
|
;; algorithm. More efficient method: sort the list,
|
||||||
|
;; then use a linear algorithm.
|
||||||
|
(set! accounts
|
||||||
|
(delete-duplicates (append accounts subaccts)))))
|
||||||
|
|
||||||
|
(gnc:query-add-account-match
|
||||||
|
query (gnc:list->glist accounts)
|
||||||
|
'acct-match-any 'query-and)
|
||||||
|
|
||||||
|
;; match splits between start and end dates
|
||||||
|
(gnc:query-add-date-match-timepair
|
||||||
|
query #t begindate #t enddate 'query-and)
|
||||||
|
(gnc:query-set-sort-order
|
||||||
|
query 'by-date 'by-standard 'by-none)
|
||||||
|
|
||||||
|
;; get the query results
|
||||||
|
(set! splits (gnc:glist->list (gnc:query-get-splits query)
|
||||||
|
<gnc:Split*>))
|
||||||
|
|
||||||
|
;; find the net starting balance for the set of accounts
|
||||||
|
(set! startbal
|
||||||
|
(gnc:accounts-get-balance-helper
|
||||||
|
accounts
|
||||||
|
(lambda (acct) (gnc:account-get-comm-balance-at-date
|
||||||
|
acct beforebegindate #f))
|
||||||
|
gnc:account-reverse-balance?))
|
||||||
|
|
||||||
|
;; and analyze the data
|
||||||
|
(set! data (analyze-splits splits startbal begindate enddate
|
||||||
|
stepsize collector->double))
|
||||||
|
|
||||||
|
;; make a plot (optionally)... if both plot and table,
|
||||||
|
;; plot comes first.
|
||||||
|
(if show-plot?
|
||||||
|
(let ((barchart (gnc:make-html-barchart))
|
||||||
|
(width (opt-val gnc:pagename-display
|
||||||
|
(N_ "Plot Width")))
|
||||||
|
(height (opt-val gnc:pagename-display
|
||||||
|
(N_ "Plot Height")))
|
||||||
|
(col-labels '())
|
||||||
|
(col-colors '()))
|
||||||
|
(if (memq 'AvgBalPlot plot-type)
|
||||||
|
(begin
|
||||||
|
(gnc:html-barchart-append-column!
|
||||||
|
barchart
|
||||||
|
(map (lambda (row) (list-ref row 2)) data))
|
||||||
|
(set! col-labels
|
||||||
|
(append col-labels
|
||||||
|
(list (list-ref columns 2))))
|
||||||
|
(set! col-colors
|
||||||
|
(append col-colors (list "blue")))))
|
||||||
|
|
||||||
|
(if (memq 'GainPlot plot-type)
|
||||||
|
(begin
|
||||||
|
(gnc:html-barchart-append-column!
|
||||||
|
barchart
|
||||||
|
(map (lambda (row) (list-ref row 7)) data))
|
||||||
|
(set! col-labels
|
||||||
|
(append col-labels
|
||||||
|
(list (list-ref columns 7))))
|
||||||
|
(set! col-colors
|
||||||
|
(append col-colors (list "green")))))
|
||||||
|
(if (memq 'GLPlot plot-type)
|
||||||
|
(begin
|
||||||
|
;; debit column
|
||||||
|
(gnc:html-barchart-append-column!
|
||||||
|
barchart
|
||||||
|
(map (lambda (row) (list-ref row 5)) data))
|
||||||
|
(set! col-labels
|
||||||
|
(append col-labels
|
||||||
|
(list (list-ref columns 5))))
|
||||||
|
(set! col-colors
|
||||||
|
(append col-colors (list "black")))
|
||||||
|
|
||||||
|
;; credit
|
||||||
|
(gnc:html-barchart-append-column!
|
||||||
|
barchart
|
||||||
|
(map (lambda (row) (list-ref row 6)) data))
|
||||||
|
(set! col-labels
|
||||||
|
(append col-labels
|
||||||
|
(list (list-ref columns 6))))
|
||||||
|
(set! col-colors
|
||||||
|
(append col-colors (list "red")))))
|
||||||
|
|
||||||
|
(gnc:html-barchart-set-col-labels!
|
||||||
|
barchart col-labels)
|
||||||
|
(gnc:html-barchart-set-col-colors!
|
||||||
|
barchart col-colors)
|
||||||
|
(gnc:html-barchart-set-row-labels!
|
||||||
|
barchart (map car data))
|
||||||
|
(gnc:html-barchart-set-row-labels-rotated?! barchart #t)
|
||||||
|
|
||||||
|
(gnc:html-barchart-set-width! barchart width)
|
||||||
|
(gnc:html-barchart-set-height! barchart height)
|
||||||
|
(gnc:html-barchart-set-height! barchart height)
|
||||||
|
(gnc:html-document-add-object! document barchart)))
|
||||||
|
|
||||||
|
;; make a table (optionally)
|
||||||
|
(if show-table?
|
||||||
|
(let ((table (gnc:make-html-table)))
|
||||||
|
(gnc:html-table-set-col-headers!
|
||||||
|
table columns)
|
||||||
|
(for-each-in-order
|
||||||
|
(lambda (row)
|
||||||
|
(gnc:html-table-append-row! table row))
|
||||||
|
data)
|
||||||
|
|
||||||
|
;; set numeric columns to align right
|
||||||
|
(for-each
|
||||||
|
(lambda (col)
|
||||||
|
(gnc:html-table-set-col-style!
|
||||||
|
table col "td"
|
||||||
|
'attribute (list "align" "right")))
|
||||||
|
'(2 3 4 5 6 7))
|
||||||
|
|
||||||
|
(gnc:html-document-add-object! document table))))
|
||||||
|
|
||||||
|
;; if there are no accounts selected...
|
||||||
|
(gnc:html-document-add-object!
|
||||||
|
document
|
||||||
|
(gnc:html-make-no-account-warning)))
|
||||||
|
document))
|
||||||
|
|
||||||
|
(gnc:define-report
|
||||||
|
'version 1
|
||||||
|
'name (N_ "Average Balance 2")
|
||||||
|
'menu-path (list gnc:menuname-asset-liability)
|
||||||
|
'options-generator options-generator
|
||||||
|
'renderer renderer))
|
||||||
@ -325,13 +325,9 @@
|
|||||||
|
|
||||||
|
|
||||||
;; error condition: no accounts specified
|
;; error condition: no accounts specified
|
||||||
(let ((p (gnc:make-html-text)))
|
|
||||||
(gnc:html-text-append!
|
(gnc:html-document-add-object!
|
||||||
p
|
doc (gnc:html-make-no-account-warning)))
|
||||||
(gnc:html-markup-h2 (_ "No accounts selected"))
|
|
||||||
(gnc:html-markup-p
|
|
||||||
(_ "This report requires accounts to be selected.")))
|
|
||||||
(gnc:html-document-add-object! doc p)))
|
|
||||||
doc))
|
doc))
|
||||||
|
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
|
|||||||
@ -191,255 +191,265 @@ developing over time"))
|
|||||||
(define (show-acct? a)
|
(define (show-acct? a)
|
||||||
(member a accounts))
|
(member a accounts))
|
||||||
|
|
||||||
;; Define more helper variables.
|
(gnc:debug accounts)
|
||||||
(let* ((exchange-alist (gnc:make-exchange-alist
|
(if (not (null? accounts))
|
||||||
report-currency to-date-tp))
|
|
||||||
(exchange-fn (gnc:make-exchange-function exchange-alist))
|
;; Define more helper variables.
|
||||||
(tree-depth (if (equal? account-levels 'all)
|
|
||||||
(gnc:get-current-group-depth)
|
(let* ((exchange-alist (gnc:make-exchange-alist
|
||||||
account-levels))
|
report-currency to-date-tp))
|
||||||
;; This is the list of date intervals to calculate.
|
(exchange-fn (gnc:make-exchange-function exchange-alist))
|
||||||
(dates-list (if do-intervals?
|
(tree-depth (if (equal? account-levels 'all)
|
||||||
(gnc:make-date-interval-list
|
(gnc:get-current-group-depth)
|
||||||
(gnc:timepair-start-day-time from-date-tp)
|
account-levels))
|
||||||
(gnc:timepair-end-day-time to-date-tp)
|
;; This is the list of date intervals to calculate.
|
||||||
(eval interval))
|
(dates-list (if do-intervals?
|
||||||
(gnc:make-date-list
|
(gnc:make-date-interval-list
|
||||||
(gnc:timepair-end-day-time from-date-tp)
|
(gnc:timepair-start-day-time from-date-tp)
|
||||||
(gnc:timepair-end-day-time to-date-tp)
|
(gnc:timepair-end-day-time to-date-tp)
|
||||||
(eval interval))))
|
(eval interval))
|
||||||
;; Here the date strings for the x-axis labels are
|
(gnc:make-date-list
|
||||||
;; created.
|
(gnc:timepair-end-day-time from-date-tp)
|
||||||
(date-string-list
|
(gnc:timepair-end-day-time to-date-tp)
|
||||||
(map (lambda (date-list-item)
|
(eval interval))))
|
||||||
(gnc:timepair-to-datestring
|
;; Here the date strings for the x-axis labels are
|
||||||
(if do-intervals?
|
;; created.
|
||||||
(car date-list-item)
|
(date-string-list
|
||||||
date-list-item)))
|
(map (lambda (date-list-item)
|
||||||
dates-list))
|
(gnc:timepair-to-datestring
|
||||||
(other-anchor "")
|
(if do-intervals?
|
||||||
(all-data '()))
|
(car date-list-item)
|
||||||
|
date-list-item)))
|
||||||
;; Converts a commodity-collector into one single double
|
dates-list))
|
||||||
;; number, depending on the report currency and the
|
(other-anchor "")
|
||||||
;; exchange-alist calculated above. Returns a double.
|
(all-data '()))
|
||||||
(define (collector->double c)
|
|
||||||
;; Future improvement: Let the user choose which kind of
|
;; Converts a commodity-collector into one single double
|
||||||
;; currency combining she want to be done.
|
;; number, depending on the report currency and the
|
||||||
(gnc:numeric-to-double
|
;; exchange-alist calculated above. Returns a double.
|
||||||
(gnc:gnc-monetary-amount
|
(define (collector->double c)
|
||||||
(gnc:sum-collector-commodity
|
;; Future improvement: Let the user choose which kind of
|
||||||
c report-currency
|
;; currency combining she want to be done.
|
||||||
exchange-fn))))
|
(gnc:numeric-to-double
|
||||||
|
(gnc:gnc-monetary-amount
|
||||||
;; Calculates the net balance (profit or loss) of an account in
|
(gnc:sum-collector-commodity
|
||||||
;; the given time interval. date-list-entry is a pair containing
|
c report-currency
|
||||||
;; the start- and end-date of that interval. If subacct?==#t,
|
exchange-fn))))
|
||||||
;; the subaccount's balances are included as well. Returns a
|
|
||||||
;; double, exchanged into the report-currency by the above
|
;; Calculates the net balance (profit or loss) of an account in
|
||||||
;; conversion function, and possibly with reversed sign.
|
;; the given time interval. date-list-entry is a pair containing
|
||||||
(define (get-balance account date-list-entry subacct?)
|
;; the start- and end-date of that interval. If subacct?==#t,
|
||||||
((if (gnc:account-reverse-balance? account)
|
;; the subaccount's balances are included as well. Returns a
|
||||||
- +)
|
;; double, exchanged into the report-currency by the above
|
||||||
(collector->double
|
;; conversion function, and possibly with reversed sign.
|
||||||
(if do-intervals?
|
(define (get-balance account date-list-entry subacct?)
|
||||||
(gnc:account-get-comm-balance-interval
|
((if (gnc:account-reverse-balance? account)
|
||||||
account
|
- +)
|
||||||
(car date-list-entry)
|
(collector->double
|
||||||
(cadr date-list-entry) subacct?)
|
(if do-intervals?
|
||||||
(gnc:account-get-comm-balance-at-date
|
(gnc:account-get-comm-balance-interval
|
||||||
account date-list-entry subacct?)))))
|
account
|
||||||
|
(car date-list-entry)
|
||||||
;; Creates the <balance-list> to be used in the function
|
(cadr date-list-entry) subacct?)
|
||||||
;; below.
|
(gnc:account-get-comm-balance-at-date
|
||||||
(define (account->balance-list account subacct?)
|
account date-list-entry subacct?)))))
|
||||||
(map
|
|
||||||
(lambda (d) (get-balance account d subacct?))
|
;; Creates the <balance-list> to be used in the function
|
||||||
dates-list))
|
;; below.
|
||||||
|
(define (account->balance-list account subacct?)
|
||||||
;; Calculates all account's balances. Returns a list of pairs:
|
(map
|
||||||
;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
|
(lambda (d) (get-balance account d subacct?))
|
||||||
;; (Gifts (12.3 14.5))), where each element of <balance-list>
|
dates-list))
|
||||||
;; is the balance corresponding to one element in
|
|
||||||
;; <dates-list>.
|
;; Calculates all account's balances. Returns a list of pairs:
|
||||||
;;
|
;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
|
||||||
;; If current-depth >= tree-depth, then the balances are
|
;; (Gifts (12.3 14.5))), where each element of <balance-list>
|
||||||
;; calculated *with* subaccount's balances. Else only the
|
;; is the balance corresponding to one element in
|
||||||
;; current account is regarded. Note: All accounts in accts
|
;; <dates-list>.
|
||||||
;; and all their subaccounts are processed, but a balances is
|
;;
|
||||||
;; calculated and returned *only* for those accounts where
|
;; If current-depth >= tree-depth, then the balances are
|
||||||
;; show-acct? is true. This is necessary because otherwise we
|
;; calculated *with* subaccount's balances. Else only the
|
||||||
;; would forget an account that is selected but not its
|
;; current account is regarded. Note: All accounts in accts
|
||||||
;; parent.
|
;; and all their subaccounts are processed, but a balances is
|
||||||
(define (traverse-accounts current-depth accts)
|
;; calculated and returned *only* for those accounts where
|
||||||
(if (< current-depth tree-depth)
|
;; show-acct? is true. This is necessary because otherwise we
|
||||||
(let ((res '()))
|
;; would forget an account that is selected but not its
|
||||||
(for-each
|
;; parent.
|
||||||
(lambda (a)
|
(define (traverse-accounts current-depth accts)
|
||||||
(begin
|
(if (< current-depth tree-depth)
|
||||||
(if (show-acct? a)
|
(let ((res '()))
|
||||||
(set! res
|
(for-each
|
||||||
(cons (list a (account->balance-list a #f))
|
(lambda (a)
|
||||||
res)))
|
(begin
|
||||||
(set! res (append
|
(if (show-acct? a)
|
||||||
(traverse-accounts
|
(set! res
|
||||||
(+ 1 current-depth)
|
(cons (list a (account->balance-list a #f))
|
||||||
(gnc:account-get-immediate-subaccounts a))
|
res)))
|
||||||
res))))
|
(set! res (append
|
||||||
accts)
|
(traverse-accounts
|
||||||
res)
|
(+ 1 current-depth)
|
||||||
;; else (i.e. current-depth == tree-depth)
|
(gnc:account-get-immediate-subaccounts a))
|
||||||
(map
|
res))))
|
||||||
(lambda (a)
|
accts)
|
||||||
(list a (account->balance-list a #t)))
|
res)
|
||||||
(filter show-acct? accts))))
|
;; else (i.e. current-depth == tree-depth)
|
||||||
|
(map
|
||||||
;; Sort the account list according to the account code field.
|
(lambda (a)
|
||||||
(set! all-data (sort
|
(list a (account->balance-list a #t)))
|
||||||
(filter (lambda (l)
|
(filter show-acct? accts))))
|
||||||
(not (= 0.0 (apply + (cadr l)))))
|
|
||||||
(traverse-accounts 1 topl-accounts))
|
;; Sort the account list according to the account code field.
|
||||||
(lambda (a b)
|
(set! all-data (sort
|
||||||
(string<? (gnc:account-get-code (car a))
|
(filter (lambda (l)
|
||||||
(gnc:account-get-code (car b))))))
|
(not (= 0.0 (apply + (cadr l)))))
|
||||||
;; Or rather sort by total amount?
|
(traverse-accounts 1 topl-accounts))
|
||||||
;;(< (apply + (cadr a))
|
(lambda (a b)
|
||||||
;; (apply + (cadr b))))))
|
(string<? (gnc:account-get-code (car a))
|
||||||
;; Other sort criteria: max. amount, standard deviation of amount,
|
(gnc:account-get-code (car b))))))
|
||||||
;; min. amount; ascending, descending. FIXME: Add user options to
|
;; Or rather sort by total amount?
|
||||||
;; choose sorting.
|
;;(< (apply + (cadr a))
|
||||||
|
;; (apply + (cadr b))))))
|
||||||
|
;; Other sort criteria: max. amount, standard deviation of amount,
|
||||||
;;(warn "all-data" all-data)
|
;; min. amount; ascending, descending. FIXME: Add user options to
|
||||||
|
;; choose sorting.
|
||||||
;; Set chart title, subtitle etc.
|
|
||||||
(gnc:html-barchart-set-title! chart report-title)
|
|
||||||
(gnc:html-barchart-set-subtitle!
|
;;(warn "all-data" all-data)
|
||||||
chart (sprintf #f
|
|
||||||
(if do-intervals?
|
;; Set chart title, subtitle etc.
|
||||||
(_ "%s to %s")
|
(gnc:html-barchart-set-title! chart report-title)
|
||||||
(_ "Balances %s to %s"))
|
(gnc:html-barchart-set-subtitle!
|
||||||
(gnc:timepair-to-datestring from-date-tp)
|
chart (sprintf #f
|
||||||
(gnc:timepair-to-datestring to-date-tp)))
|
(if do-intervals?
|
||||||
(gnc:html-barchart-set-width! chart width)
|
(_ "%s to %s")
|
||||||
(gnc:html-barchart-set-height! chart height)
|
(_ "Balances %s to %s"))
|
||||||
|
(gnc:timepair-to-datestring from-date-tp)
|
||||||
;; row labels etc.
|
(gnc:timepair-to-datestring to-date-tp)))
|
||||||
(gnc:html-barchart-set-row-labels! chart date-string-list)
|
(gnc:html-barchart-set-width! chart width)
|
||||||
;; FIXME: why doesn't the y-axis label get printed?!?
|
(gnc:html-barchart-set-height! chart height)
|
||||||
(gnc:html-barchart-set-y-axis-label!
|
|
||||||
chart (gnc:commodity-get-mnemonic report-currency))
|
;; row labels etc.
|
||||||
(gnc:html-barchart-set-row-labels-rotated?! chart #t)
|
(gnc:html-barchart-set-row-labels! chart date-string-list)
|
||||||
(gnc:html-barchart-set-stacked?! chart stacked?)
|
;; FIXME: why doesn't the y-axis label get printed?!?
|
||||||
;; If this is a stacked barchart, then reverse the legend.
|
(gnc:html-barchart-set-y-axis-label!
|
||||||
(gnc:html-barchart-set-legend-reversed?! chart stacked?)
|
chart (gnc:commodity-get-mnemonic report-currency))
|
||||||
|
(gnc:html-barchart-set-row-labels-rotated?! chart #t)
|
||||||
;; If we have too many categories, we sum them into a new
|
(gnc:html-barchart-set-stacked?! chart stacked?)
|
||||||
;; 'other' category and add a link to a new report with just
|
;; If this is a stacked barchart, then reverse the legend.
|
||||||
;; those accounts.
|
(gnc:html-barchart-set-legend-reversed?! chart stacked?)
|
||||||
(if (> (length all-data) max-slices)
|
|
||||||
(let* ((start (take all-data (- max-slices 1)))
|
;; If we have too many categories, we sum them into a new
|
||||||
(finish (drop all-data (- max-slices 1)))
|
;; 'other' category and add a link to a new report with just
|
||||||
(other-sum (map
|
;; those accounts.
|
||||||
(lambda (l) (apply + l))
|
(if (> (length all-data) max-slices)
|
||||||
(apply zip (map cadr finish)))))
|
(let* ((start (take all-data (- max-slices 1)))
|
||||||
(set! all-data
|
(finish (drop all-data (- max-slices 1)))
|
||||||
(append start
|
(other-sum (map
|
||||||
(list (list (_ "Other") other-sum))))
|
(lambda (l) (apply + l))
|
||||||
(let* ((options (gnc:make-report-options reportname))
|
(apply zip (map cadr finish)))))
|
||||||
(id #f))
|
(set! all-data
|
||||||
;; now copy all the options
|
(append start
|
||||||
(gnc:options-copy-values
|
(list (list (_ "Other") other-sum))))
|
||||||
(gnc:report-options report-obj) options)
|
(let* ((options (gnc:make-report-options reportname))
|
||||||
;; and set the destination accounts
|
(id #f))
|
||||||
(gnc:option-set-value
|
;; now copy all the options
|
||||||
(gnc:lookup-option options gnc:pagename-accounts
|
(gnc:options-copy-values
|
||||||
optname-accounts)
|
(gnc:report-options report-obj) options)
|
||||||
(map car finish))
|
;; and set the destination accounts
|
||||||
;; Set the URL to point to this report.
|
(gnc:option-set-value
|
||||||
(set! id (gnc:make-report reportname options))
|
(gnc:lookup-option options gnc:pagename-accounts
|
||||||
(gnc:report-add-child-by-id! report-obj id)
|
optname-accounts)
|
||||||
(gnc:report-set-parent! (gnc:find-report id) report-obj)
|
(map car finish))
|
||||||
(set! other-anchor (gnc:report-anchor-text id)))))
|
;; Set the URL to point to this report.
|
||||||
|
(set! id (gnc:make-report reportname options))
|
||||||
|
(gnc:report-add-child-by-id! report-obj id)
|
||||||
;; This adds the data. Note the apply-zip stuff: This
|
(gnc:report-set-parent! (gnc:find-report id) report-obj)
|
||||||
;; transposes the data, i.e. swaps rows and columns. Pretty
|
(set! other-anchor (gnc:report-anchor-text id)))))
|
||||||
;; cool, eh? Courtesy of dave_p.
|
|
||||||
(if (not (null? all-data))
|
|
||||||
(gnc:html-barchart-set-data! chart
|
;; This adds the data. Note the apply-zip stuff: This
|
||||||
(apply zip (map cadr all-data))))
|
;; transposes the data, i.e. swaps rows and columns. Pretty
|
||||||
|
;; cool, eh? Courtesy of dave_p.
|
||||||
;; Labels and colors
|
(if (not (null? all-data))
|
||||||
(gnc:html-barchart-set-col-labels!
|
(gnc:html-barchart-set-data! chart
|
||||||
chart (map (lambda (pair)
|
(apply zip (map cadr all-data))))
|
||||||
|
|
||||||
|
;; Labels and colors
|
||||||
|
(gnc:html-barchart-set-col-labels!
|
||||||
|
chart (map (lambda (pair)
|
||||||
|
(if (string? (car pair))
|
||||||
|
(car pair)
|
||||||
|
((if show-fullname?
|
||||||
|
gnc:account-get-full-name
|
||||||
|
gnc:account-get-name) (car pair))))
|
||||||
|
all-data))
|
||||||
|
(gnc:html-barchart-set-col-colors!
|
||||||
|
chart
|
||||||
|
(gnc:assign-colors (length all-data)))
|
||||||
|
|
||||||
|
;; set the URLs; the slices are links to other reports
|
||||||
|
(let ((urls
|
||||||
|
(map
|
||||||
|
(lambda (pair)
|
||||||
(if (string? (car pair))
|
(if (string? (car pair))
|
||||||
(car pair)
|
other-anchor
|
||||||
((if show-fullname?
|
(let* ((acct (car pair))
|
||||||
gnc:account-get-full-name
|
(subaccts
|
||||||
gnc:account-get-name) (car pair))))
|
(gnc:account-get-immediate-subaccounts acct)))
|
||||||
all-data))
|
(if (null? subaccts)
|
||||||
(gnc:html-barchart-set-col-colors!
|
;; if leaf-account, make this an anchor
|
||||||
chart
|
;; to the register.
|
||||||
(gnc:assign-colors (length all-data)))
|
(gnc:account-anchor-text acct)
|
||||||
|
;; if non-leaf account, make this a link
|
||||||
;; set the URLs; the slices are links to other reports
|
;; to another report which is run on the
|
||||||
(let ((urls
|
;; immediate subaccounts of this account
|
||||||
(map
|
;; (and including this account).
|
||||||
(lambda (pair)
|
(gnc:make-report-anchor
|
||||||
(if (string? (car pair))
|
reportname
|
||||||
other-anchor
|
report-obj
|
||||||
(let* ((acct (car pair))
|
(list
|
||||||
(subaccts
|
(list gnc:pagename-accounts optname-accounts
|
||||||
(gnc:account-get-immediate-subaccounts acct)))
|
(cons acct subaccts))
|
||||||
(if (null? subaccts)
|
(list gnc:pagename-accounts optname-levels
|
||||||
;; if leaf-account, make this an anchor
|
(+ 1 tree-depth))
|
||||||
;; to the register.
|
(list gnc:pagename-general
|
||||||
(gnc:account-anchor-text acct)
|
gnc:optname-reportname
|
||||||
;; if non-leaf account, make this a link
|
((if show-fullname?
|
||||||
;; to another report which is run on the
|
gnc:account-get-full-name
|
||||||
;; immediate subaccounts of this account
|
gnc:account-get-name) acct))))))))
|
||||||
;; (and including this account).
|
all-data)))
|
||||||
(gnc:make-report-anchor
|
(gnc:html-barchart-set-button-1-bar-urls! chart (append urls urls))
|
||||||
reportname
|
;; The legend urls do the same thing.
|
||||||
report-obj
|
(gnc:html-barchart-set-button-1-legend-urls! chart
|
||||||
(list
|
(append urls urls)))
|
||||||
(list gnc:pagename-accounts optname-accounts
|
|
||||||
(cons acct subaccts))
|
(gnc:html-document-add-object! document chart)
|
||||||
(list gnc:pagename-accounts optname-levels
|
|
||||||
(+ 1 tree-depth))
|
(if (gnc:option-value
|
||||||
(list gnc:pagename-general
|
(gnc:lookup-global-option "General"
|
||||||
gnc:optname-reportname
|
"Display \"Tip of the Day\""))
|
||||||
((if show-fullname?
|
(gnc:html-document-add-object!
|
||||||
gnc:account-get-full-name
|
document
|
||||||
gnc:account-get-name) acct))))))))
|
(gnc:make-html-text
|
||||||
all-data)))
|
(gnc:html-markup-p
|
||||||
(gnc:html-barchart-set-button-1-bar-urls! chart (append urls urls))
|
"If you don't see a stacked barchart i.e. you only see \
|
||||||
;; The legend urls do the same thing.
|
|
||||||
(gnc:html-barchart-set-button-1-legend-urls! chart
|
|
||||||
(append urls urls)))
|
|
||||||
|
|
||||||
(gnc:html-document-add-object! document chart)
|
|
||||||
|
|
||||||
(if (gnc:option-value
|
|
||||||
(gnc:lookup-global-option "General"
|
|
||||||
"Display \"Tip of the Day\""))
|
|
||||||
(gnc:html-document-add-object!
|
|
||||||
document
|
|
||||||
(gnc:make-html-text
|
|
||||||
(gnc:html-markup-p
|
|
||||||
"If you don't see a stacked barchart i.e. you only see \
|
|
||||||
lots of thin bars next to each other for each date, then you \
|
lots of thin bars next to each other for each date, then you \
|
||||||
should upgrade Guppi to version 0.35.4 or, \
|
should upgrade Guppi to version 0.35.4 or, \
|
||||||
if that isn't out yet, use the Guppi CVS version.")
|
if that isn't out yet, use the Guppi CVS version.")
|
||||||
(gnc:html-markup-p
|
(gnc:html-markup-p
|
||||||
"Double-click on any legend box or any bar opens \
|
"Double-click on any legend box or any bar opens \
|
||||||
another barchart report with the subaccounts of that account or, \
|
another barchart report with the subaccounts of that account or, \
|
||||||
if that account doesn't have subaccounts, the register for the account.")
|
if that account doesn't have subaccounts, the register for the account.")
|
||||||
(gnc:html-markup-p "Remove this text by disabling \
|
(gnc:html-markup-p "Remove this text by disabling \
|
||||||
the global Preference \"Display Tip of the Day\"."))))
|
the global Preference \"Display Tip of the Day\".")))))
|
||||||
|
|
||||||
document)))
|
;; else if no accounts selected
|
||||||
|
(gnc:html-document-add-object!
|
||||||
|
document
|
||||||
|
(gnc:html-make-no-account-warning)))
|
||||||
|
|
||||||
|
|
||||||
|
document))
|
||||||
|
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (l)
|
(lambda (l)
|
||||||
|
|||||||
@ -183,13 +183,9 @@
|
|||||||
accounts)))))
|
accounts)))))
|
||||||
|
|
||||||
;; error condition: no accounts specified
|
;; error condition: no accounts specified
|
||||||
(let ((p (gnc:make-html-text)))
|
|
||||||
(gnc:html-text-append!
|
(gnc:html-document-add-object!
|
||||||
p
|
doc (gnc:html-make-no-account-warning)))
|
||||||
(gnc:html-markup-h2 (_ "No accounts selected"))
|
|
||||||
(gnc:html-markup-p
|
|
||||||
(_ "This report requires accounts to be selected.")))
|
|
||||||
(gnc:html-document-add-object! doc p)))
|
|
||||||
doc))
|
doc))
|
||||||
|
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
|
|||||||
@ -54,50 +54,56 @@
|
|||||||
(define (op-value section name)
|
(define (op-value section name)
|
||||||
(gnc:option-value (get-op section name)))
|
(gnc:option-value (get-op section name)))
|
||||||
|
|
||||||
(define (table-add-stock-rows table accounts to-date
|
(define (table-add-stock-rows table accounts to-date currency pricedb collector)
|
||||||
|
|
||||||
|
(define (table-add-stock-rows-internal table accounts to-date odd-row?
|
||||||
currency pricedb collector)
|
currency pricedb collector)
|
||||||
(if (null? accounts) collector
|
(if (null? accounts) collector
|
||||||
(let* ((current (car accounts))
|
(let* ((row-style (if odd-row? "normal-row" "alternate-row"))
|
||||||
(rest (cdr accounts))
|
(current (car accounts))
|
||||||
(name (gnc:account-get-name current))
|
(rest (cdr accounts))
|
||||||
(commodity (gnc:account-get-commodity current))
|
(name (gnc:account-get-name current))
|
||||||
(ticker-symbol (gnc:commodity-get-mnemonic commodity))
|
(commodity (gnc:account-get-commodity current))
|
||||||
(listing (gnc:commodity-get-namespace commodity))
|
(ticker-symbol (gnc:commodity-get-mnemonic commodity))
|
||||||
(unit-collector (gnc:account-get-comm-balance-at-date
|
(listing (gnc:commodity-get-namespace commodity))
|
||||||
current to-date #f))
|
(unit-collector (gnc:account-get-comm-balance-at-date
|
||||||
(units (cadr (unit-collector 'getpair commodity #f)))
|
current to-date #f))
|
||||||
|
(units (cadr (unit-collector 'getpair commodity #f)))
|
||||||
(price (gnc:pricedb-lookup-nearest-in-time pricedb
|
|
||||||
commodity
|
(price (gnc:pricedb-lookup-nearest-in-time pricedb
|
||||||
currency
|
commodity
|
||||||
to-date))
|
currency
|
||||||
|
to-date))
|
||||||
(price-value (if price
|
|
||||||
(gnc:price-get-value price)
|
(price-value (if price
|
||||||
(gnc:numeric-zero)))
|
(gnc:price-get-value price)
|
||||||
|
(gnc:numeric-zero)))
|
||||||
(value-num (gnc:numeric-mul
|
|
||||||
units
|
(value-num (gnc:numeric-mul
|
||||||
price-value
|
units
|
||||||
(gnc:commodity-get-fraction currency)
|
price-value
|
||||||
GNC-RND-ROUND))
|
(gnc:commodity-get-fraction currency)
|
||||||
|
GNC-RND-ROUND))
|
||||||
(value (gnc:make-gnc-monetary currency value-num)))
|
|
||||||
(collector 'add currency value-num)
|
(value (gnc:make-gnc-monetary currency value-num)))
|
||||||
(gnc:html-table-append-row!
|
(collector 'add currency value-num)
|
||||||
table
|
(gnc:html-table-append-row/markup!
|
||||||
(list name
|
table
|
||||||
ticker-symbol
|
row-style
|
||||||
listing
|
(list name
|
||||||
(gnc:make-html-table-header-cell/markup
|
ticker-symbol
|
||||||
"number-cell" (gnc:numeric-to-double units))
|
listing
|
||||||
(gnc:make-html-table-header-cell/markup
|
(gnc:make-html-table-header-cell/markup
|
||||||
"number-cell" (gnc:make-gnc-monetary currency price-value))
|
"number-cell" (gnc:numeric-to-double units))
|
||||||
(gnc:make-html-table-header-cell/markup
|
(gnc:make-html-table-header-cell/markup
|
||||||
"number-cell" value)))
|
"number-cell" (gnc:make-gnc-monetary currency price-value))
|
||||||
(gnc:price-unref price)
|
(gnc:make-html-table-header-cell/markup
|
||||||
(table-add-stock-rows
|
"number-cell" value)))
|
||||||
table rest to-date currency pricedb collector))))
|
(gnc:price-unref price)
|
||||||
|
(table-add-stock-rows-internal
|
||||||
|
table rest to-date currency (not odd-row?) pricedb collector))))
|
||||||
|
(table-add-stock-rows-internal table accounts to-date
|
||||||
|
currency #t pricedb collector))
|
||||||
|
|
||||||
;; The first thing we do is make local variables for all the specific
|
;; The first thing we do is make local variables for all the specific
|
||||||
;; options in the set of options given to the function. This set will
|
;; options in the set of options given to the function. This set will
|
||||||
@ -116,39 +122,48 @@
|
|||||||
document (sprintf #f
|
document (sprintf #f
|
||||||
(_ "Investment Portfolio Report: %s")
|
(_ "Investment Portfolio Report: %s")
|
||||||
(gnc:timepair-to-datestring to-date)))
|
(gnc:timepair-to-datestring to-date)))
|
||||||
|
(gnc:debug "accounts" accounts)
|
||||||
|
(if (not (null? accounts))
|
||||||
|
(begin
|
||||||
|
(gnc:html-table-set-col-headers!
|
||||||
|
table
|
||||||
|
(list (_ "Account")
|
||||||
|
(_ "Symbol")
|
||||||
|
(_ "Listing")
|
||||||
|
(_ "Units")
|
||||||
|
(_ "Price")
|
||||||
|
(_ "Value")))
|
||||||
|
|
||||||
|
(table-add-stock-rows
|
||||||
|
table accounts to-date currency pricedb collector)
|
||||||
|
|
||||||
|
(gnc:html-table-append-row/markup!
|
||||||
|
table
|
||||||
|
"grand-total"
|
||||||
|
(list
|
||||||
|
(gnc:make-html-table-cell/size
|
||||||
|
1 6 (gnc:make-html-text (gnc:html-markup-hr)))))
|
||||||
|
|
||||||
|
(collector
|
||||||
|
'format
|
||||||
|
(lambda (currency amount)
|
||||||
|
(gnc:html-table-append-row/markup!
|
||||||
|
table
|
||||||
|
"grand-total"
|
||||||
|
(list (gnc:make-html-table-cell/markup
|
||||||
|
"total-label-cell" (_ "Total"))
|
||||||
|
(gnc:make-html-table-cell/size/markup
|
||||||
|
1 5 "total-number-cell"
|
||||||
|
(gnc:make-gnc-monetary currency amount)))))
|
||||||
|
#f)
|
||||||
|
|
||||||
|
(gnc:html-document-add-object! document table))
|
||||||
|
|
||||||
(gnc:html-table-set-col-headers!
|
;if no accounts selected.
|
||||||
table
|
(gnc:html-document-add-object!
|
||||||
(list (_ "Account")
|
document (gnc:html-make-no-account-warning)))
|
||||||
(_ "Symbol")
|
|
||||||
(_ "Listing")
|
|
||||||
(_ "Units")
|
|
||||||
(_ "Price")
|
|
||||||
(_ "Value")))
|
|
||||||
|
|
||||||
(table-add-stock-rows
|
|
||||||
table accounts to-date currency pricedb collector)
|
|
||||||
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list
|
|
||||||
(gnc:make-html-table-cell/size
|
|
||||||
1 6 (gnc:make-html-text (gnc:html-markup-hr)))))
|
|
||||||
|
|
||||||
(collector
|
|
||||||
'format
|
|
||||||
(lambda (currency amount)
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list (gnc:make-html-table-cell/markup
|
|
||||||
"total-label-cell" (_ "Total"))
|
|
||||||
(gnc:make-html-table-cell/size/markup
|
|
||||||
1 5 "total-number-cell"
|
|
||||||
(gnc:make-gnc-monetary currency amount)))))
|
|
||||||
#f)
|
|
||||||
|
|
||||||
(gnc:html-document-add-object! document table)
|
|
||||||
|
|
||||||
document))
|
document))
|
||||||
|
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
|
|||||||
@ -199,8 +199,7 @@
|
|||||||
(gnc:split-get-balance split))))
|
(gnc:split-get-balance split))))
|
||||||
" ")))
|
" ")))
|
||||||
|
|
||||||
(gnc:html-table-append-row! table (reverse row-contents))
|
(gnc:html-table-append-row/markup! table row-style (reverse row-contents))
|
||||||
(apply set-last-row-style! (cons table (cons "tr" row-style)))
|
|
||||||
(if (and double? transaction-info? (description-col column-vector))
|
(if (and double? transaction-info? (description-col column-vector))
|
||||||
(begin
|
(begin
|
||||||
(let ((count 0))
|
(let ((count 0))
|
||||||
@ -217,8 +216,7 @@
|
|||||||
(gnc:make-html-table-cell/size
|
(gnc:make-html-table-cell/size
|
||||||
1 (- (num-columns-required column-vector) count)
|
1 (- (num-columns-required column-vector) count)
|
||||||
(gnc:transaction-get-notes parent)))
|
(gnc:transaction-get-notes parent)))
|
||||||
(gnc:html-table-append-row! table (reverse row-contents))
|
(gnc:html-table-append-row/markup! table row-style (reverse row-contents)))))
|
||||||
(apply set-last-row-style! (cons table (cons "tr" row-style))))))
|
|
||||||
split-value))
|
split-value))
|
||||||
|
|
||||||
(define (lookup-sort-key sort-option)
|
(define (lookup-sort-key sort-option)
|
||||||
@ -314,31 +312,6 @@
|
|||||||
(N_ "Display") (N_ "Totals")
|
(N_ "Display") (N_ "Totals")
|
||||||
"l" (N_ "Display the totals?") #t))
|
"l" (N_ "Display the totals?") #t))
|
||||||
|
|
||||||
(gnc:register-reg-option
|
|
||||||
(gnc:make-color-option
|
|
||||||
(N_ "Colors") (N_ "Split Odd")
|
|
||||||
"c" (N_ "Background color for odd-numbered splits (or main splits in a
|
|
||||||
multi-line report)")
|
|
||||||
(list #xff #xff #xff 0)
|
|
||||||
255
|
|
||||||
#f))
|
|
||||||
|
|
||||||
(gnc:register-reg-option
|
|
||||||
(gnc:make-color-option
|
|
||||||
(N_ "Colors") (N_ "Split Even")
|
|
||||||
"d" (N_ "Background color for even-numbered splits
|
|
||||||
(or \"other\" splits in a multi-line report)")
|
|
||||||
(list #xff #xff #xff 0)
|
|
||||||
255
|
|
||||||
#f))
|
|
||||||
|
|
||||||
(gnc:register-reg-option
|
|
||||||
(gnc:make-color-option
|
|
||||||
(N_ "Colors") (N_ "Grand Total")
|
|
||||||
"e" (N_ "Background color for total")
|
|
||||||
(list #xff #xff #xff 0)
|
|
||||||
255
|
|
||||||
#f))
|
|
||||||
|
|
||||||
(gnc:options-set-default-section gnc:*report-options* "General")
|
(gnc:options-set-default-section gnc:*report-options* "General")
|
||||||
|
|
||||||
@ -349,24 +322,7 @@
|
|||||||
(end-string (strftime "%x" (localtime (car end)))))
|
(end-string (strftime "%x" (localtime (car end)))))
|
||||||
(sprintf #f (_ "From %s To %s") begin-string end-string)))
|
(sprintf #f (_ "From %s To %s") begin-string end-string)))
|
||||||
|
|
||||||
(define (get-grand-total-style options)
|
|
||||||
(let ((bgcolor (gnc:lookup-option options
|
|
||||||
(N_ "Colors")
|
|
||||||
(N_ "Grand Total"))))
|
|
||||||
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
|
|
||||||
|
|
||||||
(define (get-odd-row-style options)
|
|
||||||
(let ((bgcolor (gnc:lookup-option options
|
|
||||||
(N_ "Colors")
|
|
||||||
(N_ "Split Odd"))))
|
|
||||||
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
|
|
||||||
|
|
||||||
(define (get-even-row-style options)
|
|
||||||
(let ((bgcolor (gnc:lookup-option options
|
|
||||||
(N_ "Colors")
|
|
||||||
(N_ "Split Even"))))
|
|
||||||
(list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor)))))
|
|
||||||
|
|
||||||
(define (make-split-table splits options
|
(define (make-split-table splits options
|
||||||
debit-string credit-string amount-string)
|
debit-string credit-string amount-string)
|
||||||
(define (opt-val section name)
|
(define (opt-val section name)
|
||||||
@ -399,8 +355,9 @@
|
|||||||
(gnc:make-html-text (gnc:html-markup-hr))))))
|
(gnc:make-html-text (gnc:html-markup-hr))))))
|
||||||
|
|
||||||
(for-each (lambda (currency)
|
(for-each (lambda (currency)
|
||||||
(gnc:html-table-append-row!
|
(gnc:html-table-append-row/markup!
|
||||||
table
|
table
|
||||||
|
subtotal-style
|
||||||
(append (cons (gnc:make-html-table-cell/markup
|
(append (cons (gnc:make-html-table-cell/markup
|
||||||
"total-label-cell" (_ "Total"))
|
"total-label-cell" (_ "Total"))
|
||||||
'())
|
'())
|
||||||
@ -412,9 +369,7 @@
|
|||||||
(gnc:numeric-negative-p
|
(gnc:numeric-negative-p
|
||||||
(gnc:gnc-monetary-amount currency)))
|
(gnc:gnc-monetary-amount currency)))
|
||||||
(gnc:monetary-neg currency)
|
(gnc:monetary-neg currency)
|
||||||
currency)))))
|
currency))))))
|
||||||
(apply set-last-row-style!
|
|
||||||
(cons table (cons "tr" subtotal-style))))
|
|
||||||
currency-totals)))
|
currency-totals)))
|
||||||
|
|
||||||
(define (add-other-split-rows split table used-columns row-style)
|
(define (add-other-split-rows split table used-columns row-style)
|
||||||
@ -436,18 +391,15 @@
|
|||||||
multi-rows?
|
multi-rows?
|
||||||
double?
|
double?
|
||||||
odd-row?
|
odd-row?
|
||||||
main-row-style
|
|
||||||
alternate-row-style
|
|
||||||
grand-total-style
|
|
||||||
total-collector)
|
total-collector)
|
||||||
(if (null? splits)
|
(if (null? splits)
|
||||||
(add-subtotal-row table used-columns
|
(add-subtotal-row table used-columns
|
||||||
total-collector grand-total-style)
|
total-collector "grand-total")
|
||||||
|
|
||||||
(let* ((current (car splits))
|
(let* ((current (car splits))
|
||||||
(current-row-style (if multi-rows? main-row-style
|
(current-row-style (if multi-rows? "normal-row"
|
||||||
(if odd-row? main-row-style
|
(if odd-row? "normal-row"
|
||||||
alternate-row-style)))
|
"alternate-row")))
|
||||||
(rest (cdr splits))
|
(rest (cdr splits))
|
||||||
(next (if (null? rest) #f
|
(next (if (null? rest) #f
|
||||||
(car rest)))
|
(car rest)))
|
||||||
@ -461,7 +413,7 @@
|
|||||||
|
|
||||||
(if multi-rows?
|
(if multi-rows?
|
||||||
(add-other-split-rows
|
(add-other-split-rows
|
||||||
current table used-columns alternate-row-style))
|
current table used-columns "alternate-row"))
|
||||||
|
|
||||||
(total-collector 'add
|
(total-collector 'add
|
||||||
(gnc:gnc-monetary-commodity split-value)
|
(gnc:gnc-monetary-commodity split-value)
|
||||||
@ -473,23 +425,14 @@
|
|||||||
width
|
width
|
||||||
multi-rows?
|
multi-rows?
|
||||||
double?
|
double?
|
||||||
(not odd-row?)
|
(not odd-row?)
|
||||||
main-row-style
|
|
||||||
alternate-row-style
|
|
||||||
grand-total-style
|
|
||||||
total-collector))))
|
total-collector))))
|
||||||
|
|
||||||
(let* ((table (gnc:make-html-table))
|
(let* ((table (gnc:make-html-table))
|
||||||
(used-columns (build-column-used options))
|
(used-columns (build-column-used options))
|
||||||
(width (num-columns-required used-columns))
|
(width (num-columns-required used-columns))
|
||||||
(multi-rows? (reg-report-journal?))
|
(multi-rows? (reg-report-journal?))
|
||||||
(double? (reg-report-double?))
|
(double? (reg-report-double?)))
|
||||||
(grand-total-style
|
|
||||||
(get-grand-total-style options))
|
|
||||||
(odd-row-style
|
|
||||||
(get-odd-row-style options))
|
|
||||||
(even-row-style
|
|
||||||
(get-even-row-style options)))
|
|
||||||
|
|
||||||
(gnc:html-table-set-col-headers!
|
(gnc:html-table-set-col-headers!
|
||||||
table
|
table
|
||||||
@ -504,9 +447,6 @@
|
|||||||
multi-rows?
|
multi-rows?
|
||||||
double?
|
double?
|
||||||
#t
|
#t
|
||||||
odd-row-style
|
|
||||||
even-row-style
|
|
||||||
grand-total-style
|
|
||||||
(gnc:make-commodity-collector))
|
(gnc:make-commodity-collector))
|
||||||
table))
|
table))
|
||||||
|
|
||||||
|
|||||||
@ -9,6 +9,7 @@
|
|||||||
(gnc:depend "report/net-barchart.scm")
|
(gnc:depend "report/net-barchart.scm")
|
||||||
(gnc:depend "report/account-summary.scm")
|
(gnc:depend "report/account-summary.scm")
|
||||||
(gnc:depend "report/average-balance.scm")
|
(gnc:depend "report/average-balance.scm")
|
||||||
|
(gnc:depend "report/average-balance-2.scm")
|
||||||
(gnc:depend "report/balance-sheet.scm")
|
(gnc:depend "report/balance-sheet.scm")
|
||||||
(gnc:depend "report/account-piecharts.scm")
|
(gnc:depend "report/account-piecharts.scm")
|
||||||
(gnc:depend "report/category-barchart.scm")
|
(gnc:depend "report/category-barchart.scm")
|
||||||
|
|||||||
@ -381,6 +381,9 @@
|
|||||||
(vector 'date
|
(vector 'date
|
||||||
(N_ "Date")
|
(N_ "Date")
|
||||||
(N_ "Sort by date"))
|
(N_ "Sort by date"))
|
||||||
|
(vector 'exact-time
|
||||||
|
(N_ "Exact Time")
|
||||||
|
(N_ "Sort by exact time"))
|
||||||
|
|
||||||
(vector 'corresponding-acc-name
|
(vector 'corresponding-acc-name
|
||||||
(N_ "Other Account Name")
|
(N_ "Other Account Name")
|
||||||
@ -434,7 +437,7 @@
|
|||||||
(and (member x subtotal-enabled) #t))
|
(and (member x subtotal-enabled) #t))
|
||||||
(gnc:option-db-set-option-selectable-by-name
|
(gnc:option-db-set-option-selectable-by-name
|
||||||
options pagename-sorting optname-prime-date-subtotal
|
options pagename-sorting optname-prime-date-subtotal
|
||||||
(equal? 'date x)))))
|
(if (member x (list 'exact-time 'date)) #t #f)))))
|
||||||
|
|
||||||
(gnc:register-trep-option
|
(gnc:register-trep-option
|
||||||
(gnc:make-simple-boolean-option
|
(gnc:make-simple-boolean-option
|
||||||
@ -471,7 +474,7 @@
|
|||||||
(and (member x subtotal-enabled) #t))
|
(and (member x subtotal-enabled) #t))
|
||||||
(gnc:option-db-set-option-selectable-by-name
|
(gnc:option-db-set-option-selectable-by-name
|
||||||
options pagename-sorting optname-sec-date-subtotal
|
options pagename-sorting optname-sec-date-subtotal
|
||||||
(equal? 'date x)))))
|
(if (member x (list 'exact-time 'date )) #t #f)))))
|
||||||
|
|
||||||
(gnc:register-trep-option
|
(gnc:register-trep-option
|
||||||
(gnc:make-simple-boolean-option
|
(gnc:make-simple-boolean-option
|
||||||
@ -783,7 +786,9 @@ and Income accounts")))))
|
|||||||
'by-account-code
|
'by-account-code
|
||||||
split-account-code-same-p
|
split-account-code-same-p
|
||||||
render-account-code-subheading))
|
render-account-code-subheading))
|
||||||
(cons 'date (vector 'by-date #f #f))
|
(cons 'exact-time (vector 'by-date #f #f))
|
||||||
|
(cons 'date (vector
|
||||||
|
'by-date-rounded #f #f))
|
||||||
(cons 'corresponding-acc-name
|
(cons 'corresponding-acc-name
|
||||||
(vector 'by-corr-account-full-name
|
(vector 'by-corr-account-full-name
|
||||||
split-same-corr-account-full-name-p
|
split-same-corr-account-full-name-p
|
||||||
@ -812,7 +817,7 @@ and Income accounts")))))
|
|||||||
comp-index date-index)
|
comp-index date-index)
|
||||||
;; The value of the sorting-key multichoice option.
|
;; The value of the sorting-key multichoice option.
|
||||||
(let ((sortkey (opt-val pagename-sorting name-sortkey)))
|
(let ((sortkey (opt-val pagename-sorting name-sortkey)))
|
||||||
(if (eq? 'date sortkey)
|
(if (member sortkey (list 'date 'exact-time))
|
||||||
;; If sorting by date, look up the value of the
|
;; If sorting by date, look up the value of the
|
||||||
;; date-subtotalling multichoice option and return the
|
;; date-subtotalling multichoice option and return the
|
||||||
;; corresponding funcs in the assoc-list.
|
;; corresponding funcs in the assoc-list.
|
||||||
@ -855,6 +860,9 @@ and Income accounts")))))
|
|||||||
(enddate (gnc:timepair-end-day-time
|
(enddate (gnc:timepair-end-day-time
|
||||||
(gnc:date-option-absolute-time
|
(gnc:date-option-absolute-time
|
||||||
(opt-val gnc:pagename-general "To"))))
|
(opt-val gnc:pagename-general "To"))))
|
||||||
|
(report-title (opt-val
|
||||||
|
gnc:pagename-general
|
||||||
|
gnc:optname-reportname))
|
||||||
(primary-key (opt-val pagename-sorting optname-prime-sortkey))
|
(primary-key (opt-val pagename-sorting optname-prime-sortkey))
|
||||||
(primary-order (opt-val pagename-sorting "Primary Sort Order"))
|
(primary-order (opt-val pagename-sorting "Primary Sort Order"))
|
||||||
(secondary-key (opt-val pagename-sorting optname-sec-sortkey))
|
(secondary-key (opt-val pagename-sorting optname-sec-sortkey))
|
||||||
@ -904,7 +912,7 @@ and Income accounts")))))
|
|||||||
optname-sec-date-subtotal))))
|
optname-sec-date-subtotal))))
|
||||||
|
|
||||||
(gnc:html-document-set-title! document
|
(gnc:html-document-set-title! document
|
||||||
(_ "Transaction Report"))
|
report-title)
|
||||||
(gnc:html-document-add-object!
|
(gnc:html-document-add-object!
|
||||||
document
|
document
|
||||||
(gnc:make-html-text
|
(gnc:make-html-text
|
||||||
@ -926,13 +934,10 @@ match the given time interval and account selection.")))
|
|||||||
(gnc:html-document-add-object! document p))))
|
(gnc:html-document-add-object! document p))))
|
||||||
|
|
||||||
;; error condition: no accounts specified
|
;; error condition: no accounts specified
|
||||||
(let ((p (gnc:make-html-text)))
|
|
||||||
(gnc:html-text-append!
|
(gnc:html-document-add-object!
|
||||||
p
|
document
|
||||||
(gnc:html-markup-h2 (_ "No accounts selected"))
|
(gnc:html-make-no-account-warning)))
|
||||||
(gnc:html-markup-p
|
|
||||||
(_ "This report requires accounts to be selected.")))
|
|
||||||
(gnc:html-document-add-object! document p)))
|
|
||||||
|
|
||||||
document))
|
document))
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user