Index: src/report/locale-specific/us/taxtxf.scm =================================================================== --- src/report/locale-specific/us/taxtxf.scm (revision 17453) +++ src/report/locale-specific/us/taxtxf.scm (working copy) @@ -1,60 +1,78 @@ ;; -*-scheme-*- ;; by Richard -Gilligan- Uschold ;; -;; This prints Tax related accounts and exports TXF files for import to -;; TaxCut, TurboTax, etc. +;; updated by J. Alex Aycinena, July 2008 ;; +;; This report prints transaction detail and account totals for Tax-related +;; accounts sorted by tax code and form/schedule, and exports TXF files for +;; import to TaxCut, TurboTax, etc. +;; ;; For this to work, the user has to segregate taxable and not taxable -;; income to different accounts, as well as deductible and non -;; deductible expenses. +;; income to different accounts, as well as deductible and non- +;; deductible expenses and the accounts need to be referenced to the tax codes. +;; However, there is no need to limit tax codes to just one account. For codes +;; like N286 (Dividend, Ordinary) that can have the "payer" printed on +;; Schedule B on seperate lines, to have amounts from different accounts +;; summarized together for one "payer" line, the accounts referenced to the +;; same tax code for a given "payer" need to be adjacent to each other in the +;; account hierarchy. ;; -;; The user selects the accounts(s) to be printed, if none, all are checked. -;; Automatically prints up to 15 sub-account levels below selected -;; account. Accounts below that are not printed. If you really need -;; more levels, change the MAX_LEVELS constant +;; The user selects the accounts(s) to be printed; if none, all are selected. +;; Includes all sub-account levels below selected account, that are coded for +;; taxes. ;; -;; Optionally, does NOT print accounts with $0.00 values. Prints data -;; between the From and To dates. Optional alternate periods: +;; Optionally, does NOT print tax codes and accounts with $0.00 values. +;; Prints data between the From and To dates, inclusive. +;; Optional alternate periods: ;; "Last Year", "1st Est Tax Quarter", ... "4th Est Tax Quarter" ;; "Last Yr Est Tax Qtr", ... "Last Yr Est Tax Qtr" ;; Estimated Tax Quarters: Dec 31, Mar 31, Jun 30, Aug 31) ;; Optionally prints brief or full account names +;; Optionally prints multi-split details for transactions +;; Optionally prints TXF export parameters for codes and accounts +;; Optionally prints Action/Memo data for a transaction split +;; Optionally prints transaction detail +;; Optionally uses special date processing for selected accounts (see +;; definition for 'txf-special-split?' in the code below) +;; Optionally shades alternate transactions for ease of reading +;; Converts non-USD transaction amounts based on transaction data or, if +;; transaction data is not applicable, on pricedb and user specified date: +;; nearest transaction date or nearest report end date. Converts to zero +;; if there is no entry in pricedb and provides comment accordingly. ;; -;; NOTE: setting of specific dates is squirly! and seems to be -;; current-date dependant! Actually, time of day dependant! Just +;; From prior version: +;; NOTE: setting of specific dates is squirly! and seems +;; to be current-date dependant! Actually, time of day dependant! Just ;; after midnight gives diffenent dates than just before! Referencing ;; all times to noon seems to fix this. Subtracting 1 year sometimes ;; subtracts 2! see "(to-value" +;; +;; Based on prior taxtxf.scm and with references to transaction.scm. -;; depends must be outside module scope -- and should eventually go away. - (define-module (gnucash report taxtxf)) (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing. (use-modules (srfi srfi-1)) (use-modules (ice-9 slib)) +(use-modules (gnucash gnc-module)) + (require 'printf) -(use-modules (gnucash gnc-module)) (gnc:module-load "gnucash/tax/us" 0) (gnc:module-load "gnucash/report/report-system" 0) +(define reportname (N_ "Tax Schedule Report/TXF Export")) -(define reportname (N_ "Tax Report / TXF Export")) +;(define USD-currency (gnc-commodity-table-lookup +; (gnc-commodity-table-get-table (gnc-get-current-book)) +; "CURRENCY" +; "USD")) +;; this comes back as PEN??? rather than USD; need to define further down to get +;; to work -(define (make-level-collector num-levels) - (let ((level-collector (make-vector num-levels))) - (do ((i 0 (+ i 1))) - ((= i num-levels) i) - (vector-set! level-collector i (gnc:make-commodity-collector))) - level-collector)) +(define selected-accounts-sorted-by-form-line-acct (list)) -(define MAX-LEVELS 16) ; Maximum Account Levels +(define today (timespecCanonicalDayTime (cons (current-time) 0))) -(define levelx-collector (make-level-collector MAX-LEVELS)) - -(define today (timespecCanonicalDayTime - (cons (current-time) 0))) - (define bdtm (let ((result (gnc:timepair->date today))) (set-tm:mday result 16) ; 16 @@ -67,13 +85,11 @@ (define after-tax-day (gnc:timepair-later tax-day today)) (define (make-split-list account split-filter-pred) - (reverse (filter split-filter-pred - (xaccAccountGetSplitList account)))) + (filter split-filter-pred (xaccAccountGetSplitList account))) ;; returns a predicate that returns true only if a split is ;; between early-date and late-date -(define (split-report-make-date-filter-predicate begin-date-tp - end-date-tp) +(define (split-report-make-date-filter-predicate begin-date-tp end-date-tp) (lambda (split) (let ((tp (gnc-transaction-get-date-posted @@ -92,9 +108,6 @@ item)) (else (gnc:warn warn-msg item " is the wrong type.")))) -(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! (define tax-qtr-real-qtr-year 10000) @@ -155,13 +168,54 @@ (gnc:register-tax-option (gnc:make-simple-boolean-option gnc:pagename-display (N_ "Suppress $0.00 values") - "f" (N_ "$0.00 valued Accounts won't be printed.") #t)) + "f" (N_ "$0.00 valued Tax codes won't be printed.") #f)) (gnc:register-tax-option (gnc:make-simple-boolean-option - gnc:pagename-display (N_ "Print Full account names") - "g" (N_ "Print all Parent account names") #f)) + gnc:pagename-display (N_ "Do not print full account names") + "g" (N_ "Do not print all Parent account names") #f)) + (gnc:register-tax-option + (gnc:make-simple-boolean-option + gnc:pagename-display (N_ "Do not print all Transfer To/From Accounts") + "h" (N_ "Do not print all split details for multi-split transactions") #f)) + + (gnc:register-tax-option + (gnc:make-simple-boolean-option + gnc:pagename-display (N_ "Print TXF export parameters") + "i" (N_ "Show TXF export parameters for each TXF code/account on report") #f)) + + (gnc:register-tax-option + (gnc:make-simple-boolean-option + gnc:pagename-display (N_ "Do not print Action:Memo data") + "j" (N_ "Do not print Action:Memo data for transactions") #f)) + + (gnc:register-tax-option + (gnc:make-simple-boolean-option + gnc:pagename-display (N_ "Do not print transaction detail") + "k" (N_ "Do not print transaction detail for accounts") #f)) + + (gnc:register-tax-option + (gnc:make-simple-boolean-option + gnc:pagename-display (N_ "Do not use special date processing") + "l" (N_ "Do not print transactions out of specified dates") #f)) + + (gnc:register-tax-option + (gnc:make-simple-boolean-option + gnc:pagename-display (N_ "Shade alternate transactions") + "m" (N_ "Shade background of alternate transactions, if more than one displayed") #f)) + + (gnc:register-tax-option + (gnc:make-multichoice-option + gnc:pagename-display (N_ "Currency conversion date") + "n" (N_ "Select date to use for PriceDB lookups") + 'conv-to-tran-date + (list (list->vector + (list 'conv-to-tran-date (N_ "Nearest transaction date") (N_ "Use nearest to transaction date"))) + (list->vector + (list 'conv-to-report-date (N_ "Nearest report date") (N_ "Use nearest to report date"))) + ))) + (gnc:options-set-default-section options gnc:pagename-general) options) @@ -171,23 +225,18 @@ (define txf-last-payer "") ; if same as current, inc txf-l-count ; this only works if different - ; codes from the same payer are + ; accounts from the same payer are ; grouped in the accounts list (define txf-l-count 0) ; count repeated N codes +(define txf-account-name "") -;; stores assigned txf codes so we can check for duplicates -(define txf-dups-alist '()) - -(define (txf-payer? payer) - (member payer (list 'current 'parent))) - (define (gnc:account-get-txf account) (and (xaccAccountGetTaxRelated account) (not (equal? (gnc:account-get-txf-code account) 'N000)))) (define (gnc:account-get-txf-code account) (let ((code (xaccAccountGetTaxUSCode account))) - (string->symbol (if (string-null? code) "N000" code)))) + (string->symbol (if (string-null? code) "N000" code)))) (define (gnc:get-txf-format code income?) (gnc:txf-get-format (if income? @@ -195,61 +244,25 @@ txf-expense-categories) code)) +(define (gnc:get-txf-multiple code income?) + (gnc:txf-get-multiple (if income? + txf-income-categories + txf-expense-categories) + code)) + +(define (gnc:get-txf-pns code income?) + (gnc:txf-get-payer-name-source (if income? + txf-income-categories + txf-expense-categories) + code)) + (define (gnc:account-get-txf-payer-source account) (let ((pns (xaccAccountGetTaxUSPayerNameSource account))) - (string->symbol (if (string-null? pns) "none" pns)))) + (string->symbol (if (string-null? pns) "none" pns)))) -;; check for duplicate txf codes -(define (txf-check-dups account) - (let* ((code (gnc:account-get-txf-code account)) - (item (assoc-ref txf-dups-alist code)) - (payer (gnc:account-get-txf-payer-source account))) - (if (not (txf-payer? payer)) - (set! txf-dups-alist (assoc-set! txf-dups-alist code - (if item - (cons account item) - (list account))))))) - -;; Print error message for duplicate txf codes and accounts -(define (txf-print-dups doc) - (let ((dups - (apply append - (map (lambda (x) - (let ((cnt (length (cdr x)))) - (if (> cnt 1) - (let* ((acc (cadr x)) - (txf (gnc:account-get-txf acc))) - (cons (string-append - "Code \"" - (symbol->string - (gnc:account-get-txf-code acc)) - "\" has duplicates in " - (number->string cnt) " accounts:") - (map gnc-account-get-full-name - (cdr x)))) - '()))) - txf-dups-alist))) - (text (gnc:make-html-text))) - (if (not (null? dups)) - (begin - (gnc:html-document-add-object! doc text) - (gnc:html-text-append! - text - (gnc:html-markup-p - (gnc:html-markup - "blue" - (_ "WARNING: There are duplicate TXF codes assigned\ - to some accounts. Only TXF codes with payer sources may be repeated.")))) - (map (lambda (s) - (gnc:html-text-append! - text - (gnc:html-markup-p - (gnc:html-markup "blue" s)))) - dups))))) - ;; some codes require special handling (define (txf-special-split? code) - (member code (list 'N521))) ; only one for now + (member code (list 'N521))) ;only one for now Federal estimated tax, qrtrly (define (fill-clamp-sp str len) (string-append (substring (string-append str (make-string len #\space)) @@ -259,33 +272,81 @@ (string-append (substring (string-append str (make-string len #\space)) 0 len))) -(define (make-header-row table max-level) - (gnc:html-table-prepend-row! - table - (append (list (gnc:make-html-table-header-cell/markup - "account-header" (_ "Account Name"))) - (make-sub-headers max-level) - (list (gnc:make-html-table-header-cell/markup - "number-header" (_ "Total")))))) +(define (render-header-row table heading-line-text) + (let ((heading (gnc:make-html-text))) + (gnc:html-text-append! heading (gnc:html-markup-b heading-line-text)) + (let ((heading-cell (gnc:make-html-table-cell heading))) + (gnc:html-table-cell-set-colspan! heading-cell 5) + (gnc:html-table-append-row! + table + (append (list heading-cell) + (list (gnc:make-html-table-cell "   "))) + ) + ) + ) +) -(define (make-sub-headers max-level) - (if (<= max-level 1) - '() - (cons (gnc:make-html-table-header-cell/markup - "number-header" - "Sub-" - (number->string (- max-level 1))) - (make-sub-headers (- max-level 1))))) +(define (render-account-detail-header-row table suppress-action-memo?) + (gnc:html-table-append-row! + table + (append (list (gnc:make-html-table-header-cell + (_ "Date"))) + (list (gnc:make-html-table-header-cell + (_ "Num"))) + (list (gnc:make-html-table-header-cell + (_ "Description"))) + (list (gnc:make-html-table-header-cell + (if suppress-action-memo? + (_ "Notes") + (_ "Notes/Action:Memo")))) + (list (gnc:make-html-table-header-cell + (_ "Transfer To/From Account(s)"))) + (list (gnc:make-html-table-header-cell/markup + "number-header" (_ "Amount"))) + ) + ) +) -(define (render-txf-account account account-value d? date x? x-date) - (let* ((print-info (gnc-account-print-info account #t)) +(define (render-total-row table total-amount total-line-text + tax_code? transaction-details?) + (let ((description (gnc:make-html-text)) + (total (gnc:make-html-text))) + (if (or tax_code? transaction-details?) + (gnc:html-text-append! description (gnc:html-markup-b + (string-append "       " (_ "Total For ")))) + (if (not tax_code?) + (gnc:html-text-append! description (gnc:html-markup-b + "       ")) + ) + ) + (gnc:html-text-append! description (gnc:html-markup-b + total-line-text)) + (gnc:html-text-append! description (gnc:html-markup-b + (_ " "))) + (gnc:html-text-append! total (gnc:html-markup-b + total-amount)) + (let ((description-cell (if (or tax_code? transaction-details?) + (gnc:make-html-table-cell/markup + "account-total" description) + (gnc:make-html-table-cell description)))) + (gnc:html-table-cell-set-colspan! description-cell 5) + (gnc:html-table-append-row! + table + (append (list description-cell) + (list (gnc:make-html-table-cell/markup + "number-cell" total)))) + ) ;; end of let + ) ;; end of let +) + +(define (render-txf-account account account-value d? date x? x-date + type code) + (let* ((print-info (gnc-account-print-info account #f)) (value (xaccPrintAmount account-value print-info)) (txf? (gnc:account-get-txf account))) (if (and txf? (not (gnc-numeric-zero-p account-value))) - (let* ((type (xaccAccountGetType account)) - (code (gnc:account-get-txf-code account)) - (date-str (if date + (let* ((date-str (if date (strftime "%m/%d/%Y" (localtime (car date))) #f)) (x-date-str (if x-date @@ -293,25 +354,6 @@ #f)) ;; Only formats 1,3 implemented now! Others are treated as 1. (format (gnc:get-txf-format code (eq? type ACCT-TYPE-INCOME))) - (payer-src (gnc:account-get-txf-payer-source account)) - (account-name (let* ((named-acct - (if (eq? payer-src 'parent) - (gnc-account-get-parent account) - account)) - (name (xaccAccountGetName named-acct))) - (if (not (string-null? name)) - name - (begin - (display - (string-append - "Failed to get name for account: " - (gncAccountGetGUID named-acct) - (if (not (eq? account named-acct)) - (string-append - " which is the parent of " - (gncAccountGetGUID account))) - "\n")) - " -- See the Terminal Output")))) (action (if (eq? type ACCT-TYPE-INCOME) (case code ((N286 N488) "ReinvD") @@ -324,37 +366,30 @@ txf-expense-categories code))) (value-name (if (equal? "ReinvD" action) (string-append - (substring value 1 (string-length value)) - " " account-name) - account-name)) - (value (if (eq? type ACCT-TYPE-INCOME) ; negate expenses - value - (string-append - "$-" (substring value 1 (string-length value))))) - (l-value (if (= format 3) - (begin - (set! txf-l-count - (if (equal? txf-last-payer account-name) - txf-l-count - (+ 1 txf-l-count))) - (set! txf-last-payer account-name) - (number->string txf-l-count)) - "1"))) + (xaccPrintAmount (gnc-numeric-neg account-value) + print-info) + " " txf-account-name) + txf-account-name)) + (value (string-append "$" ; reverse signs on dr's & cr's + (xaccPrintAmount + (gnc-numeric-neg account-value) + print-info))) + ) (list (if x? "TD" "TS") crlf (symbol->string code) crlf "C1" crlf - "L" l-value crlf + "L" (number->string txf-l-count) crlf (if d? (list "D" date-str crlf) '()) value crlf (case format - ((3) (list "P" account-name crlf)) + ((3) (list "P" txf-account-name crlf)) (else (if (and x? (txf-special-split? code)) (list "P" crlf) '()))) (if x? - (list "X" x-date-str " " (fill-clamp-sp account-name 31) + (list "X" x-date-str " " (fill-clamp-sp txf-account-name 31) (fill-clamp-sp action 7) (fill-clamp-sp value-name 82) (fill-clamp category-key 15) crlf) @@ -362,51 +397,608 @@ "^" crlf)) ""))) -;; Render any level -(define (render-level-x-account table level max-level account lx-value - suppress-0 full-names txf-date) - (let* ((account-name (if txf-date ; special split - (strftime "%Y-%b-%d" (localtime (car txf-date))) - (if (or full-names (equal? level 1)) - (gnc-account-get-full-name account) - (xaccAccountGetName account)))) - (blue? (gnc:account-get-txf account)) - (print-info (gnc-account-print-info account #f)) - (value (xaccPrintAmount lx-value print-info)) - (value-formatted (if (= 1 level) - (gnc:html-markup-b value) - value)) - (value-formatted (gnc:make-html-text - (if blue? - (gnc:html-markup "blue" value-formatted) - value-formatted))) - (account-name (if blue? - (gnc:html-markup "blue" account-name) - ;; Note: gnc:html-markup adds an extra space - ;; before the " Price Editor dialog to enter prices. Set to zero for this report.)") + ) + (string-append + (_ "(Converted ") + (if (gnc-commodity-equiv account-commodity + USD-currency) + (gnc-commodity-get-mnemonic trans-currency) + (gnc-commodity-get-mnemonic account-commodity) + ) + " " + converted-qty + (if + (and (not (gnc-commodity-equiv account-commodity + USD-currency)) + (not (gnc-commodity-equiv trans-currency + USD-currency)) + ) + (string-append (_ " @ PriceDB lookup rate of ")) + (string-append + (_ " @ transaction split rate of ") + (xaccPrintAmount + (if (not (gnc-commodity-equiv + trans-currency + USD-currency)) + (gnc-numeric-div + (gnc:make-gnc-numeric 100 100) + (xaccSplitGetSharePrice split) + GNC-DENOM-AUTO + (logior (GNC-DENOM-SIGFIGS 6) + GNC-RND-ROUND)) + (xaccSplitGetSharePrice split) + ) + print-info) + (_ ")") + ) + ) + ) + ) + ) + (conversion-text2 (if missing-pricedb-entry? + "" + (if (and (not (gnc-commodity-equiv account-commodity + USD-currency)) + (not (gnc-commodity-equiv trans-currency + USD-currency)) + ) + (string-append + (_ " on ") + (strftime "%Y-%b-%d" + (localtime (car pricedb-lookup-price-time))) + (_ ")") + ) + "")) + ) + ) + (list amount conversion-text pricedb-lookup-price conversion-text2) + ) +) - (if (or (not suppress-0) (= level 1) - (not (gnc-numeric-zero-p lx-value))) +(define (process-transaction-multi-transfer-detail split parent + USD-currency full-names? trans-date trans-currency acct-type + currency-conversion-date to-date transfer-table print-amnt) + (let* ((all-tran-splits (xaccTransGetSplitList parent)) + (tran-splits-to-render (- (length all-tran-splits) 1)) + (trans-rpt-currency-total (gnc-numeric-zero)) ;;for USD-currency + ) + (map (lambda (tran-split) + (if (not (xaccSplitEqual split tran-split #t #f #f)) + (let* ((split-acct (xaccSplitGetAccount tran-split)) + (split-acct-commodity + (xaccAccountGetCommodity split-acct)) + (splt-amnt (xaccSplitGetAmount tran-split)) + (splt-amnt (if (eq? acct-type ACCT-TYPE-INCOME) + splt-amnt + (gnc-numeric-neg splt-amnt))) + (splt-curr-conv-note "") + (splt-curr-conv-data (list splt-amnt + splt-curr-conv-note #f "")) + (splt-curr-conv-data (if (and (gnc-commodity-equiv + split-acct-commodity + USD-currency) + (gnc-commodity-equiv + trans-currency + USD-currency)) + splt-curr-conv-data + (process-currency-conversion + tran-split + USD-currency + split-acct-commodity + (if (equal? + currency-conversion-date + 'conv-to-tran-date) + trans-date + to-date) + trans-currency + splt-amnt + (gnc-account-print-info + split-acct #f) + (if (eq? acct-type + ACCT-TYPE-INCOME) + #f + #t)) + )) + (splt-print-amnt (car splt-curr-conv-data)) + (splt-account-name (if full-names? + (xaccAccountGetFullName split-acct) + (xaccAccountGetName split-acct) + )) + (cell (gnc:make-html-table-cell + (if (string=? (cadr splt-curr-conv-data) "") + splt-account-name + (string-append splt-account-name " " + (cadr splt-curr-conv-data)) + ) + )) + ) + (if (caddr splt-curr-conv-data) + (begin + (gnc:html-table-cell-append-objects! + cell + (gnc:html-price-anchor + (caddr splt-curr-conv-data) #f)) + (gnc:html-table-cell-append-objects! + cell + (car (cdddr splt-curr-conv-data))) + ) + #f + ) + (gnc:html-table-append-row! + transfer-table + (append + (list cell) + (list (gnc:make-html-table-cell/markup + "num-cell-align-bot" (gnc:html-split-anchor + tran-split + splt-print-amnt)) + ) + ) + ) + (set! trans-rpt-currency-total (gnc-numeric-add-fixed + trans-rpt-currency-total + splt-print-amnt)) + ) ;; end of let* + ) ;; end of if + ) ;; end of lamda + all-tran-splits) ;; end of map + ;; if several splits are converted from several currencies, it is + ;; possible that they won't add - this is a 'plug' amount to make + ;; the converted amounts for the transaction add to zero on the report. + (if (not (gnc-numeric-equal print-amnt trans-rpt-currency-total)) + (let* ((conversion-text (gnc:make-html-text)) + (conversion-text-content + (_ "Multiple currency conversion differences")) + (conversion-cell (gnc:make-html-table-cell + conversion-text-content))) + (gnc:html-table-append-row! + transfer-table + (append + (list conversion-cell) + (list (gnc:make-html-table-cell/markup + "num-cell-align-bot" (gnc-numeric-add-fixed + print-amnt + (gnc-numeric-neg + trans-rpt-currency-total))) + ) + ) + ) + ) + ) ;; end of if + ) ;; end of let* +) + +;; Render transaction detail +(define (process-account-transaction-detail table account split-list + split-details? full-names? currency-conversion-date to-date + transaction-details? suppress-action-memo? + shade-alternate-transactions? splits-period full-year? to-value + tax-mode? show-TXF-data? USD-currency account-type + tax-code acct-full-name) + + (let* + ((account-commodity (xaccAccountGetCommodity account)) + (format (gnc:get-txf-format tax-code (eq? account-type ACCT-TYPE-INCOME))) + (payer-src (gnc:account-get-txf-payer-source account)) + (code-pns (gnc:get-txf-pns tax-code (eq? account-type ACCT-TYPE-INCOME))) + (l-value (begin + (set! txf-account-name (xaccAccountGetName + (if (eq? payer-src 'parent) + (gnc-account-get-parent account) + account))) + (set! txf-l-count (if (= format 3) + (if (equal? txf-last-payer + txf-account-name) + txf-l-count + (if (equal? "" txf-last-payer) + 1 + (+ 1 txf-l-count))) + 1)) + (set! txf-last-payer (if (= format 3) + txf-account-name + "")) + (number->string txf-l-count))) + (acct-collector (gnc:make-commodity-collector)) + (acct-collector-as-dr (gnc:make-commodity-collector)) + (account-commodity-total (gnc-numeric-zero)) + (account-commodity-total-as-dr (gnc-numeric-zero)) + (account-USD-total (gnc-numeric-zero)) + (account-desc (string-append + acct-full-name + (if (gnc-commodity-equiv account-commodity USD-currency) + "" + (string-append (_ " (Account Commodity: ") + (gnc-commodity-get-mnemonic account-commodity) + (_ ")"))) + (if show-TXF-data? + (let* ((pns (if (or (eq? 'parent code-pns) + (eq? 'current code-pns)) + (if (eq? 'parent payer-src) + (_ "Name Source is Parent") + (_ "Name Source is Current")) + "")) + (line (if (= format 3) + (string-append (_ "Line ") l-value) + "")) + ) + (if (eq? pns "") + (if (eq? line "") + "" + (string-append + (_ " (TXF Parameter: ") line (_ ")"))) + (if (eq? line "") + (string-append + (_ " (TXF Parameter: ") pns (_ ")")) + (string-append + (_ " (TXF Parameters: ") pns (_", ") + line (_ ")")))) + ) + ""))) + (print-info (gnc-account-print-info account #f)) + (shade-this-line? #f) + (output '()) + ) + (acct-collector 'reset #f #f) ;initialize to zero for this account + (if (and transaction-details? tax-mode?) (begin - (gnc:html-table-prepend-row! - table - (append - (list (gnc:make-html-table-cell - (apply gnc:make-html-text - (append (make-list (* 3 (- level 1)) "  ") - (list account-name))))) - blank-cells - (list (gnc:make-html-table-cell/markup "number-cell" - value-formatted)) - end-cells)) - (if (= level 1) (make-header-row table max-level)))))) + (render-header-row table (string-append + "       " account-desc)) + (render-account-detail-header-row table suppress-action-memo?))) + (set! output + (map (lambda (split) + (let* ((parent (xaccSplitGetParent split)) + (trans-date (gnc-transaction-get-date-posted parent)) + ;; TurboTax 1999 and 2000 ignore dates after Dec 31 + (fudge-date (if splits-period + (if (and full-year? + (gnc:timepair-lt to-value trans-date)) + to-value + trans-date) + trans-date)) + (notes (xaccTransGetNotes parent)) + (action (if suppress-action-memo? + "" + (xaccSplitGetAction split))) + (memo (if suppress-action-memo? + "" + (xaccSplitGetMemo split))) + (action-memo (if (and (string=? action "") (string=? memo "")) + "" + (begin + (string-append (_ "/") action + (if (string=? memo "") + "" + (string-append (_ ":") memo)))))) + (notes-act-memo (string-append notes action-memo)) + (trans-currency (xaccTransGetCurrency parent)) + (splt-amount (xaccSplitGetAmount split)) + (splt-amount-is-dr? (if (gnc-numeric-positive-p splt-amount) + #t + #f)) + (splt-rpt-amount (if (eq? account-type ACCT-TYPE-INCOME) + (gnc-numeric-neg splt-amount) + splt-amount)) + (curr-conv-note "") + (curr-conv-data (list splt-rpt-amount curr-conv-note #f "")) + (curr-conv-data (if (and (gnc-commodity-equiv + account-commodity USD-currency) + (gnc-commodity-equiv trans-currency + USD-currency)) + curr-conv-data + (process-currency-conversion + split + USD-currency + account-commodity + (if (equal? currency-conversion-date + 'conv-to-tran-date) + trans-date + to-date) + trans-currency + splt-rpt-amount + print-info + (if (eq? account-type ACCT-TYPE-INCOME) + #t + #f)))) + (print-amnt (car curr-conv-data)) + (print-amnt-is-dr? (if (gnc-numeric-positive-p print-amnt) + #t + #f)) + (curr-conv-note (cadr curr-conv-data)) + (other-account (xaccSplitGetAccount + (xaccSplitGetOtherSplit split))) + (other-account-name (if (null? other-account) + (_ "Split") + (if full-names? + (xaccAccountGetFullName + other-account) + (xaccAccountGetName other-account) + ))) + ;; use tables within cells for all items so that row lines up + ;; properly + (date-table (gnc:make-html-table)) + (num-table (gnc:make-html-table)) + (desc-table (gnc:make-html-table)) + (notes-table (gnc:make-html-table)) + (transfer-table (gnc:make-html-table)) + (amount-table (gnc:make-html-table)) + ) ;;end of let* variable definitions + (acct-collector 'add account-commodity + (if (eq? account-type ACCT-TYPE-INCOME) + (gnc-numeric-neg splt-amount) + splt-amount)) + (acct-collector-as-dr 'add account-commodity splt-amount) + (set! account-USD-total (gnc-numeric-add-fixed + account-USD-total print-amnt)) + (if (and transaction-details? tax-mode?) + (begin + (if (and (null? other-account) split-details?) + (process-transaction-multi-transfer-detail + split parent + USD-currency + full-names? + trans-date + trans-currency + account-type + currency-conversion-date + to-date + transfer-table print-amnt)) + (gnc:html-table-append-row! + date-table + (gnc:make-html-table-cell + (strftime "%Y-%b-%d" + (localtime (car trans-date))))) + (gnc:html-table-append-row! + num-table + (gnc:make-html-table-cell (xaccTransGetNum parent))) + (gnc:html-table-append-row! + desc-table + (gnc:make-html-table-cell + (xaccTransGetDescription parent))) + (gnc:html-table-append-row! + notes-table + (gnc:make-html-table-cell notes-act-memo)) + (gnc:html-table-set-style! transfer-table "table" + 'attribute (list "width" "100%")) + (if (not (and (null? other-account) split-details?)) + (let ((cell (gnc:make-html-table-cell + (if (string=? (cadr curr-conv-data) "") + other-account-name + (string-append other-account-name + " " + (cadr curr-conv-data))))) + ) + (if (caddr curr-conv-data) + (begin + (gnc:html-table-cell-append-objects! + cell + (gnc:html-price-anchor + (caddr curr-conv-data) #f)) + (gnc:html-table-cell-append-objects! + cell + (car (cdddr curr-conv-data))) + ) + #f) + (gnc:html-table-append-row! + transfer-table + cell) + ) + (if (not (string=? (cadr curr-conv-data) "")) + (let ((conversion-cell + (gnc:make-html-table-cell/markup + "just-right" curr-conv-note)) + ) + (if (caddr curr-conv-data) + (begin + (gnc:html-table-cell-append-objects! + conversion-cell + (gnc:html-price-anchor + (caddr curr-conv-data) #f)) + (gnc:html-table-cell-append-objects! + conversion-cell + (car (cdddr curr-conv-data))) + ) + #f) + (gnc:html-table-cell-set-colspan! + conversion-cell 2) + (gnc:html-table-append-row! + transfer-table + conversion-cell) + ) + ) + ) + (gnc:html-table-append-row! + amount-table + (gnc:make-html-table-cell/markup + "num-cell-align-bot" (gnc:html-split-anchor + split print-amnt))) + ;; print transaction line + (gnc:html-table-append-row/markup! + table + (if shade-alternate-transactions? + (if shade-this-line? + (begin + (set! shade-this-line? #f) + "tran-detail-shade" + ) + (begin + (set! shade-this-line? #t) + "tran-detail" + )) + "tran-detail") + (append (list (gnc:make-html-table-cell + date-table)) + (list (gnc:make-html-table-cell + num-table)) + (list (gnc:make-html-table-cell + desc-table)) + (list (gnc:make-html-table-cell + notes-table)) + (list (gnc:make-html-table-cell/markup + "just-bot" transfer-table)) + (list (gnc:make-html-table-cell/markup + "num-cell-align-bot" amount-table)) + ) + ) + ) ;; end of begin + ) ;; end of if + ;; for quarterly estimated tax payments, we need to go + ;; get data from splits for TXF output + (if (and splits-period (not tax-mode?)) + (render-txf-account account + (if (or (and print-amnt-is-dr? + splt-amount-is-dr?) + (and (not print-amnt-is-dr?) + (not splt-amount-is-dr?)) + ) + print-amnt + (gnc-numeric-neg print-amnt)) + #t fudge-date #t trans-date + account-type tax-code) + ) + ) ;;end of let* + ) ;;end of lambda + split-list) ;;end of map + ) ;; end of set! + ;; print account totals + (set! account-commodity-total (gnc-numeric-add-fixed account-commodity-total + (cadr (acct-collector 'getpair account-commodity #f)))) + (set! account-commodity-total-as-dr (gnc-numeric-add-fixed + account-commodity-total-as-dr + (cadr (acct-collector-as-dr 'getpair account-commodity #f)))) + (if tax-mode? + (let* ((account-name (if full-names? + acct-full-name + (xaccAccountGetName account))) + (amnt-acct-curr (xaccPrintAmount account-commodity-total + print-info)) + (account-total-amount (xaccPrintAmount account-USD-total + print-info)) + (account-total-line-text + (string-append (if transaction-details? + (_ "Account: ") + "") + account-name + (if (not (gnc-commodity-equiv account-commodity + USD-currency)) + (string-append (_ " (") + amnt-acct-curr + (_ " In ") + (gnc-commodity-get-mnemonic + account-commodity) + (_ ") ")) + ""))) + ) + (render-total-row table + account-total-amount + account-total-line-text + #f + transaction-details?) + ) ;; end of let* + ) ;; end of if + (list account-USD-total + output + (if (or (and (gnc-numeric-positive-p account-USD-total) + (gnc-numeric-positive-p account-commodity-total-as-dr)) + (and (gnc-numeric-negative-p account-USD-total) + (gnc-numeric-negative-p account-commodity-total-as-dr))) + account-USD-total + (gnc-numeric-neg account-USD-total))) + ) ;;end of let* +) ;; Recursivly validate children if parent is not a tax account. ;; Don't check children if parent is valid. @@ -421,7 +1013,7 @@ #t))) accounts)) -(define (generate-tax-or-txf report-name +(define (generate-tax-schedule report-name report-description report-obj tax-mode? @@ -432,17 +1024,60 @@ (gnc:lookup-option (gnc:report-options report-obj) pagename optname))) - ;; the number of account generations: children, grandchildren etc. - (define (num-generations account gen) - (if (eq? (gnc-account-n-children account) 0) - (if (and (xaccAccountGetTaxRelated account) - (txf-special-split? (gnc:account-get-txf-code account))) - (+ gen 1) ; Est Fed Tax has a extra generation - gen) ; no kids, return input - (apply max (gnc:account-map-children - (lambda (x) (num-generations x (+ 1 gen))) - account)))) + ;; List of entries, each containing a form, tax-code (as string), account name + ;; account, and, to avoid having to fetch again later, type and code as + ;; symbol. Only accounts with a tax code are put on list. + (define (make-form-line-acct-list accounts) + (map (lambda (account) + (let* ((account-name (gnc-account-get-full-name account)) + (children (gnc-account-get-children account))) + (if (string-null? (xaccAccountGetTaxUSCode account)) + selected-accounts-sorted-by-form-line-acct + (let* ((type (xaccAccountGetType account)) + (tax-code (gnc:account-get-txf-code account)) + (form (gnc:txf-get-form (if (eq? type + ACCT-TYPE-INCOME) + txf-income-categories + txf-expense-categories) tax-code)) + (form-code-acct (list (list form) + (list (symbol->string + tax-code)) + (list account-name) + (list account) + (list type) + (list tax-code)))) + (set! selected-accounts-sorted-by-form-line-acct + (append (list form-code-acct) + selected-accounts-sorted-by-form-line-acct)) + ) + ) + (if (not (null? children)) + (make-form-line-acct-list children) + selected-accounts-sorted-by-form-line-acct + ) + ) + ) + accounts) + ) + + (define (form-line-acct-less a b) + (let ((string-a (string-append + (car (car a)) " " (car (cadr a)) " " (car (caddr a)))) + (string-b (string-append + (car (car b)) " " (car (cadr b)) " " (car (caddr b))))) + (if (stringdate from-value)) (from-value (gnc:timepair-start-day-time @@ -549,9 +1194,12 @@ (set-tm:isdst bdtm -1) (cons (car (mktime bdtm)) 0)))) - (txf-feedback-str-lst '()) + (form-line-acct-header-printed? #f) + (form-schedule-header-printed? #f) + (tax-code-header-printed? #f) (doc (gnc:make-html-document)) - (table (gnc:make-html-table))) + (table (gnc:make-html-table)) + ) ;; for quarterly estimated tax payments, we need a different period ;; return the sometimes changed (from-est to-est full-year?) dates @@ -567,8 +1215,8 @@ (equal? (tm:mday bdfrom) 1) (equal? (tm:mon bdto) 11) (equal? (tm:mday bdto) 31)))) - ;; Adjust dates so we get the final Estimated Tax - ;; paymnent from the right year + ;; Adjust dates so we get the final Estimated Tax + ;; paymnent from the right year (from-est (if full-year? (let ((bdtm (gnc:timepair->date (timespecCanonicalDayTime @@ -591,253 +1239,575 @@ (list from-est to-est full-year?)) #f)) - ;; for quarterly estimated tax payments, we need to go one level down - ;; and get data from splits - (define (handle-txf-special-splits level account from-est to-est - full-year? to-value) - (let* - ((split-filter-pred (split-report-make-date-filter-predicate - from-est to-est)) - (split-list (make-split-list account split-filter-pred)) - (lev (if (>= max-level (+ 1 level)) - (+ 1 level) - level))) - (map (lambda (spl) - (let* ((date (gnc-transaction-get-date-posted - (xaccSplitGetParent spl))) - (amount (xaccSplitGetAmount spl)) - ;; TurboTax 1999 and 2000 ignore dates after Dec 31 - (fudge-date (if (and full-year? - (gnc:timepair-lt to-value date)) - to-value - date))) - (if tax-mode? - (render-level-x-account table lev max-level account - amount suppress-0 #f date) - (render-txf-account account amount - #t fudge-date #t date)))) - split-list))) - - (define (count-accounts level accounts) - (if (< level max-level) - (let ((sum 0)) - (for-each (lambda (x) - (if (gnc:account-is-inc-exp? x) - (set! sum (+ sum (+ 1 (count-accounts (+ 1 level) - (gnc-account-get-children x))))) - 0)) - accounts) - sum) - (length accounts))) + (define (handle-account account + table + need-form-line-acct-header? + need-form-schedule-header? + current-form-schedule + need-tax-code-header? + tax-code-heading-text + account-type + tax-code + acct-full-name) + (let* ((splits-period (txf-special-splits-period account + from-value + to-value)) + (full-year? (if splits-period + (caddr splits-period))) + (from-special (if splits-period + (car splits-period) + #f)) + (to-special (if splits-period + (cadr splits-period) + #f)) + (split-filter-pred (split-report-make-date-filter-predicate + (if (and (not no-special-dates?) splits-period) + from-special + from-value) + (if (and (not no-special-dates?) splits-period) + to-special + to-value))) + (split-list (make-split-list account split-filter-pred)) + (account-USD-total (gnc-numeric-zero)) + (form-line-acct-text (string-append + (_ "Form or Schedule / Line (TXF Code") + (if show-TXF-data? + (_ ": Parameters") + "") + (_ ") / Account Name"))) + ) + (if (> (length split-list) 0) + (begin + (if tax-mode? + ;; print header for new account, detail and sub-total + (begin + (if need-form-line-acct-header? + (begin + (render-header-row table form-line-acct-text) + (set! form-line-acct-header-printed? #t) + ) + ) + (if need-form-schedule-header? + (begin + (render-header-row table current-form-schedule) + (set! form-schedule-header-printed? #t) + ) + ) + (if need-tax-code-header? + (begin + (render-header-row table + (string-append "   " + tax-code-heading-text)) + (set! tax-code-header-printed? #t) + ) + ) + ) + ) + (let* ((tran-output (process-account-transaction-detail + table + account + split-list + split-details? + full-names? + currency-conversion-date + to-value + transaction-details? + suppress-action-memo? + shade-alternate-transactions? + splits-period + full-year? + to-value + tax-mode? + show-TXF-data? + USD-currency + account-type + tax-code + acct-full-name)) + (tran-txf (cadr tran-output)) + (account-USD-total-as-dr (caddr tran-output)) + ) + (set! account-USD-total (car tran-output)) + (list + account-USD-total + (if (not to-special) + (if (not tax-mode?) + (render-txf-account account + account-USD-total-as-dr + #f #f #t from-value + account-type tax-code) + '()) + tran-txf) + account-USD-total-as-dr + ) + + ) + ) + (begin ;; no split case + (if suppress-0? + (list account-USD-total + '() + account-USD-total + ) + (begin + (if need-form-line-acct-header? + (begin + (render-header-row table form-line-acct-text) + (set! form-line-acct-header-printed? #t) + ) + ) + (if need-form-schedule-header? + (begin + (render-header-row table + current-form-schedule) + (set! form-schedule-header-printed? #t) + ) + ) + (list account-USD-total + '() + account-USD-total) + ) + ) + ) + ) + ) ;; end of let* + ) - (define (handle-level-x-account level account) - (let ((type (xaccAccountGetType account))) - (set! work-done (+ 1 work-done)) - (gnc:report-percent-done (* 100 (if (> work-to-do 0) - (/ work-done work-to-do) - 1))) - (if (gnc:account-is-inc-exp? account) - (let* ((children (gnc-account-get-children-sorted account)) - (to-special #f) ; clear special-splits-period - (from-special #f) - (childrens-output - (if (null? children) - (let* ((splits-period (txf-special-splits-period - account from-value to-value))) - (if splits-period - (let* ((full-year? (caddr splits-period))) - (set! from-special (car splits-period)) - (set! to-special (cadr splits-period)) - (handle-txf-special-splits level account - from-special - to-special - full-year? - to-value)) - - '())) + (let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value)))) + (to-date (strftime "%Y-%b-%d" (localtime (car to-value)))) + (today-date (strftime "D%m/%d/%Y" + (localtime + (car (timespecCanonicalDayTime + (cons (current-time) 0)))))) + (prior-form-schedule "") + (prior-tax-code "") + (prior-account "") + (tax-code-USD-total (gnc-numeric-zero)) + (tax-code-USD-total-as-dr (gnc-numeric-zero)) + (saved-tax-code-text "") + (need-form-line-acct-header? #f) + (need-form-schedule-header? #f) + (need-tax-code-header? #f) + (tax-code-heading-text "") + (tax-code-text "") + ) - (map (lambda (x) - (if (>= max-level (+ 1 level)) - (handle-level-x-account (+ 1 level) x) - '())) - (reverse children)))) + (define (handle-tax-code form-line-acct) + (let* ((current-form-schedule (car (car form-line-acct))) + (current-tax-code (car (cadr form-line-acct))) ;; string + (acct-full-name (car (caddr form-line-acct))) + (account (car (car (cdddr form-line-acct)))) + (type (car (car (cdr (cdddr form-line-acct))))) + (tax-code (car (cadr (cdr (cdddr form-line-acct))))) ;;symbol + (output '()) + (txf-pyr (if (eq? (gnc:account-get-txf-payer-source account) + 'parent) + (xaccAccountGetName (gnc-account-get-parent account)) + (xaccAccountGetName account))) + (txf-new-payer? (if (string=? txf-last-payer txf-pyr) + #f + #t)) + ) + (gnc:debug "acct-full-name" acct-full-name) + ;; process prior tax code break, if appropriate, before + ;; processing current account + (if (string=? prior-tax-code "") + #t ;; do nothing + (if tax-mode? + ;; printed report processing + (if (string=? prior-tax-code current-tax-code) + #t ;; do nothing + (if (and suppress-0? (gnc-numeric-zero-p + tax-code-USD-total)) + #t ;; do nothing + (let* ((print-info (gnc-account-print-info + prior-account #f)) + (tax-code-total-amount + (xaccPrintAmount + tax-code-USD-total + print-info)) + ) + ;; print prior tax-code total and + ;; reset accum + (render-total-row + table + tax-code-total-amount + (string-append + (_ "Line (Code): ") + saved-tax-code-text + ) + #t + transaction-details? + ) + (set! tax-code-USD-total + (gnc-numeric-zero)) + (set! tax-code-USD-total-as-dr + (gnc-numeric-zero)) + (set! txf-l-count 0) + ) + ) + ) + ;; txf output processing + (if (gnc-numeric-zero-p tax-code-USD-total-as-dr) + #t ;; do nothing + (if (or ;; tax-code break + (not (string=? + prior-tax-code current-tax-code) + ) + ;; not tax-code break, but tax-code allows + ;; multiple lines and there is a new payer + (and + (string=? prior-tax-code current-tax-code) + (gnc:get-txf-multiple + (gnc:account-get-txf-code + prior-account) + (eq? (xaccAccountGetType + prior-account) + ACCT-TYPE-INCOME)) + txf-new-payer? + ) + ) + (begin + (set! output + (list (render-txf-account + prior-account + tax-code-USD-total-as-dr + #f #f #f #f + (xaccAccountGetType prior-account) + (gnc:account-get-txf-code + prior-account)))) + (set! tax-code-USD-total (gnc-numeric-zero)) + (set! tax-code-USD-total-as-dr + (gnc-numeric-zero)) + (if (not (string=? prior-tax-code + current-tax-code)) + (begin + (set! txf-new-payer? #t) + (set! txf-l-count 0) + )) + ) + #f ;; do nothing + ) + ) + ) + ) + (if (string=? prior-form-schedule current-form-schedule) + (begin + (if form-line-acct-header-printed? + (set! need-form-line-acct-header? #f) + (set! need-form-line-acct-header? #t) + ) + (if form-schedule-header-printed? + (set! need-form-schedule-header? #f) + (set! need-form-schedule-header? #t) + ) + ) + (begin ;; new form + (set! need-form-line-acct-header? #t) + (set! need-form-schedule-header? #t) + (set! form-line-acct-header-printed? #f) + (set! form-schedule-header-printed? #f) + (set! prior-form-schedule current-form-schedule) + ) + ) + (if (string=? prior-tax-code current-tax-code) + (if tax-code-header-printed? + (set! need-tax-code-header? #f) + (set! need-tax-code-header? #t) + ) + (begin ;; if new tax-code + (let ((description (gnc:txf-get-description + (if (eq? type ACCT-TYPE-INCOME) + txf-income-categories + txf-expense-categories) + tax-code)) + ) + (set! need-tax-code-header? #t) + (set! tax-code-header-printed? #f) + (set! tax-code-text + (string-append description (_ " (") + current-tax-code (_ ")"))) + (set! tax-code-heading-text + (string-append description (_ " (") + current-tax-code + (if show-TXF-data? + (string-append + (_ ": Payer Name Option ") + (if (or (eq? 'parent + (gnc:get-txf-pns tax-code + (eq? ACCT-TYPE-INCOME + type))) + (eq? 'current + (gnc:get-txf-pns tax-code + (eq? ACCT-TYPE-INCOME + type)))) + (_ "Y") + (_ "N")) + (_ ", TXF Format ") + (number->string + (gnc:get-txf-format tax-code + (eq? ACCT-TYPE-INCOME + type))) + (_ ", Multiple Copies ") + (if (gnc:get-txf-multiple tax-code + (eq? ACCT-TYPE-INCOME type)) + (_ "Y") + (_ "N")) + (_ ", Special Dates ") + (if (txf-special-split? tax-code) + (_ "Y") + (_ "N")) + ) + "") + (_ ")"))) + ) + (set! saved-tax-code-text tax-code-text) + ) + ) + (let* ((account-output (handle-account + account + table + need-form-line-acct-header? + need-form-schedule-header? + current-form-schedule + need-tax-code-header? + tax-code-heading-text + type + tax-code + acct-full-name)) + (account-USD-total-as-dr (caddr account-output)) + (code-tfx-output (if (null? output) + (if (null? (cadr account-output)) + '() + (list (cadr account-output))) + (if (null? (cadr account-output)) + (list output) + (list output + (cadr account-output))))) + ) + (set! tax-code-USD-total (gnc-numeric-add-fixed + tax-code-USD-total + (car account-output))) + (set! tax-code-USD-total-as-dr (gnc-numeric-add-fixed + tax-code-USD-total-as-dr + account-USD-total-as-dr)) + (set! need-form-line-acct-header? #f) + (set! need-form-schedule-header? #f) + (set! need-tax-code-header? #f) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done + (* 100 (if (> work-to-do 0) + (/ work-done work-to-do) + 1))) + (set! prior-tax-code current-tax-code) + (set! prior-account account) + (if tax-mode? + '() + code-tfx-output) + ) ;; end of let + ) ;; end of let* + ) - (account-balance - (if (xaccAccountGetTaxRelated account) - (if to-special - (gnc:account-get-balance-interval - account from-special to-special #f) - (gnc:account-get-balance-interval - account from-value to-value #f)) - (gnc-numeric-zero)))) ; don't add non tax related + ;; Now, the main body + (set! selected-accounts-sorted-by-form-line-acct '()) + (make-form-line-acct-list selected-accounts) + (set! selected-accounts-sorted-by-form-line-acct + (sort-list + selected-accounts-sorted-by-form-line-acct + form-line-acct-less + )) + (set! work-to-do (length selected-accounts-sorted-by-form-line-acct)) - (set! account-balance - (gnc-numeric-add-fixed - (if (> max-level level) - (cadr - (lx-collector (+ 1 level) - 'getpair - (xaccAccountGetCommodity account) - #f)) - (gnc-numeric-zero)) - ;; make positive - (if (eq? type ACCT-TYPE-INCOME) - (gnc-numeric-neg account-balance) - account-balance))) + (if (not tax-mode?) ; Do Txf mode + (if file-name ; cancel TXF if no file selected + (let* ((port (open-output-file file-name)) + (output (map (lambda (form-line-acct) + (handle-tax-code form-line-acct)) + selected-accounts-sorted-by-form-line-acct)) + (output-txf (list + "V037" crlf + "AGnuCash " gnc:version crlf + today-date crlf + "^" crlf + output + (if (gnc-numeric-zero-p tax-code-USD-total) + '() + (render-txf-account prior-account + tax-code-USD-total-as-dr + #f #f #f #f + (xaccAccountGetType prior-account) + (gnc:account-get-txf-code + prior-account))) + )) + ) + (gnc:display-report-list-item output-txf port + "taxschedule.scm - ") + (close-output-port port) + #t + ) ;; end of let* + #f) ;;end of if + (begin ; else do tax report + (gnc:html-document-set-style! + doc "account-total" + 'tag "th" + 'attribute (list "align" "right")) - (lx-collector level - 'add - (xaccAccountGetCommodity account) - account-balance) + (gnc:html-document-set-style! + doc "num-cell-align-bot" + 'tag "td" + 'attribute (list "align" "right") + 'attribute (list "valign" "bottom")) - (let ((level-x-output - (if tax-mode? - (render-level-x-account table level - max-level account - account-balance - suppress-0 full-names #f) - (list - (if (not to-special) - (render-txf-account account account-balance - #f #f #t from-value) - '()) - (render-txf-account account account-balance - #f #f #f #f))))) - (if (equal? 1 level) - (lx-collector 1 'reset #f #f)) + (gnc:html-document-set-style! + doc "just-right" + 'tag "td" + 'attribute (list "align" "right")) - (if (> max-level level) - (lx-collector (+ 1 level) 'reset #f #f)) + (gnc:html-document-set-style! + doc "just-bot" + 'tag "td" + 'attribute (list "valign" "bottom")) - (if (null? level-x-output) - '() - (if (null? childrens-output) - level-x-output - (if tax-mode? - (list level-x-output - childrens-output) - (if (null? children) ; swap for txf special splt - (list childrens-output level-x-output) - (list level-x-output childrens-output))))))) - ;; Ignore - '()))) + (gnc:html-document-set-style! + doc "tran-detail" + 'tag "tr" + 'attribute (list "valign" "top")) - (let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value)))) - (to-date (strftime "%Y-%b-%d" (localtime (car to-value)))) - (today-date (strftime "D%m/%d/%Y" - (localtime - (car (timespecCanonicalDayTime - (cons (current-time) 0))))))) + (gnc:html-document-set-style! + doc "tran-detail-shade" + 'tag "tr" + 'attribute (list "valign" "top") + 'attribute (list "bgcolor" "grey")) - ;; Now, the main body - ;; Reset all the balance collectors - (do ((i 1 (+ i 1))) - ((> i MAX-LEVELS) i) - (lx-collector i 'reset #f #f)) + (gnc:html-document-set-title! doc report-name) - (set! txf-last-payer "") - (set! txf-l-count 0) - (set! work-to-do (count-accounts 1 selected-accounts)) + (gnc:html-document-add-object! + doc (gnc:make-html-text + (gnc:html-markup + "center" + (gnc:html-markup-p + (gnc:html-markup/format + (_ "Period from %s to %s
All amounts in USD unless otherwise noted") + from-date + to-date + ))))) - (if (not tax-mode?) ; Do Txf mode - (begin - (if file-name ; cancel TXF if no file selected - (let* ((port (open-output-file file-name)) - (output - (map (lambda (x) (handle-level-x-account 1 x)) - selected-accounts)) - (output-txf (list - "V037" crlf - "AGnuCash " gnc:version crlf - today-date crlf - "^" crlf - output))) + (gnc:html-document-add-object! doc table) - (gnc:display-report-list-item output-txf port - "taxtxf.scm - ") - (close-output-port port) - #t) - #f)) + (map (lambda (form-line-acct) (handle-tax-code form-line-acct)) + selected-accounts-sorted-by-form-line-acct) - (begin ; else do tax report - (gnc:html-document-set-style! - doc "blue" - 'tag "font" - 'attribute (list "color" "#0000ff")) - - (gnc:html-document-set-style! - doc "income" - 'tag "font" - 'attribute (list "color" "#0000ff")) - - (gnc:html-document-set-style! - doc "expense" - 'tag "font" - 'attribute (list "color" "#ff0000")) - - (gnc:html-document-set-style! - doc "account-header" - 'tag "th" - 'attribute (list "align" "left")) - - (gnc:html-document-set-title! doc report-name) - - (gnc:html-document-add-object! - doc (gnc:make-html-text - (gnc:html-markup - "center" + ;; print final tax-code totals + (if (or (and suppress-0? (gnc-numeric-zero-p tax-code-USD-total)) + (null? selected-accounts)) + #t ;; do nothing + (let* ((print-info (gnc-account-print-info prior-account #f)) + (tax-code-total-amount (xaccPrintAmount + tax-code-USD-total + print-info)) + ) + (render-total-row table tax-code-total-amount + (string-append (_ "Line (Code): ") + saved-tax-code-text) + #t + transaction-details? + ) + ) + ) + + (if (null? selected-accounts) + ;; print message for no accounts + (gnc:html-document-add-object! + doc + (gnc:make-html-text (gnc:html-markup-p - (gnc:html-markup/format - (_ "Period from %s to %s") from-date to-date))))) - - (gnc:html-document-add-object! - doc (gnc:make-html-text - (gnc:html-markup - "center" - (gnc:html-markup - "blue" - (gnc:html-markup-p - (_ "Blue items are exportable to a .TXF file.")))))) - - (txf-print-dups doc) - - (gnc:html-document-add-object! doc table) - - (set! txf-dups-alist '()) - (map (lambda (x) (handle-level-x-account 1 x)) - selected-accounts) - - (if (null? selected-accounts) - (gnc:html-document-add-object! - doc - (gnc:make-html-text - (gnc:html-markup-p - (_ "No Tax Related accounts were found. Go to the\ - Edit->Tax Options dialog to set up tax-related accounts."))))) + (_ "No Tax Related accounts were found with your account selection. Change your selection or go to the Edit->Tax Options dialog to set up tax-related accounts.")))) + ;; or print selected report options + (gnc:html-document-add-object! + doc (gnc:make-html-text + (gnc:html-markup-p + (gnc:html-markup/format + (string-append + (_ "Selected Report Options:
") + ;; selected accounts + "      %s
" + ;; suppress 0.00 values + "      %s
" + ;; full acct names + "      %s
" + ;; transfer detail + "      %s
" + ;; TXF detail + "      %s
" + ;; action:memo detail + "      %s
" + ;; transaction detail + "      %s
" + ;; special dates + "      %s
" + ;; alternate transaction shading + "      %s
" + ;; currency conversion date + "      %s
") + (if (not (null? user-sel-accnts)) + (_ "Subset of accounts") + (_ "No accounts (none = all accounts)")) + (if suppress-0? + (_ "Suppress $0.00 valued Tax Codes") + (_ "Do not suppress $0.00 valued Tax Codes")) + (if full-names? + (_ "Display full account names") + (_ "Do not display full account names")) + (if split-details? + (_ "Display all Transfer To/From Accounts") + (_ "Do not display all Transfer To/From Accounts")) + (if show-TXF-data? + (_ "Print TXF export parameters") + (_ "Do not Print TXF export parameters")) + (if suppress-action-memo? + (_ "Do not display Action:Memo data") + (_ "Display Action:Memo data")) + (if transaction-details? + (_ "Display transactions for selected accounts") + (_ "Do not display transactions for selected accounts")) + (if no-special-dates? + (_ "Do not include transactions outside of selected dates") + (_ "Include some transactions outside of selected dates")) + (if shade-alternate-transactions? + (_ "Shade alternate transactions") + (_ "Do not shade alternate transactions")) + (if (equal? currency-conversion-date + 'conv-to-tran-date) + (_ "PriceDB lookups nearest to transaction date") + (_ "PriceDB lookups nearest to report end date")) + ) + )))) - (gnc:report-finished) - doc))))) + (gnc:report-finished) + doc + ) ;end begin + ) ;end if + ))) (gnc:define-report 'version 1 'name reportname 'report-guid "f8921f4e5c284d7caca81e239f468a68" - 'menu-name (N_ "Tax Report & TXF Export") + 'menu-name (N_ "Tax Schedule Report & TXF Export") ;;'menu-path (list gnc:menuname-taxes) - 'menu-tip (N_ "Taxable Income / Deductible Expenses / Export to .TXF file") + 'menu-tip (N_ "Taxable Income/Deductible Expenses with Transaction Detail/Export to .TXF file") 'options-generator tax-options-generator 'renderer (lambda (report-obj) - (generate-tax-or-txf - (_ "Taxable Income / Deductible Expenses") - (_ "This report shows your Taxable Income and \ -Deductible Expenses.") + (generate-tax-schedule + (_ "Taxable Income/Deductible Expenses") + (_ "This report shows transaction detail for your Taxable Income \ +and Deductible Expenses.") report-obj #t #f)) 'export-types (list (cons (_ "TXF") 'txf)) 'export-thunk (lambda (report-obj choice file-name) - (generate-tax-or-txf - (_ "Taxable Income / Deductible Expenses") + (generate-tax-schedule + (_ "Taxable Income/Deductible Expenses") (_ "This page shows your Taxable Income and \ Deductible Expenses.") report-obj