"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "gnucash/report/reports/locale-specific/de_DE/taxtxf.scm" between
gnucash-5.0.tar.bz2 and gnucash-5.1.tar.bz2

About: GnuCash is personal and small-business financial-accounting software.

taxtxf.scm  (gnucash-5.0.tar.bz2)	:	taxtxf.scm  (gnucash-5.1.tar.bz2)
skipping to change at line 87		skipping to change at line 87
(define reportname (N_ "Tax Report / TXF Export"))		(define reportname (N_ "Tax Report / TXF Export"))
(define (make-level-collector num-levels)		(define (make-level-collector num-levels)
(let ((level-collector (make-vector num-levels)))		(let ((level-collector (make-vector num-levels)))
(do ((i 0 (+ i 1)))		(do ((i 0 (+ i 1)))
((= i num-levels) i)		((= i num-levels) i)
(vector-set! level-collector i (gnc:make-commodity-collector)))		(vector-set! level-collector i (gnc:make-commodity-collector)))
level-collector))		level-collector))
(define MAX-LEVELS 16) ; Maximum Account Levels		(define MAX-LEVELS 16) ; Maximum Account Levels
(define levelx-collector (make-level-collector MAX-LEVELS))		(define levelx-collector (make-level-collector MAX-LEVELS))
(define today (time64CanonicalDayTime (current-time)))		(define today (time64CanonicalDayTime (current-time)))
(define bdtm		(define bdtm
(let ((result (gnc-localtime today)))		(let ((result (gnc-localtime today)))
(set-tm:mday result 16) ; 16		(set-tm:mday result 16) ; 16
(set-tm:mon result 3) ; Apr		(set-tm:mon result 3) ; Apr
(set-tm:isdst result -1)		(set-tm:isdst result -1)
skipping to change at line 181		skipping to change at line 181
gnc:pagename-display (N_ "Print Full account names")		gnc:pagename-display (N_ "Print Full account names")
"g" (N_ "Print all Parent account names.") #f)		"g" (N_ "Print all Parent account names.") #f)
(gnc:options-set-default-section options gnc:pagename-general)		(gnc:options-set-default-section options gnc:pagename-general)
options)		options)
;; Render txf information		;; Render txf information
(define crlf (string #\return #\newline)) ; TurboTax seems to want these		(define crlf (string #\return #\newline)) ; TurboTax seems to want these
(define txf-last-payer "") ; if same as current, inc txf-l-count		(define txf-last-payer "") ; if same as current, inc txf-l-count
; this only works if different		; this only works if different
; codes from the same payer are		; codes from the same payer are
; grouped in the accounts list		; grouped in the accounts list
(define txf-l-count 0) ; count repeated N codes		(define txf-l-count 0) ; count repeated N codes
;; stores assigned txf codes so we can check for duplicates		;; stores assigned txf codes so we can check for duplicates
(define txf-dups-alist '())		(define txf-dups-alist '())
(define (txf-payer? payer)		(define (txf-payer? payer)
(member payer (list 'current 'parent)))		(member payer (list 'current 'parent)))
(define (gnc:account-get-txf account)		(define (gnc:account-get-txf account)
(and (xaccAccountGetTaxRelated account)		(and (xaccAccountGetTaxRelated account)
(not (equal? (gnc:account-get-txf-code account) 'N000))))		(not (equal? (gnc:account-get-txf-code account) 'N000))))
skipping to change at line 304		skipping to change at line 304
(let* ((type (xaccAccountGetType account))		(let* ((type (xaccAccountGetType account))
(code (gnc:account-get-txf-code account))		(code (gnc:account-get-txf-code account))
(date-str (if date		(date-str (if date
(gnc-print-time64 date "%d.%m.%Y")		(gnc-print-time64 date "%d.%m.%Y")
#f))		#f))
(x-date-str (if x-date		(x-date-str (if x-date
(gnc-print-time64 x-date "%d.%m.%Y")		(gnc-print-time64 x-date "%d.%m.%Y")
#f))		#f))
;; Only formats 1,3 implemented now! Others are treated as 1.		;; Only formats 1,3 implemented now! Others are treated as 1.
(format (gnc:get-txf-format code (eq? type ACCT-TYPE-INCOME)))		(format (gnc:get-txf-format code (eq? type ACCT-TYPE-INCOME)))
(value (string-append		(value (string-append
(if (eq? type ACCT-TYPE-INCOME) ;; negate expenses. FIXME:		(if (eq? type ACCT-TYPE-INCOME) ;; negate expenses. FIXME
Necessary?		: Necessary?
""		""
"-")		"-")
(number->string		(number->string
(gnc-numeric-num		(gnc-numeric-num
(gnc-numeric-convert account-value (cond		(gnc-numeric-convert account-value (cond
((eq? format 2) 1)		((eq? format 2) 1)
(else 100))		(else 100))
3))))) ;; 3 is the GNC_HOW_TRUNC tr		3))))) ;; 3 is the GNC_HOW_TRUNC t
uncation rounding		runcation rounding
(payer-src (gnc:account-get-txf-payer-source account))		(payer-src (gnc:account-get-txf-payer-source account))
(account-name (let* ((named-acct		(account-name (let* ((named-acct
(if (eq? payer-src 'parent)		(if (eq? payer-src 'parent)
(gnc-account-get-parent account)		(gnc-account-get-parent account)
account))		account))
(name (xaccAccountGetName named-acct)))		(name (xaccAccountGetName named-acct)))
(if (not (string-null? name))		(if (not (string-null? name))
name		name
(begin		(begin
(display		(display
(string-append		(string-append
"Failed to get name for account: "		"Failed to get name for account: "
(gncAccountGetGUID named-acct)		(gncAccountGetGUID named-acct)
(if (not (eq? account named-acct))		(if (not (eq? account named-acct))
(string-append		(string-append
" which is the parent of "		" which is the parent of "
(gncAccountGetGUID account)))		(gncAccountGetGUID account)))
"\n"))		"\n"))
"<NONE> -- See the Terminal Output"))))		"<NONE> -- See the Terminal Output"))))
(action (if (eq? type ACCT-TYPE-INCOME)		(action (if (eq? type ACCT-TYPE-INCOME)
(case code		(case code
((N286 N488) "ReinvD")		((N286 N488) "ReinvD")
(else "Ertraege"))		(else "Ertraege"))
"Aufwendungen"))		"Aufwendungen"))
(category-key (if (eq? type ACCT-TYPE-INCOME)		(category-key (if (eq? type ACCT-TYPE-INCOME)
(gnc:txf-get-category-key		(gnc:txf-get-category-key
txf-income-categories code "")		txf-income-categories code "")
(gnc:txf-get-category-key		(gnc:txf-get-category-key
txf-expense-categories code "")))		txf-expense-categories code "")))
skipping to change at line 357		skipping to change at line 357
account-name))		account-name))
(l-value (if (= format 3)		(l-value (if (= format 3)
(begin		(begin
(set! txf-l-count		(set! txf-l-count
(if (equal? txf-last-payer account-name)		(if (equal? txf-last-payer account-name)
txf-l-count		txf-l-count
(+ 1 txf-l-count)))		(+ 1 txf-l-count)))
(set! txf-last-payer account-name)		(set! txf-last-payer account-name)
(number->string txf-l-count))		(number->string txf-l-count))
"1")))		"1")))
;(display "render-txf-account \n")		;(display "render-txf-account \n")
;(display-backtrace (make-stack #t) (current-output-port))		;(display-backtrace (make-stack #t) (current-output-port))
;; FIXME: Here the actual rendering of one account entry is		;; FIXME: Here the actual rendering of one account entry is
;; done. Use the German format here.		;; done. Use the German format here.
(list " <Kennzahl Nr=\""		(list " <Kennzahl Nr=\""
category-key		category-key
"\">"		"\">"
value		value
"</Kennzahl>" crlf))		"</Kennzahl>" crlf))
; (case format		; (case format
; ((3) (list "P" account-name crlf))		; ((3) (list "P" account-name crlf))
; (else (if (and x? (txf-special-split? code))		; (else (if (and x? (txf-special-split? code))
; (list "P" crlf)		; (list "P" crlf)
; '())))		; '())))
; (if x?		; (if x?
; (list "X" x-date-str " " (fill-clamp-sp account-name 31)		; (list "X" x-date-str " " (fill-clamp-sp account-name 31)
; (fill-clamp-sp action 7)		; (fill-clamp-sp action 7)
; (fill-clamp-sp value-name 82)		; (fill-clamp-sp value-name 82)
; (fill-clamp category-key 15) crlf)		; (fill-clamp category-key 15) crlf)
; '())		; '())
; "^" crlf))		; "^" crlf))
"")))		"")))
;; Render any level		;; Render any level
(define (render-level-x-account table level max-level account lx-value		(define (render-level-x-account table level max-level account lx-value
suppress-0 full-names txf-date)		suppress-0 full-names txf-date)
(let* ((account-name (if txf-date ; special split		(let* ((account-name (if txf-date ; special split
(gnc-print-time64 txf-date "%d.%m.%Y")		(gnc-print-time64 txf-date "%d.%m.%Y")
(if (or full-names (equal? level 1))		(if (or full-names (equal? level 1))
(gnc-account-get-full-name account)		(gnc-account-get-full-name account)
(xaccAccountGetName account))))		(xaccAccountGetName account))))
(blue? (gnc:account-get-txf account))		(blue? (gnc:account-get-txf account))
(print-info (gnc-account-print-info account #f))		(print-info (gnc-account-print-info account #f))
(value (xaccPrintAmount lx-value print-info))		(value (xaccPrintAmount lx-value print-info))
(value-formatted (if (= 1 level)		(value-formatted (if (= 1 level)
(gnc:html-markup-b value)		(gnc:html-markup-b value)
value))		value))
skipping to change at line 408		skipping to change at line 408
value-formatted)))		value-formatted)))
(account-name (if blue?		(account-name (if blue?
(gnc:html-markup "blue" account-name)		(gnc:html-markup "blue" account-name)
;; Note: gnc:html-markup adds an extra space		;; Note: gnc:html-markup adds an extra space
;; before the " <FONT" tag, so we compensate.		;; before the " <FONT" tag, so we compensate.
(string-append " " account-name)))		(string-append " " account-name)))
(blank-cells (make-list (- max-level level)		(blank-cells (make-list (- max-level level)
(gnc:make-html-table-cell #f)))		(gnc:make-html-table-cell #f)))
(end-cells (make-list (- level 1) (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		(if (and blue? (not txf-date)) ; check for duplicate txf codes
(txf-check-dups account))		(txf-check-dups account))
(if (or (not suppress-0) (= level 1)		(if (or (not suppress-0) (= level 1)
(not (gnc-numeric-zero-p lx-value)))		(not (gnc-numeric-zero-p lx-value)))
(begin		(begin
(gnc:html-table-prepend-row!		(gnc:html-table-prepend-row!
table		table
(append		(append
(list (gnc:make-html-table-cell		(list (gnc:make-html-table-cell
(apply gnc:make-html-text		(apply gnc:make-html-text
skipping to change at line 452		skipping to change at line 452
report-obj		report-obj
tax-mode?)		tax-mode?)
(define (get-option pagename optname)		(define (get-option pagename optname)
(gnc-optiondb-lookup-value		(gnc-optiondb-lookup-value
(gnc:report-options report-obj) pagename optname))		(gnc:report-options report-obj) pagename optname))
;; the number of account generations: children, grandchildren etc.		;; the number of account generations: children, grandchildren etc.
(define (num-generations account gen)		(define (num-generations account gen)
(if (eq? (gnc-account-n-children account) 0)		(if (eq? (gnc-account-n-children account) 0)
(if (and (xaccAccountGetTaxRelated account)		(if (and (xaccAccountGetTaxRelated account)
(txf-special-split? (gnc:account-get-txf-code account)))		(txf-special-split? (gnc:account-get-txf-code account)))
(+ gen 1) ; Est Fed Tax has a extra generation		(+ gen 1) ; Est Fed Tax has a extra generation
gen) ; no kids, return input		gen) ; no kids, return input
(apply max (map (lambda (x) (num-generations x (1+ gen)))		(apply max (map (lambda (x) (num-generations x (1+ gen)))
(or (gnc-account-get-children-sorted account) '())))))		(or (gnc-account-get-children-sorted account) '())))))
(gnc:report-starting reportname)		(gnc:report-starting reportname)
(let* ((from-value (gnc:date-option-absolute-time		(let* ((from-value (gnc:date-option-absolute-time
(get-option gnc:pagename-general "From")))		(get-option gnc:pagename-general "From")))
(to-value (gnc:time64-end-day-time		(to-value (gnc:time64-end-day-time
(gnc:date-option-absolute-time		(gnc:date-option-absolute-time
(get-option gnc:pagename-general "To"))))		(get-option gnc:pagename-general "To"))))
(alt-period (get-option gnc:pagename-general "Alternate Period"))		(alt-period (get-option gnc:pagename-general "Alternate Period"))
(suppress-0 (get-option gnc:pagename-display		(suppress-0 (get-option gnc:pagename-display
skipping to change at line 485		skipping to change at line 485
valid-user-sel-accnts		valid-user-sel-accnts
(validate (reverse		(validate (reverse
(gnc-account-get-children-sorted		(gnc-account-get-children-sorted
(gnc-get-current-root-account))))))		(gnc-get-current-root-account))))))
(book (gnc-get-current-book))		(book (gnc-get-current-book))
(generations (if (pair? selected-accounts)		(generations (if (pair? selected-accounts)
(apply max (map (lambda (x) (num-generations x 1))		(apply max (map (lambda (x) (num-generations x 1))
selected-accounts))		selected-accounts))
0))		0))
(max-level (min MAX-LEVELS (max 1 generations)))		(max-level (min MAX-LEVELS (max 1 generations)))
(work-to-do 0)		(work-to-do 0)
(work-done 0)		(work-done 0)
;; Alternate dates are relative to from-date		;; Alternate dates are relative to from-date
(from-date (gnc-localtime from-value))		(from-date (gnc-localtime from-value))
(from-value (gnc:time64-start-day-time		(from-value (gnc:time64-start-day-time
(let ((bdtm from-date))		(let ((bdtm from-date))
(if (member alt-period		(if (member alt-period
'(last-year 1st-last 2nd-last		'(last-year 1st-last 2nd-last
3rd-last 4th-last))		3rd-last 4th-last))
(set-tm:year bdtm (- (tm:year bdtm) 1)))		(set-tm:year bdtm (- (tm:year bdtm) 1)))
(set-tm:mday bdtm 1)		(set-tm:mday bdtm 1)
skipping to change at line 635		skipping to change at line 635
date)))		date)))
(if tax-mode?		(if tax-mode?
(render-level-x-account table lev max-level account		(render-level-x-account table lev max-level account
amount suppress-0 #f date)		amount suppress-0 #f date)
(render-txf-account account amount		(render-txf-account account amount
#t fudge-date #t date))))		#t fudge-date #t date))))
split-list)))		split-list)))
(define (count-accounts level accounts)		(define (count-accounts level accounts)
(if (< level max-level)		(if (< level max-level)
(let ((sum 0))		(let ((sum 0))
(for-each (lambda (x)		(for-each (lambda (x)
(if (gnc:account-is-inc-exp? x)		(if (gnc:account-is-inc-exp? x)
(set! sum (+ sum (+ 1 (count-accounts (+ 1 level)		(set! sum (+ sum (+ 1 (count-accounts (+ 1 level)
(gnc-account-get-chi		(gnc-account-get-ch
ldren x)))))		ildren x)))))
0))		0))
accounts)		accounts)
sum)		sum)
(length accounts)))		(length accounts)))
(define (handle-level-x-account level account)		(define (handle-level-x-account level account)
(let ((type (xaccAccountGetType account)))		(let ((type (xaccAccountGetType account)))
(set! work-done (+ 1 work-done))		(set! work-done (+ 1 work-done))
(gnc:report-percent-done (* 100 (if (> work-to-do 0)		(gnc:report-percent-done (* 100 (if (> work-to-do 0)
(/ work-done work-to-do)		(/ work-done work-to-do)
1)))		1)))
(if (gnc:account-is-inc-exp? account)		(if (gnc:account-is-inc-exp? account)
(let* ((children (gnc-account-get-children-sorted account))		(let* ((children (gnc-account-get-children-sorted account))
(to-special #f) ; clear special-splits-period		(to-special #f) ; clear special-splits-period
(from-special #f)		(from-special #f)
(childrens-output		(childrens-output
(if (null? children)		(if (null? children)
(let* ((splits-period (txf-special-splits-period		(let* ((splits-period (txf-special-splits-period
account from-value to-value)))		account from-value to-value)))
(if splits-period		(if splits-period
(let* ((full-year? (caddr splits-period)))		(let* ((full-year? (caddr splits-period)))
(set! from-special (car splits-period))		(set! from-special (car splits-period))
(set! to-special (cadr splits-period))		(set! to-special (cadr splits-period))
(handle-txf-special-splits level account		(handle-txf-special-splits level account
skipping to change at line 739		skipping to change at line 739
(list level-x-output		(list level-x-output
childrens-output)		childrens-output)
(if (null? children) ; swap for txf special splt		(if (null? children) ; swap for txf special splt
(list childrens-output level-x-output)		(list childrens-output level-x-output)
(list level-x-output childrens-output)))))))		(list level-x-output childrens-output)))))))
;; Ignore		;; Ignore
'())))		'())))
(let ((from-date (gnc-print-time64 from-value "%d.%m.%Y"))		(let ((from-date (gnc-print-time64 from-value "%d.%m.%Y"))
(to-date (gnc-print-time64 to-value "%d.%m.%Y"))		(to-date (gnc-print-time64 to-value "%d.%m.%Y"))
(to-year (gnc-print-time64 to-value "%Y"))		(to-year (gnc-print-time64 to-value "%Y"))
(today-date (gnc-print-time64 (time64CanonicalDayTime (current-time))		(today-date (gnc-print-time64 (time64CanonicalDayTime (current-time))
"%d.%m.%Y"))		"%d.%m.%Y"))
(tax-nr (gnc:book-get-option-value book gnc:*tax-label* gnc:*tax-nr-lab el*)))		(tax-nr (gnc:book-get-option-value book gnc:*tax-label* gnc:*tax-nr-la bel*)))
;; Now, the main body		;; Now, the main body
;; Reset all the balance collectors		;; Reset all the balance collectors
(do ((i 1 (+ i 1)))		(do ((i 1 (+ i 1)))
((> i MAX-LEVELS) i)		((> i MAX-LEVELS) i)
(lx-collector i 'reset #f #f))		(lx-collector i 'reset #f #f))
(set! txf-last-payer "")		(set! txf-last-payer "")
(set! txf-l-count 0)		(set! txf-l-count 0)
(set! work-to-do (count-accounts 1 selected-accounts))		(set! work-to-do (count-accounts 1 selected-accounts))
(if (not tax-mode?) ; Do Txf mode		(if (not tax-mode?) ; Do Txf mode
(begin		(begin
(gnc:html-document-set-export-string		(gnc:html-document-set-export-string
doc (call-with-output-string		doc (call-with-output-string
(lambda (port)		(lambda (port)
(gnc:display-report-list-item		(gnc:display-report-list-item
(list		(list
"<WinstonAusgang>" crlf		"<WinstonAusgang>" crlf
" <Formular Typ=\"UST\"></Formular>" crlf		" <Formular Typ=\"UST\"></Formular>" crlf
" <Ordnungsnummer>" tax-nr "</Ordnungsnummer>" crlf		" <Ordnungsnummer>" tax-nr "</Ordnungsnummer>" crlf
" <AnmeldeJahr>" to-year "</AnmeldeJahr>" crlf		" <AnmeldeJahr>" to-year "</AnmeldeJahr>" crlf
" <AnmeldeZeitraum>1</AnmeldeZeitraum>" crlf		" <AnmeldeZeitraum>1</AnmeldeZeitraum>" crlf
(map (cut handle-level-x-account 1 <>) selected-accounts)		(map (cut handle-level-x-account 1 <>) selected-accounts)
"</WinstonAusgang>")		"</WinstonAusgang>")
port "taxtxf-de.scm - "))))		port "taxtxf-de.scm - "))))
doc)		doc)
(begin ; else do tax report		(begin ; else do tax report
(gnc:html-document-set-style!		(gnc:html-document-set-style!
doc "blue"		doc "blue"
'tag "font"		'tag "font"
'attribute (list "color" "#0000ff"))		'attribute (list "color" "#0000ff"))
(gnc:html-document-set-style!		(gnc:html-document-set-style!
doc "income"		doc "income"
'tag "font"		'tag "font"
'attribute (list "color" "#0000ff"))		'attribute (list "color" "#0000ff"))
skipping to change at line 829		skipping to change at line 829
selected-accounts)		selected-accounts)
(if (null? selected-accounts)		(if (null? selected-accounts)
(gnc:html-document-add-object!		(gnc:html-document-add-object!
doc		doc
(gnc:make-html-text		(gnc:make-html-text
(gnc:html-markup-p		(gnc:html-markup-p
"Keine Steuer-relevanten Konten gefunden.<br>		"Keine Steuer-relevanten Konten gefunden.<br>
Gehen Sie zu Bearbeiten -> Optionen Steuerbericht, um Konten entsprechend einzur ichten."))))		Gehen Sie zu Bearbeiten -> Optionen Steuerbericht, um Konten entsprechend einzur ichten."))))
(gnc:report-finished)		(gnc:report-finished)
doc)))))		doc)))))
(gnc:define-report		(gnc:define-report
'version 1		'version 1
'name reportname		'name reportname
'report-guid "758b125c05e54531a7dec5f1ef0ef9c8"		'report-guid "758b125c05e54531a7dec5f1ef0ef9c8"
'menu-name (N_ "Tax Report & XML Export")		'menu-name (N_ "Tax Report & XML Export")
;;'menu-path (list gnc:menuname-taxes)		;;'menu-path (list gnc:menuname-taxes)
'menu-tip (N_ "Taxable Income / Deductible Expenses / Export to .XML file")		'menu-tip (N_ "Taxable Income / Deductible Expenses / Export to .XML file")
'options-generator tax-options-generator		'options-generator tax-options-generator
End of changes. 21 change blocks.
73 lines changed or deleted		73 lines changed or added

---