diff --git a/ChangeLog b/ChangeLog index 9ba9c307bf..1bf5d14fe0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2001-02-23 Bill Gribble + + * src/scm/qif-import/qif-dialog-utils.scm: Be more flexible + about account types on QIF import + + * src/scm/qif-import/qif-objects.scm: make sure the list of + allowed types is in the right order + + * src/scm/qif-import/qif-to-gnc.scm: be more flexible about type; + check on parent type after creating child; don't set security on + non-{stock,mutual} accounts. + 2001-02-22 Christian Stimming * src/engine/Transaction.h: Added xaccSplitGetAmount to be used diff --git a/src/scm/qif-import/qif-dialog-utils.scm b/src/scm/qif-import/qif-dialog-utils.scm index 7c53ac4eb3..bc9942f5aa 100644 --- a/src/scm/qif-import/qif-dialog-utils.scm +++ b/src/scm/qif-import/qif-dialog-utils.scm @@ -385,8 +385,10 @@ (set! entry (qif-import:guess-acct (qif-cat:name cat) (if (qif-cat:expense-cat cat) - (list GNC-EXPENSE-TYPE) - (list GNC-INCOME-TYPE)) + (list GNC-EXPENSE-TYPE + GNC-INCOME-TYPE) + (list GNC-INCOME-TYPE + GNC-EXPENSE-TYPE)) gnc-acct-info))) (qif-map-entry:set-description! entry (qif-cat:description cat)) @@ -416,8 +418,8 @@ (qif-import:guess-acct xtn-cat (if (> (qif-split:amount split) 0) - (list GNC-INCOME-TYPE) - (list GNC-EXPENSE-TYPE)) + (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE) + (list GNC-EXPENSE-TYPE GNC-INCOME-TYPE)) gnc-acct-info))) (qif-map-entry:set-display?! entry #t) (hash-set! cat-hash xtn-cat entry))))) @@ -492,8 +494,14 @@ (qif-map-entry:set-allowed-types! entry (if (> (qif-split:amount split) 0) - (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE) - (list GNC-EXPENSE-TYPE GNC-INCOME-TYPE))))) + (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE + GNC-BANK-TYPE GNC-CCARD-TYPE + GNC-LIABILITY-TYPE GNC-ASSET-TYPE + GNC-STOCK-TYPE GNC-MUTUAL-TYPE) + (list GNC-EXPENSE-TYPE GNC-INCOME-TYPE + GNC-BANK-TYPE GNC-CCARD-TYPE + GNC-LIABILITY-TYPE GNC-ASSET-TYPE + GNC-STOCK-TYPE GNC-MUTUAL-TYPE))))) (qif-map-entry:set-display?! entry #t) (hash-set! memo-hash key-string entry))))) splits))) @@ -599,13 +607,22 @@ (gnc:get-account-from-full-name (gnc:get-current-group) (qif-map-entry:gnc-name map-entry) - separator))) - (if existing-gnc-acct + separator)) + (existing-type + (gnc:account-get-type existing-gnc-acct))) + (if (and existing-gnc-acct + (memv existing-type (list GNC-STOCK-TYPE + GNC-MUTUAL-TYPE))) ;; gnc account already exists... we *know* what the ;; security is supposed to be - (hash-set! - stock-hash stock-name - (gnc:account-get-security existing-gnc-acct)) + (let ((currency + (gnc:account-get-currency existing-gnc-acct)) + (security + (gnc:account-get-security existing-gnc-acct))) + (if security + (hash-set! stock-hash stock-name security) + (hash-set! stock-hash stock-name currency))) + ;; we know nothing about this security.. we need to ;; ask about it (begin @@ -619,7 +636,7 @@ 100000)))))) #f)) #f acct-hash) - + (if (not (null? names)) (sort names string value) + (if (and value (gw:wcp-is-of-type? value)) (set! table (cons (list key (gnc:commodity-get-namespace value) (gnc:commodity-get-mnemonic value)) - table))) + table)) + (display "write-commodities: something funny in hash table.\n")) #f) #f hashtab) (write table))) - + (define (qif-import:save-map-prefs acct-map cat-map memo-map stock-map) (let* ((pref-dir (build-path (getenv "HOME") ".gnucash")) diff --git a/src/scm/qif-import/qif-objects.scm b/src/scm/qif-import/qif-objects.scm index 13a435ff55..051de7ed59 100644 --- a/src/scm/qif-import/qif-objects.scm +++ b/src/scm/qif-import/qif-objects.scm @@ -518,7 +518,7 @@ me)) (define (qif-map-entry:allowed-parent-types self) - (let ((types-list (qif-map-entry:allowed-types self))) + (let ((types-list (reverse (qif-map-entry:allowed-types self)))) (define (add-types . rest) (for-each (lambda (t) diff --git a/src/scm/qif-import/qif-to-gnc.scm b/src/scm/qif-import/qif-to-gnc.scm index ee05ab82f7..24c6d687dc 100644 --- a/src/scm/qif-import/qif-to-gnc.scm +++ b/src/scm/qif-import/qif-to-gnc.scm @@ -18,7 +18,8 @@ ;; an existing or new account. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (qif-import:find-or-make-acct acct-info currency security +(define (qif-import:find-or-make-acct acct-info check-types? + currency security gnc-acct-hash old-group new-group) (let* ((separator (string-ref (gnc:account-separator-char) 0)) (gnc-name (qif-map-entry:gnc-name acct-info)) @@ -30,17 +31,6 @@ (make-new-acct #f) (incompatible-acct #f)) - (define (make-unique-name-variant long-name short-name) - (if (gnc:get-account-from-full-name old-group long-name separator) - (let loop ((count 2)) - (let ((test-name - (string-append long-name (sprintf #f " %a" count)))) - (if (gnc:get-account-from-full-name - old-group test-name separator) - (loop (+ 1 count)) - (string-append short-name (sprintf #f " %a" count))))) - short-name)) - (define (compatible? account) (let ((acc-type (gnc:account-get-type account)) (acc-currency (gnc:account-get-currency account)) @@ -48,15 +38,34 @@ (if (memv acc-type (list GNC-STOCK-TYPE GNC-MUTUAL-TYPE)) (and - (list? allowed-types) - (memv acc-type allowed-types) + (if check-types? + (and (list? allowed-types) + (memv acc-type allowed-types)) + #t) (gnc:commodity-equiv? acc-currency currency) - (gnc:commodity-equiv? acc-security security)) + (or (not security) + (gnc:commodity-equiv? acc-security security))) (and - (list? allowed-types) - (memv acc-type allowed-types) + (if check-types? + (and + (list? allowed-types) + (memv acc-type allowed-types)) + #t) (gnc:commodity-equiv? acc-currency currency))))) - + + (define (make-unique-name-variant long-name short-name) + (if (gnc:get-account-from-full-name old-group long-name separator) + (let loop ((count 2)) + (let* ((test-name + (string-append long-name (sprintf #f " %a" count))) + (test-acct + (gnc:get-account-from-full-name old-group test-name + separator))) + (if (and test-acct (not (compatible? test-acct))) + (loop (+ 1 count)) + (string-append short-name (sprintf #f " %a" count))))) + short-name)) + ;; just because we found an account doesn't mean we can use it. ;; if the name is in use but the currency, security, or type are ;; incompatible, we need to create a new account with a modified @@ -82,7 +91,10 @@ (set! make-new-acct #t) (set! incompatible-acct #f))) - (if existing-account + ;; here, existing-account means a previously *created* account + ;; (possibly a new account, possibly a copy of an existing gnucash + ;; acct) + (if (and existing-account (compatible? existing-account)) existing-account (let ((new-acct (gnc:malloc-account)) (parent-acct #f) @@ -116,18 +128,10 @@ ;; make sure that if this is a nested account foo:bar:baz, ;; foo:bar and foo exist also. (if last-colon - (let ((pinfo (make-qif-map-entry))) + (begin (set! parent-name (substring gnc-name 0 last-colon)) (set! acct-name (substring gnc-name (+ 1 last-colon) - (string-length gnc-name))) - (qif-map-entry:set-qif-name! pinfo parent-name) - (qif-map-entry:set-gnc-name! pinfo parent-name) - (qif-map-entry:set-allowed-types! - pinfo (qif-map-entry:allowed-parent-types acct-info)) - - (set! parent-acct (qif-import:find-or-make-acct - pinfo currency security - gnc-acct-hash old-group new-group))) + (string-length gnc-name)))) (begin (set! acct-name gnc-name))) @@ -158,8 +162,20 @@ (if (qif-map-entry:allowed-types acct-info) (gnc:account-set-type new-acct (car (qif-map-entry:allowed-types acct-info)))))) - (gnc:account-commit-edit new-acct) + + (if last-colon + (let ((pinfo (make-qif-map-entry))) + (qif-map-entry:set-qif-name! pinfo parent-name) + (qif-map-entry:set-gnc-name! pinfo parent-name) + (qif-map-entry:set-allowed-types! + acct-info (list (gnc:account-get-type new-acct))) + (qif-map-entry:set-allowed-types! + pinfo (qif-map-entry:allowed-parent-types acct-info)) + + (set! parent-acct (qif-import:find-or-make-acct + pinfo #t currency #f + gnc-acct-hash old-group new-group)))) (if parent-acct (gnc:account-insert-subaccount parent-acct new-acct) (gnc:group-insert-account new-group new-acct)) @@ -256,17 +272,17 @@ (equity? (memv GNC-EQUITY-TYPE ok-types))) (cond ((and equity? security) ;; a "retained holdings" acct - (qif-import:find-or-make-acct acctinfo + (qif-import:find-or-make-acct acctinfo #f security security gnc-acct-hash old-group new-group)) (security (qif-import:find-or-make-acct - acctinfo default-currency security + acctinfo #f default-currency security gnc-acct-hash old-group new-group)) (#t (qif-import:find-or-make-acct - acctinfo default-currency default-currency + acctinfo #f default-currency #f gnc-acct-hash old-group new-group))))) sorted-accounts-list)