From a4027674f993ea4693b33cf22f212a4a2dd784fb Mon Sep 17 00:00:00 2001 From: Christian Stimming Date: Wed, 29 Dec 2004 16:57:35 +0000 Subject: [PATCH] Add de_DE tax categories. 2004-12-29 Christian Stimming * src/tax/us/txf-de_DE.scm: Add Tax TXF categories for the de_DE locale, i.e. the German tax report. If the current locale begins with de_DE, the new German tax categories will be loaded, otherwise the conventional U.S. ones. This is the easiest method to allow other (non-U.S.) tax categories to be selected in the accounts' tax settings. * src/report/locale-specific/us/taxtxf-de_DE.scm: Add Tax report for de_DE locale. If the current locale begins with de_DE, the new German tax report will be loaded, otherwise the conventional U.S. report. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@10390 57a11ea4-9604-0410-9ed3-97b8803252fd --- ChangeLog | 14 + src/report/locale-specific/us/Makefile.am | 10 +- .../us/gncmod-locale-reports-us.c | 19 +- .../locale-specific/us/taxtxf-de_DE.scm | 885 ++++++++++++++++++ src/report/locale-specific/us/us.scm | 1 + src/tax/us/Makefile.am | 6 +- src/tax/us/de_DE.scm | 25 + src/tax/us/gncmod-tax-us.c | 11 +- src/tax/us/txf-de_DE.scm | 98 ++ src/tax/us/txf-help-de_DE.scm | 38 + 10 files changed, 1097 insertions(+), 10 deletions(-) create mode 100644 src/report/locale-specific/us/taxtxf-de_DE.scm create mode 100644 src/tax/us/de_DE.scm create mode 100644 src/tax/us/txf-de_DE.scm create mode 100644 src/tax/us/txf-help-de_DE.scm diff --git a/ChangeLog b/ChangeLog index 132fe8aab1..6c79b3d657 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2004-12-29 Christian Stimming + + * src/tax/us/txf-de_DE.scm: Add Tax TXF categories for the de_DE + locale, i.e. the German tax report. If the current locale begins + with de_DE, the new German tax categories will be loaded, + otherwise the conventional U.S. ones. This is the easiest method + to allow other (non-U.S.) tax categories to be selected in the + accounts' tax settings. + + * src/report/locale-specific/us/taxtxf-de_DE.scm: Add Tax report + for de_DE locale. If the current locale begins with de_DE, the new + German tax report will be loaded, otherwise the conventional + U.S. report. + 2004-12-23 Christian Stimming * src/import-export/hbci/druid-hbci-initial.c (on_aqhbci_button): diff --git a/src/report/locale-specific/us/Makefile.am b/src/report/locale-specific/us/Makefile.am index 1e677506f5..f42061e11d 100644 --- a/src/report/locale-specific/us/Makefile.am +++ b/src/report/locale-specific/us/Makefile.am @@ -37,14 +37,16 @@ endif noinst_DATA = .scm-links -gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report/locale-specific -gncscmmod_DATA = us.scm +## This is unused and therefore no longer installed and/or loaded +# gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report/locale-specific +# gncscmmod_DATA = us.scm gncscmothermoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report/ -gncscmothermod_DATA = taxtxf.scm +gncscmothermod_DATA = taxtxf.scm taxtxf-de_DE.scm EXTRA_DIST = \ - ${gncscmmod_DATA} \ ${gncscmothermod_DATA} +# ${gncscmmod_DATA} + CLEANFILES = ${SCM_FILE_LINKS} gnucash report locale-specific us .scm-links diff --git a/src/report/locale-specific/us/gncmod-locale-reports-us.c b/src/report/locale-specific/us/gncmod-locale-reports-us.c index 33254cda32..0c329cf2d9 100644 --- a/src/report/locale-specific/us/gncmod-locale-reports-us.c +++ b/src/report/locale-specific/us/gncmod-locale-reports-us.c @@ -10,6 +10,8 @@ #include #include "guile-mappings.h" #include +#include +#include #include "gnc-module.h" #include "gnc-module-api.h" @@ -51,17 +53,30 @@ libgncmod_locale_reports_us_LTX_gnc_module_init(int refcount) { return FALSE; } + const char *report_taxtxf; + /* This is a very simple hack that loads the (new, special) German + tax definition file in a German locale, or (default) loads the + previous US tax file. */ + const char *thislocale = setlocale(LC_ALL, NULL); + if (strncmp(thislocale, "de_DE", 5) == 0) { + report_taxtxf = "(use-modules (gnucash report taxtxf-de_DE))"; + } else { + report_taxtxf = "(use-modules (gnucash report taxtxf))"; + } + /* load the report generation scheme code */ - if(scm_c_eval_string("(use-modules (gnucash report taxtxf))") + if(scm_c_eval_string(report_taxtxf) == SCM_BOOL_F) { printf("failed to load (gnucash report taxtxf)\n"); return FALSE; } + /* This is unused and therefore no longer installed and/or loaded */ + /* if(scm_c_eval_string("(use-modules (gnucash report locale-specific us))") == SCM_BOOL_F) { return FALSE; - } + }*/ return TRUE; } diff --git a/src/report/locale-specific/us/taxtxf-de_DE.scm b/src/report/locale-specific/us/taxtxf-de_DE.scm new file mode 100644 index 0000000000..0a0daae69f --- /dev/null +++ b/src/report/locale-specific/us/taxtxf-de_DE.scm @@ -0,0 +1,885 @@ +;; -*-scheme-*- +;; +;; This file was copied from the file txf.scm by Richard -Gilligan- Uschold +;; +;; Originally, these were meant to print Tax related accounts and +;; exports TXF files for import to TaxCut, TurboTax, etc. for the US +;; tax TXF format. I modified this heavily so that it might become +;; useful for the German Umsatzsteuer-Voranmeldung. +;; +;; The report in this file extracts the amounts that belong to the +;; Kennzahlen (from txf-de_DE.scm) as assigned to the different +;; accounts, and will write it to some XML file as required by +;; e.g. the Winston software +;; http://www.felfri.de/winston/schnittstellen.htm +;; +;; This file might still contain a lot of US-TXF related stuff. This +;; can surely be thrown out once someone was able to actually use this +;; report for his/her taxes. +;; +;; +;; Richard Gilligan Uschold's original comment continued here as follows: +;; +;; 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. +;; +;; 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 +;; +;; Optionally, does NOT print accounts with $0.00 values. Prints data +;; between the From and To dates. 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 +;; +;; 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" + +;; depends must be outside module scope -- and should eventually go away. + +(define-module (gnucash report taxtxf-de_DE)) +(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing. +(use-modules (srfi srfi-1)) +(use-modules (ice-9 slib)) +(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 Report / TXF Export")) + +(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 MAX-LEVELS 16) ; Maximum Account Levels + +(define levelx-collector (make-level-collector MAX-LEVELS)) + +(define today (gnc:timepair-canonical-day-time + (cons (current-time) 0))) + +(define bdtm + (let ((result (gnc:timepair->date today))) + (set-tm:mday result 16) ; 16 + (set-tm:mon result 3) ; Apr + (set-tm:isdst result -1) + result)) + +(define tax-day (cons (car (mktime bdtm)) 0)) + +(define after-tax-day (gnc:timepair-later tax-day today)) + +(define (make-split-list account split-filter-pred) + (reverse (filter split-filter-pred + (gnc:account-get-split-list 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) + (lambda (split) + (let ((tp + (gnc:transaction-get-date-posted + (gnc:split-get-parent split)))) + (and (gnc:timepair-ge-date tp begin-date-tp) + (gnc:timepair-le-date tp end-date-tp))))) + +;; This is nearly identical to, and could be shared with +;; display-report-list-item in report.scm. This adds warn-msg parameter +(define (gnc:display-report-list-item item port warn-msg) + (cond + ((string? item) (display item port)) + ((null? item) #t) + ((list? item) (map (lambda (item) + (gnc:display-report-list-item item port warn-msg)) + 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) + +(define (tax-options-generator) + (define options (gnc:new-options)) + (define (gnc:register-tax-option new-option) + (gnc:register-option options new-option)) + + ;; date at which to report + (gnc:options-add-date-interval! + options gnc:pagename-general + (N_ "From") (N_ "To") "a") + + (gnc:register-tax-option + (gnc:make-multichoice-option + gnc:pagename-general (N_ "Alternate Period") + "c" (N_ "Override or modify From: & To:") + (if after-tax-day 'from-to 'last-year) + (list (list->vector + (list 'from-to (N_ "Use From - To") (N_ "Use From - To period"))) + (list->vector + (list '1st-est (N_ "1st Est Tax Quarter") (N_ "Jan 1 - Mar 31"))) + (list->vector + (list '2nd-est (N_ "2nd Est Tax Quarter") (N_ "Apr 1 - May 31"))) + (list->vector + (list '3rd-est (N_ "3rd Est Tax Quarter") (N_ "Jun 1 - Aug 31"))) + (list->vector + (list '4th-est (N_ "4th Est Tax Quarter") (N_ "Sep 1 - Dec 31"))) + (list->vector + (list 'last-year (N_ "Last Year") (N_ "Last Year"))) + (list->vector + (list '1st-last (N_ "Last Yr 1st Est Tax Qtr") + (N_ "Jan 1 - Mar 31, Last year"))) + (list->vector + (list '2nd-last (N_ "Last Yr 2nd Est Tax Qtr") + (N_ "Apr 1 - May 31, Last year"))) + (list->vector + (list '3rd-last (N_ "Last Yr 3rd Est Tax Qtr") + (N_ "Jun 1 - Aug 31, Last year"))) + (list->vector + (list '4th-last (N_ "Last Yr 4th Est Tax Qtr") + (N_ "Sep 1 - Dec 31, Last year")))))) + + (gnc:register-tax-option + (gnc:make-account-list-option + gnc:pagename-accounts (N_ "Select Accounts (none = all)") + "d" (N_ "Select accounts") + (lambda () '()) + #f #t)) + + (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)) + + (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:options-set-default-section options gnc:pagename-general) + + options) + +;; Render txf information +(define crlf (string #\return #\newline)) ; TurboTax seems to want these + +(define txf-last-payer "") ; if same as current, inc txf-l-count + ; this only works if different + ; codes from the same payer are + ; grouped in the accounts list +(define txf-l-count 0) ; count repeated N codes + +;; 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 (gnc:account-get-tax-related account) + (not (equal? (gnc:account-get-txf-code account) 'N000)))) + +(define (gnc:account-get-txf-code account) + (let ((code (gnc:account-get-tax-US-code account))) + (string->symbol (if code code "N000")))) + +(define (gnc:get-txf-format code income?) + (gnc:txf-get-format (if income? + txf-income-categories + txf-expense-categories) + code)) + +(define (gnc:account-get-txf-payer-source account) + (let ((pns (gnc:account-get-tax-US-payer-name-source account))) + (string->symbol (if pns pns "keine")))) + +;; 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 + +(define (fill-clamp-sp str len) + (string-append (substring (string-append str (make-string len #\space)) + 0 (- len 1)) " ")) + +(define (fill-clamp str len) + (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 (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-txf-account account account-value d? date x? x-date) + (let* ((print-info (gnc:account-print-info account #t)) + (txf? (gnc:account-get-txf account))) + (if (and txf? + (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)) + (date-str (if date + (strftime "%d.%m.%Y" (localtime (car date))) + #f)) + (x-date-str (if x-date + (strftime "%d.%m.%Y" (localtime (car x-date))) + #f)) + ;; Only formats 1,3 implemented now! Others are treated as 1. + (format (gnc:get-txf-format code (eq? type 'income))) + (value (string-append + (if (eq? type 'income) ;; negate expenses. FIXME: Necessary? + "" + "-") + (number->string + (gnc:numeric-num + (gnc:numeric-convert account-value (cond + ((eq? format 2) 1) + (else 100)) + 3))))) ;; 3 is the GNC_HOW_TRUNC truncation rounding + (payer-src (gnc:account-get-txf-payer-source account)) + (account-name (let* ((named-acct + (if (eq? payer-src 'parent) + (gnc:group-get-parent + (gnc:account-get-parent account)) + account)) + (name (gnc:account-get-name named-acct))) + (if name + name + (begin + (display + (string-append + "Failed to get name for account: " + (gnc:account-get-guid named-acct) + (if (not (eq? account named-acct)) + (string-append + " which is the parent of " + (gnc:account-get-guid account))) + "\n")) + " -- See the Terminal Output")))) + (action (if (eq? type 'income) + (case code + ((N286 N488) "ReinvD") + (else "Ertraege")) + "Aufwendungen")) + (category-key (if (eq? type 'income) + (gnc:txf-get-category-key + txf-income-categories code) + (gnc:txf-get-category-key + txf-expense-categories code))) + (value-name (if (equal? "ReinvD" action) + (string-append + (substring value 1 (string-length value)) + " " account-name) + account-name)) + (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"))) + ;(display "render-txf-account \n") + ;(display-backtrace (make-stack #t) (current-output-port)) + + ;; FIXME: Here the actual rendering of one account entry is + ;; done. Use the German format here. + (list " " + value + "" crlf)) +; (case format +; ((3) (list "P" 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) +; (fill-clamp-sp action 7) +; (fill-clamp-sp value-name 82) +; (fill-clamp category-key 15) crlf) +; '()) +; "^" 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 "%d.%m.%Y" (localtime (car txf-date))) + (if (or full-names (equal? level 1)) + (gnc:account-get-full-name account) + (gnc:account-get-name account)))) + (blue? (gnc:account-get-txf account)) + (print-info (gnc:account-print-info account #f)) + (value (gnc:amount->string 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 " date from-value)) + (from-value (gnc:timepair-start-day-time + (let ((bdtm from-date)) + (if (member alt-period + '(last-year 1st-last 2nd-last + 3rd-last 4th-last)) + (set-tm:year bdtm (- (tm:year bdtm) 1))) + (set-tm:mday bdtm 1) + (if (< (gnc:date-get-year bdtm) + tax-qtr-real-qtr-year) + (case alt-period + ((1st-est 1st-last last-year) ; Jan 1 + (set-tm:mon bdtm 0)) + ((2nd-est 2nd-last) ; Apr 1 + (set-tm:mon bdtm 3)) + ((3rd-est 3rd-last) ; Jun 1 + (set-tm:mon bdtm 5)) + ((4th-est 4th-last) ; Sep 1 + (set-tm:mon bdtm 8))) + ;; Tax quaters equal Real quarters + (case alt-period + ((1st-est 1st-last last-year) ; Jan 1 + (set-tm:mon bdtm 0)) + ((2nd-est 2nd-last) ; Apr 1 + (set-tm:mon bdtm 3)) + ((3rd-est 3rd-last) ; Jul 1 + (set-tm:mon bdtm 6)) + ((4th-est 4th-last) ; Oct 1 + (set-tm:mon bdtm 9)))) + (set-tm:isdst bdtm -1) + (cons (car (mktime bdtm)) 0)))) + + (to-value (gnc:timepair-end-day-time + (let ((bdtm from-date)) + (if (member alt-period + '(last-year 1st-last 2nd-last + 3rd-last 4th-last)) + (set-tm:year bdtm (- (tm:year bdtm) 1))) + ;; Bug! Above subtracts two years, should only be one! + ;; The exact same code, in from-value, further above, + ;; only subtraces one! Go figure! + ;; So, we add one back below! + (if (member alt-period + '(last-year 1st-last 2nd-last + 3rd-last 4th-last)) + (set-tm:year bdtm (+ (tm:year bdtm) 1))) + (set-tm:mday bdtm 31) + (if (< (gnc:date-get-year bdtm) tax-qtr-real-qtr-year) + (case alt-period + ((1st-est 1st-last) ; Mar 31 + (set-tm:mon bdtm 2)) + ((2nd-est 2nd-last) ; May 31 + (set-tm:mon bdtm 4)) + ((3rd-est 3rd-last) ; Aug 31 + (set-tm:mon bdtm 7)) + ((4th-est 4th-last last-year) ; Dec 31 + (set-tm:mon bdtm 11)) + (else (set! bdtm (gnc:timepair->date to-value)))) + ;; Tax quaters equal Real quarters + (case alt-period + ((1st-est 1st-last) ; Mar 31 + (set-tm:mon bdtm 2)) + ((2nd-est 2nd-last) ; Jun 30 + (set-tm:mday bdtm 30) + (set-tm:mon bdtm 5)) + ((3rd-est 3rd-last) ; Sep 30 + (set-tm:mday bdtm 30) + (set-tm:mon bdtm 8)) + ((4th-est 4th-last last-year) ; Dec 31 + (set-tm:mon bdtm 11)) + (else + (set! bdtm (gnc:timepair->date to-value))))) + (set-tm:isdst bdtm -1) + (cons (car (mktime bdtm)) 0)))) + + (txf-feedback-str-lst '()) + (doc (gnc:make-html-document)) + (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 + (define (txf-special-splits-period account from-value to-value) + (if (and (gnc:account-get-tax-related account) + (txf-special-split? (gnc:account-get-txf-code account))) + (let* + ((full-year? + (let ((bdto (localtime (car to-value))) + (bdfrom (localtime (car from-value)))) + (and (equal? (tm:year bdto) (tm:year bdfrom)) + (equal? (tm:mon bdfrom) 0) + (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 + (from-est (if full-year? + (let ((bdtm (gnc:timepair->date + (gnc:timepair-canonical-day-time + from-value)))) + (set-tm:mday bdtm 1) ; 01 + (set-tm:mon bdtm 2) ; Mar + (set-tm:isdst bdtm -1) + (cons (car (mktime bdtm)) 0)) + from-value)) + (to-est (if full-year? + (let* ((bdtm (gnc:timepair->date + (gnc:timepair-canonical-day-time + from-value)))) + (set-tm:mday bdtm 28) ; 28 + (set-tm:mon bdtm 1) ; Feb + (set-tm:year bdtm (+ (tm:year bdtm) 1)) + (set-tm:isdst bdtm -1) + (cons (car (mktime bdtm)) 0)) + to-value))) + (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 + (gnc:split-get-parent 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)) + 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-immediate-subaccounts x))))) + 0)) + accounts) + sum) + (length accounts))) + + (define (handle-level-x-account level account) + (let ((type (gw:enum--val->sym + (gnc:account-get-type account) #f))) + (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 account)) + (to-special #f) ; clear special-splits-period + (from-special #f) + (childrens-output + (if (not 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)) + + '())) + + (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) + (gnc:account-get-balance-interval + account from-value to-value #f)) + (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? + (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)) + + (if (> max-level level) + (lx-collector (+ 1 level) 'reset #f #f)) + + (if (null? level-x-output) + '() + (if (null? childrens-output) + level-x-output + (if tax-mode? + (list level-x-output + childrens-output) + (if (not children) ; swap for txf special splt + (list childrens-output level-x-output) + (list level-x-output childrens-output))))))) + ;; Ignore + '()))) + + (let ((from-date (strftime "%d.%m.%Y" (localtime (car from-value)))) + (to-date (strftime "%d.%m.%Y" (localtime (car to-value)))) + (to-year (strftime "%Y" (localtime (car to-value)))) + (today-date (strftime "%d.%m.%Y" + (localtime + (car (gnc:timepair-canonical-day-time + (cons (current-time) 0)))))) + (tax-nr (or + (gnc:kvp-frame-get-slot-path + (gnc:book-get-slots (gnc:get-current-book)) + (append gnc:*kvp-option-path* + (list gnc:*tax-label* gnc:*tax-nr-label*))) + "")) + ) + + ;; Now, the main body + ;; Reset all the balance collectors + (do ((i 1 (+ i 1))) + ((> i MAX-LEVELS) i) + (lx-collector i 'reset #f #f)) + + (set! txf-last-payer "") + (set! txf-l-count 0) + (set! work-to-do (count-accounts 1 selected-accounts)) + + (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)) + ;; FIXME: Print the leading and trailing bits here + (output-txf (list + "" crlf + " " crlf + ;; FIXME: Get this Ordnungsnummer somehow + " " + tax-nr + "" crlf + ;;"GnuCash" crlf + ;;"" gnc:version "" crlf + ;; today-date crlf + " " to-year "" crlf + ;; FIXME: Find out what this should mean + " " "1" "" crlf + output + ""))) + + (gnc:display-report-list-item output-txf port + "taxtxf-de.scm - ") + (close-output-port port) + #t) + #f)) + + (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 (gnc:html-markup "center" report-name)) + + (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") 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 German Tax XML file. Press Export to actually export them.")))))) + + (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."))))) + + (gnc:report-finished) + doc))))) + +(gnc:define-report + 'version 1 + 'name reportname + 'menu-name (N_ "Tax Report & XML Export") + ;;'menu-path (list gnc:menuname-taxes) + 'menu-tip (N_ "Taxable Income / Deductible Expenses / Export to .XML 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.") + report-obj + #t + #f)) + 'export-types (list (cons (_ "XML") 'txf)) + 'export-thunk (lambda (report-obj choice file-name) + (generate-tax-or-txf + (_ "Taxable Income / Deductible Expenses") + (_ "This page shows your Taxable Income and \ +Deductible Expenses.") + report-obj + #f + file-name))) diff --git a/src/report/locale-specific/us/us.scm b/src/report/locale-specific/us/us.scm index 83f5afe4cc..c892532e30 100644 --- a/src/report/locale-specific/us/us.scm +++ b/src/report/locale-specific/us/us.scm @@ -1,2 +1,3 @@ +; This is unused and therefore no longer installed and/or loaded (define-module (gnucash report locale-specific us)) (use-modules (gnucash report taxtxf)) diff --git a/src/tax/us/Makefile.am b/src/tax/us/Makefile.am index 65f36a8c20..d8e22faa9a 100644 --- a/src/tax/us/Makefile.am +++ b/src/tax/us/Makefile.am @@ -17,7 +17,7 @@ AM_CFLAGS = \ if GNUCASH_SEPARATE_BUILDDIR #For executing test cases -SCM_FILE_LINKS = us.scm +SCM_FILE_LINKS = us.scm de_DE.scm endif .scm-links: @@ -34,10 +34,10 @@ endif noinst_DATA = .scm-links gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/tax -gncscmmod_DATA = us.scm +gncscmmod_DATA = us.scm de_DE.scm gncscmdir = ${GNC_SHAREDIR}/scm -gncscm_DATA = txf.scm txf-help.scm +gncscm_DATA = txf.scm txf-help.scm txf-de_DE.scm txf-help-de_DE.scm EXTRA_DIST = \ ${gncscmmod_DATA} \ diff --git a/src/tax/us/de_DE.scm b/src/tax/us/de_DE.scm new file mode 100644 index 0000000000..f89ed26809 --- /dev/null +++ b/src/tax/us/de_DE.scm @@ -0,0 +1,25 @@ +(define-module (gnucash tax de_DE)) + +(use-modules (gnucash gnc-module)) +(gnc:module-load "gnucash/app-utils" 0) + +(export gnc:txf-get-payer-name-source) +(export gnc:txf-get-form) +(export gnc:txf-get-description) +(export gnc:txf-get-format) +(export gnc:txf-get-multiple) +(export gnc:txf-get-category-key) +(export gnc:txf-get-help) +(export gnc:txf-get-codes) +(export gnc:txf-get-code-info) +(export txf-help-categories) +(export txf-income-categories) +(export txf-expense-categories) + +(define gnc:*tax-label* (N_ "Tax")) +(define gnc:*tax-nr-label* (N_ "Tax Number")) + +(export gnc:*tax-label* gnc:*tax-nr-label*) + +(load-from-path "txf-de_DE.scm") +(load-from-path "txf-help-de_DE.scm") diff --git a/src/tax/us/gncmod-tax-us.c b/src/tax/us/gncmod-tax-us.c index 1be4268791..421b065100 100644 --- a/src/tax/us/gncmod-tax-us.c +++ b/src/tax/us/gncmod-tax-us.c @@ -9,6 +9,8 @@ #include #include #include +#include +#include #include "gnc-module.h" #include "gnc-module-api.h" @@ -49,7 +51,14 @@ lmod(char * mn) int libgncmod_tax_us_LTX_gnc_module_init(int refcount) { - lmod("(gnucash tax us)"); + /* This is a very simple hack that loads the (new, special) German + tax definition file in a German locale, or (default) loads the + previous US tax file. */ + const char *thislocale = setlocale(LC_ALL, NULL); + if (strncmp(thislocale, "de_DE", 5) == 0) + lmod("(gnucash tax de_DE)"); + else + lmod("(gnucash tax us)"); return TRUE; } diff --git a/src/tax/us/txf-de_DE.scm b/src/tax/us/txf-de_DE.scm new file mode 100644 index 0000000000..d19f42e20b --- /dev/null +++ b/src/tax/us/txf-de_DE.scm @@ -0,0 +1,98 @@ +;; -*-scheme-*- +;; +;; This file was copied from the file txf.scm by Richard -Gilligan- Uschold +;; +;; Originally, these were meant to hold the codes for the US tax TXF +;; format. I modified this heavily so that it might become useful for +;; the German Umsatzsteuer-Voranmeldung. +;; +;; This file holds all the Kennzahlen for the +;; Umsatzsteuer-Voranmeldung and their explanations, which can be +;; assigned to particular accounts via the "Edit -> Tax options" +;; dialog. The report in taxtxf-de_DE.scm then will extract the +;; numbers for these Kennzahlen from the actual accounts for a given +;; time period, and will write it to some XML file as required by +;; e.g. the Winston software +;; http://www.felfri.de/winston/schnittstellen.htm +;; +(define (gnc:txf-get-payer-name-source categories code) + (gnc:txf-get-code-info categories code 0)) +(define (gnc:txf-get-form categories code) + (gnc:txf-get-code-info categories code 1)) +(define (gnc:txf-get-description categories code) + (gnc:txf-get-code-info categories code 2)) +(define (gnc:txf-get-format categories code) + (gnc:txf-get-code-info categories code 3)) +(define (gnc:txf-get-multiple categories code) + (gnc:txf-get-code-info categories code 4)) +(define (gnc:txf-get-category-key categories code) + (gnc:txf-get-code-info categories code 5)) +(define (gnc:txf-get-help categories code) + (let ((pair (assv code txf-help-strings))) + (if pair + (cdr pair) + "No help available."))) + +(define (gnc:txf-get-codes categories) + (map car categories)) + +;;;; Private + +(define (gnc:txf-get-code-info categories code index) + (vector-ref (cdr (assv code categories)) index)) + +(define txf-help-categories + (list + (cons 'H000 #(current "help" "Name of Current account is exported." 0 #f "")) + (cons 'H002 #(parent "help" "Name of Parent account is exported." 0 #f "")) + (cons 'H003 #(not-impl "help" "Not implemented yet, Do NOT Use!" 0 #f "")))) + +;; We use several formats; nr. 1 means Euro+Cent, nr. 2 means only full Euro + +;; Also, we abuse the "category-key" for now to store the Kennzahl as +;; well. We are not yet sure what to use the "form" field for. + +;; Format: (name-source form description format multiple category-key) +(define txf-income-categories + (list + (cons 'N000 #(none "" "Nur zur Voransicht im Steuer-Bericht -- kein Export" 0 #f "")) + + (cons 'K41 #(none "41" "Innergemeinschaftliche Lieferungen an Abnehmer mit USt-IdNr. " 2 #f "41")) + (cons 'K44 #(none "44" "Innergemeinschaftliche Lieferungen neuer Fahrzeuge an Abnehmer ohne USt-IdNr" 2 #f "44")) + (cons 'K49 #(none "49" "Innergemeinschaftliche Lieferungen neuer Fahrzeuge außerhalb eines Unternehmens" 2 #f "49")) + (cons 'K43 #(none "43" "Weitere steuerfreie Umsätze mit Vorsteuerabzug" 2 #f "43")) + (cons 'K48 #(none "48" "Steuerfreie Umsätze ohne Vorsteuerabzug" 2 #f "48")) + + (cons 'K51 #(none "51" "Steuerpflichtige Umsätze, Steuersatz 16 v.H." 2 #f "51")) + (cons 'K86 #(none "86" "Steuerpflichtige Umsätze, Steuersatz 7 v.H." 2 #f "86")) + (cons 'K35 #(none "35" "Umsätze, die anderen Steuersätzen unterliegen (Bemessungsgrundlage)" 2 #f "35")) + (cons 'K36 #(none "36" "Umsätze, die anderen Steuersätzen unterliegen (Steuer)" 1 #f "36")) + (cons 'K77 #(none "77" "Umsätze land- und forstwirtschaftlicher Betriebe:: Lieferungen in das übrige Gemeinschaftsgebiet an Abnehmer mit USt-IdNr." 2 #f "77")) + (cons 'K76 #(none "76" "Umsätze, für die eine Steuer nach § 24 UStG zu entrichten ist (Bemessungsgrundlage)" 2 #f "76")) + (cons 'K80 #(none "80" "Umsätze, für die eine Steuer nach § 24 UStG zu entrichten ist (Steuer)" 1 #f "80")) + )) + + +(define txf-expense-categories + (list + (cons 'N000 #(none "" "Nur zur Voransicht im Steuer-Bericht -- kein Export" 0 #f "")) + + (cons 'K91 #(none "91" "Steuerfreie innergemeinschaftliche Erwerbe" 2 #f "91")) + + (cons 'K66 #(none "66" "Vorsteuerbeträge aus Rechnungen von anderen Unternehmern" 1 #f "66")) + )) + + + +;;; Register global options in this book +(define (book-options-generator options) + (define (reg-option new-option) + (gnc:register-option options new-option)) + + (reg-option + (gnc:make-string-option + gnc:*tax-label* gnc:*tax-nr-label* + "a" (N_ "The electronic tax number of your business") "")) + ) + +(gnc:register-kvp-option-generator gnc:id-book book-options-generator) diff --git a/src/tax/us/txf-help-de_DE.scm b/src/tax/us/txf-help-de_DE.scm new file mode 100644 index 0000000000..64dab4b78c --- /dev/null +++ b/src/tax/us/txf-help-de_DE.scm @@ -0,0 +1,38 @@ +;; -*-scheme-*- +;; +;; This file was copied from the file txf.scm by Richard -Gilligan- Uschold +;; +;; Originally, these were meant to hold the codes for the US tax TXF +;; format. I modified this heavily so that it might become useful for +;; the German Umsatzsteuer-Voranmeldung. +;; +;; This file holds the explanations to the categories from txf-de_DE.scm. +;; + +(define txf-help-strings + '( + (H001 . "Categories marked with a \"<\" or a \"^\", require a Payer identification to be exported. \"<\" indicates that the name of this account is exported as this Payer ID. Typically, this is a bank, stock, or mutual fund name.") + (H002 . "Categories marked with a \"<\" or a \"^\", require a Payer identification to be exported. \"^\" indicates that the name of the PARENT of this account is exported as this Payer ID. Typically, this is a bank, stock, or mutual fund name.") + (H003 . "Categories marked with a \"#\" are not fully implemented yet! Do not use these codes!") + (N000 . "This is a dummy category and only shows up on the tax report, but is not exported.") + + + (K41 . "Innergemeinschaftliche Lieferungen (§ 4 Nr. 1 Buchst. b UStG) an Abnehmer mit USt-IdNr. (Bemessungsgrundlage)") + (K44 . "Innergemeinschaftliche Lieferungen neuer Fahrzeuge an Abnehmer ohne USt-IdNr (Bemessungsgrundlage)") + (K49 . "Innergemeinschaftliche Lieferungen neuer Fahrzeuge außerhalb eines Unternehmens (§ 2a UStG) (Bemessungsgrundlage)") + (K43 . "Weitere steuerfreie Umsätze mit Vorsteuerabzug (z.B. Ausfuhrlieferungen, Umsätze nach § 4 Nr. 2 bis 7 UStG) (Bemessungsgrundlage)") + (K48 . "Steuerfreie Umsätze ohne Vorsteuerabzug: Umsätze nach § 4 Nr. 8 bis 28 UStG (Bemessungsgrundlage)") + + (K51 . "Steuerpflichtige Umsätze (Lieferungen und sonstige Leistungen einschl. unentgeltlicher Wertabgaben) zum Steuersatz von 16 v.H. (Bemessungsgrundlage)") + (K86 . "Steuerpflichtige Umsätze (Lieferungen und sonstige Leistungen einschl. unentgeltlicher Wertabgaben) zum Steuersatz von 7 v.H. (Bemessungsgrundlage)") + (K35 . "Umsätze, die anderen Steuersätzen unterliegen (Bemessungsgrundlage)") + (K36 . "Umsätze, die anderen Steuersätzen unterliegen (Steuer)") + (K77 . "Umsätze land- und forstwirtschaftlicher Betriebe nach § 24 UStG: Lieferungen in das übrige Gemeinschaftsgebiet an Abnehmer mit USt-IdNr. (Bemessungsgrundlage)") + (K76 . "Umsätze, für die eine Steuer nach § 24 UStG zu entrichten ist (Sägewerkserzeugnisse, Getränke und alkohol. Flüssigkeiten, z.B. Wein) (Bemessungsgrundlage)") + (K80 . "Umsätze, für die eine Steuer nach § 24 UStG zu entrichten ist (Sägewerkserzeugnisse, Getränke und alkohol. Flüssigkeiten, z.B. Wein) (Steuer)") + + (K91 . "Steuerfreie innergemeinschaftliche Erwerbe: Erwerbe nach § 4b UStG (Bemessungsgrundlage)") + + + (K66 . "Vorsteuerbeträge aus Rechnungen von anderen Unternehmern (§ 15 Abs. 1 Satz 1 Nr. 1 UStG), aus Leistungen im Sinne des § 13a Abs. 1 Nr. 6 UStG (§ 15 Abs. 1 Satz 1 Nr. 5 UStG) und aus innergemeinschaftlichen Dreiecksgeschäften (§ 25b Abs. 5 UStG)") + ))