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

Bill Gribble's qif patch.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2456 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-06-12 21:50:58 +00:00
parent 2069a63ddc
commit 08635f8e8e
5 changed files with 433 additions and 282 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
src/scm/qif-import/qif-dialog-utils.scm
View File

@ -9,20 +9,25 @@
(gnc:support "qif-import/qif-dialog-utils.scm") (gnc:support "qif-import/qif-dialog-utils.scm")
(define (default-dividend-acct security) (define (default-stock-acct brokerage security)
(string-append "Dividends:" security)) (string-append brokerage ":" security))
(define (default-interest-acct security) (define (default-dividend-acct brokerage security)
(string-append "Interest:" security)) (string-append "Dividends:" brokerage ":" security))
(define (default-cglong-acct security) (define (default-interest-acct brokerage security)
(string-append "Cap. gain (long):" security)) (string-append "Interest:" brokerage ":" security))
(define (default-cgshort-acct security) (define (default-cglong-acct brokerage security)
(string-append "Cap. gain (short):" security)) (string-append "Cap. gain (long):" brokerage ":" security))
(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") (define (default-equity-account) "Retained Earnings")
(define (default-equity-category) "[Retained Earnings]")
;; the account-display is a 3-columned list of accounts in the QIF ;; the account-display is a 3-columned list of accounts in the QIF
;; import dialog (the "Account" page of the notebook). Column 1 is ;; import dialog (the "Account" page of the notebook). Column 1 is
@ -72,14 +77,13 @@
(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:number xtn)) (action (qif-xtn:action xtn))
(action-sym #f)
(from-acct (qif-xtn:from-acct xtn)) (from-acct (qif-xtn:from-acct xtn))
(qif-account #f) (qif-account #f)
(qif-account-types #f) (qif-account-types #f)
(entry #f)) (entry #f))
(if (and stock-acct (string? 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,
;; the brokerage, a dividend account, a long-term CG ;; the brokerage, a dividend account, a long-term CG
@ -87,14 +91,14 @@
;; account. Make sure all of the right ones get stuck ;; account. Make sure all of the right ones get stuck
;; in the map. ;; in the map.
(begin (begin
(set! action-sym (qif-parse:parse-action-field action))
;; 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-sym (case action
((buy buyx sell sellx reinvint reinvdiv reinvsh reinvsg ((buy buyx sell sellx reinvint reinvdiv reinvsh reinvsg
reinvlg shrsin stksplit) reinvlg shrsin shrsout stksplit)
(set! qif-account stock-acct) (set! qif-account
(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 cglong intinc miscinc miscexp xin xout) ((div cgshort cglong intinc miscinc miscexp xin xout)
@ -107,10 +111,7 @@
(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))))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; now reference the near-end account ;; now reference the near-end account
(if qif-account (if qif-account
@ -128,12 +129,12 @@
;; 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 ;; sellx, etc, or an equity account for ShrsIn/ShrsOut
;; miscintx and miscexpx are very, very "special" ;; miscintx and miscexpx are very, very "special"
;; cases which I don't quite handle correctly yet. ;; cases which I don't quite handle correctly yet.
(set! qif-account #f) (set! qif-account #f)
(case action-sym (case action
((buy sell) ((buy sell)
(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
@ -146,12 +147,13 @@
GNC-CCARD-TYPE))) GNC-CCARD-TYPE)))
((stksplit) ((stksplit)
(set! qif-account stock-acct) (set! qif-account
(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)))
((cgshort cgshortx reinvsg reinvsh) ((cgshort cgshortx reinvsg reinvsh)
(set! qif-account (set! qif-account
(default-cgshort-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)))
((miscincx) ((miscincx)
@ -168,31 +170,27 @@
((cglong cglongx reinvlg) ((cglong cglongx reinvlg)
(set! qif-account (set! qif-account
(default-cglong-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 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 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)))
((shrsin) ((shrsin shrsout)
(set! qif-account (set! qif-account
(default-equity-account)) (default-equity-holding stock-acct))
(set! qif-account-types (list GNC-EQUITY-TYPE))) (set! qif-account-types (list GNC-EQUITY-TYPE)))
((miscinc miscexp) ((miscinc miscexp)
;; these reference a category on the other end ;; these reference a category on the other end
(set! qif-account #f)) (set! qif-account #f)))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; now reference the far-end account ;; now reference the far-end account
(if qif-account (if qif-account

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

@ -116,10 +116,12 @@
(string-append current "\n" value)))) (string-append current "\n" value))))
;; N : check number / transaction number /xtn direction ;; N : check number / transaction number /xtn direction
;; this could be a number or a string; no point in ;; there's both an action and a number in gnucash,
;; keeping it numeric just yet. ;; one for securities, one for banks.
((#\N) ((#\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 : cleared flag
((#\C) ((#\C)
@ -350,9 +352,11 @@
;; to change the category to point to the equity account that ;; to change the category to point to the equity account that
;; the opening balance comes from. ;; the opening balance comes from.
(begin (begin
(qif-split:set-category! (qif-split:set-category-private!
(car (qif-xtn:splits xtn)) (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) (if (eq? (qif-file:default-account self) 'unknown)
(qif-file:set-default-account! self category))) (qif-file:set-default-account! self category)))
@ -435,6 +439,10 @@
qif-xtn:cleared qif-xtn:set-cleared! qif-xtn:cleared qif-xtn:set-cleared!
qif-parse:parse-cleared-field (qif-file:xtns self) set-error) 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 (check-and-parse-field
qif-xtn:share-price qif-xtn:set-share-price! qif-xtn:share-price qif-xtn:set-share-price!
qif-parse:check-number-format '(decimal comma) qif-parse:check-number-format '(decimal comma)

33
src/scm/qif-import/qif-objects.scm
View File

@ -27,7 +27,6 @@
default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE
y2k-threshold y2k-threshold
currency ;; this is a string.. no checking currency ;; this is a string.. no checking
accts-mentioned
xtns xtns
markable-xtns ;; we prune xtns to speed up marking. markable-xtns ;; we prune xtns to speed up marking.
accounts accounts
@ -67,12 +66,6 @@
(define qif-file:set-currency! (define qif-file:set-currency!
(simple-obj-setter <qif-file> 'currency)) (simple-obj-setter <qif-file> 'currency))
(define qif-file:accts-mentioned
(simple-obj-getter <qif-file> 'accts-mentioned))
(define qif-file:set-accts-mentioned!
(simple-obj-setter <qif-file> 'accts-mentioned))
(define qif-file:cats (define qif-file:cats
(simple-obj-getter <qif-file> 'cats)) (simple-obj-getter <qif-file> 'cats))
@ -108,7 +101,6 @@
(qif-file:set-default-account! self account) (qif-file:set-default-account! self account)
(qif-file:set-currency! self currency) (qif-file:set-currency! self currency)
(qif-file:set-y2k-threshold! self 50) (qif-file:set-y2k-threshold! self 50)
(qif-file:set-accts-mentioned! self '())
(qif-file:set-xtns! self '()) (qif-file:set-xtns! self '())
(qif-file:set-accounts! self '()) (qif-file:set-accounts! self '())
(qif-file:set-cats! self '()) (qif-file:set-cats! self '())
@ -202,7 +194,7 @@
(define <qif-xtn> (define <qif-xtn>
(make-simple-class (make-simple-class
'qif-xtn 'qif-xtn
'(date payee address number cleared '(date payee address number action cleared
from-acct share-price num-shares security-name commission from-acct share-price num-shares security-name commission
splits mark))) splits mark)))
@ -233,6 +225,12 @@
(define qif-xtn:set-number! (define qif-xtn:set-number!
(simple-obj-setter <qif-xtn> 'number)) (simple-obj-setter <qif-xtn> 'number))
(define qif-xtn:action
(simple-obj-getter <qif-xtn> 'action))
(define qif-xtn:set-action!
(simple-obj-setter <qif-xtn> 'action))
(define qif-xtn:cleared (define qif-xtn:cleared
(simple-obj-getter <qif-xtn> 'cleared)) (simple-obj-getter <qif-xtn> 'cleared))
@ -456,23 +454,6 @@
(simple-obj-print self)) (simple-obj-print self))
(define (qif-file:add-xtn! self xtn) (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 (qif-file:set-xtns! self
(cons xtn (qif-file:xtns self)))) (cons xtn (qif-file:xtns self))))

9
src/scm/qif-import/qif-parse.scm
View File

@ -175,6 +175,7 @@
(define (qif-parse:parse-action-field read-value) (define (qif-parse:parse-action-field read-value)
(if read-value
(let ((action-symbol (string-to-canonical-symbol read-value))) (let ((action-symbol (string-to-canonical-symbol read-value)))
(case action-symbol (case action-symbol
;; buy ;; buy
@ -204,6 +205,8 @@
'cgshortx) 'cgshortx)
((shrsin) ((shrsin)
'shrsin) 'shrsin)
((shrsout)
'shrsout)
((xin) ((xin)
'xin) 'xin)
((xout) ((xout)
@ -231,7 +234,8 @@
(else (else
(display "qif-parse:parse-action-field : unknown action field ") (display "qif-parse:parse-action-field : unknown action field ")
(write read-value) (newline) (write read-value) (newline)
'unknown)))) #f)))
#f))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse-cleared-field : in a C (cleared) field in a QIF transaction, ;; parse-cleared-field : in a C (cleared) field in a QIF transaction,
@ -479,7 +483,8 @@
(let ((retval formats)) (let ((retval formats))
(for-each (for-each
(lambda (amt) (lambda (amt)
(set! retval (qif-parse:check-number-format amt retval))) (if amt
(set! retval (qif-parse:check-number-format amt retval))))
amt-strings) amt-strings)
retval)) retval))

361
src/scm/qif-import/qif-to-gnc.scm
View File

@ -24,6 +24,7 @@
separator)) separator))
(check-full-name #f) (check-full-name #f)
(make-new-acct #f) (make-new-acct #f)
(set-security #t)
(default-currency (default-currency
(gnc:option-value (gnc:option-value
(gnc:lookup-global-option "International" "Default Currency")))) (gnc:lookup-global-option "International" "Default Currency"))))
@ -70,7 +71,6 @@
(gnc:account-set-security (gnc:account-set-security
new-acct (gnc:account-get-security same-gnc-account)))) new-acct (gnc:account-get-security same-gnc-account))))
;; make sure that if this is a nested account foo:bar:baz, ;; make sure that if this is a nested account foo:bar:baz,
;; foo:bar and foo exist also. ;; foo:bar and foo exist also.
(if last-colon (if last-colon
@ -81,14 +81,30 @@
(set! parent-acct (qif-import:find-or-make-acct (set! parent-acct (qif-import:find-or-make-acct
parent-name gnc-acct-hash parent-name gnc-acct-hash
gnc-type qif-info gnc-type qif-info
acct-group)) acct-group)))
(begin
(set! acct-name gnc-name)))
;; if this is a new account, use the ;; if this is a new account, use the
;; parameters passed in ;; parameters passed in
(if make-new-acct (if make-new-acct
(begin (begin
(gnc:account-set-name new-acct acct-name) (gnc:account-set-name new-acct acct-name)
(gnc:account-set-currency new-acct default-currency) (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-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)))
(if gnc-type (gnc:account-set-type new-acct gnc-type)) (if gnc-type (gnc:account-set-type new-acct gnc-type))
(cond ((and (qif-acct? qif-info) (cond ((and (qif-acct? qif-info)
(qif-acct:description qif-info)) (qif-acct:description qif-info))
@ -99,7 +115,8 @@
(gnc:account-set-description (gnc:account-set-description
new-acct (qif-cat:description qif-info))) new-acct (qif-cat:description qif-info)))
((and (qif-xtn? qif-info) ((and (qif-xtn? qif-info)
(qif-xtn:security-name qif-info)) (qif-xtn:security-name qif-info)
set-security)
(gnc:account-set-security (gnc:account-set-security
new-acct (qif-xtn:security-name qif-info))) new-acct (qif-xtn:security-name qif-info)))
((string? qif-info) ((string? qif-info)
@ -107,27 +124,44 @@
new-acct qif-info))))) new-acct qif-info)))))
(gnc:account-commit-edit new-acct) (gnc:account-commit-edit new-acct)
(gnc:insert-subaccount parent-acct new-acct)) (if parent-acct
(begin (gnc:insert-subaccount parent-acct new-acct)
(if make-new-acct (gnc:group-insert-account acct-group new-acct))
(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-commit-edit 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) (hash-set! gnc-acct-hash gnc-name new-acct)
new-acct)))) new-acct))))
@ -146,6 +180,7 @@
(account-group (gnc:get-current-group)) (account-group (gnc:get-current-group))
(gnc-acct-hash (make-hash-table 20)) (gnc-acct-hash (make-hash-table 20))
(existing-gnc-accounts #f) (existing-gnc-accounts #f)
(sorted-accounts-list '())
(sorted-qif-files-list (sorted-qif-files-list
(sort qif-files-list (sort qif-files-list
(lambda (a b) (lambda (a b)
@ -160,16 +195,10 @@
(for-each (for-each
(lambda (hashpair) (lambda (hashpair)
(let* ((acctinfo (cdr hashpair)) (let* ((acctinfo (cdr hashpair))
(qif-name (list-ref acctinfo 0)) (gnc-xtns (list-ref acctinfo 4)))
(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)))
(if (> gnc-xtns 0) (if (> gnc-xtns 0)
(qif-import:find-or-make-acct gnc-name gnc-acct-hash (set! sorted-accounts-list
gnc-type qif-info (cons acctinfo sorted-accounts-list)))))
account-group))))
bin)) bin))
(vector->list qif-acct-map)) (vector->list qif-acct-map))
@ -178,18 +207,40 @@
(for-each (for-each
(lambda (hashpair) (lambda (hashpair)
(let* ((acctinfo (cdr hashpair)) (let* ((acctinfo (cdr hashpair))
(qif-name (list-ref acctinfo 0)) (gnc-xtns (list-ref acctinfo 4)))
(if (> gnc-xtns 0)
(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-name (list-ref acctinfo 1))
(gnc-type (list-ref acctinfo 2)) (gnc-type (list-ref acctinfo 2))
(gnc-new (list-ref acctinfo 3)) (gnc-new (list-ref acctinfo 3))
(gnc-xtns (list-ref acctinfo 4)) (gnc-xtns (list-ref acctinfo 4))
(qif-info (list-ref acctinfo 5))) (qif-info (list-ref acctinfo 5)))
(if (> gnc-xtns 0)
(qif-import:find-or-make-acct gnc-name gnc-acct-hash (qif-import:find-or-make-acct gnc-name gnc-acct-hash
gnc-type qif-info gnc-type qif-info
account-group)))) account-group)))
bin)) sorted-accounts-list)
(vector->list qif-cat-map))
;; before trying to mark transactions, prune down the list of ;; before trying to mark transactions, prune down the list of
;; ones to match. ;; ones to match.
@ -269,11 +320,26 @@
(currency (qif-file:currency qif-file)) (currency (qif-file:currency qif-file))
(qif-payee (qif-xtn:payee qif-xtn)) (qif-payee (qif-xtn:payee qif-xtn))
(qif-number (qif-xtn:number 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-security (qif-xtn:security-name qif-xtn))
(qif-memo (qif-split:memo (car (qif-xtn:splits qif-xtn)))) (qif-memo (qif-split:memo (car (qif-xtn:splits qif-xtn))))
(qif-from-acct (qif-xtn:from-acct qif-xtn)) (qif-from-acct (qif-xtn:from-acct qif-xtn))
(qif-cleared (qif-xtn:cleared 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) (if (not qif-security)
(begin (begin
;; NON-STOCK TRANSACTIONS: the near account is the current ;; NON-STOCK TRANSACTIONS: the near account is the current
@ -346,8 +412,7 @@
;; "action" encoded in the Number field. It's generally the ;; "action" encoded in the Number field. It's generally the
;; security account (for buys, sells, and reinvests) but can ;; security account (for buys, sells, and reinvests) but can
;; also be an interest, dividend, or SG/LG account. ;; also be an interest, dividend, or SG/LG account.
(let ((action-sym (qif-parse:parse-action-field qif-number)) (let ((share-price (qif-xtn:share-price qif-xtn))
(share-price (qif-xtn:share-price qif-xtn))
(num-shares (qif-xtn:num-shares qif-xtn)) (num-shares (qif-xtn:num-shares qif-xtn))
(split-amt (qif-split:amount (car (qif-xtn:splits qif-xtn)))) (split-amt (qif-split:amount (car (qif-xtn:splits qif-xtn))))
(qif-accts #f) (qif-accts #f)
@ -356,9 +421,9 @@
(far-acct-info #f) (far-acct-info #f)
(far-acct-name #f) (far-acct-name #f)
(far-acct #f) (far-acct #f)
(defer-share-price #f)
(gnc-far-split (gnc:split-create))) (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 num-shares) (set! num-shares 0.0))
(if (not split-amt) (set! split-amt 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? ;; the amounts and signs: are shares going in or out?
;; are amounts currency or shares? ;; are amounts currency or shares?
(case action-sym (case qif-action
((buy buyx reinvint reinvdiv reinvsg reinvsh reinvlg shrsin) ((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-near-split share-price)
(gnc:split-set-share-price gnc-far-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-near-split num-shares)
(gnc:split-set-share-amount gnc-far-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-near-split share-price)
(gnc:split-set-share-price gnc-far-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-near-split (- num-shares))
(gnc:split-set-share-amount gnc-far-split num-shares)) (gnc:split-set-share-amount gnc-far-split num-shares))
((cgshort cgshortx cglong cglongx intinc intincx div divx ((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-near-split split-amt currency)
(gnc:split-set-base-value gnc-far-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-near-split (- split-amt) currency)
(gnc:split-set-base-value gnc-far-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 ;; stock splits are a pain in the butt: QIF just specifies
;; the split ratio, not the number of shares in and out, ;; the split ratio, not the number of shares in and out,
;; so we have to fetch the number of shares from the ;; so we have to fetch the number of shares from the
@ -426,13 +512,14 @@
(in-shares (in-shares
(gnc:account-get-share-balance near-acct)) (gnc:account-get-share-balance near-acct))
(out-shares (* in-shares splitratio))) (out-shares (* in-shares splitratio)))
(if (not share-price) (set! share-price 0.0))
(gnc:split-set-share-price gnc-near-split (gnc:split-set-share-price gnc-near-split
(/ share-price splitratio)) (/ share-price splitratio))
(gnc:split-set-share-price gnc-far-split share-price) (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-near-split out-shares)
(gnc:split-set-share-amount gnc-far-split (- in-shares)))) (gnc:split-set-share-amount gnc-far-split (- in-shares))))
(else (else
(display "symbol = " ) (write action-sym) (newline))) (display "symbol = " ) (write qif-action) (newline)))
(let ((cleared (qif-split:matching-cleared (let ((cleared (qif-split:matching-cleared
(car (qif-xtn:splits qif-xtn))))) (car (qif-xtn:splits qif-xtn)))))
@ -446,22 +533,12 @@
(gnc:account-insert-split near-acct gnc-near-split) (gnc:account-insert-split near-acct gnc-near-split)
(gnc:transaction-append-split gnc-xtn gnc-far-split) (gnc:transaction-append-split gnc-xtn gnc-far-split)
(gnc:account-insert-split far-acct 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))
;; 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). ;; return the modified transaction (though it's ignored).
gnc-xtn)) gnc-xtn))
@ -491,7 +568,7 @@
(amount (- (qif-split:amount split))) (amount (- (qif-split:amount split)))
(memo (qif-split:memo split)) (memo (qif-split:memo split))
(security-name (qif-xtn:security-name xtn)) (security-name (qif-xtn:security-name xtn))
(action (qif-xtn:number xtn)) (action (qif-xtn:action xtn))
(bank-xtn? (not security-name)) (bank-xtn? (not security-name))
(cleared? #f) (cleared? #f)
(done #f)) (done #f))
@ -502,26 +579,27 @@
(if near (if near
(set! near-acct-name near) (set! near-acct-name near)
(set! near-acct-name (qif-file:default-account qif-file)))) (set! near-acct-name (qif-file:default-account qif-file))))
(let ((qif-accts (let ((qif-accts
(qif-split:accounts-affected split xtn))) (qif-split:accounts-affected split xtn)))
(set! near-acct-name (car qif-accts)) (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 ;; this is the grind loop. Go over every unmarked split of every
;; unmarked transaction of every file that has any transactions from ;; unmarked transaction of every file that has any transactions from
;; the far-acct-name. ;; the far-acct-name.
(let file-loop ((files qif-files)) (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)))) (let xtn-loop ((xtns (qif-file:markable-xtns (car files))))
(if (not (qif-xtn:mark (car xtns))) (if (not (qif-xtn:mark (car xtns)))
(let split-loop ((splits (qif-xtn:splits (car xtns)))) (let split-loop ((splits (qif-xtn:splits (car xtns))))
@ -529,10 +607,10 @@
(car splits) (car xtns) (car splits) (car xtns)
near-acct-name date amount memo) near-acct-name date amount memo)
(begin (begin
;;; (display "found ")(write (car splits))(newline)
(qif-split:set-mark! (car splits) #t) (qif-split:set-mark! (car splits) #t)
(set! cleared? (qif-xtn:cleared (car xtns))) (set! cleared? (qif-xtn:cleared (car xtns)))
(set! done #t) (set! done #t)
(qif-xtn:merge-xtns xtn split (car xtns) (car splits))
(let ((all-marked #t)) (let ((all-marked #t))
(for-each (for-each
(lambda (s) (if (not (qif-split:mark s)) (lambda (s) (if (not (qif-split:mark s))
@ -543,16 +621,16 @@
(if (and (not done) (if (and (not done)
(not (null? (cdr splits)))) (not (null? (cdr splits))))
(split-loop (cdr splits))))) (split-loop (cdr splits)))))
(if (and (not done) (if (and (not done)
(not (null? (cdr xtns)))) (not (null? (cdr xtns))))
(xtn-loop (cdr xtns))))) (xtn-loop (cdr xtns))))
(if (and (not done) (if (and (not done)
(not (null? (cdr files)))) (not (null? (cdr files))))
(file-loop (cdr files)))) (file-loop (cdr files))))
cleared?)) cleared?))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-split:split-matches? ;; qif-split:split-matches?
;; check if a split matches date, amount, and other criteria ;; check if a split matches date, amount, and other criteria
@ -563,8 +641,18 @@
;; account name matches ;; account name matches
(string=? acct-name (qif-split:category split)) (string=? acct-name (qif-split:category split))
;; is the amount right? ;; is the amount right? flip the sign for sellx and xout
(eqv? amount (qif-split:amount split)) ;; 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? ;; is the date the same?
(let ((self-date (qif-xtn:date xtn))) (let ((self-date (qif-xtn:date xtn)))
@ -580,6 +668,7 @@
;; ignore it for now ;; ignore it for now
)) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (qif-split:accounts-affected split xtn) ;; (qif-split:accounts-affected split xtn)
;; Get the near and far ends of a split, returned as a list ;; Get the near and far ends of a split, returned as a list
@ -589,7 +678,8 @@
(let ((near-acct-name #f) (let ((near-acct-name #f)
(far-acct-name #f) (far-acct-name #f)
(security (qif-xtn:security-name xtn)) (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 ;; for non-security transactions, the near account is the
;; acct in which the xtn is, and the far is the account ;; acct in which the xtn is, and the far is the account
@ -598,52 +688,121 @@
(if (not security) (if (not security)
;; non-security transactions ;; non-security transactions
(begin (begin
(set! near-acct-name (qif-xtn:from-acct xtn)) (set! near-acct-name from-acct)
(set! far-acct-name (qif-split:category split))) (set! far-acct-name (qif-split:category split)))
;; security transactions : the near end is either the ;; security transactions : the near end is either the
;; brokerage, the stock, or the category ;; brokerage, the stock, or the category
(let ((action-sym (qif-parse:parse-action-field action))) (begin
(case action-sym (case action
((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh ((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh
reinvlg shrsin stksplit) reinvlg shrsin shrsout stksplit)
(set! near-acct-name security)) (set! near-acct-name (default-stock-acct from-acct security)))
((div cgshort cglong intinc miscinc miscexp xin xout) ((div cgshort cglong intinc miscinc miscexp xin xout)
(set! near-acct-name (qif-xtn:from-acct xtn))) (set! near-acct-name from-acct))
((divx cgshortx cglongx intincx miscintx miscexpx) ((divx cgshortx cglongx intincx miscincx miscexpx)
(set! near-acct-name (set! near-acct-name
(qif-split:category (car (qif-xtn:splits xtn))))) (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)))
;; the far split: where is the money coming from? ;; the far split: where is the money coming from?
;; Either the brokerage account, the category, ;; Either the brokerage account, the category,
;; or an external account ;; or an external account
(case action-sym (case action
((buy sell) ((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) ((buyx sellx miscinc miscincx miscexp miscexpx xin xout)
(set! far-acct-name (set! far-acct-name
(qif-split:category (car (qif-xtn:splits xtn))))) (qif-split:category (car (qif-xtn:splits xtn)))))
((stksplit) ((stksplit)
(set! far-acct-name security)) (set! far-acct-name (default-stock-acct from-acct security)))
((cgshort cgshortx reinvsg reinvsh) ((cgshort cgshortx reinvsg reinvsh)
(set! far-acct-name (set! far-acct-name
(default-cgshort-acct security))) (default-cgshort-acct from-acct security)))
((cglong cglongx reinvlg) ((cglong cglongx reinvlg)
(set! far-acct-name (set! far-acct-name
(default-cglong-acct security))) (default-cglong-acct from-acct security)))
((intinc intincx reinvint) ((intinc intincx reinvint)
(set! far-acct-name (set! far-acct-name
(default-interest-acct security))) (default-interest-acct from-acct security)))
((div divx reinvdiv) ((div divx reinvdiv)
(set! far-acct-name (set! far-acct-name
(default-dividend-acct security))) (default-dividend-acct from-acct security)))
((shrsin) ((shrsin shrsout)
(set! far-acct-name (set! far-acct-name
(default-equity-account)))))) (default-equity-holding security))))))
(list near-acct-name far-acct-name))) (list near-acct-name far-acct-name)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)))))))