From 9261c867b5f7a7fde6b22db5c6d04b1f00c998a2 Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Thu, 30 Mar 2000 08:37:37 +0000 Subject: [PATCH] *** empty log message *** git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2135 57a11ea4-9604-0410-9ed3-97b8803252fd --- ChangeLog | 3 + Makefile.in | 7 +- README.install => doc/INSTALL | 6 - README => doc/README | 0 README.francais => doc/README.francais | 0 README.german => doc/README.german | 0 README.SuSE-6.3 => doc/SuSE-6.3.txt | 0 README.aix => doc/aix.txt | 0 README.gnome-hackers => doc/gnome-hackers.txt | 0 README.guile-hackers => doc/guile-hackers.txt | 0 README.solaris => doc/solaris.txt | 0 src/gnome/window-register.c | 2 - src/scm/date-utilities.scm | 18 +- src/scm/report/transaction-report.scm | 175 +++++++++--------- 14 files changed, 113 insertions(+), 98 deletions(-) rename README.install => doc/INSTALL (89%) rename README => doc/README (100%) rename README.francais => doc/README.francais (100%) rename README.german => doc/README.german (100%) rename README.SuSE-6.3 => doc/SuSE-6.3.txt (100%) rename README.aix => doc/aix.txt (100%) rename README.gnome-hackers => doc/gnome-hackers.txt (100%) rename README.guile-hackers => doc/guile-hackers.txt (100%) rename README.solaris => doc/solaris.txt (100%) diff --git a/ChangeLog b/ChangeLog index de4143f568..ae3d6b6511 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ 2000-03-29 Dave Peticolas + * 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 diff --git a/Makefile.in b/Makefile.in index d7ce196bd2..fee0197064 100644 --- a/Makefile.in +++ b/Makefile.in @@ -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 diff --git a/README.install b/doc/INSTALL similarity index 89% rename from README.install rename to doc/INSTALL index a9977c660c..8f07057fbd 100644 --- a/README.install +++ b/doc/INSTALL @@ -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 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 - diff --git a/README b/doc/README similarity index 100% rename from README rename to doc/README diff --git a/README.francais b/doc/README.francais similarity index 100% rename from README.francais rename to doc/README.francais diff --git a/README.german b/doc/README.german similarity index 100% rename from README.german rename to doc/README.german diff --git a/README.SuSE-6.3 b/doc/SuSE-6.3.txt similarity index 100% rename from README.SuSE-6.3 rename to doc/SuSE-6.3.txt diff --git a/README.aix b/doc/aix.txt similarity index 100% rename from README.aix rename to doc/aix.txt diff --git a/README.gnome-hackers b/doc/gnome-hackers.txt similarity index 100% rename from README.gnome-hackers rename to doc/gnome-hackers.txt diff --git a/README.guile-hackers b/doc/guile-hackers.txt similarity index 100% rename from README.guile-hackers rename to doc/guile-hackers.txt diff --git a/README.solaris b/doc/solaris.txt similarity index 100% rename from README.solaris rename to doc/solaris.txt diff --git a/src/gnome/window-register.c b/src/gnome/window-register.c index adecb3091d..085ab51bb3 100644 --- a/src/gnome/window-register.c +++ b/src/gnome/window-register.c @@ -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"); diff --git a/src/scm/date-utilities.scm b/src/scm/date-utilities.scm index 56134841a3..07af75189d 100644 --- a/src/scm/date-utilities.scm +++ b/src/scm/date-utilities.scm @@ -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)))) diff --git a/src/scm/report/transaction-report.scm b/src/scm/report/transaction-report.scm index d326534dda..51b3aabe1a 100644 --- a/src/scm/report/transaction-report.scm +++ b/src/scm/report/transaction-report.scm @@ -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 - "" - (cond (first (gnc:print-date - (gnc:tr-report-get-date split-scm))) - (else "")) - "" - (cond (first (gnc:tr-report-get-num split-scm)) - (else "")) - "" - (cond (first (gnc:tr-report-get-description split-scm)) - (else "")) - "" - (cond (first (gnc:tr-report-get-memo split-scm)) - (else "")) - "" - (if (string? (car split-sub)) (car split-sub) "") - "" - (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 + "" + (cond (first (gnc:print-date + (gnc:tr-report-get-date split-scm))) + (else "")) + "" + (cond (first (gnc:tr-report-get-num split-scm)) + (else "")) + "" + (cond (first (gnc:tr-report-get-description split-scm)) + (else "")) + "" + (cond (first (gnc:tr-report-get-memo split-scm)) + (else "")) + "" + account-name + "" + (cond ((< (cadr split-sub) 0) + (string-append + (gnc:amount->string (- (cadr split-sub)) #f #t #f) "")) - (else - (string-append - "" - (gnc:amount->string (cadr split-sub) #f #t #f)))) + (else + (string-append + "" + (gnc:amount->string (cadr split-sub) #f #t #f)))) "" (cond ((not last) "") - (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 "" @@ -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 "" "" - "" (gnc:titles))) + "
" + "" + (gnc:titles))) (suffix (list "
" + (string-db 'lookup 'tr-report) " - " + (gnc:account-get-full-name (car accounts)) + "
" "" "")) (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 @@ "" (string-db 'lookup 'no-accounts) "")) (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")