aherman
/
gnucash
mirror of https://github.com/Gnucash/gnucash
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Improve txf scheme routines to handle invalid tax-entity-types more gracefully.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@20611 57a11ea4-9604-0410-9ed3-97b8803252fd
pull/1/head
J. Alex Aycinena 15 years ago
parent 845fe0d435
commit b8e8f51330
5 changed files with 87 additions and 111 deletions
Show Stats Download Patch File Download Diff File

26
src/app-utils/gnc-ui-util.c
Unescape View File

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

39
src/gnome/dialog-tax-info.c
Unescape View File

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

2
src/report/locale-specific/us/taxtxf.scm
Unescape View File

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

64
src/tax/us/txf-de_DE.scm
Unescape View File

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

67
src/tax/us/txf.scm
Unescape View File

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

Write Preview
Loading…
Cancel
Save