From 08635f8e8eca7e28d721b947913d74a4495cb43d Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Mon, 12 Jun 2000 21:50:58 +0000 Subject: [PATCH] Bill Gribble's qif patch. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2456 57a11ea4-9604-0410-9ed3-97b8803252fd --- src/scm/qif-import/qif-dialog-utils.scm | 70 ++-- src/scm/qif-import/qif-file.scm | 20 +- src/scm/qif-import/qif-objects.scm | 33 +- src/scm/qif-import/qif-parse.scm | 121 +++--- src/scm/qif-import/qif-to-gnc.scm | 471 ++++++++++++++++-------- 5 files changed, 433 insertions(+), 282 deletions(-) diff --git a/src/scm/qif-import/qif-dialog-utils.scm b/src/scm/qif-import/qif-dialog-utils.scm index b1106465e1..8e4566ef1f 100644 --- a/src/scm/qif-import/qif-dialog-utils.scm +++ b/src/scm/qif-import/qif-dialog-utils.scm @@ -9,20 +9,25 @@ (gnc:support "qif-import/qif-dialog-utils.scm") -(define (default-dividend-acct security) - (string-append "Dividends:" security)) +(define (default-stock-acct brokerage security) + (string-append brokerage ":" security)) -(define (default-interest-acct security) - (string-append "Interest:" security)) +(define (default-dividend-acct brokerage security) + (string-append "Dividends:" brokerage ":" security)) -(define (default-cglong-acct security) - (string-append "Cap. gain (long):" security)) +(define (default-interest-acct brokerage security) + (string-append "Interest:" brokerage ":" security)) -(define (default-cgshort-acct security) - (string-append "Cap. gain (short):" security)) +(define (default-cglong-acct brokerage security) + (string-append "Cap. gain (long):" brokerage ":" security)) -(define (default-equity-account) "Retained Earnings") -(define (default-equity-category) "[Retained Earnings]") +(define (default-cgshort-acct brokerage security) + (string-append "Cap. gain (short):" brokerage ":" security)) + +(define (default-equity-holding security) + (string-append "Retained Holdings:" security)) + +(define (default-equity-account) "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 @@ -72,14 +77,13 @@ (for-each (lambda (xtn) (let ((stock-acct (qif-xtn:security-name xtn)) - (action (qif-xtn:number xtn)) - (action-sym #f) + (action (qif-xtn:action xtn)) (from-acct (qif-xtn:from-acct xtn)) (qif-account #f) (qif-account-types #f) (entry #f)) - (if (and stock-acct (string? action)) + (if (and stock-acct action) ;; stock transactions are weird. there can be several ;; accounts associated with stock xtns: the security, ;; the brokerage, a dividend account, a long-term CG @@ -87,14 +91,14 @@ ;; account. Make sure all of the right ones get stuck ;; in the map. (begin - (set! action-sym (qif-parse:parse-action-field action)) ;; 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 + (case action ((buy buyx sell sellx reinvint reinvdiv reinvsh reinvsg - reinvlg shrsin stksplit) - (set! qif-account stock-acct) + reinvlg shrsin shrsout stksplit) + (set! qif-account + (default-stock-acct from-acct stock-acct)) (set! qif-account-types (list GNC-STOCK-TYPE GNC-MUTUAL-TYPE))) ((div cgshort cglong intinc miscinc miscexp xin xout) @@ -107,10 +111,7 @@ (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))) + GNC-CCARD-TYPE)))) ;; now reference the near-end account (if qif-account @@ -128,12 +129,12 @@ ;; 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 + ;; sellx, etc, or an equity account for ShrsIn/ShrsOut ;; miscintx and miscexpx are very, very "special" ;; cases which I don't quite handle correctly yet. (set! qif-account #f) - (case action-sym + (case action ((buy sell) (set! qif-account from-acct) (set! qif-account-types (list GNC-BANK-TYPE @@ -146,12 +147,13 @@ GNC-CCARD-TYPE))) ((stksplit) - (set! qif-account stock-acct) + (set! qif-account + (default-stock-acct from-acct stock-acct)) (set! qif-account-types (list GNC-STOCK-TYPE GNC-MUTUAL-TYPE))) ((cgshort cgshortx reinvsg reinvsh) (set! qif-account - (default-cgshort-acct stock-acct)) + (default-cgshort-acct from-acct stock-acct)) (set! qif-account-types (list GNC-INCOME-TYPE))) ((miscincx) @@ -168,31 +170,27 @@ ((cglong cglongx reinvlg) (set! qif-account - (default-cglong-acct stock-acct)) + (default-cglong-acct from-acct stock-acct)) (set! qif-account-types (list GNC-INCOME-TYPE))) ((intinc intincx reinvint) (set! qif-account - (default-interest-acct stock-acct)) + (default-interest-acct from-acct stock-acct)) (set! qif-account-types (list GNC-INCOME-TYPE))) ((div divx reinvdiv) (set! qif-account - (default-dividend-acct stock-acct)) + (default-dividend-acct from-acct stock-acct)) (set! qif-account-types (list GNC-INCOME-TYPE))) - ((shrsin) + ((shrsin shrsout) (set! qif-account - (default-equity-account)) + (default-equity-holding stock-acct)) (set! qif-account-types (list GNC-EQUITY-TYPE))) - + ((miscinc miscexp) ;; these reference a category on the other end - (set! qif-account #f)) - - (else - (display "HEY! HEY! action-sym = ") - (display action-sym) (newline))) + (set! qif-account #f))) ;; now reference the far-end account (if qif-account diff --git a/src/scm/qif-import/qif-file.scm b/src/scm/qif-import/qif-file.scm index 421e49d7e1..4b477c92a1 100644 --- a/src/scm/qif-import/qif-file.scm +++ b/src/scm/qif-import/qif-file.scm @@ -116,11 +116,13 @@ (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. + ;; there's both an action and a number in gnucash, + ;; one for securities, one for banks. ((#\N) - (qif-xtn:set-number! current-xtn value)) - + (if (eq? qstate-type 'type:invst) + (qif-xtn:set-action! current-xtn value) + (qif-xtn:set-number! current-xtn value))) + ;; C : cleared flag ((#\C) (qif-xtn:set-cleared! current-xtn value)) @@ -350,9 +352,11 @@ ;; to change the category to point to the equity account that ;; the opening balance comes from. (begin - (qif-split:set-category! + (qif-split:set-category-private! (car (qif-xtn:splits xtn)) - (default-equity-category)) + (default-equity-account)) + (qif-split:set-category-is-account?! + (car (qif-xtn:splits xtn)) #t) (if (eq? (qif-file:default-account self) 'unknown) (qif-file:set-default-account! self category))) @@ -435,6 +439,10 @@ qif-xtn:cleared qif-xtn:set-cleared! qif-parse:parse-cleared-field (qif-file:xtns self) set-error) + (parse-field + qif-xtn:action qif-xtn:set-action! + qif-parse:parse-action-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) diff --git a/src/scm/qif-import/qif-objects.scm b/src/scm/qif-import/qif-objects.scm index 34a82d5962..d1830c3830 100644 --- a/src/scm/qif-import/qif-objects.scm +++ b/src/scm/qif-import/qif-objects.scm @@ -27,7 +27,6 @@ default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE y2k-threshold currency ;; this is a string.. no checking - accts-mentioned xtns markable-xtns ;; we prune xtns to speed up marking. accounts @@ -67,12 +66,6 @@ (define qif-file:set-currency! (simple-obj-setter 'currency)) -(define qif-file:accts-mentioned - (simple-obj-getter 'accts-mentioned)) - -(define qif-file:set-accts-mentioned! - (simple-obj-setter 'accts-mentioned)) - (define qif-file:cats (simple-obj-getter 'cats)) @@ -108,7 +101,6 @@ (qif-file:set-default-account! self account) (qif-file:set-currency! self currency) (qif-file:set-y2k-threshold! self 50) - (qif-file:set-accts-mentioned! self '()) (qif-file:set-xtns! self '()) (qif-file:set-accounts! self '()) (qif-file:set-cats! self '()) @@ -202,7 +194,7 @@ (define (make-simple-class 'qif-xtn - '(date payee address number cleared + '(date payee address number action cleared from-acct share-price num-shares security-name commission splits mark))) @@ -233,6 +225,12 @@ (define qif-xtn:set-number! (simple-obj-setter 'number)) +(define qif-xtn:action + (simple-obj-getter 'action)) + +(define qif-xtn:set-action! + (simple-obj-setter 'action)) + (define qif-xtn:cleared (simple-obj-getter 'cleared)) @@ -456,23 +454,6 @@ (simple-obj-print self)) (define (qif-file:add-xtn! self xtn) - (let ((splits (qif-xtn:splits xtn))) - (for-each - (lambda (split) - (let ((accts (qif-split:accounts-affected split xtn)) - (mentioned (qif-file:accts-mentioned self))) - ;; add the near account to the mentioned-list - ;; but only for the first split - (if (and (eq? (car splits) split) - (not (member (car accts) mentioned))) - (qif-file:set-accts-mentioned! - self (cons (car accts) mentioned))) - ;; add the far account for each split - (set! mentioned (qif-file:accts-mentioned self)) - (if (not (member (cadr accts) mentioned)) - (qif-file:set-accts-mentioned! - self (cons (cadr accts) mentioned))))) - splits)) (qif-file:set-xtns! self (cons xtn (qif-file:xtns self)))) diff --git a/src/scm/qif-import/qif-parse.scm b/src/scm/qif-import/qif-parse.scm index d6f781f4b8..9df1b6eec2 100644 --- a/src/scm/qif-import/qif-parse.scm +++ b/src/scm/qif-import/qif-parse.scm @@ -175,63 +175,67 @@ (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) - ((int intinc aktzu) ;; zinsen - 'intinc) - ((intx intincx) - 'intincx) - ((cglong) ;; Kapitalgewinnsteuer - 'cglong) - ((cglongx) - 'cglongx) - ((cgshort) - 'cgshort) - ((cgshortx) - 'cgshortx) - ((shrsin) - 'shrsin) - ((xin) - 'xin) - ((xout) - 'xout) - ((stksplit) - 'stksplit) - ((reinvdiv) - 'reinvdiv) - ((reinvint) - 'reinvint) - ((reinvsg) - 'reinvsg) - ((reinvsh) - 'reinvsh) - ((reinvlg reinvkur) - 'reinvlg) - ((miscinc) - 'miscinc) - ((miscincx) - 'miscincx) - ((miscexp) - 'miscexp) - ((miscexpx) - 'miscexpx) - (else - (display "qif-parse:parse-action-field : unknown action field ") - (write read-value) (newline) - 'unknown)))) + (if 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) + ((int intinc aktzu) ;; zinsen + 'intinc) + ((intx intincx) + 'intincx) + ((cglong) ;; Kapitalgewinnsteuer + 'cglong) + ((cglongx) + 'cglongx) + ((cgshort) + 'cgshort) + ((cgshortx) + 'cgshortx) + ((shrsin) + 'shrsin) + ((shrsout) + 'shrsout) + ((xin) + 'xin) + ((xout) + 'xout) + ((stksplit) + 'stksplit) + ((reinvdiv) + 'reinvdiv) + ((reinvint) + 'reinvint) + ((reinvsg) + 'reinvsg) + ((reinvsh) + 'reinvsh) + ((reinvlg reinvkur) + 'reinvlg) + ((miscinc) + 'miscinc) + ((miscincx) + 'miscincx) + ((miscexp) + 'miscexp) + ((miscexpx) + 'miscexpx) + (else + (display "qif-parse:parse-action-field : unknown action field ") + (write read-value) (newline) + #f))) + #f)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; parse-cleared-field : in a C (cleared) field in a QIF transaction, @@ -479,7 +483,8 @@ (let ((retval formats)) (for-each (lambda (amt) - (set! retval (qif-parse:check-number-format amt retval))) + (if amt + (set! retval (qif-parse:check-number-format amt retval)))) amt-strings) retval)) diff --git a/src/scm/qif-import/qif-to-gnc.scm b/src/scm/qif-import/qif-to-gnc.scm index 6fbf0f66fe..be122018e5 100644 --- a/src/scm/qif-import/qif-to-gnc.scm +++ b/src/scm/qif-import/qif-to-gnc.scm @@ -24,6 +24,7 @@ separator)) (check-full-name #f) (make-new-acct #f) + (set-security #t) (default-currency (gnc:option-value (gnc:lookup-global-option "International" "Default Currency")))) @@ -69,8 +70,7 @@ new-acct (gnc:account-get-code same-gnc-account)) (gnc:account-set-security new-acct (gnc:account-get-security same-gnc-account)))) - - + ;; make sure that if this is a nested account foo:bar:baz, ;; foo:bar and foo exist also. (if last-colon @@ -81,53 +81,87 @@ (set! parent-acct (qif-import:find-or-make-acct parent-name gnc-acct-hash gnc-type qif-info - acct-group)) - - ;; if this is a new account, use the - ;; parameters passed in - (if make-new-acct - (begin - (gnc:account-set-name new-acct acct-name) - (gnc:account-set-currency new-acct default-currency) - (if gnc-type (gnc:account-set-type new-acct gnc-type)) - (cond ((and (qif-acct? qif-info) - (qif-acct:description qif-info)) - (gnc:account-set-description - new-acct (qif-acct:description qif-info))) - ((and (qif-cat? qif-info) - (qif-cat:description qif-info)) - (gnc:account-set-description - new-acct (qif-cat:description qif-info))) - ((and (qif-xtn? qif-info) - (qif-xtn:security-name qif-info)) - (gnc:account-set-security - new-acct (qif-xtn:security-name qif-info))) - ((string? qif-info) - (gnc:account-set-description - new-acct qif-info))))) - - (gnc:account-commit-edit new-acct) - (gnc:insert-subaccount parent-acct new-acct)) + acct-group))) (begin - (if make-new-acct + (set! acct-name gnc-name))) + + ;; if this is a new account, use the + ;; parameters passed in + (if make-new-acct + (begin + (gnc:account-set-name new-acct acct-name) + (if (and gnc-type + (eq? GNC-EQUITY-TYPE gnc-type) + (qif-xtn? qif-info) + (qif-xtn:security-name qif-info)) + ;; this is the special case of the + ;; "retained holdings" equity account (begin - (gnc:account-set-name new-acct gnc-name) - (gnc:account-set-currency new-acct default-currency) - (cond ((and (qif-acct? qif-info) - (qif-acct:description qif-info)) - (gnc:account-set-description - new-acct (qif-acct:description qif-info))) - ((and (qif-cat? qif-info) - (qif-cat:description qif-info)) - (gnc:account-set-description - new-acct (qif-cat:description qif-info))) - ((string? qif-info) - (gnc:account-set-description - new-acct qif-info))) - (if gnc-type (gnc:account-set-type new-acct gnc-type)))) + (gnc:account-set-currency + new-acct (qif-xtn:security-name qif-info)) + (set! set-security #f)) + (begin + (gnc:account-set-currency new-acct + default-currency) + (set! set-security #t))) - (gnc:account-commit-edit new-acct) - (gnc:group-insert-account acct-group new-acct))) + (if gnc-type (gnc:account-set-type new-acct gnc-type)) + (cond ((and (qif-acct? qif-info) + (qif-acct:description qif-info)) + (gnc:account-set-description + new-acct (qif-acct:description qif-info))) + ((and (qif-cat? qif-info) + (qif-cat:description qif-info)) + (gnc:account-set-description + new-acct (qif-cat:description qif-info))) + ((and (qif-xtn? qif-info) + (qif-xtn:security-name qif-info) + set-security) + (gnc:account-set-security + new-acct (qif-xtn:security-name qif-info))) + ((string? qif-info) + (gnc:account-set-description + new-acct qif-info))))) + + (gnc:account-commit-edit new-acct) + (if parent-acct + (gnc:insert-subaccount parent-acct new-acct) + (gnc:group-insert-account acct-group new-acct)) + + +; (begin +; (if make-new-acct +; (begin +; (gnc:account-set-name new-acct gnc-name) +; (if (and gnc-type +; (eq? GNC-EQUITY-TYPE gnc-type) +; (qif-xtn? qif-info) +; (qif-xtn:qif-security-name qif-info)) +; ;; this is the special case of the +; ;; "retained holdings" equity account +; (begin +; (gnc:account-set-currency +; new-acct (qif-xtn:security-name qif-info)) +; (set! set-security #f)) +; (begin +; (gnc:account-set-currency new-acct +; default-currency) +; (set! set-security #t))) + +; (cond ((and (qif-acct? qif-info) +; (qif-acct:description qif-info)) +; (gnc:account-set-description +; new-acct (qif-acct:description qif-info))) +; ((and (qif-cat? qif-info) +; (qif-cat:description qif-info)) +; (gnc:account-set-description +; new-acct (qif-cat:description qif-info))) +; ((string? qif-info) +; (gnc:account-set-description +; new-acct qif-info))) +; (if gnc-type (gnc:account-set-type new-acct gnc-type)))) + +; (gnc:account-commit-edit new-acct) (hash-set! gnc-acct-hash gnc-name new-acct) new-acct)))) @@ -146,6 +180,7 @@ (account-group (gnc:get-current-group)) (gnc-acct-hash (make-hash-table 20)) (existing-gnc-accounts #f) + (sorted-accounts-list '()) (sorted-qif-files-list (sort qif-files-list (lambda (a b) @@ -160,16 +195,10 @@ (for-each (lambda (hashpair) (let* ((acctinfo (cdr hashpair)) - (qif-name (list-ref acctinfo 0)) - (gnc-name (list-ref acctinfo 1)) - (gnc-type (list-ref acctinfo 2)) - (gnc-new (list-ref acctinfo 3)) - (gnc-xtns (list-ref acctinfo 4)) - (qif-info (list-ref acctinfo 5))) + (gnc-xtns (list-ref acctinfo 4))) (if (> gnc-xtns 0) - (qif-import:find-or-make-acct gnc-name gnc-acct-hash - gnc-type qif-info - account-group)))) + (set! sorted-accounts-list + (cons acctinfo sorted-accounts-list))))) bin)) (vector->list qif-acct-map)) @@ -178,19 +207,41 @@ (for-each (lambda (hashpair) (let* ((acctinfo (cdr hashpair)) - (qif-name (list-ref acctinfo 0)) - (gnc-name (list-ref acctinfo 1)) - (gnc-type (list-ref acctinfo 2)) - (gnc-new (list-ref acctinfo 3)) - (gnc-xtns (list-ref acctinfo 4)) - (qif-info (list-ref acctinfo 5))) + (gnc-xtns (list-ref acctinfo 4))) (if (> gnc-xtns 0) - (qif-import:find-or-make-acct gnc-name gnc-acct-hash - gnc-type qif-info - account-group)))) + (set! sorted-accounts-list + (cons acctinfo sorted-accounts-list))))) bin)) (vector->list qif-cat-map)) + + ;; sort the account info on the depth of the account path. if a + ;; short part is explicitly mentioned, make sure it gets created + ;; before the deeper path, which will create the parent accounts + ;; without the information about their type. + (set! sorted-accounts-list + (sort sorted-accounts-list + (lambda (a b) + (let ((a-depth + (length (string-split-on (cadr a) #\:))) + (b-depth + (length (string-split-on (cadr b) #\:)))) + (< a-depth b-depth))))) + + (for-each + (lambda (acctinfo) + (let ((qif-name (list-ref acctinfo 0)) + (gnc-name (list-ref acctinfo 1)) + (gnc-type (list-ref acctinfo 2)) + (gnc-new (list-ref acctinfo 3)) + (gnc-xtns (list-ref acctinfo 4)) + (qif-info (list-ref acctinfo 5))) + (qif-import:find-or-make-acct gnc-name gnc-acct-hash + gnc-type qif-info + account-group))) + sorted-accounts-list) + + ;; before trying to mark transactions, prune down the list of ;; ones to match. (for-each @@ -269,11 +320,26 @@ (currency (qif-file:currency qif-file)) (qif-payee (qif-xtn:payee qif-xtn)) (qif-number (qif-xtn:number qif-xtn)) + (qif-action (qif-xtn:action 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))) + ;; set properties of the whole transaction + (apply gnc:transaction-set-date gnc-xtn (qif-xtn:date qif-xtn)) + + (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 (or (eq? qif-cleared 'cleared) + (eq? qif-cleared 'reconciled)) + (gnc:split-set-reconcile gnc-near-split #\c)) + (if (not qif-security) (begin ;; NON-STOCK TRANSACTIONS: the near account is the current @@ -346,8 +412,7 @@ ;; "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)) + (let ((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-accts #f) @@ -356,9 +421,9 @@ (far-acct-info #f) (far-acct-name #f) (far-acct #f) + (defer-share-price #f) (gnc-far-split (gnc:split-create))) - (if (not share-price) (set! share-price 0.0)) (if (not num-shares) (set! num-shares 0.0)) (if (not split-amt) (set! split-amt 0.0)) @@ -395,28 +460,49 @@ ;; the amounts and signs: are shares going in or out? ;; are amounts currency or shares? - (case action-sym - ((buy buyx reinvint reinvdiv reinvsg reinvsh reinvlg shrsin) + (case qif-action + ((buy buyx reinvint reinvdiv reinvsg reinvsh reinvlg) + (if (not share-price) (set! share-price 0.0)) (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) + ((sell sellx) + (if (not share-price) (set! share-price 0.0)) (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 - miscinc miscincx miscexp miscexpx xin) + miscinc miscincx xin) (gnc:split-set-base-value gnc-near-split split-amt currency) (gnc:split-set-base-value gnc-far-split (- split-amt) currency)) - ((xout) + ((xout miscexp miscexpx ) (gnc:split-set-base-value gnc-near-split (- split-amt) currency) (gnc:split-set-base-value gnc-far-split split-amt currency)) + ((shrsin) + ;; for shrsin, the near account is the security account. + ;; we'll need to set the share-price after a little + ;; trickery post-adding-to-account + (if (not share-price) + (set! defer-share-price #t) + (gnc:split-set-share-price gnc-near-split share-price)) + (gnc:split-set-share-amount gnc-near-split num-shares) + (gnc:split-set-base-value gnc-far-split num-shares + qif-security)) + ((shrsout) + ;; shrsout is like shrsin + (if (not share-price) + (set! defer-share-price #t) + (gnc:split-set-share-price gnc-near-split share-price)) + (gnc:split-set-share-amount gnc-near-split (- num-shares)) + (gnc:split-set-base-value gnc-far-split (- num-shares) + qif-security)) + ;; stock splits are a pain in the butt: QIF just specifies ;; the split ratio, not the number of shares in and out, ;; so we have to fetch the number of shares from the @@ -426,14 +512,15 @@ (in-shares (gnc:account-get-share-balance near-acct)) (out-shares (* in-shares splitratio))) + (if (not share-price) (set! share-price 0.0)) (gnc:split-set-share-price gnc-near-split (/ share-price splitratio)) (gnc:split-set-share-price gnc-far-split share-price) (gnc:split-set-share-amount gnc-near-split out-shares) (gnc:split-set-share-amount gnc-far-split (- in-shares)))) (else - (display "symbol = " ) (write action-sym) (newline))) - + (display "symbol = " ) (write qif-action) (newline))) + (let ((cleared (qif-split:matching-cleared (car (qif-xtn:splits qif-xtn))))) (if (or (eq? 'cleared cleared) @@ -446,22 +533,12 @@ (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-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 (or (eq? qif-cleared 'cleared) - (eq? qif-cleared 'reconciled)) - (gnc:split-set-reconcile gnc-near-split #\c)) - + (gnc:account-insert-split far-acct gnc-far-split) + + ;; now find the share price if we need to + ;; (shrsin and shrsout xtns) + (if defer-share-price + (qif-import:set-share-price gnc-near-split)))))) ;; return the modified transaction (though it's ignored). gnc-xtn)) @@ -491,7 +568,7 @@ (amount (- (qif-split:amount split))) (memo (qif-split:memo split)) (security-name (qif-xtn:security-name xtn)) - (action (qif-xtn:number xtn)) + (action (qif-xtn:action xtn)) (bank-xtn? (not security-name)) (cleared? #f) (done #f)) @@ -502,57 +579,58 @@ (if near (set! near-acct-name near) (set! near-acct-name (qif-file:default-account qif-file)))) + (let ((qif-accts - (qif-split:accounts-affected split xtn))) + (qif-split:accounts-affected split xtn))) (set! near-acct-name (car qif-accts)) - (set! far-acct-name (cadr qif-accts)))) + (set! far-acct-name (cadr qif-accts)) + (if action + ;; we need to do some special massaging to get + ;; transactions to match up. Quicken thinks the near + ;; and far accounts are different than we do. + (case action + ((intincx divx cglongx cgshortx miscincx miscexpx) + (set! amount (- amount)) + (set! near-acct-name (qif-xtn:from-acct xtn)) + (set! far-acct-name (qif-split:category split))) + ((xout sellx) + (set! amount (- amount))))))) ;; this is the grind loop. Go over every unmarked split of every ;; unmarked transaction of every file that has any transactions from ;; the far-acct-name. (let file-loop ((files qif-files)) - (if (and - (member near-acct-name - (qif-file:accts-mentioned (car files))) - (member far-acct-name - (qif-file:accts-mentioned (car files)))) - - ;; (if (and (not (eq? qif-file (car files))) - ;; (or (not bank-xtn?) - ;; (string=? far-acct-name - ;; (qif-file:account (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? - (car splits) (car xtns) - near-acct-name date amount memo) - (begin - ;;; (display "found ")(write (car splits))(newline) - (qif-split:set-mark! (car splits) #t) - (set! cleared? (qif-xtn:cleared (car xtns))) - (set! done #t) - (let ((all-marked #t)) - (for-each - (lambda (s) (if (not (qif-split:mark s)) - (set! all-marked #f))) - (qif-xtn:splits (car xtns))) - (if all-marked (qif-xtn:set-mark! - (car xtns) #t))))) - (if (and (not done) - (not (null? (cdr splits)))) - (split-loop (cdr splits))))) - (if (and (not done) - (not (null? (cdr xtns)))) - (xtn-loop (cdr xtns))))) + (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? + (car splits) (car xtns) + near-acct-name date amount memo) + (begin + (qif-split:set-mark! (car splits) #t) + (set! cleared? (qif-xtn:cleared (car xtns))) + (set! done #t) + (qif-xtn:merge-xtns xtn split (car xtns) (car splits)) + (let ((all-marked #t)) + (for-each + (lambda (s) (if (not (qif-split:mark s)) + (set! all-marked #f))) + (qif-xtn:splits (car xtns))) + (if all-marked (qif-xtn:set-mark! + (car xtns) #t))))) + (if (and (not done) + (not (null? (cdr splits)))) + (split-loop (cdr splits))))) + + (if (and (not done) + (not (null? (cdr xtns)))) + (xtn-loop (cdr xtns)))) (if (and (not done) (not (null? (cdr files)))) (file-loop (cdr files)))) cleared?)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; qif-split:split-matches? ;; check if a split matches date, amount, and other criteria @@ -563,8 +641,18 @@ ;; account name matches (string=? acct-name (qif-split:category split)) - ;; is the amount right? - (eqv? amount (qif-split:amount split)) + ;; is the amount right? flip the sign for sellx and xout + ;; transactions, since they are represented with positive values + ;; for outgoing funds. + (let ((this-amt (qif-split:amount split)) + (stock-xtn (qif-xtn:security-name xtn)) + (action (qif-xtn:action xtn))) + (if (and stock-xtn action) + (begin + (case action + ((xout sellx intincx divx cglongx cgshortx miscincx miscexpx) + (set! this-amt (- this-amt)))))) + (eqv? amount this-amt)) ;; is the date the same? (let ((self-date (qif-xtn:date xtn))) @@ -580,6 +668,7 @@ ;; ignore it for now )) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (qif-split:accounts-affected split xtn) ;; Get the near and far ends of a split, returned as a list @@ -589,61 +678,131 @@ (let ((near-acct-name #f) (far-acct-name #f) (security (qif-xtn:security-name xtn)) - (action (qif-xtn:number xtn))) + (action (qif-xtn:action xtn)) + (from-acct (qif-xtn:from-acct xtn))) ;; for non-security transactions, the near account is the ;; acct in which the xtn is, and the far is the account ;; linked by the category line. - + (if (not security) ;; non-security transactions (begin - (set! near-acct-name (qif-xtn:from-acct xtn)) + (set! near-acct-name from-acct) (set! far-acct-name (qif-split:category split))) ;; security transactions : the near end is either the ;; brokerage, the stock, or the category - (let ((action-sym (qif-parse:parse-action-field action))) - (case action-sym + (begin + (case action ((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh - reinvlg shrsin stksplit) - (set! near-acct-name security)) + reinvlg shrsin shrsout stksplit) + (set! near-acct-name (default-stock-acct from-acct security))) ((div cgshort cglong intinc miscinc miscexp xin xout) - (set! near-acct-name (qif-xtn:from-acct xtn))) - ((divx cgshortx cglongx intincx miscintx miscexpx) + (set! near-acct-name from-acct)) + ((divx cgshortx cglongx intincx miscincx miscexpx) (set! near-acct-name - (qif-split:category (car (qif-xtn:splits xtn))))) - (else - (set! near-acct-name (qif-xtn:from-acct xtn)) - (display "HEY! HEY! action-sym = ") - (display action-sym) (newline))) + (qif-split:category (car (qif-xtn:splits xtn)))))) ;; the far split: where is the money coming from? ;; Either the brokerage account, the category, ;; or an external account - (case action-sym + (case action ((buy sell) - (set! far-acct-name (qif-xtn:from-acct xtn))) + (set! far-acct-name from-acct)) ((buyx sellx miscinc miscincx miscexp miscexpx xin xout) (set! far-acct-name (qif-split:category (car (qif-xtn:splits xtn))))) ((stksplit) - (set! far-acct-name security)) + (set! far-acct-name (default-stock-acct from-acct security))) ((cgshort cgshortx reinvsg reinvsh) (set! far-acct-name - (default-cgshort-acct security))) + (default-cgshort-acct from-acct security))) ((cglong cglongx reinvlg) (set! far-acct-name - (default-cglong-acct security))) + (default-cglong-acct from-acct security))) ((intinc intincx reinvint) (set! far-acct-name - (default-interest-acct security))) + (default-interest-acct from-acct security))) ((div divx reinvdiv) (set! far-acct-name - (default-dividend-acct security))) - ((shrsin) + (default-dividend-acct from-acct security))) + ((shrsin shrsout) (set! far-acct-name - (default-equity-account)))))) - + (default-equity-holding security)))))) + (list near-acct-name far-acct-name))) - \ No newline at end of file + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-xtn:marge-xtns +;; merge-xtns merges any additional information from other-xtn into +;; xtn. this needs to be fleshed out a bit. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-xtn:merge-xtns xtn split other-xtn other-split) + ;; merge transaction fields + (let ((action (qif-xtn:action xtn)) + (o-action (qif-xtn:action other-xtn)) + (security (qif-xtn:security-name other-xtn))) + (cond + ;; this is a transfer involving a security xtn. Let the + ;; security xtn dominate the way it's handled. + ((and (not action) o-action security) + (qif-xtn:set-action! xtn o-action) + (qif-xtn:set-security-name! xtn (qif-xtn:security-name other-xtn)) + (qif-xtn:set-num-shares! xtn (qif-xtn:num-shares other-xtn)) + (qif-xtn:set-share-price! xtn (qif-xtn:share-price other-xtn)) + (qif-xtn:set-commission! xtn (qif-xtn:commission other-xtn)) + (qif-xtn:set-from-acct! + xtn (qif-xtn:from-acct other-xtn)) + (qif-split:set-amount! split (qif-split:amount other-split)) + (qif-split:set-class! split (qif-split:class other-split)) + (qif-split:set-category-is-account?! + split (qif-split:category-is-account? other-split)) + (qif-split:set-category-private! + split (qif-split:category other-split))) + + ;; this is a security transaction from one brokerage to another. + ;; The "foox" xtn has the most information about what went on, so + ;; use it. + ((and action o-action security) + (case o-action + ((buyx sellx cgshortx cglongx intincx divx) + (qif-xtn:set-action! xtn o-action) + (qif-xtn:set-security-name! xtn + (qif-xtn:security-name other-xtn)) + (qif-xtn:set-num-shares! xtn (qif-xtn:num-shares other-xtn)) + (qif-xtn:set-share-price! xtn (qif-xtn:share-price other-xtn)) + (qif-xtn:set-commission! xtn (qif-xtn:commission other-xtn)) + (qif-split:set-amount! split (qif-split:amount other-split)) + (qif-split:set-class! split (qif-split:class other-split)) + (qif-xtn:set-from-acct! + xtn (qif-xtn:from-acct other-xtn)) + (qif-split:set-category-is-account?! + split (qif-split:category-is-account? other-split)) + (qif-split:set-category-private! + split (qif-split:category other-split))))))) + ;; merge split fields + (write xtn) (newline) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-import:set-share-price split +;; find the split that precedes 'split' in the account and set split's +;; share price to that. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-import:set-share-price split) + (let* ((account (gnc:split-get-account split)) + (numsplits (gnc:account-get-split-count account))) + (let loop ((i 0) + (last-split #f)) + (let ((ith-split (gnc:account-get-split account i))) + (if (pointer-token-eq? ith-split split) + (if last-split + (gnc:split-set-share-price + split (gnc:split-get-share-price last-split))) + (if (< i numsplits) (loop (+ 1 i) ith-split))))))) +