mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
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:
parent
c88f2c44df
commit
449c6ea7f0
@ -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)
|
||||
(lx-collector (+ 1 level)
|
||||
'total #f)
|
||||
0)
|
||||
;; make positive
|
||||
(if (eq? type 'income)
|
||||
(- account-balance)
|
||||
account-balance)))
|
||||
(lx-collector level 'add account-balance)
|
||||
(set! account-balance
|
||||
(gnc:numeric-add-fixed
|
||||
(if (> max-level level)
|
||||
(cadr
|
||||
(lx-collector (+ 1 level)
|
||||
'getpair
|
||||
(gnc:account-get-commodity account)
|
||||
#f))
|
||||
(gnc:numeric-zero))
|
||||
;; make positive
|
||||
(if (eq? type 'income)
|
||||
(gnc:numeric-neg account-balance)
|
||||
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)
|
||||
|
||||
|
@ -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")
|
||||
|
@ -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)))))))
|
||||
|
Loading…
Reference in New Issue
Block a user