diff --git a/src/report/locale-specific/us/taxtxf.scm b/src/report/locale-specific/us/taxtxf.scm index ced7522d41..86fc58c618 100644 --- a/src/report/locale-specific/us/taxtxf.scm +++ b/src/report/locale-specific/us/taxtxf.scm @@ -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--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)) @@ -626,7 +626,7 @@ (define (handle-level-x-account level account) (let ((type (gw:enum--val->sym (gnc:account-get-type account) #f))) - + (if (gnc:account-is-inc-exp? account) (let* ((children (gnc:account-get-children account)) (to-special #f) ; clear special-splits-period @@ -646,33 +646,41 @@ to-value)) '())) - + (map (lambda (x) (if (>= max-level (+ 1 level)) (handle-level-x-account (+ 1 level) x) '())) (reverse (gnc:group-get-account-list children))))) - + (account-balance (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 - - (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) + (gnc:numeric-zero)))) ; don't add non tax related + + (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) '() @@ -712,16 +721,16 @@ (car (gnc:timepair-canonical-day-time (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) - + (if (not tax-mode?) ; Do Txf mode (begin (set! file-name ; get file name from user diff --git a/src/report/report-system/report-system.scm b/src/report/report-system/report-system.scm index 457656234e..d676e63762 100644 --- a/src/report/report-system/report-system.scm +++ b/src/report/report-system/report-system.scm @@ -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") diff --git a/src/report/report-system/report-utilities.scm b/src/report/report-system/report-utilities.scm index a8b03fd7ce..70f54d7ea1 100644 --- a/src/report/report-system/report-utilities.scm +++ b/src/report/report-system/report-utilities.scm @@ -388,7 +388,7 @@ ;; commodity->numeric-collector (define (gnc:make-commodity-collector) - (let + (let ;; the association list of (commodity -> value-collector) pairs. ((commoditylist '())) @@ -453,7 +453,7 @@ (if sign? (gnc:numeric-neg ((cadr pair) 'total #f)) ((cadr pair) 'total #f)))))) - + ;; Dispatch function (lambda (action commodity amount) (case action @@ -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: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. @@ -526,21 +501,12 @@ (gnc:query-get-splits query) )) (gnc:free-query query) - + (if (and splits (not (null? splits))) (balance-collector 'add (gnc:account-get-commodity account) (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,33 +583,25 @@ ;; 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 - 'minusmerge (gnc:account-get-comm-balance-at-date - account + (this-collector + 'minusmerge (gnc:account-get-comm-balance-at-date + account (gnc:timepair-end-day-time (gnc:timepair-previous-day from)) 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)))))))