Bill Gribble's qif patch.

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

View File

@ -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

View File

@ -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)

View File

@ -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 <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
(simple-obj-getter <qif-file> '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 <qif-xtn>
(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 <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
(simple-obj-getter <qif-xtn> '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))))

View File

@ -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))

View File

@ -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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)))))))