aherman
/
gnucash
mirror of https://github.com/Gnucash/gnucash
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2135 57a11ea4-9604-0410-9ed3-97b8803252fd
zzzoldreleases/1.4
Dave Peticolas 26 years ago
parent b95e3f59dc
commit 9261c867b5
14 changed files with 113 additions and 98 deletions
Show Stats Download Patch File Download Diff File

3
ChangeLog
Unescape View File

@ -1,5 +1,8 @@
2000-03-29 Dave Peticolas <peticola@cs.ucdavis.edu>
* src/scm/report/transaction-report.scm: bug fixes and speed
improvements
* src/engine/Group.c: added some new transaction traversal code
* src/scm/report/folio.scm: implement the old eperl report

7
Makefile.in
Unescape View File

@ -164,16 +164,15 @@ install:
$(INSTALL) src/swig/perl5/gnucash.so ${GNC_LIBDIR}
$(INSTALL_DATA) src/quotes/Quote.pm ${GNC_LIBDIR}
$(INSTALL_DATA) README* ${GNC_DOCDIR}
$(INSTALL_DATA) doc/README* ${GNC_DOCDIR}
$(INSTALL_DATA) doc/*.txt ${GNC_DOCDIR}
$(INSTALL_DATA) doc/INSTALL ${GNC_DOCDIR}
$(INSTALL_DATA) TODO ${GNC_DOCDIR}
$(INSTALL_DATA) CHANGES ${GNC_DOCDIR}
$(INSTALL_DATA) man/gnucash.1 ${GNC_MANDIR}/man1
$(INSTALL_DATA) man/gnc-prices.1 ${GNC_MANDIR}/man1
# @mkdir -p $(prefix)/toolbar
# $(INSTALL_DATA) toolbar/*.xpm $(prefix)/toolbar
# Share directory
# Try to do this in a platform independent way...
# Directories

6
README.install → doc/INSTALL
Unescape View File

@ -1,4 +1,3 @@
You'll use "make install" when you want to do a normal FSSTND /usr/ or
/usr/local style install where everything scatters across the
filesystem in foo/gnucash/* directories. You'll use "make
@ -51,8 +50,3 @@ better.
--
Rob Browning <rlb@cs.utexas.edu> PGP=E80E0D04F521A094 532B97F5D64E3930
----- %< -------------------------------------------- >% ------
The GnuCash / X-Accountant Mailing List
To subscribe, send mail to majordomo@gnucash.org and
put "subscribe gnucash-devel your@email.address" in the body

0
README → doc/README
Unescape View File

0
README.francais → doc/README.francais
Unescape View File

0
README.german → doc/README.german
Unescape View File

0
README.SuSE-6.3 → doc/SuSE-6.3.txt
Unescape View File

0
README.aix → doc/aix.txt
Unescape View File

0
README.gnome-hackers → doc/gnome-hackers.txt
Unescape View File

0
README.guile-hackers → doc/guile-hackers.txt
Unescape View File

0
README.solaris → doc/solaris.txt
Unescape View File

2
src/gnome/window-register.c
Unescape View File

@ -939,8 +939,6 @@ print_check_cb(GtkWidget * widget, gpointer data)
char * payee;
char * memo;
double amount;
char datestring[1024];
struct tm * timestruct;
time_t date;
SCM print_check = gh_eval_str("gnc:print-check");

18
src/scm/date-utilities.scm
Unescape View File

@ -179,7 +179,7 @@
;; Find difference in seconds time 1 and time2
(define (gnc:timepair-delta t1 t2)
(- (gnc:timepair->secs t2) (gnc:timepair->secs t1)))
(- (gnc:timepair->secs t2) (gnc:timepair->secs t1)))
;; timepair manipulation functions
;; hack alert - these should probably be put somewhere else
@ -215,3 +215,19 @@
(define (gnc:timepair-later-or-eq-date t1 t2)
(gnc:timepair-earlier-or-eq-date t2 t1))
(define (gnc:timepair-start-day-time tp)
(let ((bdt (localtime (gnc:timepair->secs tp))))
(set-tm:sec bdt 0)
(set-tm:min bdt 0)
(set-tm:hour bdt 0)
(let ((newtime (car (mktime bdt))))
(cons newtime 0))))
(define (gnc:timepair-end-day-time tp)
(let ((bdt (localtime (gnc:timepair->secs tp))))
(set-tm:sec bdtime 59)
(set-tm:min bdtime 59)
(set-tm:hour bdtime 23)
(let ((newtime (car (mktime bdt))))
(cons newtime 0))))

175
src/scm/report/transaction-report.scm
Unescape View File

@ -27,24 +27,22 @@
;; returns a list contains elements of the-list for which predicate is true
(define (gnc:filter-list the-list predicate)
(cond ((not (list? the-list))
(gnc:error "Attempted to filter a non-list object"))
((null? the-list) '())
((predicate (car the-list))
(cons (car the-list)
(gnc:filter-list (cdr the-list) predicate)))
(else (gnc:filter-list (cdr the-list) predicate))))
(let loop ((rest the-list)
(collected '()))
(cond ((null? rest) (reverse collected))
(else (loop (cdr rest)
(if (predicate (car rest))
(cons (car rest) collected)
collected))))))
;; like map, but restricted to one dimension, and
;; guaranteed to have inorder semantics.
(define (gnc:inorder-map the-list fn)
(cond ((not (list? the-list))
(gnc:error "Attempted to map a non-list object"))
((not (procedure? fn))
(gnc:error "Attempted to map a non-function object to a list"))
((null? the-list) '())
(else (cons (fn (car the-list))
(gnc:inorder-map (cdr the-list) fn)))))
(let loop ((rest the-list)
(collected '()))
(cond ((null? rest) (reverse collected))
(else (loop (cdr rest)
(cons (fn (car rest)) collected))))))
;; extract fields out of the scheme split representation
@ -83,23 +81,23 @@
(define (gnc:tr-report-get-first-acc-name split-scm)
(let ((other-splits (gnc:tr-report-get-other-splits split-scm)))
(cond ((= (length other-splits) 0) "-")
(else (caar other-splits)))))
(cond ((null? other-splits) "-")
(else (gnc:account-get-full-name (caar other-splits))))))
;; builds a list of the account name and values for the other
;; splits in a transaction
(define (gnc:split-get-corresponding-account-name-and-values
split split-filter)
(define (gnc:split-get-corresponding-account-and-value
split split-filter)
(let* ((diff-list '())
(parent-transaction (gnc:split-get-parent split))
(num-splits (gnc:transaction-get-split-count parent-transaction)))
(gnc:for-loop
(lambda (n)
(let* ((split-in-trans
(gnc:for-loop
(lambda (n)
(let* ((split-in-trans
(gnc:transaction-get-split parent-transaction n))
(sub-split
(list
(gnc:split-get-account-name split-in-trans)
(list
(gnc:split-get-account split-in-trans)
(gnc:split-get-value split-in-trans))))
(if (split-filter sub-split)
(set! diff-list
@ -107,9 +105,8 @@
0 num-splits 1)
(reverse diff-list)))
;; takes a C split, extracts relevant data and converts to a scheme
;; representation. split-filter is a predicate that filters the splits.
;; representation. split-filter is a predicate that filters the splits.
(define (gnc:make-split-scheme-data split split-filter)
(vector
(gnc:split-get-memo split)
@ -122,7 +119,18 @@
(gnc:split-get-share-price split)
(gnc:split-get-value split)
(gnc:transaction-get-num (gnc:split-get-parent split))
(gnc:split-get-corresponding-account-name-and-values split split-filter)))
(gnc:split-get-corresponding-account-and-value split split-filter)))
(define (gnc:account->split-scm-list account sub-split-filter-pred)
(let ((num-splits (gnc:account-get-split-count account)))
(let loop ((index 0)
(split (gnc:account-get-split account 0))
(split-scms '()))
(cond ((>= index num-splits) (reverse split-scms))
(else (loop (+ index 1)
(gnc:account-get-split account (+ index 1))
(cons (gnc:make-split-scheme-data
split sub-split-filter-pred) split-scms)))))))
;; Note: This can be turned into a lookup table which will
;; *massively* simplify it...
@ -231,8 +239,7 @@
((list accounts))
(if (null? list)
#f
(or (not (equal? (gnc:account-get-name (car list))
(car sub-split)))
(or (not (equal? (car list) (car sub-split)))
(loop (cdr list)))))))
;; converts a scheme split representation to a line of HTML,
@ -251,43 +258,44 @@
split-scm))))))
(for-each
(lambda (split-sub first last)
(set! report-string
(string-append
report-string
"<TR><TD>"
(cond (first (gnc:print-date
(gnc:tr-report-get-date split-scm)))
(else ""))
"</TD><TD>"
(cond (first (gnc:tr-report-get-num split-scm))
(else ""))
"</TD><TD>"
(cond (first (gnc:tr-report-get-description split-scm))
(else ""))
"</TD><TD>"
(cond (first (gnc:tr-report-get-memo split-scm))
(else ""))
"</TD><TD>"
(if (string? (car split-sub)) (car split-sub) "")
"</TD><TD>"
(cond ((< (cadr split-sub) 0)
(string-append
(gnc:amount->string (- (cadr split-sub)) #f #t #f)
(let ((account-name (gnc:account-get-full-name (car split-sub))))
(set! report-string
(string-append
report-string
"<TR><TD>"
(cond (first (gnc:print-date
(gnc:tr-report-get-date split-scm)))
(else ""))
"</TD><TD>"
(cond (first (gnc:tr-report-get-num split-scm))
(else ""))
"</TD><TD>"
(cond (first (gnc:tr-report-get-description split-scm))
(else ""))
"</TD><TD>"
(cond (first (gnc:tr-report-get-memo split-scm))
(else ""))
"</TD><TD>"
account-name
"</TD><TD>"
(cond ((< (cadr split-sub) 0)
(string-append
(gnc:amount->string (- (cadr split-sub)) #f #t #f)
"</TD><TD>"))
(else
(string-append
"</TD><TD>"
(gnc:amount->string (cadr split-sub) #f #t #f))))
(else
(string-append
"</TD><TD>"
(gnc:amount->string (cadr split-sub) #f #t #f))))
"</TD>"
(cond ((not last) "</TR>")
(else "")))))
other-splits
(if (null? other-splits)
()
(append (list #t) (make-list (- (length other-splits) 1) #f)))
(if (null? other-splits)
()
(append (make-list (- (length other-splits) 1) #f) (list #t))))
(else ""))))))
other-splits
(if (null? other-splits)
()
(append (list #t) (make-list (- (length other-splits) 1) #f)))
(if (null? other-splits)
()
(append (make-list (- (length other-splits) 1) #f) (list #t))))
(string-append
report-string
"<TD>"
@ -300,18 +308,14 @@
;; we are doing multiple passes over the list - if it becomes a performance
;; problem some code optimisation will become necessary
(define (gnc:tr-report-get-starting-balance scm-split-list beginning-date)
(cond ((or
(eq? scm-split-list '())
(gnc:timepair-later-date
(gnc:tr-report-get-date (car scm-split-list))
beginning-date))
0)
(else
(+
(gnc:tr-report-get-value
(car scm-split-list))
(gnc:tr-report-get-starting-balance
(cdr scm-split-list) beginning-date)))))
(let loop ((list scm-split-list)
(total 0))
(cond ((null? list) total)
((gnc:timepair-lt beginning-date
(gnc:tr-report-get-date (car list)))
total)
(else (loop (cdr list)
(+ total (gnc:tr-report-get-value (car list))))))))
;; register a configuration option for the transaction report
(define (trep-options-generator)
@ -457,14 +461,19 @@
"Secondary Key"))
(tr-report-secondary-order-op
(gnc:lookup-option options "Sorting" "Secondary Sort Order"))
(accounts (gnc:option-value tr-report-account-op))
(prefix (list "<HTML>" "<BODY bgcolor=#99ccff>"
"<TABLE>" (gnc:titles)))
"<TABLE>"
"<caption><b>"
(string-db 'lookup 'tr-report) " - "
(gnc:account-get-full-name (car accounts))
"</b></caption>"
(gnc:titles)))
(suffix (list "</TABLE>" "</BODY>" "</HTML>"))
(balance-line '())
(inflow-outflow-line '())
(net-inflow-line '())
(report-lines '())
(accounts (gnc:option-value tr-report-account-op))
(date-filter-pred (gnc:tr-report-make-filter-predicate
(gnc:option-value begindate)
(gnc:option-value enddate)))
@ -477,18 +486,13 @@
"<TR><TD>" (string-db 'lookup 'no-accounts) "</TD></TR>"))
(begin
; reporting on more than one account not yet supported
(gnc:for-each-split-in-account
(car accounts)
(lambda (split)
(set! report-lines
(append! report-lines
(list (gnc:make-split-scheme-data
split sub-split-filter-pred))))))
(set! report-lines
(gnc:account->split-scm-list (car accounts)
sub-split-filter-pred))
(set! starting-balance
(gnc:tr-report-get-starting-balance
report-lines (gnc:option-value begindate)))
(set! report-lines (gnc:filter-list report-lines
date-filter-pred))
(set! report-lines (gnc:filter-list report-lines date-filter-pred))
(set! report-lines
(sort!
report-lines
@ -548,6 +552,7 @@
(append prefix balance-line report-lines
inflow-outflow-line net-inflow-line suffix)))
(string-db 'store 'tr-report "Transaction Report")
(string-db 'store 'date "Date")
(string-db 'store 'num "Num")
(string-db 'store 'desc "Description")

Write Preview
Loading…
Cancel
Save