diff --git a/ChangeLog b/ChangeLog index 1687a9cc36..aecf431be9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2000-05-29 Robert Graham Merkel + + * src/scm/report/transaction-report-2.scm (make-account-subheading): + added the ability to display balances at start-of-report date + when sorting by accounts. Also replaced gnc:split-get-amount + (which doesn't exist) with gnc:split-get-value for amount sorting. + + * doc/guile-hackers.txt: Added pointers to g-wrap now that it's + not part of the main gnucash distribution. + 2000-05-24 Dave Peticolas * src/SplitLedger.c: some simplification, some additional diff --git a/doc/guile-hackers.txt b/doc/guile-hackers.txt index 6a6822cdb7..729f92c361 100644 --- a/doc/guile-hackers.txt +++ b/doc/guile-hackers.txt @@ -53,13 +53,15 @@ and other resources. g-wrap ------ -g-wrap is the tool used to automate the wrapping of C functions -to make them callable from the guile code. Gnucash installs -its own local copy of g-wrap. Documentation in info format -is available in gnucash/lib/g-wrap/doc/g-wrap.info. Available -C functions are wrapped in gnucash/src/g-wrap/gnc.gwp. Pointers -are wrapped using some stuff in gnucash/lib/g-wrap/guile/pointer.scm -which is not documented but looks reasonably straightforward. +g-wrap is the tool used to automate the wrapping of C functions to +make them callable from the guile code. g-wrap is now maintained by +Rob Browning and is available from ftp://ftp.gnucash.org/pub/g-wrap, +or as a Debian package from http://www.cs.mu.oz.au/~rgmerk/software. +Documentation in info format is distributed as part of the package. +Available C functions are wrapped in gnucash/src/g-wrap/gnc.gwp. +Pointers are wrapped using some stuff in +gnucash/lib/g-wrap/guile/pointer.scm which is not documented but looks +reasonably straightforward. Garbage collection: diff --git a/src/gnome/account-tree.c b/src/gnome/account-tree.c index f114b91cad..528e172a1d 100644 --- a/src/gnome/account-tree.c +++ b/src/gnome/account-tree.c @@ -125,8 +125,8 @@ gnc_account_tree_init(GNCAccountTree *tree) gnc_account_tree_set_view_info_real(tree); gtk_ctree_construct(GTK_CTREE(tree), - tree->num_columns, 0, - tree->column_headings); + tree->num_columns, 0, + (gchar **) tree->column_headings); gtk_clist_set_shadow_type(GTK_CLIST(tree), GTK_SHADOW_IN); gtk_clist_column_titles_passive(GTK_CLIST(tree)); diff --git a/src/gnome/dialog-qif-import.c b/src/gnome/dialog-qif-import.c index b7a00b9989..376b90c214 100644 --- a/src/gnome/dialog-qif-import.c +++ b/src/gnome/dialog-qif-import.c @@ -27,6 +27,8 @@ #include #include +#include +#include #include @@ -46,16 +48,11 @@ #include "query-user.h" #include "util.h" -#define _QIF_IMPORT_NUM_RADIX_FORMATS 3 -#define _QIF_IMPORT_NUM_DATE_FORMATS 5 - struct _qifimportwindow { /* on the Files tab */ GtkWidget * dialog; GtkWidget * currency_entry; - GtkWidget * radix_picker; - GtkWidget * date_picker; GtkWidget * filename_entry; GtkWidget * acct_auto_button; GtkWidget * acct_entry; @@ -90,9 +87,6 @@ QIFImportWindow * gnc_ui_qif_import_dialog_make() { QIFImportWindow * retval; - GtkWidget * menu; - GtkWidget * active; - int i; SCM load_map_prefs; SCM mapping_info; @@ -110,10 +104,6 @@ gnc_ui_qif_import_dialog_make() retval->currency_entry = gtk_object_get_data(GTK_OBJECT(retval->dialog), "qif_currency_entry"); - retval->radix_picker = - gtk_object_get_data(GTK_OBJECT(retval->dialog), "qif_radix_picker"); - retval->date_picker = - gtk_object_get_data(GTK_OBJECT(retval->dialog), "qif_date_picker"); retval->filename_entry = gtk_object_get_data(GTK_OBJECT(retval->dialog), "qif_filename_entry"); retval->acct_auto_button = @@ -153,30 +143,6 @@ gnc_ui_qif_import_dialog_make() gtk_entry_set_text(GTK_ENTRY(retval->currency_entry), gh_scm2newstr(default_currency, &scm_strlen)); - /* repair the option menus to associate "option_index" with the - * index number for each menu item */ - menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(retval->radix_picker)); - - for(i = 0; i < _QIF_IMPORT_NUM_RADIX_FORMATS; i++) { - gtk_option_menu_set_history(GTK_OPTION_MENU(retval->radix_picker), i); - active = gtk_menu_get_active(GTK_MENU(menu)); - gtk_object_set_data(GTK_OBJECT(active), "option_index", - GINT_TO_POINTER(i)); - } - gtk_option_menu_set_history(GTK_OPTION_MENU(retval->radix_picker), 0); - - - menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(retval->date_picker)); - - for(i = 0; i < _QIF_IMPORT_NUM_DATE_FORMATS; i++) { - gtk_option_menu_set_history(GTK_OPTION_MENU(retval->date_picker), i); - active = gtk_menu_get_active(GTK_MENU(menu)); - gtk_object_set_data(GTK_OBJECT(active), - "option_index", - GINT_TO_POINTER(i)); - } - gtk_option_menu_set_history(GTK_OPTION_MENU(retval->date_picker), 0); - gtk_widget_show_all(retval->dialog); return retval; @@ -223,8 +189,6 @@ gnc_ui_qif_import_select_file_cb(GtkButton * button, new_file_name = fileBox(_("Select QIF File"), "*.qif"); - - if(new_file_name && (access(new_file_name, R_OK) == 0)) { /* set the filename entry for what was selected */ @@ -243,17 +207,7 @@ gnc_ui_qif_import_select_file_cb(GtkButton * button, if(wind->acct_entry) { gtk_entry_set_text(GTK_ENTRY(wind->acct_entry), ""); - } - - /* radix and date formats are auto-determined by default */ - if(wind->date_picker) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), - 0); - } - if(wind->radix_picker) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->radix_picker), - 0); - } + } } } @@ -262,13 +216,13 @@ gnc_ui_qif_import_select_file_cb(GtkButton * button, * gnc_ui_qif_import_load_file_cb * * Invoked when the "load file" button is clicked on the first page of - * the QIF Import notebook. Filename, currency, radix format, and + * the QIF Import notebook. Filename, currency, and * date format are read from the UI and passed to the Scheme side. \********************************************************************/ void -gnc_ui_qif_import_load_file_cb (GtkButton *button, - gpointer user_data) { +gnc_ui_qif_import_load_file_cb(GtkButton * button, gpointer user_data) { + GtkWidget * dialog = GTK_WIDGET(user_data); QIFImportWindow * wind = gtk_object_get_data(GTK_OBJECT(dialog), "qif_window_struct"); @@ -277,37 +231,21 @@ gnc_ui_qif_import_load_file_cb (GtkButton *button, char * qif_account; char * currency; char * error_string = NULL; - int radix_format; - int date_format; - - GtkWidget * menu; - GtkWidget * menuitem; + + struct timeval start, end; SCM make_qif_file, qif_file_load, qif_file_loaded, unload_qif_file; - SCM scm_filename, scm_currency, scm_radix, scm_date, scm_qif_account; + SCM qif_file_parse; + SCM scm_filename, scm_currency, scm_qif_account; SCM scm_qiffile; SCM imported_files = SCM_EOL; - SCM load_return; + SCM load_return, parse_return; - char * radix_symbols [] = { "unknown", "decimal", "comma" }; - char * date_symbols [] = { "unknown", "m-d-y", "d-m-y", - "y-m-d", "y-d-m" }; - /* get the UI elements */ path_to_load = gtk_entry_get_text(GTK_ENTRY(wind->filename_entry)); currency = gtk_entry_get_text(GTK_ENTRY(wind->currency_entry)); qif_account = gtk_entry_get_text(GTK_ENTRY(wind->acct_entry)); - menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(wind->radix_picker)); - menuitem = gtk_menu_get_active(GTK_MENU(menu)); - radix_format = GPOINTER_TO_INT(gtk_object_get_data(GTK_OBJECT(menuitem), - "option_index")); - - menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(wind->date_picker)); - menuitem = gtk_menu_get_active(GTK_MENU(menu)); - date_format = GPOINTER_TO_INT(gtk_object_get_data(GTK_OBJECT(menuitem), - "option_index")); - if(strlen(path_to_load) == 0) { gnc_error_dialog_parented(GTK_WINDOW(wind->dialog), _("You must specify a file to load.")); @@ -320,6 +258,7 @@ gnc_ui_qif_import_load_file_cb (GtkButton *button, /* find the make and load functions. */ make_qif_file = gh_eval_str("make-qif-file"); qif_file_load = gh_eval_str("qif-file:read-file"); + qif_file_parse = gh_eval_str("qif-file:parse-fields"); qif_file_loaded = gh_eval_str("qif-dialog:qif-file-loaded?"); unload_qif_file = gh_eval_str("qif-dialog:unload-qif-file"); @@ -334,8 +273,6 @@ gnc_ui_qif_import_load_file_cb (GtkButton *button, /* convert args */ scm_filename = gh_str02scm(path_to_load); scm_currency = gh_str02scm(currency); - scm_radix = gh_symbol2scm(radix_symbols[radix_format]); - scm_date = gh_symbol2scm(date_symbols[date_format]); if(gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON(wind->acct_auto_button))) { @@ -364,46 +301,88 @@ gnc_ui_qif_import_load_file_cb (GtkButton *button, /* turn on the busy cursor */ gnc_set_busy_cursor(NULL); + gettimeofday(&start, NULL); + /* create the object */ scm_qiffile = gh_apply(make_qif_file, - SCM_LIST4(scm_qif_account, scm_radix, - scm_date, scm_currency)); + SCM_LIST2(scm_qif_account, scm_currency)); imported_files = gh_cons(scm_qiffile, imported_files); wind->selected_file = scm_qiffile; - /* I think I have to do this since it's a global but not in - * guile-space */ scm_protect_object(wind->selected_file); load_return = gh_call2(qif_file_load, gh_car(imported_files), scm_filename); - /* import the file into it */ - if(load_return != SCM_BOOL_T) { - if(gh_list_p(load_return)) { - asprintf(&error_string, - QIF_LOAD_FAILED_FORMAT_MSG, - gh_scm2newstr(gh_cadr(load_return), NULL)); - } - else { - error_string = QIF_LOAD_FAILED_DEFAULT_MSG; - } + /* a list returned is (#f error-message) for an error, + * (#t error-message) for a warning */ + if(gh_list_p(load_return) && + (gh_car(load_return) == SCM_BOOL_T)) { + asprintf(&error_string, + QIF_LOAD_WARNING_FORMAT_MSG, + gh_scm2newstr(gh_cadr(load_return), NULL)); + gnc_warning_dialog_parented(GTK_WIDGET(wind->dialog), error_string); + } + + if((load_return != SCM_BOOL_T) && + (!gh_list_p(load_return) || + (gh_car(load_return) != SCM_BOOL_T))) { + asprintf(&error_string, + QIF_LOAD_FAILED_FORMAT_MSG, + gh_scm2newstr(gh_cadr(load_return), NULL)); gnc_error_dialog_parented(GTK_WINDOW(wind->dialog), error_string); imported_files = gh_call2(unload_qif_file, scm_filename, imported_files); } + else { + parse_return = gh_call1(qif_file_parse, gh_car(imported_files)); + + if(gh_list_p(parse_return) && + (gh_car(parse_return) == SCM_BOOL_T)) { + asprintf(&error_string, + QIF_PARSE_WARNING_FORMAT_MSG, + gh_scm2newstr(gh_cadr(parse_return), NULL)); + gnc_warning_dialog_parented(GTK_WIDGET(wind->dialog), error_string); + } + if((parse_return != SCM_BOOL_T) && + (!gh_list_p(parse_return) || + (gh_car(parse_return) != SCM_BOOL_T))) { + asprintf(&error_string, + QIF_PARSE_FAILED_FORMAT_MSG, + gh_scm2newstr(gh_cadr(parse_return), NULL)); + gnc_error_dialog_parented(GTK_WINDOW(wind->dialog), error_string); + imported_files = + gh_call2(unload_qif_file, scm_filename, imported_files); + } + } + wind->imported_files = imported_files; scm_protect_object(wind->imported_files); + gettimeofday(&end, NULL); + printf("QIF file load took %f ms total.\n", + 1000.0*(end.tv_sec - start.tv_sec) + + .001*(end.tv_usec - start.tv_usec)); + + gettimeofday(&start, NULL); + /* now update the Accounts and Categories pages in the notebook */ update_file_page(wind); update_accounts_page(wind); update_categories_page(wind); + gettimeofday(&end, NULL); + + printf("QIF Category/account tab update took %f ms.\n", + 1000.0*(end.tv_sec - start.tv_sec) + + .001*(end.tv_usec - start.tv_usec)); + + gettimeofday(&end, NULL); + /* turn back the cursor */ gnc_unset_busy_cursor(NULL); } @@ -637,13 +616,9 @@ update_file_page(QIFImportWindow * wind) { static void update_file_info(QIFImportWindow * wind, SCM qif_file) { - SCM qif_file_radix_format; - SCM qif_file_date_format; SCM qif_file_currency; SCM qif_file_path; SCM qif_file_account; - SCM scm_radix_format; - SCM scm_date_format; SCM scm_currency; SCM scm_qif_account; SCM scm_qif_path; @@ -651,16 +626,12 @@ update_file_info(QIFImportWindow * wind, SCM qif_file) { int scm_strlen; /* look up the methods */ - qif_file_radix_format = gh_eval_str("qif-file:radix-format"); - qif_file_date_format = gh_eval_str("qif-file:date-format"); qif_file_currency = gh_eval_str("qif-file:currency"); qif_file_path = gh_eval_str("qif-file:path"); - qif_file_account = gh_eval_str("qif-file:account"); + qif_file_account = gh_eval_str("qif-file:default-account"); /* make sure the methods are loaded */ - if((!gh_procedure_p(qif_file_radix_format)) || - (!gh_procedure_p(qif_file_date_format)) || - (!gh_procedure_p(qif_file_currency)) || + if((!gh_procedure_p(qif_file_currency)) || (!gh_procedure_p(qif_file_account)) || (!gh_procedure_p(qif_file_path))) { gnc_error_dialog_parented(GTK_WINDOW(wind->dialog), @@ -674,11 +645,7 @@ update_file_info(QIFImportWindow * wind, SCM qif_file) { scm_protect_object(qif_file); - /* get the radix/date formats, currency etc from the Scheme side */ - scm_radix_format = gh_call1(qif_file_radix_format, - qif_file); - scm_date_format = gh_call1(qif_file_date_format, - qif_file); + /* get the currency etc from the Scheme side */ scm_currency = gh_call1(qif_file_currency, qif_file); scm_qif_path = gh_call1(qif_file_path, @@ -697,42 +664,7 @@ update_file_info(QIFImportWindow * wind, SCM qif_file) { gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(wind->acct_auto_button), FALSE); gtk_entry_set_text(GTK_ENTRY(wind->acct_entry), - gh_scm2newstr(scm_qif_account, &scm_strlen)); - - /* set the option menu selections */ - if(!strcmp(gh_symbol2newstr(scm_radix_format, &scm_strlen), - "unknown")) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->radix_picker), 0); - } - else if(!strcmp(gh_symbol2newstr(scm_radix_format, &scm_strlen), - "decimal")) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->radix_picker), 1); - } - else if(!strcmp(gh_symbol2newstr(scm_radix_format, &scm_strlen), - "comma")) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->radix_picker), 2); - } - - if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen), - "unknown")) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 0); - } - else if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen), - "m-d-y")) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 1); - } - else if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen), - "d-m-y")) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 2); - } - else if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen), - "y-m-d")) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 3); - } - else if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen), - "y-d-m")) { - gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 4); - } + gh_scm2newstr(scm_qif_account, &scm_strlen)); } } diff --git a/src/gnome/glade-gnc-dialogs.c b/src/gnome/glade-gnc-dialogs.c index d83686eb91..0c63dff8fe 100644 --- a/src/gnome/glade-gnc-dialogs.c +++ b/src/gnome/glade-gnc-dialogs.c @@ -35,8 +35,6 @@ create_QIF_File_Import_Dialog (void) GtkWidget *label1; GtkWidget *label679; GtkWidget *currency_label; - GtkWidget *radix_format_label; - GtkWidget *date_format_label; GtkWidget *vbox4; GtkWidget *hbox33; GtkWidget *qif_filename_entry; @@ -45,11 +43,6 @@ create_QIF_File_Import_Dialog (void) GtkWidget *qif_account_entry; GtkWidget *qif_account_auto_check; GtkWidget *qif_currency_entry; - GtkWidget *qif_radix_picker; - GtkWidget *qif_radix_picker_menu; - GtkWidget *glade_menuitem; - GtkWidget *qif_date_picker; - GtkWidget *qif_date_picker_menu; GtkWidget *hbox9; GtkWidget *add_file_button; GtkWidget *label69; @@ -180,24 +173,6 @@ create_QIF_File_Import_Dialog (void) gtk_label_set_justify (GTK_LABEL (currency_label), GTK_JUSTIFY_RIGHT); gtk_misc_set_alignment (GTK_MISC (currency_label), 1, 0.5); - radix_format_label = gtk_label_new (_("Radix format:")); - gtk_widget_ref (radix_format_label); - gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "radix_format_label", radix_format_label, - (GtkDestroyNotify) gtk_widget_unref); - gtk_widget_show (radix_format_label); - gtk_box_pack_start (GTK_BOX (vbox3), radix_format_label, FALSE, FALSE, 0); - gtk_label_set_justify (GTK_LABEL (radix_format_label), GTK_JUSTIFY_RIGHT); - gtk_misc_set_alignment (GTK_MISC (radix_format_label), 1, 0.5); - - date_format_label = gtk_label_new (_("Date format:")); - gtk_widget_ref (date_format_label); - gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "date_format_label", date_format_label, - (GtkDestroyNotify) gtk_widget_unref); - gtk_widget_show (date_format_label); - gtk_box_pack_start (GTK_BOX (vbox3), date_format_label, FALSE, FALSE, 0); - gtk_label_set_justify (GTK_LABEL (date_format_label), GTK_JUSTIFY_RIGHT); - gtk_misc_set_alignment (GTK_MISC (date_format_label), 1, 0.5); - vbox4 = gtk_vbox_new (TRUE, 0); gtk_widget_ref (vbox4); gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "vbox4", vbox4, @@ -256,48 +231,6 @@ create_QIF_File_Import_Dialog (void) gtk_widget_show (qif_currency_entry); gtk_box_pack_start (GTK_BOX (vbox4), qif_currency_entry, FALSE, FALSE, 0); - qif_radix_picker = gtk_option_menu_new (); - gtk_widget_ref (qif_radix_picker); - gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "qif_radix_picker", qif_radix_picker, - (GtkDestroyNotify) gtk_widget_unref); - gtk_widget_show (qif_radix_picker); - gtk_box_pack_start (GTK_BOX (vbox4), qif_radix_picker, FALSE, FALSE, 0); - qif_radix_picker_menu = gtk_menu_new (); - glade_menuitem = gtk_menu_item_new_with_label (_("Autodetect")); - gtk_widget_show (glade_menuitem); - gtk_menu_append (GTK_MENU (qif_radix_picker_menu), glade_menuitem); - glade_menuitem = gtk_menu_item_new_with_label (_("Decimal (1,000.00)")); - gtk_widget_show (glade_menuitem); - gtk_menu_append (GTK_MENU (qif_radix_picker_menu), glade_menuitem); - glade_menuitem = gtk_menu_item_new_with_label (_("Comma (1.000,00)")); - gtk_widget_show (glade_menuitem); - gtk_menu_append (GTK_MENU (qif_radix_picker_menu), glade_menuitem); - gtk_option_menu_set_menu (GTK_OPTION_MENU (qif_radix_picker), qif_radix_picker_menu); - - qif_date_picker = gtk_option_menu_new (); - gtk_widget_ref (qif_date_picker); - gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "qif_date_picker", qif_date_picker, - (GtkDestroyNotify) gtk_widget_unref); - gtk_widget_show (qif_date_picker); - gtk_box_pack_start (GTK_BOX (vbox4), qif_date_picker, FALSE, FALSE, 0); - qif_date_picker_menu = gtk_menu_new (); - glade_menuitem = gtk_menu_item_new_with_label (_("Autodetect ")); - gtk_widget_show (glade_menuitem); - gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem); - glade_menuitem = gtk_menu_item_new_with_label (_("MM/DD/YYYY")); - gtk_widget_show (glade_menuitem); - gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem); - glade_menuitem = gtk_menu_item_new_with_label (_("DD/MM/YYYY")); - gtk_widget_show (glade_menuitem); - gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem); - glade_menuitem = gtk_menu_item_new_with_label (_("YYYY/MM/DD")); - gtk_widget_show (glade_menuitem); - gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem); - glade_menuitem = gtk_menu_item_new_with_label (_("YYYY/DD/MM")); - gtk_widget_show (glade_menuitem); - gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem); - gtk_option_menu_set_menu (GTK_OPTION_MENU (qif_date_picker), qif_date_picker_menu); - hbox9 = gtk_hbox_new (TRUE, 0); gtk_widget_ref (hbox9); gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "hbox9", hbox9, diff --git a/src/gnome/gnc-dialogs.glade b/src/gnome/gnc-dialogs.glade index 2a2907aa86..dd4720e003 100644 --- a/src/gnome/gnc-dialogs.glade +++ b/src/gnome/gnc-dialogs.glade @@ -10,7 +10,9 @@ C True True + False False + True False False glade-gnc-dialogs.c @@ -47,66 +49,6 @@ True - - GtkHButtonBox - GnomeDialog:action_area - dialog-action_area2 - GTK_BUTTONBOX_SPREAD - 8 - 85 - 27 - 7 - 0 - - 0 - False - True - GTK_PACK_END - - - - GtkButton - button2 - True - True - - clicked - gnc_ui_qif_import_ok_cb - QIF_File_Import_Dialog - Tue, 14 Mar 2000 15:08:23 GMT - - GNOME_STOCK_BUTTON_OK - - - - GtkButton - button3 - True - True - - clicked - gnc_ui_qif_import_cancel_cb - QIF_File_Import_Dialog - Tue, 14 Mar 2000 15:08:04 GMT - - GNOME_STOCK_BUTTON_CANCEL - - - - GtkButton - button4 - True - True - - clicked - gnc_ui_qif_import_help_cb - QIF_File_Import_Dialog - Tue, 14 Mar 2000 15:08:59 GMT - - GNOME_STOCK_BUTTON_HELP - - - GtkNotebook notebook1 @@ -262,40 +204,6 @@ False - - - GtkLabel - radix_format_label - - GTK_JUSTIFY_RIGHT - False - 1 - 0.5 - 0 - 0 - - 0 - False - False - - - - - GtkLabel - date_format_label - - GTK_JUSTIFY_RIGHT - False - 1 - 0.5 - 0 - 0 - - 0 - False - False - - @@ -411,40 +319,6 @@ False - - - GtkOptionMenu - qif_radix_picker - True - Autodetect -Decimal (1,000.00) -Comma (1.000,00) - - 0 - - 0 - False - False - - - - - GtkOptionMenu - qif_date_picker - True - Autodetect -MM/DD/YYYY -DD/MM/YYYY -YYYY/MM/DD -YYYY/DD/MM - - 0 - - 0 - False - False - - @@ -674,6 +548,66 @@ YYYY/DD/MM 0 + + + GtkHButtonBox + GnomeDialog:action_area + dialog-action_area2 + GTK_BUTTONBOX_SPREAD + 8 + 85 + 27 + 7 + 0 + + 0 + False + True + GTK_PACK_END + + + + GtkButton + button2 + True + True + + clicked + gnc_ui_qif_import_ok_cb + QIF_File_Import_Dialog + Tue, 14 Mar 2000 15:08:23 GMT + + GNOME_STOCK_BUTTON_OK + + + + GtkButton + button3 + True + True + + clicked + gnc_ui_qif_import_cancel_cb + QIF_File_Import_Dialog + Tue, 14 Mar 2000 15:08:04 GMT + + GNOME_STOCK_BUTTON_CANCEL + + + + GtkButton + button4 + True + True + + clicked + gnc_ui_qif_import_help_cb + QIF_File_Import_Dialog + Tue, 14 Mar 2000 15:08:59 GMT + + GNOME_STOCK_BUTTON_HELP + + @@ -702,52 +636,6 @@ YYYY/DD/MM True - - GtkHButtonBox - GnomeDialog:action_area - hbuttonbox1 - GTK_BUTTONBOX_SPREAD - 8 - 85 - 27 - 7 - 0 - - 0 - False - False - GTK_PACK_END - - - - GtkButton - button1 - True - True - - clicked - gnc_ui_account_picker_ok_cb - QIF_Import_Account_Picker - Thu, 02 Mar 2000 23:02:59 GMT - - GNOME_STOCK_BUTTON_OK - - - - GtkButton - button2 - True - True - - clicked - gnc_ui_account_picker_cancel_cb - QIF_Import_Account_Picker - Thu, 02 Mar 2000 23:03:18 GMT - - GNOME_STOCK_BUTTON_CANCEL - - - GtkVBox vbox2 @@ -946,6 +834,52 @@ Equity + + + GtkHButtonBox + GnomeDialog:action_area + hbuttonbox1 + GTK_BUTTONBOX_SPREAD + 8 + 85 + 27 + 7 + 0 + + 0 + False + False + GTK_PACK_END + + + + GtkButton + button1 + True + True + + clicked + gnc_ui_account_picker_ok_cb + QIF_Import_Account_Picker + Thu, 02 Mar 2000 23:02:59 GMT + + GNOME_STOCK_BUTTON_OK + + + + GtkButton + button2 + True + True + + clicked + gnc_ui_account_picker_cancel_cb + QIF_Import_Account_Picker + Thu, 02 Mar 2000 23:03:18 GMT + + GNOME_STOCK_BUTTON_CANCEL + + @@ -974,6 +908,41 @@ Equity True + + GtkFrame + frame14 + + 0 + GTK_SHADOW_ETCHED_IN + + 0 + True + True + + + + GtkScrolledWindow + scrolledwindow4 + 1 + GTK_POLICY_ALWAYS + GTK_POLICY_ALWAYS + GTK_UPDATE_CONTINUOUS + GTK_UPDATE_CONTINUOUS + + + GnomeCanvas + preview_canvas + True + True + 0 + 0 + 100 + 100 + 1 + + + + GtkHButtonBox GnomeDialog:action_area @@ -1021,41 +990,6 @@ Equity - - - GtkFrame - frame14 - - 0 - GTK_SHADOW_ETCHED_IN - - 0 - True - True - - - - GtkScrolledWindow - scrolledwindow4 - 1 - GTK_POLICY_ALWAYS - GTK_POLICY_ALWAYS - GTK_UPDATE_CONTINUOUS - GTK_UPDATE_CONTINUOUS - - - GnomeCanvas - preview_canvas - True - True - 0 - 0 - 100 - 100 - 1 - - - @@ -1084,81 +1018,6 @@ Equity True - - GtkHButtonBox - GnomeDialog:action_area - dialog-action_area4 - GTK_BUTTONBOX_SPREAD - 8 - 85 - 27 - 7 - 0 - - 0 - False - True - GTK_PACK_END - - - - GtkButton - button9 - True - True - - clicked - gnc_ui_print_dialog_ok_cb - Print_Dialog - Wed, 22 Mar 2000 22:42:13 GMT - - - GNOME_STOCK_PIXMAP_PRINT - - - - GtkButton - button13 - True - True - - clicked - gnc_ui_print_dialog_preview_cb - Print_Dialog - Wed, 22 Mar 2000 22:42:05 GMT - - - - - - GtkButton - button24 - True - True - - clicked - gnc_ui_print_dialog_cancel_cb - Print_Dialog - Tue, 28 Mar 2000 02:12:27 GMT - - GNOME_STOCK_BUTTON_CANCEL - - - - GtkButton - button25 - True - True - - clicked - gnc_ui_print_dialog_help_cb - Print_Dialog - Tue, 28 Mar 2000 02:12:52 GMT - - GNOME_STOCK_BUTTON_HELP - - - GtkHBox hbox12 @@ -1509,6 +1368,81 @@ Equity + + + GtkHButtonBox + GnomeDialog:action_area + dialog-action_area4 + GTK_BUTTONBOX_SPREAD + 8 + 85 + 27 + 7 + 0 + + 0 + False + True + GTK_PACK_END + + + + GtkButton + button9 + True + True + + clicked + gnc_ui_print_dialog_ok_cb + Print_Dialog + Wed, 22 Mar 2000 22:42:13 GMT + + + GNOME_STOCK_PIXMAP_PRINT + + + + GtkButton + button13 + True + True + + clicked + gnc_ui_print_dialog_preview_cb + Print_Dialog + Wed, 22 Mar 2000 22:42:05 GMT + + + + + + GtkButton + button24 + True + True + + clicked + gnc_ui_print_dialog_cancel_cb + Print_Dialog + Tue, 28 Mar 2000 02:12:27 GMT + + GNOME_STOCK_BUTTON_CANCEL + + + + GtkButton + button25 + True + True + + clicked + gnc_ui_print_dialog_help_cb + Print_Dialog + Tue, 28 Mar 2000 02:12:52 GMT + + GNOME_STOCK_BUTTON_HELP + + @@ -1537,6 +1471,16 @@ Equity True + + GnomePaperSelector + paperselector1 + + 0 + True + True + + + GtkHButtonBox GnomeDialog:action_area @@ -1590,16 +1534,6 @@ Equity GNOME_STOCK_BUTTON_CANCEL - - - GnomePaperSelector - paperselector1 - - 0 - True - True - - @@ -1628,66 +1562,6 @@ Equity True - - GtkHButtonBox - GnomeDialog:action_area - dialog-action_area6 - GTK_BUTTONBOX_SPREAD - 8 - 85 - 27 - 7 - 0 - - 0 - False - True - GTK_PACK_END - - - - GtkButton - button21 - True - True - - clicked - gnc_ui_print_check_dialog_ok_cb - Print_Check_Dialog - Tue, 28 Mar 2000 19:36:10 GMT - - GNOME_STOCK_BUTTON_OK - - - - GtkButton - button22 - True - True - - clicked - gnc_ui_print_check_dialog_cancel_cb - Print_Check_Dialog - Tue, 28 Mar 2000 19:36:22 GMT - - GNOME_STOCK_BUTTON_CANCEL - - - - GtkButton - button23 - True - True - - clicked - gnc_ui_print_check_dialog_help_cb - Print_Check_Dialog - Tue, 28 Mar 2000 19:36:37 GMT - - GNOME_STOCK_BUTTON_HELP - - - GtkVBox vbox10 @@ -2439,6 +2313,66 @@ Points + + + GtkHButtonBox + GnomeDialog:action_area + dialog-action_area6 + GTK_BUTTONBOX_SPREAD + 8 + 85 + 27 + 7 + 0 + + 0 + False + True + GTK_PACK_END + + + + GtkButton + button21 + True + True + + clicked + gnc_ui_print_check_dialog_ok_cb + Print_Check_Dialog + Tue, 28 Mar 2000 19:36:10 GMT + + GNOME_STOCK_BUTTON_OK + + + + GtkButton + button22 + True + True + + clicked + gnc_ui_print_check_dialog_cancel_cb + Print_Check_Dialog + Tue, 28 Mar 2000 19:36:22 GMT + + GNOME_STOCK_BUTTON_CANCEL + + + + GtkButton + button23 + True + True + + clicked + gnc_ui_print_check_dialog_help_cb + Print_Check_Dialog + Tue, 28 Mar 2000 19:36:37 GMT + + GNOME_STOCK_BUTTON_HELP + + @@ -2467,67 +2401,6 @@ Points True - - GtkHButtonBox - GnomeDialog:action_area - dialog-action_area7 - GTK_BUTTONBOX_SPREAD - 8 - 85 - 27 - 7 - 0 - - 0 - False - True - GTK_PACK_END - - - - GtkButton - button26 - True - True - - clicked - gnc_ui_find_transactions_dialog_ok_cb - Find_Transactions - Wed, 29 Mar 2000 18:54:52 GMT - - - GNOME_STOCK_PIXMAP_SEARCH - - - - GtkButton - button27 - True - True - - clicked - gnc_ui_find_transactions_dialog_cancel_cb - Find_Transactions - Thu, 30 Mar 2000 18:02:10 GMT - - GNOME_STOCK_BUTTON_CANCEL - - - - GtkButton - button28 - True - True - - clicked - gnc_ui_find_transactions_dialog_help_cb - Find_Transactions - Thu, 30 Mar 2000 18:01:32 GMT - - GNOME_STOCK_BUTTON_HELP - - - GtkNotebook notebook2 @@ -3880,6 +3753,67 @@ Exactly + + + GtkHButtonBox + GnomeDialog:action_area + dialog-action_area7 + GTK_BUTTONBOX_SPREAD + 8 + 85 + 27 + 7 + 0 + + 0 + False + True + GTK_PACK_END + + + + GtkButton + button26 + True + True + + clicked + gnc_ui_find_transactions_dialog_ok_cb + Find_Transactions + Wed, 29 Mar 2000 18:54:52 GMT + + + GNOME_STOCK_PIXMAP_SEARCH + + + + GtkButton + button27 + True + True + + clicked + gnc_ui_find_transactions_dialog_cancel_cb + Find_Transactions + Thu, 30 Mar 2000 18:02:10 GMT + + GNOME_STOCK_BUTTON_CANCEL + + + + GtkButton + button28 + True + True + + clicked + gnc_ui_find_transactions_dialog_help_cb + Find_Transactions + Thu, 30 Mar 2000 18:01:32 GMT + + GNOME_STOCK_BUTTON_HELP + + @@ -3908,52 +3842,6 @@ Exactly True - - GtkHButtonBox - GnomeDialog:action_area - dialog-action_area8 - GTK_BUTTONBOX_SPREAD - 8 - 85 - 27 - 7 - 0 - - 0 - False - True - GTK_PACK_END - - - - GtkButton - button34 - True - True - - clicked - gnc_ui_select_date_dialog_ok_cb - Select_Date - Fri, 14 Apr 2000 20:08:28 GMT - - GNOME_STOCK_BUTTON_OK - - - - GtkButton - button36 - True - True - - clicked - gnc_ui_select_date_dialog_cancel_cb - Select_Date - Fri, 14 Apr 2000 20:08:51 GMT - - GNOME_STOCK_BUTTON_CANCEL - - - GtkVBox vbox47 @@ -3999,6 +3887,52 @@ Exactly + + + GtkHButtonBox + GnomeDialog:action_area + dialog-action_area8 + GTK_BUTTONBOX_SPREAD + 8 + 85 + 27 + 7 + 0 + + 0 + False + True + GTK_PACK_END + + + + GtkButton + button34 + True + True + + clicked + gnc_ui_select_date_dialog_ok_cb + Select_Date + Fri, 14 Apr 2000 20:08:28 GMT + + GNOME_STOCK_BUTTON_OK + + + + GtkButton + button36 + True + True + + clicked + gnc_ui_select_date_dialog_cancel_cb + Select_Date + Fri, 14 Apr 2000 20:08:51 GMT + + GNOME_STOCK_BUTTON_CANCEL + + @@ -4027,56 +3961,6 @@ Exactly True - - GtkHButtonBox - GnomeDialog:action_area - dialog-action_area9 - GTK_BUTTONBOX_END - 8 - 85 - 27 - 7 - 0 - - 0 - False - True - GTK_PACK_END - - - - GtkButton - ok_button - True - True - GNOME_STOCK_BUTTON_OK - - - - GtkButton - apply_button - True - True - GNOME_STOCK_BUTTON_APPLY - - - - GtkButton - cancel_button - True - True - GNOME_STOCK_BUTTON_CANCEL - - - - GtkButton - help_button - True - True - GNOME_STOCK_BUTTON_HELP - - - GtkFrame frame24 @@ -4753,6 +4637,56 @@ Contingency + + + GtkHButtonBox + GnomeDialog:action_area + dialog-action_area9 + GTK_BUTTONBOX_END + 8 + 85 + 27 + 7 + 0 + + 0 + False + True + GTK_PACK_END + + + + GtkButton + ok_button + True + True + GNOME_STOCK_BUTTON_OK + + + + GtkButton + apply_button + True + True + GNOME_STOCK_BUTTON_APPLY + + + + GtkButton + cancel_button + True + True + GNOME_STOCK_BUTTON_CANCEL + + + + GtkButton + help_button + True + True + GNOME_STOCK_BUTTON_HELP + + diff --git a/src/messages_i18n.h b/src/messages_i18n.h index 50dabc45af..5b698ccfc2 100644 --- a/src/messages_i18n.h +++ b/src/messages_i18n.h @@ -123,9 +123,10 @@ "If this is not right, remove the .LCK file " \ "and try again.") #define GNOME_PRINT_MSG _("You need to install the gnome-print library.") -#define QIF_LOAD_FAILED_FORMAT_MSG _("QIF file load failed. %s") -#define QIF_LOAD_FAILED_DEFAULT_MSG _("QIF file load failed. Check "\ - "settings and reload.") +#define QIF_LOAD_FAILED_FORMAT_MSG _("QIF file load failed:\n%s") +#define QIF_LOAD_WARNING_FORMAT_MSG _("QIF file load warning:\n%s") +#define QIF_PARSE_FAILED_FORMAT_MSG _("QIF file parse failed:\n%s") +#define QIF_PARSE_WARNING_FORMAT_MSG _("QIF file parse warning:\n%s") #define QUOTE_SRC_MSG _("The source for price quotes") #define RECN_BALN_WARN _("The account is not balanced.\n" \ diff --git a/src/scm/qif-import/qif-dialog-utils.scm b/src/scm/qif-import/qif-dialog-utils.scm index 116a165446..d6675b7c22 100644 --- a/src/scm/qif-import/qif-dialog-utils.scm +++ b/src/scm/qif-import/qif-dialog-utils.scm @@ -22,6 +22,20 @@ (#t (list-set! old-map 5 new-descript))))) +(define (default-dividend-acct security) + (string-append "Dividends:" security)) + +(define (default-interest-acct security) + (string-append "Interest:" security)) + +(define (default-cglong-acct security) + (string-append "Cap. gain (long):" security)) + +(define (default-cgshort-acct security) + (string-append "Cap. gain (short):" security)) + +(define (default-equity-account) "Retained Earnings") +(define (default-equity-category) "[Retained Earnings]") ;; the account-display is a 3-columned list of accounts in the QIF ;; import dialog (the "Account" page of the notebook). Column 1 is @@ -63,10 +77,10 @@ (qif-file:accounts file)) ;; then make an implicit account entry for the file - (if (and (qif-file:account file) - (qif-file:account-type file)) + (if (and (qif-file:default-account file) + (qif-file:default-account-type file)) ; (not (eq? (qif-file:account-type file) GNC-STOCK-TYPE))) - (let ((entry (hash-ref acct-hash (qif-file:account file)))) + (let ((entry (hash-ref acct-hash (qif-file:default-account file)))) (if entry ;; increment the xtn count in place (list-set! entry 4 @@ -75,83 +89,174 @@ ;; make a new hash table entry for the account ;; make it a Bank account by default. (hash-set! - acct-hash (qif-file:account file) + acct-hash (qif-file:default-account file) (append (qif-import:guess-acct - (qif-file:account file) + (qif-file:default-account file) (list GNC-BANK-TYPE GNC-CCARD-TYPE) gnc-acct-info) - (list - (qif-file:default-acct-xtns file) - #f))))))) + (list 0 #f))))))) qif-files) ;; now make the second pass through the files, looking at the ;; transactions. Hopefully the accounts are all there already. ;; stock accounts can have both a category/account and another - ;; account ref from the security name. + ;; account ref from the security name. (for-each (lambda (file) (for-each (lambda (xtn) - (let ((bank-xtn? (qif-xtn:bank-xtn? xtn)) - (stock-acct (qif-xtn:security-name xtn)) + (let ((stock-acct (qif-xtn:security-name xtn)) + (action (qif-xtn:number xtn)) + (action-sym #f) + (from-acct (qif-xtn:from-acct xtn)) + (qif-account #f) + (qif-account-types #f) (entry #f)) - (if (not bank-xtn?) + + (if (string? action) + (set! action-sym (qif-parse:parse-action-field action))) + + (if (and stock-acct action-sym) + ;; stock transactions are weird. there can be several + ;; accounts associated with stock xtns: the security, + ;; the brokerage, a dividend account, a long-term CG + ;; account, a short-term CG account, an interest + ;; account. Make sure all of the right ones get stuck + ;; in the map. (begin - (set! entry (hash-ref acct-hash stock-acct)) + ;; first: figure out what the near-end account is. + ;; it's generally the security account, but could be + ;; an interest, dividend, or CG account. + (case action-sym + ((buy buyx sell sellx reinvdiv reinvsh reinvsg + reinvlg shrsin) + (set! qif-account stock-acct) + (set! qif-account-types (list GNC-STOCK-TYPE + GNC-MUTUAL-TYPE))) + ((div cgshort cglong intinc) + (set! qif-account from-acct) + (set! qif-account-types (list GNC-BANK-TYPE + GNC-CCARD-TYPE))) + + ((divx cgshortx cglongx intincx) + (set! qif-account + (qif-split:category + (car (qif-xtn:splits xtn)))) + (set! qif-account-types (list GNC-BANK-TYPE + GNC-CCARD-TYPE))) + (else + (display "HEY! HEY! action-sym = ") + (display action-sym) (newline))) + + ;; now reference the near-end account + (set! entry (hash-ref acct-hash qif-account)) (if entry (list-set! entry 4 (+ 1 (list-ref entry 4))) - (hash-set! acct-hash stock-acct + (hash-set! acct-hash qif-account (append (qif-import:guess-acct - stock-acct - (list GNC-STOCK-TYPE - GNC-MUTUAL-TYPE) + qif-account qif-account-types gnc-acct-info) - (list 1 xtn))))))) - ;; if there's a from-acct, reference it - (let ((from (qif-xtn:from-acct xtn)) - (entry #f)) - (if from - (begin - (set! entry (hash-ref acct-hash from)) + (list 1 xtn)))) + + ;; now figure out the other end of the transaction. + ;; the far end will be the brokerage for buy, sell, + ;; etc, or the "L"-referenced account for buyx, + ;; sellx, etc, or an equity account for ShrsIn + + (case action-sym + ((buy sell) + (set! qif-account from-acct) + (set! qif-account-types (list GNC-BANK-TYPE + GNC-CCARD-TYPE))) + ((buyx sellx) + (set! qif-account + (qif-split:category + (car (qif-xtn:splits xtn)))) + (set! qif-account-types (list GNC-BANK-TYPE + GNC-CCARD-TYPE))) + + ((cgshort cgshortx reinvsg reinvsh) + (set! qif-account + (default-cgshort-acct stock-acct)) + (set! qif-account-types (list GNC-INCOME-TYPE))) + + ((cglong cglongx reinvlg) + (set! qif-account + (default-cglong-acct stock-acct)) + (set! qif-account-types (list GNC-INCOME-TYPE))) + ((intinc intincx reinvint) + (set! qif-account + (default-interest-acct stock-acct)) + (set! qif-account-types (list GNC-INCOME-TYPE))) + ((div divx reinvdiv) + (set! qif-account + (default-dividend-acct stock-acct)) + (set! qif-account-types (list GNC-INCOME-TYPE))) + ((shrsin) + (set! qif-account + (default-equity-account)) + (set! qif-account-types (list GNC-EQUITY-TYPE))) + (else + (display "HEY! HEY! action-sym = ") + (display action-sym) (newline))) + + ;; now reference the far-end account + (set! entry (hash-ref acct-hash qif-account)) (if entry (list-set! entry 4 (+ 1 (list-ref entry 4))) - (hash-set! acct-hash from + (hash-set! acct-hash qif-account (append (qif-import:guess-acct - from + qif-account qif-account-types + gnc-acct-info) + (list 1 xtn)))) + + ;; if there's a commission, it will reference + ;; a separate account on the far end. + + ) + + ;; non-stock transactions. these are a bit easier. + ;; the near-end account (from) is always in the + ;; transaction, and the far end(s) are in the splits. + (begin + (set! entry (hash-ref acct-hash from-acct)) + (if entry + (list-set! entry 4 + (+ 1 (list-ref entry 4))) + (hash-set! acct-hash from-acct + (append (qif-import:guess-acct + from-acct (list GNC-BANK-TYPE - GNC-CCARD-TYPE - GNC-STOCK-TYPE) + GNC-CCARD-TYPE) gnc-acct-info) - (list 1 #f))))))) - - ;; iterate over the splits doing the same thing. - (for-each - (lambda (split) - (let ((xtn-is-acct (qif-split:category-is-account? split)) - (xtn-acct #f) - (entry #f)) - (if xtn-is-acct - (begin - (set! xtn-acct (qif-split:category split)) - (set! entry (hash-ref acct-hash xtn-acct)) - (if entry - (list-set! entry 4 - (+ 1 (list-ref entry 4))) - (hash-set! acct-hash xtn-acct - (append (qif-import:guess-acct - xtn-acct - (list - GNC-BANK-TYPE - GNC-CCARD-TYPE - GNC-STOCK-TYPE) - gnc-acct-info) - (list 1 #f)))))))) - (qif-xtn:splits xtn))) + (list 1 #f)))) + + ;; iterate over the splits doing the same thing. + (for-each + (lambda (split) + (let ((xtn-is-acct (qif-split:category-is-account? split)) + (xtn-acct #f) + (entry #f)) + (if xtn-is-acct + (begin + (set! xtn-acct (qif-split:category split)) + (set! entry (hash-ref acct-hash xtn-acct)) + (if entry + (list-set! entry 4 + (+ 1 (list-ref entry 4))) + (hash-set! acct-hash xtn-acct + (append (qif-import:guess-acct + xtn-acct + (list + GNC-BANK-TYPE + GNC-CCARD-TYPE) + gnc-acct-info) + (list 1 #f)))))))) + (qif-xtn:splits xtn)))))) (qif-file:xtns file))) qif-files) @@ -186,7 +291,6 @@ (define (qif-dialog:make-category-display qif-files gnc-acct-info) (let ((cat-hash (make-hash-table 20)) (retval '())) - ;; get the Cat entries from each file (for-each (lambda (file) diff --git a/src/scm/qif-import/qif-file.scm b/src/scm/qif-import/qif-file.scm index 34971b5023..0ad60668c8 100644 --- a/src/scm/qif-import/qif-file.scm +++ b/src/scm/qif-import/qif-file.scm @@ -7,14 +7,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (gnc:support "qif-import/qif-file.scm") -(gnc:depend "qif-import/qif-objects.scm") -(gnc:depend "qif-import/qif-parse.scm") -(gnc:depend "qif-import/qif-utils.scm") +(gnc:depend "qif-import/qif-objects.scm") +(gnc:depend "qif-import/qif-parse.scm") +(gnc:depend "qif-import/qif-utils.scm") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; qif-file:read-file self path -;; suck in all the transactions; if necessary, determine [guess] -;; radix format first. +;; suck in all the transactions; don't do any string interpretation, +;; just store the fields "raw". ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (qif-file:read-file self path) @@ -26,51 +26,57 @@ (default-split #f) (first-xtn #f) (ignore-accounts #f) + (return-val #t) (line #f) (tag #f) (value #f) (heinous-error #f) + (start-time #f) + (end-time #f) + (delimiters (string #\cr #\nl)) (valid-acct-types '(type:bank type:cash type:ccard type:invst #{type:oth\ a}# #{type:oth\ l}#))) + (set! start-time (gettimeofday)) (with-input-from-file path - (lambda () + (lambda () ;; loop over lines (let line-loop () - (set! line (read-delimited (string #\nl #\cr))) + (set! line (read-delimited delimiters)) (if (and (not (eof-object? line)) - (>= (string-length line) 1)) + (not (string=? line ""))) (begin ;; pick the 1-char tag off from the remainder of the line (set! tag (string-ref line 0)) - (set! value (substring line 1 (string-length line))) + (set! value (make-shared-substring line 1)) ;; now do something with the line - (cond - ;; the type switcher. - ((eq? tag #\!) - (set! qstate-type (qif-file:parse-bang-field self value)) - (cond ((member qstate-type valid-acct-types) - (set! current-xtn (make-qif-xtn)) - (set! default-split (make-qif-split)) - (qif-split:set-category! default-split "") - (qif-file:set-account-type! - self (qif-file:state-to-account-type - self qstate-type)) - (set! first-xtn #t)) - ((eq? qstate-type 'type:class) - (set! current-xtn (make-qif-class))) - ((eq? qstate-type 'type:cat) - (set! current-xtn (make-qif-cat))) - ((eq? qstate-type 'account) - (set! current-xtn (make-qif-acct))) - ((eq? qstate-type 'option:autoswitch) - (set! ignore-accounts #t)) - ((eq? qstate-type 'clear:autoswitch) - (set! ignore-accounts #f)))) - + (if + (eq? tag #\!) + (begin + (set! qstate-type (qif-parse:parse-bang-field value)) + (case qstate-type + ((type:bank type:cash type:ccard type:invst + #{type:oth\ a}# #{type:oth\ l}#) + (set! current-xtn (make-qif-xtn)) + (set! default-split (make-qif-split)) + (qif-split:set-category! default-split "") + (qif-file:set-default-account-type! + self (qif-parse:state-to-account-type qstate-type)) + (set! first-xtn #t)) + ((type:class) + (set! current-xtn (make-qif-class))) + ((type:cat) + (set! current-xtn (make-qif-cat))) + ((account) + (set! current-xtn (make-qif-acct))) + ((option:autoswitch) + (set! ignore-accounts #t)) + ((clear:autoswitch) + (set! ignore-accounts #f)))) + ;;; (#t ;;; (display "qif-file:read-file can't handle ") ;;; (write qstate-type) @@ -81,310 +87,211 @@ ;; bank-account type transactions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ((member qstate-type valid-acct-types) - (case tag - ;; D : transaction date - ((#\D) - (qif-xtn:set-date! current-xtn - (qif-file:parse-date self value))) - - ;; T : total amount - ((#\T) - (qif-split:set-amount! - default-split (qif-file:parse-value/decimal self value)) - (if (not (number? (qif-split:amount default-split))) - (begin - (display "value not a number : ") - (display value) (display " ") - (write (qif-split:amount default-split)) - (newline)))) - - ;; P : payee - ((#\P) - (qif-xtn:set-payee! current-xtn - (qif-file:parse-string self value))) - - ;; A : address - ;; multiple "A" lines are appended together with - ;; newlines; some Quicken files have a lot of - ;; A lines. - ((#\A) - (qif-xtn:set-address! - current-xtn - (let ((current (qif-xtn:address current-xtn))) - (if (not (string? current)) - (set! current "")) - (string-append - current "\n" - (qif-file:parse-string self value))))) - - ;; N : check number / transaction number /xtn direction - ;; this could be a number or a string; no point in - ;; keeping it numeric just yet. - ((#\N) - (qif-xtn:set-number! - current-xtn (qif-file:parse-string self value))) - - ;; C : cleared flag - ((#\C) - (qif-xtn:set-cleared! - current-xtn (qif-file:parse-cleared-field self value))) - - ;; M : memo - ((#\M) - (qif-split:set-memo! default-split - (qif-file:parse-string self value))) - - ;; I : share price (stock transactions) - ((#\I) - (qif-xtn:set-share-price! - current-xtn (qif-file:parse-value self value))) - - ;; Q : share price (stock transactions) - ((#\Q) - (qif-xtn:set-num-shares! - current-xtn (qif-file:parse-value self value)) - (qif-xtn:set-bank-xtn?! current-xtn #f)) - - ;; Y : name of security (stock transactions) - ((#\Y) - (qif-xtn:set-security-name! - current-xtn (qif-file:parse-string self value))) - - ;; O : adjustment (stock transactions) - ((#\O) - (qif-xtn:set-adjustment! - current-xtn (qif-file:parse-value/decimal self value))) - - ;; L : category - ((#\L) - (qif-split:set-category! - default-split (qif-file:parse-string self value))) - - ;; S : split category - ((#\S) - (set! current-split (make-qif-split)) - (qif-split:set-category! - current-split (qif-file:parse-string self value)) - (qif-xtn:set-splits! - current-xtn - (cons current-split (qif-xtn:splits current-xtn)))) - - ;; E : split memo (?) - ((#\E) - (qif-split:set-memo! - current-split (qif-file:parse-string self value))) - - ;; $ : split amount (if there are splits) - ((#\$) - ;; if this is 'Type:Invst, I can't figure out - ;; what the $ signifies. I'll do it later. - (if (not (eq? qstate-type 'type:invst)) - (qif-split:set-amount! - current-split - (qif-file:parse-value/decimal self value)))) - - ;; ^ : end-of-record - ((#\^) - (if (qif-xtn:date current-xtn) - (begin - (if (not (qif-split:amount default-split)) - (qif-split:set-amount! default-split 0.00)) - - (if (null? (qif-xtn:splits current-xtn)) - (qif-xtn:set-splits! current-xtn - (list default-split))) - (if (and (not ignore-accounts) - current-account-name) - (qif-xtn:set-from-acct! current-xtn - current-account-name)) - (qif-file:add-xtn! self current-xtn))) -; (begin -; (display "qif-file:read-file : discarding xtn") -; (newline) -; (qif-xtn:print current-xtn))) - - (if (and first-xtn - (string? (qif-xtn:payee current-xtn)) - (string=? (qif-xtn:payee current-xtn) - "Opening Balance") - (eq? (length (qif-xtn:splits current-xtn)) 1) - (qif-split:category-is-account? - (car (qif-xtn:splits current-xtn)))) - (begin - (qif-file:set-account! - self (qif-split:category - (car (qif-xtn:splits current-xtn)))) - (qif-split:set-category! - (car (qif-xtn:splits current-xtn)) - "Opening Balance"))) - - ;; some special love for stock transactions - (if (and (qif-xtn:security-name current-xtn) - (string? (qif-xtn:number current-xtn))) - (begin - (cond - ((and - (or (string=? (qif-xtn:number current-xtn) - "ReinvDiv") - (string=? (qif-xtn:number current-xtn) - "ReinvLg") - (string=? (qif-xtn:number current-xtn) - "ReinvSh") - (string=? (qif-xtn:number current-xtn) - "Div")) - (string=? - "" (qif-split:category - (car - (qif-xtn:splits current-xtn))))) - (qif-split:set-category! - (car (qif-xtn:splits current-xtn)) - "Dividend") - ;; KLUDGE! for brokerage accounts - ;; where Dividend pays into the - ;; brokerage account. - (if (and (qif-xtn:bank-xtn? current-xtn) - (string? - (qif-xtn:security-name - current-xtn))) - (qif-xtn:set-payee! - current-xtn (qif-xtn:security-name - current-xtn)))) - - ((or (string=? (qif-xtn:number current-xtn) - "SellX") - (string=? (qif-xtn:number current-xtn) - "Sell")) - (let ((shrs (qif-xtn:num-shares current-xtn))) - (cond ((string? shrs) - (qif-xtn:set-num-shares! - current-xtn - (string-append "-" shrs))) - ((number? shrs) - (qif-xtn:set-num-shares! - current-xtn (- shrs))))))))) - - (set! first-xtn #f) - (set! current-xtn (make-qif-xtn)) - (set! default-split (make-qif-split))))) - - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Class transactions - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ((eq? qstate-type 'type:class) - (case tag - ;; N : name - ((#\N) - (qif-class:set-name! current-xtn - (qif-file:parse-string self value))) - - ;; D : description - ((#\D) - (qif-class:set-description! - current-xtn (qif-file:parse-string self value))) - - ;; end-of-record - ((#\^) - (qif-file:add-class! self current-xtn) - (set! current-xtn (make-qif-class))) - - (else - (display "qif-file:read-file : unknown Class slot ") - (display tag) (newline)))) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Account definitions - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ((eq? qstate-type 'account) - (case tag - ((#\N) - (qif-acct:set-name! current-xtn - (qif-file:parse-string self value))) - ((#\D) - (qif-acct:set-description! - current-xtn (qif-file:parse-string self value))) - - ((#\T) - (qif-acct:set-type! - current-xtn (qif-file:parse-acct-type self value))) - - ((#\L) - (qif-acct:set-limit! - current-xtn (qif-file:parse-value/decimal self value))) - - ;; B : budget amount. not really supported. - ((#\B) - (qif-acct:set-budget! - current-xtn (qif-file:parse-value/decimal self value))) - - ((#\^) - (if (not ignore-accounts) - (set! current-account-name - (qif-acct:name current-xtn))) - (qif-file:add-account! self current-xtn) -;;; (qif-acct:print current-xtn) - (set! current-xtn (make-qif-acct))))) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Category (Cat) transactions - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - ((eq? qstate-type 'type:cat) - (case tag - ;; N : category name - ((#\N) - (qif-cat:set-name! current-xtn - (qif-file:parse-string self value))) - - ;; D : category description - ((#\D) - (qif-cat:set-description! current-xtn - (qif-file:parse-string - self value))) - - ;; E : is this a taxable category? - ((#\T) - (qif-cat:set-taxable! current-xtn #t)) - - ;; E : is this an expense category? - ((#\E) - (qif-cat:set-expense-cat! current-xtn #t)) - - ;; I : is this an income category? - ((#\I) - (qif-cat:set-income-cat! current-xtn #t)) - - ;; R : what is the tax rate (from some table? - ;; seems to be an integer) - ((#\R) - (qif-cat:set-tax-rate! - current-xtn (qif-file:parse-value/decimal self value))) - - ;; B : budget amount. not really supported. - ((#\B) - (qif-cat:set-budget-amt! - current-xtn (qif-file:parse-value/decimal self value))) - - ;; end-of-record - ((#\^) - (qif-file:add-cat! self current-xtn) -;;; (qif-cat:print current-xtn) - (set! current-xtn (make-qif-cat))) - - (else - (display "qif-file:read-file : unknown Cat slot ") - (display tag) (newline)))) - - ;; trying to sneak one by, eh? - (#t - (if (not qstate-type) - (begin - (display "line = ") (display line) (newline) - (display "qif-file:read-file : ") - (display "file does not appear to be a QIF file.") - (newline) - (set! heinous-error #t))))) + (case qstate-type + ((type:bank type:cash type:ccard type:invst + #{type:oth\ a}# #{type:oth\ l}#) + (case tag + ;; D : transaction date + ((#\D) + (qif-xtn:set-date! current-xtn value)) + + ;; T : total amount + ((#\T) + (qif-split:set-amount! default-split value)) + + ;; P : payee + ((#\P) + (qif-xtn:set-payee! current-xtn value)) + + ;; A : address + ;; multiple "A" lines are appended together with + ;; newlines; some Quicken files have a lot of + ;; A lines. + ((#\A) + (qif-xtn:set-address! + current-xtn + (let ((current (qif-xtn:address current-xtn))) + (if (not (string? current)) + (set! current "")) + (string-append current "\n" value)))) + + ;; N : check number / transaction number /xtn direction + ;; this could be a number or a string; no point in + ;; keeping it numeric just yet. + ((#\N) + (qif-xtn:set-number! current-xtn value)) + + ;; C : cleared flag + ((#\C) + (qif-xtn:set-cleared! current-xtn value)) + + ;; M : memo + ((#\M) + (qif-split:set-memo! default-split value)) + + ;; I : share price (stock transactions) + ((#\I) + (qif-xtn:set-share-price! current-xtn value)) + + ;; Q : share price (stock transactions) + ((#\Q) + (qif-xtn:set-num-shares! current-xtn value)) + + ;; Y : name of security (stock transactions) + ((#\Y) + (qif-xtn:set-security-name! current-xtn value)) + + ;; O : commission (stock transactions) + ((#\O) + (qif-xtn:set-commission! current-xtn value)) + + ;; L : category + ((#\L) + (qif-split:set-category! default-split value)) + + ;; S : split category + ((#\S) + (set! current-split (make-qif-split)) + (qif-split:set-category! current-split value) + (qif-xtn:set-splits! + current-xtn + (cons current-split (qif-xtn:splits current-xtn)))) + + ;; E : split memo + ((#\E) + (if current-split + (qif-split:set-memo! current-split value))) + + ;; $ : split amount (if there are splits) + ((#\$) + (if current-split + (qif-split:set-amount! current-split value))) + + ;; ^ : end-of-record + ((#\^) + (if (null? (qif-xtn:splits current-xtn)) + (qif-xtn:set-splits! current-xtn + (list default-split))) + (if first-xtn + (begin + (qif-file:process-opening-balance-xtn + self current-xtn qstate-type) + (set! first-xtn #f))) + + (if current-account-name + (qif-xtn:set-from-acct! current-xtn + current-account-name) + (qif-xtn:set-from-acct! + current-xtn (qif-file:default-account self))) + (if (qif-xtn:date current-xtn) + (qif-file:add-xtn! self current-xtn)) + (set! current-xtn (make-qif-xtn)) + (set! default-split (make-qif-split))))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Class transactions + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ((type:class) + (case tag + ;; N : name + ((#\N) + (qif-class:set-name! current-xtn value)) + + ;; D : description + ((#\D) + (qif-class:set-description! current-xtn value)) + + ;; end-of-record + ((#\^) + (qif-file:add-class! self current-xtn) + (set! current-xtn (make-qif-class))) + + (else + (display "qif-file:read-file : unknown Class slot ") + (display tag) + (display " .. continuing anyway.") + (newline)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Account definitions + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ((account) + (case tag + ((#\N) + (qif-acct:set-name! current-xtn value)) + ((#\D) + (qif-acct:set-description! current-xtn value)) + ((#\T) + (qif-acct:set-type! current-xtn value)) + ((#\L) + (qif-acct:set-limit! current-xtn value)) + ((#\B) + (qif-acct:set-budget! current-xtn value)) + ((#\^) + (if (not ignore-accounts) + (set! current-account-name + (qif-acct:name current-xtn))) + (qif-file:add-account! self current-xtn) + (set! current-xtn (make-qif-acct))))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Category (Cat) transactions + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ((type:cat) + (case tag + ;; N : category name + ((#\N) + (qif-cat:set-name! current-xtn value)) + + ;; D : category description + ((#\D) + (qif-cat:set-description! current-xtn value)) + + ;; E : is this a taxable category? + ((#\T) + (qif-cat:set-taxable! current-xtn #t)) + + ;; E : is this an expense category? + ((#\E) + (qif-cat:set-expense-cat! current-xtn #t)) + + ;; I : is this an income category? + ((#\I) + (qif-cat:set-income-cat! current-xtn #t)) + + ;; R : what is the tax rate (from some table? + ;; seems to be an integer) + ((#\R) + (qif-cat:set-tax-rate! current-xtn value)) + + ;; B : budget amount. not really supported. + ((#\B) + (qif-cat:set-budget-amt! current-xtn value)) + + ;; end-of-record + ((#\^) + (qif-file:add-cat! self current-xtn) + (set! current-xtn (make-qif-cat))) + + (else + (display "qif-file:read-file : unknown Cat slot ") + (display tag) + (display " .. continuing anyway") (newline)))) + + ;; trying to sneak one by, eh? + (else + (if (not qstate-type) + (begin + (display "line = ") (display line) (newline) + (display "qif-file:read-file : ") + (display "file does not appear to be a QIF file.") + (newline) + (set! + return-val + (list #f "File does not appear to be a QIF file.")) + (set! heinous-error #t)))))) ;; this is if we read a normal (non-null, non-eof) line... (if (not heinous-error) @@ -395,57 +302,290 @@ (not (eof-object? line))) (line-loop)))))) - (if (not heinous-error) - (begin - ;; now that the file is read in, figure out if either - ;; the date or radix format has made itself clear from the - ;; values. - (if (and - (eq? (qif-file:radix-format self) 'unknown) - (not (eq? (qif-file:guessed-radix-format self) 'unknown)) - (not (eq? (qif-file:guessed-radix-format self) 'inconsistent))) - (qif-file:set-radix-format! - self - (qif-file:guessed-radix-format self))) - - (if (and - (eq? (qif-file:date-format self) 'unknown) - (not (eq? (qif-file:guessed-date-format self) 'unknown)) - (not (eq? (qif-file:guessed-date-format self) 'inconsistent))) - (qif-file:set-date-format! self - (qif-file:guessed-date-format self))) - - ;; if the account hasn't been found from an Opening Balance line, - ;; just set it to the filename and force the user to specify it. - (if (eq? 'unknown (qif-file:account self)) - (qif-file:set-account! - self (qif-file:path-to-accountname self))) - - ;; reparse values and dates if we figured out the format. - (let ((reparse-ok #t)) - (for-each - (lambda (xtn) - (if (eq? reparse-ok #t) - (set! reparse-ok - (qif-xtn:reparse xtn self)))) - (qif-file:xtns self)) - - (for-each - (lambda (cat) - (if (eq? reparse-ok #t) - (set! reparse-ok - (qif-cat:reparse cat self)))) - (qif-file:cats self)) - - (for-each - (lambda (acct) - (if (eq? reparse-ok #t) - (set! reparse-ok - (qif-acct:reparse acct self)))) - (qif-file:accounts self)) - reparse-ok)) - (begin - (display "There was a heinous error. Failed to read file.") - (newline) - #f)))) + ;; now reverse the transaction list so xtns are in the same order that + ;; they were in the file. This is important in a few cases. + (qif-file:set-xtns! self (reverse (qif-file:xtns self))) + + (set! end-time (gettimeofday)) + (display "QIF file read took ") + (display (+ (* 1000 (- (car end-time) (car start-time))) + (* .001 (- (cdr end-time) (cdr start-time))))) + (newline) + + return-val)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-file:process-opening-balance-xtn self xtn +;; +;; this gets called for the first transaction after a !Type: tag. +;; +;; if the first transaction after a !Type: tag has a payee of +;; "Opening Balance", we have to massage the transaction a little. +;; The meaning of an OB transaction is "transfer from Equity to the +;; account specified in the L line." idiomatically, ms-money and some +;; others use this transaction instead of an Account record to +;; specify "this" account (the from-account for all following +;; transactions), so we have to allow for that. +;; +;; even if the payee isn't "Opening Balance", we know that if there's +;; no default from-account by this time, we need to set one. In that +;; case, we set the default account based on the file name. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-file:process-opening-balance-xtn self xtn type) + (let ((payee (qif-xtn:payee xtn)) + (category (qif-split:category + (car (qif-xtn:splits xtn)))) + (cat-is-acct? (qif-split:category-is-account? + (car (qif-xtn:splits xtn)))) + (security (qif-xtn:security-name xtn))) + (if (and payee (string? payee) + (not security) + (string=? (string-remove-trailing-space payee) + "Opening Balance") + cat-is-acct?) + ;; this is an explicit "Opening Balance" transaction. we need + ;; to change the category to point to the equity account that + ;; the opening balance comes from. + (begin + (qif-split:set-category! + (car (qif-xtn:splits xtn)) + (default-equity-category)) + (if (eq? (qif-file:default-account self) 'unknown) + (qif-file:set-default-account! self category))) + + ;; it's not an OB transaction. Still set the default + ;; account if there isn't one. + (if (eq? (qif-file:default-account self) 'unknown) + (begin + (qif-file:set-default-account! + self (qif-file:path-to-accountname self)) + (case type + ((type:invst) + (qif-file:set-default-account-type! self GNC-STOCK-TYPE)) + (else + (qif-file:set-default-account-type! self GNC-BANK-TYPE)))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-file:parse-fields self +;; take a previously-read qif file and convert fields +;; from strings to the appropriate type. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-file:parse-fields self) + (let* ((error #f) + (all-ok #f) + (start-time #f) + (end-time #f) + (set-error + (lambda (e) (set! error e))) + (errlist-to-string + (lambda (lst) + (with-output-to-string + (lambda () + (for-each + (lambda (elt) + (display elt)) + lst)))))) + (set! start-time (gettimeofday)) + (and + ;; fields of categories. + (check-and-parse-field + qif-cat:tax-rate qif-cat:set-tax-rate! + qif-parse:check-number-format '(decimal comma) + qif-parse:parse-number/format (qif-file:cats self) + set-error) + + (check-and-parse-field + qif-cat:budget-amt qif-cat:set-budget-amt! + qif-parse:check-number-format '(decimal comma) + qif-parse:parse-number/format (qif-file:cats self) + set-error) + + ;; fields of accounts + (check-and-parse-field + qif-acct:limit qif-acct:set-limit! + qif-parse:check-number-format '(decimal comma) + qif-parse:parse-number/format (qif-file:accounts self) + set-error) + + (check-and-parse-field + qif-acct:budget qif-acct:set-budget! + qif-parse:check-number-format '(decimal comma) + qif-parse:parse-number/format (qif-file:accounts self) + set-error) + + (parse-field + qif-acct:type qif-acct:set-type! + qif-parse:parse-acct-type (qif-file:accounts self) + set-error) + + ;; fields of transactions + (check-and-parse-field + qif-xtn:date qif-xtn:set-date! + qif-parse:check-date-format '(m-d-y d-m-y y-m-d y-d-m) + qif-parse:parse-date/format + (qif-file:xtns self) + set-error) + + (parse-field + qif-xtn:cleared qif-xtn:set-cleared! + qif-parse:parse-cleared-field (qif-file:xtns self) set-error) + + (check-and-parse-field + qif-xtn:share-price qif-xtn:set-share-price! + qif-parse:check-number-format '(decimal comma) + qif-parse:parse-number/format (qif-file:xtns self) + set-error) + + (check-and-parse-field + qif-xtn:num-shares qif-xtn:set-num-shares! + qif-parse:check-number-format '(decimal comma) + qif-parse:parse-number/format (qif-file:xtns self) + set-error) + + (check-and-parse-field + qif-xtn:commission qif-xtn:set-commission! + qif-parse:check-number-format '(decimal comma) + qif-parse:parse-number/format (qif-file:xtns self) + set-error) + + ;; this one's a little tricky... it checks and sets all the + ;; split amounts for the transaction together. + (check-and-parse-field + qif-xtn:split-amounts qif-xtn:set-split-amounts! + qif-parse:check-number-formats '(decimal comma) + qif-parse:parse-numbers/format (qif-file:xtns self) + set-error) + + (begin + (set! all-ok #t) + #t)) + + (set! end-time (gettimeofday)) + (display "QIF string parsing took ") + (display (+ (* 1000 (- (car end-time) (car start-time))) + (* .001 (- (cdr end-time) (cdr start-time))))) + (newline) + + (cond ((list? error) + (list all-ok (errlist-to-string error))) + (error + (list all-ok error)) + (#t #t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; parse-field +;; a simplified version of check-and-parse-field which just calls +;; the parser on every instance of the field in the set of objects +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (parse-field getter setter parser objects errormsg) + (for-each + (lambda (obj) + (let ((unparsed (getter obj))) + (if (and unparsed (string? unparsed)) + (setter obj (parser unparsed))))) + objects) + #t) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; check-and-parse-field +;; +;; this is a semi-generic routine to apply a format check and +;; parsing routine to fields that can have multiple possible +;; formats. In this case, any amount field cam be decimal or +;; comma radix and the date firled can be any of several possible +;; types. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (check-and-parse-field getter setter checker + formats parser objects errormsg) + ;; first find the right format for the field + (let ((do-parsing #f) + (retval #t) + (format #f)) + ;; loop over objects. If the formats list ever gets down + ;; to 1 element, we can stop right there. + (if (not (null? objects)) + (let loop ((current (car objects)) + (rest (cdr objects))) + (let ((val (getter current))) + (if val + (begin + (set! do-parsing #t) + (set! formats (checker val formats))))) + (if (and (not (null? formats)) + (not (null? (cdr formats))) + (not (null? rest))) + (loop (car rest) (cdr rest))))) + + ;; if there's nothing left in formats, there's no format that will + ;; fit all the values for a given field. We have to give up at + ;; that point. If there are multiple items in formats, we just + ;; take the default (first) item in the list. This is not super + ;; great. + (cond + ((null? formats) + (errormsg "Data for number or date does not match a known format.") + (set! retval #f) + (set! do-parsing #f)) + ((and (not (null? (cdr formats))) do-parsing) + ;; there are multiple formats that fit. If they all produce the + ;; same interpretation for every data point in the set, then + ;; just ignore the format ambiguity. Otherwise, it's really an + ;; error. ATM since there's no way to correct the error let's + ;; just leave it be. + (all-formats-equivalent? getter parser formats objects errormsg) + (set! format (car formats))) + (#t + (set! format (car formats)))) + + ;; do-parsing is false if there were no objects with non-#f values + ;; in the field. We would have had to look at all of them once, + ;; but at least not twice. + (if do-parsing + (for-each + (lambda (current) + (let ((val (getter current)) + (parsed #f)) + (if val + (begin + (set! parsed (parser val format)) + (if parsed + (setter current parsed) + (begin + (set! retval #f) + (errormsg + "Data format inconsistent in QIF file."))))))) + objects)) + retval)) + +(define (all-formats-equivalent? getter parser formats objects errormsg) + (let ((all-ok #t)) + (let obj-loop ((objlist objects)) + (let* ((unparsed (getter (car objlist))) + (parsed #f)) + (if (string? unparsed) + (begin + (set! parsed (parser unparsed (car formats))) + (for-each + (lambda (fmt) + (let ((this-parsed (parser unparsed fmt))) + (if (not (equal? parsed this-parsed)) + (begin + (set! all-ok #f) + (errormsg + (list "Parse ambiguity : between formats " + formats "\nValue " unparsed " could be " + parsed " or " this-parsed + "\nand no evidence exists to distinguish." + "\nUsing " parsed ". " + "\nSee help for more info.")))))) + (cdr formats)))) + (if (and all-ok (not (null? (cdr objlist)))) + (obj-loop (cdr objlist))))) + all-ok)) diff --git a/src/scm/qif-import/qif-guess-map.scm b/src/scm/qif-import/qif-guess-map.scm index ddadd9c33b..2dbdbf5c88 100644 --- a/src/scm/qif-import/qif-guess-map.scm +++ b/src/scm/qif-import/qif-guess-map.scm @@ -123,17 +123,19 @@ (lambda (bin) (for-each (lambda (hashpair) - (list-set! (cdr hashpair) 4 0)) + (list-set! (cdr hashpair) 4 0) + (list-set! (cdr hashpair) 5 #f)) bin)) (vector->list acct-map)) (for-each (lambda (bin) (for-each (lambda (hashpair) - (list-set! (cdr hashpair) 4 0)) + (list-set! (cdr hashpair) 4 0) + (list-set! (cdr hashpair) 5 #f)) bin)) (vector->list cat-map)) - + (with-output-to-file pref-filename (lambda () @@ -268,16 +270,17 @@ (define (qif-import:find-new-acct qif-acct allowed-types gnc-map-info) (cond ((and (string? qif-acct) - (string=? qif-acct "Opening Balance")) + (string=? qif-acct (default-equity-account))) (let ((existing-equity - (qif-import:find-similar-acct "Retained Earnings" + (qif-import:find-similar-acct (default-equity-account) (list GNC-EQUITY-TYPE) gnc-map-info))) (if existing-equity (cdr existing-equity) - (list "Retained Earnings" GNC-EQUITY-TYPE)))) + (list (default-equity-account) GNC-EQUITY-TYPE)))) ((and (string? qif-acct) (not (string=? qif-acct ""))) (list qif-acct (car allowed-types))) (#t (list "Unspecified" (car allowed-types))))) + diff --git a/src/scm/qif-import/qif-objects.scm b/src/scm/qif-import/qif-objects.scm index 766873d649..20571e0764 100644 --- a/src/scm/qif-import/qif-objects.scm +++ b/src/scm/qif-import/qif-objects.scm @@ -12,8 +12,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; qif-file class -;; radix-format : one of 'decimal 'comma or 'unspecified -;; date-format : one of 'd-m-y, 'm-d-y, 'y-m-d, 'y-d-m, 'unspecified ;; currency : a string representing the file's currency unit ;; xtns : list of ;; accounts : list of @@ -24,122 +22,97 @@ (define (make-simple-class 'qif-file - '(path ;; where file was loaded - account ;; guessed or specified - account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE - radix-format - guessed-radix-format - date-format - guessed-date-format - y2k-threshold - currency ;; this is a string.. no checking + '(path ;; where file was loaded + default-account ;; guessed or specified default account name + default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE default-acct-xtns + y2k-threshold + currency ;; this is a string.. no checking accts-mentioned xtns + markable-xtns ;; we prune xtns to speed up marking. accounts cats classes))) -(define (qif-file? self) - (eq? (simple-obj-type self) 'qif-file)) +(define qif-file? + (record-predicate )) -(define (qif-file:path self) - (simple-obj-getter self 'path)) +(define qif-file:path + (simple-obj-getter 'path)) -(define (qif-file:account self) - (simple-obj-getter self 'account)) +(define qif-file:default-account + (simple-obj-getter 'default-account)) -(define (qif-file:set-account! self value) - (simple-obj-setter self 'account value)) +(define qif-file:set-default-account! + (simple-obj-setter 'default-account)) -(define (qif-file:account-type self) - (simple-obj-getter self 'account-type)) +(define qif-file:default-account-type + (simple-obj-getter 'default-account-type)) -(define (qif-file:set-account-type! self value) - (simple-obj-setter self 'account-type value)) +(define qif-file:set-default-account-type! + (simple-obj-setter 'default-account-type)) -(define (qif-file:set-path! self value) - (simple-obj-setter self 'path value)) +(define qif-file:set-path! + (simple-obj-setter 'path)) -(define (qif-file:radix-format self) - (simple-obj-getter self 'radix-format)) +(define qif-file:y2k-threshold + (simple-obj-getter 'y2k-threshold)) -(define (qif-file:set-radix-format! self value) - (simple-obj-setter self 'radix-format value)) +(define qif-file:set-y2k-threshold! + (simple-obj-setter 'y2k-threshold)) -(define (qif-file:guessed-radix-format self) - (simple-obj-getter self 'guessed-radix-format)) +(define qif-file:currency + (simple-obj-getter 'currency)) -(define (qif-file:set-guessed-radix-format! self value) - (simple-obj-setter self 'guessed-radix-format value)) +(define qif-file:set-currency! + (simple-obj-setter 'currency)) -(define (qif-file:date-format self) - (simple-obj-getter self 'date-format)) +(define qif-file:default-acct-xtns + (simple-obj-getter 'default-acct-xtns)) -(define (qif-file:set-date-format! self value) - (simple-obj-setter self 'date-format value)) +(define qif-file:set-default-acct-xtns! + (simple-obj-setter 'default-acct-xtns)) -(define (qif-file:guessed-date-format self) - (simple-obj-getter self 'guessed-date-format)) +(define qif-file:accts-mentioned + (simple-obj-getter 'accts-mentioned)) -(define (qif-file:set-guessed-date-format! self value) - (simple-obj-setter self 'guessed-date-format value)) +(define qif-file:set-accts-mentioned! + (simple-obj-setter 'accts-mentioned)) -(define (qif-file:y2k-threshold self) - (simple-obj-getter self 'y2k-threshold)) +(define qif-file:cats + (simple-obj-getter 'cats)) -(define (qif-file:set-y2k-threshold! self value) - (simple-obj-setter self 'y2k-threshold value)) +(define qif-file:set-cats! + (simple-obj-setter 'cats)) -(define (qif-file:currency self) - (simple-obj-getter self 'currency)) +(define qif-file:classes + (simple-obj-getter 'classes)) -(define (qif-file:set-currency! self value) - (simple-obj-setter self 'currency value)) +(define qif-file:set-classes! + (simple-obj-setter 'classes)) -(define (qif-file:default-acct-xtns self) - (simple-obj-getter self 'default-acct-xtns)) +(define qif-file:xtns + (simple-obj-getter 'xtns)) -(define (qif-file:set-default-acct-xtns! self value) - (simple-obj-setter self 'default-acct-xtns value)) +(define qif-file:set-xtns! + (simple-obj-setter 'xtns)) -(define (qif-file:accts-mentioned self) - (simple-obj-getter self 'accts-mentioned)) +(define qif-file:markable-xtns + (simple-obj-getter 'markable-xtns)) -(define (qif-file:set-accts-mentioned! self value) - (simple-obj-setter self 'accts-mentioned value)) +(define qif-file:set-markable-xtns! + (simple-obj-setter 'markable-xtns)) -(define (qif-file:cats self) - (simple-obj-getter self 'cats)) +(define qif-file:accounts + (simple-obj-getter 'accounts)) -(define (qif-file:set-cats! self value) - (simple-obj-setter self 'cats value)) +(define qif-file:set-accounts! + (simple-obj-setter 'accounts)) -(define (qif-file:classes self) - (simple-obj-getter self 'classes)) - -(define (qif-file:set-classes! self value) - (simple-obj-setter self 'classes value)) - -(define (qif-file:xtns self) - (simple-obj-getter self 'xtns)) - -(define (qif-file:set-xtns! self value) - (simple-obj-setter self 'xtns value)) - -(define (qif-file:accounts self) - (simple-obj-getter self 'accounts)) - -(define (qif-file:set-accounts! self value) - (simple-obj-setter self 'accounts value)) - -(define (make-qif-file account radix-format date-format currency) +(define (make-qif-file account currency) (let ((self (make-simple-obj ))) - (qif-file:set-account! self account) - (qif-file:set-radix-format! self radix-format) - (qif-file:set-guessed-radix-format! self radix-format) - (qif-file:set-date-format! self date-format) - (qif-file:set-guessed-date-format! self date-format) + (qif-file:set-default-account! self account) (qif-file:set-currency! self currency) (qif-file:set-y2k-threshold! self 50) (qif-file:set-default-acct-xtns! self 0) @@ -160,8 +133,11 @@ 'qif-split '(category class memo amount category-is-account? matching-cleared mark))) -(define (qif-split:category self) - (simple-obj-getter self 'category)) +(define qif-split:category + (simple-obj-getter 'category)) + +(define qif-split:set-category-private! + (simple-obj-setter 'category)) (define (qif-split:set-category! self value) (let* ((cat-info @@ -169,53 +145,51 @@ (cat-name (list-ref cat-info 0)) (is-account? (list-ref cat-info 1)) (class-name (list-ref cat-info 2))) - (simple-obj-setter self 'category cat-name) - (simple-obj-setter self 'class class-name) - (simple-obj-setter self 'category-is-account? is-account?))) -; (if (not is-account?) -; (simple-obj-setter self 'mark #t)))) + (qif-split:set-category-private! self cat-name) + (qif-split:set-class! self class-name) + (qif-split:set-category-is-account?! self is-account?))) -(define (qif-split:class self) - (simple-obj-getter self 'class)) +(define qif-split:class + (simple-obj-getter 'class)) -(define (qif-split:set-class! self value) - (simple-obj-setter self 'class value)) +(define qif-split:set-class! + (simple-obj-setter 'class)) -(define (qif-split:memo self) - (simple-obj-getter self 'memo)) +(define qif-split:memo + (simple-obj-getter 'memo)) -(define (qif-split:set-memo! self value) - (simple-obj-setter self 'memo value)) +(define qif-split:set-memo! + (simple-obj-setter 'memo)) -(define (qif-split:amount self) - (simple-obj-getter self 'amount)) +(define qif-split:amount + (simple-obj-getter 'amount)) -(define (qif-split:set-amount! self value) - (simple-obj-setter self 'amount value)) +(define qif-split:set-amount! + (simple-obj-setter 'amount)) -(define (qif-split:mark self) - (simple-obj-getter self 'mark)) +(define qif-split:mark + (simple-obj-getter 'mark)) -(define (qif-split:set-mark! self value) - (simple-obj-setter self 'mark value)) +(define qif-split:set-mark! + (simple-obj-setter 'mark)) -(define (qif-split:matching-cleared self) - (simple-obj-getter self 'matching-cleared)) +(define qif-split:matching-cleared + (simple-obj-getter 'matching-cleared)) -(define (qif-split:set-matching-cleared! self value) - (simple-obj-setter self 'matching-cleared value)) +(define qif-split:set-matching-cleared! + (simple-obj-setter 'matching-cleared)) -(define (qif-split:category-is-account? self) - (simple-obj-getter self 'category-is-account?)) +(define qif-split:category-is-account? + (simple-obj-getter 'category-is-account?)) -(define (qif-split:set-category-is-account?! self value) - (simple-obj-setter self 'category-is-account? value)) +(define qif-split:set-category-is-account?! + (simple-obj-setter 'category-is-account?)) (define (make-qif-split) (let ((self (make-simple-obj ))) (qif-split:set-category! self "") self)) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -228,7 +202,7 @@ ;; [I] share price : parsed ;; [Q] number of shares ;; [Y] name of security -;; [O] adjustment (parsed) +;; [O] commission (parsed) ;; [L] category : string ;; [S]/[E]/[$] splits : a list of ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -237,158 +211,104 @@ (make-simple-class 'qif-xtn '(date payee address number cleared - from-acct share-price num-shares security-name adjustment - splits bank-xtn? mark))) + from-acct share-price num-shares security-name commission + splits mark))) -(define (qif-xtn? self) - (eq? (simple-obj-type self) 'qif-xtn)) +(define qif-xtn? + (record-predicate )) -(define (qif-xtn:date self) - (simple-obj-getter self 'date)) +(define qif-xtn:date + (simple-obj-getter 'date)) -(define (qif-xtn:set-date! self value) - (simple-obj-setter self 'date value)) +(define qif-xtn:set-date! + (simple-obj-setter 'date)) -(define (qif-xtn:payee self) - (simple-obj-getter self 'payee)) +(define qif-xtn:payee + (simple-obj-getter 'payee)) -(define (qif-xtn:set-payee! self value) - (simple-obj-setter self 'payee value)) +(define qif-xtn:set-payee! + (simple-obj-setter 'payee)) -(define (qif-xtn:address self) - (simple-obj-getter self 'address)) +(define qif-xtn:address + (simple-obj-getter 'address)) -(define (qif-xtn:set-address! self value) - (simple-obj-setter self 'address value)) +(define qif-xtn:set-address! + (simple-obj-setter 'address)) -(define (qif-xtn:number self) - (simple-obj-getter self 'number)) +(define qif-xtn:number + (simple-obj-getter 'number)) -(define (qif-xtn:set-number! self value) - (simple-obj-setter self 'number value)) +(define qif-xtn:set-number! + (simple-obj-setter 'number)) -(define (qif-xtn:cleared self) - (simple-obj-getter self 'cleared)) +(define qif-xtn:cleared + (simple-obj-getter 'cleared)) -(define (qif-xtn:set-cleared! self value) - (simple-obj-setter self 'cleared value)) +(define qif-xtn:set-cleared! + (simple-obj-setter 'cleared)) -(define (qif-xtn:from-acct self) - (simple-obj-getter self 'from-acct)) +(define qif-xtn:from-acct + (simple-obj-getter 'from-acct)) -(define (qif-xtn:set-from-acct! self value) - (simple-obj-setter self 'from-acct value)) +(define qif-xtn:set-from-acct! + (simple-obj-setter 'from-acct)) -(define (qif-xtn:share-price self) - (simple-obj-getter self 'share-price)) +(define qif-xtn:share-price + (simple-obj-getter 'share-price)) -(define (qif-xtn:set-share-price! self value) - (simple-obj-setter self 'share-price value)) +(define qif-xtn:set-share-price! + (simple-obj-setter 'share-price)) -(define (qif-xtn:num-shares self) - (simple-obj-getter self 'num-shares)) +(define qif-xtn:num-shares + (simple-obj-getter 'num-shares)) -(define (qif-xtn:set-num-shares! self value) - (simple-obj-setter self 'num-shares value)) +(define qif-xtn:set-num-shares! + (simple-obj-setter 'num-shares)) -(define (qif-xtn:security-name self) - (simple-obj-getter self 'security-name)) +(define qif-xtn:security-name + (simple-obj-getter 'security-name)) -(define (qif-xtn:set-security-name! self value) - (simple-obj-setter self 'security-name value)) +(define qif-xtn:set-security-name! + (simple-obj-setter 'security-name)) -(define (qif-xtn:adjustment self) - (simple-obj-getter self 'adjustment)) +(define qif-xtn:commission + (simple-obj-getter 'commission)) -(define (qif-xtn:set-adjustment! self value) - (simple-obj-setter self 'adjustment value)) +(define qif-xtn:set-commission! + (simple-obj-setter 'commission)) -(define (qif-xtn:splits self) - (simple-obj-getter self 'splits)) +(define qif-xtn:splits + (simple-obj-getter 'splits)) -(define (qif-xtn:set-splits! self value) - (simple-obj-setter self 'splits value)) +(define qif-xtn:set-splits! + (simple-obj-setter 'splits)) -(define (qif-xtn:mark self) - (simple-obj-getter self 'mark)) +(define qif-xtn:mark + (simple-obj-getter 'mark)) -(define (qif-xtn:set-mark! self value) - (simple-obj-setter self 'mark value)) - -(define (qif-xtn:bank-xtn? self) - (simple-obj-getter self 'bank-xtn?)) - -(define (qif-xtn:set-bank-xtn?! self value) - (simple-obj-setter self 'bank-xtn? value)) +(define qif-xtn:set-mark! + (simple-obj-setter 'mark)) (define (make-qif-xtn) (let ((self (make-simple-obj ))) - (qif-xtn:set-bank-xtn?! self #t) (qif-xtn:set-mark! self #f) (qif-xtn:set-splits! self '()) self)) -(define (qif-xtn:reparse self qif-file) - (let ((reparse-ok #t)) - ;; share price - (if (string? (qif-xtn:share-price self)) - (qif-xtn:set-share-price! - self - (qif-file:parse-value qif-file (qif-xtn:share-price self)))) - - ;; number of shares - (if (string? (qif-xtn:num-shares self)) - (qif-xtn:set-num-shares! - self - (qif-file:parse-value qif-file (qif-xtn:num-shares self)))) - - ;; adjustment - (if (string? (qif-xtn:adjustment self)) - (qif-xtn:set-adjustment! - self - (qif-file:parse-value qif-file (qif-xtn:adjustment self)))) - - (if (or (string? (qif-xtn:share-price self)) - (string? (qif-xtn:num-shares self)) - (string? (qif-xtn:adjustment self))) - (begin - (display "qif-import: failed to reparse stock info") - (newline) - (qif-xtn:print self) - (set! reparse-ok - (list #f "Could not autodetect radix format.")))) - - ;; reparse the amount of each split - (for-each - (lambda (split) - (if (string? (qif-split:amount split)) - (qif-split:set-amount! - split - (qif-file:parse-value qif-file (qif-split:amount split)))) - (if (string? (qif-split:amount split)) - (begin - (display "qif-import: failed to reparse value") - (write (qif-split:amount split)) (newline) - (set! reparse-ok - (list #f "Could not autodetect radix format."))))) - (qif-xtn:splits self)) - - ;; reparse the date - (if (string? (qif-xtn:date self)) - (qif-xtn:set-date! self - (qif-file:parse-date qif-file - (qif-xtn:date self)))) - (if (string? (qif-xtn:date self)) - (begin - (display "qif-import: failed to reparse date ") - (write (qif-xtn:date self)) (newline) - (set! reparse-ok - (list #f "Could not autodetect date format.")))) - reparse-ok)) - (define (qif-xtn:print self) - (simple-obj-print self )) + (simple-obj-print self)) +(define (qif-xtn:split-amounts self) + (map + (lambda (split) + (qif-split:amount split)) + (qif-xtn:splits self))) + +(define (qif-xtn:set-split-amounts! self amounts) + (map + (lambda (split amount) + (qif-split:set-amount! split amount)) + (qif-xtn:splits self) amounts)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -402,54 +322,44 @@ 'qif-acct '(name type description limit budget))) -(define (qif-acct:name self) - (simple-obj-getter self 'name)) +(define qif-acct:name + (simple-obj-getter 'name)) -(define (qif-acct:set-name! self value) - (simple-obj-setter self 'name value)) +(define qif-acct:set-name! + (simple-obj-setter 'name)) -(define (qif-acct:type self) - (simple-obj-getter self 'type)) +(define qif-acct:type + (simple-obj-getter 'type)) -(define (qif-acct:set-type! self value) - (simple-obj-setter self 'type value)) +(define qif-acct:set-type! + (simple-obj-setter 'type)) -(define (qif-acct:description self) - (simple-obj-getter self 'description)) +(define qif-acct:description + (simple-obj-getter 'description)) -(define (qif-acct:set-description! self value) - (simple-obj-setter self 'description value)) +(define qif-acct:set-description! + (simple-obj-setter 'description)) -(define (qif-acct:limit self) - (simple-obj-getter self 'limit)) +(define qif-acct:limit + (simple-obj-getter 'limit)) -(define (qif-acct:set-limit! self value) - (simple-obj-setter self 'limit value)) +(define qif-acct:set-limit! + (simple-obj-setter 'limit)) -(define (qif-acct:budget self) - (simple-obj-getter self 'budget)) +(define qif-acct:budget + (simple-obj-getter 'budget)) -(define (qif-acct:set-budget! self value) - (simple-obj-setter self 'budget value)) +(define qif-acct:set-budget! + (simple-obj-setter 'budget)) (define (make-qif-acct) (make-simple-obj )) -(define (qif-acct? self) - (eq? (simple-obj-type self) 'qif-acct)) +(define qif-acct? + (record-predicate )) (define (qif-acct:print self) - (simple-obj-print self )) - -(define (qif-acct:reparse self file) - (if (string? (qif-acct:limit self)) - (qif-acct:set-limit! - self (qif-file:parse-value file (qif-acct:limit self)))) - (if (or (string? (qif-acct:limit self)) - (string? (qif-acct:type self))) - (list #f "Could not autodetect radix for fields in Account record") - #t)) - + (simple-obj-print self)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -462,26 +372,26 @@ 'qif-class '(name description))) -(define (qif-class:name self) - (simple-obj-getter self 'name)) +(define qif-class:name + (simple-obj-getter 'name)) -(define (qif-class:set-name! self value) - (simple-obj-setter self 'name value)) +(define qif-class:set-name! + (simple-obj-setter 'name)) -(define (qif-class:description self) - (simple-obj-getter self 'description)) +(define qif-class:description + (simple-obj-getter 'description)) -(define (qif-class:set-description! self value) - (simple-obj-setter self 'description value)) +(define qif-class:set-description! + (simple-obj-setter 'description)) (define (qif-class:print self) - (simple-obj-print self )) + (simple-obj-print self)) (define (make-qif-class) (make-simple-obj )) -(define (qif-class? self) - (eq? (simple-obj-type self) 'qif-class)) +(define qif-class? + (record-predicate )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; : a "Cat" or category transaction @@ -500,71 +410,56 @@ 'qif-cat '(name description taxable expense-cat income-cat tax-rate budget-amt))) -(define (qif-cat:name self) - (simple-obj-getter self 'name)) +(define qif-cat:name + (simple-obj-getter 'name)) -(define (qif-cat:set-name! self value) - (simple-obj-setter self 'name value)) +(define qif-cat:set-name! + (simple-obj-setter 'name)) -(define (qif-cat:description self) - (simple-obj-getter self 'description)) +(define qif-cat:description + (simple-obj-getter 'description)) -(define (qif-cat:set-description! self value) - (simple-obj-setter self 'description value)) +(define qif-cat:set-description! + (simple-obj-setter 'description)) -(define (qif-cat:taxable self) - (simple-obj-getter self 'taxable)) +(define qif-cat:taxable + (simple-obj-getter 'taxable)) -(define (qif-cat:set-taxable! self value) - (simple-obj-setter self 'taxable value)) +(define qif-cat:set-taxable! + (simple-obj-setter 'taxable)) -(define (qif-cat:expense-cat self) - (simple-obj-getter self 'expense-cat)) +(define qif-cat:expense-cat + (simple-obj-getter 'expense-cat)) -(define (qif-cat:set-expense-cat! self value) - (simple-obj-setter self 'expense-cat value)) +(define qif-cat:set-expense-cat! + (simple-obj-setter 'expense-cat)) -(define (qif-cat:income-cat self) - (simple-obj-getter self 'income-cat)) +(define qif-cat:income-cat + (simple-obj-getter 'income-cat)) -(define (qif-cat:set-income-cat! self value) - (simple-obj-setter self 'income-cat value)) +(define qif-cat:set-income-cat! + (simple-obj-setter 'income-cat)) -(define (qif-cat:tax-rate self) - (simple-obj-getter self 'tax-rate)) +(define qif-cat:tax-rate + (simple-obj-getter 'tax-rate)) -(define (qif-cat:set-tax-rate! self value) - (simple-obj-setter self 'tax-rate value)) +(define qif-cat:set-tax-rate! + (simple-obj-setter 'tax-rate)) -(define (qif-cat:budget-amt self) - (simple-obj-getter self 'budget-amt)) +(define qif-cat:budget-amt + (simple-obj-getter 'budget-amt)) -(define (qif-cat:set-budget-amt! self value) - (simple-obj-setter self 'budget-amt value)) +(define qif-cat:set-budget-amt! + (simple-obj-setter 'budget-amt)) (define (make-qif-cat) (make-simple-obj )) -(define (qif-cat? obj) - (eq? (simple-obj-type obj) 'qif-cat)) +(define qif-cat? + (record-predicate )) (define (qif-cat:print self) - (simple-obj-print self )) - -(define (qif-cat:reparse self file) - (if (string? (qif-cat:tax-rate self)) - (qif-cat:set-tax-rate! - self (qif-file:parse-value file (qif-cat:tax-rate self)))) - - (if (string? (qif-cat:budget-amt self)) - (qif-cat:set-budget-amt! - self (qif-file:parse-value file (qif-cat:budget-amt self)))) - - (if (or (string? (qif-cat:tax-rate self)) - (string? (qif-cat:budget-amt self))) - (list #f "Could not autodetect radix for fields in Category record") - #t)) - + (simple-obj-print self)) (define (qif-file:add-xtn! self xtn) (let ((from (qif-xtn:from-acct xtn))) @@ -574,11 +469,11 @@ self (cons from (qif-file:accts-mentioned self)))) (let ((defs (qif-file:default-acct-xtns self))) (qif-file:set-default-acct-xtns! self (+ 1 defs)) - (if (and (eq? 0 defs) - (not (member (qif-file:account self) + (if (and (eq? 0 defs) + (not (member (qif-file:default-account self) (qif-file:accts-mentioned self)))) (qif-file:set-accts-mentioned! - self (cons (qif-file:account self) + self (cons (qif-file:default-account self) (qif-file:accts-mentioned self))))))) (for-each (lambda (split) diff --git a/src/scm/qif-import/qif-parse.scm b/src/scm/qif-import/qif-parse.scm index 5c2260a4e8..d9921446fb 100644 --- a/src/scm/qif-import/qif-parse.scm +++ b/src/scm/qif-import/qif-parse.scm @@ -8,6 +8,22 @@ (gnc:support "qif-import/qif-parse.scm") +(define qif-category-compiled-rexp + (make-regexp "^ *(\\[)?([^]/]*)(]?)(/?)(.*) *$")) + +(define qif-date-compiled-rexp + (make-regexp "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+).*$")) + +(define decimal-radix-regexp + (make-regexp + "^ *\\$?-?\\$?[0-9]+$|^ *\\$?-?\\$?[0-9]?[0-9]?[0-9]?(,[0-9][0-9][0-9])*(\\.[0-9]*)? *$|^ *\\$?-?\\$?[0-9]+\\.[0-9]* *$")) + +(define comma-radix-regexp + (make-regexp + "^ *\\$?-?\\$?[0-9]+$|^ *\\$?-?\\$?[0-9]?[0-9]?[0-9]?(\\.[0-9][0-9][0-9])*(,[0-9]*) *$|^ *\\$?-?\\$?[0-9]+,[0-9]* *$")) + +(define integer-regexp (make-regexp "^\\$?-?\\$?[0-9]+ *$")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; qif-split:parse-category ;; this one just gets nastier and nastier. @@ -18,9 +34,6 @@ ;; gosh, I love regular expressions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define qif-category-compiled-rexp - (make-regexp "(\\[)?([^]/]*)(]?)(/?)(.*)")) - (define (qif-split:parse-category self value) (let ((match (regexp-exec qif-category-compiled-rexp value))) (if match @@ -36,15 +49,16 @@ (display "qif-split:parse-category : can't parse ") (display value) (newline) (list "" #f #f))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; qif-file:fix-year +;; qif-parse:fix-year ;; this is where we handle y2k fixes etc. input is a string ;; containing the year ("00", "2000", and "19100" all mean the same ;; thing). output is an integer representing the year in the C.E. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (qif-file:fix-year self year-string) +(define (qif-parse:fix-year year-string y2k-threshold) (let ((fixed-string #f) (post-read-value #f) (y2k-fixed-value #f)) @@ -70,7 +84,7 @@ ;; 2-digit numbers less than the window size are interpreted to ;; be post-2000. ((and (integer? post-read-value) - (< post-read-value (qif-file:y2k-threshold self))) + (< post-read-value y2k-threshold)) (set! y2k-fixed-value (+ 2000 post-read-value))) ;; there's a common bug in printing post-2000 dates that @@ -109,7 +123,7 @@ ;; conventions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (qif-file:parse-acct-type self read-value) +(define (qif-parse:parse-acct-type read-value) (let ((mangled-string (string-downcase! (string-remove-trailing-space (string-remove-leading-space read-value))))) @@ -120,8 +134,8 @@ GNC-CASH-TYPE) ((string=? mangled-string "ccard") GNC-CCARD-TYPE) - ((string=? mangled-string "invst") - GNC-STOCK-TYPE) + ((string=? mangled-string "invst") ;; these are brokerage accounts. + GNC-BANK-TYPE) ((string=? mangled-string "oth a") GNC-ASSET-TYPE) ((string=? mangled-string "oth l") @@ -129,20 +143,20 @@ ((string=? mangled-string "mutual") GNC-MUTUAL-TYPE) (#t - (display "qif-file:parse-acct-type : unhandled account type ") + (display "qif-parse:parse-acct-type : unhandled account type ") (display read-value) (display "... substituting Bank.") GNC-BANK-TYPE)))) -(define (qif-file:state-to-account-type self qstate) +(define (qif-parse:state-to-account-type qstate) (cond ((eq? qstate 'type:bank) GNC-BANK-TYPE) ((eq? qstate 'type:cash) GNC-CASH-TYPE) ((eq? qstate 'type:ccard) GNC-CCARD-TYPE) - ((eq? qstate 'type:invst) - GNC-STOCK-TYPE) + ((eq? qstate 'type:invst) ;; these are brokerage accounts in quicken + GNC-BANK-TYPE) ((eq? qstate '#{type:oth\ a}#) GNC-ASSET-TYPE) ((eq? qstate '#{type:oth\ l}#) @@ -153,19 +167,62 @@ ;; the qif file. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (qif-file:parse-bang-field self read-value) +(define (qif-parse:parse-bang-field read-value) (string->symbol (string-downcase! (string-remove-trailing-space read-value)))) +(define (qif-parse:parse-action-field read-value) + (let ((action-symbol (string-to-canonical-symbol read-value))) + (case action-symbol + ;; buy + ((buy kauf) + 'buy) + ((buyx kaufx) + 'buyx) + ((sell) ;; verkaufen + 'sell) + ((sellx) + 'sellx) + ((div) ;; dividende + 'div) + ((divx) + 'divx) + ((intinc aktzu) ;; zinsen + 'intinc) + ((intincx) + 'intincx) + ((cglong) ;; Kapitalgewinnsteuer + 'cglong) + ((cglongx) + 'cglongx) + ((cgshort) + 'cgshort) + ((cgshortx) + 'cgshortx) + ((shrsin) + 'shrsin) + ((reinvdiv) + 'reinvdiv) + ((reinvint) + 'reinvint) + ((reinvsg) + 'reinvsg) + ((reinvsh) + 'reinvsh) + ((reinvlg reinvkur) + 'reinvlg) + (else + action-symbol)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; parse-cleared-field : in a C (cleared) field in a QIF transaction, ;; * means cleared, x or X means reconciled, and ! or ? mean some ;; budget related stuff I don't understand. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (qif-file:parse-cleared-field self read-value) - +(define (qif-parse:parse-cleared-field read-value) (if (and (string? read-value) (> (string-length read-value) 0)) (let ((secondchar (string-ref read-value 0))) @@ -183,35 +240,87 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; qif-file:parse-date -;; -;; If the date format is specified, use that; otherwise, try to guess -;; the format. When the format is being guessed, I don't actually do -;; any translation to a numeric format; that's saved for a second -;; pass (calling qif-bank-xtn:reparse on every transaction) +;; qif-parse:check-date-format +;; given a list of possible date formats, return a pruned list +;; of possibilities. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (qif-file:parse-date self date-string) - (if (or (not (string? date-string)) - (not (> (string-length date-string) 0))) - (begin - (display "qif-import: very bogus QIF date in transaction.") (newline) - (display "qif-import: Substituting 1/1/2999 for date.") (newline) - (set! date-string "1/1/2999"))) +(define (qif-parse:check-date-format date-string possible-formats) + (let ((retval #f)) + (if (or (not (string? date-string)) + (not (> (string-length date-string) 0))) + (set! retval possible-formats)) + (let ((date-parts '()) + (numeric-date-parts '()) + (match (regexp-exec qif-date-compiled-rexp date-string))) + + (if match + (set! date-parts (list (match:substring match 1) + (match:substring match 2) + (match:substring match 3)))) + + ;; get the strings into numbers (but keep the strings around) + (set! numeric-date-parts + (map (lambda (elt) + (with-input-from-string elt + (lambda () (read)))) + date-parts)) + + (let ((possibilities possible-formats) + (n1 (car numeric-date-parts)) + (n2 (cadr numeric-date-parts)) + (n3 (caddr numeric-date-parts))) + + ;; filter the possibilities to eliminate (hopefully) + ;; all but one + (if (or (not (number? n1)) (> n1 12)) + (set! possibilities (delq 'm-d-y possibilities))) + (if (or (not (number? n1)) (> n1 31)) + (set! possibilities (delq 'd-m-y possibilities))) + (if (or (not (number? n1)) (< n1 1)) + (set! possibilities (delq 'd-m-y possibilities))) + (if (or (not (number? n1)) (< n1 1)) + (set! possibilities (delq 'm-d-y possibilities))) + + (if (or (not (number? n2)) (> n2 12)) + (begin + (set! possibilities (delq 'd-m-y possibilities)) + (set! possibilities (delq 'y-m-d possibilities)))) + + (if (or (not (number? n2)) (> n2 31)) + (begin + (set! possibilities (delq 'm-d-y possibilities)) + (set! possibilities (delq 'y-d-m possibilities)))) + + (if (or (not (number? n3)) (> n3 12)) + (set! possibilities (delq 'y-d-m possibilities))) + (if (or (not (number? n3)) (> n3 31)) + (set! possibilities (delq 'y-m-d possibilities))) + + (if (or (not (number? n3)) (< n3 1)) + (set! possibilities (delq 'y-m-d possibilities))) + (if (or (not (number? n3)) (< n3 1)) + (set! possibilities (delq 'y-d-m possibilities))) + (set! retval possibilities)) + retval))) - (set! date-string (string-remove-trailing-space date-string)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-parse:parse-date-format +;; given a list of possible date formats, return a pruned list +;; of possibilities. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-parse:parse-date/format date-string format) (let ((date-parts '()) (numeric-date-parts '()) (retval date-string) - (match - (string-match "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+) *$" - date-string))) + (match (regexp-exec qif-date-compiled-rexp date-string))) (if match (set! date-parts (list (match:substring match 1) (match:substring match 2) (match:substring match 3)))) - + ;; get the strings into numbers (but keep the strings around) (set! numeric-date-parts (map (lambda (elt) @@ -219,162 +328,67 @@ (lambda () (read)))) date-parts)) - (cond - ;; if the date parts list doesn't have 3 parts, we're in - ;; trouble - ((not (eq? 3 (length date-parts))) - (begin - (display "qif-file:parse-date : can't interpret date ") - (display date-string) (display " ") (write date-parts)(newline))) - - ;; if the format is unknown, don't try to fully interpret the - ;; number, just look for a good guess or an inconsistency with - ;; the current guess. - ((and (eq? (qif-file:date-format self) 'unknown) - (not (eq? (qif-file:guessed-date-format self) - 'inconsistent))) - (cond - ;; we currently think the date format is m/d/y - ((eq? (qif-file:guessed-date-format self) 'm-d-y) - (let ((m (car numeric-date-parts)) - (d (cadr numeric-date-parts))) - (if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31)) - (qif-file:set-guessed-date-format! self 'inconsistent)))) - - ;; current guess is d/m/y - ((eq? (qif-file:guessed-date-format self) 'd-m-y) - (let ((d (car numeric-date-parts)) - (m (cadr numeric-date-parts))) - (if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31)) - (qif-file:set-guessed-date-format! self 'inconsistent)))) - - ;; current guess is y/m/d - ((eq? (qif-file:guessed-date-format self) 'y-m-d) - (let ((m (cadr numeric-date-parts)) - (d (caddr numeric-date-parts))) - (if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31)) - (qif-file:set-guessed-date-format! self 'inconsistent)))) - - ;; current guess is y/d/m (is this really possible?) - ((eq? (qif-file:guessed-date-format self) 'y-d-m) - (let ((d (cadr numeric-date-parts)) - (m (caddr numeric-date-parts))) - (if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31)) - (qif-file:set-guessed-date-format! self 'inconsistent)))) - - ;; no guess currently. See if we can find a smoking gun in - ;; the date format. For dates like 11-9-11 just don't try to - ;; guess. - ((eq? (qif-file:guessed-date-format self) 'unknown) - (let ((possibilities '(m-d-y d-m-y y-m-d y-d-m)) - (n1 (car numeric-date-parts)) - (n2 (cadr numeric-date-parts)) - (n3 (caddr numeric-date-parts))) - - ;; filter the possibilities to eliminate (hopefully) - ;; all but one - (if (or (not (number? n1)) (> n1 12)) - (set! possibilities (delq 'm-d-y possibilities))) - (if (or (not (number? n1)) (> n1 31)) - (set! possibilities (delq 'd-m-y possibilities))) - (if (or (not (number? n1)) (< n1 1)) - (set! possibilities (delq 'd-m-y possibilities))) - (if (or (not (number? n1)) (< n1 1)) - (set! possibilities (delq 'm-d-y possibilities))) - - (if (or (not (number? n2)) (> n2 12)) - (begin - (set! possibilities (delq 'd-m-y possibilities)) - (set! possibilities (delq 'y-m-d possibilities)))) - - (if (or (not (number? n2)) (> n2 31)) - (begin - (set! possibilities (delq 'm-d-y possibilities)) - (set! possibilities (delq 'y-d-m possibilities)))) - - (if (or (not (number? n3)) (> n3 12)) - (set! possibilities (delq 'y-d-m possibilities))) - (if (or (not (number? n3)) (> n3 31)) - (set! possibilities (delq 'y-m-d possibilities))) - - (if (or (not (number? n3)) (< n3 1)) - (set! possibilities (delq 'y-m-d possibilities))) - (if (or (not (number? n3)) (< n3 1)) - (set! possibilities (delq 'y-d-m possibilities))) - + ;; if the date parts list doesn't have 3 parts, we're in + ;; trouble + (if (not (eq? 3 (length date-parts))) + (begin + (display "qif-parse:parse-date-format : can't interpret date ") + (display date-string) (display " ") (write date-parts)(newline)) + + (case format + ((d-m-y) + (let ((d (car numeric-date-parts)) + (m (cadr numeric-date-parts)) + (y (qif-parse:fix-year (caddr date-parts) 50))) + (if (and (integer? d) (integer? m) (integer? y) + (<= m 12) (<= d 31)) + (set! retval (list d m y)) + (begin + (display "qif-parse:parse-date-format : ") + (display "format is d/m/y, but date is ") + (display date-string) (newline))))) - ;; if there's exactly one possibility left, we've got a good - ;; guess. if there are no possibilities left, the date - ;; is somehow inconsistent. More than one, do nothing. - (cond ((eq? (length possibilities) 1) - (qif-file:set-guessed-date-format! self (car possibilities))) - ((eq? (length possibilities) 0) - (display "qif-file:parse-date : can't interpret date ") - (display date-string) - (newline) - (qif-file:set-guessed-date-format! self 'inconsistent))))))) - - ;; we think we know the date format. Make sure the data is - ;; consistent with that. - ((eq? (qif-file:date-format self) 'd-m-y) - (let ((d (car numeric-date-parts)) - (m (cadr numeric-date-parts)) - (y (qif-file:fix-year self (caddr date-parts)))) - (if (and (integer? d) (integer? m) (integer? y) - (<= m 12) (<= d 31)) - (set! retval (list d m y)) - (begin - (display "qif-file:parse-date : format is d/m/y, but date is ") - (display date-string) (newline))))) - - ((eq? (qif-file:date-format self) 'm-d-y) - (let ((m (car numeric-date-parts)) - (d (cadr numeric-date-parts)) - (y (qif-file:fix-year self (caddr date-parts)))) - (if (and (integer? d) (integer? m) (integer? y) - (<= m 12) (<= d 31)) - (set! retval (list d m y)) - (begin - (display "qif-file:parse-date : format is m/d/y, but date is ") - (display date-string) (newline))))) - - ((eq? (qif-file:date-format self) 'y-m-d) - (let ((y (qif-file:fix-year self (car date-parts))) - (m (cadr numeric-date-parts)) - (d (caddr numeric-date-parts)))) - (if (and (integer? d) (integer? m) (integer? y) - (<= m 12) (<= d 31)) - (set! retval (list d m y)) - (begin - (display "qif-file:parse-date : format is y/m/d, but date is ") - (display date-string) (newline)))) - - ((eq? (qif-file:date-format self) 'y-d-m) - (let ((y (qif-file:fix-year self (car date-parts))) - (d (cadr numeric-date-parts)) - (m (caddr numeric-date-parts)))) - (if (and (integer? d) (integer? m) (integer? y) - (<= m 12) (<= d 31)) - (set! retval (list d m y)) - (begin - (display "qif-file:parse-date : format is y/m/d, but date is ") - (display date-string) (newline))))) + ((m-d-y) + (let ((m (car numeric-date-parts)) + (d (cadr numeric-date-parts)) + (y (qif-parse:fix-year (caddr date-parts) 50))) + (if (and (integer? d) (integer? m) (integer? y) + (<= m 12) (<= d 31)) + (set! retval (list d m y)) + (begin + (display "qif-parse:parse-date-format : ") + (display " format is m/d/y, but date is ") + (display date-string) (newline))))) + + ((y-m-d) + (let ((y (qif-parse:fix-year (car date-parts) 50)) + (m (cadr numeric-date-parts)) + (d (caddr numeric-date-parts))) + (if (and (integer? d) (integer? m) (integer? y) + (<= m 12) (<= d 31)) + (set! retval (list d m y)) + (begin + (display "qif-parse:parse-date-format :") + (display " format is y/m/d, but date is ") + (display date-string) (newline))))) + + ((y-d-m) + (let ((y (qif-parse:fix-year (car date-parts) 50)) + (d (cadr numeric-date-parts)) + (m (caddr numeric-date-parts))) + (if (and (integer? d) (integer? m) (integer? y) + (<= m 12) (<= d 31)) + (set! retval (list d m y)) + (begin + (display "qif-parse:parse-date-format : ") + (display " format is y/m/d, but date is ") + (display date-string) (newline))))))) retval)) -(define (qif-file:parse-string self str) - (if (or (not (string? str)) - (not (> (string-length str) 0))) - (set! str " ")) - (string-remove-leading-space (string-remove-trailing-space str))) - -(define decimal-radix-regexp - (make-regexp - "^\\$?-?\\$?[0-9]+$|^\\$?-?\\$?[0-9]?[0-9]?[0-9]?(,?[0-9][0-9][0-9])*(\\.[0-9]*)?$")) - -(define comma-radix-regexp - (make-regexp - "^\\$?-?\\$?[0-9]+$|^\\$?-?\\$?[0-9]?[0-9]?[0-9]?(\\.?[0-9][0-9][0-9])*(,[0-9]*)?$")) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; number format predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (value-is-decimal-radix? value) (if (regexp-exec decimal-radix-regexp value) @@ -384,92 +398,87 @@ (if (regexp-exec comma-radix-regexp value) #t #f)) -(define (qif-file:parse-value/decimal self value-string) - (set! value-string (string-remove-trailing-space value-string)) - (if (value-is-decimal-radix? value-string) - (let ((read-val - (with-input-from-string - (string-remove-char - (string-remove-char value-string #\,) - #\$) - (lambda () (read))))) - (if (number? read-val) - (+ 0.0 read-val) - #f)) - #f)) +(define (value-is-integer? value) + (if (regexp-exec integer-regexp value) + #t #f)) -(define (qif-file:parse-value/comma self value-string) - (set! value-string (string-remove-trailing-space value-string)) - (if (value-is-comma-radix? value-string) - (let ((read-val - (with-input-from-string - (string-remove-char - (string-replace-char! - (string-remove-char value-string #\.) - #\, #\.) - #\$) - (lambda () (read))))) - (if (number? read-val) - (+ 0.0 read-val) - #f)) - #f)) -(define (qif-file:parse-value self value-string) - (if (or (not (string? value-string)) - (not (> (string-length value-string) 0))) - (set! value-string "0") - (set! value-string (string-remove-leading-space - (string-remove-trailing-space value-string)))) - - (let ((possibly-comma-radix? (value-is-comma-radix? value-string)) - (possibly-decimal-radix? (value-is-decimal-radix? value-string))) - - (if (and (eq? (qif-file:radix-format self) 'unknown) - (not (eq? (qif-file:guessed-radix-format self) 'inconsistent))) - (cond - ;; already think it's decimal - ((eq? (qif-file:guessed-radix-format self) 'decimal) - (if (and possibly-comma-radix? - (not possibly-decimal-radix?)) - (begin - (qif-file:set-guessed-radix-format! self 'inconsistent) - (display "this QIF file has inconsistent radix notation!") - (newline)))) - - ;; already think it's comma - ((eq? (qif-file:guessed-radix-format self) 'comma) - (if (and possibly-decimal-radix? - (not possibly-comma-radix?)) - (begin - (qif-file:set-guessed-radix-format! self 'inconsistent) - (display "this QIF file has inconsistent radix notation!") - (newline)))) - - ;; don't know : look for numbers that are giveaways. - ((eq? (qif-file:guessed-radix-format self) 'unknown) - (cond ((and possibly-decimal-radix? - (not possibly-comma-radix?)) - (qif-file:set-guessed-radix-format! self 'decimal)) - ((and possibly-comma-radix? - (not possibly-decimal-radix?)) - (qif-file:set-guessed-radix-format! self 'comma)))))) - (cond - ((eq? (qif-file:radix-format self) 'decimal) - (if possibly-decimal-radix? - (qif-file:parse-value/decimal self value-string) - (begin - (display "Format is decimal-radix, but number is") - (write value-string) - (newline) - 0.0))) - ((eq? (qif-file:radix-format self) 'comma) - (if possibly-comma-radix? - (qif-file:parse-value/comma self value-string) - (begin - (display "Format is comma-radix, but number is") - (write value-string) - (newline) - 0.0))) - (#t - value-string)))) - +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-parse:check-number-format +;; given a list of possible number formats, return a pruned list +;; of possibilities. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-parse:check-number-format value-string possible-formats) + (let ((retval possible-formats)) + (if (not (value-is-decimal-radix? value-string)) + (set! retval (delq 'decimal retval))) + (if (not (value-is-comma-radix? value-string)) + (set! retval (delq 'comma retval))) + (if (not (value-is-integer? value-string)) + (set! retval (delq 'integer retval))) + retval)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-parse:parse-number/format +;; assuming we know what the format is, parse the string. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-parse:parse-number/format value-string format) + (case format + ((decimal) + (let ((read-val + (with-input-from-string + (string-remove-char + (string-remove-char value-string #\,) + #\$) + (lambda () (read))))) + (if (number? read-val) + (+ 0.0 read-val) + #f))) + ((comma) + (let ((read-val + (with-input-from-string + (string-remove-char + (string-replace-char! + (string-remove-char value-string #\.) + #\, #\.) + #\$) + (lambda () (read))))) + (if (number? read-val) + (+ 0.0 read-val) + #f))) + ((integer) + (let ((read-val + (with-input-from-string + (string-remove-char value-string #\$) + (lambda () (read))))) + (if (number? read-val) + (+ 0.0 read-val) + #f))))) + +(define (qif-parse:check-number-formats amt-strings formats) + (let ((retval formats)) + (for-each + (lambda (amt) + (set! retval (qif-parse:check-number-format amt retval))) + amt-strings) + retval)) + +(define (qif-parse:parse-numbers/format amt-strings format) + (let* ((all-ok #t) + (tmp #f) + (parsed + (map + (lambda (amt) + (if amt + (begin + (set! tmp (qif-parse:parse-number/format amt format)) + (if (not tmp) + (set! all-ok #f)) + tmp) + 0.0)) + amt-strings))) + (if all-ok parsed #f))) + diff --git a/src/scm/qif-import/qif-to-gnc.scm b/src/scm/qif-import/qif-to-gnc.scm index 7de1ad86a5..9f058762d4 100644 --- a/src/scm/qif-import/qif-to-gnc.scm +++ b/src/scm/qif-import/qif-to-gnc.scm @@ -52,7 +52,7 @@ (gnc:account-begin-edit new-acct 1) ;; if this is a copy of an existing gnc account, - ;; copy the account properties +2 ;; copy the account properties (if (not make-new-acct) (begin (gnc:account-set-name @@ -99,9 +99,9 @@ (gnc:account-set-description new-acct (qif-cat:description qif-info))) ((and (qif-xtn? qif-info) - (not (qif-xtn:bank-xtn? qif-info))) + (qif-xtn:security-name qif-info)) (gnc:account-set-security - (qif-xtn:security-name qif-info))) + new-acct (qif-xtn:security-name qif-info))) ((string? qif-info) (gnc:account-set-description new-acct qif-info))))) @@ -191,20 +191,28 @@ bin)) (vector->list qif-cat-map)) + ;; before trying to mark transactions, prune down the list of + ;; ones to match. + (for-each + (lambda (qif-file) + (let ((markable-xtns '())) + (for-each + (lambda (xtn) + (let splitloop ((splits (qif-xtn:splits xtn))) + (if (qif-split:category-is-account? (car splits)) + (set! markable-xtns (cons xtn markable-xtns)) + (if (not (null? (cdr splits))) + (splitloop (cdr splits)))))) + (qif-file:xtns qif-file)) + (qif-file:set-markable-xtns! qif-file markable-xtns))) + qif-files-list) + ;; iterate over files. Going in the sort order by number of ;; transactions should give us a small speed advantage. (for-each (lambda (qif-file) - (display "Importing QIF xtns from ") - (display (qif-file:path qif-file)) (newline) - (display "Accounts mentioned: ") - (write (qif-file:accts-mentioned qif-file)) (newline) - - ;; within the file, iterate over transactions. key things to - ;; remember: if the L line in the transaction is a category, - ;; it's a single-entry xtn and no need to look for the other - ;; end. if it's an account, search for a QIF file with that - ;; account name and find the xtn to mark. + ;; iterate over markable transactions. The non-transfer + ;; ones are already weeded out. (for-each (lambda (xtn) (if (not (qif-xtn:mark xtn)) @@ -243,6 +251,7 @@ (gnc:merge-accounts account-group) (gnc:refresh-main-window))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; qif-import:qif-xtn-to-gnc-xtn ;; translate a single transaction to a set of gnucash splits and @@ -258,148 +267,197 @@ (qif-acct-map (cadr mapping-data)) (near-acct-info #f) (near-acct-name #f) - (near-acct #f)) + (near-acct #f) + (currency (qif-file:currency qif-file)) + (qif-payee (qif-xtn:payee qif-xtn)) + (qif-number (qif-xtn:number qif-xtn)) + (qif-security (qif-xtn:security-name qif-xtn)) + (qif-memo (qif-split:memo (car (qif-xtn:splits qif-xtn)))) + (qif-from-acct (qif-xtn:from-acct qif-xtn)) + (qif-cleared (qif-xtn:cleared qif-xtn))) + + (if (not qif-security) + (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 + ;; category. + (if qif-from-acct + (set! near-acct-info + (hash-ref qif-acct-map + qif-from-acct)) + (set! near-acct-info + (hash-ref qif-acct-map + (qif-file:default-account qif-file)))) + (set! near-acct-name + (list-ref near-acct-info 1)) + (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 + (lambda (qif-split) + (let ((gnc-far-split (gnc:split-create)) + (far-acct-info #f) + (far-acct-name #f) + (far-acct-type #f) + (far-acct #f) + (split-amt (qif-split:amount qif-split)) + (memo (qif-split:memo qif-split))) + + ;; fill the splits in (near first). This handles files in + ;; multiple currencies by pulling the currency value from the + ;; file import. + (set! near-split-total (+ near-split-total split-amt)) + (gnc:split-set-base-value gnc-far-split (- split-amt) currency) + + (if memo (gnc:split-set-memo gnc-far-split memo)) + + (if (qif-split:category-is-account? qif-split) + (set! far-acct-info + (hash-ref qif-acct-map + (qif-split:category qif-split))) + (set! far-acct-info + (hash-ref qif-cat-map + (qif-split:category qif-split)))) + (set! far-acct-name + (list-ref far-acct-info 1)) + (set! far-acct (hash-ref gnc-acct-hash far-acct-name)) + + ;; set the reconcile status. I thought I could set using + ;; the quicken type, but it looks like #\r reconcile + ;; states aren't preserved across gnucash save/restores. + (let ((cleared (qif-split:matching-cleared qif-split))) + (if (or (eq? 'cleared cleared) + (eq? 'reconciled cleared)) + (gnc:split-set-reconcile gnc-far-split #\c))) + + ;; finally, plug the split into the account + (gnc:transaction-append-split gnc-xtn gnc-far-split) + (gnc:account-insert-split far-acct gnc-far-split))) + splits) + + ;; the value of the near split is the total of the far splits. + (gnc:split-set-base-value gnc-near-split near-split-total currency) + (gnc:transaction-append-split gnc-xtn gnc-near-split) + (gnc:account-insert-split near-acct gnc-near-split)) + + + ;; 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 + ;; also be an interest, dividend, or SG/LG account. + (let ((action-sym (qif-parse:parse-action-field qif-number)) + (share-price (qif-xtn:share-price qif-xtn)) + (num-shares (qif-xtn:num-shares qif-xtn)) + (split-amt (qif-split:amount (car (qif-xtn:splits qif-xtn)))) + (qif-near-acct #f) + (qif-far-acct #f) + (far-acct-info #f) + (far-acct-name #f) + (far-acct #f) + (gnc-far-split (gnc:split-create))) + + ;; I don't think this should ever happen, but I want + ;; to keep this check just in case. + (if (> (length splits) 1) + (begin + (display "qif-import:qif-xtn-to-gnc-xtn : ") + (display "splits in stock transaction!") (newline))) + + ;; the near split: where is the money going TO? + (case action-sym + ((buy buyx sell sellx reinvdiv reinvsg reinvsh reinvlg shrsin) + (set! qif-near-acct qif-security)) + ((div cgshort cglong intinc) + (set! qif-near-acct (qif-xtn:from-acct qif-xtn))) + ((divx cgshortx cglongx intincx) + (set! qif-near-acct + (qif-split:category (car (qif-xtn:splits qif-xtn))))) + (else + (display "HEY! HEY! action-sym = ") + (display action-sym) (newline))) + + ;; the far split: where is the money coming from? + (case action-sym + ((buy sell) + (set! qif-far-acct (qif-xtn:from-acct qif-xtn))) + ((buyx sellx) + (set! qif-far-acct + (qif-split:category (car (qif-xtn:splits qif-xtn))))) + ((cgshort cgshortx reinvsg reinvsh) + (set! qif-far-acct + (default-cgshort-acct qif-security))) + ((cglong cglongx reinvlg) + (set! qif-far-acct + (default-cglong-acct qif-security))) + ((intinc intincx reinvint) + (set! qif-far-acct + (default-interest-acct qif-security))) + ((div divx reinvdiv) + (set! qif-far-acct + (default-dividend-acct qif-security))) + ((shrsin) + (set! qif-far-acct + (default-equity-account))) + (else + (display "HEY! HEY! action-sym = ") + (display action-sym) (newline))) + + ;; the amounts and signs: are shares going in or out? + ;; are amounts currency or shares? + (case action-sym + ((buy buyx reinvdiv reinvsg reinvsh reinvlg shrsin) + (gnc:split-set-share-price gnc-near-split share-price) + (gnc:split-set-share-price gnc-far-split share-price) + (gnc:split-set-share-amount gnc-near-split num-shares) + (gnc:split-set-share-amount gnc-far-split (- num-shares))) + ((sell sellx) + (gnc:split-set-share-price gnc-near-split share-price) + (gnc:split-set-share-price gnc-far-split share-price) + (gnc:split-set-share-amount gnc-near-split (- num-shares)) + (gnc:split-set-share-amount gnc-far-split num-shares)) + ((cgshort cgshortx cglong cglongx intinc intincx div divx) + (gnc:split-set-base-value gnc-near-split split-amt currency) + (gnc:split-set-base-value gnc-far-split (- split-amt) currency))) + + (set! near-acct-info + (hash-ref qif-acct-map qif-near-acct)) + (set! near-acct-name + (list-ref near-acct-info 1)) + (set! near-acct (hash-ref gnc-acct-hash near-acct-name)) + + (set! far-acct-info + (hash-ref qif-acct-map qif-far-acct)) + (set! far-acct-name + (list-ref far-acct-info 1)) + (set! far-acct (hash-ref gnc-acct-hash far-acct-name)) + + (let ((cleared (qif-split:matching-cleared + (car (qif-xtn:splits qif-xtn))))) + (if (or (eq? 'cleared cleared) + (eq? 'reconciled cleared)) + (gnc:split-set-reconcile gnc-far-split #\c))) + + (gnc:transaction-append-split gnc-xtn gnc-near-split) + (gnc:account-insert-split near-acct gnc-near-split) + + (gnc:transaction-append-split gnc-xtn gnc-far-split) + (gnc:account-insert-split far-acct gnc-far-split))) ;; set properties of the whole transaction (apply gnc:transaction-set-date gnc-xtn (qif-xtn:date qif-xtn)) - (if (qif-xtn:payee qif-xtn) - (gnc:transaction-set-description gnc-xtn (qif-xtn:payee qif-xtn))) - (if (qif-xtn:number qif-xtn) - (gnc:transaction-set-xnum gnc-xtn (qif-xtn:number qif-xtn))) - - ;; find the GNC account for the near end of the transaction - (if (qif-xtn:bank-xtn? qif-xtn) - (begin - (if (qif-xtn:from-acct qif-xtn) - (set! near-acct-info - (hash-ref qif-acct-map - (qif-xtn:from-acct qif-xtn))) - (set! near-acct-info - (hash-ref qif-acct-map - (qif-file:account qif-file)))) - (set! near-acct-name - (list-ref near-acct-info 1)) - (set! near-acct (hash-ref gnc-acct-hash near-acct-name))) - (begin - (set! near-acct-info - (hash-ref qif-acct-map - (qif-xtn:security-name qif-xtn))) - (set! near-acct-name - (list-ref near-acct-info 1)) - (set! near-acct (hash-ref gnc-acct-hash near-acct-name)))) + (if qif-payee + (gnc:transaction-set-description gnc-xtn qif-payee)) + (if qif-number + (gnc:transaction-set-xnum gnc-xtn qif-number)) + (if qif-memo + (gnc:split-set-memo gnc-near-split qif-memo)) - (if (qif-split:memo (car (qif-xtn:splits qif-xtn))) - (gnc:split-set-memo gnc-near-split - (qif-split:memo (car (qif-xtn:splits qif-xtn))))) - - (let ((cleared (qif-xtn:cleared qif-xtn))) - (if (or - (eq? 'cleared cleared) - (eq? 'reconciled cleared)) - (gnc:split-set-reconcile gnc-near-split #\c))) - - ;; iterate over QIF splits - (for-each - (lambda (qif-split) - (let ((gnc-far-split (gnc:split-create)) - (far-acct-info #f) - (far-acct-name #f) - (far-acct-type #f) - (far-acct #f) - (split-amt (qif-split:amount qif-split)) - (currency (qif-file:currency qif-file)) - (memo (qif-split:memo qif-split))) - - ;; fill the splits in (near first). This handles files in - ;; multiple currencies by pulling the currency value from the - ;; file import. - (set! near-split-total - (+ near-split-total split-amt)) - (gnc:split-set-base-value gnc-far-split - (- split-amt) currency) - - (if memo - (begin - (gnc:split-set-memo gnc-far-split memo))) - - ;; my guess is that you can't have Quicken splits - ;; on stock transactions. This will break if you can. - (if (qif-xtn:share-price qif-xtn) - (begin - (if (> (length splits) 1) - (begin - (display "qif-import:qif-xtn-to-gnc-xtn : ") - (display "splits in stock transaction!") (newline))) - (let ((price (qif-xtn:share-price qif-xtn))) - (gnc:split-set-share-price gnc-near-split price) - (gnc:split-set-share-price gnc-far-split price))) - (begin - (gnc:split-set-share-price gnc-near-split 1.0) - (gnc:split-set-share-price gnc-far-split 1.0))) - - (if (qif-xtn:num-shares qif-xtn) - (let ((numshares (qif-xtn:num-shares qif-xtn))) - (if (> (length splits) 1) - (begin - (display "qif-import:qif-xtn-to-gnc-xtn : ") - (display "splits in stock transaction!") (newline))) - - (gnc:split-set-share-amount gnc-near-split numshares) - (gnc:split-set-share-amount gnc-far-split (- numshares)))) - - ;; find the GNC account on the far end of the split - (cond - ;; this is a stock xtn with no specified category, which - ;; generally means this account is a brokerage account - ;; description. - ((and (not (qif-xtn:bank-xtn? qif-xtn)) - (string=? (qif-split:category qif-split) "")) - (set! far-acct-info - (hash-ref qif-acct-map - (qif-file:account qif-file))) - (set! far-acct-name - (list-ref far-acct-info 1)) - (set! far-acct (hash-ref gnc-acct-hash far-acct-name))) - - ;; this is a normal stock or bank transfer to another - ;; account - ((qif-split:category-is-account? qif-split) - (set! far-acct-info - (hash-ref qif-acct-map - (qif-split:category qif-split))) - (set! far-acct-name - (list-ref far-acct-info 1)) - (set! far-acct (hash-ref gnc-acct-hash far-acct-name))) - - ;; otherwise the category is a category and won't have a - ;; matching split in the QIF world. - (#t - (set! far-acct-info - (hash-ref qif-cat-map - (qif-split:category qif-split))) - (set! far-acct-name - (list-ref far-acct-info 1)) - (set! far-acct (hash-ref gnc-acct-hash far-acct-name)))) - - ;; set the reconcile status. I thought I could set using - ;; the quicken type, but it looks like #\r reconcile - ;; states aren't preserved across gnucash save/restores. - (let ((cleared (qif-split:matching-cleared qif-split))) - (if (or (eq? 'cleared cleared) - (eq? 'reconciled cleared)) - (gnc:split-set-reconcile gnc-far-split #\c))) - - ;; finally, plug the splits into the accounts - (gnc:transaction-append-split gnc-xtn gnc-far-split) - (gnc:account-insert-split far-acct gnc-far-split))) - splits) - - (gnc:split-set-base-value gnc-near-split - near-split-total - (qif-file:currency qif-file)) - (gnc:transaction-append-split gnc-xtn gnc-near-split) - (gnc:account-insert-split near-acct gnc-near-split) + (if (or (eq? qif-cleared 'cleared) + (eq? qif-cleared 'reconciled)) + (gnc:split-set-reconcile gnc-near-split #\c)) ;; return the modified transaction (though it's ignored). gnc-xtn)) @@ -428,15 +486,16 @@ (date (qif-xtn:date xtn)) (amount (- (qif-split:amount split))) (memo (qif-split:memo split)) - (bank-xtn? (qif-xtn:bank-xtn? xtn)) + (bank-xtn? (not (qif-xtn:security-name xtn))) (cleared? #f) (done #f)) - + + ;; FIXME security stuff (if bank-xtn? (let ((near (qif-xtn:from-acct xtn))) (if near (set! near-acct-name near) - (set! near-acct-name (qif-file:account qif-file)))) + (set! near-acct-name (qif-file:default-account qif-file)))) (set! near-acct-name (qif-xtn:security-name xtn))) ;; (display "mark-matching-split : near-acct = ") @@ -462,7 +521,7 @@ ;; (string=? far-acct-name ;; (qif-file:account (car files))))) - (let xtn-loop ((xtns (qif-file:xtns (car files)))) + (let xtn-loop ((xtns (qif-file:markable-xtns (car files)))) (if (not (qif-xtn:mark (car xtns))) (let split-loop ((splits (qif-xtn:splits (car xtns)))) (if (qif-split:split-matches? diff --git a/src/scm/qif-import/qif-utils.scm b/src/scm/qif-import/qif-utils.scm index b89455776d..0d70b9a056 100644 --- a/src/scm/qif-import/qif-utils.scm +++ b/src/scm/qif-import/qif-utils.scm @@ -23,9 +23,6 @@ (make-regexp "^ *([^ ].*)$")) (define (string-remove-trailing-space str) - (if (eq? (string-ref str (- (string-length str) 1)) #\cr) - (string-set! str (- (string-length str) 1) #\space)) - (let ((match (regexp-exec remove-trailing-space-rexp str))) (if match (string-copy (match:substring match 1)) @@ -76,3 +73,8 @@ (set! parts (cons (substring str 0 last-char) parts)))) parts)) +(define (string-to-canonical-symbol str) + (string->symbol + (string-downcase + (string-remove-leading-space + (string-remove-trailing-space str))))) \ No newline at end of file diff --git a/src/scm/qif-import/simple-obj.scm b/src/scm/qif-import/simple-obj.scm index 45eee3baa1..e5b070a094 100644 --- a/src/scm/qif-import/simple-obj.scm +++ b/src/scm/qif-import/simple-obj.scm @@ -25,77 +25,20 @@ ;; the 'simple-class' class. (define (make-simple-class class-symbol slot-names) - (let ((slots (make-vector 3)) - (slot-hash (make-hash-table 11)) - (slot-counter 0)) - (vector-set! slots 0 class-symbol) - (vector-set! slots 1 slot-hash) - (vector-set! slots 2 slot-names) - (for-each - (lambda (elt) - (hash-set! slot-hash elt slot-counter) - (set! slot-counter (+ 1 slot-counter))) - slot-names) - (cons 'simple-class slots))) + (make-record-type (symbol->string class-symbol) slot-names)) -(define (simple-class? self) - (and (pair? self) (eq? (car self) 'simple-class))) +(define (simple-obj-getter class slot) + (record-accessor class slot)) -(define (simple-obj-getter obj class slot) - (let ((slot-num (hash-ref (vector-ref (cdr class) 1) slot))) - (vector-ref (cdr obj) slot-num))) +(define (simple-obj-setter class slot) + (record-modifier class slot)) -;; (if (and (pair? obj) -;; (simple-class? class)) -;; (if (eq? (vector-ref (cdr class) 0) (car obj)) -;; (let ((slot-num-pair (assq slot (vector-ref (cdr class) 1)))) -;; (if slot-num-pair -;; (if (vector? (cdr obj)) -;; (vector-ref (cdr obj) (cdr slot-num-pair)) -;; (error "simple-obj-getter: data field not a vector??")) -;; (error "simple-obj-getter: no slot " slot " in class " -;; class))) -;; (error "simple-obj-getter: object " obj " is not of class " -;; class)) -;; (error "simple-obj-getter: bad object/class " obj class))) - -(define (simple-obj-setter obj class slot value) - (let ((slot-num (hash-ref (vector-ref (cdr class) 1) slot))) - (vector-set! (cdr obj) slot-num value))) - -;; (if (and (pair? obj) -;; (simple-class? class)) -;; (if (eq? (vector-ref (cdr class) 0) (car obj)) -;; (let ((slot-num-pair (assq slot (vector-ref (cdr class) 1)))) -;; (if slot-num-pair -;; (if (vector? (cdr obj)) -;; (vector-set! (cdr obj) (cdr slot-num-pair) value) -;; (error "simple-obj-setter: data field not a vector??")) -;; (error "simple-obj-setter: no slot " slot " in class " -;; class))) -;; (error "simple-obj-setter: object " obj " is not of class " -;; class)) -;; (error "simple-obj-setter: bad object/class " obj class))) - - -(define (simple-obj-print obj class) - (display ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;") (newline) - (for-each - (lambda (slot) - (display " ") - (display slot) - (display " : ") - (write (simple-obj-getter obj class slot)) - (newline)) - (vector-ref (cdr class) 2))) - -(define (simple-obj-type obj) - (if (pair? obj) - (car obj) - #f)) +(define (simple-obj-print obj) + (write obj)) (define (make-simple-obj class) - (if (simple-class? class) - (cons (vector-ref (cdr class) 0) - (make-vector (length (vector-ref (cdr class) 2)) #f)))) - + (let ((ctor (record-constructor class)) + (field-defaults + (map (lambda (v) #f) (record-type-fields class)))) + (apply ctor field-defaults))) + diff --git a/src/scm/report/transaction-report-2.scm b/src/scm/report/transaction-report-2.scm index ac82c27efd..5d35c11085 100644 --- a/src/scm/report/transaction-report-2.scm +++ b/src/scm/report/transaction-report-2.scm @@ -12,8 +12,24 @@ (let () (define string-db (gnc:make-string-database)) + (define (make-account-subheading acc-name from-date) + (let* ((separator (string-ref (gnc:account-separator-char) 0)) + (balance-at-start (gnc:account-get-balance-at-date + (gnc:get-account-from-full-name + (gnc:get-current-group) + acc-name + separator) + from-date + #f))) + (string-append acc-name + " (" + (string-db 'lookup 'open-bal-string) + " " + (gnc:amount->formatted-string balance-at-start #f) + ")" + ))) - (define (make-split-report-spec options) + (define (make-split-report-spec options) (remove-if-not (lambda (x) x) (list @@ -221,7 +237,7 @@ #f) #f)))) - (define (split-report-get-sort-spec-entry key ascending?) + (define (split-report-get-sort-spec-entry key ascending? begindate) (case key ((account) (make-report-sort-spec @@ -230,7 +246,7 @@ (if ascending? string-ci?) string-ci=? string-ci=? - (lambda (x) x))) + (lambda (x) (make-account-subheading x begindate)))) ((date) (make-report-sort-spec @@ -336,7 +352,7 @@ ((amount) (make-report-sort-spec - gnc:split-get-amount + gnc:split-get-value (if ascending? < >) = #f @@ -585,10 +601,12 @@ (car (gnc:option-value enddate)))) (s1 (split-report-get-sort-spec-entry (gnc:option-value tr-report-primary-key-op) - (eq? (gnc:option-value tr-report-primary-order-op) 'ascend))) + (eq? (gnc:option-value tr-report-primary-order-op) 'ascend) + (gnc:option-value begindate))) (s2 (split-report-get-sort-spec-entry (gnc:option-value tr-report-secondary-key-op) - (eq? (gnc:option-value tr-report-secondary-order-op) 'ascend))) + (eq? (gnc:option-value tr-report-secondary-order-op) 'ascend) + (gnc:option-value begindate))) (s2b (if s2 (list s2) '())) (sort-specs (if s1 (cons s1 s2b) s2b)) (split-list @@ -641,6 +659,7 @@ (string-db 'store 'debit-string "Debit") (string-db 'store 'credit-string "Credit") (string-db 'store 'total-string "Total") + (string-db 'store 'open-bal-string "Opening Balance") (gnc:define-report 'version 1