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

src/app-utils/gnc-ui-util.c

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

src/gnome/dialog-tax-info.c

@@ -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_to_int(scm);
-        year = scm_is_bool (scm) ? 0 : SCM_INUM(scm); /* <-guile 1.6  */
         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;
-        cpy = scm_is_bool (scm) ? (scm_is_false (scm) ? FALSE : TRUE) : FALSE; /* <-guile 1.6  */
         txf_info->copy = cpy;
 
         infos = g_list_prepend (infos, txf_info);

src/report/locale-specific/us/taxtxf.scm

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

src/tax/us/txf-de_DE.scm

@@ -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)))
+  (if (assv type-code tax-entity-types)
-    (and tax-entity-type
+      (let ((tax-entity-type (assv type-code tax-entity-types)))
-         (vector-ref (cdr 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)
   (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)
+  (if (assv (string->symbol tax-entity-type) categories)
-                                                                  categories)))
+      (let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
-         (category (assv code tax-entity-codes)))
+                                          categories)))
-    (if (or (not category) (< (vector-length (cdr category)) 7))
+             (category (if (assv code tax-entity-codes)
-        #f
+                           (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)
-  (let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
+  (if (assv (string->symbol tax-entity-type) categories)
-                                                                  categories)))
+      (let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
-         (category (assv code tax-entity-codes)))
+                                          categories)))
-    (if (or (not category) (< (vector-length (cdr category)) 8))
+             (category (if (assv code tax-entity-codes)
-        #f
+                           (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)
   (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 "")
+  (if (assv (string->symbol tax-entity-type) categories)
-                                              'Ind
+      (let* ((tax-entity-code-list-pair (assv (if (eqv? tax-entity-type "")
-                                              (string->symbol tax-entity-type))
+                                               'Ind
-                                          categories))
+                                               (string->symbol tax-entity-type))
-         (tax-entity-codes (if tax-entity-code-list-pair
+                                              categories))
-                               (cdr tax-entity-code-list-pair)
+             (tax-entity-codes (if tax-entity-code-list-pair
-                               '())))
+                                   (cdr tax-entity-code-list-pair)
-    (map car tax-entity-codes)))
+                                   '())))
+            (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
+        (if category
-         (vector-ref (cdr category) index))))
+            (and category
+                 (vector-ref (cdr category) index))
+            #f)))
 
 (define txf-help-categories
   (list

src/tax/us/txf.scm

@@ -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)))
+  (if (assv type-code tax-entity-types)
-    (and tax-entity-type
+      (let ((tax-entity-type (assv type-code tax-entity-types)))
-         (vector-ref (cdr 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)
   (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)
+  (if (assv (string->symbol tax-entity-type) categories)
-                                                                  categories)))
+      (let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
-         (category (assv code tax-entity-codes)))
+                                          categories)))
-    (if (or (not category) (< (vector-length (cdr category)) 7))
+             (category (if (assv code tax-entity-codes)
-        #f
+                           (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)
-  (let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
+  (if (assv (string->symbol tax-entity-type) categories)
-                                                                  categories)))
+      (let* ((tax-entity-codes (cdr (assv (string->symbol tax-entity-type)
-         (category (assv code tax-entity-codes)))
+                                          categories)))
-    (if (or (not category) (< (vector-length (cdr category)) 8))
+             (category (if (assv code tax-entity-codes)
-        #f
+                           (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)
   (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 "")
+  (if (or (assv (string->symbol tax-entity-type) categories)
-                                     'F1040
+          (eqv? tax-entity-type ""))
-                                     (string->symbol tax-entity-type))
+      (let* ((tax-entity-codes (cdr (assv (if (eqv? tax-entity-type "")
-                                                                  categories)))
+                                              'F1040
-         (category (assv code tax-entity-codes)))
+                                              (string->symbol tax-entity-type))
-    (and category
+                                          categories)))
-         (vector-ref (cdr 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
   (list