Convert tax report to use gnc-numerics.

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@5199 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-08-20 00:40:25 +00:00
parent c88f2c44df
commit 449c6ea7f0
3 changed files with 55 additions and 100 deletions

View File

@ -56,7 +56,7 @@
(let ((level-collector (make-vector num-levels)))
(do ((i 0 (+ i 1)))
((= i num-levels) i)
(vector-set! level-collector i (gnc:make-stats-collector)))
(vector-set! level-collector i (gnc:make-commodity-collector)))
level-collector))
(define MAX-LEVELS 16) ; Maximum Account Levels
@ -104,8 +104,8 @@
item))
(else (gnc:warn warn-msg item " is the wrong type."))))
(define (lx-collector level action value)
((vector-ref levelx-collector (- level 1)) action value))
(define (lx-collector level action arg1 arg2)
((vector-ref levelx-collector (- level 1)) action arg1 arg2))
;; IRS asked congress to make the tax quarters the same as real quarters
;; This is the year it is effective. THIS IS A Y10K BUG!
@ -288,7 +288,7 @@
(value (gnc:amount->string account-value print-info))
(txf? (gnc:account-get-txf account)))
(if (and txf?
(not (equal? value (gnc:amount->string 0 print-info))))
(not (gnc:numeric-zero-p account-value)))
(let* ((type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type account) #f))
(code (gnc:account-get-txf-code account))
@ -382,11 +382,12 @@
(blank-cells (make-list (- max-level level)
(gnc:make-html-table-cell #f)))
(end-cells (make-list (- level 1) (gnc:make-html-table-cell #f))))
(if (and blue? (not txf-date)) ; check for duplicate txf codes
(txf-check-dups account))
;;(if (not (equal? lx-value 0.0)) ; this fails, round off, I guess
(if (or (not suppress-0) (= level 1)
(not (equal? value (gnc:amount->string 0 print-info))))
(not (gnc:numeric-zero-p lx-value)))
(begin
(gnc:html-table-prepend-row!
table
@ -609,8 +610,7 @@
(map (lambda (spl)
(let* ((date (gnc:transaction-get-date-posted
(gnc:split-get-parent spl)))
(amount (gnc:numeric-to-double
(gnc:split-get-amount spl)))
(amount (gnc:split-get-amount spl))
;; TurboTax 1999 and 2000 ignore dates after Dec 31
(fudge-date (if (and full-year?
(gnc:timepair-lt to-value date))
@ -658,21 +658,29 @@
(if (gnc:account-get-tax-related account)
(if to-special
(gnc:account-get-balance-interval
account from-special
to-special #f)
account from-special to-special #f)
(gnc:account-get-balance-interval
account from-value to-value #f))
0))) ; don't add non tax related
(gnc:numeric-zero)))) ; don't add non tax related
(set! account-balance (+ (if (> max-level level)
(set! account-balance
(gnc:numeric-add-fixed
(if (> max-level level)
(cadr
(lx-collector (+ 1 level)
'total #f)
0)
'getpair
(gnc:account-get-commodity account)
#f))
(gnc:numeric-zero))
;; make positive
(if (eq? type 'income)
(- account-balance)
(gnc:numeric-neg account-balance)
account-balance)))
(lx-collector level 'add account-balance)
(lx-collector level
'add
(gnc:account-get-commodity account)
account-balance)
(let ((level-x-output
(if tax-mode?
@ -688,9 +696,10 @@
(render-txf-account account account-balance
#f #f #f #f)))))
(if (equal? 1 level)
(lx-collector 1 'reset #f))
(lx-collector 1 'reset #f #f))
(if (> max-level level)
(lx-collector (+ 1 level) 'reset #f))
(lx-collector (+ 1 level) 'reset #f #f))
(if (null? level-x-output)
'()
@ -713,12 +722,12 @@
(cons (current-time) 0))))))
(file-name #f))
;; Now, the main body
;; Reset all the balance collectors
(do ((i 1 (+ i 1)))
((> i MAX-LEVELS) i)
(lx-collector i 'reset #f))
(lx-collector i 'reset #f #f))
(set! txf-last-payer "")
(set! txf-l-count 0)

View File

@ -514,7 +514,6 @@
(export gnc:make-commodity-collector)
(export gnc:account-get-balance-at-date)
(export gnc:account-get-comm-balance-at-date)
(export gnc:group-get-balance-at-date)
(export gnc:accounts-get-balance-helper)
(export gnc:accounts-get-comm-total-profit)
(export gnc:accounts-get-comm-total-income)
@ -523,10 +522,8 @@
(export gnc:group-get-comm-balance-at-date)
(export gnc:account-get-balance-interval)
(export gnc:account-get-comm-balance-interval)
(export gnc:group-get-balance-interval)
(export gnc:group-get-comm-balance-interval)
(export gnc:transaction-get-splits)
(export gnc:split-get-other-splits)
(load-from-path "commodity-utilities.scm")
(load-from-path "html-barchart.scm")

View File

@ -471,34 +471,9 @@
;; is true, the balances of all children (not just direct children)
;; are included in the calculation.
(define (gnc:account-get-balance-at-date account date include-children?)
(let ((children-balance
(if include-children?
(gnc:group-get-balance-at-date
(gnc:account-get-children account) date)
0))
(balance #f)
(query (gnc:malloc-query))
(splits #f))
(gnc:query-set-group query (gnc:get-current-group))
(gnc:query-add-single-account-match query account 'query-and)
(gnc:query-add-date-match-timepair query #f date #t date 'query-and)
(gnc:query-set-sort-order query 'by-date 'by-standard 'by-none)
(gnc:query-set-sort-increasing query #t #t #t)
(gnc:query-set-max-splits query 1)
(set! splits (gnc:glist->list
(gnc:query-get-splits query)
<gnc:Split*>))
(gnc:free-query query)
(if (and splits (not (null? splits)))
(set! balance (gnc:numeric-to-double
(gnc:split-get-balance (car splits))))
(set! balance 0.0))
(if include-children?
(+ balance children-balance)
balance)))
(let ((collector (gnc:account-get-comm-balance-at-date
account date include-children?)))
(cadr (collector 'getpair (gnc:account-get-commodity account) #f))))
;; This works similar as above but returns a commodity-collector,
;; thus takes care of children accounts with different currencies.
@ -532,15 +507,6 @@
(gnc:split-get-balance (car splits))))
balance-collector))
;; get the balance of a group of accounts at the specified date
;; inlcuding child accounts.
(define (gnc:group-get-balance-at-date group date)
(apply +
(gnc:group-map-all-accounts
(lambda (account)
(gnc:account-get-balance-at-date account date #f))
group)))
;; Adds all accounts' balances, where the balances are determined with
;; the get-balance-fn. The reverse-balance-fn
;; (e.g. gnc:account-reverse-balance?) should return #t if the
@ -617,18 +583,16 @@
;; this isn't quite as efficient as it could be, but it's a whole lot
;; simpler :)
(define (gnc:account-get-balance-interval account from to include-children?)
;; Since this function calculates a balance difference it has to
;; subtract the balance of the previous day's end (from-date)
;; instead of the plain date.
(- (gnc:account-get-balance-at-date account to include-children?)
(gnc:account-get-balance-at-date
account
(gnc:timepair-end-day-time (gnc:timepair-previous-day from))
include-children?)))
(let ((collector (gnc:account-get-comm-balance-interval
account from to include-children?)))
(cadr (collector 'getpair (gnc:account-get-commodity account) #f))))
;; the version which returns a commodity-collector
(define (gnc:account-get-comm-balance-interval
account from to include-children?)
;; Since this function calculates a balance difference it has to
;; subtract the balance of the previous day's end (from-date)
;; instead of the plain date.
(let ((this-collector (gnc:account-get-comm-balance-at-date
account to include-children?)))
(this-collector
@ -638,12 +602,6 @@
include-children?) #f)
this-collector))
(define (gnc:group-get-balance-interval group from to)
(apply +
(gnc:group-map-all-accounts
(lambda (account)
(gnc:account-get-balance-interval account from to #t)) group)))
;; the version which returns a commodity-collector
(define (gnc:group-get-comm-balance-interval group from to)
(let ((this-collector (gnc:make-commodity-collector)))
@ -654,6 +612,7 @@
account from to #t)) group))
this-collector))
;; FIXME redundant
(define (gnc:transaction-get-splits transaction)
(let* ((num-splits (gnc:transaction-get-split-count transaction)))
(let loop ((index 0))
@ -662,13 +621,3 @@
(cons
(gnc:transaction-get-split transaction index)
(loop (+ index 1)))))))
;; given one split, return the other splits in a transaction
(define (gnc:split-get-other-splits split)
(let loop ((splits
(gnc:transaction-get-splits (gnc:split-get-parent split))))
(if (null? splits)
'()
(if (equal? (car splits) split)
(loop (cdr splits))
(cons (car splits) (loop (cdr splits)))))))