r20611 - gnucash/trunk/src - Improve txf scheme routines to handle invalid tax-entity-types more gracefully.
J. Alex Aycinena
alex.aycinena at code.gnucash.org
Thu May 5 20:02:55 EDT 2011
Author: alex.aycinena
Date: 2011-05-05 20:02:54 -0400 (Thu, 05 May 2011)
New Revision: 20611
Trac: http://svn.gnucash.org/trac/changeset/20611
Modified:
gnucash/trunk/src/app-utils/gnc-ui-util.c
gnucash/trunk/src/gnome/dialog-tax-info.c
gnucash/trunk/src/report/locale-specific/us/taxtxf.scm
gnucash/trunk/src/tax/us/txf-de_DE.scm
gnucash/trunk/src/tax/us/txf.scm
Log:
Improve txf scheme routines to handle invalid tax-entity-types more gracefully.
Modified: gnucash/trunk/src/app-utils/gnc-ui-util.c
===================================================================
--- gnucash/trunk/src/app-utils/gnc-ui-util.c 2011-05-03 20:08:34 UTC (rev 20610)
+++ gnucash/trunk/src/app-utils/gnc-ui-util.c 2011-05-06 00:02:54 UTC (rev 20611)
@@ -459,7 +459,6 @@
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 @@
}
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 @@
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 ?
Modified: gnucash/trunk/src/gnome/dialog-tax-info.c
===================================================================
--- gnucash/trunk/src/gnome/dialog-tax-info.c 2011-05-03 20:08:34 UTC (rev 20610)
+++ gnucash/trunk/src/gnome/dialog-tax-info.c 2011-05-06 00:02:54 UTC (rev 20611)
@@ -227,8 +227,6 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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);
Modified: gnucash/trunk/src/report/locale-specific/us/taxtxf.scm
===================================================================
--- gnucash/trunk/src/report/locale-specific/us/taxtxf.scm 2011-05-03 20:08:34 UTC (rev 20610)
+++ gnucash/trunk/src/report/locale-specific/us/taxtxf.scm 2011-05-06 00:02:54 UTC (rev 20611)
@@ -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))
Modified: gnucash/trunk/src/tax/us/txf-de_DE.scm
===================================================================
--- gnucash/trunk/src/tax/us/txf-de_DE.scm 2011-05-03 20:08:34 UTC (rev 20610)
+++ gnucash/trunk/src/tax/us/txf-de_DE.scm 2011-05-06 00:02:54 UTC (rev 20611)
@@ -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 @@
Fehlermeldungen + Dankschreiben an: stoll at 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 @@
(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
Modified: gnucash/trunk/src/tax/us/txf.scm
===================================================================
--- gnucash/trunk/src/tax/us/txf.scm 2011-05-03 20:08:34 UTC (rev 20610)
+++ gnucash/trunk/src/tax/us/txf.scm 2011-05-06 00:02:54 UTC (rev 20611)
@@ -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
More information about the gnucash-changes
mailing list