mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Improve txf scheme routines to handle invalid tax-entity-types more gracefully.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@20611 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
J. Alex Aycinena
parent
845fe0d435
commit
b8e8f51330
@ -459,7 +459,6 @@ gnc_ui_account_get_balance_as_of_date (Account *account,
|
||||
char *
|
||||
gnc_ui_account_get_tax_info_string (const Account *account)
|
||||
{
|
||||
static SCM get_tax_entity_types = SCM_UNDEFINED;
|
||||
static SCM get_form = SCM_UNDEFINED;
|
||||
static SCM get_desc = SCM_UNDEFINED;
|
||||
|
||||
@ -499,8 +498,6 @@ gnc_ui_account_get_tax_info_string (const Account *account)
|
||||
}
|
||||
else /* with tax code */
|
||||
{
|
||||
SCM tax_types;
|
||||
gboolean tax_type_valid = FALSE;
|
||||
const gchar *num_code = NULL;
|
||||
const gchar *prefix = "N";
|
||||
|
||||
@ -539,38 +536,15 @@ gnc_ui_account_get_tax_info_string (const Account *account)
|
||||
|
||||
g_return_val_if_fail (module, NULL);
|
||||
|
||||
get_tax_entity_types = scm_c_eval_string
|
||||
("(false-if-exception gnc:txf-get-tax-entity-type-codes)");
|
||||
get_form = scm_c_eval_string
|
||||
("(false-if-exception gnc:txf-get-form)");
|
||||
get_desc = scm_c_eval_string
|
||||
("(false-if-exception gnc:txf-get-description)");
|
||||
}
|
||||
|
||||
g_return_val_if_fail (scm_is_procedure (get_tax_entity_types),
|
||||
NULL);
|
||||
g_return_val_if_fail (scm_is_procedure (get_form), NULL);
|
||||
g_return_val_if_fail (scm_is_procedure (get_desc), NULL);
|
||||
|
||||
tax_types = scm_call_0 (get_tax_entity_types);
|
||||
if (!scm_is_list (tax_types))
|
||||
return g_strdup (_("Tax entity types not available"));
|
||||
while (!scm_is_null (tax_types))
|
||||
{
|
||||
SCM type_scm;
|
||||
gchar *str;
|
||||
|
||||
type_scm = SCM_CAR (tax_types);
|
||||
tax_types = SCM_CDR (tax_types);
|
||||
str = scm_is_symbol(type_scm) ? SCM_SYMBOL_CHARS(type_scm) : "";
|
||||
if (safe_strcmp (tax_type, str) == 0)
|
||||
tax_type_valid = TRUE;
|
||||
/* g_free (str); */
|
||||
}
|
||||
if (!tax_type_valid)
|
||||
return g_strdup_printf (_("Tax entity type not valid: %s"),
|
||||
tax_type);
|
||||
|
||||
category = scm_c_eval_string (atype == ACCT_TYPE_INCOME ?
|
||||
"txf-income-categories" :
|
||||
(atype == ACCT_TYPE_EXPENSE ?
|
||||
|
||||
@ -227,8 +227,6 @@ load_txf_info (gint acct_category, TaxInfoDialog *ti_dialog)
|
||||
SCM tax_entity_type;
|
||||
SCM category;
|
||||
SCM codes;
|
||||
SCM tax_types;
|
||||
gboolean tax_type_valid = FALSE;
|
||||
|
||||
if (ti_dialog->tax_type == NULL ||
|
||||
(safe_strcmp (ti_dialog->tax_type, "") == 0))
|
||||
@ -241,31 +239,6 @@ load_txf_info (gint acct_category, TaxInfoDialog *ti_dialog)
|
||||
tax_entity_type = scm_from_locale_string (ti_dialog->tax_type);
|
||||
}
|
||||
|
||||
/* validate that tax_type in book is valid (can be untrue if locales
|
||||
are changed) */
|
||||
tax_types = scm_call_0 (getters.tax_entity_types);
|
||||
if (!scm_is_list (tax_types))
|
||||
{
|
||||
destroy_txf_infos (infos);
|
||||
return NULL;
|
||||
}
|
||||
while (!scm_is_null (tax_types))
|
||||
{
|
||||
SCM type_scm;
|
||||
gchar *str;
|
||||
|
||||
type_scm = SCM_CAR (tax_types);
|
||||
tax_types = SCM_CDR (tax_types);
|
||||
str = scm_is_symbol(type_scm) ? SCM_SYMBOL_CHARS(type_scm) : "";
|
||||
if (safe_strcmp (ti_dialog->tax_type, str) == 0)
|
||||
tax_type_valid = TRUE;
|
||||
}
|
||||
if (!tax_type_valid)
|
||||
{
|
||||
destroy_txf_infos (infos);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
switch (acct_category)
|
||||
{
|
||||
case INCOME:
|
||||
@ -319,7 +292,7 @@ load_txf_info (gint acct_category, TaxInfoDialog *ti_dialog)
|
||||
|
||||
scm = scm_call_3 (getters.payer_name_source, category, code_scm,
|
||||
tax_entity_type);
|
||||
str = SCM_SYMBOL_CHARS (scm);
|
||||
str = scm_is_symbol(scm) ? SCM_SYMBOL_CHARS (scm) : "";
|
||||
if (safe_strcmp (str, "not-impl") == 0)
|
||||
{
|
||||
continue;
|
||||
@ -349,8 +322,7 @@ load_txf_info (gint acct_category, TaxInfoDialog *ti_dialog)
|
||||
scm = scm_call_2 (getters.help, category, code_scm);
|
||||
str = scm_is_string(scm) ? scm_to_locale_string(scm) : "";
|
||||
scm = scm_call_3 (getters.last_year, category, code_scm, tax_entity_type);
|
||||
/* year = scm_is_bool (scm) ? 0 : scm_to_int(scm); <- Req's guile 1.8 */
|
||||
year = scm_is_bool (scm) ? 0 : SCM_INUM(scm); /* <-guile 1.6 */
|
||||
year = scm_is_bool (scm) ? 0 : scm_to_int(scm);
|
||||
scm = scm_call_3 (getters.line_data, category, code_scm, tax_entity_type);
|
||||
if (scm_is_list (scm))
|
||||
{
|
||||
@ -367,10 +339,8 @@ load_txf_info (gint acct_category, TaxInfoDialog *ti_dialog)
|
||||
year_scm = SCM_CAR (scm);
|
||||
scm = SCM_CDR (scm);
|
||||
|
||||
/* line_year = scm_is_bool (SCM_CAR (year_scm)) ? 0 :
|
||||
scm_to_int (SCM_CAR (year_scm)); <- Req's guile 1.8 */
|
||||
line_year = scm_is_bool (SCM_CAR (year_scm)) ? 0 :
|
||||
SCM_INUM (SCM_CAR (year_scm)); /* <-guile 1.6 */
|
||||
scm_to_int (SCM_CAR (year_scm));
|
||||
line = scm_is_string((SCM_CAR (SCM_CDR (year_scm))))
|
||||
? scm_to_locale_string((SCM_CAR (SCM_CDR (year_scm)))) : "";
|
||||
temp = g_strconcat (form_line_data, "\n",
|
||||
@ -409,8 +379,7 @@ load_txf_info (gint acct_category, TaxInfoDialog *ti_dialog)
|
||||
g_free(form_line_data);
|
||||
|
||||
scm = scm_call_3 (getters.copy, category, code_scm, tax_entity_type);
|
||||
/* cpy = scm_is_bool (scm) ? (scm_is_false (scm) ? FALSE : TRUE): FALSE; <- Req's guile 1.8 */
|
||||
cpy = scm_is_bool (scm) ? (scm_is_false (scm) ? FALSE : TRUE) : FALSE; /* <-guile 1.6 */
|
||||
cpy = scm_is_bool (scm) ? (scm_is_false (scm) ? FALSE : TRUE): FALSE;
|
||||
txf_info->copy = cpy;
|
||||
|
||||
infos = g_list_prepend (infos, txf_info);
|
||||
|
||||
@ -1713,7 +1713,7 @@
|
||||
;; and have an invalid tax code are put on an error list. Codes N438 and N440
|
||||
;; have special processing: if an asset account is assigned to either of these
|
||||
;; two codes, an additional 'form-line-acct' entry is created for the other
|
||||
;; code so that either both accounts are represented or neither.
|
||||
;; code so that either both codes are represented or neither.
|
||||
(define (make-form-line-acct-list accounts tax-year)
|
||||
(map (lambda (account)
|
||||
(let* ((account-name (gnc-account-get-full-name account))
|
||||
|
||||
@ -32,9 +32,11 @@
|
||||
(cons 'Other #("None" "Keine Steuerberichtsoptionen vorhanden"))))
|
||||
|
||||
(define (gnc:tax-type-txf-get-code-info tax-entity-types type-code index)
|
||||
(let ((tax-entity-type (assv type-code tax-entity-types)))
|
||||
(and tax-entity-type
|
||||
(vector-ref (cdr tax-entity-type) index))))
|
||||
(if (assv type-code tax-entity-types)
|
||||
(let ((tax-entity-type (assv type-code tax-entity-types)))
|
||||
(and tax-entity-type
|
||||
(vector-ref (cdr tax-entity-type) index)))
|
||||
#f))
|
||||
|
||||
(define (gnc:txf-get-tax-entity-type type-code)
|
||||
(gnc:tax-type-txf-get-code-info txf-tax-entity-types type-code 0))
|
||||
@ -58,19 +60,27 @@
|
||||
(define (gnc:txf-get-category-key categories code 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)
|
||||
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories)))
|
||||
(category (assv code tax-entity-codes)))
|
||||
(if (or (not category) (< (vector-length (cdr category)) 7))
|
||||
#f
|
||||
(gnc:txf-get-code-info categories code 6 tax-entity-type))))
|
||||
(if (assv (string->symbol tax-entity-type) categories)
|
||||
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories)))
|
||||
(category (if (assv code tax-entity-codes)
|
||||
(assv code tax-entity-codes)
|
||||
#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)
|
||||
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories)))
|
||||
(category (assv code tax-entity-codes)))
|
||||
(if (or (not category) (< (vector-length (cdr category)) 8))
|
||||
#f
|
||||
(gnc:txf-get-code-info categories code 7 tax-entity-type))))
|
||||
(if (assv (string->symbol tax-entity-type) categories)
|
||||
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories)))
|
||||
(category (if (assv code tax-entity-codes)
|
||||
(assv code tax-entity-codes)
|
||||
#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)
|
||||
(let ((pair (assv code txf-help-strings)))
|
||||
@ -82,14 +92,16 @@ USt-Kategorien 2011 für GnuCash Vers. 2.4.0 entwickelt und erstellt von: FJSW
|
||||
Fehlermeldungen + Dankschreiben an: stoll@bomhardt.de")))
|
||||
|
||||
(define (gnc:txf-get-codes categories tax-entity-type)
|
||||
(let* ((tax-entity-code-list-pair (assv (if (eqv? tax-entity-type "")
|
||||
'Ind
|
||||
(string->symbol tax-entity-type))
|
||||
categories))
|
||||
(tax-entity-codes (if tax-entity-code-list-pair
|
||||
(cdr tax-entity-code-list-pair)
|
||||
'())))
|
||||
(map car tax-entity-codes)))
|
||||
(if (assv (string->symbol tax-entity-type) categories)
|
||||
(let* ((tax-entity-code-list-pair (assv (if (eqv? tax-entity-type "")
|
||||
'Ind
|
||||
(string->symbol tax-entity-type))
|
||||
categories))
|
||||
(tax-entity-codes (if tax-entity-code-list-pair
|
||||
(cdr tax-entity-code-list-pair)
|
||||
'())))
|
||||
(map car tax-entity-codes))
|
||||
#f))
|
||||
|
||||
;;;; Private
|
||||
|
||||
@ -102,8 +114,10 @@ Fehlermeldungen + Dankschreiben an: stoll@bomhardt.de")))
|
||||
(cdr tax-entity-code-list-pair)
|
||||
'()))
|
||||
(category (assv code tax-entity-codes)))
|
||||
(and category
|
||||
(vector-ref (cdr category) index))))
|
||||
(if category
|
||||
(and category
|
||||
(vector-ref (cdr category) index))
|
||||
#f)))
|
||||
|
||||
(define txf-help-categories
|
||||
(list
|
||||
|
||||
@ -28,9 +28,11 @@
|
||||
(cons 'Other #("None" "No Income Tax Options Provided"))))
|
||||
|
||||
(define (gnc:tax-type-txf-get-code-info tax-entity-types type-code index)
|
||||
(let ((tax-entity-type (assv type-code tax-entity-types)))
|
||||
(and tax-entity-type
|
||||
(vector-ref (cdr tax-entity-type) index))))
|
||||
(if (assv type-code tax-entity-types)
|
||||
(let ((tax-entity-type (assv type-code tax-entity-types)))
|
||||
(and tax-entity-type
|
||||
(vector-ref (cdr tax-entity-type) index)))
|
||||
#f))
|
||||
|
||||
(define (gnc:txf-get-tax-entity-type type-code)
|
||||
(gnc:tax-type-txf-get-code-info txf-tax-entity-types type-code 0))
|
||||
@ -54,19 +56,27 @@
|
||||
(define (gnc:txf-get-category-key categories code 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)
|
||||
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories)))
|
||||
(category (assv code tax-entity-codes)))
|
||||
(if (or (not category) (< (vector-length (cdr category)) 7))
|
||||
#f
|
||||
(gnc:txf-get-code-info categories code 6 tax-entity-type))))
|
||||
(if (assv (string->symbol tax-entity-type) categories)
|
||||
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories)))
|
||||
(category (if (assv code tax-entity-codes)
|
||||
(assv code tax-entity-codes)
|
||||
#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)
|
||||
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories)))
|
||||
(category (assv code tax-entity-codes)))
|
||||
(if (or (not category) (< (vector-length (cdr category)) 8))
|
||||
#f
|
||||
(gnc:txf-get-code-info categories code 7 tax-entity-type))))
|
||||
(if (assv (string->symbol tax-entity-type) categories)
|
||||
(let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories)))
|
||||
(category (if (assv code tax-entity-codes)
|
||||
(assv code tax-entity-codes)
|
||||
#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)
|
||||
(let ((pair (assv code txf-help-strings)))
|
||||
@ -75,18 +85,27 @@
|
||||
(_ "No help available.") )))
|
||||
|
||||
(define (gnc:txf-get-codes categories tax-entity-type)
|
||||
(let ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
(if (assv (string->symbol tax-entity-type) categories)
|
||||
(let ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
|
||||
categories))))
|
||||
(map car tax-entity-codes)))
|
||||
(map car tax-entity-codes))
|
||||
#f))
|
||||
|
||||
(define (gnc:txf-get-code-info categories code index tax-entity-type)
|
||||
(let* ((tax-entity-codes (cdr (assv (if (eqv? tax-entity-type "")
|
||||
'F1040
|
||||
(string->symbol tax-entity-type))
|
||||
categories)))
|
||||
(category (assv code tax-entity-codes)))
|
||||
(and category
|
||||
(vector-ref (cdr category) index))))
|
||||
(if (or (assv (string->symbol tax-entity-type) categories)
|
||||
(eqv? tax-entity-type ""))
|
||||
(let* ((tax-entity-codes (cdr (assv (if (eqv? tax-entity-type "")
|
||||
'F1040
|
||||
(string->symbol tax-entity-type))
|
||||
categories)))
|
||||
(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
|
||||
(list
|
||||
|
||||
Loading…
Reference in New Issue
Block a user