mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
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
parent
2069a63ddc
commit
08635f8e8e
@ -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-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-category) "[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
|
||||
|
||||
@ -116,10 +116,12 @@
|
||||
(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)
|
||||
@ -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)
|
||||
|
||||
@ -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))))
|
||||
|
||||
|
||||
@ -175,6 +175,7 @@
|
||||
|
||||
|
||||
(define (qif-parse:parse-action-field read-value)
|
||||
(if read-value
|
||||
(let ((action-symbol (string-to-canonical-symbol read-value)))
|
||||
(case action-symbol
|
||||
;; buy
|
||||
@ -204,6 +205,8 @@
|
||||
'cgshortx)
|
||||
((shrsin)
|
||||
'shrsin)
|
||||
((shrsout)
|
||||
'shrsout)
|
||||
((xin)
|
||||
'xin)
|
||||
((xout)
|
||||
@ -231,7 +234,8 @@
|
||||
(else
|
||||
(display "qif-parse:parse-action-field : unknown action field ")
|
||||
(write read-value) (newline)
|
||||
'unknown))))
|
||||
#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))
|
||||
|
||||
|
||||
@ -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"))))
|
||||
@ -70,7 +71,6 @@
|
||||
(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,14 +81,30 @@
|
||||
(set! parent-acct (qif-import:find-or-make-acct
|
||||
parent-name gnc-acct-hash
|
||||
gnc-type qif-info
|
||||
acct-group))
|
||||
acct-group)))
|
||||
(begin
|
||||
(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)
|
||||
(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))
|
||||
(cond ((and (qif-acct? qif-info)
|
||||
(qif-acct:description qif-info))
|
||||
@ -99,7 +115,8 @@
|
||||
(gnc:account-set-description
|
||||
new-acct (qif-cat:description 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
|
||||
new-acct (qif-xtn:security-name qif-info)))
|
||||
((string? qif-info)
|
||||
@ -107,27 +124,44 @@
|
||||
new-acct qif-info)))))
|
||||
|
||||
(gnc:account-commit-edit new-acct)
|
||||
(gnc:insert-subaccount parent-acct new-acct))
|
||||
(begin
|
||||
(if make-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))))
|
||||
(if parent-acct
|
||||
(gnc:insert-subaccount parent-acct new-acct)
|
||||
(gnc:group-insert-account acct-group new-acct))
|
||||
|
||||
(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)
|
||||
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,18 +207,40 @@
|
||||
(for-each
|
||||
(lambda (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-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)
|
||||
(qif-import:find-or-make-acct gnc-name gnc-acct-hash
|
||||
gnc-type qif-info
|
||||
account-group))))
|
||||
bin))
|
||||
(vector->list qif-cat-map))
|
||||
account-group)))
|
||||
sorted-accounts-list)
|
||||
|
||||
|
||||
;; before trying to mark transactions, prune down the list of
|
||||
;; ones to match.
|
||||
@ -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)
|
||||
(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,13 +512,14 @@
|
||||
(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)))))
|
||||
@ -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,26 +579,27 @@
|
||||
(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)))
|
||||
(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))))
|
||||
@ -529,10 +607,10 @@
|
||||
(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)
|
||||
(qif-xtn:merge-xtns xtn split (car xtns) (car splits))
|
||||
(let ((all-marked #t))
|
||||
(for-each
|
||||
(lambda (s) (if (not (qif-split:mark s))
|
||||
@ -543,16 +621,16 @@
|
||||
(if (and (not done)
|
||||
(not (null? (cdr splits))))
|
||||
(split-loop (cdr splits)))))
|
||||
|
||||
(if (and (not done)
|
||||
(not (null? (cdr xtns))))
|
||||
(xtn-loop (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,7 +678,8 @@
|
||||
(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
|
||||
@ -598,52 +688,121 @@
|
||||
(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)))))))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user