IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Bug #511182: Commodity mapping preferences are now preserved correctly. In

Browse Source 
addition, use of the misleading term "stock" has been replaced by "security"
throughout the C code. Also includes a small fix to prevent passing a null
pointer to xaccAccountGetType(), which caused some critical warnings to be
logged. Some comment and whitespace cleanup as well.
BP


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@17074 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Charles Day 2008-04-10 20:37:41 +00:00
parent f034c41dfb
commit 54d94702d5
4 changed files with 326 additions and 290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
src/import-export/qif-import/druid-qif-import.c
View File

@ -118,8 +118,9 @@ struct _qifimportwindow {
SCM memo_display_info; SCM memo_display_info;
SCM gnc_acct_info; SCM gnc_acct_info;
SCM stock_hash; SCM security_hash;
SCM new_stocks; SCM security_prefs;
SCM new_securities;
SCM ticker_map; SCM ticker_map;
SCM imported_account_tree; SCM imported_account_tree;
@ -192,8 +193,9 @@ gnc_ui_qif_import_druid_destroy (QIFImportWindow * window)
scm_gc_unprotect_object(window->memo_map_info); scm_gc_unprotect_object(window->memo_map_info);
scm_gc_unprotect_object(window->acct_display_info); scm_gc_unprotect_object(window->acct_display_info);
scm_gc_unprotect_object(window->acct_map_info); scm_gc_unprotect_object(window->acct_map_info);
scm_gc_unprotect_object(window->stock_hash); scm_gc_unprotect_object(window->security_hash);
scm_gc_unprotect_object(window->new_stocks); scm_gc_unprotect_object(window->security_prefs);
scm_gc_unprotect_object(window->new_securities);
scm_gc_unprotect_object(window->ticker_map); scm_gc_unprotect_object(window->ticker_map);
scm_gc_unprotect_object(window->imported_account_tree); scm_gc_unprotect_object(window->imported_account_tree);
scm_gc_unprotect_object(window->match_transactions); scm_gc_unprotect_object(window->match_transactions);
@ -240,7 +242,7 @@ get_next_druid_page(QIFImportWindow * wind, GnomeDruidPage * page)
next = current->next; next = current->next;
while (!next || while (!next ||
(!wind->show_doc_pages && g_list_find(wind->doc_pages, next->data)) || (!wind->show_doc_pages && g_list_find(wind->doc_pages, next->data)) ||
(wind->new_stocks == SCM_BOOL_F && (wind->new_securities == SCM_BOOL_F &&
GNOME_DRUID_PAGE(next->data) == get_named_page(wind, "commodity_doc_page"))) { GNOME_DRUID_PAGE(next->data) == get_named_page(wind, "commodity_doc_page"))) {
if(next && next->next) { if(next && next->next) {
next = next->next; next = next->next;
@ -316,7 +318,7 @@ get_prev_druid_page(QIFImportWindow * wind, GnomeDruidPage * page)
* (c) the page is commodity related and the are no new commodities. */ * (c) the page is commodity related and the are no new commodities. */
while (!prev || while (!prev ||
(!wind->show_doc_pages && g_list_find(wind->doc_pages, prev->data)) || (!wind->show_doc_pages && g_list_find(wind->doc_pages, prev->data)) ||
(wind->new_stocks == SCM_BOOL_F && (wind->new_securities == SCM_BOOL_F &&
GNOME_DRUID_PAGE(prev->data) == get_named_page(wind, "commodity_doc_page"))) { GNOME_DRUID_PAGE(prev->data) == get_named_page(wind, "commodity_doc_page"))) {
/* We're either out of pages for this stage, or we've reached /* We're either out of pages for this stage, or we've reached
* an optional doc page that shouldn't be shown. */ * an optional doc page that shouldn't be shown. */
@ -333,7 +335,7 @@ get_prev_druid_page(QIFImportWindow * wind, GnomeDruidPage * page)
prev = g_list_last(wind->pre_comm_pages); prev = g_list_last(wind->pre_comm_pages);
break; break;
case 2: case 2:
if(wind->new_stocks != SCM_BOOL_F) { if(wind->new_securities != SCM_BOOL_F) {
prev = g_list_last(wind->commodity_pages); prev = g_list_last(wind->commodity_pages);
} }
else { else {
@ -1349,7 +1351,7 @@ gnc_ui_qif_import_commodity_update(QIFImportWindow * wind)
* each reference to the "old" commodity with a reference to the commodity * each reference to the "old" commodity with a reference to the commodity
* returned by gnc_commodity_table_insert? */ * returned by gnc_commodity_table_insert? */
if (old_commodity != page->commodity) if (old_commodity != page->commodity)
scm_hash_remove_x(wind->stock_hash, scm_makfrom0str(fullname)); scm_hash_remove_x(wind->security_hash, scm_makfrom0str(fullname));
} }
} }
@ -1456,7 +1458,7 @@ gnc_ui_qif_import_convert(QIFImportWindow * wind)
wind->acct_map_info, wind->acct_map_info,
wind->cat_map_info, wind->cat_map_info,
wind->memo_map_info, wind->memo_map_info,
wind->stock_hash, wind->security_hash,
scm_makfrom0str(currname), scm_makfrom0str(currname),
window), window),
SCM_EOL); SCM_EOL);
@ -1546,26 +1548,27 @@ static gboolean
gnc_ui_qif_import_new_securities(QIFImportWindow * wind) gnc_ui_qif_import_new_securities(QIFImportWindow * wind)
{ {
SCM updates; SCM updates;
SCM update_stock = scm_c_eval_string("qif-import:update-stock-hash"); SCM update_securities = scm_c_eval_string("qif-import:update-security-hash");
/* Get a list of any new QIF securities since the previous call. */ /* Get a list of any new QIF securities since the previous call. */
updates = scm_call_3(update_stock, wind->stock_hash, updates = scm_call_3(update_securities, wind->security_hash,
wind->ticker_map, wind->acct_map_info); wind->ticker_map, wind->acct_map_info);
if (updates != SCM_BOOL_F) if (updates != SCM_BOOL_F)
{ {
/* A list of new QIF securities was returned. Save it. */ /* A list of new QIF securities was returned. Save it. */
scm_gc_unprotect_object(wind->new_stocks); scm_gc_unprotect_object(wind->new_securities);
if (wind->new_stocks != SCM_BOOL_F) if (wind->new_securities != SCM_BOOL_F)
/* There is an existing list, so append the new list. */ /* There is an existing list, so append the new list. */
wind->new_stocks = scm_append(scm_list_2(wind->new_stocks, updates)); wind->new_securities = scm_append(scm_list_2(wind->new_securities,
updates));
else else
wind->new_stocks = updates; wind->new_securities = updates;
scm_gc_protect_object(wind->new_stocks); scm_gc_protect_object(wind->new_securities);
return TRUE; return TRUE;
} }
if (wind->new_stocks != SCM_BOOL_F) if (wind->new_securities != SCM_BOOL_F)
return TRUE; return TRUE;
return FALSE; return FALSE;
@ -1592,7 +1595,7 @@ gnc_ui_qif_import_memo_next_cb(GnomeDruidPage * page,
return gnc_ui_qif_import_generic_next_cb(page, arg1, wind); return gnc_ui_qif_import_generic_next_cb(page, arg1, wind);
else else
{ {
/* if we need to look at stocks, do that, otherwise import /* If we need to look at securities do that; otherwise import
xtns and go to the duplicates page */ xtns and go to the duplicates page */
if (gnc_ui_qif_import_new_securities(wind)) if (gnc_ui_qif_import_new_securities(wind))
{ {
@ -1728,7 +1731,7 @@ gnc_ui_qif_import_comm_check_cb(GnomeDruidPage * page,
/******************************************************************** /********************************************************************
* gnc_ui_qif_import_commodity_prepare_cb * gnc_ui_qif_import_commodity_prepare_cb
* build a mapping of QIF stock name to a gnc_commodity * build a mapping of QIF security name to gnc_commodity
********************************************************************/ ********************************************************************/
static void static void
@ -1739,7 +1742,7 @@ gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
QIFImportWindow * wind = user_data; QIFImportWindow * wind = user_data;
SCM hash_ref = scm_c_eval_string("hash-ref"); SCM hash_ref = scm_c_eval_string("hash-ref");
SCM stocks; SCM securities;
SCM comm_ptr_token; SCM comm_ptr_token;
GList * current; GList * current;
@ -1748,7 +1751,7 @@ gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
QIFDruidPage * new_page; QIFDruidPage * new_page;
/* This shouldn't happen, but do the right thing if it does. */ /* This shouldn't happen, but do the right thing if it does. */
if (wind->new_stocks == SCM_BOOL_F || SCM_NULLP(wind->new_stocks)) if (wind->new_securities == SCM_BOOL_F || SCM_NULLP(wind->new_securities))
{ {
g_warning("QIF import: BUG DETECTED! Reached commodity doc page with nothing to do!"); g_warning("QIF import: BUG DETECTED! Reached commodity doc page with nothing to do!");
gnc_ui_qif_import_convert(wind); gnc_ui_qif_import_convert(wind);
@ -1759,9 +1762,9 @@ gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
* Make druid pages for each new QIF security. * Make druid pages for each new QIF security.
*/ */
gnc_set_busy_cursor(NULL, TRUE); gnc_set_busy_cursor(NULL, TRUE);
stocks = wind->new_stocks; securities = wind->new_securities;
current = wind->commodity_pages; current = wind->commodity_pages;
while (!SCM_NULLP(stocks) && (stocks != SCM_BOOL_F)) while (!SCM_NULLP(securities) && (securities != SCM_BOOL_F))
{ {
if (current) if (current)
{ {
@ -1773,8 +1776,8 @@ gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
{ {
/* Get the GnuCash commodity corresponding to the new QIF security. */ /* Get the GnuCash commodity corresponding to the new QIF security. */
comm_ptr_token = scm_call_2(hash_ref, comm_ptr_token = scm_call_2(hash_ref,
wind->stock_hash, wind->security_hash,
SCM_CAR(stocks)); SCM_CAR(securities));
#define FUNC_NAME "make_qif_druid_page" #define FUNC_NAME "make_qif_druid_page"
commodity = SWIG_MustGetPtr(comm_ptr_token, commodity = SWIG_MustGetPtr(comm_ptr_token,
SWIG_TypeQuery("_p_gnc_commodity"), 1, 0); SWIG_TypeQuery("_p_gnc_commodity"), 1, 0);
@ -1801,7 +1804,7 @@ gnc_ui_qif_import_commodity_prepare_cb(GnomeDruidPage * page,
gtk_widget_show_all(new_page->page); gtk_widget_show_all(new_page->page);
} }
stocks = SCM_CDR(stocks); securities = SCM_CDR(securities);
} }
gnc_unset_busy_cursor(NULL); gnc_unset_busy_cursor(NULL);
@ -2086,8 +2089,9 @@ gnc_ui_qif_import_finish_cb(GnomeDruidPage * gpage,
/* Save the user's mapping preferences. */ /* Save the user's mapping preferences. */
scm_apply(save_map_prefs, scm_apply(save_map_prefs,
SCM_LIST4(wind->acct_map_info, wind->cat_map_info, SCM_LIST5(wind->acct_map_info, wind->cat_map_info,
wind->memo_map_info, wind->stock_hash), wind->memo_map_info, wind->security_hash,
wind->security_prefs),
SCM_EOL); SCM_EOL);
/* Open an account tab in the main window if one doesn't exist already. */ /* Open an account tab in the main window if one doesn't exist already. */
@ -2283,8 +2287,8 @@ gnc_ui_qif_import_druid_make(void)
retval->acct_map_info = SCM_BOOL_F; retval->acct_map_info = SCM_BOOL_F;
retval->memo_display_info = SCM_BOOL_F; retval->memo_display_info = SCM_BOOL_F;
retval->memo_map_info = SCM_BOOL_F; retval->memo_map_info = SCM_BOOL_F;
retval->stock_hash = SCM_BOOL_F; retval->security_hash = SCM_BOOL_F;
retval->new_stocks = SCM_BOOL_F; retval->new_securities = SCM_BOOL_F;
retval->ticker_map = SCM_BOOL_F; retval->ticker_map = SCM_BOOL_F;
retval->imported_account_tree = SCM_BOOL_F; retval->imported_account_tree = SCM_BOOL_F;
retval->match_transactions = SCM_BOOL_F; retval->match_transactions = SCM_BOOL_F;
@ -2445,7 +2449,8 @@ gnc_ui_qif_import_druid_make(void)
retval->acct_map_info = scm_list_ref(mapping_info, scm_int2num(1)); retval->acct_map_info = scm_list_ref(mapping_info, scm_int2num(1));
retval->cat_map_info = scm_list_ref(mapping_info, scm_int2num(2)); retval->cat_map_info = scm_list_ref(mapping_info, scm_int2num(2));
retval->memo_map_info = scm_list_ref(mapping_info, scm_int2num(3)); retval->memo_map_info = scm_list_ref(mapping_info, scm_int2num(3));
retval->stock_hash = scm_list_ref(mapping_info, scm_int2num(4)); retval->security_hash = scm_list_ref(mapping_info, scm_int2num(4));
retval->security_prefs = scm_list_ref(mapping_info, scm_int2num(5));
create_ticker_map = scm_c_eval_string("make-ticker-map"); create_ticker_map = scm_c_eval_string("make-ticker-map");
retval->ticker_map = scm_call_0(create_ticker_map); retval->ticker_map = scm_call_0(create_ticker_map);
@ -2459,8 +2464,9 @@ gnc_ui_qif_import_druid_make(void)
scm_gc_protect_object(retval->memo_map_info); scm_gc_protect_object(retval->memo_map_info);
scm_gc_protect_object(retval->acct_display_info); scm_gc_protect_object(retval->acct_display_info);
scm_gc_protect_object(retval->acct_map_info); scm_gc_protect_object(retval->acct_map_info);
scm_gc_protect_object(retval->stock_hash); scm_gc_protect_object(retval->security_hash);
scm_gc_protect_object(retval->new_stocks); scm_gc_protect_object(retval->security_prefs);
scm_gc_protect_object(retval->new_securities);
scm_gc_protect_object(retval->ticker_map); scm_gc_protect_object(retval->ticker_map);
scm_gc_protect_object(retval->imported_account_tree); scm_gc_protect_object(retval->imported_account_tree);
scm_gc_protect_object(retval->match_transactions); scm_gc_protect_object(retval->match_transactions);

414
src/import-export/qif-import/qif-dialog-utils.scm
View File

@ -1,9 +1,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; qif-dialog-utils.scm ;;; qif-dialog-utils.scm
;;; build qif->gnc account maps and put them in a displayable ;;; build qif->gnc account maps and put them in a displayable
;;; form. ;;; form.
;;; ;;;
;;; Bill Gribble <grib@billgribble.com> 20 Feb 2000 ;;; Bill Gribble <grib@billgribble.com> 20 Feb 2000
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (default-stock-acct brokerage security) (define (default-stock-acct brokerage security)
@ -14,15 +14,15 @@
brokerage (gnc-get-account-separator-string) brokerage (gnc-get-account-separator-string)
security)) security))
(define (default-interest-acct brokerage security) (define (default-interest-acct brokerage security)
(string-append (_ "Interest") (gnc-get-account-separator-string) (string-append (_ "Interest") (gnc-get-account-separator-string)
brokerage brokerage
(if (string=? security "") (if (string=? security "")
"" ""
(string-append (gnc-get-account-separator-string) (string-append (gnc-get-account-separator-string)
security)))) security))))
(define (default-capital-return-acct brokerage security) (define (default-capital-return-acct brokerage security)
(string-append (_ "Cap Return") (gnc-get-account-separator-string) (string-append (_ "Cap Return") (gnc-get-account-separator-string)
brokerage (gnc-get-account-separator-string) brokerage (gnc-get-account-separator-string)
security)) security))
@ -44,13 +44,13 @@
(define (default-equity-holding security) (_ "Retained Earnings")) (define (default-equity-holding security) (_ "Retained Earnings"))
(define (default-equity-account) (_ "Retained Earnings")) (define (default-equity-account) (_ "Retained Earnings"))
(define (default-commission-acct brokerage) (define (default-commission-acct brokerage)
(string-append (_ "Commissions") (gnc-get-account-separator-string) (string-append (_ "Commissions") (gnc-get-account-separator-string)
brokerage)) brokerage))
(define (default-margin-interest-acct brokerage) (define (default-margin-interest-acct brokerage)
(string-append (_ "Margin Interest") (gnc-get-account-separator-string) (string-append (_ "Margin Interest") (gnc-get-account-separator-string)
brokerage)) brokerage))
@ -59,7 +59,7 @@
(define (qif-import:gnc-account-exists map-entry acct-list) (define (qif-import:gnc-account-exists map-entry acct-list)
(let ((retval #f)) (let ((retval #f))
(for-each (for-each
(lambda (acct) (lambda (acct)
(if (string=? (qif-map-entry:gnc-name map-entry) (if (string=? (qif-map-entry:gnc-name map-entry)
(cadr acct)) (cadr acct))
@ -73,16 +73,16 @@
;; xtns with that account name, and column 3 is the guess for the ;; xtns with that account name, and column 3 is the guess for the
;; translation. Sorted on # transactions, then alpha. ;; translation. Sorted on # transactions, then alpha.
(define (qif-dialog:make-account-display qif-files acct-hash gnc-acct-info) (define (qif-dialog:make-account-display qif-files acct-hash gnc-acct-info)
;; first, clear the "display" flags in the acct-hash and set up the ;; first, clear the "display" flags in the acct-hash and set up the
;; new-file? flags. If there's nothing to show any more, don't. ;; new-file? flags. If there's nothing to show any more, don't.
(hash-fold (hash-fold
(lambda (k v p) (lambda (k v p)
(qif-map-entry:set-display?! v #f) (qif-map-entry:set-display?! v #f)
#f) #f)
#f acct-hash) #f acct-hash)
(let ((retval '())) (let ((retval '()))
;; we want to make two passes here. The first pass picks the ;; we want to make two passes here. The first pass picks the
;; explicit Account descriptions out of each file. These are the ;; explicit Account descriptions out of each file. These are the
;; best sources of info because we will have types and so on for ;; best sources of info because we will have types and so on for
@ -91,31 +91,31 @@
;; we'll have most of the accounts already located by that point. ;; we'll have most of the accounts already located by that point.
;; Otherwise, we have to guess them. ;; Otherwise, we have to guess them.
;; acct-hash hashes the qif name to a <qif-map-entry> object. ;; acct-hash hashes the qif name to a <qif-map-entry> object.
;; guess-acct returns one. ;; guess-acct returns one.
(for-each (for-each
(lambda (file) (lambda (file)
;; first, get the explicit account references. ;; first, get the explicit account references.
(for-each (for-each
(lambda (acct) (lambda (acct)
(let ((entry (hash-ref acct-hash (qif-acct:name acct)))) (let ((entry (hash-ref acct-hash (qif-acct:name acct))))
(if (not entry) (if (not entry)
(set! entry (set! entry
(qif-import:guess-acct (qif-acct:name acct) (qif-import:guess-acct (qif-acct:name acct)
(qif-acct:type acct) (qif-acct:type acct)
gnc-acct-info))) gnc-acct-info)))
(qif-map-entry:set-description! entry (qif-acct:description acct)) (qif-map-entry:set-description! entry (qif-acct:description acct))
(hash-set! acct-hash (qif-acct:name acct) entry))) (hash-set! acct-hash (qif-acct:name acct) entry)))
(qif-file:accounts file))) (qif-file:accounts file)))
qif-files) qif-files)
;; now make the second pass through the files, looking at the ;; now make the second pass through the files, looking at the
;; transactions. Hopefully the accounts are all there already. ;; transactions. Hopefully the accounts are all there already.
;; stock accounts can have both a category/account and another ;; stock accounts can have both a category/account and another
;; account ref from the security name. ;; account ref from the security name.
(for-each (for-each
(lambda (file) (lambda (file)
(for-each (for-each
(lambda (xtn) (lambda (xtn)
(let ((stock-acct (qif-xtn:security-name xtn)) (let ((stock-acct (qif-xtn:security-name xtn))
(action (qif-xtn:action xtn)) (action (qif-xtn:action xtn))
@ -123,7 +123,7 @@
(qif-account #f) (qif-account #f)
(qif-account-types #f) (qif-account-types #f)
(entry #f)) (entry #f))
(if (and stock-acct action) (if (and stock-acct action)
;; stock transactions are weird. there can be several ;; stock transactions are weird. there can be several
;; accounts associated with stock xtns: the security, ;; accounts associated with stock xtns: the security,
@ -133,16 +133,16 @@
;; in the map. ;; in the map.
(begin (begin
;; first: figure out what the near-end account is. ;; first: figure out what the near-end account is.
;; it's generally the security account, but could be ;; it's generally the security account, but could be
;; an interest, dividend, or CG account. ;; an interest, dividend, or CG account.
(case action (case action
((buy buyx sell sellx reinvint reinvdiv reinvsh reinvsg ((buy buyx sell sellx reinvint reinvdiv reinvsh reinvsg
reinvlg reinvmd shrsin shrsout stksplit) reinvlg reinvmd shrsin shrsout stksplit)
(set! qif-account (set! qif-account
(default-stock-acct from-acct stock-acct)) (default-stock-acct from-acct stock-acct))
(set! qif-account-types (list GNC-STOCK-TYPE (set! qif-account-types (list GNC-STOCK-TYPE
GNC-MUTUAL-TYPE))) GNC-MUTUAL-TYPE)))
((div cgshort cgmid cglong intinc miscinc miscexp ((div cgshort cgmid cglong intinc miscinc miscexp
margint rtrncap xin xout) margint rtrncap xin xout)
(set! qif-account from-acct) (set! qif-account from-acct)
(set! qif-account-types (list GNC-BANK-TYPE (set! qif-account-types (list GNC-BANK-TYPE
@ -150,10 +150,10 @@
GNC-CASH-TYPE GNC-CASH-TYPE
GNC-ASSET-TYPE GNC-ASSET-TYPE
GNC-LIABILITY-TYPE))) GNC-LIABILITY-TYPE)))
((divx cgshortx cgmidx cglongx intincx margintx rtrncapx) ((divx cgshortx cgmidx cglongx intincx margintx rtrncapx)
(set! qif-account (set! qif-account
(qif-split:category (qif-split:category
(car (qif-xtn:splits xtn)))) (car (qif-xtn:splits xtn))))
(set! qif-account-types (list GNC-BANK-TYPE (set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE GNC-CCARD-TYPE
@ -161,40 +161,40 @@
GNC-ASSET-TYPE GNC-ASSET-TYPE
GNC-LIABILITY-TYPE))) GNC-LIABILITY-TYPE)))
((miscincx miscexpx) ((miscincx miscexpx)
(set! qif-account (set! qif-account
(qif-split:miscx-category (qif-split:miscx-category
(car (qif-xtn:splits xtn)))) (car (qif-xtn:splits xtn))))
(set! qif-account-types (list GNC-BANK-TYPE (set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE GNC-CCARD-TYPE
GNC-CASH-TYPE GNC-CASH-TYPE
GNC-ASSET-TYPE GNC-ASSET-TYPE
GNC-LIABILITY-TYPE)))) GNC-LIABILITY-TYPE))))
;; now reference the near-end account ;; now reference the near-end account
(if qif-account (if qif-account
(begin (begin
(set! entry (hash-ref acct-hash qif-account)) (set! entry (hash-ref acct-hash qif-account))
(if (not entry) (if (not entry)
(set! entry (set! entry
(qif-import:guess-acct qif-account (qif-import:guess-acct qif-account
qif-account-types qif-account-types
gnc-acct-info))) gnc-acct-info)))
(qif-map-entry:set-display?! entry #t) (qif-map-entry:set-display?! entry #t)
(hash-set! acct-hash qif-account entry))) (hash-set! acct-hash qif-account entry)))
;; now figure out the other end of the transaction. ;; now figure out the other end of the transaction.
;; the far end will be the brokerage for buy, sell, ;; the far end will be the brokerage for buy, sell,
;; etc, or the "L"-referenced account for buyx, ;; etc, or the "L"-referenced account for buyx,
;; sellx, etc, or an equity account for ShrsIn/ShrsOut ;; sellx, etc, or an equity account for ShrsIn/ShrsOut
;; miscintx and miscexpx are very, very "special" ;; miscintx and miscexpx are very, very "special"
;; cases ... I'm not sure this is right. ;; cases ... I'm not sure this is right.
;; the L line looks like : ;; the L line looks like :
;; LCategory/class [Account]/class ;; LCategory/class [Account]/class
;; so I assume near-acct is Account and far acct ;; so I assume near-acct is Account and far acct
;; is Category. This matches the intincx/divx ;; is Category. This matches the intincx/divx
;; behavior. ;; behavior.
(set! qif-account #f) (set! qif-account #f)
(case action (case action
((buy sell) ((buy sell)
@ -205,19 +205,19 @@
GNC-ASSET-TYPE GNC-ASSET-TYPE
GNC-LIABILITY-TYPE))) GNC-LIABILITY-TYPE)))
((buyx sellx xin xout) ((buyx sellx xin xout)
(set! qif-account (set! qif-account
(qif-split:category (qif-split:category
(car (qif-xtn:splits xtn)))) (car (qif-xtn:splits xtn))))
(set! qif-account-types (list GNC-BANK-TYPE (set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE GNC-CCARD-TYPE
GNC-CASH-TYPE GNC-CASH-TYPE
GNC-ASSET-TYPE GNC-ASSET-TYPE
GNC-LIABILITY-TYPE))) GNC-LIABILITY-TYPE)))
((stksplit) ((stksplit)
(set! qif-account (set! qif-account
(default-stock-acct from-acct stock-acct)) (default-stock-acct from-acct stock-acct))
(set! qif-account-types (list GNC-STOCK-TYPE (set! qif-account-types (list GNC-STOCK-TYPE
GNC-MUTUAL-TYPE GNC-MUTUAL-TYPE
GNC-ASSET-TYPE GNC-ASSET-TYPE
GNC-LIABILITY-TYPE))) GNC-LIABILITY-TYPE)))
@ -225,27 +225,27 @@
(set! qif-account (set! qif-account
(default-cgshort-acct from-acct stock-acct)) (default-cgshort-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((cgmid cgmidx reinvmd) ((cgmid cgmidx reinvmd)
(set! qif-account (set! qif-account
(default-cgmid-acct from-acct stock-acct)) (default-cgmid-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((cglong cglongx reinvlg) ((cglong cglongx reinvlg)
(set! qif-account (set! qif-account
(default-cglong-acct from-acct stock-acct)) (default-cglong-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((intinc intincx reinvint) ((intinc intincx reinvint)
(set! qif-account (set! qif-account
(default-interest-acct from-acct stock-acct)) (default-interest-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((div divx reinvdiv) ((div divx reinvdiv)
(set! qif-account (set! qif-account
(default-dividend-acct from-acct stock-acct)) (default-dividend-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((rtrncap rtrncapx) ((rtrncap rtrncapx)
(set! qif-account (set! qif-account
(default-capital-return-acct from-acct stock-acct)) (default-capital-return-acct from-acct stock-acct))
@ -260,14 +260,14 @@
(set! qif-account (set! qif-account
(default-margin-interest-acct from-acct)) (default-margin-interest-acct from-acct))
(set! qif-account-types (list GNC-EXPENSE-TYPE))) (set! qif-account-types (list GNC-EXPENSE-TYPE)))
((miscinc miscexp miscincx miscexpx) ((miscinc miscexp miscincx miscexpx)
;; these reference a category on the other end ;; these reference a category on the other end
(set! qif-account #f))) (set! qif-account #f)))
;; now reference the far-end account ;; now reference the far-end account
(if qif-account (if qif-account
(begin (begin
(set! entry (hash-ref acct-hash qif-account)) (set! entry (hash-ref acct-hash qif-account))
(if (not entry) (if (not entry)
(set! entry (qif-import:guess-acct (set! entry (qif-import:guess-acct
@ -276,23 +276,23 @@
(qif-map-entry:set-display?! entry #t) (qif-map-entry:set-display?! entry #t)
(hash-set! acct-hash qif-account entry))) (hash-set! acct-hash qif-account entry)))
;; if there's a commission, reference the ;; if there's a commission, reference the
;; commission account ;; commission account
(if (qif-xtn:commission xtn) (if (qif-xtn:commission xtn)
(begin (begin
(set! qif-account (set! qif-account
(default-commission-acct from-acct)) (default-commission-acct from-acct))
(set! entry (set! entry
(hash-ref acct-hash qif-account)) (hash-ref acct-hash qif-account))
(if (not entry) (if (not entry)
(set! entry (set! entry
(qif-import:guess-acct (qif-import:guess-acct
qif-account qif-account
(list GNC-EXPENSE-TYPE) (list GNC-EXPENSE-TYPE)
gnc-acct-info))) gnc-acct-info)))
(qif-map-entry:set-display?! entry #t) (qif-map-entry:set-display?! entry #t)
(hash-set! acct-hash qif-account entry)))) (hash-set! acct-hash qif-account entry))))
;; non-stock transactions. these are a bit easier. ;; non-stock transactions. these are a bit easier.
;; the near-end account (from) is always in the ;; the near-end account (from) is always in the
;; transaction, and the far end(s) are in the splits. ;; transaction, and the far end(s) are in the splits.
@ -300,8 +300,8 @@
(set! entry (hash-ref acct-hash from-acct)) (set! entry (hash-ref acct-hash from-acct))
(if (not entry) (if (not entry)
(set! entry (qif-import:guess-acct (set! entry (qif-import:guess-acct
from-acct from-acct
(list (list
GNC-BANK-TYPE GNC-BANK-TYPE
GNC-CCARD-TYPE GNC-CCARD-TYPE
GNC-CASH-TYPE GNC-CASH-TYPE
@ -310,22 +310,22 @@
gnc-acct-info))) gnc-acct-info)))
(qif-map-entry:set-display?! entry #t) (qif-map-entry:set-display?! entry #t)
(hash-set! acct-hash from-acct entry) (hash-set! acct-hash from-acct entry)
;; iterate over the splits doing the same thing. ;; iterate over the splits doing the same thing.
(for-each (for-each
(lambda (split) (lambda (split)
(let ((xtn-is-acct (qif-split:category-is-account? split)) (let ((xtn-is-acct (qif-split:category-is-account? split))
(xtn-acct #f) (xtn-acct #f)
(entry #f)) (entry #f))
(if xtn-is-acct (if xtn-is-acct
(begin (begin
(set! xtn-acct (qif-split:category split)) (set! xtn-acct (qif-split:category split))
(set! entry (hash-ref acct-hash xtn-acct)) (set! entry (hash-ref acct-hash xtn-acct))
(if (not entry) (if (not entry)
(set! entry (set! entry
(qif-import:guess-acct (qif-import:guess-acct
xtn-acct xtn-acct
(list (list
GNC-BANK-TYPE GNC-BANK-TYPE
GNC-CCARD-TYPE GNC-CCARD-TYPE
GNC-CASH-TYPE GNC-CASH-TYPE
@ -337,35 +337,35 @@
(qif-xtn:splits xtn)))))) (qif-xtn:splits xtn))))))
(qif-file:xtns file))) (qif-file:xtns file)))
qif-files) qif-files)
;; now that the hash table is filled, make the display list ;; now that the hash table is filled, make the display list
(hash-fold (hash-fold
(lambda (k v p) (lambda (k v p)
(if (qif-map-entry:display? v) (if (qif-map-entry:display? v)
(begin (begin
(qif-map-entry:set-new-acct?! (qif-map-entry:set-new-acct?!
v (not (qif-import:gnc-account-exists v gnc-acct-info))) v (not (qif-import:gnc-account-exists v gnc-acct-info)))
(set! retval (cons v retval)))) (set! retval (cons v retval))))
#f) #f)
#f acct-hash) #f acct-hash)
;; sort by number of transactions with that account so the ;; sort by number of transactions with that account so the
;; most important are at the top ;; most important are at the top
(set! retval (set! retval
(sort retval (sort retval
(lambda (a b) (lambda (a b)
(string<? (qif-map-entry:qif-name a) (string<? (qif-map-entry:qif-name a)
(qif-map-entry:qif-name b))))) (qif-map-entry:qif-name b)))))
retval)) retval))
;; the category display is similar to the Account display. ;; the category display is similar to the Account display.
;; QIF category name, xtn count, then GNUcash account. ;; QIF category name, xtn count, then GNUcash account.
(define (qif-dialog:make-category-display qif-files cat-hash gnc-acct-info) (define (qif-dialog:make-category-display qif-files cat-hash gnc-acct-info)
;; first, clear the "display" flags in the cat-hash. If there's ;; first, clear the "display" flags in the cat-hash. If there's
;; nothing to show any more, don't. ;; nothing to show any more, don't.
(hash-fold (hash-fold
(lambda (k v p) (lambda (k v p)
(qif-map-entry:set-display?! v #f) (qif-map-entry:set-display?! v #f)
#f) #f)
@ -373,14 +373,14 @@
(let ((retval '()) (let ((retval '())
(entry #f)) (entry #f))
;; get the Cat entries from each file ;; get the Cat entries from each file
(for-each (for-each
(lambda (file) (lambda (file)
(for-each (for-each
(lambda (cat) (lambda (cat)
(set! entry (hash-ref cat-hash (qif-cat:name cat))) (set! entry (hash-ref cat-hash (qif-cat:name cat)))
(if (not entry) (if (not entry)
(set! entry (set! entry
(qif-import:guess-acct (qif-cat:name cat) (qif-import:guess-acct (qif-cat:name cat)
(if (qif-cat:expense-cat cat) (if (qif-cat:expense-cat cat)
(list GNC-EXPENSE-TYPE (list GNC-EXPENSE-TYPE
@ -388,31 +388,31 @@
(list GNC-INCOME-TYPE (list GNC-INCOME-TYPE
GNC-EXPENSE-TYPE)) GNC-EXPENSE-TYPE))
gnc-acct-info))) gnc-acct-info)))
(qif-map-entry:set-description! (qif-map-entry:set-description!
entry (qif-cat:description cat)) entry (qif-cat:description cat))
(hash-set! cat-hash (qif-cat:name cat) entry)) (hash-set! cat-hash (qif-cat:name cat) entry))
(qif-file:cats file))) (qif-file:cats file)))
qif-files) qif-files)
;; now look at every transaction and increment the count ;; now look at every transaction and increment the count
;; in the account slot if the string matches, or make a ;; in the account slot if the string matches, or make a
;; new hash reference if not. ;; new hash reference if not.
(for-each (for-each
(lambda (qif-file) (lambda (qif-file)
(for-each (for-each
(lambda (xtn) (lambda (xtn)
;; iterate over the splits ;; iterate over the splits
(for-each (for-each
(lambda (split) (lambda (split)
(let ((xtn-is-acct (qif-split:category-is-account? split)) (let ((xtn-is-acct (qif-split:category-is-account? split))
(xtn-cat #f) (xtn-cat #f)
(entry #f)) (entry #f))
(if (not xtn-is-acct) (if (not xtn-is-acct)
(begin (begin
(set! xtn-cat (qif-split:category split)) (set! xtn-cat (qif-split:category split))
(set! entry (hash-ref cat-hash xtn-cat)) (set! entry (hash-ref cat-hash xtn-cat))
(if (not entry) (if (not entry)
(set! entry (set! entry
(qif-import:guess-acct (qif-import:guess-acct
xtn-cat xtn-cat
(if (gnc-numeric-positive-p (if (gnc-numeric-positive-p
@ -425,47 +425,47 @@
(qif-xtn:splits xtn))) (qif-xtn:splits xtn)))
(qif-file:xtns qif-file))) (qif-file:xtns qif-file)))
qif-files) qif-files)
;; now that the hash table is filled, make the display list ;; now that the hash table is filled, make the display list
(hash-fold (hash-fold
(lambda (k v p) (lambda (k v p)
(if (qif-map-entry:display? v) (if (qif-map-entry:display? v)
(begin (begin
(qif-map-entry:set-new-acct?! (qif-map-entry:set-new-acct?!
v (not (qif-import:gnc-account-exists v gnc-acct-info))) v (not (qif-import:gnc-account-exists v gnc-acct-info)))
(set! retval (cons v retval)))) (set! retval (cons v retval))))
#f) #f)
#f cat-hash) #f cat-hash)
;; sort by qif account name ;; sort by qif account name
(set! retval (sort retval (set! retval (sort retval
(lambda (a b) (lambda (a b)
(string<? (qif-map-entry:qif-name a) (string<? (qif-map-entry:qif-name a)
(qif-map-entry:qif-name b))))) (qif-map-entry:qif-name b)))))
retval)) retval))
;; this one's like the other display builders, it just looks at the ;; this one's like the other display builders, it just looks at the
;; payee and memo too. ;; payee and memo too.
(define (qif-dialog:make-memo-display qif-files memo-hash gnc-acct-info) (define (qif-dialog:make-memo-display qif-files memo-hash gnc-acct-info)
(let ((retval '())) (let ((retval '()))
;; clear the display flags for existing items ;; clear the display flags for existing items
(hash-fold (hash-fold
(lambda (k v p) (lambda (k v p)
(qif-map-entry:set-display?! v #f) (qif-map-entry:set-display?! v #f)
#f) #f)
#f memo-hash) #f memo-hash)
;; iterate over every imported transaction. If there's no ;; iterate over every imported transaction. If there's no
;; category in the transaction, look at the payee to get a clue. ;; category in the transaction, look at the payee to get a clue.
;; of there's no payee, look at the split memo. ;; of there's no payee, look at the split memo.
(for-each (for-each
(lambda (file) (lambda (file)
(for-each (for-each
(lambda (xtn) (lambda (xtn)
(let ((payee (qif-xtn:payee xtn)) (let ((payee (qif-xtn:payee xtn))
(splits (qif-xtn:splits xtn))) (splits (qif-xtn:splits xtn)))
(for-each (for-each
(lambda (split) (lambda (split)
(let ((cat (qif-split:category split)) (let ((cat (qif-split:category split))
(memo (qif-split:memo split)) (memo (qif-split:memo split))
@ -473,7 +473,7 @@
;; for each split: if there's a category, do nothing. ;; for each split: if there's a category, do nothing.
;; if there's a payee, use that as the ;; if there's a payee, use that as the
;; key otherwise, use the split memo. ;; key otherwise, use the split memo.
(cond ((and cat (cond ((and cat
(or (not (string? cat)) (or (not (string? cat))
(not (string=? cat "")))) (not (string=? cat ""))))
(set! key-string #f)) (set! key-string #f))
@ -481,25 +481,25 @@
(set! key-string payee)) (set! key-string payee))
(memo (memo
(set! key-string memo))) (set! key-string memo)))
(if key-string (if key-string
(let ((entry (hash-ref memo-hash key-string))) (let ((entry (hash-ref memo-hash key-string)))
(if (not entry) (if (not entry)
(begin (begin
(set! entry (make-qif-map-entry)) (set! entry (make-qif-map-entry))
(qif-map-entry:set-qif-name! entry key-string) (qif-map-entry:set-qif-name! entry key-string)
(qif-map-entry:set-gnc-name! (qif-map-entry:set-gnc-name!
entry (default-unspec-acct)) entry (default-unspec-acct))
(qif-map-entry:set-allowed-types! (qif-map-entry:set-allowed-types!
entry entry
(if (gnc-numeric-positive-p (if (gnc-numeric-positive-p
(qif-split:amount split)) (qif-split:amount split))
(list GNC-INCOME-TYPE GNC-EXPENSE-TYPE (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE
GNC-BANK-TYPE GNC-CCARD-TYPE GNC-BANK-TYPE GNC-CCARD-TYPE
GNC-LIABILITY-TYPE GNC-ASSET-TYPE GNC-LIABILITY-TYPE GNC-ASSET-TYPE
GNC-STOCK-TYPE GNC-MUTUAL-TYPE) GNC-STOCK-TYPE GNC-MUTUAL-TYPE)
(list GNC-EXPENSE-TYPE GNC-INCOME-TYPE (list GNC-EXPENSE-TYPE GNC-INCOME-TYPE
GNC-BANK-TYPE GNC-CCARD-TYPE GNC-BANK-TYPE GNC-CCARD-TYPE
GNC-LIABILITY-TYPE GNC-ASSET-TYPE GNC-LIABILITY-TYPE GNC-ASSET-TYPE
GNC-STOCK-TYPE GNC-MUTUAL-TYPE))))) GNC-STOCK-TYPE GNC-MUTUAL-TYPE)))))
(qif-map-entry:set-display?! entry #t) (qif-map-entry:set-display?! entry #t)
@ -507,28 +507,28 @@
splits))) splits)))
(qif-file:xtns file))) (qif-file:xtns file)))
qif-files) qif-files)
;; build display list ;; build display list
(hash-fold (hash-fold
(lambda (k v p) (lambda (k v p)
(if (qif-map-entry:display? v) (if (qif-map-entry:display? v)
(begin (begin
(qif-map-entry:set-new-acct?! (qif-map-entry:set-new-acct?!
v (not (qif-import:gnc-account-exists v gnc-acct-info))) v (not (qif-import:gnc-account-exists v gnc-acct-info)))
(set! retval (cons v retval)))) (set! retval (cons v retval))))
#f) #f)
#f memo-hash) #f memo-hash)
;; sort by qif memo/payee name ;; sort by qif memo/payee name
(set! retval (sort retval (set! retval (sort retval
(lambda (a b) (lambda (a b)
(string<? (qif-map-entry:qif-name a) (string<? (qif-map-entry:qif-name a)
(qif-map-entry:qif-name b))))) (qif-map-entry:qif-name b)))))
retval)) retval))
(define (qif-dialog:qif-file-loaded? filename list-of-files) (define (qif-dialog:qif-file-loaded? filename list-of-files)
(let ((status (map (let ((status (map
(lambda (file) (lambda (file)
(string=? filename (qif-file:path file))) (string=? filename (qif-file:path file)))
list-of-files))) list-of-files)))
@ -539,11 +539,11 @@
(define (qif-dialog:unload-qif-file oldfile list-of-files) (define (qif-dialog:unload-qif-file oldfile list-of-files)
(delq oldfile list-of-files)) (delq oldfile list-of-files))
(define (qif-import:any-new-accts? hash-table) (define (qif-import:any-new-accts? hash-table)
(let ((retval #f)) (let ((retval #f))
(for-each (for-each
(lambda (bin) (lambda (bin)
(for-each (for-each
(lambda (elt) (lambda (elt)
(if (and (qif-map-entry:new-acct? (cdr elt)) (if (and (qif-map-entry:new-acct? (cdr elt))
(qif-map-entry:display? (cdr elt))) (qif-map-entry:display? (cdr elt)))
@ -552,8 +552,8 @@
(vector->list hash-table)) (vector->list hash-table))
retval)) retval))
(define (qif-import:fix-from-acct qif-file new-acct-name) (define (qif-import:fix-from-acct qif-file new-acct-name)
(for-each (for-each
(lambda (xtn) (lambda (xtn)
(if (not (qif-xtn:from-acct xtn)) (if (not (qif-xtn:from-acct xtn))
(qif-xtn:set-from-acct! xtn new-acct-name))) (qif-xtn:set-from-acct! xtn new-acct-name)))
@ -610,68 +610,66 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:update-stock-hash ;; qif-import:update-security-hash
;; ;;
;; make new commodities for each new stock in acct-hash that isn't ;; Make new commodities for each new security in acct-hash
;; already in stock-hash. Return a list of the QIF names of the ;; that isn't already in security-hash. Return a list of
;; new stocks or #f if none. ;; the QIF names for which new commodities are created, or
;; #f if none.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:update-stock-hash stock-hash ticker-map acct-hash) (define (qif-import:update-security-hash security-hash ticker-map acct-hash)
(let ((names '())) (let ((names '()))
(hash-fold (hash-fold
(lambda (qif-name map-entry p) (lambda (qif-name map-entry p)
(let ((stock-name (qif-import:get-account-name qif-name))) (let ((security-name (qif-import:get-account-name qif-name)))
;; is it: a stock or mutual fund and displayed and not already in ;; is it: a stock or mutual fund and displayed and not already in
;; the stock-hash? ;; the security-hash?
(if (and (if (and
stock-name security-name
(qif-map-entry:display? map-entry) (qif-map-entry:display? map-entry)
(or (memv GNC-STOCK-TYPE (or (memv GNC-STOCK-TYPE
(qif-map-entry:allowed-types map-entry)) (qif-map-entry:allowed-types map-entry))
(memv GNC-MUTUAL-TYPE (memv GNC-MUTUAL-TYPE
(qif-map-entry:allowed-types map-entry))) (qif-map-entry:allowed-types map-entry)))
(not (hash-ref stock-hash stock-name))) (not (hash-ref security-hash security-name)))
(let* ((separator (string-ref (gnc-get-account-separator-string) 0)) (let ((existing-gnc-acct
(existing-gnc-acct (gnc-account-lookup-by-full-name
(gnc-account-lookup-by-full-name
(gnc-get-current-root-account) (gnc-get-current-root-account)
(qif-map-entry:gnc-name map-entry))) (qif-map-entry:gnc-name map-entry)))
(book (gnc-account-get-book (gnc-get-current-root-account))) (book (gnc-account-get-book (gnc-get-current-root-account))))
(existing-type (if (and (not (null? existing-gnc-acct))
(xaccAccountGetType existing-gnc-acct))) (memv (xaccAccountGetType existing-gnc-acct)
(if (and (not (null? existing-gnc-acct)) (list GNC-STOCK-TYPE GNC-MUTUAL-TYPE)))
(memv existing-type (list GNC-STOCK-TYPE ;; gnc account already exists... we *know* what the
GNC-MUTUAL-TYPE))) ;; security is supposed to be
;; gnc account already exists... we *know* what the (let ((commodity
;; security is supposed to be
(let ((commodity
(xaccAccountGetCommodity existing-gnc-acct))) (xaccAccountGetCommodity existing-gnc-acct)))
(hash-set! stock-hash stock-name commodity)) (hash-set! security-hash security-name commodity))
;; we know nothing about this security.. we need to ;; we know nothing about this security.. we need to
;; ask about it ;; ask about it
(let ((ticker-symbol (let ((ticker-symbol
(qif-ticker-map:lookup-ticker ticker-map (qif-ticker-map:lookup-ticker ticker-map
stock-name)) security-name))
(namespace GNC_COMMODITY_NS_MUTUAL)) (namespace GNC_COMMODITY_NS_MUTUAL))
(if (not ticker-symbol) (if (not ticker-symbol)
(set! ticker-symbol stock-name) (set! ticker-symbol security-name)
(set! namespace (set! namespace
(qif-dialog:default-namespace ticker-symbol))) (qif-dialog:default-namespace ticker-symbol)))
(set! names (cons stock-name names)) (set! names (cons security-name names))
(hash-set! (hash-set! security-hash
stock-hash stock-name security-name
(gnc-commodity-new book (gnc-commodity-new book
stock-name security-name
namespace namespace
ticker-symbol ticker-symbol
"" ""
100000)))))) 100000))))))
#f)) #f))
#f acct-hash) #f acct-hash)
(if (not (null? names)) (if (not (null? names))
(sort names string<?) (sort names string<?)
#f))) #f)))
@ -679,19 +677,19 @@
;; this is used within the dialog to get a list of all the new ;; this is used within the dialog to get a list of all the new
;; accounts the importer thinks it's going to make. Passed to the ;; accounts the importer thinks it's going to make. Passed to the
;; account picker. ;; account picker.
;; ;;
;; returned is a tree-structured list of all the old and new accounts ;; returned is a tree-structured list of all the old and new accounts
;; like so : (name new? children). trees are sorted alphabetically. ;; like so : (name new? children). trees are sorted alphabetically.
;; This should probably change but it's beeter than no sort at all. ;; This should probably change but it's beeter than no sort at all.
(define (qif-import:get-all-accts extra-maps) (define (qif-import:get-all-accts extra-maps)
(define (cvt-to-tree path new?) (define (cvt-to-tree path new?)
(if (null? path) (if (null? path)
'() '()
(list (car path) new? (list (car path) new?
(if (null? (cdr path)) '() (if (null? (cdr path)) '()
(list (cvt-to-tree (cdr path) new?)))))) (list (cvt-to-tree (cdr path) new?))))))
(define (merge-into-tree tree path new?) (define (merge-into-tree tree path new?)
(if (null? path) (if (null? path)
tree tree
@ -705,58 +703,58 @@
(set! newtree (set! newtree
(cons (list (car path) (cons (list (car path)
(and new? (cadr tree-elt)) (and new? (cadr tree-elt))
(merge-into-tree (merge-into-tree
old-children (cdr path) new?)) old-children (cdr path) new?))
(append newtree tree-left)))) (append newtree tree-left))))
(begin (begin
(set! newtree (cons tree-elt newtree)) (set! newtree (cons tree-elt newtree))
(if (not (null? tree-left)) (if (not (null? tree-left))
(loop (car tree-left) (cdr tree-left)) (loop (car tree-left) (cdr tree-left))
(set! newtree (cons (cvt-to-tree path new?) (set! newtree (cons (cvt-to-tree path new?)
newtree)))))) newtree))))))
(sort newtree (lambda (a b) (string<? (car a) (car b)))))))) (sort newtree (lambda (a b) (string<? (car a) (car b))))))))
(let ((accts '()) (let ((accts '())
(acct-tree '()) (acct-tree '())
(separator (string-ref (gnc-get-account-separator-string) 0))) (separator (string-ref (gnc-get-account-separator-string) 0)))
;; get the new accounts from the account map ;; get the new accounts from the account map
(for-each (for-each
(lambda (acctmap) (lambda (acctmap)
(if acctmap (if acctmap
(hash-fold (hash-fold
(lambda (k v p) (lambda (k v p)
(if (qif-map-entry:display? v) (if (qif-map-entry:display? v)
(set! accts (set! accts
(cons (cons
(cons (string-split (qif-map-entry:gnc-name v) (cons (string-split (qif-map-entry:gnc-name v)
separator) separator)
(qif-map-entry:new-acct? v)) (qif-map-entry:new-acct? v))
accts))) accts)))
#f) #f)
#f acctmap))) #f acctmap)))
extra-maps) extra-maps)
;; get the old accounts from the current account group ;; get the old accounts from the current account group
(for-each (for-each
(lambda (acct) (lambda (acct)
(set! accts (set! accts
(cons (cons
(cons (string-split (cons (string-split
(gnc-account-get-full-name acct) (gnc-account-get-full-name acct)
separator) separator)
#f) #f)
accts))) accts)))
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))) (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
;; now build a tree structure ;; now build a tree structure
(for-each (for-each
(lambda (acct) (lambda (acct)
(set! acct-tree (set! acct-tree
(merge-into-tree acct-tree (car acct) (cdr acct)))) (merge-into-tree acct-tree (car acct) (cdr acct))))
accts) accts)
;; we're done ;; we're done
acct-tree)) acct-tree))
(define (qif-import:refresh-match-selection matches item) (define (qif-import:refresh-match-selection matches item)
@ -765,7 +763,7 @@
(for-each (for-each
(lambda (match) (lambda (match)
(if (= i item) (if (= i item)
(if (cdr match) (if (cdr match)
(set-cdr! match #f) (set-cdr! match #f)
(set-cdr! match #t)) (set-cdr! match #t))
(set-cdr! match #f)) (set-cdr! match #f))

112
src/import-export/qif-import/qif-guess-map.scm
View File

@ -33,7 +33,8 @@
;; - a hash of QIF category to gnucash account info ;; - a hash of QIF category to gnucash account info
;; - a hash of QIF memo/payee to gnucash account info ;; - a hash of QIF memo/payee to gnucash account info
;; (older saved prefs may not have this one) ;; (older saved prefs may not have this one)
;; - a hash of QIF stock name to gnc-commodity* ;; - a hash of QIF security name to gnc-commodity*
;; - a list of all previously saved security mappings
;; (older saved prefs may not have this one) ;; (older saved prefs may not have this one)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -80,18 +81,18 @@
(let ((qif-account-list #f) (let ((qif-account-list #f)
(qif-cat-list #f) (qif-cat-list #f)
(qif-memo-list #f) (qif-memo-list #f)
(qif-stock-list #f) (qif-security-list #f)
(qif-account-hash #f) (qif-account-hash #f)
(qif-cat-hash #f) (qif-cat-hash #f)
(qif-memo-hash #f) (qif-memo-hash #f)
(qif-stock-hash #f) (qif-security-hash #f)
(saved-sep #f)) (saved-sep #f))
;; Read the mapping file. ;; Read the mapping file.
(set! qif-account-list (safe-read)) (set! qif-account-list (safe-read))
(set! qif-cat-list (safe-read)) (set! qif-cat-list (safe-read))
(set! qif-memo-list (safe-read)) (set! qif-memo-list (safe-read))
(set! qif-stock-list (safe-read)) (set! qif-security-list (safe-read))
(set! saved-sep (safe-read)) (set! saved-sep (safe-read))
;; Process the QIF account mapping. ;; Process the QIF account mapping.
@ -114,22 +115,24 @@
saved-sep))) saved-sep)))
;; Process the QIF security mapping. ;; Process the QIF security mapping.
(if (not (list? qif-stock-list)) (if (not (list? qif-security-list))
(set! qif-stock-hash (make-hash-table 20)) (set! qif-security-hash (make-hash-table 20))
(set! qif-stock-hash (qif-import:read-commodities (set! qif-security-hash (qif-import:read-securities
qif-stock-list))) qif-security-list)))
;; Put all the mappings together in a list. ;; Put all the mappings together in a list.
(set! results (list qif-account-hash (set! results (list qif-account-hash
qif-cat-hash qif-cat-hash
qif-memo-hash qif-memo-hash
qif-stock-hash))))) qif-security-hash
qif-security-list)))))
;; Otherwise, we can't get any saved mappings. Use empty tables. ;; Otherwise, we can't get any saved mappings. Use empty tables.
(set! results (list (make-hash-table 20) (set! results (list (make-hash-table 20)
(make-hash-table 20) (make-hash-table 20)
(make-hash-table 20) (make-hash-table 20)
(make-hash-table 20)))) (make-hash-table 20)
'())))
;; Build the list of all known account names. ;; Build the list of all known account names.
(let* ((all-accounts (gnc-get-current-root-account)) (let* ((all-accounts (gnc-get-current-root-account))
@ -180,20 +183,22 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:read-commodities ;; qif-import:read-securities
;; ;;
;; This procedure examines a list of previously seen commodities ;; This procedure examines a list of previously seen security
;; and returns a hash table of them, if they still exist. ;; mappings and returns a hash table pairing QIF security names
;; with existing GnuCash commodities.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:read-commodities commlist) (define (qif-import:read-securities security-list)
(let ((table (make-hash-table 20))) (let ((table (make-hash-table 20)))
(for-each (for-each
(lambda (entry) (lambda (entry)
(if (and (list? entry) (if (and (list? entry)
(= 3 (length entry))) (= 3 (length entry)))
;; The saved information about each commodity is a ;; The saved information about each security mapping is a
;; list of three items: name, namespace, and mnemonic. ;; list of three items: the QIF name, and the GnuCash
;; namespace and mnemonic (symbol) to which it maps.
;; Example: ("McDonald's" "NYSE" "MCD") ;; Example: ("McDonald's" "NYSE" "MCD")
(let ((commodity (gnc-commodity-table-lookup (let ((commodity (gnc-commodity-table-lookup
(gnc-commodity-table-get-table (gnc-commodity-table-get-table
@ -201,26 +206,47 @@
(cadr entry) (cadr entry)
(caddr entry)))) (caddr entry))))
(if (and commodity (not (null? commodity))) (if (and commodity (not (null? commodity)))
;; The commodity is defined in GnuCash. ;; There is an existing GnuCash commodity for this
;; combination of namespace and symbol.
(hash-set! table (car entry) commodity))))) (hash-set! table (car entry) commodity)))))
commlist) security-list)
table)) table))
(define (qif-import:write-commodities hashtab)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:write-securities
;;
;; This procedure writes a mapping QIF security names to
;; GnuCash commodity namespaces and mnemonics (symbols).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:write-securities security-hash security-prefs)
(let ((table '())) (let ((table '()))
;; For each security that has been paired with an existing
;; GnuCash commodity, create a list containing the QIF name
;; and the commodity's namespace and mnemonic (symbol).
(hash-fold (hash-fold
(lambda (key value p) (lambda (key value p)
;;FIXME: we used to type-check the values, like: ;;FIXME: we used to type-check the values, like:
;; (gw:wcp-is-of-type? <gnc:commodity*> value) ;; (gw:wcp-is-of-type? <gnc:commodity*> value)
(if (and value #t) (if (and value #t)
(set! table (set! table (cons (list key
(cons (list key (gnc-commodity-get-namespace value)
(gnc-commodity-get-namespace value) (gnc-commodity-get-mnemonic value))
(gnc-commodity-get-mnemonic value)) table))
table)) (gnc:warn "qif-import:write-securities:"
(gnc:warn "qif-import:write-commodities:" " something funny in hash table."))
" something funny in hash table.")) #f)
#f) #f hashtab) #f security-hash)
;; Add on the rest of the saved security mapping preferences.
(for-each
(lambda (m)
(if (not (hash-ref security-hash (car m)))
(set! table (cons m table))))
security-prefs)
;; Write out the mappings.
(write table))) (write table)))
@ -233,7 +259,8 @@
;; user cancels the import instead. ;; user cancels the import instead.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:save-map-prefs acct-map cat-map memo-map stock-map) (define (qif-import:save-map-prefs acct-map cat-map memo-map
security-map security-prefs)
(let* ((pref-filename (gnc-build-dotgnucash-path "qif-accounts-map"))) (let* ((pref-filename (gnc-build-dotgnucash-path "qif-accounts-map")))
;; does the file exist? if not, create it; in either case, ;; does the file exist? if not, create it; in either case,
;; make sure it's a directory and we have write and execute ;; make sure it's a directory and we have write and execute
@ -241,26 +268,31 @@
(with-output-to-file pref-filename (with-output-to-file pref-filename
(lambda () (lambda ()
(display ";;; qif-accounts-map\n") (display ";;; qif-accounts-map\n")
(display ";;; automatically generated by GNUcash. DO NOT EDIT\n") (display ";;; Automatically generated by GnuCash. DO NOT EDIT.\n")
(display ";;; (unless you really, really want to).\n") (display ";;; (Unless you really, really want to.)\n")
(display ";;; map from QIF accounts to GNC accounts") (newline) (display ";;; Map QIF accounts to GnuCash accounts")
(newline)
(qif-import:write-map acct-map) (qif-import:write-map acct-map)
(newline) (newline)
(display ";;; map from QIF categories to GNC accounts") (newline) (display ";;; Map QIF categories to GnuCash accounts")
(newline)
(qif-import:write-map cat-map) (qif-import:write-map cat-map)
(newline) (newline)
(display ";;; map from QIF payee/memo to GNC accounts") (newline) (display ";;; Map QIF payee/memo to GnuCash accounts")
(newline)
(qif-import:write-map memo-map) (qif-import:write-map memo-map)
(newline) (newline)
(display ";;; map from QIF stock name to GNC commodity") (newline) (display ";;; Map QIF security names to GnuCash commodities")
(qif-import:write-commodities stock-map) (newline)
(qif-import:write-securities security-map security-prefs)
(newline) (newline)
(display ";;; GnuCash separator used in these mappings") (newline) (display ";;; GnuCash separator used in these mappings")
(newline)
(write (string-ref (gnc-get-account-separator-string) 0)) (write (string-ref (gnc-get-account-separator-string) 0))
(newline))))) (newline)))))

18
src/import-export/qif-import/qif-import.scm
View File

@ -1,8 +1,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; qif-import.scm ;;; qif-import.scm
;;; virtual loader for QIF import facility ;;; virtual loader for QIF import facility
;;; ;;;
;;; Bill Gribble <grib@billgribble.com> 20 Feb 2000 ;;; Bill Gribble <grib@billgribble.com> 20 Feb 2000
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash import-export qif-import)) (define-module (gnucash import-export qif-import))
@ -24,14 +24,14 @@
(gnc:module-load "gnucash/app-utils" 0) (gnc:module-load "gnucash/app-utils" 0)
(gnc:module-load "gnucash/gnome-utils" 0) (gnc:module-load "gnucash/gnome-utils" 0)
(load-from-path "qif-import/qif-objects.scm") ;; class definitions (load-from-path "qif-import/qif-objects.scm") ;; class definitions
(load-from-path "qif-import/qif-parse.scm") ;; string-to-value (load-from-path "qif-import/qif-parse.scm") ;; string-to-value
(load-from-path "qif-import/qif-utils.scm") (load-from-path "qif-import/qif-utils.scm")
(load-from-path "qif-import/qif-file.scm") ;; actual file reading (load-from-path "qif-import/qif-file.scm") ;; actual file reading
(load-from-path "qif-import/qif-dialog-utils.scm") ;; build displays (load-from-path "qif-import/qif-dialog-utils.scm") ;; build displays
(load-from-path "qif-import/qif-guess-map.scm") ;; build acct mappings (load-from-path "qif-import/qif-guess-map.scm") ;; build acct mappings
(load-from-path "qif-import/qif-to-gnc.scm") ;; conv QIF xtns to GNC (load-from-path "qif-import/qif-to-gnc.scm") ;; conv QIF xtns to GNC
(load-from-path "qif-import/qif-merge-groups.scm") ;; merge into user's acct (load-from-path "qif-import/qif-merge-groups.scm") ;; merge into user's acct
(export make-qif-file) (export make-qif-file)
(export make-ticker-map) (export make-ticker-map)
@ -39,7 +39,7 @@
(export qif-import:get-all-accts) (export qif-import:get-all-accts)
(export qif-import:fix-from-acct) (export qif-import:fix-from-acct)
(export qif-import:any-new-accts?) (export qif-import:any-new-accts?)
(export qif-import:update-stock-hash) (export qif-import:update-security-hash)
(export qif-import:refresh-match-selection) (export qif-import:refresh-match-selection)
(export qif-import:save-map-prefs) (export qif-import:save-map-prefs)
(export qif-import:load-map-prefs) (export qif-import:load-map-prefs)