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@2459 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
parent
7cb10bab16
commit
93c3b8e226
@ -29,6 +29,10 @@
|
||||
|
||||
(define (default-equity-account) "Retained Earnings")
|
||||
|
||||
(define (default-commission-acct brokerage)
|
||||
(string-append "Commissions:" brokerage))
|
||||
|
||||
|
||||
;; the account-display is a 3-columned list of accounts in the QIF
|
||||
;; import dialog (the "Account" page of the notebook). Column 1 is
|
||||
;; the account name in the QIF file, column 2 is the number of QIF
|
||||
@ -203,6 +207,25 @@
|
||||
(append (qif-import:guess-acct
|
||||
qif-account qif-account-types
|
||||
gnc-acct-info)
|
||||
(list 1 xtn))))))
|
||||
|
||||
;; if there's a commission, reference the
|
||||
;; commission account
|
||||
(if (qif-xtn:commission xtn)
|
||||
(begin
|
||||
(set! qif-account
|
||||
(default-commission-acct from-acct))
|
||||
(set! entry
|
||||
(hash-ref acct-hash qif-account))
|
||||
(if entry
|
||||
(list-set! entry 4
|
||||
(+ 1 (list-ref entry 4)))
|
||||
(hash-set! acct-hash
|
||||
qif-account
|
||||
(append (qif-import:guess-acct
|
||||
qif-account
|
||||
(list GNC-EXPENSE-TYPE)
|
||||
gnc-acct-info)
|
||||
(list 1 xtn)))))))
|
||||
|
||||
;; non-stock transactions. these are a bit easier.
|
||||
|
||||
@ -401,12 +401,14 @@
|
||||
qif-cat:tax-class qif-cat:set-tax-class!
|
||||
qif-parse:check-number-format '(decimal comma)
|
||||
qif-parse:parse-number/format (qif-file:cats self)
|
||||
qif-parse:print-number
|
||||
set-error)
|
||||
|
||||
(check-and-parse-field
|
||||
qif-cat:budget-amt qif-cat:set-budget-amt!
|
||||
qif-parse:check-number-format '(decimal comma)
|
||||
qif-parse:parse-number/format (qif-file:cats self)
|
||||
qif-parse:print-number
|
||||
set-error)
|
||||
|
||||
;; fields of accounts
|
||||
@ -414,12 +416,14 @@
|
||||
qif-acct:limit qif-acct:set-limit!
|
||||
qif-parse:check-number-format '(decimal comma)
|
||||
qif-parse:parse-number/format (qif-file:accounts self)
|
||||
qif-parse:print-number
|
||||
set-error)
|
||||
|
||||
(check-and-parse-field
|
||||
qif-acct:budget qif-acct:set-budget!
|
||||
qif-parse:check-number-format '(decimal comma)
|
||||
qif-parse:parse-number/format (qif-file:accounts self)
|
||||
qif-parse:print-number
|
||||
set-error)
|
||||
|
||||
(parse-field
|
||||
@ -433,6 +437,7 @@
|
||||
qif-parse:check-date-format '(m-d-y d-m-y y-m-d y-d-m)
|
||||
qif-parse:parse-date/format
|
||||
(qif-file:xtns self)
|
||||
qif-parse:print-date
|
||||
set-error)
|
||||
|
||||
(parse-field
|
||||
@ -447,18 +452,21 @@
|
||||
qif-xtn:share-price qif-xtn:set-share-price!
|
||||
qif-parse:check-number-format '(decimal comma)
|
||||
qif-parse:parse-number/format (qif-file:xtns self)
|
||||
qif-parse:print-number
|
||||
set-error)
|
||||
|
||||
(check-and-parse-field
|
||||
qif-xtn:num-shares qif-xtn:set-num-shares!
|
||||
qif-parse:check-number-format '(decimal comma)
|
||||
qif-parse:parse-number/format (qif-file:xtns self)
|
||||
qif-parse:print-number
|
||||
set-error)
|
||||
|
||||
(check-and-parse-field
|
||||
qif-xtn:commission qif-xtn:set-commission!
|
||||
qif-parse:check-number-format '(decimal comma)
|
||||
qif-parse:parse-number/format (qif-file:xtns self)
|
||||
qif-parse:print-number
|
||||
set-error)
|
||||
|
||||
;; this one's a little tricky... it checks and sets all the
|
||||
@ -467,6 +475,7 @@
|
||||
qif-xtn:split-amounts qif-xtn:set-split-amounts!
|
||||
qif-parse:check-number-formats '(decimal comma)
|
||||
qif-parse:parse-numbers/format (qif-file:xtns self)
|
||||
qif-parse:print-numbers
|
||||
set-error)
|
||||
|
||||
(begin
|
||||
@ -508,7 +517,7 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (check-and-parse-field getter setter checker
|
||||
formats parser objects errormsg)
|
||||
formats parser objects printer errormsg)
|
||||
;; first find the right format for the field
|
||||
(let ((do-parsing #f)
|
||||
(retval #t)
|
||||
@ -544,7 +553,8 @@
|
||||
;; just ignore the format ambiguity. Otherwise, it's really an
|
||||
;; error. ATM since there's no way to correct the error let's
|
||||
;; just leave it be.
|
||||
(all-formats-equivalent? getter parser formats objects errormsg)
|
||||
(all-formats-equivalent? getter parser formats objects printer
|
||||
errormsg)
|
||||
(set! format (car formats)))
|
||||
(#t
|
||||
(set! format (car formats))))
|
||||
@ -569,7 +579,8 @@
|
||||
objects))
|
||||
retval))
|
||||
|
||||
(define (all-formats-equivalent? getter parser formats objects errormsg)
|
||||
(define (all-formats-equivalent? getter parser formats objects
|
||||
printer errormsg)
|
||||
(let ((all-ok #t))
|
||||
(let obj-loop ((objlist objects))
|
||||
(let* ((unparsed (getter (car objlist)))
|
||||
@ -586,9 +597,10 @@
|
||||
(errormsg
|
||||
(list "Parse ambiguity : between formats "
|
||||
formats "\nValue " unparsed " could be "
|
||||
parsed " or " this-parsed
|
||||
(printer parsed) " or "
|
||||
(printer this-parsed)
|
||||
"\nand no evidence exists to distinguish."
|
||||
"\nUsing " parsed ". "
|
||||
"\nUsing " (printer parsed) ". "
|
||||
"\nSee help for more info."))))))
|
||||
(cdr formats))))
|
||||
(if (and all-ok (not (null? (cdr objlist))))
|
||||
|
||||
@ -504,3 +504,22 @@
|
||||
amt-strings)))
|
||||
(if all-ok parsed #f)))
|
||||
|
||||
(define (qif-parse:print-date date-list)
|
||||
(let ((tm (localtime (current-time))))
|
||||
(set-tm:mday tm (car date-list))
|
||||
(set-tm:mon tm (- (cadr date-list) 1))
|
||||
(set-tm:year tm (- (caddr date-list) 1900))
|
||||
(strftime "%a %B %d %Y" tm)))
|
||||
|
||||
(define (qif-parse:print-number num)
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(write num))))
|
||||
|
||||
(define (qif-parse:print-numbers num)
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(write num))))
|
||||
|
||||
(define (qif-parse:print-acct-type t)
|
||||
(symbol->string (gnc:account-type->symbol t)))
|
||||
@ -128,40 +128,6 @@
|
||||
(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))))
|
||||
|
||||
@ -418,9 +384,13 @@
|
||||
(qif-accts #f)
|
||||
(qif-near-acct #f)
|
||||
(qif-far-acct #f)
|
||||
(qif-commission-acct #f)
|
||||
(far-acct-info #f)
|
||||
(far-acct-name #f)
|
||||
(far-acct #f)
|
||||
(commission-acct #f)
|
||||
(commission-amt (qif-xtn:commission qif-xtn))
|
||||
(commission-split #f)
|
||||
(defer-share-price #f)
|
||||
(gnc-far-split (gnc:split-create)))
|
||||
|
||||
@ -435,11 +405,12 @@
|
||||
(display "splits in stock transaction!") (newline)))
|
||||
|
||||
(set! qif-accts
|
||||
(qif-split:accounts-affected (qif-xtn:splits qif-xtn)
|
||||
(qif-split:accounts-affected (car (qif-xtn:splits qif-xtn))
|
||||
qif-xtn))
|
||||
|
||||
(set! qif-near-acct (car qif-accts))
|
||||
(set! qif-far-acct (cadr qif-accts))
|
||||
(set! qif-commission-acct (caddr qif-accts))
|
||||
|
||||
;; translate the QIF account names into Gnucash accounts
|
||||
(if (and qif-near-acct qif-far-acct)
|
||||
@ -527,6 +498,21 @@
|
||||
(eq? 'reconciled cleared))
|
||||
(gnc:split-set-reconcile gnc-far-split #\c)))
|
||||
|
||||
(if qif-commission-acct
|
||||
(let* ((commission-acct-info
|
||||
(or (hash-ref qif-acct-map qif-commission-acct)
|
||||
(hash-ref qif-cat-map qif-commission-acct)))
|
||||
(commission-acct-name
|
||||
(list-ref commission-acct-info 1)))
|
||||
(set! commission-acct
|
||||
(hash-ref gnc-acct-hash commission-acct-name))))
|
||||
|
||||
(if (and commission-amt commission-acct)
|
||||
(begin
|
||||
(set! commission-split (gnc:split-create))
|
||||
(gnc:split-set-base-value commission-split commission-amt
|
||||
currency)))
|
||||
|
||||
(if (and qif-near-acct qif-far-acct)
|
||||
(begin
|
||||
(gnc:transaction-append-split gnc-xtn gnc-near-split)
|
||||
@ -535,6 +521,12 @@
|
||||
(gnc:transaction-append-split gnc-xtn gnc-far-split)
|
||||
(gnc:account-insert-split far-acct gnc-far-split)
|
||||
|
||||
(if commission-split
|
||||
(begin
|
||||
(gnc:transaction-append-split gnc-xtn commission-split)
|
||||
(gnc:account-insert-split commission-acct
|
||||
commission-split)))
|
||||
|
||||
;; now find the share price if we need to
|
||||
;; (shrsin and shrsout xtns)
|
||||
(if defer-share-price
|
||||
@ -542,6 +534,7 @@
|
||||
;; return the modified transaction (though it's ignored).
|
||||
gnc-xtn))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; qif-import:mark-matching-xtns
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@ -677,6 +670,7 @@
|
||||
(define (qif-split:accounts-affected split xtn)
|
||||
(let ((near-acct-name #f)
|
||||
(far-acct-name #f)
|
||||
(commission-acct-name #f)
|
||||
(security (qif-xtn:security-name xtn))
|
||||
(action (qif-xtn:action xtn))
|
||||
(from-acct (qif-xtn:from-acct xtn)))
|
||||
@ -729,9 +723,14 @@
|
||||
(default-dividend-acct from-acct security)))
|
||||
((shrsin shrsout)
|
||||
(set! far-acct-name
|
||||
(default-equity-holding security))))))
|
||||
(default-equity-holding security))))
|
||||
|
||||
(list near-acct-name far-acct-name)))
|
||||
;; the commission account, if it exists
|
||||
(if (qif-xtn:commission xtn)
|
||||
(set! commission-acct-name
|
||||
(default-commission-acct from-acct)))))
|
||||
|
||||
(list near-acct-name far-acct-name commission-acct-name)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@ -782,10 +781,7 @@
|
||||
(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)
|
||||
)
|
||||
split (qif-split:category other-split))))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user