IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

2001-05-01 Robert Graham Merkel <rgmerk@mira.net>

Browse Source 
* 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 2001-05-01 02:14:19 +00:00
parent 7a6e0a9b42
commit 9be6dfbca6
20 changed files with 3673 additions and 6334 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
ChangeLog
View File

@ -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>
* src/scm/report/net-worth-timeseries.scm,

8359
po/ja.po
View File

File diff suppressed because it is too large Load Diff

28
src/engine/Query.c
View File

@ -702,6 +702,18 @@ date_cmp_func(Timespec *t1, Timespec *t2) {
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
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;
case BY_DATE_ROUNDED:
return date_rounded_cmp_func(&(ta->date_posted), &(tb->date_posted));
break;
case BY_DATE_ENTERED:
return date_cmp_func(&(ta->date_entered), &(tb->date_entered));
break;
case BY_DATE_ENTERED_ROUNDED:
return date_rounded_cmp_func(&(ta->date_entered), &(tb->date_entered));
break;
case BY_DATE_RECONCILED:
return date_cmp_func(&(sa->date_reconciled), &(sb->date_reconciled));
break;
case BY_DATE_RECONCILED_ROUNDED:
return date_rounded_cmp_func(&(sa->date_reconciled), &(sb->date_reconciled));
break;
case BY_NUM:
/* sort on transaction number */
da = ta->num;

3
src/engine/Query.h
View File

@ -43,8 +43,11 @@ typedef enum {
typedef enum {
BY_STANDARD=1,
BY_DATE,
BY_DATE_ROUNDED,
BY_DATE_ENTERED,
BY_DATE_ENTERED_ROUNDED,
BY_DATE_RECONCILED,
BY_DATE_RECONCILED_ROUNDED,
BY_NUM,
BY_AMOUNT,
BY_MEMO,

23
src/engine/date.c
View File

@ -128,6 +128,29 @@ timespec_abs(const Timespec *t)
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

7
src/engine/date.h
View File

@ -92,6 +92,13 @@ Timespec timespec_diff(const Timespec *ta, const Timespec *tb);
*/
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);
/**

14
src/scm/date-utilities.scm
View File

@ -153,6 +153,8 @@
(define (incdate adate delta)(moddate + adate delta ))
;; Time comparison, true if t2 is later than t1
;; FIXME: RENAME THIS FUNCTION!!!!
(define (gnc:timepair-later t1 t2)
(cond ((< (car t1) (car t2)) #t)
((= (car t1) (car t2)) (< (cdr t2) (cdr t2)))
@ -163,6 +165,9 @@
(define (gnc:timepair-earlier t1 t2)
(gnc:timepair-later t2 t1))
(define (gnc:timepair-gt t1 t2)
(gnc:timepair-earlier t1 t2))
;; t1 <= t2
(define (gnc:timepair-le t1 t2)
(cond ((< (car t1) (car t2)) #t)
@ -296,15 +301,6 @@
;; given a timepair contains any time on a certain day (local time)
;; 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)
(let ((bdt (gnc:timepair->date tp)))
(set-tm:sec bdt 0)

26
src/scm/html-utilities.scm
View File

@ -393,15 +393,14 @@
;; depends on the structure of html-table-data, i.e. if those are
;; changed then this might break.
(define (remove-last-empty-row)
(if (not (null? (gnc:html-table-data table)))
(if (not (or-map
(lambda (e)
(if (gnc:html-table-cell? e)
(car (gnc:html-table-cell-data e))
e))
(car (gnc:html-table-data table))))
(gnc:html-table-remove-last-row! table))))
(if (and (not (null? (gnc:html-table-data table)))
(not (or-map
(lambda (e)
(if (gnc:html-table-cell? e)
(car (gnc:html-table-cell-data e))
e))
(car (gnc:html-table-data table)))))
(gnc:html-table-remove-last-row! table)))
;; Wrapper for gnc:html-acct-table-row-helper!
(define (add-row-helper!
@ -654,3 +653,12 @@
(_ "Exchange rates")))))))
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))

2
src/scm/report-utilities.scm
View File

@ -222,6 +222,7 @@
(if (< amount min)
(set! min amount))
(set! totalitems (+ 1 totalitems))))))
(getnumitems (lambda () totalitems))
(gettotal (lambda () value))
(getaverage (lambda () (/ value totalitems)))
(getmax (lambda () max))
@ -236,6 +237,7 @@
('add (adder value))
('total (gettotal))
('average (getaverage))
('numitems (getnumitems))
('getmax (getmax))
('getmin (getmin))
('reset (reset-all))

1
src/scm/report/Makefile.am
View File

@ -5,6 +5,7 @@ gncscm_DATA = \
account-piecharts.scm \
account-summary.scm \
average-balance.scm \
average-balance-2.scm \
balance-sheet.scm \
category-barchart.scm \
hello-world.scm \

265
src/scm/report/account-piecharts.scm
View File

@ -251,138 +251,145 @@ balance at a given time"))
(filter show-acct? accts))))
;; 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
;; and add a link to a new pie report with just those
;; accounts
(if (> (length combined) max-slices)
(let* ((start (take combined (- max-slices 1)))
(finish (drop combined (- max-slices 1)))
(sum (apply + (unzip1 finish))))
(if (not (null? accounts))
(begin
(set! combined
(append start
(list (list sum (_ "Other")))))
(let ((options (gnc:make-report-options reportname))
(id #f))
;; now copy all the options
(gnc:options-copy-values (gnc:report-options report-obj)
options)
;; and set the destination accounts
(gnc:option-set-value
(gnc:lookup-option options gnc:pagename-accounts
optname-accounts)
(map cadr finish))
(set! id (gnc:make-report reportname options))
(gnc:report-add-child-by-id! report-obj id)
(gnc:report-set-parent! (gnc:find-report id) report-obj)
;; set the URL.
(set! other-anchor (gnc:report-anchor-text id)))))
;; set the URLs; the slices are links to other reports
(let
((urls
(map
(lambda (pair)
(if (string? (cadr pair))
other-anchor
(let* ((acct (cadr pair))
(subaccts
(gnc:account-get-immediate-subaccounts acct)))
(if (null? subaccts)
;; if leaf-account, make this an anchor
;; to the register.
(gnc:account-anchor-text (cadr pair))
;; if non-leaf account, make this a link
;; to another report which is run on the
;; immediate subaccounts of this account
;; (and including this account).
(gnc:make-report-anchor
reportname
report-obj
(list
(list gnc:pagename-accounts optname-accounts
(cons acct subaccts))
(list gnc:pagename-accounts optname-levels
(+ 1 tree-depth))
(list gnc:pagename-general
gnc:optname-reportname
((if show-fullname?
gnc:account-get-full-name
gnc:account-get-name) acct))))))))
combined)))
(gnc:html-piechart-set-button-1-slice-urls!
chart urls)
(gnc:html-piechart-set-button-1-legend-urls!
chart urls))
(gnc:html-piechart-set-title!
chart report-title)
(gnc:html-piechart-set-width! chart width)
(gnc:html-piechart-set-height! chart height)
(gnc:html-piechart-set-data! chart (unzip1 combined))
(gnc:html-piechart-set-colors! chart
(gnc:assign-colors (length combined)))
(gnc:html-piechart-set-subtitle!
chart (string-append
(if do-intervals?
(sprintf #f
(_ "%s to %s")
(gnc:timepair-to-datestring from-date-tp)
(gnc:timepair-to-datestring to-date-tp))
(sprintf #f
(_ "Balance at %s")
(gnc:timepair-to-datestring to-date-tp)))
(if show-total?
(let ((total (apply + (unzip1 combined))))
(sprintf #f ": %s"
(gnc:amount->string total print-info)))
"")))
(let ((legend-labels
(map
(lambda (pair)
(string-append
(if (string? (cadr pair))
(cadr pair)
((if show-fullname?
gnc:account-get-full-name
gnc:account-get-name) (cadr pair)))
(if show-total?
(string-append
" - "
(gnc:amount->string (car pair) print-info))
"")))
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 \
(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
;; and add a link to a new pie report with just those
;; 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
(append start
(list (list sum (_ "Other")))))
(let ((options (gnc:make-report-options reportname))
(id #f))
;; now copy all the options
(gnc:options-copy-values (gnc:report-options report-obj)
options)
;; and set the destination accounts
(gnc:option-set-value
(gnc:lookup-option options gnc:pagename-accounts
optname-accounts)
(map cadr finish))
(set! id (gnc:make-report reportname options))
(gnc:report-add-child-by-id! report-obj id)
(gnc:report-set-parent! (gnc:find-report id) report-obj)
;; set the URL.
(set! other-anchor (gnc:report-anchor-text id)))))
;; set the URLs; the slices are links to other reports
(let
((urls
(map
(lambda (pair)
(if (string? (cadr pair))
other-anchor
(let* ((acct (cadr pair))
(subaccts
(gnc:account-get-immediate-subaccounts acct)))
(if (null? subaccts)
;; if leaf-account, make this an anchor
;; to the register.
(gnc:account-anchor-text (cadr pair))
;; if non-leaf account, make this a link
;; to another report which is run on the
;; immediate subaccounts of this account
;; (and including this account).
(gnc:make-report-anchor
reportname
report-obj
(list
(list gnc:pagename-accounts optname-accounts
(cons acct subaccts))
(list gnc:pagename-accounts optname-levels
(+ 1 tree-depth))
(list gnc:pagename-general
gnc:optname-reportname
((if show-fullname?
gnc:account-get-full-name
gnc:account-get-name) acct))))))))
combined)))
(gnc:html-piechart-set-button-1-slice-urls!
chart urls)
(gnc:html-piechart-set-button-1-legend-urls!
chart urls))
(gnc:html-piechart-set-title!
chart report-title)
(gnc:html-piechart-set-width! chart width)
(gnc:html-piechart-set-height! chart height)
(gnc:html-piechart-set-data! chart (unzip1 combined))
(gnc:html-piechart-set-colors! chart
(gnc:assign-colors (length combined)))
(gnc:html-piechart-set-subtitle!
chart (string-append
(if do-intervals?
(sprintf #f
(_ "%s to %s")
(gnc:timepair-to-datestring from-date-tp)
(gnc:timepair-to-datestring to-date-tp))
(sprintf #f
(_ "Balance at %s")
(gnc:timepair-to-datestring to-date-tp)))
(if show-total?
(let ((total (apply + (unzip1 combined))))
(sprintf #f ": %s"
(gnc:amount->string total print-info)))
"")))
(let ((legend-labels
(map
(lambda (pair)
(string-append
(if (string? (cadr pair))
(cadr pair)
((if show-fullname?
gnc:account-get-full-name
gnc:account-get-name) (cadr pair)))
(if show-total?
(string-append
" - "
(gnc:amount->string (car pair) print-info))
"")))
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 \
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. \
Dragging with right button lets you rotate the pie. ")
(gnc:html-markup-p "Remove this text by disabling \
the global Preference \"Display Tip of the Day\"."))))
(gnc:html-markup-p "Remove this text by disabling \
the global Preference \"Display Tip of the Day\".")))))
document)))
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning)))
document)))
(for-each
(lambda (l)
(gnc:define-report
@ -390,10 +397,10 @@ the global Preference \"Display Tip of the Day\"."))))
'name (car l)
'menu-path (if (caddr l)
(list gnc:menuname-income-expense)
(list gnc:menuname-asset-liability))
'menu-name (cadddr l)
'menu-tip (car (cddddr l))
'options-generator (lambda () (options-generator (cadr l)
(list gnc:menuname-asset-liability))
'menu-name (cadddr l)
'menu-tip (car (cddddr l))
'options-generator (lambda () (options-generator (cadr l)
(caddr l)))
'renderer (lambda (report-obj)
(piechart-renderer report-obj

10
src/scm/report/account-summary.scm
View File

@ -171,14 +171,8 @@
report-currency exchange-fn accounts)));;)
;; error condition: no accounts specified
(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.")))
(gnc:html-document-add-object! doc p)))
doc))
(gnc:html-document-add-object! doc (gnc:html-make-no-account-warning))))
doc)
(gnc:define-report
'version 1

443
src/scm/report/average-balance-2.scm Normal file
View 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))

10
src/scm/report/balance-sheet.scm
View File

@ -325,13 +325,9 @@
;; error condition: no accounts specified
(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.")))
(gnc:html-document-add-object! doc p)))
(gnc:html-document-add-object!
doc (gnc:html-make-no-account-warning)))
doc))
(gnc:define-report

496
src/scm/report/category-barchart.scm
View File

@ -191,255 +191,265 @@ developing over time"))
(define (show-acct? a)
(member a accounts))
;; Define more helper variables.
(let* ((exchange-alist (gnc:make-exchange-alist
report-currency to-date-tp))
(exchange-fn (gnc:make-exchange-function exchange-alist))
(tree-depth (if (equal? account-levels 'all)
(gnc:get-current-group-depth)
account-levels))
;; This is the list of date intervals to calculate.
(dates-list (if do-intervals?
(gnc:make-date-interval-list
(gnc:timepair-start-day-time from-date-tp)
(gnc:timepair-end-day-time to-date-tp)
(eval interval))
(gnc:make-date-list
(gnc:timepair-end-day-time from-date-tp)
(gnc:timepair-end-day-time to-date-tp)
(eval interval))))
;; Here the date strings for the x-axis labels are
;; created.
(date-string-list
(map (lambda (date-list-item)
(gnc:timepair-to-datestring
(if do-intervals?
(car date-list-item)
date-list-item)))
dates-list))
(other-anchor "")
(all-data '()))
;; Converts a commodity-collector into one single double
;; number, depending on the report currency and the
;; exchange-alist calculated above. Returns a double.
(define (collector->double c)
;; Future improvement: Let the user choose which kind of
;; currency combining she want to be done.
(gnc:numeric-to-double
(gnc:gnc-monetary-amount
(gnc:sum-collector-commodity
c report-currency
exchange-fn))))
;; Calculates the net balance (profit or loss) of an account in
;; the given time interval. date-list-entry is a pair containing
;; the start- and end-date of that interval. If subacct?==#t,
;; the subaccount's balances are included as well. Returns a
;; double, exchanged into the report-currency by the above
;; conversion function, and possibly with reversed sign.
(define (get-balance account date-list-entry subacct?)
((if (gnc:account-reverse-balance? account)
- +)
(collector->double
(if do-intervals?
(gnc:account-get-comm-balance-interval
account
(car date-list-entry)
(cadr date-list-entry) subacct?)
(gnc:account-get-comm-balance-at-date
account date-list-entry subacct?)))))
;; Creates the <balance-list> to be used in the function
;; below.
(define (account->balance-list account subacct?)
(map
(lambda (d) (get-balance account d subacct?))
dates-list))
;; Calculates all account's balances. Returns a list of pairs:
;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
;; (Gifts (12.3 14.5))), where each element of <balance-list>
;; is the balance corresponding to one element in
;; <dates-list>.
;;
;; If current-depth >= tree-depth, then the balances are
;; calculated *with* subaccount's balances. Else only the
;; current account is regarded. Note: All accounts in accts
;; and all their subaccounts are processed, but a balances is
;; calculated and returned *only* for those accounts where
;; show-acct? is true. This is necessary because otherwise we
;; would forget an account that is selected but not its
;; parent.
(define (traverse-accounts current-depth accts)
(if (< current-depth tree-depth)
(let ((res '()))
(for-each
(lambda (a)
(begin
(if (show-acct? a)
(set! res
(cons (list a (account->balance-list a #f))
res)))
(set! res (append
(traverse-accounts
(+ 1 current-depth)
(gnc:account-get-immediate-subaccounts a))
res))))
accts)
res)
;; else (i.e. current-depth == tree-depth)
(map
(lambda (a)
(list a (account->balance-list a #t)))
(filter show-acct? accts))))
;; Sort the account list according to the account code field.
(set! all-data (sort
(filter (lambda (l)
(not (= 0.0 (apply + (cadr l)))))
(traverse-accounts 1 topl-accounts))
(lambda (a b)
(string<? (gnc:account-get-code (car a))
(gnc:account-get-code (car b))))))
;; Or rather sort by total amount?
;;(< (apply + (cadr a))
;; (apply + (cadr b))))))
;; Other sort criteria: max. amount, standard deviation of amount,
;; min. amount; ascending, descending. FIXME: Add user options to
;; choose sorting.
;;(warn "all-data" all-data)
;; Set chart title, subtitle etc.
(gnc:html-barchart-set-title! chart report-title)
(gnc:html-barchart-set-subtitle!
chart (sprintf #f
(if do-intervals?
(_ "%s to %s")
(_ "Balances %s to %s"))
(gnc:timepair-to-datestring from-date-tp)
(gnc:timepair-to-datestring to-date-tp)))
(gnc:html-barchart-set-width! chart width)
(gnc:html-barchart-set-height! chart height)
;; row labels etc.
(gnc:html-barchart-set-row-labels! chart date-string-list)
;; FIXME: why doesn't the y-axis label get printed?!?
(gnc:html-barchart-set-y-axis-label!
chart (gnc:commodity-get-mnemonic report-currency))
(gnc:html-barchart-set-row-labels-rotated?! chart #t)
(gnc:html-barchart-set-stacked?! chart stacked?)
;; If this is a stacked barchart, then reverse the legend.
(gnc:html-barchart-set-legend-reversed?! chart stacked?)
;; If we have too many categories, we sum them into a new
;; 'other' category and add a link to a new report with just
;; those accounts.
(if (> (length all-data) max-slices)
(let* ((start (take all-data (- max-slices 1)))
(finish (drop all-data (- max-slices 1)))
(other-sum (map
(lambda (l) (apply + l))
(apply zip (map cadr finish)))))
(set! all-data
(append start
(list (list (_ "Other") other-sum))))
(let* ((options (gnc:make-report-options reportname))
(id #f))
;; now copy all the options
(gnc:options-copy-values
(gnc:report-options report-obj) options)
;; and set the destination accounts
(gnc:option-set-value
(gnc:lookup-option options gnc:pagename-accounts
optname-accounts)
(map car finish))
;; Set the URL to point to this report.
(set! id (gnc:make-report reportname options))
(gnc:report-add-child-by-id! report-obj id)
(gnc:report-set-parent! (gnc:find-report id) report-obj)
(set! other-anchor (gnc:report-anchor-text id)))))
;; This adds the data. Note the apply-zip stuff: This
;; transposes the data, i.e. swaps rows and columns. Pretty
;; cool, eh? Courtesy of dave_p.
(if (not (null? all-data))
(gnc:html-barchart-set-data! chart
(apply zip (map cadr all-data))))
;; Labels and colors
(gnc:html-barchart-set-col-labels!
chart (map (lambda (pair)
(gnc:debug accounts)
(if (not (null? accounts))
;; Define more helper variables.
(let* ((exchange-alist (gnc:make-exchange-alist
report-currency to-date-tp))
(exchange-fn (gnc:make-exchange-function exchange-alist))
(tree-depth (if (equal? account-levels 'all)
(gnc:get-current-group-depth)
account-levels))
;; This is the list of date intervals to calculate.
(dates-list (if do-intervals?
(gnc:make-date-interval-list
(gnc:timepair-start-day-time from-date-tp)
(gnc:timepair-end-day-time to-date-tp)
(eval interval))
(gnc:make-date-list
(gnc:timepair-end-day-time from-date-tp)
(gnc:timepair-end-day-time to-date-tp)
(eval interval))))
;; Here the date strings for the x-axis labels are
;; created.
(date-string-list
(map (lambda (date-list-item)
(gnc:timepair-to-datestring
(if do-intervals?
(car date-list-item)
date-list-item)))
dates-list))
(other-anchor "")
(all-data '()))
;; Converts a commodity-collector into one single double
;; number, depending on the report currency and the
;; exchange-alist calculated above. Returns a double.
(define (collector->double c)
;; Future improvement: Let the user choose which kind of
;; currency combining she want to be done.
(gnc:numeric-to-double
(gnc:gnc-monetary-amount
(gnc:sum-collector-commodity
c report-currency
exchange-fn))))
;; Calculates the net balance (profit or loss) of an account in
;; the given time interval. date-list-entry is a pair containing
;; the start- and end-date of that interval. If subacct?==#t,
;; the subaccount's balances are included as well. Returns a
;; double, exchanged into the report-currency by the above
;; conversion function, and possibly with reversed sign.
(define (get-balance account date-list-entry subacct?)
((if (gnc:account-reverse-balance? account)
- +)
(collector->double
(if do-intervals?
(gnc:account-get-comm-balance-interval
account
(car date-list-entry)
(cadr date-list-entry) subacct?)
(gnc:account-get-comm-balance-at-date
account date-list-entry subacct?)))))
;; Creates the <balance-list> to be used in the function
;; below.
(define (account->balance-list account subacct?)
(map
(lambda (d) (get-balance account d subacct?))
dates-list))
;; Calculates all account's balances. Returns a list of pairs:
;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
;; (Gifts (12.3 14.5))), where each element of <balance-list>
;; is the balance corresponding to one element in
;; <dates-list>.
;;
;; If current-depth >= tree-depth, then the balances are
;; calculated *with* subaccount's balances. Else only the
;; current account is regarded. Note: All accounts in accts
;; and all their subaccounts are processed, but a balances is
;; calculated and returned *only* for those accounts where
;; show-acct? is true. This is necessary because otherwise we
;; would forget an account that is selected but not its
;; parent.
(define (traverse-accounts current-depth accts)
(if (< current-depth tree-depth)
(let ((res '()))
(for-each
(lambda (a)
(begin
(if (show-acct? a)
(set! res
(cons (list a (account->balance-list a #f))
res)))
(set! res (append
(traverse-accounts
(+ 1 current-depth)
(gnc:account-get-immediate-subaccounts a))
res))))
accts)
res)
;; else (i.e. current-depth == tree-depth)
(map
(lambda (a)
(list a (account->balance-list a #t)))
(filter show-acct? accts))))
;; Sort the account list according to the account code field.
(set! all-data (sort
(filter (lambda (l)
(not (= 0.0 (apply + (cadr l)))))
(traverse-accounts 1 topl-accounts))
(lambda (a b)
(string<? (gnc:account-get-code (car a))
(gnc:account-get-code (car b))))))
;; Or rather sort by total amount?
;;(< (apply + (cadr a))
;; (apply + (cadr b))))))
;; Other sort criteria: max. amount, standard deviation of amount,
;; min. amount; ascending, descending. FIXME: Add user options to
;; choose sorting.
;;(warn "all-data" all-data)
;; Set chart title, subtitle etc.
(gnc:html-barchart-set-title! chart report-title)
(gnc:html-barchart-set-subtitle!
chart (sprintf #f
(if do-intervals?
(_ "%s to %s")
(_ "Balances %s to %s"))
(gnc:timepair-to-datestring from-date-tp)
(gnc:timepair-to-datestring to-date-tp)))
(gnc:html-barchart-set-width! chart width)
(gnc:html-barchart-set-height! chart height)
;; row labels etc.
(gnc:html-barchart-set-row-labels! chart date-string-list)
;; FIXME: why doesn't the y-axis label get printed?!?
(gnc:html-barchart-set-y-axis-label!
chart (gnc:commodity-get-mnemonic report-currency))
(gnc:html-barchart-set-row-labels-rotated?! chart #t)
(gnc:html-barchart-set-stacked?! chart stacked?)
;; If this is a stacked barchart, then reverse the legend.
(gnc:html-barchart-set-legend-reversed?! chart stacked?)
;; If we have too many categories, we sum them into a new
;; 'other' category and add a link to a new report with just
;; those accounts.
(if (> (length all-data) max-slices)
(let* ((start (take all-data (- max-slices 1)))
(finish (drop all-data (- max-slices 1)))
(other-sum (map
(lambda (l) (apply + l))
(apply zip (map cadr finish)))))
(set! all-data
(append start
(list (list (_ "Other") other-sum))))
(let* ((options (gnc:make-report-options reportname))
(id #f))
;; now copy all the options
(gnc:options-copy-values
(gnc:report-options report-obj) options)
;; and set the destination accounts
(gnc:option-set-value
(gnc:lookup-option options gnc:pagename-accounts
optname-accounts)
(map car finish))
;; Set the URL to point to this report.
(set! id (gnc:make-report reportname options))
(gnc:report-add-child-by-id! report-obj id)
(gnc:report-set-parent! (gnc:find-report id) report-obj)
(set! other-anchor (gnc:report-anchor-text id)))))
;; This adds the data. Note the apply-zip stuff: This
;; transposes the data, i.e. swaps rows and columns. Pretty
;; cool, eh? Courtesy of dave_p.
(if (not (null? all-data))
(gnc:html-barchart-set-data! chart
(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))
(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))
other-anchor
(let* ((acct (car pair))
(subaccts
(gnc:account-get-immediate-subaccounts acct)))
(if (null? subaccts)
;; if leaf-account, make this an anchor
;; to the register.
(gnc:account-anchor-text acct)
;; if non-leaf account, make this a link
;; to another report which is run on the
;; immediate subaccounts of this account
;; (and including this account).
(gnc:make-report-anchor
reportname
report-obj
(list
(list gnc:pagename-accounts optname-accounts
(cons acct subaccts))
(list gnc:pagename-accounts optname-levels
(+ 1 tree-depth))
(list gnc:pagename-general
gnc:optname-reportname
((if show-fullname?
gnc:account-get-full-name
gnc:account-get-name) acct))))))))
all-data)))
(gnc:html-barchart-set-button-1-bar-urls! chart (append urls urls))
;; 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 \
other-anchor
(let* ((acct (car pair))
(subaccts
(gnc:account-get-immediate-subaccounts acct)))
(if (null? subaccts)
;; if leaf-account, make this an anchor
;; to the register.
(gnc:account-anchor-text acct)
;; if non-leaf account, make this a link
;; to another report which is run on the
;; immediate subaccounts of this account
;; (and including this account).
(gnc:make-report-anchor
reportname
report-obj
(list
(list gnc:pagename-accounts optname-accounts
(cons acct subaccts))
(list gnc:pagename-accounts optname-levels
(+ 1 tree-depth))
(list gnc:pagename-general
gnc:optname-reportname
((if show-fullname?
gnc:account-get-full-name
gnc:account-get-name) acct))))))))
all-data)))
(gnc:html-barchart-set-button-1-bar-urls! chart (append urls urls))
;; 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 \
should upgrade Guppi to version 0.35.4 or, \
if that isn't out yet, use the Guppi CVS version.")
(gnc:html-markup-p
"Double-click on any legend box or any bar opens \
(gnc:html-markup-p
"Double-click on any legend box or any bar opens \
another barchart report with the subaccounts of that account or, \
if that account doesn't have subaccounts, the register for the account.")
(gnc:html-markup-p "Remove this text by disabling \
the global Preference \"Display Tip of the Day\"."))))
document)))
(gnc:html-markup-p "Remove this text by disabling \
the global Preference \"Display Tip of the Day\".")))))
;; else if no accounts selected
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning)))
document))
(for-each
(lambda (l)

10
src/scm/report/pnl.scm
View File

@ -183,13 +183,9 @@
accounts)))))
;; error condition: no accounts specified
(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.")))
(gnc:html-document-add-object! doc p)))
(gnc:html-document-add-object!
doc (gnc:html-make-no-account-warning)))
doc))
(gnc:define-report

165
src/scm/report/portfolio.scm
View File

@ -54,50 +54,56 @@
(define (op-value 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)
(if (null? accounts) collector
(let* ((current (car accounts))
(rest (cdr accounts))
(name (gnc:account-get-name current))
(commodity (gnc:account-get-commodity current))
(ticker-symbol (gnc:commodity-get-mnemonic commodity))
(listing (gnc:commodity-get-namespace commodity))
(unit-collector (gnc:account-get-comm-balance-at-date
current to-date #f))
(units (cadr (unit-collector 'getpair commodity #f)))
(price (gnc:pricedb-lookup-nearest-in-time pricedb
commodity
currency
to-date))
(price-value (if price
(gnc:price-get-value price)
(gnc:numeric-zero)))
(value-num (gnc:numeric-mul
units
price-value
(gnc:commodity-get-fraction currency)
GNC-RND-ROUND))
(value (gnc:make-gnc-monetary currency value-num)))
(collector 'add currency value-num)
(gnc:html-table-append-row!
table
(list name
ticker-symbol
listing
(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:numeric-to-double units))
(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:make-gnc-monetary currency price-value))
(gnc:make-html-table-header-cell/markup
"number-cell" value)))
(gnc:price-unref price)
(table-add-stock-rows
table rest to-date currency pricedb collector))))
(if (null? accounts) collector
(let* ((row-style (if odd-row? "normal-row" "alternate-row"))
(current (car accounts))
(rest (cdr accounts))
(name (gnc:account-get-name current))
(commodity (gnc:account-get-commodity current))
(ticker-symbol (gnc:commodity-get-mnemonic commodity))
(listing (gnc:commodity-get-namespace commodity))
(unit-collector (gnc:account-get-comm-balance-at-date
current to-date #f))
(units (cadr (unit-collector 'getpair commodity #f)))
(price (gnc:pricedb-lookup-nearest-in-time pricedb
commodity
currency
to-date))
(price-value (if price
(gnc:price-get-value price)
(gnc:numeric-zero)))
(value-num (gnc:numeric-mul
units
price-value
(gnc:commodity-get-fraction currency)
GNC-RND-ROUND))
(value (gnc:make-gnc-monetary currency value-num)))
(collector 'add currency value-num)
(gnc:html-table-append-row/markup!
table
row-style
(list name
ticker-symbol
listing
(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:numeric-to-double units))
(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:make-gnc-monetary currency price-value))
(gnc:make-html-table-header-cell/markup
"number-cell" value)))
(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
;; options in the set of options given to the function. This set will
@ -116,39 +122,48 @@
document (sprintf #f
(_ "Investment Portfolio Report: %s")
(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!
table
(list (_ "Account")
(_ "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)
;if no accounts selected.
(gnc:html-document-add-object!
document (gnc:html-make-no-account-warning)))
document))
(gnc:define-report

86
src/scm/report/register.scm
View File

@ -199,8 +199,7 @@
(gnc:split-get-balance split))))
" ")))
(gnc:html-table-append-row! table (reverse row-contents))
(apply set-last-row-style! (cons table (cons "tr" row-style)))
(gnc:html-table-append-row/markup! table row-style (reverse row-contents))
(if (and double? transaction-info? (description-col column-vector))
(begin
(let ((count 0))
@ -217,8 +216,7 @@
(gnc:make-html-table-cell/size
1 (- (num-columns-required column-vector) count)
(gnc:transaction-get-notes parent)))
(gnc:html-table-append-row! table (reverse row-contents))
(apply set-last-row-style! (cons table (cons "tr" row-style))))))
(gnc:html-table-append-row/markup! table row-style (reverse row-contents)))))
split-value))
(define (lookup-sort-key sort-option)
@ -314,31 +312,6 @@
(N_ "Display") (N_ "Totals")
"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")
@ -349,24 +322,7 @@
(end-string (strftime "%x" (localtime (car end)))))
(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
debit-string credit-string amount-string)
(define (opt-val section name)
@ -399,8 +355,9 @@
(gnc:make-html-text (gnc:html-markup-hr))))))
(for-each (lambda (currency)
(gnc:html-table-append-row!
(gnc:html-table-append-row/markup!
table
subtotal-style
(append (cons (gnc:make-html-table-cell/markup
"total-label-cell" (_ "Total"))
'())
@ -412,9 +369,7 @@
(gnc:numeric-negative-p
(gnc:gnc-monetary-amount currency)))
(gnc:monetary-neg currency)
currency)))))
(apply set-last-row-style!
(cons table (cons "tr" subtotal-style))))
currency))))))
currency-totals)))
(define (add-other-split-rows split table used-columns row-style)
@ -436,18 +391,15 @@
multi-rows?
double?
odd-row?
main-row-style
alternate-row-style
grand-total-style
total-collector)
(if (null? splits)
(add-subtotal-row table used-columns
total-collector grand-total-style)
total-collector "grand-total")
(let* ((current (car splits))
(current-row-style (if multi-rows? main-row-style
(if odd-row? main-row-style
alternate-row-style)))
(current-row-style (if multi-rows? "normal-row"
(if odd-row? "normal-row"
"alternate-row")))
(rest (cdr splits))
(next (if (null? rest) #f
(car rest)))
@ -461,7 +413,7 @@
(if multi-rows?
(add-other-split-rows
current table used-columns alternate-row-style))
current table used-columns "alternate-row"))
(total-collector 'add
(gnc:gnc-monetary-commodity split-value)
@ -473,23 +425,14 @@
width
multi-rows?
double?
(not odd-row?)
main-row-style
alternate-row-style
grand-total-style
(not odd-row?)
total-collector))))
(let* ((table (gnc:make-html-table))
(used-columns (build-column-used options))
(width (num-columns-required used-columns))
(multi-rows? (reg-report-journal?))
(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)))
(double? (reg-report-double?)))
(gnc:html-table-set-col-headers!
table
@ -504,9 +447,6 @@
multi-rows?
double?
#t
odd-row-style
even-row-style
grand-total-style
(gnc:make-commodity-collector))
table))

1
src/scm/report/report-list.scm
View File

@ -9,6 +9,7 @@
(gnc:depend "report/net-barchart.scm")
(gnc:depend "report/account-summary.scm")
(gnc:depend "report/average-balance.scm")
(gnc:depend "report/average-balance-2.scm")
(gnc:depend "report/balance-sheet.scm")
(gnc:depend "report/account-piecharts.scm")
(gnc:depend "report/category-barchart.scm")

29
src/scm/report/transaction-report.scm
View File

@ -381,6 +381,9 @@
(vector 'date
(N_ "Date")
(N_ "Sort by date"))
(vector 'exact-time
(N_ "Exact Time")
(N_ "Sort by exact time"))
(vector 'corresponding-acc-name
(N_ "Other Account Name")
@ -434,7 +437,7 @@
(and (member x subtotal-enabled) #t))
(gnc:option-db-set-option-selectable-by-name
options pagename-sorting optname-prime-date-subtotal
(equal? 'date x)))))
(if (member x (list 'exact-time 'date)) #t #f)))))
(gnc:register-trep-option
(gnc:make-simple-boolean-option
@ -471,7 +474,7 @@
(and (member x subtotal-enabled) #t))
(gnc:option-db-set-option-selectable-by-name
options pagename-sorting optname-sec-date-subtotal
(equal? 'date x)))))
(if (member x (list 'exact-time 'date )) #t #f)))))
(gnc:register-trep-option
(gnc:make-simple-boolean-option
@ -783,7 +786,9 @@ and Income accounts")))))
'by-account-code
split-account-code-same-p
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
(vector 'by-corr-account-full-name
split-same-corr-account-full-name-p
@ -812,7 +817,7 @@ and Income accounts")))))
comp-index date-index)
;; The value of the sorting-key multichoice option.
(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
;; date-subtotalling multichoice option and return the
;; corresponding funcs in the assoc-list.
@ -855,6 +860,9 @@ and Income accounts")))))
(enddate (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(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-order (opt-val pagename-sorting "Primary Sort Order"))
(secondary-key (opt-val pagename-sorting optname-sec-sortkey))
@ -904,7 +912,7 @@ and Income accounts")))))
optname-sec-date-subtotal))))
(gnc:html-document-set-title! document
(_ "Transaction Report"))
report-title)
(gnc:html-document-add-object!
document
(gnc:make-html-text
@ -926,13 +934,10 @@ match the given time interval and account selection.")))
(gnc:html-document-add-object! document p))))
;; error condition: no accounts specified
(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.")))
(gnc:html-document-add-object! document p)))
(gnc:html-document-add-object!
document
(gnc:html-make-no-account-warning)))
document))