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

*** empty log message ***

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2106 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-03-23 11:31:40 +00:00
parent 465790c218
commit 8849492dc4
17 changed files with 4089 additions and 3586 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
ChangeLog
View File

@ -1,7 +1,20 @@
2000-03-23 Dave Peticolas <peticola@cs.ucdavis.edu>
* src/scm/report/average-balance.scm: fixed many things and i18n'd
the report.
* src/engine/util.c (PrintAmt): always use '.' as the decimal point
coming from sprintf.
2000-03-22 Dave Peticolas <peticola@cs.ucdavis.edu>
* src/scm/prefs.scm: set the default currency code using the
wrapped C function in util.c below.
* src/engine/util.c (xaccSPrintAmount): add a PRTNMN flag for
printing non-monetary values.
(gnc_locale_default_currency): return the currency code for the
current locale.
* src/register/splitreg.c (xaccInitSplitRegister): update for
changes to the price cell api.

1363
po/de.po
View File

File diff suppressed because it is too large Load Diff

1414
po/en_GB.po
View File

File diff suppressed because it is too large Load Diff

1259
po/fr.po
View File

File diff suppressed because it is too large Load Diff

1527
po/gnucash.pot
View File

File diff suppressed because it is too large Load Diff

12
po/guile_strings.txt
View File

@ -31,6 +31,7 @@ _("The date option is %s.")
_("Account Transactions")
_("UK")
_("Sort by date")
_("Report for %s and all subaccounts.")
_("Account types to display")
_("Gain And Loss")
_("Double click expands parent accounts")
@ -39,6 +40,7 @@ _("Boolean Option")
_("Income-Salary-Taxable")
_("Testing")
_("US-style: mm/dd/yyyy")
_("You have not selected an account.")
_("By default, show every transaction in an account.")
_("Amount")
_("Multi Line")
@ -53,6 +55,7 @@ _("Show icons only")
_("The default background color for odd rows in single mode")
_("Auto Single")
_("Display the Hello, World report.")
_("Gain")
_("Hello Again")
_("This page shows your profits and losses.")
_("Show Vertical Borders")
@ -75,6 +78,7 @@ _("The boolean option is %s.")
_("Multi mode default transaction background")
_("Double clicking on an account with children expands the account instead of opening a register.")
_("The background color for the active transaction in single mode")
_("Loss")
_("Credit Accounts")
_("Sort by description")
_("largest to smallest, latest to earliest")
@ -82,13 +86,14 @@ _("Secondary Key")
_("Save window sizes and positions.")
_("Bank")
_("Number Option")
_("Report for %s.")
_("Reverse Income and Expense Accounts")
_("Europe")
_("Add in sub-accounts of each selected")
_("Day")
_("This is for testing. Your reports probably shouldn't have an option like this.")
_("Average")
_("The items selected in the list option are:")
_("Average")
_("A_ccount Balance Tracker")
_("From")
_("Start of reporting period")
@ -106,6 +111,7 @@ _("Hello, World!")
_("ISO")
_("A report useful for balancing the budget")
_("Date Format Display")
_("Ending")
_("Reversed-balance account types")
_("Show transactions on two lines with more information")
_("Account fields to display")
@ -182,9 +188,11 @@ _("Order of primary sorting")
_("Default Currency For New Accounts")
_("Sort by this criterion second")
_("true")
_("Period Ending")
_("Income.Salary.Taxable")
_("Income")
_("The Ugly")
_("Max")
_("By default, show horizontal borders on the cells.")
_(": (Colon)")
_("By default, show vertical borders on the cells.")
@ -259,10 +267,12 @@ _("Display the Account Transactions report.")
_("Net")
_("Have a nice day!")
_("This is a list option")
_("Min")
_("Order of Secondary sorting")
_("Help for second option")
_("reg_stock_win_width")
_("Report items up to and including this date")
_("Beginning")
_("For help on writing reports, or to contribute your brand new, totally cool report, consult the mailing list %s. For details on subscribing to that list, see %s.")
_("The background color for an active transaction in multi-line mode and the auto modes")
_("This is a multi choice option.")

1259
po/sv.po
View File

File diff suppressed because it is too large Load Diff

16
src/engine/date.c
View File

