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

[taxtxf(-de_DE)] compact functions, use srfi-2

Browse Source 
srfi-2 and-let* allows concise code and returns #f if any intermediate
var is #f.
This commit is contained in:
Christopher Lam 2019-08-23 18:55:55 +08:00
parent 123033e5ea
commit 67751665b3
2 changed files with 53 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
libgnucash/tax/us/txf-de_DE.scm
View File

@ -46,6 +46,7 @@
(use-modules (gnucash app-utils)) (use-modules (gnucash app-utils))
(use-modules (srfi srfi-2))
(define txf-tax-entity-types (define txf-tax-entity-types
(list (list
@ -53,11 +54,8 @@
(cons 'Other #("None" "Keine Steuerberichtsoptionen vorhanden")))) (cons 'Other #("None" "Keine Steuerberichtsoptionen vorhanden"))))
(define (gnc:tax-type-txf-get-code-info tax-entity-types type-code index) (define (gnc:tax-type-txf-get-code-info tax-entity-types type-code index)
(if (assv type-code tax-entity-types) (and-let* ((tax-entity-type (assv-ref tax-entity-types type-code)))
(let ((tax-entity-type (assv type-code tax-entity-types))) (vector-ref tax-entity-type index)))
(and tax-entity-type
(vector-ref (cdr tax-entity-type) index)))
#f))
(define (gnc:txf-get-tax-entity-type type-code) (define (gnc:txf-get-tax-entity-type type-code)
(gnc:tax-type-txf-get-code-info txf-tax-entity-types type-code 0)) (gnc:tax-type-txf-get-code-info txf-tax-entity-types type-code 0))
@ -81,64 +79,41 @@
(define (gnc:txf-get-category-key categories code tax-entity-type) (define (gnc:txf-get-category-key categories code tax-entity-type)
(gnc:txf-get-code-info categories code 5 tax-entity-type)) (gnc:txf-get-code-info categories code 5 tax-entity-type))
(define (gnc:txf-get-line-data categories code tax-entity-type) (define (gnc:txf-get-line-data categories code tax-entity-type)
(if (assv (string->symbol tax-entity-type) categories) (and-let* ((sym (string->symbol tax-entity-type))
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type) (tax-entity-codes (assv-ref categories sym))
categories))) (category (assv-ref tax-entity-codes code))
(category (if (assv code tax-entity-codes) ((>= (vector-length category) 7)))
(assv code tax-entity-codes) (gnc:txf-get-code-info categories code 6 tax-entity-type)))
#f)))
(if (or (not category) (< (vector-length (cdr category)) 7))
#f
(gnc:txf-get-code-info categories code 6 tax-entity-type)))
#f))
(define (gnc:txf-get-last-year categories code tax-entity-type) (define (gnc:txf-get-last-year categories code tax-entity-type)
(if (assv (string->symbol tax-entity-type) categories) (and-let* ((sym (string->symbol tax-entity-type))
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type) (tax-entity-codes (assv-ref categories sym))
categories))) (category (assv-ref tax-entity-codes code))
(category (if (assv code tax-entity-codes) ((>= (vector-length category) 8)))
(assv code tax-entity-codes) (gnc:txf-get-code-info categories code 7 tax-entity-type)))
#f)))
(if (or (not category) (< (vector-length (cdr category)) 8))
#f
(gnc:txf-get-code-info categories code 7 tax-entity-type)))
#f))
(define (gnc:txf-get-help categories code) (define (gnc:txf-get-help categories code)
(let ((pair (assv code txf-help-strings))) (or (assv-ref txf-help-strings code)
(if pair "Keine Hilfe verfügbar, da nur Gruppenüberschrift.
(cdr pair)
"Keine Hilfe verfügbar, da nur Gruppenüberschrift.
Diese Kategorie ohne Nummer ==>> N I C H T V E R W E N D E N ! Diese Kategorie ohne Nummer ==>> N I C H T V E R W E N D E N !
USt-Kategorien 2011 für GnuCash Vers. 2.4.0 entwickelt und erstellt von: FJSW USt-Kategorien 2011 für GnuCash Vers. 2.4.0 entwickelt und erstellt von: FJSW
Fehlermeldungen + Dankschreiben an: stoll@bomhardt.de"))) Fehlermeldungen + Dankschreiben an: stoll@bomhardt.de"))
(define (gnc:txf-get-codes categories tax-entity-type) (define (gnc:txf-get-codes categories tax-entity-type)
(if (assv (string->symbol tax-entity-type) categories) (and-let* ((sym (if (string-null? tax-entity-type)
(let* ((tax-entity-code-list-pair (assv (if (eqv? tax-entity-type "") 'Ind
'Ind (string->symbol tax-entity-type)))
(string->symbol tax-entity-type)) (tax-entity-codes (assv-ref categories sym)))
categories)) (map car tax-entity-codes)))
(tax-entity-codes (if tax-entity-code-list-pair
(cdr tax-entity-code-list-pair)
'())))
(map car tax-entity-codes))
#f))
;;;; Private ;;;; Private
(define (gnc:txf-get-code-info categories code index tax-entity-type) (define (gnc:txf-get-code-info categories code index tax-entity-type)
(let* ((tax-entity-code-list-pair (assv (if (eqv? tax-entity-type "") (and-let* ((sym (if (string-null? tax-entity-type)
'Ind 'Ind
(string->symbol tax-entity-type)) (string->symbol tax-entity-type)))
categories)) (tax-entity-codes (assv-ref categories sym))
(tax-entity-codes (if tax-entity-code-list-pair (category (assv-ref tax-entity-codes code)))
(cdr tax-entity-code-list-pair) (vector-ref category index)))
'()))
(category (assv code tax-entity-codes)))
(if category
(and category
(vector-ref (cdr category) index))
#f)))
(define txf-help-categories (define txf-help-categories
(list (list

74
libgnucash/tax/us/txf.scm
View File

@ -41,6 +41,7 @@
(use-modules (gnucash app-utils)) (use-modules (gnucash app-utils))
(use-modules (srfi srfi-2))
(define txf-tax-entity-types (define txf-tax-entity-types
(list (list
@ -51,11 +52,8 @@
(cons 'Other #("None" "No Income Tax Options Provided")))) (cons 'Other #("None" "No Income Tax Options Provided"))))
(define (gnc:tax-type-txf-get-code-info tax-entity-types type-code index) (define (gnc:tax-type-txf-get-code-info tax-entity-types type-code index)
(if (assv type-code tax-entity-types) (and-let* ((tax-entity-type (assv-ref tax-entity-types type-code)))
(let ((tax-entity-type (assv type-code tax-entity-types))) (vector-ref tax-entity-type index)))
(and tax-entity-type
(vector-ref (cdr tax-entity-type) index)))
#f))
(define (gnc:txf-get-tax-entity-type type-code) (define (gnc:txf-get-tax-entity-type type-code)
(gnc:tax-type-txf-get-code-info txf-tax-entity-types type-code 0)) (gnc:tax-type-txf-get-code-info txf-tax-entity-types type-code 0))
@ -78,57 +76,37 @@
(gnc:txf-get-code-info categories code 4 tax-entity-type)) (gnc:txf-get-code-info categories code 4 tax-entity-type))
(define (gnc:txf-get-category-key categories code tax-entity-type) (define (gnc:txf-get-category-key categories code tax-entity-type)
(gnc:txf-get-code-info categories code 5 tax-entity-type)) (gnc:txf-get-code-info categories code 5 tax-entity-type))
(define (gnc:txf-get-line-data categories code tax-entity-type) (define (gnc:txf-get-line-data categories code tax-entity-type)
(if (assv (string->symbol tax-entity-type) categories) (and-let* ((sym (string->symbol tax-entity-type))
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type) (tax-entity-codes (assv-ref categories sym))
categories))) (category (assv-ref tax-entity-codes code))
(category (if (assv code tax-entity-codes) ((>= (vector-length category) 7)))
(assv code tax-entity-codes) (gnc:txf-get-code-info categories code 6 tax-entity-type)))
#f)))
(if (or (not category) (< (vector-length (cdr category)) 7))
#f
(gnc:txf-get-code-info categories code 6 tax-entity-type)))
#f))
(define (gnc:txf-get-last-year categories code tax-entity-type) (define (gnc:txf-get-last-year categories code tax-entity-type)
(if (assv (string->symbol tax-entity-type) categories) (and-let* ((sym (string->symbol tax-entity-type))
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type) (tax-entity-codes (assv-ref categories sym))
categories))) (category (assv-ref tax-entity-codes code))
(category (if (assv code tax-entity-codes) ((>= (vector-length category) 8)))
(assv code tax-entity-codes) (gnc:txf-get-code-info categories code 7 tax-entity-type)))
#f)))
(if (or (not category) (< (vector-length (cdr category)) 8))
#f
(gnc:txf-get-code-info categories code 7 tax-entity-type)))
#f))
(define (gnc:txf-get-help categories code) (define (gnc:txf-get-help categories code)
(let ((pair (assv code txf-help-strings))) (or (assv-ref txf-help-strings code)
(if pair (_ "No help available.")))
(cdr pair)
(_ "No help available.") )))
(define (gnc:txf-get-codes categories tax-entity-type) (define (gnc:txf-get-codes categories tax-entity-type)
(if (assv (string->symbol tax-entity-type) categories) (and-let* ((sym (string->symbol tax-entity-type))
(let ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type) (tax-entity-codes (assv-ref categories sym)))
categories)))) (map car tax-entity-codes)))
(map car tax-entity-codes))
#f))
(define (gnc:txf-get-code-info categories code index tax-entity-type) (define (gnc:txf-get-code-info categories code index tax-entity-type)
(if (or (assv (string->symbol tax-entity-type) categories) (and-let* ((sym (if (string-null? tax-entity-type)
(eqv? tax-entity-type "")) 'F1040
(let* ((tax-entity-codes (cdr (assv (if (eqv? tax-entity-type "") (string->symbol tax-entity-type)))
'F1040 (tax-entity-codes (assv-ref categories sym))
(string->symbol tax-entity-type)) (category (assv-ref tax-entity-codes code)))
categories))) (vector-ref category index)))
(category (if (assv code tax-entity-codes)
(assv code tax-entity-codes)
#f)))
(if category
(and category
(vector-ref (cdr category) index))
#f))
#f))
(define txf-help-categories (define txf-help-categories
(list (list