Convert tax report to use gnc-numerics.

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@5199 57a11ea4-9604-0410-9ed3-97b8803252fd

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)
+(define (lx-collector level action arg1 arg2)
-  ((vector-ref levelx-collector (- level 1)) action value))
+  ((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
+                      (amount (gnc:split-get-amount spl))
-                               (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-<gnc:AccountType>-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 
+                             account from-special to-special #f)
-                             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
-                                           (lx-collector (+ 1 level)
+                    (gnc:numeric-add-fixed
-                                                         'total #f)
+                     (if (> max-level level)
-                                           0)
+                         (cadr
-                                       ;; make positive
+                          (lx-collector (+ 1 level)
-                                       (if (eq? type 'income)
+                                        'getpair
-                                           (- account-balance)
+                                        (gnc:account-get-commodity account)
-                                           account-balance)))
+                                        #f))
-              (lx-collector level 'add account-balance)
+                         (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

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")

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
+  (let ((collector (gnc:account-get-comm-balance-at-date
-         (if include-children?
+                    account date include-children?)))
-             (gnc:group-get-balance-at-date
+    (cadr (collector 'getpair (gnc:account-get-commodity account) #f))))
-              (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)))    
 
 ;; 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:Split*>))
       (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
+  (let ((collector (gnc:account-get-comm-balance-interval
-  ;; subtract the balance of the previous day's end (from-date)
+                    account from to include-children?)))
-  ;; instead of the plain date.
+    (cadr (collector 'getpair (gnc:account-get-commodity account) #f))))
-  (- (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?)))
 
 ;; 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 
+    (this-collector
-     'minusmerge (gnc:account-get-comm-balance-at-date 
+     'minusmerge (gnc:account-get-comm-balance-at-date
-		  account 
+		  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)))))))