r17216 - gnucash/branches/gda-dev2 - Merge with trunk through 17215
Phil Longstaff
plongstaff at cvs.gnucash.org
Wed Jun 11 19:25:11 EDT 2008
Author: plongstaff
Date: 2008-06-11 19:25:10 -0400 (Wed, 11 Jun 2008)
New Revision: 17216
Trac: http://svn.gnucash.org/trac/changeset/17216
Added:
gnucash/branches/gda-dev2/src/scm/string.scm
Modified:
gnucash/branches/gda-dev2/AUTHORS
gnucash/branches/gda-dev2/configure.in
gnucash/branches/gda-dev2/src/backend/file/sixtp-dom-generators.c
gnucash/branches/gda-dev2/src/backend/file/sixtp-utils.c
gnucash/branches/gda-dev2/src/core-utils/gnc-glib-utils.c
gnucash/branches/gda-dev2/src/engine/Account.c
gnucash/branches/gda-dev2/src/gnome-utils/dialog-commodity.c
gnucash/branches/gda-dev2/src/gnome-utils/gnc-dense-cal.c
gnucash/branches/gda-dev2/src/import-export/qif-import/druid-qif-import.c
gnucash/branches/gda-dev2/src/import-export/qif-import/qif-dialog-utils.scm
gnucash/branches/gda-dev2/src/import-export/qif-import/qif-file.scm
gnucash/branches/gda-dev2/src/import-export/qif-import/qif-guess-map.scm
gnucash/branches/gda-dev2/src/import-export/qif-import/qif-objects.scm
gnucash/branches/gda-dev2/src/import-export/qif-import/qif-parse.scm
gnucash/branches/gda-dev2/src/import-export/qif-import/qif-to-gnc.scm
gnucash/branches/gda-dev2/src/import-export/qif-import/qif-utils.scm
gnucash/branches/gda-dev2/src/import-export/qif-import/qif.glade
gnucash/branches/gda-dev2/src/report/report-system/report.scm
gnucash/branches/gda-dev2/src/scm/Makefile.am
gnucash/branches/gda-dev2/src/scm/main.scm
Log:
Merge with trunk through 17215
Modified: gnucash/branches/gda-dev2/AUTHORS
===================================================================
--- gnucash/branches/gda-dev2/AUTHORS 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/AUTHORS 2008-06-11 23:25:10 UTC (rev 17216)
@@ -91,6 +91,9 @@
Andreas Köhler <andi5.py at gmx.net> is hunting down lots of bugs,
especially for GUI code and other gtk related issues.
+Charles Day <cedayiv at gmail.com> hacks excessively on the QIF importer
+ and aims to see significantly expanded support for investments.
+
Other Contributors:
----------------
(In alphabetical order)
Modified: gnucash/branches/gda-dev2/configure.in
===================================================================
--- gnucash/branches/gda-dev2/configure.in 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/configure.in 2008-06-11 23:25:10 UTC (rev 17216)
@@ -1067,6 +1067,7 @@
# checks for goffice
goffice=0
goffice_with_cairo=0
+ have_goffice_0_5=0
PKG_CHECK_MODULES(GOFFICE, libgoffice-0.6 >= 0.6.0, [goffice=1], [
PKG_CHECK_MODULES(GOFFICE, libgoffice-0.5 >= 0.5.1, [goffice=1], [goffice=0])
])
@@ -1074,6 +1075,7 @@
then
AC_DEFINE(HAVE_GOFFICE_0_5,1,[System has goffice 0.5.1 or better])
AC_DEFINE(GOFFICE_WITH_CAIRO,1,[GOffice has been built with cairo support])
+ have_goffice_0_5=1
goffice_with_cairo=1
else
PKG_CHECK_MODULES(GOFFICE, libgoffice-0.4 >= 0.4.0, [goffice=1], [
@@ -1115,6 +1117,11 @@
], [gtkhtml=0])
AM_CONDITIONAL(GTKHTML_USES_GTKPRINT,test "x$gtkhtml" = "x1")
+ # GOffice >= 0.5 requires GtkHTML >= 3.14
+ if test x$have_goffice_0_5 = x1 -a x$gtkhtml = x0 ; then
+ AC_MSG_ERROR([Goffice uses Cairo/GtkPrint but didn't find GtkHTML with GtkPrint support])
+ fi
+
# fallback to older gtkhtml versions and gnomeprint
if test x$gtkhtml = x0
then
Modified: gnucash/branches/gda-dev2/src/backend/file/sixtp-dom-generators.c
===================================================================
--- gnucash/branches/gda-dev2/src/backend/file/sixtp-dom-generators.c 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/backend/file/sixtp-dom-generators.c 2008-06-11 23:25:10 UTC (rev 17216)
@@ -21,10 +21,9 @@
* *
********************************************************************/
-#include "config.h"
-
#define __EXTENSIONS__
+#include "config.h"
#include <glib.h>
#include "gnc-xml-helper.h"
Modified: gnucash/branches/gda-dev2/src/backend/file/sixtp-utils.c
===================================================================
--- gnucash/branches/gda-dev2/src/backend/file/sixtp-utils.c 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/backend/file/sixtp-utils.c 2008-06-11 23:25:10 UTC (rev 17216)
@@ -21,10 +21,10 @@
* *
********************************************************************/
+#define __EXTENSIONS__
+
#include "config.h"
-#define __EXTENSIONS__
-
#include <ctype.h>
#include <glib.h>
#include <stdio.h>
Modified: gnucash/branches/gda-dev2/src/core-utils/gnc-glib-utils.c
===================================================================
--- gnucash/branches/gda-dev2/src/core-utils/gnc-glib-utils.c 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/core-utils/gnc-glib-utils.c 2008-06-11 23:25:10 UTC (rev 17216)
@@ -269,25 +269,25 @@
void
gnc_scm_log_warn(const gchar *msg)
{
- g_log("gnc.scm", G_LOG_LEVEL_WARNING, msg);
+ g_log("gnc.scm", G_LOG_LEVEL_WARNING, "%s", msg);
}
void
gnc_scm_log_error(const gchar *msg)
{
- g_log("gnc.scm", G_LOG_LEVEL_CRITICAL, msg);
+ g_log("gnc.scm", G_LOG_LEVEL_CRITICAL, "%s", msg);
}
void
gnc_scm_log_msg(const gchar *msg)
{
- g_log("gnc.scm", G_LOG_LEVEL_MESSAGE, msg);
+ g_log("gnc.scm", G_LOG_LEVEL_MESSAGE, "%s", msg);
}
void
gnc_scm_log_debug(const gchar *msg)
{
- g_log("gnc.scm", G_LOG_LEVEL_DEBUG, msg);
+ g_log("gnc.scm", G_LOG_LEVEL_DEBUG, "%s", msg);
}
void gnc_gpid_kill(GPid pid)
Modified: gnucash/branches/gda-dev2/src/engine/Account.c
===================================================================
--- gnucash/branches/gda-dev2/src/engine/Account.c 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/engine/Account.c 2008-06-11 23:25:10 UTC (rev 17216)
@@ -4275,15 +4275,15 @@
Account *acc_b = node_b->data;
priv_b = GET_PRIVATE(acc_b);
- if (0 != safe_strcmp(priv_a->accountName, priv_b->accountName))
+ if (0 != null_strcmp(priv_a->accountName, priv_b->accountName))
continue;
- if (0 != safe_strcmp(priv_a->accountCode, priv_b->accountCode))
+ if (0 != null_strcmp(priv_a->accountCode, priv_b->accountCode))
continue;
- if (0 != safe_strcmp(priv_a->description, priv_b->description))
+ if (0 != null_strcmp(priv_a->description, priv_b->description))
continue;
if (!gnc_commodity_equiv(priv_a->commodity, priv_b->commodity))
continue;
- if (0 != safe_strcmp(xaccAccountGetNotes(acc_a),
+ if (0 != null_strcmp(xaccAccountGetNotes(acc_a),
xaccAccountGetNotes(acc_b)))
continue;
if (priv_a->type != priv_b->type)
Modified: gnucash/branches/gda-dev2/src/gnome-utils/dialog-commodity.c
===================================================================
--- gnucash/branches/gda-dev2/src/gnome-utils/dialog-commodity.c 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/gnome-utils/dialog-commodity.c 2008-06-11 23:25:10 UTC (rev 17216)
@@ -178,6 +178,7 @@
mnemonic ? mnemonic : "");
gtk_label_set_text ((GtkLabel *)(win->select_user_prompt),
user_prompt_text);
+ g_free(user_prompt_text);
/* Run the dialog, handling the terminal conditions. */
done = FALSE;
Modified: gnucash/branches/gda-dev2/src/gnome-utils/gnc-dense-cal.c
===================================================================
--- gnucash/branches/gda-dev2/src/gnome-utils/gnc-dense-cal.c 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/gnome-utils/gnc-dense-cal.c 2008-06-11 23:25:10 UTC (rev 17216)
@@ -1387,6 +1387,8 @@
}
num_weeks_toRet = MAX(num_weeks_toRet, (endWeek - startWeek)+1);
}
+ g_date_free(start);
+ g_date_free(end);
return num_weeks_toRet;
}
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/druid-qif-import.c
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/druid-qif-import.c 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/druid-qif-import.c 2008-06-11 23:25:10 UTC (rev 17216)
@@ -152,22 +152,7 @@
};
typedef struct _qifdruidpage QIFDruidPage;
-static QIFDruidPage * make_qif_druid_page(SCM security_hash_key,
- gnc_commodity * comm);
-static void update_file_page(QIFImportWindow * win);
-static void update_account_page(QIFImportWindow * win);
-static void update_category_page(QIFImportWindow * win);
-static void update_memo_page(QIFImportWindow * win);
-
-static void update_account_picker_page(QIFImportWindow * wind,
- SCM make_display, GtkWidget *view,
- SCM map_info, SCM * display_info);
-
-static void gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
- gpointer arg1,
- gpointer user_data);
-
static GdkColor std_bg_color = { 0, 39835, 49087, 40092 };
static GdkColor std_logo_bg_color = { 0, 65535, 65535, 65535 };
static GdkColor std_title_color = { 0, 65535, 65535, 65535 };
@@ -184,6 +169,124 @@
/****************************************************************
+ * update_account_picker_page
+ *
+ * Generic function to update an account_picker page. This
+ * generalizes the code shared whenever any QIF -> GNC mapper is
+ * updating it's LIST STORE. It asks the Scheme side to guess some account
+ * translations and then shows the account name and suggested
+ * translation in the Accounts page view (acount picker list).
+ ****************************************************************/
+
+static void
+update_account_picker_page(QIFImportWindow * wind, SCM make_display,
+ GtkWidget *view, SCM map_info, SCM * display_info)
+{
+
+ SCM get_qif_name = scm_c_eval_string("qif-map-entry:qif-name");
+ SCM get_gnc_name = scm_c_eval_string("qif-map-entry:gnc-name");
+ SCM get_new = scm_c_eval_string("qif-map-entry:new-acct?");
+ SCM accts_left;
+ const gchar *qif_name, *gnc_name;
+ gboolean checked;
+ gint row = 0;
+ gint prev_row;
+ GtkListStore *store;
+ GtkTreeIter iter;
+ GtkTreePath *path;
+ GtkTreeSelection *selection;
+
+ store = GTK_LIST_STORE(gtk_tree_view_get_model(GTK_TREE_VIEW(view)));
+
+ /* now get the list of strings to display in the gtk_list_store widget */
+ accts_left = scm_call_3(make_display,
+ wind->imported_files,
+ map_info,
+ wind->gnc_acct_info);
+
+ scm_gc_unprotect_object(*display_info);
+ *display_info = accts_left;
+ scm_gc_protect_object(*display_info);
+
+ /* clear the list */
+ gtk_list_store_clear(store);
+
+ while(!SCM_NULLP(accts_left)) {
+ qif_name = SCM_STRING_CHARS(scm_call_1(get_qif_name, SCM_CAR(accts_left)));
+ gnc_name = SCM_STRING_CHARS(scm_call_1(get_gnc_name, SCM_CAR(accts_left)));
+ checked = (scm_call_1(get_new, SCM_CAR(accts_left)) == SCM_BOOL_T);
+
+ gtk_list_store_append(store, &iter);
+ gtk_list_store_set(store, &iter,
+ ACCOUNT_COL_INDEX, row++,
+ ACCOUNT_COL_QIF_NAME, qif_name,
+ ACCOUNT_COL_GNC_NAME, gnc_name,
+ ACCOUNT_COL_NEW, checked,
+ -1);
+ accts_left = SCM_CDR(accts_left);
+ }
+
+ /* move to the old selected row */
+ prev_row = GPOINTER_TO_INT(g_object_get_data(G_OBJECT(store), PREV_ROW));
+ if (prev_row != -1) {
+ selection = gtk_tree_view_get_selection(GTK_TREE_VIEW(view));
+ path = gtk_tree_path_new_from_indices(prev_row, -1);
+ gtk_tree_selection_select_path(selection, path);
+ gtk_tree_path_free(path);
+ }
+}
+
+
+/****************************************************************
+ * update_account_page
+ *
+ * update the QIF account -> GNC Account picker
+ ****************************************************************/
+
+static void
+update_account_page(QIFImportWindow * wind)
+{
+
+ SCM make_account_display = scm_c_eval_string("qif-dialog:make-account-display");
+
+ update_account_picker_page(wind, make_account_display, wind->acct_view,
+ wind->acct_map_info, &(wind->acct_display_info));
+}
+
+
+/****************************************************************
+ * update_category_page
+ *
+ * update the QIF category -> GNC Account picker
+ ****************************************************************/
+
+static void
+update_category_page(QIFImportWindow * wind)
+{
+ SCM make_category_display = scm_c_eval_string("qif-dialog:make-category-display");
+
+ update_account_picker_page(wind, make_category_display, wind->cat_view,
+ wind->cat_map_info, &(wind->cat_display_info));
+}
+
+
+/****************************************************************
+ * update_memo_page
+ *
+ * update the QIF memo -> GNC Account picker
+ ****************************************************************/
+
+static void
+update_memo_page(QIFImportWindow * wind)
+{
+ SCM make_memo_display = scm_c_eval_string("qif-dialog:make-memo-display");
+
+ update_account_picker_page(wind, make_memo_display, wind->memo_view,
+ wind->memo_map_info, &(wind->memo_display_info));
+}
+
+
+/****************************************************************
* gnc_ui_qif_import_commodity_destroy
*
* This function destroys any commodity pages.
@@ -395,7 +498,7 @@
prev = g_list_last(wind->commodity_pages);
}
else {
- prev = g_list_last(wind->pre_comm_pages);
+ prev = g_list_last(wind->pre_comm_pages);
}
break;
default:
@@ -429,15 +532,14 @@
QIFImportWindow * wind = user_data;
GtkWidget * next_page = get_next_druid_page(wind, page);
- if(next_page) {
+ if(next_page)
+ {
gnome_druid_set_page(GNOME_DRUID(wind->druid),
GNOME_DRUID_PAGE(next_page));
-
return TRUE;
}
- else {
- return FALSE;
- }
+
+ return FALSE;
}
@@ -454,14 +556,14 @@
QIFImportWindow * wind = user_data;
GtkWidget * back_page = get_prev_druid_page(wind, page);
- if(back_page) {
+ if(back_page)
+ {
gnome_druid_set_page(GNOME_DRUID(wind->druid),
GNOME_DRUID_PAGE(back_page));
return TRUE;
}
- else {
- return FALSE;
- }
+
+ return FALSE;
}
@@ -790,6 +892,63 @@
}
+/********************************************************************
+ * update_file_page
+ *
+ * Update the list of loaded files.
+ ********************************************************************/
+
+static void
+update_file_page(QIFImportWindow * wind)
+{
+
+ SCM loaded_file_list = wind->imported_files;
+ SCM scm_qiffile = SCM_BOOL_F;
+ SCM qif_file_path;
+ int row = 0;
+ char * row_text;
+ GtkTreeView *view;
+ GtkListStore *store;
+ GtkTreeIter iter;
+ GtkTreePath *path;
+ GtkTreeRowReference *reference = NULL;
+
+ /* clear the list */
+ view = GTK_TREE_VIEW(wind->selected_file_view);
+ store = GTK_LIST_STORE(gtk_tree_view_get_model(view));
+ gtk_list_store_clear(store);
+ qif_file_path = scm_c_eval_string("qif-file:path");
+
+ while(!SCM_NULLP(loaded_file_list)) {
+ scm_qiffile = SCM_CAR(loaded_file_list);
+ row_text = SCM_STRING_CHARS(scm_call_1(qif_file_path, scm_qiffile));
+
+ gtk_list_store_append(store, &iter);
+ gtk_list_store_set(store, &iter,
+ FILENAME_COL_INDEX, row++,
+ FILENAME_COL_NAME, row_text,
+ -1);
+ if(scm_qiffile == wind->selected_file) {
+ path = gtk_tree_model_get_path(GTK_TREE_MODEL(store), &iter);
+ reference = gtk_tree_row_reference_new(GTK_TREE_MODEL(store), path);
+ gtk_tree_path_free(path);
+ }
+
+ loaded_file_list = SCM_CDR(loaded_file_list);
+ }
+
+ if (reference) {
+ GtkTreeSelection* selection = gtk_tree_view_get_selection(view);
+ path = gtk_tree_row_reference_get_path(reference);
+ if (path) {
+ gtk_tree_selection_select_path(selection, path);
+ gtk_tree_path_free(path);
+ }
+ gtk_tree_row_reference_free(reference);
+ }
+}
+
+
/****************************************************************
* gnc_ui_qif_import_select_loaded_file_cb
* callback when a file is clicked in the "loaded files" page
@@ -900,58 +1059,26 @@
/********************************************************************
- * update_file_page
- * update the list of loaded files
+ * gnc_ui_qif_import_loaded_files_next_cb
+ *
+ * Get the matching pages ready for viewing.
********************************************************************/
-static void
-update_file_page(QIFImportWindow * wind)
+static gboolean
+gnc_ui_qif_import_loaded_files_next_cb(GnomeDruidPage * page,
+ gpointer arg1,
+ gpointer user_data)
{
+ QIFImportWindow * wind = user_data;
- SCM loaded_file_list = wind->imported_files;
- SCM scm_qiffile = SCM_BOOL_F;
- SCM qif_file_path;
- int row = 0;
- char * row_text;
- GtkTreeView *view;
- GtkListStore *store;
- GtkTreeIter iter;
- GtkTreePath *path;
- GtkTreeRowReference *reference = NULL;
+ /* Prepare the matching pages. */
+ gnc_set_busy_cursor(NULL, TRUE);
+ update_account_page(wind);
+ update_category_page(wind);
+ update_memo_page(wind);
+ gnc_unset_busy_cursor(NULL);
- /* clear the list */
- view = GTK_TREE_VIEW(wind->selected_file_view);
- store = GTK_LIST_STORE(gtk_tree_view_get_model(view));
- gtk_list_store_clear(store);
- qif_file_path = scm_c_eval_string("qif-file:path");
-
- while(!SCM_NULLP(loaded_file_list)) {
- scm_qiffile = SCM_CAR(loaded_file_list);
- row_text = SCM_STRING_CHARS(scm_call_1(qif_file_path, scm_qiffile));
-
- gtk_list_store_append(store, &iter);
- gtk_list_store_set(store, &iter,
- FILENAME_COL_INDEX, row++,
- FILENAME_COL_NAME, row_text,
- -1);
- if(scm_qiffile == wind->selected_file) {
- path = gtk_tree_model_get_path(GTK_TREE_MODEL(store), &iter);
- reference = gtk_tree_row_reference_new(GTK_TREE_MODEL(store), path);
- gtk_tree_path_free(path);
- }
-
- loaded_file_list = SCM_CDR(loaded_file_list);
- }
-
- if (reference) {
- GtkTreeSelection* selection = gtk_tree_view_get_selection(view);
- path = gtk_tree_row_reference_get_path(reference);
- if (path) {
- gtk_tree_selection_select_path(selection, path);
- gtk_tree_path_free(path);
- }
- gtk_tree_row_reference_free(reference);
- }
+ return gnc_ui_qif_import_generic_next_cb(page, arg1, user_data);
}
@@ -1017,123 +1144,6 @@
}
-/****************************************************************
- * update_account_picker_page
- * Generic function to update an account_picker page. This
- * generalizes the code shared whenever any QIF -> GNC mapper is
- * updating it's LIST STORE. It asks the Scheme side to guess some account
- * translations and then shows the account name and suggested
- * translation in the Accounts page view (acount picker list).
- ****************************************************************/
-
-static void
-update_account_picker_page(QIFImportWindow * wind, SCM make_display,
- GtkWidget *view, SCM map_info, SCM * display_info)
-{
-
- SCM get_qif_name = scm_c_eval_string("qif-map-entry:qif-name");
- SCM get_gnc_name = scm_c_eval_string("qif-map-entry:gnc-name");
- SCM get_new = scm_c_eval_string("qif-map-entry:new-acct?");
- SCM accts_left;
- const gchar *qif_name, *gnc_name;
- gboolean checked;
- gint row = 0;
- gint prev_row;
- GtkListStore *store;
- GtkTreeIter iter;
- GtkTreePath *path;
- GtkTreeSelection *selection;
-
- store = GTK_LIST_STORE(gtk_tree_view_get_model(GTK_TREE_VIEW(view)));
-
- /* now get the list of strings to display in the gtk_list_store widget */
- accts_left = scm_call_3(make_display,
- wind->imported_files,
- map_info,
- wind->gnc_acct_info);
-
- scm_gc_unprotect_object(*display_info);
- *display_info = accts_left;
- scm_gc_protect_object(*display_info);
-
- /* clear the list */
- gtk_list_store_clear(store);
-
- while(!SCM_NULLP(accts_left)) {
- qif_name = SCM_STRING_CHARS(scm_call_1(get_qif_name, SCM_CAR(accts_left)));
- gnc_name = SCM_STRING_CHARS(scm_call_1(get_gnc_name, SCM_CAR(accts_left)));
- checked = (scm_call_1(get_new, SCM_CAR(accts_left)) == SCM_BOOL_T);
-
- gtk_list_store_append(store, &iter);
- gtk_list_store_set(store, &iter,
- ACCOUNT_COL_INDEX, row++,
- ACCOUNT_COL_QIF_NAME, qif_name,
- ACCOUNT_COL_GNC_NAME, gnc_name,
- ACCOUNT_COL_NEW, checked,
- -1);
- accts_left = SCM_CDR(accts_left);
- }
-
- /* move to the old selected row */
- prev_row = GPOINTER_TO_INT(g_object_get_data(G_OBJECT(store), PREV_ROW));
- if (prev_row != -1) {
- selection = gtk_tree_view_get_selection(GTK_TREE_VIEW(view));
- path = gtk_tree_path_new_from_indices(prev_row, -1);
- gtk_tree_selection_select_path(selection, path);
- gtk_tree_path_free(path);
- }
-}
-
-
-/****************************************************************
- * update_account_page
- *
- * update the QIF account -> GNC Account picker
- ****************************************************************/
-
-static void
-update_account_page(QIFImportWindow * wind)
-{
-
- SCM make_account_display = scm_c_eval_string("qif-dialog:make-account-display");
-
- update_account_picker_page(wind, make_account_display, wind->acct_view,
- wind->acct_map_info, &(wind->acct_display_info));
-}
-
-
-/****************************************************************
- * update_category_page
- *
- * update the QIF category -> GNC Account picker
- ****************************************************************/
-
-static void
-update_category_page(QIFImportWindow * wind)
-{
- SCM make_category_display = scm_c_eval_string("qif-dialog:make-category-display");
-
- update_account_picker_page(wind, make_category_display, wind->cat_view,
- wind->cat_map_info, &(wind->cat_display_info));
-}
-
-
-/****************************************************************
- * update_memo_page
- *
- * update the QIF memo -> GNC Account picker
- ****************************************************************/
-
-static void
-update_memo_page(QIFImportWindow * wind)
-{
- SCM make_memo_display = scm_c_eval_string("qif-dialog:make-memo-display");
-
- update_account_picker_page(wind, make_memo_display, wind->memo_view,
- wind->memo_map_info, &(wind->memo_display_info));
-}
-
-
/********************************************************************
********************************************************************/
@@ -1401,7 +1411,7 @@
* gnc_ui_qif_import_memo_activate_cb
*
* This handler is invoked when a row is double-clicked in the "Match
- * QIF memo/payee to GnuCash accounts" page.
+ * QIF payee/memo to GnuCash accounts" page.
********************************************************************/
static void
@@ -1457,23 +1467,6 @@
}
-/********************************************************************
- * gnc_ui_qif_import_account_prepare_cb
- ********************************************************************/
-
-static void
-gnc_ui_qif_import_account_prepare_cb(GnomeDruidPage * page,
- gpointer arg1,
- gpointer user_data)
-{
- QIFImportWindow * wind = user_data;
-
- gnc_set_busy_cursor(NULL, TRUE);
- update_account_page(wind);
- gnc_unset_busy_cursor(NULL);
-}
-
-
/****************************************************************
* gnc_ui_qif_import_account_rematch_cb
*
@@ -1497,20 +1490,40 @@
}
-/********************************************************************
- * gnc_ui_qif_import_category_prepare_cb
- ********************************************************************/
+/****************************************************************
+ * gnc_ui_qif_import_account_next_cb
+ *
+ * Find the next page to show, depending on whether there are
+ * category or payee/memo mappings to be dealt with.
+ ****************************************************************/
-static void
-gnc_ui_qif_import_category_prepare_cb(GnomeDruidPage * page,
- gpointer arg1,
- gpointer user_data)
+static gboolean
+gnc_ui_qif_import_account_next_cb(GnomeDruidPage * page,
+ gpointer arg1,
+ gpointer user_data)
{
QIFImportWindow * wind = user_data;
- gnc_set_busy_cursor(NULL, TRUE);
- update_category_page(wind);
- gnc_unset_busy_cursor(NULL);
+ /* If there are category mappings then proceed as usual. */
+ if (SCM_LISTP(wind->cat_display_info) && !SCM_NULLP(wind->cat_display_info))
+ return gnc_ui_qif_import_generic_next_cb(page, arg1, user_data);
+
+ /* If there are memo mappings then skip to that step. */
+ if (SCM_LISTP(wind->memo_display_info) && !SCM_NULLP(wind->memo_display_info))
+ {
+ if (wind->show_doc_pages)
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ get_named_page(wind, "memo_doc_page"));
+ else
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ get_named_page(wind, "memo_match_page"));
+ return TRUE;
+ }
+
+ /* Skip ahead to the currency page. */
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ get_named_page(wind, "currency_page"));
+ return TRUE;
}
@@ -1539,54 +1552,27 @@
/****************************************************************
* gnc_ui_qif_import_category_next_cb
- * Check to see if there are any payees and memos to show. If not
- * jump to currency page.
+ *
+ * Check to see if there are any memo or payee mappings to show.
+ * If not, skip that step.
****************************************************************/
+
static gboolean
gnc_ui_qif_import_category_next_cb(GnomeDruidPage * page,
gpointer arg1,
gpointer user_data)
{
QIFImportWindow * wind = user_data;
- SCM make_memo_display = scm_c_eval_string("qif-dialog:make-memo-display");
- SCM accts_left;
- gnc_set_busy_cursor(NULL, TRUE);
- /*
- * Hack. Call make-memo-display to see if there are any memos to display.
- * This will get called again when we actually do make the memo display.
- */
- accts_left = scm_call_3(make_memo_display,
- wind->imported_files,
- wind->memo_map_info,
- wind->gnc_acct_info);
-
- gnc_unset_busy_cursor(NULL);
-
- if (SCM_NULLP(accts_left)) {
+ /* If there aren't any payee/memo mappings then skip that step. */
+ if (!SCM_LISTP(wind->memo_display_info) || SCM_NULLP(wind->memo_display_info))
+ {
gnome_druid_set_page(GNOME_DRUID(wind->druid),
get_named_page(wind, "currency_page"));
return TRUE;
- } else {
- return gnc_ui_qif_import_generic_next_cb(page, arg1, user_data);
}
-}
-
-/********************************************************************
- * gnc_ui_qif_import_memo_prepare_cb
- ********************************************************************/
-
-static void
-gnc_ui_qif_import_memo_prepare_cb(GnomeDruidPage * page,
- gpointer arg1,
- gpointer user_data)
-{
- QIFImportWindow * wind = user_data;
-
- gnc_set_busy_cursor(NULL, TRUE);
- update_memo_page(wind);
- gnc_unset_busy_cursor(NULL);
+ return gnc_ui_qif_import_generic_next_cb(page, arg1, user_data);
}
@@ -1614,6 +1600,58 @@
/****************************************************************
+ * gnc_ui_qif_import_memo_doc_back_cb
+ *
+ * Figure out which page went before payee/memo documentation.
+ ****************************************************************/
+
+static gboolean
+gnc_ui_qif_import_memo_doc_back_cb(GnomeDruidPage * page, gpointer arg1,
+ gpointer user_data)
+{
+ QIFImportWindow * wind = user_data;
+
+ /* If there are no categories to show, go to account matching. */
+ if (!SCM_LISTP(wind->cat_display_info) || SCM_NULLP(wind->cat_display_info))
+ {
+
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ get_named_page(wind, "account_match_page"));
+ return TRUE;
+ }
+
+ return gnc_ui_qif_import_generic_back_cb(page, arg1, user_data);
+}
+
+
+/****************************************************************
+ * gnc_ui_qif_import_memo_back_cb
+ *
+ * Figure out which page went before payee/memo mapping.
+ ****************************************************************/
+
+static gboolean
+gnc_ui_qif_import_memo_back_cb(GnomeDruidPage * page, gpointer arg1,
+ gpointer user_data)
+{
+ QIFImportWindow * wind = user_data;
+
+ /* If documentation is off and there are no categories to show,
+ * skip directly to account matching. */
+ if (!wind->show_doc_pages &&
+ (!SCM_LISTP(wind->cat_display_info) || SCM_NULLP(wind->cat_display_info)))
+ {
+
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ get_named_page(wind, "account_match_page"));
+ return TRUE;
+ }
+
+ return gnc_ui_qif_import_generic_back_cb(page, arg1, user_data);
+}
+
+
+/****************************************************************
* gnc_ui_qif_import_commodity_update
*
* This function updates the commodities based on the values for
@@ -1918,102 +1956,39 @@
}
-/********************************************************************
- * gnc_ui_qif_import_memo_next_cb
- ********************************************************************/
+/****************************************************************
+ * gnc_ui_qif_import_currency_back_cb
+ *
+ * Set the next page depending on whether there are payee/memo
+ * or category mappings to show.
+ ****************************************************************/
static gboolean
-gnc_ui_qif_import_memo_next_cb(GnomeDruidPage * page,
- gpointer arg1,
- gpointer user_data)
+gnc_ui_qif_import_currency_back_cb(GnomeDruidPage * page,
+ gpointer arg1,
+ gpointer user_data)
{
QIFImportWindow * wind = user_data;
- SCM any_new = scm_c_eval_string("qif-import:any-new-accts?");
- /* if any accounts are new, ask about the currency; else,
- just skip that page */
- if ((scm_call_1(any_new, wind->acct_map_info) == SCM_BOOL_T) ||
- (scm_call_1(any_new, wind->cat_map_info) == SCM_BOOL_T))
- /* go to currency page */
- return gnc_ui_qif_import_generic_next_cb(page, arg1, wind);
- else
+ /* If there are payee/memo mappings to display, go there. */
+ if (SCM_LISTP(wind->memo_display_info) && !SCM_NULLP(wind->memo_display_info))
{
- /* If we need to look at securities do that; otherwise import
- xtns and go to the duplicates page */
- if (gnc_ui_qif_import_new_securities(wind))
- {
- if (wind->show_doc_pages)
- gnome_druid_set_page(GNOME_DRUID(wind->druid),
- get_named_page(wind, "commodity_doc_page"));
- else
- {
- gnc_ui_qif_import_commodity_prepare_cb(page, arg1, wind);
- gnome_druid_set_page(GNOME_DRUID(wind->druid),
- GNOME_DRUID_PAGE(wind->commodity_pages->data));
- }
- }
- else
- /* It's time to import the accounts. */
- gnc_ui_qif_import_convert(wind);
-
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ get_named_page(wind, "memo_match_page"));
return TRUE;
}
-}
-/****************************************************************
- * gnc_ui_qif_import_currency_back_cb
- * Check to see if there are any payees and memos to show. If not
- * jump to category match page.
- ****************************************************************/
-static gboolean
-gnc_ui_qif_import_currency_back_cb(GnomeDruidPage * page, gpointer arg1,
- gpointer user_data)
-{
- QIFImportWindow * wind = user_data;
-
- if (!wind->memo_display_info ||
- (wind->memo_display_info == SCM_BOOL_F) ||
- SCM_NULLP(wind->memo_display_info))
+ /* If there are category mappings to display, go there. */
+ if (SCM_LISTP(wind->cat_display_info) && !SCM_NULLP(wind->cat_display_info))
{
gnome_druid_set_page(GNOME_DRUID(wind->druid),
get_named_page(wind, "category_match_page"));
return TRUE;
- } else {
- return gnc_ui_qif_import_generic_back_cb(page, arg1, user_data);
}
-}
-/********************************************************************
- * gnc_ui_qif_import_currency_next_cb
- ********************************************************************/
-
-static gboolean
-gnc_ui_qif_import_currency_next_cb(GnomeDruidPage * page,
- gpointer arg1,
- gpointer user_data)
-{
- QIFImportWindow * wind = user_data;
-
- gnc_set_busy_cursor(NULL, TRUE);
-
- if (gnc_ui_qif_import_new_securities(wind))
- {
- /* There are new commodities, so show a commodity page next. */
- if (wind->show_doc_pages)
- gnome_druid_set_page(GNOME_DRUID(wind->druid),
- get_named_page(wind, "commodity_doc_page"));
- else
- {
- gnc_ui_qif_import_commodity_prepare_cb(page, arg1, user_data);
- gnome_druid_set_page(GNOME_DRUID(wind->druid),
- GNOME_DRUID_PAGE(wind->commodity_pages->data));
- }
- }
- else
- /* It's time to import the accounts. */
- gnc_ui_qif_import_convert(wind);
-
- gnc_unset_busy_cursor(NULL);
+ /* Go to account matching. */
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ get_named_page(wind, "account_match_page"));
return TRUE;
}
@@ -2125,96 +2100,8 @@
}
-/********************************************************************
- * gnc_ui_qif_import_commodity_prepare_cb
- * build a mapping of QIF security name to gnc_commodity
- ********************************************************************/
-
-static void
-gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
- gpointer arg1,
- gpointer user_data)
-{
- QIFImportWindow * wind = user_data;
-
- SCM hash_ref = scm_c_eval_string("hash-ref");
- SCM securities;
- SCM comm_ptr_token;
-
- GList * current;
- gnc_commodity * commodity;
- GnomeDruidPage * back_page = get_named_page(wind, "commodity_doc_page");
- QIFDruidPage * new_page;
-
- /* This shouldn't happen, but do the right thing if it does. */
- if (wind->new_securities == SCM_BOOL_F || SCM_NULLP(wind->new_securities))
- {
- g_warning("QIF import: BUG DETECTED! Reached commodity doc page with nothing to do!");
- gnc_ui_qif_import_convert(wind);
- }
- else
- {
- /*
- * Make druid pages for each new QIF security.
- */
- gnc_set_busy_cursor(NULL, TRUE);
- securities = wind->new_securities;
- current = wind->commodity_pages;
- while (!SCM_NULLP(securities) && (securities != SCM_BOOL_F))
- {
- if (current)
- {
- /* The page has already been made. */
- back_page = GNOME_DRUID_PAGE(current->data);
- current = current->next;
- }
- else
- {
- /* Get the GnuCash commodity corresponding to the new QIF security. */
- comm_ptr_token = scm_call_2(hash_ref,
- wind->security_hash,
- SCM_CAR(securities));
- #define FUNC_NAME "make_qif_druid_page"
- commodity = SWIG_MustGetPtr(comm_ptr_token,
- SWIG_TypeQuery("_p_gnc_commodity"), 1, 0);
- #undef FUNC_NAME
-
- /* Add a druid page for the commodity. */
- new_page = make_qif_druid_page(SCM_CAR(securities), commodity);
-
- g_signal_connect(new_page->page, "prepare",
- G_CALLBACK(gnc_ui_qif_import_comm_prepare_cb),
- wind);
-
- g_signal_connect(new_page->page, "back",
- G_CALLBACK(gnc_ui_qif_import_generic_back_cb),
- wind);
-
- g_signal_connect(new_page->page, "next",
- G_CALLBACK(gnc_ui_qif_import_comm_next_cb),
- wind);
-
- wind->commodity_pages = g_list_append(wind->commodity_pages,
- new_page->page);
-
- gnome_druid_insert_page(GNOME_DRUID(wind->druid),
- back_page,
- GNOME_DRUID_PAGE(new_page->page));
- back_page = GNOME_DRUID_PAGE(new_page->page);
- gtk_widget_show_all(new_page->page);
- }
-
- securities = SCM_CDR(securities);
- }
-
- gnc_unset_busy_cursor(NULL);
- }
-
- gnc_druid_set_colors(GNOME_DRUID(wind->druid));
-}
-
static QIFDruidPage *
-make_qif_druid_page(SCM security_hash_key, gnc_commodity *comm)
+new_security_page(SCM security_hash_key, gnc_commodity *comm)
{
QIFDruidPage *retval = g_new0(QIFDruidPage, 1);
@@ -2324,7 +2211,146 @@
}
+/********************************************************************
+ * prepare_security_pages
+ *
+ * Prepare the druid page for each security.
+ ********************************************************************/
+
static void
+prepare_security_pages(QIFImportWindow * wind)
+{
+ SCM hash_ref = scm_c_eval_string("hash-ref");
+ SCM securities;
+ SCM comm_ptr_token;
+
+ GList * current;
+ gnc_commodity * commodity;
+ GnomeDruidPage * back_page = get_named_page(wind, "commodity_doc_page");
+ QIFDruidPage * new_page;
+
+ /*
+ * Make druid pages for each new QIF security.
+ */
+ gnc_set_busy_cursor(NULL, TRUE);
+ securities = wind->new_securities;
+ current = wind->commodity_pages;
+ while (!SCM_NULLP(securities) && (securities != SCM_BOOL_F))
+ {
+ if (current)
+ {
+ /* The page has already been made. */
+ back_page = GNOME_DRUID_PAGE(current->data);
+ current = current->next;
+ }
+ else
+ {
+ /* Get the GnuCash commodity corresponding to the new QIF security. */
+ comm_ptr_token = scm_call_2(hash_ref,
+ wind->security_hash,
+ SCM_CAR(securities));
+ #define FUNC_NAME "new_security_page"
+ commodity = SWIG_MustGetPtr(comm_ptr_token,
+ SWIG_TypeQuery("_p_gnc_commodity"), 1, 0);
+ #undef FUNC_NAME
+
+ /* Build a new security page. */
+ new_page = new_security_page(SCM_CAR(securities), commodity);
+
+ /* Connect the signals. */
+ g_signal_connect(new_page->page, "prepare",
+ G_CALLBACK(gnc_ui_qif_import_comm_prepare_cb),
+ wind);
+
+ g_signal_connect(new_page->page, "back",
+ G_CALLBACK(gnc_ui_qif_import_generic_back_cb),
+ wind);
+
+ g_signal_connect(new_page->page, "next",
+ G_CALLBACK(gnc_ui_qif_import_comm_next_cb),
+ wind);
+
+ /* Add it to the list of security pages. */
+ wind->commodity_pages = g_list_append(wind->commodity_pages,
+ new_page->page);
+
+ /* Add the new page to the druid. */
+ gnome_druid_insert_page(GNOME_DRUID(wind->druid),
+ back_page,
+ GNOME_DRUID_PAGE(new_page->page));
+
+ back_page = GNOME_DRUID_PAGE(new_page->page);
+ gtk_widget_show_all(new_page->page);
+ }
+
+ securities = SCM_CDR(securities);
+ }
+ gnc_unset_busy_cursor(NULL);
+
+ gnc_druid_set_colors(GNOME_DRUID(wind->druid));
+}
+
+
+/********************************************************************
+ * gnc_ui_qif_import_currency_next_cb
+ ********************************************************************/
+
+static gboolean
+gnc_ui_qif_import_currency_next_cb(GnomeDruidPage * page,
+ gpointer arg1,
+ gpointer user_data)
+{
+ QIFImportWindow * wind = user_data;
+
+ gnc_set_busy_cursor(NULL, TRUE);
+
+ if (gnc_ui_qif_import_new_securities(wind))
+ {
+ /* There are new commodities, so show a commodity page next. */
+ if (wind->show_doc_pages)
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ get_named_page(wind, "commodity_doc_page"));
+ else
+ {
+ prepare_security_pages(wind);
+ gnome_druid_set_page(GNOME_DRUID(wind->druid),
+ GNOME_DRUID_PAGE(wind->commodity_pages->data));
+ }
+ }
+ else
+ /* It's time to import the accounts. */
+ gnc_ui_qif_import_convert(wind);
+
+ gnc_unset_busy_cursor(NULL);
+ return TRUE;
+}
+
+
+/********************************************************************
+ * gnc_ui_qif_import_commodity_prepare_cb
+ *
+ * build a mapping of QIF security name to gnc_commodity
+ ********************************************************************/
+
+static void
+gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
+ gpointer arg1,
+ gpointer user_data)
+{
+ QIFImportWindow * wind = user_data;
+
+ /* This shouldn't happen, but do the right thing if it does. */
+ if (wind->new_securities == SCM_BOOL_F || SCM_NULLP(wind->new_securities))
+ {
+ g_warning("QIF import: BUG DETECTED! Reached commodity doc page with nothing to do!");
+ gnc_ui_qif_import_convert(wind);
+ }
+ else
+ prepare_security_pages(wind);
+}
+
+
+static void
refresh_old_transactions(QIFImportWindow * wind, int selection)
{
SCM possible_matches;
@@ -2668,6 +2694,10 @@
G_CALLBACK(gnc_ui_qif_import_unload_file_cb), retval);
glade_xml_signal_connect_data
+ (xml, "gnc_ui_qif_import_loaded_files_next_cb",
+ G_CALLBACK(gnc_ui_qif_import_loaded_files_next_cb), retval);
+
+ glade_xml_signal_connect_data
(xml, "gnc_ui_qif_import_default_acct_next_cb",
G_CALLBACK(gnc_ui_qif_import_default_acct_next_cb), retval);
@@ -2676,16 +2706,12 @@
G_CALLBACK(gnc_ui_qif_import_default_acct_back_cb), retval);
glade_xml_signal_connect_data
- (xml, "gnc_ui_qif_import_account_prepare_cb",
- G_CALLBACK(gnc_ui_qif_import_account_prepare_cb), retval);
-
- glade_xml_signal_connect_data
(xml, "gnc_ui_qif_import_account_rematch_cb",
G_CALLBACK(gnc_ui_qif_import_account_rematch_cb), retval);
glade_xml_signal_connect_data
- (xml, "gnc_ui_qif_import_category_prepare_cb",
- G_CALLBACK(gnc_ui_qif_import_category_prepare_cb), retval);
+ (xml, "gnc_ui_qif_import_account_next_cb",
+ G_CALLBACK(gnc_ui_qif_import_account_next_cb), retval);
glade_xml_signal_connect_data
(xml, "gnc_ui_qif_import_category_rematch_cb",
@@ -2696,16 +2722,16 @@
G_CALLBACK(gnc_ui_qif_import_category_next_cb), retval);
glade_xml_signal_connect_data
- (xml, "gnc_ui_qif_import_memo_prepare_cb",
- G_CALLBACK(gnc_ui_qif_import_memo_prepare_cb), retval);
+ (xml, "gnc_ui_qif_import_memo_doc_back_cb",
+ G_CALLBACK(gnc_ui_qif_import_memo_doc_back_cb), retval);
glade_xml_signal_connect_data
(xml, "gnc_ui_qif_import_memo_rematch_cb",
G_CALLBACK(gnc_ui_qif_import_memo_rematch_cb), retval);
glade_xml_signal_connect_data
- (xml, "gnc_ui_qif_import_memo_next_cb",
- G_CALLBACK(gnc_ui_qif_import_memo_next_cb), retval);
+ (xml, "gnc_ui_qif_import_memo_back_cb",
+ G_CALLBACK(gnc_ui_qif_import_memo_back_cb), retval);
glade_xml_signal_connect_data
(xml, "gnc_ui_qif_import_currency_back_cb",
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/qif-dialog-utils.scm
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/qif-dialog-utils.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/qif-dialog-utils.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -57,6 +57,14 @@
(define (default-unspec-acct)
(_ "Unspecified"))
+;; The following investment actions implicitly specify
+;; the two accounts involved in the transaction.
+(define qif-import:actions-implicit
+ (list 'buy 'cglong 'cgmid 'cgshort 'div 'intinc 'margint 'reinvdiv
+ 'reinvint 'reinvlg 'reinvmd 'reinvsg 'reinvsh 'reminder
+ 'rtrncap 'sell 'shrsin 'shrsout 'stksplit))
+
+
(define (qif-import:gnc-account-exists map-entry acct-list)
(let ((retval #f))
(for-each
@@ -149,17 +157,23 @@
GNC-CCARD-TYPE
GNC-CASH-TYPE
GNC-ASSET-TYPE
- GNC-LIABILITY-TYPE)))
+ GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE
+ GNC-PAYABLE-TYPE)))
((divx cgshortx cgmidx cglongx intincx margintx rtrncapx)
(set! qif-account
- (qif-split:category
- (car (qif-xtn:splits xtn))))
+ (and (qif-split:category-is-account?
+ (car (qif-xtn:splits xtn)))
+ (qif-split:category
+ (car (qif-xtn:splits xtn)))))
(set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE
GNC-CASH-TYPE
GNC-ASSET-TYPE
- GNC-LIABILITY-TYPE)))
+ GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE
+ GNC-PAYABLE-TYPE)))
((miscincx miscexpx)
(set! qif-account
(qif-split:miscx-category
@@ -168,7 +182,9 @@
GNC-CCARD-TYPE
GNC-CASH-TYPE
GNC-ASSET-TYPE
- GNC-LIABILITY-TYPE))))
+ GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE
+ GNC-PAYABLE-TYPE))))
;; now reference the near-end account
(if qif-account
@@ -203,16 +219,22 @@
GNC-CCARD-TYPE
GNC-CASH-TYPE
GNC-ASSET-TYPE
- GNC-LIABILITY-TYPE)))
+ GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE
+ GNC-PAYABLE-TYPE)))
((buyx sellx xin xout)
(set! qif-account
- (qif-split:category
- (car (qif-xtn:splits xtn))))
+ (and (qif-split:category-is-account?
+ (car (qif-xtn:splits xtn)))
+ (qif-split:category
+ (car (qif-xtn:splits xtn)))))
(set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE
GNC-CASH-TYPE
GNC-ASSET-TYPE
- GNC-LIABILITY-TYPE)))
+ GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE
+ GNC-PAYABLE-TYPE)))
((stksplit)
(set! qif-account
@@ -220,7 +242,9 @@
(set! qif-account-types (list GNC-STOCK-TYPE
GNC-MUTUAL-TYPE
GNC-ASSET-TYPE
- GNC-LIABILITY-TYPE)))
+ GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE
+ GNC-PAYABLE-TYPE)))
((cgshort cgshortx reinvsg reinvsh)
(set! qif-account
(default-cgshort-acct from-acct stock-acct))
@@ -301,12 +325,13 @@
(if (not entry)
(set! entry (qif-import:guess-acct
from-acct
- (list
- GNC-BANK-TYPE
- GNC-CCARD-TYPE
- GNC-CASH-TYPE
- GNC-ASSET-TYPE
- GNC-LIABILITY-TYPE)
+ (list GNC-BANK-TYPE
+ GNC-CCARD-TYPE
+ GNC-CASH-TYPE
+ GNC-ASSET-TYPE
+ GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE
+ GNC-PAYABLE-TYPE)
gnc-acct-info)))
(qif-map-entry:set-display?! entry #t)
(hash-set! acct-hash from-acct entry)
@@ -325,12 +350,13 @@
(set! entry
(qif-import:guess-acct
xtn-acct
- (list
- GNC-BANK-TYPE
- GNC-CCARD-TYPE
- GNC-CASH-TYPE
- GNC-ASSET-TYPE
- GNC-LIABILITY-TYPE)
+ (list GNC-BANK-TYPE
+ GNC-CCARD-TYPE
+ GNC-CASH-TYPE
+ GNC-ASSET-TYPE
+ GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE
+ GNC-PAYABLE-TYPE)
gnc-acct-info)))
(qif-map-entry:set-display?! entry #t)
(hash-set! acct-hash xtn-acct entry)))))
@@ -401,28 +427,62 @@
(lambda (qif-file)
(for-each
(lambda (xtn)
- ;; iterate over the splits
- (for-each
- (lambda (split)
- (let ((xtn-is-acct (qif-split:category-is-account? split))
- (xtn-cat #f)
- (entry #f))
- (if (not xtn-is-acct)
- (begin
- (set! xtn-cat (qif-split:category split))
- (set! entry (hash-ref cat-hash xtn-cat))
- (if (not entry)
- (set! entry
- (qif-import:guess-acct
- xtn-cat
- (if (gnc-numeric-positive-p
- (qif-split:amount split))
- (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE)
- (list GNC-EXPENSE-TYPE GNC-INCOME-TYPE))
- gnc-acct-info)))
- (qif-map-entry:set-display?! entry #t)
- (hash-set! cat-hash xtn-cat entry)))))
- (qif-xtn:splits xtn)))
+ (let ((action (qif-xtn:action xtn)))
+ ;; Many types of investment transactions implicitly use the
+ ;; brokerage account or a known offshoot. There is no need
+ ;; to consider a category mapping for these.
+ (if (not (and action
+ (memv action qif-import:actions-implicit)))
+ ;; iterate over the splits
+ (for-each
+ (lambda (split)
+ (let ((xtn-is-acct (qif-split:category-is-account? split))
+ (xtn-cat #f)
+ (entry #f))
+ (if (not xtn-is-acct)
+ (begin
+ (set! xtn-cat (qif-split:category split))
+ (set! entry (hash-ref cat-hash xtn-cat))
+ ;; NOTE: It would be more robust and efficient if the
+ ;; three "make display" routines below were combined:
+ ;; make-account-display
+ ;; make-category-display
+ ;; make-memo-display
+ ;;
+ ;; This would also require adjusting several callback
+ ;; functions that reference these procedures from C.
+ ;;
+ ;; Until then, the maintainer of this code must make
+ ;; sure that the logic used in the "if" below matches
+ ;; the criteria for making memo/payee mappings (seen
+ ;; in make-memo-display).
+
+ ;; Add an entry if there isn't one already and either
+ ;; (a) the category is non-blank, or
+ ;; (b) no memo/payee mapping can be applied
+ (if (and (not entry)
+ (or (not (and (string? xtn-cat)
+ (string=? xtn-cat "")))
+ (and (or (not (qif-split:memo split))
+ (equal? (qif-split:memo split) ""))
+ (or (> (length (qif-xtn:splits xtn)) 1)
+ (not (qif-xtn:payee xtn))
+ (equal? (qif-xtn:payee xtn) "")))))
+ (set! entry
+ (qif-import:guess-acct
+ xtn-cat
+ (if (gnc-numeric-positive-p
+ (qif-split:amount split))
+ (list GNC-INCOME-TYPE
+ GNC-EXPENSE-TYPE)
+ (list GNC-EXPENSE-TYPE
+ GNC-INCOME-TYPE))
+ gnc-acct-info)))
+ (if entry
+ (begin
+ (qif-map-entry:set-display?! entry #t)
+ (hash-set! cat-hash xtn-cat entry)))))))
+ (qif-xtn:splits xtn)))))
(qif-file:xtns qif-file)))
qif-files)
@@ -464,47 +524,55 @@
(for-each
(lambda (xtn)
(let ((payee (qif-xtn:payee xtn))
+ (action (qif-xtn:action xtn))
(splits (qif-xtn:splits xtn)))
- (for-each
- (lambda (split)
- (let ((cat (qif-split:category split))
- (memo (qif-split:memo split))
- (key-string #f))
- ;; for each split: if there's a category, do nothing.
- ;; if there's a payee, use that as the
- ;; key otherwise, use the split memo.
- (cond ((and cat
- (or (not (string? cat))
- (not (string=? cat ""))))
- (set! key-string #f))
- ((and payee (= (length splits) 1))
- (set! key-string payee))
- (memo
- (set! key-string memo)))
+ ;; Many types of investment transactions implicitly use the
+ ;; brokerage account or a known offshoot. There is no need
+ ;; to consider a memo/payee mapping for these.
+ (if (not (and action
+ (memv action qif-import:actions-implicit)))
+ (for-each
+ (lambda (split)
+ (let ((cat (qif-split:category split))
+ (memo (qif-split:memo split))
+ (key-string #f))
+ ;; for each split: if there's a category, do nothing.
+ ;; if there's a payee, use that as the
+ ;; key otherwise, use the split memo.
+ (cond ((and cat
+ (or (not (string? cat))
+ (not (string=? cat ""))))
+ (set! key-string #f))
+ ((and payee (= (length splits) 1))
+ (set! key-string payee))
+ (memo
+ (set! key-string memo)))
- (if key-string
- (let ((entry (hash-ref memo-hash key-string)))
- (if (not entry)
- (begin
- (set! entry (make-qif-map-entry))
- (qif-map-entry:set-qif-name! entry key-string)
- (qif-map-entry:set-gnc-name!
- entry (default-unspec-acct))
- (qif-map-entry:set-allowed-types!
- entry
- (if (gnc-numeric-positive-p
- (qif-split:amount split))
- (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE
- GNC-BANK-TYPE GNC-CCARD-TYPE
- GNC-LIABILITY-TYPE GNC-ASSET-TYPE
- GNC-STOCK-TYPE GNC-MUTUAL-TYPE)
- (list GNC-EXPENSE-TYPE GNC-INCOME-TYPE
- GNC-BANK-TYPE GNC-CCARD-TYPE
- GNC-LIABILITY-TYPE GNC-ASSET-TYPE
- GNC-STOCK-TYPE GNC-MUTUAL-TYPE)))))
- (qif-map-entry:set-display?! entry #t)
- (hash-set! memo-hash key-string entry)))))
- splits)))
+ (if key-string
+ (let ((entry (hash-ref memo-hash key-string)))
+ (if (not entry)
+ (begin
+ (set! entry (make-qif-map-entry))
+ (qif-map-entry:set-qif-name! entry key-string)
+ (qif-map-entry:set-gnc-name!
+ entry (default-unspec-acct))
+ (qif-map-entry:set-allowed-types!
+ entry
+ (if (gnc-numeric-positive-p
+ (qif-split:amount split))
+ (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE
+ GNC-BANK-TYPE GNC-CCARD-TYPE
+ GNC-LIABILITY-TYPE GNC-ASSET-TYPE
+ GNC-RECEIVABLE-TYPE GNC-PAYABLE-TYPE
+ GNC-STOCK-TYPE GNC-MUTUAL-TYPE)
+ (list GNC-EXPENSE-TYPE GNC-INCOME-TYPE
+ GNC-BANK-TYPE GNC-CCARD-TYPE
+ GNC-LIABILITY-TYPE GNC-ASSET-TYPE
+ GNC-RECEIVABLE-TYPE GNC-PAYABLE-TYPE
+ GNC-STOCK-TYPE GNC-MUTUAL-TYPE)))))
+ (qif-map-entry:set-display?! entry #t)
+ (hash-set! memo-hash key-string entry)))))
+ splits))))
(qif-file:xtns file)))
qif-files)
@@ -569,11 +637,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:get-account-name fullname)
- (let ((lastsep (string-rindex fullname
- (string-ref (gnc-get-account-separator-string)
- 0))))
- (if lastsep
- (substring fullname (+ lastsep 1))
+ (let* ((sep (gnc-get-account-separator-string))
+ (last-sep (gnc:string-rcontains fullname sep)))
+ (if last-sep
+ (substring fullname (+ last-sep (string-length sep)))
fullname)))
@@ -667,7 +734,7 @@
(hash-fold
(lambda (qif-name map-entry p)
(let ((security-name (qif-import:get-account-name qif-name)))
- ;; Is this account going to be imported, is it security-denominated,
+ ;; Is this account going to be imported, is it security-denominated,
;; and is the security not already in the security hash table?
(if (and
security-name
@@ -771,7 +838,8 @@
(let ((accts '())
(acct-tree '())
- (separator (string-ref (gnc-get-account-separator-string) 0)))
+ (sep (gnc-get-account-separator-string)))
+
;; get the new accounts from the account map
(for-each
(lambda (acctmap)
@@ -781,8 +849,8 @@
(if (qif-map-entry:display? v)
(set! accts
(cons
- (cons (string-split (qif-map-entry:gnc-name v)
- separator)
+ (cons (gnc:substring-split (qif-map-entry:gnc-name v)
+ sep)
(qif-map-entry:new-acct? v))
accts)))
#f)
@@ -794,9 +862,7 @@
(lambda (acct)
(set! accts
(cons
- (cons (string-split
- (gnc-account-get-full-name acct)
- separator)
+ (cons (gnc:substring-split (gnc-account-get-full-name acct) sep)
#f)
accts)))
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/qif-file.scm
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/qif-file.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/qif-file.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -48,6 +48,7 @@
(first-xtn #f)
(ignore-accounts #f)
(return-val #t)
+ (line-num 0)
(line #f)
(tag #f)
(value #f)
@@ -79,6 +80,7 @@
;; loop over lines
(let line-loop ()
(set! line (read-delimited delimiters))
+ (set! line-num (+ 1 line-num))
(if (and (not (eof-object? line))
(not (string=? line "")))
(begin
@@ -105,7 +107,8 @@
" "
(_ "Some characters have been discarded."))))
(gnc:warn "qif-file:read-file:"
- " stripping invalid characters."
+ " stripping invalid characters"
+ " at line " line-num
"\nAfter: [" value "]"))
(begin
(set! return-val
@@ -114,7 +117,8 @@
" "
(_ "Some characters have been converted according to your locale."))))
(gnc:warn "qif-file:read-file:"
- " converting characters by locale."
+ " converting characters by locale"
+ " at line " line-num
"\nBefore: [" value "]"
"\nAfter: [" converted-value "]")
(set! value converted-value)))))
@@ -175,8 +179,8 @@
(symbol->string qstate-type))
(begin
(gnc:warn "qif-file:read-file:"
- " ignoring '" qstate-type
- "' option.")
+ " ignoring '" qstate-type "' option"
+ " at line " line-num)
(set! qstate-type old-qstate))))))
@@ -349,7 +353,8 @@
(else
(gnc:warn "qif-file:read-file:"
- " ignoring class '" tag "' line."
+ " ignoring class '" tag "'"
+ " at line " line-num
"\nLine content: [" line "]"))))
@@ -452,7 +457,8 @@
(else
(gnc:warn "qif-file:read-file:"
- " ignoring security '" tag "' line."
+ " ignoring security '" tag "'"
+ " at line " line-num
"\nLine content: [" line "]"))))
@@ -462,18 +468,18 @@
(not (string=? (string-trim line) "")))
(begin
(gnc:warn "qif-file:read-file:"
- " file does not appear to be a QIF."
+ " file does not appear to be a QIF"
+ " at line " line-num
"\nLine content: [" line "]")
(set! return-val
(list #f "File does not appear to be a QIF file."))
(set! heinous-error #t))))))
;; Update the progress bar for each line read.
- (if (not (null? progress-dialog))
- (begin
- (gnc-progress-dialog-set-value
- progress-dialog (/ bytes-read file-size))
- (gnc-progress-dialog-update progress-dialog)))
+ (if (and (not (null? progress-dialog))
+ (zero? (remainder line-num 32)))
+ (gnc-progress-dialog-set-value progress-dialog
+ (/ bytes-read file-size)))
;; This is if we read a normal (non-null, non-eof) line...
(if (not heinous-error)
@@ -496,7 +502,9 @@
;; Get rid of the progress dialog (if any).
(if (not (null? progress-dialog))
- (gnc-progress-dialog-destroy progress-dialog))
+ (begin
+ (gnc-progress-dialog-set-value progress-dialog 1)
+ (gnc-progress-dialog-destroy progress-dialog)))
retval))
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/qif-guess-map.scm
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/qif-guess-map.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/qif-guess-map.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -17,6 +17,8 @@
(define GNC-INCOME-TYPE 8)
(define GNC-EXPENSE-TYPE 9)
(define GNC-EQUITY-TYPE 10)
+(define GNC-RECEIVABLE-TYPE 11)
+(define GNC-PAYABLE-TYPE 12)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -95,6 +97,11 @@
(set! qif-security-list (safe-read))
(set! saved-sep (safe-read))
+ ;; Convert the separator to a string if necessary.
+ ;; It was a character prior to 2.2.6.
+ (if (char? saved-sep)
+ (set! saved-sep (string saved-sep)))
+
;; Process the QIF account mapping.
(if (not (list? qif-account-list))
(set! qif-account-hash (make-hash-table 20))
@@ -160,8 +167,8 @@
(define (qif-import:read-map tablist tab-sep)
(let* ((table (make-hash-table 20))
- (sep (string-ref (gnc-get-account-separator-string) 0))
- (changed-sep? (and (char? tab-sep) (not (char=? tab-sep sep)))))
+ (sep (gnc-get-account-separator-string))
+ (changed-sep? (and (string? tab-sep) (not (string=? tab-sep sep)))))
(for-each
(lambda (entry)
@@ -173,8 +180,9 @@
(let ((acct-name (qif-map-entry:gnc-name value)))
(if (string? acct-name)
(qif-map-entry:set-gnc-name! value
- (string-map (lambda (c) (if (char=? c tab-sep) sep c))
- acct-name)))))
+ (gnc:substring-replace acct-name
+ tab-sep
+ sep)))))
(qif-map-entry:set-display?! value #f)
(hash-set! table key value)))
@@ -293,7 +301,7 @@
(display ";;; GnuCash separator used in these mappings")
(newline)
- (write (string-ref (gnc-get-account-separator-string) 0))
+ (write (gnc-get-account-separator-string))
(newline)))))
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/qif-objects.scm
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/qif-objects.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/qif-objects.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -552,10 +552,12 @@
(cond
((memv t (list GNC-BANK-TYPE GNC-CASH-TYPE GNC-CCARD-TYPE
GNC-STOCK-TYPE GNC-MUTUAL-TYPE
- GNC-ASSET-TYPE GNC-LIABILITY-TYPE))
+ GNC-ASSET-TYPE GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE GNC-PAYABLE-TYPE))
(add-types GNC-BANK-TYPE GNC-CASH-TYPE GNC-CCARD-TYPE
GNC-STOCK-TYPE GNC-MUTUAL-TYPE
- GNC-ASSET-TYPE GNC-LIABILITY-TYPE))
+ GNC-ASSET-TYPE GNC-LIABILITY-TYPE
+ GNC-RECEIVABLE-TYPE GNC-PAYABLE-TYPE))
((memv t (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE))
(add-types GNC-INCOME-TYPE GNC-EXPENSE-TYPE))
(#t
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/qif-parse.scm
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/qif-parse.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/qif-parse.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -312,7 +312,7 @@
(match:substring match 2)
(match:substring match 3)))
(numeric-date-parts '())
- (retval #f))
+ (retval '()))
;;(define (print-list l)
;; (for-each (lambda (x) (display x) (display " ")) l))
@@ -388,7 +388,7 @@
;; of possibilities.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:check-date-format date-string possible-formats)
- (let ((retval #f))
+ (let ((retval '()))
(if (or (not (string? date-string))
(not (> (string-length date-string) 0)))
(set! retval possible-formats))
@@ -553,7 +553,7 @@
(define (qif-parse:parse-number/format value-string format)
(case format
((decimal)
- (let* ((filtered-string (string-remove-chars value-string ",$'"))
+ (let* ((filtered-string (gnc:string-delete-chars value-string ",$'"))
(read-val (with-input-from-string filtered-string
(lambda () (read)))))
(if (number? read-val)
@@ -564,8 +564,8 @@
GNC-RND-ROUND))
(gnc-numeric-zero))))
((comma)
- (let* ((filtered-string (string-replace-char
- (string-remove-chars value-string ".$'")
+ (let* ((filtered-string (gnc:string-replace-char
+ (gnc:string-delete-chars value-string ".$'")
#\, #\.))
(read-val (with-input-from-string filtered-string
(lambda () (read)))))
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/qif-to-gnc.scm
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/qif-to-gnc.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/qif-to-gnc.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -1,9 +1,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; qif-to-gnc.scm
-;;; this is where QIF transactions are transformed into a
+;;; this is where QIF transactions are transformed into a
;;; Gnucash account tree.
;;;
-;;; Copyright 2000-2001 Bill Gribble <grib at billgribble.com>
+;;; Copyright 2000-2001 Bill Gribble <grib at billgribble.com>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (srfi srfi-13))
@@ -19,69 +19,69 @@
(define (qif-import:find-or-make-acct acct-info check-types? commodity
check-commodity? default-currency
gnc-acct-hash old-root new-root)
- (let* ((separator (string-ref (gnc-get-account-separator-string) 0))
+ (let* ((sep (gnc-get-account-separator-string))
(gnc-name (qif-map-entry:gnc-name acct-info))
(existing-account (hash-ref gnc-acct-hash gnc-name))
- (same-gnc-account
+ (same-gnc-account
(gnc-account-lookup-by-full-name old-root gnc-name))
- (allowed-types
+ (allowed-types
(qif-map-entry:allowed-types acct-info))
(make-new-acct #f)
(incompatible-acct #f))
-
+
(define (compatible? account)
(let ((acc-type (xaccAccountGetType account))
(acc-commodity (xaccAccountGetCommodity account)))
(and
- (if check-types?
+ (if check-types?
(and (list? allowed-types)
(memv acc-type allowed-types))
#t)
(if check-commodity?
(gnc-commodity-equiv acc-commodity commodity)
#t))))
-
+
(define (make-unique-name-variant long-name short-name)
(if (not (null? (gnc-account-lookup-by-full-name old-root long-name)))
(let loop ((count 2))
- (let* ((test-name
+ (let* ((test-name
(string-append long-name (sprintf #f " %a" count)))
- (test-acct
+ (test-acct
(gnc-account-lookup-by-full-name old-root test-name)))
(if (and (not (null? test-acct)) (not (compatible? test-acct)))
(loop (+ 1 count))
(string-append short-name (sprintf #f " %a" count)))))
short-name))
-
+
;; If a GnuCash account already exists in the old root with the same
;; name, that doesn't necessarily mean we can use it. The type and
;; commodity must be compatible.
- (if (and same-gnc-account (not (null? same-gnc-account)))
+ (if (and same-gnc-account (not (null? same-gnc-account)))
(if (compatible? same-gnc-account)
- (begin
+ (begin
;; The existing GnuCash account is compatible, so we
- ;; can use it. Make sure we use the same type.
+ ;; can use it. Make sure we use the same type.
(set! make-new-acct #f)
(set! incompatible-acct #f)
- (set! allowed-types
+ (set! allowed-types
(list (xaccAccountGetType same-gnc-account))))
- (begin
+ (begin
;; There's an existing, incompatible account with that name,
;; so we have to make a new account with different properties
;; and a slightly different name.
(set! make-new-acct #t)
(set! incompatible-acct #t)))
- (begin
+ (begin
;; Otherwise, there's no existing account with the same name.
(set! make-new-acct #t)
(set! incompatible-acct #f)))
-
+
;; here, existing-account means a previously *created* account
;; (possibly a new account, possibly a copy of an existing gnucash
;; acct)
- (if (and (and existing-account (not (null? existing-account)))
+ (if (and (and existing-account (not (null? existing-account)))
(compatible? existing-account))
- existing-account
+ existing-account
(let ((new-acct (xaccMallocAccount (gnc-get-current-book)))
(parent-acct #f)
(parent-name #f)
@@ -114,15 +114,15 @@
(default-account-type (cdr allowed-types)
currency?)))))
- (set! last-sep (string-rindex gnc-name separator))
-
+ (set! last-sep (gnc:string-rcontains gnc-name sep))
+
(xaccAccountBeginEdit new-acct)
-
+
;; if this is a copy of an existing gnc account, copy the
;; account properties. For incompatible existing accts,
;; we'll do something different later.
(if (and same-gnc-account (not (null? same-gnc-account)))
- (begin
+ (begin
(xaccAccountSetName
new-acct (xaccAccountGetName same-gnc-account))
(xaccAccountSetDescription
@@ -135,38 +135,38 @@
new-acct (xaccAccountGetNotes same-gnc-account))
(xaccAccountSetCode
new-acct (xaccAccountGetCode same-gnc-account))))
-
+
;; If this is a nested account foo:bar:baz, make sure
;; that foo:bar and foo exist also.
(if last-sep
- (begin
+ (begin
(set! parent-name (substring gnc-name 0 last-sep))
- (set! acct-name (substring gnc-name (+ 1 last-sep)
- (string-length gnc-name))))
+ (set! acct-name (substring gnc-name (+ (string-length sep)
+ last-sep))))
(set! acct-name gnc-name))
-
+
;; If this is a completely new account (as opposed to a copy
;; of an existing account), use the parameters passed in.
(if make-new-acct
- (begin
+ (begin
;; Set the name, description, and commodity.
(xaccAccountSetName new-acct acct-name)
(if (qif-map-entry:description acct-info)
(xaccAccountSetDescription
new-acct (qif-map-entry:description acct-info)))
(xaccAccountSetCommodity new-acct commodity)
-
+
;; If there was an existing, incompatible account with
;; the same name, set the new account name to be unique,
;; and set a description that hints at what's happened.
(if incompatible-acct
- (let ((new-name (make-unique-name-variant
+ (let ((new-name (make-unique-name-variant
gnc-name acct-name)))
(xaccAccountSetName new-acct new-name)
(xaccAccountSetDescription
- new-acct
+ new-acct
(_ "QIF import: Name conflict with another account."))))
-
+
;; Set the account type.
(xaccAccountSetType new-acct
(default-account-type
@@ -179,61 +179,61 @@
(let ((pinfo (make-qif-map-entry)))
(qif-map-entry:set-qif-name! pinfo parent-name)
(qif-map-entry:set-gnc-name! pinfo parent-name)
- (qif-map-entry:set-allowed-types!
+ (qif-map-entry:set-allowed-types!
acct-info (list (xaccAccountGetType new-acct)))
- (qif-map-entry:set-allowed-types!
+ (qif-map-entry:set-allowed-types!
pinfo (qif-map-entry:allowed-parent-types acct-info))
-
- (set! parent-acct (qif-import:find-or-make-acct
+
+ (set! parent-acct (qif-import:find-or-make-acct
pinfo #t default-currency #f default-currency
gnc-acct-hash old-root new-root))))
(if (and parent-acct (not (null? parent-acct)))
(gnc-account-append-child parent-acct new-acct)
(gnc-account-append-child new-root new-acct))
-
+
(hash-set! gnc-acct-hash gnc-name new-acct)
new-acct))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-import:qif-to-gnc
+;; qif-import:qif-to-gnc
;;
;; This is the top-level of the back end conversion from QIF
-;; to GnuCash. All the account mappings and so on should be
-;; done before this is called.
+;; to GnuCash. All the account mappings and so on should be
+;; done before this is called.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (qif-import:qif-to-gnc qif-files-list
- qif-acct-map qif-cat-map
- qif-memo-map stock-map
+(define (qif-import:qif-to-gnc qif-files-list
+ qif-acct-map qif-cat-map
+ qif-memo-map stock-map
default-currency-name window)
(let ((progress-dialog '())
(retval #f))
(set! retval
- (gnc:backtrace-if-exception
+ (gnc:backtrace-if-exception
(lambda ()
(let* ((old-root (gnc-get-current-root-account))
(new-root (xaccMallocAccount (gnc-get-current-book)))
(gnc-acct-hash (make-hash-table 20))
- (separator (string-ref (gnc-get-account-separator-string) 0))
- (default-currency
+ (sep (gnc-get-account-separator-string))
+ (default-currency
(gnc-commodity-table-find-full
(gnc-commodity-table-get-table (gnc-get-current-book))
GNC_COMMODITY_NS_CURRENCY default-currency-name))
(sorted-accounts-list '())
(markable-xtns '())
- (sorted-qif-files-list
- (sort qif-files-list
+ (sorted-qif-files-list
+ (sort qif-files-list
(lambda (a b)
- (> (length (qif-file:xtns a))
+ (> (length (qif-file:xtns a))
(length (qif-file:xtns b))))))
(work-to-do 0)
(work-done 0))
-
+
;; first, build a local account tree that mirrors the gnucash
;; accounts in the mapping data. we need to iterate over the
;; cat-map and the acct-map to build the list
- (hash-fold
+ (hash-fold
(lambda (k v p)
(if (qif-map-entry:display? v)
(set! sorted-accounts-list
@@ -241,7 +241,7 @@
#t)
#t qif-acct-map)
- (hash-fold
+ (hash-fold
(lambda (k v p)
(if (qif-map-entry:display? v)
(set! sorted-accounts-list
@@ -249,79 +249,74 @@
#t)
#t qif-cat-map)
- (hash-fold
+ (hash-fold
(lambda (k v p)
(if (qif-map-entry:display? v)
(set! sorted-accounts-list
(cons v sorted-accounts-list)))
#t)
#t qif-memo-map)
-
+
;; sort the account info on the depth of the account path. if a
;; short part is explicitly mentioned, make sure it gets created
;; before the deeper path, which will create the parent accounts
;; without the information about their type.
- (set! sorted-accounts-list
- (sort sorted-accounts-list
+ (set! sorted-accounts-list
+ (sort sorted-accounts-list
(lambda (a b)
- (let ((a-depth
- (length
- (string-split (qif-map-entry:gnc-name a)
- separator)))
- (b-depth
- (length
- (string-split (qif-map-entry:gnc-name b)
- separator))))
- (< a-depth b-depth)))))
-
- ;; make all the accounts
- (for-each
+ (< (gnc:substring-count (qif-map-entry:gnc-name a)
+ sep)
+ (gnc:substring-count (qif-map-entry:gnc-name b)
+ sep)))))
+
+ ;; make all the accounts
+ (for-each
(lambda (acctinfo)
- (let* ((security
- (and stock-map
- (hash-ref stock-map
- (qif-import:get-account-name
+ (let* ((security
+ (and stock-map
+ (hash-ref stock-map
+ (qif-import:get-account-name
(qif-map-entry:qif-name acctinfo)))))
(ok-types (qif-map-entry:allowed-types acctinfo))
(equity? (memv GNC-EQUITY-TYPE ok-types))
(stock? (or (memv GNC-STOCK-TYPE ok-types)
(memv GNC-MUTUAL-TYPE ok-types))))
-
+
;; Debug
;; (for-each
;; (lambda (expr)
;; (display expr))
- ;; (list "Account: " acctinfo "\nsecurity = " security
- ;; "\nequity? = " equity?
+ ;; (list "Account: " acctinfo "\nsecurity = " security
+ ;; "\nequity? = " equity?
;; "\n"))
(cond ((and equity? security) ;; a "retained holdings" acct
(qif-import:find-or-make-acct acctinfo #f
security #t
default-currency
- gnc-acct-hash
+ gnc-acct-hash
old-root new-root))
((and security (or stock?
(gnc-commodity-is-currency security)))
- (qif-import:find-or-make-acct
+ (qif-import:find-or-make-acct
acctinfo #f security #t default-currency
gnc-acct-hash old-root new-root))
- (#t
- (qif-import:find-or-make-acct
+ (#t
+ (qif-import:find-or-make-acct
acctinfo #f default-currency #t default-currency
gnc-acct-hash old-root new-root)))))
sorted-accounts-list)
-
- ;; before trying to mark transactions, prune down the list of
- ;; ones to match.
- (for-each
+
+ ;; before trying to mark transactions, prune down the list of
+ ;; ones to match.
+ (for-each
(lambda (qif-file)
- (for-each
+ (for-each
(lambda (xtn)
(set! work-to-do (+ 1 work-to-do))
- (let splitloop ((splits (qif-xtn:splits xtn)))
+ (let splitloop ((splits (qif-xtn:splits xtn)))
(if (qif-split:category-is-account? (car splits))
- (begin
+ (begin
(set! markable-xtns (cons xtn markable-xtns))
(set! work-to-do (+ 1 work-to-do)))
(if (not (null? (cdr splits)))
@@ -330,21 +325,21 @@
qif-files-list)
(if (> work-to-do 100)
- (begin
+ (begin
(set! progress-dialog (gnc-progress-dialog-new window #f))
(gnc-progress-dialog-set-title progress-dialog (_ "Progress"))
(gnc-progress-dialog-set-heading progress-dialog
(_ "Importing transactions..."))))
-
+
;; now run through the markable transactions marking any
;; duplicates. marked transactions/splits won't get imported.
(if (> (length markable-xtns) 1)
(let xloop ((xtn (car markable-xtns))
(rest (cdr markable-xtns)))
(set! work-done (+ 1 work-done))
- (if (not (null? progress-dialog))
- (begin
+ (if (not (null? progress-dialog))
+ (begin
(gnc-progress-dialog-set-value
progress-dialog (/ work-done work-to-do))
(gnc-progress-dialog-update progress-dialog)))
@@ -353,20 +348,20 @@
(if (not (null? (cdr rest)))
(xloop (car rest) (cdr rest)))))
- ;; iterate over files. Going in the sort order by number of
+ ;; iterate over files. Going in the sort order by number of
;; transactions should give us a small speed advantage.
- (for-each
+ (for-each
(lambda (qif-file)
- (for-each
+ (for-each
(lambda (xtn)
(set! work-done (+ 1 work-done))
- (if (not (null? progress-dialog))
- (begin
+ (if (not (null? progress-dialog))
+ (begin
(gnc-progress-dialog-set-value
progress-dialog (/ work-done work-to-do))
(gnc-progress-dialog-update progress-dialog)))
(if (not (qif-xtn:mark xtn))
- (begin
+ (begin
;; create and fill in the GNC transaction
(let ((gnc-xtn (xaccMallocTransaction
(gnc-get-current-book))))
@@ -376,8 +371,8 @@
(xaccTransSetCurrency gnc-xtn (gnc-default-currency))
;; build the transaction
- (qif-import:qif-xtn-to-gnc-xtn
- xtn qif-file gnc-xtn gnc-acct-hash
+ (qif-import:qif-xtn-to-gnc-xtn
+ xtn qif-file gnc-xtn gnc-acct-hash
qif-acct-map qif-cat-map qif-memo-map)
;; rebalance and commit everything
@@ -396,12 +391,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:qif-xtn-to-gnc-xtn
-;; translate a single transaction to a set of gnucash splits and
-;; a gnucash transaction structure.
+;; translate a single transaction to a set of gnucash splits and
+;; a gnucash transaction structure.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (qif-import:qif-xtn-to-gnc-xtn qif-xtn qif-file gnc-xtn
- gnc-acct-hash
+(define (qif-import:qif-xtn-to-gnc-xtn qif-xtn qif-file gnc-xtn
+ gnc-acct-hash
qif-acct-map qif-cat-map qif-memo-map)
(let ((splits (qif-xtn:splits qif-xtn))
(gnc-near-split (xaccMallocSplit (gnc-get-current-book)))
@@ -423,7 +418,7 @@
(n+ (lambda (a b) (gnc-numeric-add a b 0 GNC-DENOM-LCD)))
(n* (lambda (a b) (gnc-numeric-mul a b 0 GNC-DENOM-REDUCE)))
(n/ (lambda (a b) (gnc-numeric-div a b 0 GNC-DENOM-REDUCE))))
-
+
;; Set properties of the whole transaction.
;; Set the transaction date.
@@ -442,8 +437,8 @@
#f))
(else
(apply xaccTransSetDate gnc-xtn (qif-xtn:date qif-xtn))))
-
- ;; fixme: bug #105
+
+ ;; fixme: bug #105
(if qif-payee
(xaccTransSetDescription gnc-xtn qif-payee))
(if qif-number
@@ -462,14 +457,14 @@
;; Use the memo for the transaction notes. Previously this went to
;; the debit/credit lines. See bug 495219 for more information.
(xaccTransSetNotes gnc-xtn qif-memo)))
-
- (if (eq? qif-cleared 'cleared)
+
+ (if (eq? qif-cleared 'cleared)
(xaccSplitSetReconcile gnc-near-split #\c))
(if (eq? qif-cleared 'reconciled)
(xaccSplitSetReconcile gnc-near-split #\y))
-
+
(if (not qif-security)
- (begin
+ (begin
;; NON-STOCK TRANSACTIONS: the near account is the current
;; bank-account or the default associated with the file.
;; the far account is the one associated with the split
@@ -477,10 +472,10 @@
(set! near-acct-info (hash-ref qif-acct-map qif-from-acct))
(set! near-acct-name (qif-map-entry:gnc-name near-acct-info))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name))
-
+
;; iterate over QIF splits. Each split defines one "far
;; end" for the transaction.
- (for-each
+ (for-each
(lambda (qif-split)
(if (not (qif-split:mark qif-split))
(let ((gnc-far-split (xaccMallocSplit
@@ -495,7 +490,7 @@
(if qif-default-split
(qif-split:memo qif-split) #f))
(cat (qif-split:category qif-split)))
-
+
(if (not split-amt) (set! split-amt (gnc-numeric-zero)))
;; fill the splits in (near first). This handles
;; files in multiple currencies by pulling the
@@ -505,14 +500,14 @@
(xaccSplitSetAmount gnc-far-split (n- split-amt))
(if memo (xaccSplitSetMemo gnc-far-split memo))
-
+
;; figure out what the far acct is
- (cond
+ (cond
;; If the category is an account, use the account mapping.
((and (not (string=? cat ""))
(qif-split:category-is-account? qif-split))
(set! far-acct-info (hash-ref qif-acct-map cat)))
-
+
;; Otherwise, if it isn't empty, use the category mapping.
((not (string=? cat ""))
(set! far-acct-info (hash-ref qif-cat-map cat)))
@@ -524,7 +519,7 @@
;; the default category mapping (the Unspecified account,
;; unless the user has changed it).
(#t
- (set! far-acct-info
+ (set! far-acct-info
(if (= (length splits) 1)
(or (and (string? qif-payee)
(not (string=? qif-payee ""))
@@ -540,25 +535,25 @@
(set! far-acct-name (qif-map-entry:gnc-name far-acct-info))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name))
-
- ;; set the reconcile status.
+
+ ;; set the reconcile status.
(let ((cleared (qif-split:matching-cleared qif-split)))
(if (eq? 'cleared cleared)
(xaccSplitSetReconcile gnc-far-split #\c))
(if (eq? 'reconciled cleared)
(xaccSplitSetReconcile gnc-far-split #\y)))
-
- ;; finally, plug the split into the account
+
+ ;; finally, plug the split into the account
(xaccSplitSetAccount gnc-far-split far-acct)
(xaccSplitSetParent gnc-far-split gnc-xtn))))
splits)
-
+
;; the value of the near split is the total of the far splits.
(xaccSplitSetValue gnc-near-split near-split-total)
(xaccSplitSetAmount gnc-near-split near-split-total)
(xaccSplitSetParent gnc-near-split gnc-xtn)
(xaccSplitSetAccount gnc-near-split near-acct))
-
+
;; STOCK TRANSACTIONS: the near/far accounts depend on the
;; "action" encoded in the Number field. It's generally the
;; security account (for buys, sells, and reinvests) but can
@@ -579,7 +574,7 @@
(commission-split #f)
(defer-share-price #f)
(gnc-far-split (xaccMallocSplit (gnc-get-current-book))))
-
+
(if (not num-shares) (set! num-shares (gnc-numeric-zero)))
;; Determine the extended price of all shares without commission.
@@ -607,31 +602,31 @@
;; share price ourselves. For more information, see
;; bug 373584.
(set! share-price (n/ split-amt num-shares))))
-
- ;; I don't think this should ever happen, but I want
- ;; to keep this check just in case.
+
+ ;; I don't think this should ever happen, but I want
+ ;; to keep this check just in case.
(if (> (length splits) 1)
(gnc:warn "qif-import:qif-xtn-to-gnc-xtn: "
"splits in stock transaction!"))
- (set! qif-accts
+ (set! qif-accts
(qif-split:accounts-affected (car (qif-xtn:splits qif-xtn))
qif-xtn))
-
+
(set! qif-near-acct (car qif-accts))
(set! qif-far-acct (cadr qif-accts))
(set! qif-commission-acct (caddr qif-accts))
;; Translate the QIF account names into GnuCash accounts.
(if (and qif-near-acct qif-far-acct)
- (begin
+ (begin
;; Determine the near account.
- (set! near-acct-info
+ (set! near-acct-info
(or (hash-ref qif-acct-map qif-near-acct)
(hash-ref qif-cat-map qif-near-acct)))
(set! near-acct-name (qif-map-entry:gnc-name near-acct-info))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name))
-
+
;; Determine the far account.
(if (or (not (string? qif-far-acct))
(string=? qif-far-acct ""))
@@ -648,9 +643,9 @@
(hash-ref qif-cat-map qif-far-acct))))
(set! far-acct-name (qif-map-entry:gnc-name far-acct-info))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name))))
-
- ;; the amounts and signs: are shares going in or out?
- ;; are amounts currency or shares?
+
+ ;; the amounts and signs: are shares going in or out?
+ ;; are amounts currency or shares?
(case qif-action
((buy buyx reinvint reinvdiv reinvsg reinvsh reinvmd reinvlg)
(if (not share-price) (set! share-price (gnc-numeric-zero)))
@@ -658,27 +653,27 @@
(xaccSplitSetValue gnc-near-split split-amt)
(xaccSplitSetValue gnc-far-split (n- xtn-amt))
(xaccSplitSetAmount gnc-far-split (n- xtn-amt)))
-
- ((sell sellx)
+
+ ((sell sellx)
(if (not share-price) (set! share-price (gnc-numeric-zero)))
(xaccSplitSetAmount gnc-near-split (n- num-shares))
(xaccSplitSetValue gnc-near-split (n- split-amt))
(xaccSplitSetValue gnc-far-split xtn-amt)
(xaccSplitSetAmount gnc-far-split xtn-amt))
-
- ((cgshort cgshortx cgmid cgmidx cglong cglongx intinc intincx
+
+ ((cgshort cgshortx cgmid cgmidx cglong cglongx intinc intincx
div divx miscinc miscincx xin rtrncap rtrncapx)
(xaccSplitSetValue gnc-near-split xtn-amt)
(xaccSplitSetAmount gnc-near-split xtn-amt)
(xaccSplitSetValue gnc-far-split (n- xtn-amt))
(xaccSplitSetAmount gnc-far-split (n- xtn-amt)))
-
+
((xout miscexp miscexpx margint margintx)
(xaccSplitSetValue gnc-near-split (n- xtn-amt))
(xaccSplitSetAmount gnc-near-split (n- xtn-amt))
(xaccSplitSetValue gnc-far-split xtn-amt)
(xaccSplitSetAmount gnc-far-split xtn-amt))
-
+
((shrsin)
;; getting rid of the old equity-acct-per-stock trick.
;; you must now have a cash/basis value for the stock.
@@ -686,37 +681,37 @@
(xaccSplitSetValue gnc-near-split split-amt)
(xaccSplitSetValue gnc-far-split (n- xtn-amt))
(xaccSplitSetAmount gnc-far-split (n- xtn-amt)))
-
+
((shrsout)
- ;; shrsout is like shrsin
+ ;; shrsout is like shrsin
(xaccSplitSetAmount gnc-near-split (n- num-shares))
(xaccSplitSetValue gnc-near-split (n- split-amt))
(xaccSplitSetValue gnc-far-split xtn-amt)
(xaccSplitSetAmount gnc-far-split xtn-amt))
-
+
;; stock splits: QIF just specifies the split ratio, not
;; the number of shares in and out, so we have to fetch
- ;; the number of shares from the security account
-
+ ;; the number of shares from the security account
+
;; FIXME : this could be wrong. Make sure the
;; share-amount is at the correct time.
((stksplit)
(let* ((splitratio (n/ num-shares (gnc-numeric-create 10 1)))
- (in-shares
+ (in-shares
(xaccAccountGetBalance near-acct))
(out-shares (n* in-shares splitratio)))
(xaccSplitSetAmount gnc-near-split out-shares)
(xaccSplitSetAmount gnc-far-split (n- in-shares))
(xaccSplitSetValue gnc-near-split (n- split-amt))
(xaccSplitSetValue gnc-far-split split-amt))))
-
- (let ((cleared (qif-split:matching-cleared
+
+ (let ((cleared (qif-split:matching-cleared
(car (qif-xtn:splits qif-xtn)))))
(if (eq? 'cleared cleared)
(xaccSplitSetReconcile gnc-far-split #\c))
(if (eq? 'reconciled cleared)
(xaccSplitSetReconcile gnc-far-split #\y)))
-
+
(if qif-commission-acct
(let* ((commission-acct-info
(or (hash-ref qif-acct-map qif-commission-acct)
@@ -727,24 +722,24 @@
(if commission-acct-name
(set! commission-acct
(hash-ref gnc-acct-hash commission-acct-name)))))
-
+
(if (and commission-amt commission-acct)
- (begin
+ (begin
(set! commission-split (xaccMallocSplit
(gnc-get-current-book)))
(xaccSplitSetValue commission-split commission-amt)
(xaccSplitSetAmount commission-split commission-amt)))
(if (and qif-near-acct qif-far-acct)
- (begin
+ (begin
(xaccSplitSetParent gnc-near-split gnc-xtn)
(xaccSplitSetAccount gnc-near-split near-acct)
-
+
(xaccSplitSetParent gnc-far-split gnc-xtn)
(xaccSplitSetAccount gnc-far-split far-acct)
-
+
(if commission-split
- (begin
+ (begin
(xaccSplitSetParent commission-split gnc-xtn)
(xaccSplitSetAccount commission-split
commission-acct)))))))
@@ -759,26 +754,26 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-import:mark-matching-xtns
-;; find transactions that are the "opposite half" of xtn and
-;; mark them so they won't be imported.
+;; qif-import:mark-matching-xtns
+;; find transactions that are the "opposite half" of xtn and
+;; mark them so they won't be imported.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:mark-matching-xtns xtn candidate-xtns)
(let splitloop ((splits-left (qif-xtn:splits xtn)))
-
+
;; splits-left starts out as all the splits of this transaction.
- ;; if multiple splits match up with a single split on the other
+ ;; if multiple splits match up with a single split on the other
;; end, we may remove more than one split from splits-left with
- ;; each call to mark-some-splits.
+ ;; each call to mark-some-splits.
(if (not (null? splits-left))
(if (and (not (qif-split:mark (car splits-left)))
(qif-split:category-is-account? (car splits-left)))
- (set! splits-left
- (qif-import:mark-some-splits
+ (set! splits-left
+ (qif-import:mark-some-splits
splits-left xtn candidate-xtns))
(set! splits-left (cdr splits-left))))
-
+
(if (not (null? splits-left))
(splitloop splits-left))))
@@ -801,7 +796,7 @@
(date (qif-xtn:date xtn))
(amount (n- (qif-split:amount split)))
(group-amount #f)
- (memo (qif-split:memo split))
+ (memo (qif-split:memo split))
(security-name (qif-xtn:security-name xtn))
(action (qif-xtn:action xtn))
(bank-xtn? (not security-name))
@@ -810,35 +805,35 @@
(same-acct-splits '())
(how #f)
(done #f))
-
+
(if bank-xtn?
- (begin
+ (begin
(set! near-acct-name (qif-xtn:from-acct xtn))
(set! far-acct-name (qif-split:category split))
(set! group-amount (gnc-numeric-zero))
-
+
;; group-amount is the sum of all the splits in this xtn
;; going to the same account as 'split'. We might be able
;; to match this whole group to a single matching opposite
;; split.
- (for-each
+ (for-each
(lambda (s)
(if (and (qif-split:category-is-account? s)
(string=? far-acct-name (qif-split:category s)))
(begin
- (set! same-acct-splits
+ (set! same-acct-splits
(cons s same-acct-splits))
(set! group-amount (nsub group-amount (qif-split:amount s))))
- (set! different-acct-splits
+ (set! different-acct-splits
(cons s different-acct-splits))))
splits)
-
+
(set! same-acct-splits (reverse same-acct-splits))
(set! different-acct-splits (reverse different-acct-splits)))
-
+
;; stock transactions. they can't have splits as far as I can
;; tell, so the 'different-acct-splits' is always '()
- (let ((qif-accts
+ (let ((qif-accts
(qif-split:accounts-affected split xtn)))
(set! near-acct-name (car qif-accts))
(set! far-acct-name (cadr qif-accts))
@@ -848,7 +843,7 @@
;; transactions to match up. Quicken thinks the near
;; and far accounts are different than we do.
(case action
- ((intincx divx cglongx cgmidx cgshortx rtrncapx margintx
+ ((intincx divx cglongx cgmidx cgshortx rtrncapx margintx
sellx)
(set! amount (n- amount))
(set! near-acct-name (qif-xtn:from-acct xtn))
@@ -862,26 +857,26 @@
(set! far-acct-name (qif-split:category split)))
((xout)
(set! amount (n- amount)))))))
-
+
;; this is the grind loop. Go over every unmarked transaction in
;; the candidate-xtns list.
(let xtn-loop ((xtns candidate-xtns))
(if (and (not (qif-xtn:mark (car xtns)))
(string=? (qif-xtn:from-acct (car xtns)) far-acct-name))
- (begin
+ (begin
(set! how
(qif-import:xtn-has-matches? (car xtns) near-acct-name
date amount group-amount))
(if how
(begin
- (qif-import:merge-and-mark-xtns xtn same-acct-splits
+ (qif-import:merge-and-mark-xtns xtn same-acct-splits
(car xtns) how)
(set! done #t)))))
;; iterate with the next transaction
(if (and (not done)
(not (null? (cdr xtns))))
(xtn-loop (cdr xtns))))
-
+
;; return the rest of the splits to iterate on
(if (not how)
(cdr splits)
@@ -904,7 +899,7 @@
(same-acct-splits '())
(this-group-amt (gnc-numeric-zero))
(how #f)
- (date-matches
+ (date-matches
(let ((self-date (qif-xtn:date xtn)))
(and (pair? self-date)
(pair? date)
@@ -918,17 +913,17 @@
(n+ (lambda (a b) (gnc-numeric-add a b 0 GNC-DENOM-LCD)))
(n* (lambda (a b) (gnc-numeric-mul a b 0 GNC-DENOM-REDUCE)))
(n/ (lambda (a b) (gnc-numeric-div a b 0 GNC-DENOM-REDUCE))))
-
- (if date-matches
- (begin
- ;; calculate a group total for splits going to acct-name
+
+ (if date-matches
+ (begin
+ ;; calculate a group total for splits going to acct-name
(let split-loop ((splits-left (qif-xtn:splits xtn)))
(let ((split (car splits-left)))
;; does the account match up?
(if (and (qif-split:category-is-account? split)
(string? acct-name)
(string=? (qif-split:category split) acct-name))
- ;; if so, get the amount
+ ;; if so, get the amount
(let ((this-amt (qif-split:amount split))
(stock-xtn (qif-xtn:security-name xtn))
(action (qif-xtn:action xtn)))
@@ -936,92 +931,92 @@
;; stock transactions (buy/sell both positive in
;; QIF)
(if (and stock-xtn action)
- (case action
- ((xout sellx intincx divx cglongx cgshortx
+ (case action
+ ((xout sellx intincx divx cglongx cgshortx
miscincx miscexpx)
(set! this-amt (n- this-amt)))))
-
- ;; we might be done if this-amt is either equal
+
+ ;; we might be done if this-amt is either equal
;; to the split amount or the group amount.
- (cond
+ (cond
((gnc-numeric-equal this-amt amount)
- (set! how
+ (set! how
(cons 'one-to-one (list split))))
((and group-amt (gnc-numeric-equal this-amt group-amt))
(set! how
(cons 'one-to-many (list split))))
(#t
(set! same-acct-splits (cons split same-acct-splits))
- (set! this-group-amt
+ (set! this-group-amt
(n+ this-group-amt this-amt))))))
-
+
;; if 'how' is non-#f, we are ready to return.
- (if (and (not how)
+ (if (and (not how)
(not (null? (cdr splits-left))))
(split-loop (cdr splits-left)))))
-
- ;; now we're out of the loop. if 'how' isn't set,
+
+ ;; now we're out of the loop. if 'how' isn't set,
;; we can still have a many-to-one match.
(if (and (not how)
(gnc-numeric-equal this-group-amt amount))
- (begin
- (set! how
+ (begin
+ (set! how
(cons 'many-to-one same-acct-splits))))))
-
- ;; we're all done. 'how' either is #f or a
- ;; cons of the way-it-matched and a list of the matching
- ;; splits.
+
+ ;; we're all done. 'how' either is #f or a
+ ;; cons of the way-it-matched and a list of the matching
+ ;; splits.
how))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (qif-split:accounts-affected split xtn)
-;; Get the near and far ends of a split, returned as a list
+;; Get the near and far ends of a split, returned as a list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (qif-split:accounts-affected split xtn)
+(define (qif-split:accounts-affected split xtn)
(let ((near-acct-name #f)
(far-acct-name #f)
(commission-acct-name #f)
(security (qif-xtn:security-name xtn))
(action (qif-xtn:action xtn))
(from-acct (qif-xtn:from-acct xtn)))
-
- ;; for non-security transactions, the near account is the
- ;; acct in which the xtn is, and the far is the account
- ;; linked by the category line.
-
+
+ ;; for non-security transactions, the near account is the
+ ;; acct in which the xtn is, and the far is the account
+ ;; linked by the category line.
+
(if (not security)
- ;; non-security transactions
- (begin
+ ;; non-security transactions
+ (begin
(set! near-acct-name from-acct)
(set! far-acct-name (qif-split:category split)))
-
- ;; security transactions : the near end is either the
- ;; brokerage, the stock, or the category
+
+ ;; security transactions : the near end is either the
+ ;; brokerage, the stock, or the category
(begin
(case action
- ((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh
+ ((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh
reinvlg reinvmd shrsin shrsout stksplit)
(set! near-acct-name (default-stock-acct from-acct security)))
- ((div cgshort cglong cgmid intinc miscinc miscexp
+ ((div cgshort cglong cgmid intinc miscinc miscexp
rtrncap margint xin xout)
(set! near-acct-name from-acct))
((divx cgshortx cglongx cgmidx intincx rtrncapx margintx)
- (set! near-acct-name
+ (set! near-acct-name
(qif-split:category (car (qif-xtn:splits xtn)))))
((miscincx miscexpx)
- (set! near-acct-name
+ (set! near-acct-name
(qif-split:miscx-category (car (qif-xtn:splits xtn))))))
- ;; the far split: where is the money coming from?
+ ;; the far split: where is the money coming from?
;; Either the brokerage account, the category,
- ;; or an external account
+ ;; or an external account
(case action
((buy sell)
(set! far-acct-name from-acct))
((buyx sellx miscinc miscincx miscexp miscexpx xin xout)
- (set! far-acct-name
+ (set! far-acct-name
(qif-split:category (car (qif-xtn:splits xtn)))))
((stksplit)
(set! far-acct-name (default-stock-acct from-acct security)))
@@ -1045,27 +1040,27 @@
(default-capital-return-acct from-acct security)))
((div divx reinvdiv)
(set! far-acct-name
- (default-dividend-acct from-acct security)))
+ (default-dividend-acct from-acct security)))
((shrsin shrsout)
(set! far-acct-name
(default-equity-holding security))))
-
- ;; the commission account, if it exists
+
+ ;; the commission account, if it exists
(if (qif-xtn:commission xtn)
- (set! commission-acct-name
+ (set! commission-acct-name
(default-commission-acct from-acct)))))
-
+
(list near-acct-name far-acct-name commission-acct-name)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-import:merge-and-mark-xtns
-;; we know that the splits match. Pick one to mark and
-;; merge the information into the other one.
+;; qif-import:merge-and-mark-xtns
+;; we know that the splits match. Pick one to mark and
+;; merge the information into the other one.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:merge-and-mark-xtns xtn splits other-xtn how)
- ;; merge transaction fields
+ ;; merge transaction fields
(let ((action (qif-xtn:action xtn))
(o-action (qif-xtn:action other-xtn))
(security (qif-xtn:security-name xtn))
@@ -1073,32 +1068,32 @@
(split (car splits))
(match-type (car how))
(match-splits (cdr how)))
- (case match-type
+ (case match-type
;; many-to-one: the other-xtn has several splits that total
;; in amount to 'split'. We want to preserve the multi-split
- ;; transaction.
+ ;; transaction.
((many-to-one)
(qif-xtn:mark-split xtn split)
(qif-import:merge-xtn-info xtn other-xtn)
- (for-each
+ (for-each
(lambda (s)
(qif-split:set-matching-cleared! s (qif-xtn:cleared xtn)))
match-splits))
-
+
;; one-to-many: 'split' is just one of a set of splits in xtn
;; that total up to the split in match-splits.
((one-to-many)
(qif-xtn:mark-split other-xtn (car match-splits))
(qif-import:merge-xtn-info other-xtn xtn)
- (for-each
+ (for-each
(lambda (s)
- (qif-split:set-matching-cleared!
+ (qif-split:set-matching-cleared!
s (qif-xtn:cleared other-xtn)))
splits))
;; otherwise: one-to-one, a normal single split match.
- (else
- (cond
+ (else
+ (cond
;; If one transaction has more splits than the other, mark the
;; one with less splits, regardless of all other conditions.
;; Otherwise, QIF split transactions will become mangled. For
@@ -1109,7 +1104,7 @@
(qif-import:merge-xtn-info xtn other-xtn)
(qif-split:set-matching-cleared!
(car match-splits) (qif-xtn:cleared xtn)))
-
+
((> (length (qif-xtn:splits xtn))
(length (qif-xtn:splits other-xtn)))
(qif-xtn:mark-split other-xtn (car match-splits))
@@ -1117,40 +1112,40 @@
(qif-split:set-matching-cleared!
split (qif-xtn:cleared other-xtn)))
- ;; this is a transfer involving a security xtn. Let the
- ;; security xtn dominate the way it's handled.
+ ;; this is a transfer involving a security xtn. Let the
+ ;; security xtn dominate the way it's handled.
((and (not action) o-action o-security)
(qif-xtn:mark-split xtn split)
(qif-import:merge-xtn-info xtn other-xtn)
- (qif-split:set-matching-cleared!
+ (qif-split:set-matching-cleared!
(car match-splits) (qif-xtn:cleared xtn)))
-
+
((and action (not o-action) security)
(qif-xtn:mark-split other-xtn (car match-splits))
(qif-import:merge-xtn-info other-xtn xtn)
- (qif-split:set-matching-cleared!
+ (qif-split:set-matching-cleared!
split (qif-xtn:cleared other-xtn)))
-
+
;; this is a security transaction from one brokerage to another
;; or within a brokerage. The "foox" xtn has the most
;; information about what went on, so use it.
((and action o-action o-security)
(case o-action
- ((buyx sellx cgshortx cgmidx cglongx intincx divx
+ ((buyx sellx cgshortx cgmidx cglongx intincx divx
margintx rtrncapx miscincx miscexpx)
(qif-xtn:mark-split xtn split)
(qif-import:merge-xtn-info xtn other-xtn)
(qif-split:set-matching-cleared!
(car match-splits) (qif-xtn:cleared xtn)))
-
- (else
+
+ (else
(qif-xtn:mark-split other-xtn (car match-splits))
(qif-import:merge-xtn-info other-xtn xtn)
- (qif-split:set-matching-cleared!
+ (qif-split:set-matching-cleared!
split (qif-xtn:cleared other-xtn)))))
-
+
;; Otherwise, this is a normal no-frills split match.
- (#t
+ (#t
(qif-xtn:mark-split other-xtn (car match-splits))
(qif-import:merge-xtn-info other-xtn xtn)
(qif-split:set-matching-cleared!
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/qif-utils.scm
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/qif-utils.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/qif-utils.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -5,7 +5,7 @@
;;; Bill Gribble <grib at billgribble.com> 20 Feb 2000
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(use-modules (srfi srfi-13))
+(use-modules (ice-9 regex))
(define (simple-filter pred list)
@@ -49,33 +49,11 @@
(regexp-substitute/global #f rexpstr str 'pre 'post)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; string-remove-chars
-;;
-;; Removes all characters in string "chars" from string "str".
-;; Example: (string-remove-chars "abcd" "cb") returns "ad".
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (string-remove-chars str chars)
- (string-delete str (lambda (c) (string-index chars c))))
-
-
(define (string-char-count str char)
(length (simple-filter (lambda (elt) (eq? elt char))
(string->list str))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; string-replace-char
-;;
-;; Replaces all occurrences of char "old" with char "new".
-;; Example: (string-replace-char "foo" #\o #\c) returns "fcc".
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (string-replace-char str old new)
- (string-map (lambda (c) (if (char=? c old) new c)) str))
-
-
(define (string-replace-char! str old new)
(let ((rexpstr
(if (not (eq? old #\.))
@@ -89,4 +67,3 @@
(string-downcase
(string-remove-leading-space
(string-remove-trailing-space str)))))
-
Modified: gnucash/branches/gda-dev2/src/import-export/qif-import/qif.glade
===================================================================
--- gnucash/branches/gda-dev2/src/import-export/qif-import/qif.glade 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/import-export/qif-import/qif.glade 2008-06-11 23:25:10 UTC (rev 17216)
@@ -504,7 +504,7 @@
<property name="title" translatable="yes">QIF files you have loaded</property>
<property name="title_foreground">#f5f5f5f5f5f5</property>
<signal name="prepare" handler="gnc_ui_qif_import_loaded_files_prepare_cb" after="yes"/>
- <signal name="next" handler="gnc_ui_qif_import_generic_next_cb"/>
+ <signal name="next" handler="gnc_ui_qif_import_loaded_files_next_cb"/>
<signal name="back" handler="gnc_ui_qif_import_generic_back_cb"/>
<child internal-child="vbox">
@@ -664,8 +664,7 @@
<property name="visible">True</property>
<property name="title" translatable="yes">Match QIF accounts with GnuCash accounts</property>
<property name="title_foreground">#f5f5f5f5f5f5</property>
- <signal name="prepare" handler="gnc_ui_qif_import_account_prepare_cb"/>
- <signal name="next" handler="gnc_ui_qif_import_generic_next_cb"/>
+ <signal name="next" handler="gnc_ui_qif_import_account_next_cb"/>
<signal name="back" handler="gnc_ui_qif_import_generic_back_cb"/>
<child internal-child="vbox">
@@ -673,7 +672,7 @@
<property name="border_width">25</property>
<property name="visible">True</property>
<property name="homogeneous">False</property>
- <property name="spacing">5</property>
+ <property name="spacing">0</property>
<child>
<widget class="GtkLabel" id="label7609">
@@ -869,7 +868,6 @@
<property name="visible">True</property>
<property name="title" translatable="yes">Match QIF categories with GnuCash accounts</property>
<property name="title_foreground">#f5f5f5f5f5f5</property>
- <signal name="prepare" handler="gnc_ui_qif_import_category_prepare_cb"/>
<signal name="next" handler="gnc_ui_qif_import_category_next_cb"/>
<signal name="back" handler="gnc_ui_qif_import_generic_back_cb"/>
@@ -878,7 +876,7 @@
<property name="border_width">25</property>
<property name="visible">True</property>
<property name="homogeneous">False</property>
- <property name="spacing">5</property>
+ <property name="spacing">0</property>
<child>
<widget class="GtkLabel" id="label7611">
@@ -1026,7 +1024,7 @@
<property name="title" translatable="yes">Payees and memos</property>
<property name="title_foreground">#f5f5f5f5f5f5</property>
<signal name="next" handler="gnc_ui_qif_import_generic_next_cb"/>
- <signal name="back" handler="gnc_ui_qif_import_generic_back_cb"/>
+ <signal name="back" handler="gnc_ui_qif_import_memo_doc_back_cb"/>
<child internal-child="vbox">
<widget class="GtkVBox" id="druid-vbox39">
@@ -1072,8 +1070,7 @@
<property name="title" translatable="yes">Match payees/memos to GnuCash accounts</property>
<property name="title_foreground">#f5f5f5f5f5f5</property>
<signal name="next" handler="gnc_ui_qif_import_generic_next_cb"/>
- <signal name="back" handler="gnc_ui_qif_import_generic_back_cb"/>
- <signal name="prepare" handler="gnc_ui_qif_import_memo_prepare_cb"/>
+ <signal name="back" handler="gnc_ui_qif_import_memo_back_cb"/>
<child internal-child="vbox">
<widget class="GtkVBox" id="druid-vbox40">
Modified: gnucash/branches/gda-dev2/src/report/report-system/report.scm
===================================================================
--- gnucash/branches/gda-dev2/src/report/report-system/report.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/report/report-system/report.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -253,13 +253,19 @@
(gnc:get-html-style-sheets)))))
(if (procedure? generator)
- (let ((options (generator)))
+ (let ((options (gnc:backtrace-if-exception generator)))
+ (if (not options)
+ (begin
+ (gnc:warn "BUG DETECTED: Scheme exception raised in "
+ "report options generator procedure named "
+ (procedure-name generator))
+ (set! options (gnc:new-options))))
(gnc:register-option options stylesheet)
(gnc:register-option options namer)
options)
(let ((options (gnc:new-options)))
(gnc:register-option options stylesheet)
- (gnc:register-option options names)
+ (gnc:register-option options namer)
options))))
;; A <report> represents an instantiation of a particular report type.
Modified: gnucash/branches/gda-dev2/src/scm/Makefile.am
===================================================================
--- gnucash/branches/gda-dev2/src/scm/Makefile.am 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/scm/Makefile.am 2008-06-11 23:25:10 UTC (rev 17216)
@@ -7,6 +7,7 @@
gncscmmod_DATA = main.scm price-quotes.scm
gnc_regular_scm_files = \
+ string.scm \
command-line.scm \
doc.scm \
fin.scm \
Modified: gnucash/branches/gda-dev2/src/scm/main.scm
===================================================================
--- gnucash/branches/gda-dev2/src/scm/main.scm 2008-06-11 23:00:35 UTC (rev 17215)
+++ gnucash/branches/gda-dev2/src/scm/main.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -37,6 +37,7 @@
;; files we can load from the top-level because they're "well behaved"
;; (these should probably be in modules eventually)
+(load-from-path "string.scm")
(load-from-path "doc.scm")
(load-from-path "main-window.scm") ;; depends on app-utils (N_, etc.)...
(load-from-path "fin.scm")
@@ -56,7 +57,6 @@
(export gnc:safe-strcmp) ;; only used by aging.scm atm...
(re-export hash-fold)
-(re-export string-split)
;; from command-line.scm
(export gnc:*doc-path*)
@@ -127,25 +127,21 @@
(cons joinstr (cons (car remaining-elements)
(loop (cdr remaining-elements)))))))))
-(define (string-split str char)
- (let ((parts '())
- (first-char #f))
- (let loop ((last-char (string-length str)))
- (set! first-char (string-rindex str char 0 last-char))
- (if first-char
- (begin
- (set! parts (cons (substring str (+ 1 first-char) last-char)
- parts))
- (loop first-char))
- (set! parts (cons (substring str 0 last-char) parts))))
- parts))
-
-
(define (gnc:backtrace-if-exception proc . args)
(define (dumper key . args)
(let ((stack (make-stack #t dumper)))
+ ;; Send debugging output to the console.
(display-backtrace stack (current-error-port))
(apply display-error stack (current-error-port) args)
+
+ ;; Send debugging output to the log.
+ (if (defined? 'gnc:warn)
+ (let ((string-port (open-output-string)))
+ (display-backtrace stack string-port)
+ (apply display-error stack string-port args)
+ (gnc:warn (get-output-string string-port))
+ (close-output-port string-port)))
+
(throw 'ignore)))
(catch
Copied: gnucash/branches/gda-dev2/src/scm/string.scm (from rev 17215, gnucash/trunk/src/scm/string.scm)
===================================================================
--- gnucash/branches/gda-dev2/src/scm/string.scm (rev 0)
+++ gnucash/branches/gda-dev2/src/scm/string.scm 2008-06-11 23:25:10 UTC (rev 17216)
@@ -0,0 +1,121 @@
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
+;; Boston, MA 02110-1301, USA gnu at gnu.org
+
+(use-modules (srfi srfi-13))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gnc:string-rcontains
+;;
+;; Similar to string-contains, but searches from the right.
+;;
+;; Example: (gnc:string-rcontains "foobarfoobarf" "bar")
+;; returns 9.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (gnc:string-rcontains s1 s2)
+ (let ((s2len (string-length s2)))
+ (let loop ((i (string-contains s1 s2))
+ (retval #f))
+ (if i
+ (loop (string-contains s1 s2 (+ i s2len)) i)
+ retval))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gnc:substring-count
+;;
+;; Similar to string-count, but searches for a substring rather
+;; than a single character.
+;;
+;; Example: (gnc:substring-count "foobarfoobarfoo" "bar")
+;; returns 2.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (gnc:substring-count s1 s2)
+ (let ((s2len (string-length s2)))
+ (let loop ((i (string-contains s1 s2))
+ (retval 0))
+ (if i
+ (loop (string-contains s1 s2 (+ i s2len)) (+ 1 retval))
+ retval))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gnc:substring-split
+;;
+;; Similar to string-split, but the delimiter is a string
+;; rather than a single character.
+;;
+;; Example: (gnc:substring-split "foobarfoobarf" "bar") returns
+;; ("foo" "foo" "f").
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (gnc:substring-split s1 s2)
+ (let ((i (string-contains s1 s2)))
+ (if i
+ (cons (substring s1 0 i)
+ (gnc:substring-split (substring s1 (+ i (string-length s2))) s2))
+ (list s1))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gnc:substring-replace
+;;
+;; Search for all occurrences in string "s1" of string "s2" and
+;; replace them with string "s3".
+;;
+;; Example: (gnc:substring-replace "foobarfoobar" "bar" "xyz")
+;; returns "fooxyzfooxyz".
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (gnc:substring-replace s1 s2 s3)
+ (let ((s2len (string-length s2)))
+ (let loop ((start1 0)
+ (i (string-contains s1 s2)))
+ (if i
+ (string-append (substring s1 start1 i)
+ s3
+ (loop (+ i s2len) (string-contains s1 s2 (+ i s2len))))
+ (substring s1 start1)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gnc:string-replace-char
+;;
+;; Replaces all occurrences in string "s" of character "old"
+;; with character "new".
+;;
+;; Example: (gnc:string-replace-char "foo" #\o #\c) returns
+;; "fcc".
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (gnc:string-replace-char s old new)
+ (string-map (lambda (c) (if (char=? c old) new c)) s))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gnc:string-delete-chars
+;;
+;; Filter string "s", retaining only those characters that do not
+;; appear in string "chars".
+;;
+;; Example: (gnc:string-delete-chars "abcd" "cb") returns "ad".
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-public (gnc:string-delete-chars s chars)
+ (string-delete s (lambda (c) (string-index chars c))))
More information about the gnucash-changes
mailing list