@ -2,7 +2,7 @@
* date.c -- utility functions to handle the date (adjusting, get *
* current date, etc.) for xacc (X-Accountant) *
* Copyright (C) 1997 Robin D. Clark *
* Copyright (C) 1998 Linas Vepstas *
* Copyright (C) 1998, 1999, 2000 Linas Vepstas *
* *
* This program is free software; you can redistribute it and/or *
* modify it under the terms of the GNU General Public License as *
@ -147,7 +147,6 @@ printDateSecs (char * buff, time_t t)
theTime->tm_year + 1900);
}
char *
xaccPrintDateSecs (time_t t)
{
@ -156,6 +155,19 @@ xaccPrintDateSecs (time_t t)
return strdup (buff);
}
char *
gnc_print_date(Timespec ts)
{
static char buff[256];
time_t t;
t = ts.tv_sec + (ts.tv_nsec / 1000000000.0);
printDateSecs(buff, t);
return buff;
}
/**
* scanDate
* Convert a string into day / month / year integers according to

3
src/engine/date.h
View File

@ -2,7 +2,7 @@
* date.h -- utility functions to handle the date (adjusting, get *
* current date, etc.) for xacc (X-Accountant) *
* Copyright (C) 1997 Robin D. Clark (rclark@cs.hmc.edu) *
* Copyright (C) 1998, 1999 Linas Vepstas *
* Copyright (C) 1998, 1999, 2000 Linas Vepstas *
* *
* This program is free software; you can redistribute it and/or *
* modify it under the terms of the GNU General Public License as *
@ -96,6 +96,7 @@ void printDate (char * buff, int day, int month, int year);
void printDateSecs (char * buff, time_t secs);
char * xaccPrintDateSecs (time_t secs);
char * gnc_print_date(Timespec ts);
void scanDate (const char *buff, int *day, int *monty, int *year);
char dateSeparator(void);

30
src/engine/util.c
View File

@ -240,6 +240,7 @@ gnc_localeconv()
gnc_lconv_set(&lc.decimal_point, ".");
gnc_lconv_set(&lc.thousands_sep, ",");
gnc_lconv_set(&lc.int_curr_symbol, "USD ");
gnc_lconv_set(&lc.currency_symbol, CURRENCY_SYMBOL);
gnc_lconv_set(&lc.mon_decimal_point, ".");
gnc_lconv_set(&lc.mon_thousands_sep, ",");
@ -259,6 +260,29 @@ gnc_localeconv()
return &lc;
}
char *
gnc_locale_default_currency()
{
static char currency[4];
gncBoolean got_it = GNC_F;
struct lconv *lc;
int i;
if (got_it)
return currency;
for (i = 0; i < 4; i++)
currency[i] = 0;
lc = gnc_localeconv();
strncpy(currency, lc->int_curr_symbol, 3);
got_it = GNC_T;
return currency;
}
/* Utility function for printing non-negative amounts */
static int
PrintAmt(char *buf, double val, int prec,
@ -298,7 +322,7 @@ PrintAmt(char *buf, double val, int prec,
max_delete--;
}
if (*p == lc->decimal_point[0])
if (*p == '.')
*p = 0;
}
@ -313,10 +337,12 @@ PrintAmt(char *buf, double val, int prec,
stringLength = strlen(tempBuf);
numWholeDigits = -1;
for (i = stringLength - 1; i >= 0; i--) {
if (tempBuf[i] == lc->decimal_point[0]) {
if (tempBuf[i] == '.') {
numWholeDigits = i;
if (monetary)
tempBuf[i] = lc->mon_decimal_point[0];
else
tempBuf[i] = lc->decimal_point[0];
break;
}
}

3
src/engine/util.h
View File

@ -137,6 +137,9 @@ char * ultostr (unsigned long val, int base);
*/
struct lconv * gnc_localeconv();
/* Returns the 3 character currency code of the current locale. */
char * gnc_locale_default_currency();
/** PROTOTYPES ******************************************************/

3
src/gnome/window-register.c
View File

@ -968,8 +968,7 @@ print_check_cb(GtkWidget * widget, gpointer data)
gh_str02scm(memo)));
}
#else
gnc_info_dialog_parented(GTK_WINDOW(reg_data->window),
_("You need to install the gnome-print library."));
gnc_info_dialog_parented(GTK_WINDOW(reg_data->window), GNOME_PRINT_MSG);
#endif
}

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

@ -172,13 +172,14 @@
(set-tm:mon ddt 1)
ddt))
(define (gnc:timepair-to-ldatestring tp)
(let ((bdtime (localtime (car tp))))
(strftime "%m/%d/%Y" bdtime)))
(define (gnc:timepair->secs tp)
(inexact->exact
(+ (car tp)
(/ (cdr tp) 1000000000))))
;; Find difference in seconds (?) between time 1 and time2
;; Find difference in seconds time 1 and time2
(define (gnc:timepair-delta t1 t2)
(- (car t2) (car t1)))
(- (gnc:timepair->secs t2) (gnc:timepair->secs t1)))
;; timepair manipulation functions
;; hack alert - these should probably be put somewhere else

