Add de_DE tax categories.

2004-12-29  Christian Stimming  <stimming@tuhh.de>

	* 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
This commit is contained in:
Christian Stimming 2004-12-29 16:57:35 +00:00
parent eb9822f6a5
commit a4027674f9
10 changed files with 1097 additions and 10 deletions

View File

@ -1,3 +1,17 @@
2004-12-29 Christian Stimming <stimming@tuhh.de>
* 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 <stimming@tuhh.de>
* src/import-export/hbci/druid-hbci-initial.c (on_aqhbci_button):

View File

@ -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

View File

@ -10,6 +10,8 @@
#include <libguile.h>
#include "guile-mappings.h"
#include <glib.h>
#include <locale.h>
#include <string.h>
#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;
}

View File

@ -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-<gnc:AccountType>-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"))
"<NONE> -- 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 " <Kennzahl Nr=\""
category-key
"\">"
value
"</Kennzahl>" 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 " <FONT" tag, so we compensate.
(string-append " " account-name)))
(blank-cells (make-list (- max-level level)
(gnc:make-html-table-cell #f)))
(end-cells (make-list (- level 1) (gnc:make-html-table-cell #f))))
(if (and blue? (not txf-date)) ; check for duplicate txf codes
(txf-check-dups account))
(if (or (not suppress-0) (= level 1)
(not (gnc:numeric-zero-p lx-value)))
(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)) "&nbsp; ")
(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))))))
;; Recursivly validate children if parent is not a tax account.
;; Don't check children if parent is valid.
;; Returns the Parent if a child or grandchild is valid.
(define (validate accounts)
(filter (lambda (a)
(if (gnc:account-get-tax-related a)
#t
;; check children
(if (null? (validate
(gnc:group-get-subaccounts
(gnc:account-get-children a))))
#f
#t)))
accounts))
(define (generate-tax-or-txf report-name
report-description
report-obj
tax-mode?
file-name)
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
;; the number of account generations: children, grandchildren etc.
(define (num-generations account gen)
(let ((children (gnc:account-get-children account)))
(if (eq? (gnc:group-get-num-accounts children) 0)
(if (and (gnc:account-get-tax-related 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:group-map-accounts
(lambda (x) (num-generations x (+ 1 gen)))
children)))))
(gnc:report-starting reportname)
(let* ((from-value (gnc:date-option-absolute-time
(get-option gnc:pagename-general "From")))
(to-value (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(get-option gnc:pagename-general "To"))))
(alt-period (get-option gnc:pagename-general "Alternate Period"))
(suppress-0 (get-option gnc:pagename-display
"Suppress $0.00 values"))
(full-names (get-option gnc:pagename-display
"Print Full account names"))
(user-sel-accnts (get-option gnc:pagename-accounts
"Select Accounts (none = all)"))
(valid-user-sel-accnts (validate user-sel-accnts))
;; If no selected accounts, check all.
(selected-accounts (if (not (null? user-sel-accnts))
valid-user-sel-accnts
(validate (reverse
(gnc:group-get-account-list
(gnc:get-current-group))))))
(generations (if (pair? selected-accounts)
(apply max (map (lambda (x) (num-generations x 1))
selected-accounts))
0))
(max-level (min MAX-LEVELS (max 1 generations)))
(work-to-do 0)
(work-done 0)
;; Alternate dates are relative to from-date
(from-date (gnc:timepair->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-<gnc:AccountType>-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
"<WinstonAusgang>" crlf
" <Formular Typ=\"UST\"></Formular>" crlf
;; FIXME: Get this Ordnungsnummer somehow
" <Ordnungsnummer>"
tax-nr
"</Ordnungsnummer>" crlf
;;"<software>GnuCash</software>" crlf
;;"<version>" gnc:version "</version>" crlf
;; today-date crlf
" <AnmeldeJahr>" to-year "</AnmeldeJahr>" crlf
;; FIXME: Find out what this should mean
" <AnmeldeZeitraum>" "1" "</AnmeldeZeitraum>" crlf
output
"</WinstonAusgang>")))
(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)))

View File

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

View File

@ -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} \

25
src/tax/us/de_DE.scm Normal file
View File

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

View File

@ -9,6 +9,8 @@
#include <stdio.h>
#include <glib.h>
#include <libguile.h>
#include <locale.h>
#include <string.h>
#include "gnc-module.h"
#include "gnc-module-api.h"
@ -49,6 +51,13 @@ lmod(char * mn)
int
libgncmod_tax_us_LTX_gnc_module_init(int refcount) {
/* 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;
}

98
src/tax/us/txf-de_DE.scm Normal file
View File

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

View File

@ -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 \"&lt;\" or a \"^\", require a Payer identification to be exported. \"&lt;\" 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 \"&lt;\" 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)")
))