IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Richard -Gilligan- Uschold's tax report patch.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3905 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-04-07 07:14:21 +00:00
parent ba6b95ec45
commit 83d28bc2b3
1 changed files with 24 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
src/scm/report/taxtxf.scm
View File

@ -181,6 +181,10 @@
(define (txf-payer? payer) (define (txf-payer? payer)
(member payer '('current 'parent))) (member payer '('current 'parent)))
(define (gnc:account-get-txf account)
(and (gnc:account-get-tax-related account)
(not (equal? (gnc:account-get-txf-code account) 'N000))))
(define (gnc:account-get-txf-code account) (define (gnc:account-get-txf-code account)
(let ((code (gnc:account-get-tax-US-code account))) (let ((code (gnc:account-get-tax-US-code account)))
(string->symbol (if code code "N000")))) (string->symbol (if code code "N000"))))
@ -197,13 +201,13 @@
;; because we use the list-option input structure, we have to build our own ;; because we use the list-option input structure, we have to build our own
;; search function ;; search function
(define (txfq-ref key txf-list) ; (define (txfq-ref key txf-list)
(do ((i 0 (+ i 1)) ; (do ((i 0 (+ i 1))
(len (length txf-list))) ; (len (length txf-list)))
((or (>= i len) (eq? key (vector-ref (list-ref txf-list i) 0))) ; ((or (>= i len) (eq? key (vector-ref (list-ref txf-list i) 0)))
(if (>= i len) ; (if (>= i len)
(list-ref txf-list 0) ; (list-ref txf-list 0)
(list-ref txf-list i))))) ; (list-ref txf-list i)))))
;; check for duplicate txf codes ;; check for duplicate txf codes
(define (txf-check-dups account) (define (txf-check-dups account)
@ -261,7 +265,7 @@
(define (render-txf-account account account-value date) (define (render-txf-account account account-value date)
(let* ((print-info (gnc:account-value-print-info account #f)) (let* ((print-info (gnc:account-value-print-info account #f))
(value (gnc:amount->string account-value print-info)) (value (gnc:amount->string account-value print-info))
(txf? (gnc:account-get-tax-related account))) (txf? (gnc:account-get-txf account)))
(if (and txf? (if (and txf?
(not (equal? value (gnc:amount->string 0 print-info)))) (not (equal? value (gnc:amount->string 0 print-info))))
(let* ((type (gw:enum-<gnc:AccountType>-val->sym (let* ((type (gw:enum-<gnc:AccountType>-val->sym
@ -314,7 +318,7 @@
(if (or full-names (equal? level 1)) (if (or full-names (equal? level 1))
(gnc:account-get-full-name account) (gnc:account-get-full-name account)
(gnc:account-get-name account)))) (gnc:account-get-name account))))
(blue? (gnc:account-get-tax-related account)) (blue? (gnc:account-get-txf account))
(print-info (gnc:account-value-print-info account #f)) (print-info (gnc:account-value-print-info account #f))
(value (gnc:amount->string lx-value print-info)) (value (gnc:amount->string lx-value print-info))
(value-formatted (value-formatted
@ -338,7 +342,7 @@
(list (list
(gnc:make-html-table-cell (gnc:make-html-table-cell
(apply gnc:make-html-text (apply gnc:make-html-text
(append (make-list level "&nbsp;") (append (make-list (* 6 level) "&nbsp;")
(list account-name))))) (list account-name)))))
blank-cells blank-cells
(list (list
@ -547,18 +551,18 @@
(let ((type (gw:enum-<gnc:AccountType>-val->sym (let ((type (gw:enum-<gnc:AccountType>-val->sym
(gnc:account-get-type account) #f)) (gnc:account-get-type account) #f))
(name (gnc:account-get-name account))) (name (gnc:account-get-name account)))
(if (gnc:account-is-inc-exp? account) (if (gnc:account-is-inc-exp? account)
(let ((children (gnc:account-get-children account)) (let ((children (gnc:account-get-children account))
(account-balance (if (gnc:account-get-tax-related account) (account-balance (if (gnc:account-get-tax-related account)
(gnc:account-get-balance-interval (gnc:account-get-balance-interval
account from-value to-value #f) account from-value to-value #f)
0))) ; don't add non tax related 0))) ; don't add non tax related
(if (and tax-mode (not children)) (if (not children)
(handle-txf-special-splits (handle-txf-special-splits
level account from-value to-value)) level account from-value to-value))
(set! account-balance (+ (if (> max-level level) (set! account-balance (+ (if (> max-level level)
(lx-collector (+ 1 level) (lx-collector (+ 1 level)
'total #f) 'total #f)
@ -568,7 +572,7 @@
(- account-balance) (- account-balance)
account-balance))) account-balance)))
(lx-collector level 'add account-balance) (lx-collector level 'add account-balance)
(let ((level-x-output (let ((level-x-output
(if tax-mode (if tax-mode
(render-level-x-account table level (render-level-x-account table level
@ -580,15 +584,15 @@
(lx-collector 1 'reset #f)) (lx-collector 1 'reset #f))
(if (> max-level level) (if (> max-level level)
(lx-collector (+ 1 level) 'reset #f)) (lx-collector (+ 1 level) 'reset #f))
(if (and tax-mode children) (if children
(gnc:group-map-accounts (gnc:group-map-accounts
(lambda (x) (lambda (x)
(if (>= max-level (+ 1 level)) (if (>= max-level (+ 1 level))
(handle-level-x-account (+ 1 level) x))) (handle-level-x-account (+ 1 level) x)))
children)) children))
level-x-output))))) level-x-output)))))
(let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value)))) (let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value))))
(to-date (strftime "%Y-%b-%d" (localtime (car to-value)))) (to-date (strftime "%Y-%b-%d" (localtime (car to-value))))
(today-date (strftime "D%m/%d/%Y" (today-date (strftime "D%m/%d/%Y"
@ -604,8 +608,8 @@
'() '()
(cons (gnc:make-html-table-header-cell/markup (cons (gnc:make-html-table-header-cell/markup
"number-header" "number-header"
"(" (_ "Sub") " " (_ "Sub") " "
(number->string (- max-level 1)) ")") (number->string (- max-level 1)))
(make-sub-headers (- max-level 1))))) (make-sub-headers (- max-level 1)))))
;; Now, the main body ;; Now, the main body