6
src/scm/prefs.scm
View File

@ -119,13 +119,11 @@ the account instead of opening a register." #f))
#(iso "ISO" "ISO Standard: yyyy-mm-dd"))))
; #(locale "Locale" "Take from system locale"))))
;; hack alert - we should probably get the default new account currency
;; from the locale
;; I haven't figured out if I can do this in scheme or need a C hook yet
(gnc:register-configuration-option
(gnc:make-string-option
"International" "Default Currency"
"b" "Default Currency For New Accounts" "USD"))
"b" "Default Currency For New Accounts"
(gnc:locale-default-currency)))
(gnc:register-configuration-option
(gnc:make-simple-boolean-option

746
src/scm/report/average-balance.scm
View File

@ -14,420 +14,446 @@
(require 'hash-table)
(gnc:depend "structure.scm")
(gnc:depend "report-utilities")
(gnc:depend "html-generator.scm")
(gnc:depend "date-utilities.scm")
;; Options
(define (runavg-options-generator)
(let*
((gnc:*runavg-track-options* (gnc:new-options))
;; register a configuration option for the report
(gnc:register-runavg-option
(lambda (new-option)
(gnc:register-option gnc:*runavg-track-options*
new-option))))
;; from date
(gnc:register-runavg-option
(gnc:make-date-option
"Report Options" "From"
"a" "Report Items from this date"
(lambda ()
(let ((bdtime (localtime (current-time))))
(set-tm:sec bdtime 0)
(set-tm:min bdtime 0)
(set-tm:hour bdtime 0)
(set-tm:mday bdtime 1)
(set-tm:mon bdtime 0)
(cons (car (mktime bdtime)) 0)))
#f))
;; to-date
(gnc:register-runavg-option
(gnc:make-date-option
"Report Options" "To"
"c" "Report items up to and including this date"
(lambda () (cons (current-time) 0))
#f))
;; account(s) to do report on
(gnc:register-runavg-option
(gnc:make-account-list-option
"Report Options" "Account"
"d" "Do transaction report on this account"
(lambda ()
(let ((current-accounts (gnc:get-current-accounts))
(num-accounts
(gnc:group-get-num-accounts (gnc:get-current-group))))
(cond ((not (null? current-accounts)) current-accounts)
(else
(let ((acctlist '()))
(gnc:for-loop
(lambda(x)
(set! acctlist
(append!
acctlist
(list (gnc:group-get-account
(gnc:get-current-group) x)))))
0 num-accounts 1)
acctlist)))))
#f #t))
(gnc:register-runavg-option
(gnc:make-multichoice-option
"Report Options" "Step Size"
"b" "Get number at each one of these" 'WeekDelta
(list #(DayDelta "Day" "Day")
#(WeekDelta "Week" "Week")
#(TwoWeekDelta "2Week" "Two Week")
#(MonthDelta "Month" "Month")
#(YearDelta "Year" "Year")
)))
(gnc:register-runavg-option
(gnc:make-simple-boolean-option
"Report Options" "Sub-Accounts"
"e" "Add in sub-accounts of each selected" #f))
(gnc:register-runavg-option
(gnc:make-multichoice-option
"Report Options" "Plot Type"
"f" "Get number at each one of these" 'NoPlot
(list #(NoPlot "Nothing" "Make No Plot")
#(AvgBalPlot "Average" "Average Balance")
#(GainPlot "Net Gain" "Net Gain")
#(GLPlot "Gain/Loss" "Gain And Loss"))))
gnc:*runavg-track-options*))
;; Plot strings
(define AvgBalPlot "using 2:3:4:5 t 'Average Balance' with errorbars, '' using 2:3 smooth sbezier t '' with lines")
(define GainPlot "using 2:6 t 'Net Gain' with linespoints, '' using 2:6 smooth sbezier t '' with lines" )
(define GLPlot "using 2:8 t 'Losses' with lp, '' using 2:7 t 'Gains' with lp")
(define NoPlot "")
;; applies thunk to each split in account account
(define (gnc:for-each-split-in-account account thunk)
(gnc:for-loop (lambda (x) (thunk (gnc:account-get-split account x)))
0 (gnc:account-get-split-count account) 1))
(let ()
;; get transactions date from split - needs to be done indirectly
;; as it's stored in the parent transaction
;; Options
(define (runavg-options-generator)
(let*
((gnc:*runavg-track-options* (gnc:new-options))
;; register a configuration option for the report
(gnc:register-runavg-option
(lambda (new-option)
(gnc:register-option gnc:*runavg-track-options*
new-option))))
(define (gnc:split-get-transaction-date split)
(gnc:transaction-get-date-posted (gnc:split-get-parent split)))
;; from date
(gnc:register-runavg-option
(gnc:make-date-option
"Report Options" "From"
"a" "Report Items from this date"
(lambda ()
(let ((bdtime (localtime (current-time))))
(set-tm:sec bdtime 0)
(set-tm:min bdtime 0)
(set-tm:hour bdtime 0)
(set-tm:mday bdtime 1)
(set-tm:mon bdtime 0)
(cons (car (mktime bdtime)) 0)))
#f))
;; ditto descriptions
(define (gnc:split-get-description-from-parent split)
(gnc:transaction-get-description (gnc:split-get-parent split)))
;; to-date
(gnc:register-runavg-option
(gnc:make-date-option
"Report Options" "To"
"c" "Report items up to and including this date"
(lambda ()
(let ((bdtime (localtime (current-time))))
(set-tm:sec bdtime 59)
(set-tm:min bdtime 59)
(set-tm:hour bdtime 23)
(cons (car (mktime bdtime)) 0)))
#f))
;; get the account name of a split
(define (gnc:split-get-account-name split)
(gnc:account-get-name (gnc:split-get-account split)))
;; account(s) to do report on
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Text table
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(gnc:register-runavg-option
(gnc:make-account-list-option
"Report Options" "Account"
"d" "Do transaction report on this account"
(lambda ()
(let ((current-accounts (gnc:get-current-accounts))
(num-accounts
(gnc:group-get-num-accounts (gnc:get-current-group))))
; Create an text table row from a list of entries
(define (text-table-row lst)
(string-append
(tostring (car lst))
(cond ((not (null? current-accounts)) current-accounts)
(else
(let ((acctlist '()))
(gnc:for-loop
(lambda(x)
(set! acctlist
(append!
acctlist
(list (gnc:group-get-account
(gnc:get-current-group) x)))))
0 num-accounts 1)
acctlist)))))
#f #t))
(apply string-append (map (lambda (val)
(string-append "\t" (tostring val)))
(cdr lst)))
"\n"))
(gnc:register-runavg-option
(gnc:make-multichoice-option
"Report Options" "Step Size"
"b" "Get number at each one of these" 'WeekDelta
(list #(DayDelta "Day" "Day")
#(WeekDelta "Week" "Week")
#(TwoWeekDelta "2Week" "Two Week")
#(MonthDelta "Month" "Month")
#(YearDelta "Year" "Year")
)))
(define (text-table-header lst)
(string-append
"# "
(text-table-row lst)))
(gnc:register-runavg-option
(gnc:make-simple-boolean-option
"Report Options" "Sub-Accounts"
"e" "Add in sub-accounts of each selected" #f))
(define (text-table hdrlst llst)
(string-append
(text-table-header hdrlst)
(apply string-append (map text-table-row llst))))
(gnc:register-runavg-option
(gnc:make-multichoice-option
"Report Options" "Plot Type"
"f" "Get number at each one of these" 'NoPlot
(list #(NoPlot "Nothing" "Make No Plot")
#(AvgBalPlot "Average" "Average Balance")
#(GainPlot "Net Gain" "Net Gain")
#(GLPlot "Gain/Loss" "Gain And Loss"))))
gnc:*runavg-track-options*))
; Quick and dirty until there is REAL plot support
(define (data-to-gpfile hdrlst llst fn plotcmd)
(let ((oport (open-output-file fn)))
(display
(text-table hdrlst llst)
oport)
(close-output-port oport)))
;; get transactions date from split - needs to be done indirectly
;; as it's stored in the parent transaction
;; Returns sum of all vector elements after the first
(define (vector-sum v)
(let ((sum 0))
(gnc:for-loop
(lambda(i) (set! sum (+ sum (car (vector-ref v i)))))
1 (vector-length v) 1)
sum))
(define (gnc:split-get-transaction-date split)
(gnc:transaction-get-date-posted (gnc:split-get-parent split)))
; Datelist entry operators
(define (dl:begin dl) (car dl))
(define (dl:end dl) (car (cdr dl)))
;; ditto descriptions
(define (gnc:split-get-description-from-parent split)
(gnc:transaction-get-description (gnc:split-get-parent split)))
(define (reduce-split-list dl tl pt av)
(let ((stat-accumulator (make-stats-collector))
;;; (avgaccum 0) ;; 'add, 'total, 'average, 'getmax, 'getmin, reset
;;; (balmin 10E9)
;;; (balmax -10E9)
(gl-accumulator (makedrcr-collector))
(bals av)
(prevdate 0))
;; get the account name of a split
(define (gnc:split-get-account-name split)
(gnc:account-get-name (gnc:split-get-account split)))
;; accbal runs the accumulator
(define (accbal beg end)
(let ((curbal (vector-sum (car (cdr (av 'x 0))))))
(stat-accumulator 'add (gnc:timepair-delta beg end))))
(define (calc-in-interval d tl)
(cond ((not (null? tl))
(let* ((bd (dl:begin d)) ; begin date
(ed (dl:end d)) ; end date
(cs (car tl)) ; current split
(cd (gnc:split-get-transaction-date cs)) ;current date
(an (gnc:split-get-account-name cs)) ; account name
(prevbal (vector-sum (car (cdr (av 'x 0))))))
;; Text table
(cond ((gnc:timepair-later cd bd) ;split before interval
(bals 'put an (gnc:split-get-balance cs))
(calc-in-interval d (cdr tl)))
; Create an text table row from a list of entries
(define (text-table-row lst)
(string-append
(tostring (car lst))
((gnc:timepair-later cd ed) ;split is in the interval
(accbal prevdate cd)
(bals 'put an (gnc:split-get-balance cs))
(apply string-append (map (lambda (val)
(string-append "\t" (tostring val)))
(cdr lst)))
"\n"))
(let ((val (gnc:split-get-value cs)))
(gl-accumulator 'add val))
(set! prevdate cd)
(calc-in-interval d (cdr tl)))
(define (text-table-header lst)
(string-append
"# "
(text-table-row lst)))
(else ; Past interval, nothing to do?
(accbal prevdate ed)
tl))))
(else ; Out of data !
(accbal prevdate (dl:end d))
tl)))
(define (text-table hdrlst llst)
(string-append
(text-table-header hdrlst)
(apply string-append (map text-table-row llst))))
;; Actual routine
(cond ((null? dl) '());; End of recursion
(else
(let ((bd (dl:begin (car dl)))
(ed (dl:end (car dl))))
; Quick and dirty until there is REAL plot support
(define (data-to-gpfile hdrlst llst fn plotcmd)
(let ((oport (open-output-file fn)))
(display
(text-table hdrlst llst)
oport)
(close-output-port oport)))
;; Reset valaccumulator values
(set! prevdate bd)
(stat-accumulator 'reset #f)
(gl-accumulator 'reset #f)
;; Returns sum of all vector elements after the first
(define (vector-sum v)
(let ((sum 0))
(gnc:for-loop
(lambda(i) (set! sum (+ sum (car (vector-ref v i)))))
1 (vector-length v) 1)
sum))
(let ((rest (calc-in-interval (car dl) tl)))
;; list of values for report
(cons
(list
(gnc:timepair-to-ldatestring bd)
(gnc:timepair-to-ldatestring ed)
(/ (stat-accumulator 'total #f)
(gnc:timepair-delta bd ed))
(stat-accumulator 'getmin #f)
(stat-accumulator 'getmax #f)
(- (gl-accumulator 'debits #f)
(gl-accumulator 'credits #f))
(gl-accumulator 'debits #f)
(gl-accumulator 'credits #f))
(reduce-split-list (cdr dl) rest pt av))))))))
(define (reduce-split-list deltas splits balance)
(let ((stat-accumulator (make-stats-collector))
(min-max-accumulator (make-stats-collector))
(gl-accumulator (makedrcr-collector))
(prevdate 0))
;; Pull a scheme list of splits from a C array
(define (gnc:convert-split-list slist)
(let
((numsplit 0)
(schsl '()))
(while
(let ((asplit (gnc:ith-split slist numsplit)))
(cond
((pointer-token-null? asplit ) #f)
(else
(set! schsl (append! schsl (list asplit)))
(set! numsplit (+ numsplit 1))
#t))) ())
schsl))
;; accbal runs the accumulator
(define (accbal start end)
(stat-accumulator 'add
(* (gnc:timepair-delta start end) balance))
(min-max-accumulator 'add balance))
;; Pull a scheme list of accounts (including subaccounts) from group grp
(define (gnc:group-get-account-list grp)
(cond ((pointer-token-null? grp) '())
(else
(let ((numacct 0)
(acctar (gnc:get-accounts grp))
(schal '()))
(while
(let ((anact (gnc:account-nth-account acctar numacct)))
(cond
((pointer-token-null? anact ) #f)
(else
(set! schal (append! schal (list anact)))
(set! numacct (+ numacct 1))
#t))) ())
schal))))
(define (calc-in-interval delta splits)
(let ((start (car delta))
(end (cadr delta)))
(if (null? splits)
(begin
(accbal start end)
'())
(let* ((split (car splits))
(now (gnc:split-get-transaction-date split)))
(define (accumvects x y)
(cond
((null? x) '())
((number? (car x))
(cons (+ (car x) (car y)) (accumvects (cdr x) (cdr y))))
(else (cons "x" (accumvects (cdr x) (cdr y))))))
(cond ((gnc:timepair-lt now start) ;split before interval
(set! balance (+ balance (gnc:split-get-value split)))
(calc-in-interval delta (cdr splits)))
;; Add x to list lst if it is not already in there
(define (addunique lst x)
(cond
((null? lst) (list x)) ; all checked add it
(else (cond
((equal? x (car lst)) lst) ; found, quit search and don't add again
(else (cons (car lst) (addunique (cdr lst) x))) ; keep searching
))))
((gnc:timepair-lt now end) ;split is in the interval
(accbal prevdate now)
(set! prevdate now)
(gl-accumulator 'add (gnc:split-get-value split))
(set! balance (+ balance (gnc:split-get-value split)))
(calc-in-interval delta (cdr splits)))
;; Calculate averages of each column
(define (get-averages indata)
(let ((avglst '()))
(map (lambda (x) (set! avglst (append avglst (list 0.0)))) (car indata))
(map (lambda (x)
(set! avglst (accumvects x avglst)))
indata)
(map (lambda (x)
(cond ((number? x) (/ x (length indata)))
(else "")))
avglst)))
(else ; split is past interval
(accbal prevdate end)
splits))))))
;; Turn a C array of accounts into a scheme list of account names
(define (gnc:acctnames-from-list acctlist)
(let ((anlist '()))
(map (lambda(an)
(set! anlist (append! anlist
(list (gnc:account-get-name an)))))
acctlist)
anlist))
;; Actual routine
(if (null? deltas)
'() ; end of recursion
(let* ((delta (car deltas))
(start (car delta))
(end (cadr delta)))
(define acctcurrency "USD")
(define acctname "")
;; Reset accumulator values
(set! prevdate start)
(stat-accumulator 'reset #f)
(min-max-accumulator 'reset #f)
(gl-accumulator 'reset #f)
(define (allsubaccounts accounts)
(cond ((null? accounts) '())
(else
; (display (gnc:account-get-name (car accounts)))(newline)
(append
(gnc:group-get-account-list
(gnc:account-get-children (car accounts)))
(allsubaccounts (cdr accounts))))))
(let ((rest (calc-in-interval delta splits)))
;; list of values for report
(cons
(list start
end
(/ (stat-accumulator 'total #f)
(gnc:timepair-delta start end))
(min-max-accumulator 'getmin #f)
(min-max-accumulator 'getmax #f)
(- (gl-accumulator 'debits #f)
(gl-accumulator 'credits #f))
(gl-accumulator 'debits #f)
(gl-accumulator 'credits #f))
(reduce-split-list (cdr deltas) rest balance)))))))
(define (average-balance-renderer options)
(let ((gov-fun (lambda (value)
(gnc:option-value (gnc:lookup-option
options "Report Options"
value)))))
(let ((begindate (gov-fun "From"))
(enddate (gov-fun "To"))
(stepsize (eval (gov-fun "Step Size")))
(plotstr (eval (gov-fun "Plot Type")))
(accounts (gov-fun "Account"))
(dosubs (gov-fun "Sub-Accounts"))
(prefix (list "<HTML>" "<BODY>"))
(suffix (list "</BODY>" "</HTML>"))
(collist
(list "Beginning" "Ending" "Average" "Max" "Min"
"Net Gain" "Gain" "Loss"))
(report-lines '())
(rept-data '())
(sum-data '())
(tempstruct '())
(rept-text "")
(gncq (gnc:malloc-query))
(slist '()))
(gnc:init-query gncq)
(define (format-numbers-in-list list)
(if (null? list)
'()
(cond ((number? (car list))
(cons (gnc:amount->string (car list) #f #t #f)
(format-numbers-in-list (cdr list))))
(else
(cons (car list)
(format-numbers-in-list (cdr list)))))))
(if (null? accounts)
(set! rept-text
(list "<TR><TD>You have not selected an account.</TD></TR>"))
(begin
; Grab account names
(set! acctname (string-join
(map gnc:account-get-name accounts)
" , "))
(cond ((equal? dosubs #t)
(map (lambda (a)
(set! accounts (addunique accounts a)))
(allsubaccounts accounts))
(define (format-reduced-list list)
(define (reduce-line line)
(let ((start (car line))
(end (cadr line))
(rest (cddr line)))
(cons (gnc:print-date start)
(cons (gnc:print-date end)
(format-numbers-in-list rest)))))
(if (null? list)
'()
(cons (reduce-line (car list))
(format-reduced-list (cdr list)))))
(set! acctname (string-append acctname " and sub-accounts"))))
(define (gnc:timepair-to-gnuplot-string tp)
(let ((bdtime (localtime (car tp))))
(strftime "%m/%d/%Y" bdtime)))
(map (lambda(acct) (gnc:query-add-account gncq acct)) accounts)
(define (gnuplot-reduced-list list)
(define (reduce-line line)
(let ((start (car line))
(end (cadr line))
(rest (cddr line)))
(cons (gnc:timepair-to-gnuplot-string start)
(cons (gnc:timepair-to-gnuplot-string end) rest))))
(if (null? list)
'()
(cons (reduce-line (car list))
(gnuplot-reduced-list (cdr list)))))
(set! tempstruct
(build-mystruct-instance
(define-mystruct
(gnc:acctnames-from-list accounts))))
;; Pull a scheme list of splits from a C array
(define (gnc:convert-split-list slist)
(let loop ((index 0)
(split (gnc:ith-split slist 0)))
(if (pointer-token-null? split)
'()
(cons split (loop (+ index 1)
(gnc:ith-split slist (+ index 1)))))))
(set! acctcurrency (gnc:account-get-currency (car accounts)))
;; Pull a scheme list of accounts (including subaccounts) from group grp
(define (gnc:group-get-account-list grp)
(if (pointer-token-null? grp)
'()
(let ((account-array (gnc:get-accounts grp)))
(let loop
((index 0)
(account (gnc:account-nth-account account-array 0)))
(if (pointer-token-null? account)
'()
(cons account
(loop (+ index 1)
(gnc:account-nth-account account-array
(+ index 1)))))))))
(set! report-lines
(gnc:convert-split-list (gnc:query-get-splits gncq)))
(define (accumvects x y)
(cond
((null? x) '())
((number? (car x))
(cons (+ (car x) (car y)) (accumvects (cdr x) (cdr y))))
(else (cons "x" (accumvects (cdr x) (cdr y))))))
(gnc:free-query gncq)
;; Add x to list lst if it is not already in there
(define (addunique lst x)
(cond
((null? lst) (list x)) ; all checked add it
(else (cond
((equal? x (car lst)) lst) ; found, quit search and don't add again
(else (cons (car lst) (addunique (cdr lst) x))) ; keep searching
))))
(display (length report-lines))
(display " Splits\n")
;; Calculate averages of each column
(define (get-averages indata)
(let ((avglst '()))
(set! avglst (map (lambda (x) 0.0) (car indata)))
(for-each (lambda (x)
(set! avglst (accumvects x avglst)))
indata)
(map (lambda (x)
(cond ((number? x) (/ x (length indata)))
(else "")))
avglst)))
; Set initial balances to zero
(map (lambda(an) (tempstruct 'put an 0))
(gnc:acctnames-from-list accounts))
(define (allsubaccounts accounts)
(cond ((null? accounts) '())
(else
(append
(gnc:group-get-account-list
(gnc:account-get-children (car accounts)))
(allsubaccounts (cdr accounts))))))
(dateloop begindate enddate stepsize)
(define string-db (gnc:make-string-database))
(set! rept-data
(reduce-split-list
(dateloop begindate enddate stepsize)
report-lines (make-zdate) tempstruct))
(define (column-list)
(map (lambda (key) (string-db 'lookup key))
(list 'beginning 'ending 'average 'max 'min 'net-gain 'gain 'loss)))
(set! sum-data (get-averages rept-data))
(define (average-balance-renderer options)
(let ((gov-fun (lambda (value)
(gnc:option-value (gnc:lookup-option
options "Report Options"
value)))))
(let ((acctcurrency "USD")
(acctname "")
(begindate (gov-fun "From"))
(enddate (gov-fun "To"))
(stepsize (eval (gov-fun "Step Size")))
(plotstr (eval (gov-fun "Plot Type")))
(accounts (gov-fun "Account"))
(dosubs (gov-fun "Sub-Accounts"))
(prefix (list "<HTML>" "<BODY>"))
(suffix (list "</BODY>" "</HTML>"))
(columns (column-list))
(report-lines '())
(rept-data '())
(sum-data '())
(rept-text "")
(gncq (gnc:malloc-query))
(slist '()))
(gnc:init-query gncq)
;; Create HTML
(set! rept-text
(html-table
collist
(append rept-data
(list "<TR cellspacing=0><TD><TD><TD colspan=3><HR size=2 noshade><TD colspan=3><HR size=2 noshade></TR>" sum-data))))
(if (null? accounts)
(set! rept-text
(list "<TR><TD>"
(string-db 'lookup 'no-account)
"</TD></TR>"))
(begin
;; Do a plot
(if (not (string=? NoPlot plotstr))
(let
((fn "/tmp/gncplot.dat")
(preplot (string-append
"set xdata time\n"
"set timefmt '%m/%d/%Y'\n"
"set pointsize 2\n"
"set title '" acctname "'\n"
"set ylabel '" acctcurrency "'\n"
"set xlabel 'Period Ending'\n")))
; Grab account names
(set! acctname
(string-join (map gnc:account-get-name accounts) " , "))
(data-to-gpfile collist rept-data fn plotstr)
(system
(string-append "echo \"" preplot "plot '"
fn "'" plotstr
"\"|gnuplot -persist " ))))))
(if dosubs
(map (lambda (a)
(set! accounts (addunique accounts a)))
(allsubaccounts accounts)))
(append prefix
(if (null? accounts)
()
(list "Report for " acctname "<p>\n"))
(list rept-text) suffix))))
(map (lambda (acct) (gnc:query-add-account gncq acct)) accounts)
(gnc:define-report
;; version
1
;; Name
"Account Balance Tracker"
;; Options
runavg-options-generator
;; renderer
average-balance-renderer)
(set! acctcurrency (gnc:account-get-currency (car accounts)))
(set! report-lines
(gnc:convert-split-list (gnc:query-get-splits gncq)))
(gnc:free-query gncq)
(set! rept-data
(reduce-split-list (dateloop begindate enddate stepsize)
report-lines 0))
(set! sum-data (get-averages rept-data))
;; Create HTML
(set! rept-text
(html-table
columns
(append (format-reduced-list rept-data)
(list "<TR cellspacing=0><TD><TD><TD colspan=3><HR size=2 noshade><TD colspan=3><HR size=2 noshade></TR>"
(format-numbers-in-list sum-data)))))
;; Do a plot
(if (not (string=? NoPlot plotstr))
(let ((fn "/tmp/gncplot.dat")
(preplot (string-append
"set xdata time\n"
"set timefmt '%m/%d/%Y'\n"
"set pointsize 2\n"
"set title '" acctname "'\n"
"set ylabel '" acctcurrency "'\n"
"set xlabel '"
(string-db 'lookup 'period-ending)
"'\n")))
(data-to-gpfile columns (gnuplot-reduced-list rept-data)
fn plotstr)
(system
(string-append "echo \"" preplot "plot '"
fn "'" plotstr
"\"|gnuplot -persist " ))))))
(append prefix
(if (null? accounts)
'()
(list (sprintf #f
(string-db 'lookup
(if dosubs
'report-for-and
'report-for))
acctname)
"<p>\n"))
(list rept-text)
suffix))))
;; Define the strings
(string-db 'store 'beginning "Beginning")
(string-db 'store 'ending "Ending")
(string-db 'store 'average "Average")
(string-db 'store 'max "Max")
(string-db 'store 'min "Min")
(string-db 'store 'net-gain "Net Gain")
(string-db 'store 'gain "Gain")
(string-db 'store 'loss "Loss")
(string-db 'store 'no-account "You have not selected an account.")
(string-db 'store 'period-ending "Period Ending")
(string-db 'store 'report-for "Report for %s.")
(string-db 'store 'report-for-and "Report for %s and all subaccounts.")
(gnc:define-report
;; version
1
;; Name
"Account Balance Tracker"
;; Options
runavg-options-generator
;; renderer
average-balance-renderer))

8
src/scm/report/hello-world.scm
View File

@ -276,6 +276,13 @@
(make-para 'num-string-1 (bold (number->string num-val)))
;; Here we print the value of the number option formatted as
;; currency. When printing currency values, you should use
;; the functions (gnc:amount->string) and
;; (gnc:amount->formatted-string) which are defined in
;; report-utilities. These functions will format the number
;; appropriately in the current locale. Don't try to format
;; it yourself -- it will be wrong in other locales.
(make-para 'num-string-2
(bold (gnc:amount->formatted-string num-val #f)))
@ -348,6 +355,7 @@
;; Here we define the actual report with gnc:define-report
(gnc:define-report
;; The version of this report.
1

2
src/scm/structure.scm
View File

@ -69,5 +69,3 @@
; (display "Overlay 'f3 with 42, add to 'f1 value")
; (mi 'put 'f3 42)
; (display (number->string (+ (mi 'get 'f1) (mi 'get 'f3)))) (newline))))