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

Robert Merkel's patch to average-balance.scm. Bill Gribble's qif import patch.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2443 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-06-08 19:51:16 +00:00
parent 7768c07faa
commit 00972f5231
10 changed files with 345 additions and 244 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
ChangeLog
View File

@ -1,3 +1,8 @@
2000-06-08 Robert Graham Merkel <rgmerk@mira.net>
* src/scm/report/average-balance.scm (average-balance-renderer):
added a condition to catch incorrectly entered dates without crashing.
2000-06-07 Dave Peticolas <dave@krondo.com> 2000-06-07 Dave Peticolas <dave@krondo.com>
* src/engine/Query.c: fixed a "dave is an idiot" bug in cropping * src/engine/Query.c: fixed a "dave is an idiot" bug in cropping

8
po/gnucash.pot
View File

@ -6,7 +6,7 @@
msgid "" msgid ""
msgstr "" msgstr ""
"Project-Id-Version: PACKAGE VERSION\n" "Project-Id-Version: PACKAGE VERSION\n"
"POT-Creation-Date: 2000-06-04 17:16-0700\n" "POT-Creation-Date: 2000-06-08 12:48-0700\n"
"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <LL@li.org>\n" "Language-Team: LANGUAGE <LL@li.org>\n"
@ -2977,8 +2977,8 @@ msgstr ""
msgid "You must specify a currency." msgid "You must specify a currency."
msgstr "" msgstr ""
#: src/gnome/dialog-qif-import.c:270 src/gnome/dialog-qif-import.c:619 #: src/gnome/dialog-qif-import.c:270 src/gnome/dialog-qif-import.c:622
#: src/gnome/dialog-qif-import.c:676 src/gnome/dialog-qif-import.c:774 #: src/gnome/dialog-qif-import.c:679 src/gnome/dialog-qif-import.c:777
msgid "QIF File scheme code not loaded properly." msgid "QIF File scheme code not loaded properly."
msgstr "" msgstr ""
@ -2986,7 +2986,7 @@ msgstr ""
msgid "QIF File already loaded. Reload with current settings?" msgid "QIF File already loaded. Reload with current settings?"
msgstr "" msgstr ""
#: src/gnome/dialog-qif-import.c:704 src/gnome/dialog-qif-import.c:802 #: src/gnome/dialog-qif-import.c:707 src/gnome/dialog-qif-import.c:804
msgid "Something is very wrong with QIF Importing." msgid "Something is very wrong with QIF Importing."
msgstr "" msgstr ""

6
src/gnome/dialog-qif-import.c
View File

@ -364,10 +364,11 @@ gnc_ui_qif_import_load_file_cb(GtkButton * button, gpointer user_data) {
scm_protect_object(wind->imported_files); scm_protect_object(wind->imported_files);
gettimeofday(&end, NULL); gettimeofday(&end, NULL);
#if 0
printf("QIF file load took %f ms total.\n", printf("QIF file load took %f ms total.\n",
1000.0*(end.tv_sec - start.tv_sec) + 1000.0*(end.tv_sec - start.tv_sec) +
.001*(end.tv_usec - start.tv_usec)); .001*(end.tv_usec - start.tv_usec));
#endif
gettimeofday(&start, NULL); gettimeofday(&start, NULL);
/* now update the Accounts and Categories pages in the notebook */ /* now update the Accounts and Categories pages in the notebook */
@ -377,9 +378,11 @@ gnc_ui_qif_import_load_file_cb(GtkButton * button, gpointer user_data) {
gettimeofday(&end, NULL); gettimeofday(&end, NULL);
#if 0
printf("QIF Category/account tab update took %f ms.\n", printf("QIF Category/account tab update took %f ms.\n",
1000.0*(end.tv_sec - start.tv_sec) + 1000.0*(end.tv_sec - start.tv_sec) +
.001*(end.tv_usec - start.tv_usec)); .001*(end.tv_usec - start.tv_usec));
#endif
gettimeofday(&end, NULL); gettimeofday(&end, NULL);
@ -785,7 +788,6 @@ update_categories_page(QIFImportWindow * wind) {
hash_data); hash_data);
} }
/* now get the list of strings to display in the clist widget */ /* now get the list of strings to display in the clist widget */
/* gnc_unprotect_object(wind->cat_display_info); */ /* gnc_unprotect_object(wind->cat_display_info); */
display_info = gh_call2(make_category_display, display_info = gh_call2(make_category_display,

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

@ -35,13 +35,12 @@
(retval '())) (retval '()))
;; we want to make two passes here. The first pass picks the ;; we want to make two passes here. The first pass picks the
;; explicit Account descriptions and implicit "this" description ;; explicit Account descriptions out of each file. These are the
;; out of each file. These are the best sources of info because ;; best sources of info because we will have types and so on for
;; we will have types and so on for them. The second pass picks ;; them. The second pass picks out account-style L fields and
;; out account-style L fields and investment security names from ;; investment security names from the transactions. Hopefully
;; the transactions. Hopefully we'll have most of the accounts ;; we'll have most of the accounts already located by that point.
;; already located by that point. Otherwise, we have to guess ;; Otherwise, we have to guess them.
;; them.
;; guess-acct returns a list that's ;; guess-acct returns a list that's
;; (qif-name gnc-name gnc-type new-acct?) ;; (qif-name gnc-name gnc-type new-acct?)
@ -61,28 +60,7 @@
(list (qif-acct:type acct)) (list (qif-acct:type acct))
gnc-acct-info) gnc-acct-info)
(list 0 acct))))) (list 0 acct)))))
(qif-file:accounts file)) (qif-file:accounts file)))
;; then make an implicit account entry for the file
(if (and (qif-file:default-account file)
(qif-file:default-account-type file))
; (not (eq? (qif-file:account-type file) GNC-STOCK-TYPE)))
(let ((entry (hash-ref acct-hash (qif-file:default-account file))))
(if entry
;; increment the xtn count in place
(list-set! entry 4
(+ (list-ref entry 4)
(qif-file:default-acct-xtns file)))
;; make a new hash table entry for the account
;; make it a Bank account by default.
(hash-set!
acct-hash (qif-file:default-account file)
(append (qif-import:guess-acct
(qif-file:default-account file)
(list GNC-BANK-TYPE
GNC-CCARD-TYPE)
gnc-acct-info)
(list 0 #f)))))))
qif-files) qif-files)
;; now make the second pass through the files, looking at the ;; now make the second pass through the files, looking at the
@ -101,32 +79,30 @@
(qif-account-types #f) (qif-account-types #f)
(entry #f)) (entry #f))
(if (string? action) (if (and stock-acct (string? action))
(set! action-sym (qif-parse:parse-action-field action)))
(if (and stock-acct action-sym)
;; 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
;; account, a short-term CG account, an interest ;; account, a short-term CG account, an interest
;; 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-sym
((buy buyx sell sellx reinvdiv reinvsh reinvsg ((buy buyx sell sellx reinvint reinvdiv reinvsh reinvsg
reinvlg shrsin) reinvlg shrsin stksplit)
(set! qif-account stock-acct) (set! qif-account 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) ((div cgshort cglong intinc miscinc miscexp xin xout)
(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
GNC-CCARD-TYPE))) GNC-CCARD-TYPE)))
((divx cgshortx cglongx intincx) ((divx cgshortx cglongx intincx miscincx miscexpx)
(set! qif-account (set! qif-account
(qif-split:category (qif-split:category
(car (qif-xtn:splits xtn)))) (car (qif-xtn:splits xtn))))
@ -137,73 +113,99 @@
(display action-sym) (newline))) (display action-sym) (newline)))
;; now reference the near-end account ;; now reference the near-end account
(set! entry (hash-ref acct-hash qif-account)) (if qif-account
(if entry (begin
(list-set! entry 4 (set! entry (hash-ref acct-hash qif-account))
(+ 1 (list-ref entry 4))) (if entry
(hash-set! acct-hash qif-account (list-set! entry 4
(append (qif-import:guess-acct (+ 1 (list-ref entry 4)))
qif-account qif-account-types (hash-set! acct-hash qif-account
gnc-acct-info) (append (qif-import:guess-acct
(list 1 xtn)))) qif-account qif-account-types
gnc-acct-info)
(list 1 xtn))))))
;; 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
;; 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-sym
((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
GNC-CCARD-TYPE))) GNC-CCARD-TYPE)))
((buyx sellx) ((buyx sellx xin xout)
(set! qif-account (set! qif-account
(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)))
((stksplit)
(set! qif-account stock-acct)
(set! qif-account-types (list GNC-STOCK-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 stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((miscincx)
(set! qif-account
(qif-split:category
(car (qif-xtn:splits xtn))))
(set! qif-account-types (list GNC-INCOME-TYPE)))
((miscexpx)
(set! qif-account
(qif-split:category
(car (qif-xtn:splits xtn))))
(set! qif-account-types (list GNC-EXPENSE-TYPE)))
((cglong cglongx reinvlg) ((cglong cglongx reinvlg)
(set! qif-account (set! qif-account
(default-cglong-acct stock-acct)) (default-cglong-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 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 stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((shrsin) ((shrsin)
(set! qif-account (set! qif-account
(default-equity-account)) (default-equity-account))
(set! qif-account-types (list GNC-EQUITY-TYPE))) (set! qif-account-types (list GNC-EQUITY-TYPE)))
((miscinc miscexp)
;; these reference a category on the other end
(set! qif-account #f))
(else (else
(display "HEY! HEY! action-sym = ") (display "HEY! HEY! action-sym = ")
(display action-sym) (newline))) (display action-sym) (newline)))
;; now reference the far-end account ;; now reference the far-end account
(set! entry (hash-ref acct-hash qif-account)) (if qif-account
(if entry (begin
(list-set! entry 4 (set! entry (hash-ref acct-hash qif-account))
(+ 1 (list-ref entry 4))) (if entry
(hash-set! acct-hash qif-account (list-set! entry 4
(append (qif-import:guess-acct (+ 1 (list-ref entry 4)))
qif-account qif-account-types (hash-set! acct-hash qif-account
gnc-acct-info) (append (qif-import:guess-acct
(list 1 xtn)))) qif-account qif-account-types
gnc-acct-info)
;; if there's a commission, it will reference (list 1 xtn)))))))
;; a separate account on the far end.
)
;; non-stock transactions. these are a bit easier. ;; non-stock transactions. these are a bit easier.
;; the near-end account (from) is always in the ;; the near-end account (from) is always in the
@ -259,17 +261,17 @@
(vector->list acct-hash)) (vector->list acct-hash))
(list-set! gnc-acct-info 1 acct-hash) (list-set! gnc-acct-info 1 acct-hash)
;; sort by number of transactions with that account so the ;; sort by number of transactions with that account so the
;; most important are at the top ;; most important are at the top
(set! retval (sort retval (set! retval (sort retval
(lambda (a b) (lambda (a b)
(or (or
(> (list-ref a 4) (list-ref b 4)) (> (list-ref a 4) (list-ref b 4))
(and (and
(eq? (list-ref a 4) (list-ref b 4)) (eq? (list-ref a 4) (list-ref b 4))
(string<? (car a) (car b))))))) (string<? (car a) (car b)))))))
retval)) retval))
;; the category display is similar to the Account display. ;; the category display is similar to the Account display.
@ -341,7 +343,7 @@
(vector->list cat-hash)) (vector->list cat-hash))
(list-set! gnc-acct-info 2 cat-hash) (list-set! gnc-acct-info 2 cat-hash)
;; sort by number of transactions with that account so the ;; sort by number of transactions with that account so the
;; most important are at the top ;; most important are at the top
(set! retval (sort retval (set! retval (sort retval

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

@ -178,6 +178,10 @@
self current-xtn qstate-type) self current-xtn qstate-type)
(set! first-xtn #f))) (set! first-xtn #f)))
(if (and (eq? qstate-type 'type:invst)
(not (qif-xtn:security-name current-xtn)))
(qif-xtn:set-security-name! current-xtn ""))
(if current-account-name (if current-account-name
(qif-xtn:set-from-acct! current-xtn (qif-xtn:set-from-acct! current-xtn
current-account-name) current-account-name)
@ -201,6 +205,10 @@
((#\D) ((#\D)
(qif-class:set-description! current-xtn value)) (qif-class:set-description! current-xtn value))
;; R : tax copy designator (ignored for now)
((#\R)
#t)
;; end-of-record ;; end-of-record
((#\^) ((#\^)
(qif-file:add-class! self current-xtn) (qif-file:add-class! self current-xtn)
@ -264,7 +272,7 @@
;; R : what is the tax rate (from some table? ;; R : what is the tax rate (from some table?
;; seems to be an integer) ;; seems to be an integer)
((#\R) ((#\R)
(qif-cat:set-tax-rate! current-xtn value)) (qif-cat:set-tax-class! current-xtn value))
;; B : budget amount. not really supported. ;; B : budget amount. not really supported.
((#\B) ((#\B)
@ -305,13 +313,6 @@
;; now reverse the transaction list so xtns are in the same order that ;; now reverse the transaction list so xtns are in the same order that
;; they were in the file. This is important in a few cases. ;; they were in the file. This is important in a few cases.
(qif-file:set-xtns! self (reverse (qif-file:xtns self))) (qif-file:set-xtns! self (reverse (qif-file:xtns self)))
(set! end-time (gettimeofday))
(display "QIF file read took ")
(display (+ (* 1000 (- (car end-time) (car start-time)))
(* .001 (- (cdr end-time) (cdr start-time)))))
(newline)
return-val)) return-val))
@ -393,7 +394,7 @@
(and (and
;; fields of categories. ;; fields of categories.
(check-and-parse-field (check-and-parse-field
qif-cat:tax-rate qif-cat:set-tax-rate! qif-cat:tax-class qif-cat:set-tax-class!
qif-parse:check-number-format '(decimal comma) qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:cats self) qif-parse:parse-number/format (qif-file:cats self)
set-error) set-error)
@ -465,11 +466,7 @@
#t)) #t))
(set! end-time (gettimeofday)) (set! end-time (gettimeofday))
(display "QIF string parsing took ")
(display (+ (* 1000 (- (car end-time) (car start-time)))
(* .001 (- (cdr end-time) (cdr start-time)))))
(newline)
(cond ((list? error) (cond ((list? error)
(list all-ok (errlist-to-string error))) (list all-ok (errlist-to-string error)))
(error (error

55
src/scm/qif-import/qif-guess-map.scm
View File

@ -71,13 +71,15 @@
;; (shortname fullname account) format. ;; (shortname fullname account) format.
;; - a hash of QIF account name to gnucash account info ;; - a hash of QIF account name to gnucash account info
;; - a hash of QIF category to gnucash account info ;; - a hash of QIF category to gnucash account info
(let ((pref-filename (build-path (getenv "HOME") (let* ((pref-dir (build-path (getenv "HOME") ".gnucash"))
".gnucash" "qif-accounts-map")) (pref-filename (build-path pref-dir "qif-accounts-map"))
(results '())) (results '()))
;; first, read the account map and category map from the ;; first, read the account map and category map from the
;; user's qif-accounts-map file. ;; user's qif-accounts-map file.
(if (access? pref-filename R_OK) (if (and (access? pref-dir F_OK)
(access? pref-dir X_OK)
(access? pref-filename R_OK))
(with-input-from-file pref-filename (with-input-from-file pref-filename
(lambda () (lambda ()
(let ((qif-account-hash #f) (let ((qif-account-hash #f)
@ -98,9 +100,6 @@
(let* ((all-accounts (gnc:get-current-group)) (let* ((all-accounts (gnc:get-current-group))
(all-account-info (extract-all-account-info all-accounts #f))) (all-account-info (extract-all-account-info all-accounts #f)))
(set! results (cons all-account-info results))) (set! results (cons all-account-info results)))
; (display " ** load prefs **")(newline)
; (write results)(newline)
results)) results))
@ -115,10 +114,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:save-map-prefs prefs) (define (qif-import:save-map-prefs prefs)
(let ((pref-filename (build-path (getenv "HOME") (let* ((pref-dir (build-path (getenv "HOME") ".gnucash"))
".gnucash" "qif-accounts-map")) (pref-filename (build-path pref-dir "qif-accounts-map"))
(acct-map (cadr prefs)) (acct-map (cadr prefs))
(cat-map (caddr prefs))) (cat-map (caddr prefs))
(save-ok #f))
(for-each (for-each
(lambda (bin) (lambda (bin)
(for-each (for-each
@ -135,17 +135,32 @@
(list-set! (cdr hashpair) 5 #f)) (list-set! (cdr hashpair) 5 #f))
bin)) bin))
(vector->list cat-map)) (vector->list cat-map))
(with-output-to-file pref-filename ;; test for the existence of the directory and create it
(lambda () ;; if necessary
(display ";;; qif-accounts-map") (newline)
(display ";;; automatically generated by GNUcash. DO NOT EDIT") ;; does the file exist? if not, create it; in either case,
(newline) ;; make sure it's a directory and we have write and execute
(display ";;; map from QIF accounts to GNC accounts") (newline) ;; permission.
(write acct-map) (newline) (let ((perm (access? pref-dir F_OK)))
(display ";;; map from QIF categories to GNC accounts") (newline) (if (not perm)
(write cat-map) (newline))))) (mkdir pref-dir))
(let ((stats (stat pref-dir)))
(if (and (eq? (stat:type stats) 'directory)
(access? pref-dir X_OK)
(access? pref-dir W_OK))
(set! save-ok #t))))
(if save-ok
(with-output-to-file pref-filename
(lambda ()
(display ";;; qif-accounts-map") (newline)
(display ";;; automatically generated by GNUcash. DO NOT EDIT")
(newline)
(display ";;; map from QIF accounts to GNC accounts") (newline)
(write acct-map) (newline)
(display ";;; map from QIF categories to GNC accounts") (newline)
(write cat-map) (newline))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -25,7 +25,6 @@
'(path ;; where file was loaded '(path ;; where file was loaded
default-account ;; guessed or specified default account name default-account ;; guessed or specified default account name
default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE
default-acct-xtns
y2k-threshold y2k-threshold
currency ;; this is a string.. no checking currency ;; this is a string.. no checking
accts-mentioned accts-mentioned
@ -68,12 +67,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:default-acct-xtns
(simple-obj-getter <qif-file> 'default-acct-xtns))
(define qif-file:set-default-acct-xtns!
(simple-obj-setter <qif-file> 'default-acct-xtns))
(define qif-file:accts-mentioned (define qif-file:accts-mentioned
(simple-obj-getter <qif-file> 'accts-mentioned)) (simple-obj-getter <qif-file> 'accts-mentioned))
@ -115,7 +108,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-default-acct-xtns! self 0)
(qif-file:set-accts-mentioned! self '()) (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 '())
@ -353,7 +345,9 @@
(simple-obj-setter <qif-acct> 'budget)) (simple-obj-setter <qif-acct> 'budget))
(define (make-qif-acct) (define (make-qif-acct)
(make-simple-obj <qif-acct>)) (let ((retval (make-simple-obj <qif-acct>)))
(qif-acct:set-type! retval "Bank")
retval))
(define qif-acct? (define qif-acct?
(record-predicate <qif-acct>)) (record-predicate <qif-acct>))
@ -408,7 +402,7 @@
(define <qif-cat> (define <qif-cat>
(make-simple-class (make-simple-class
'qif-cat 'qif-cat
'(name description taxable expense-cat income-cat tax-rate budget-amt))) '(name description taxable expense-cat income-cat tax-class budget-amt)))
(define qif-cat:name (define qif-cat:name
(simple-obj-getter <qif-cat> 'name)) (simple-obj-getter <qif-cat> 'name))
@ -440,11 +434,11 @@
(define qif-cat:set-income-cat! (define qif-cat:set-income-cat!
(simple-obj-setter <qif-cat> 'income-cat)) (simple-obj-setter <qif-cat> 'income-cat))
(define qif-cat:tax-rate (define qif-cat:tax-class
(simple-obj-getter <qif-cat> 'tax-rate)) (simple-obj-getter <qif-cat> 'tax-class))
(define qif-cat:set-tax-rate! (define qif-cat:set-tax-class!
(simple-obj-setter <qif-cat> 'tax-rate)) (simple-obj-setter <qif-cat> 'tax-class))
(define qif-cat:budget-amt (define qif-cat:budget-amt
(simple-obj-getter <qif-cat> 'budget-amt)) (simple-obj-getter <qif-cat> 'budget-amt))
@ -462,29 +456,23 @@
(simple-obj-print self)) (simple-obj-print self))
(define (qif-file:add-xtn! self xtn) (define (qif-file:add-xtn! self xtn)
(let ((from (qif-xtn:from-acct xtn))) (let ((splits (qif-xtn:splits xtn)))
(if from (for-each
(if (not (member from (qif-file:accts-mentioned self))) (lambda (split)
(qif-file:set-accts-mentioned! (let ((accts (qif-split:accounts-affected split xtn))
self (cons from (qif-file:accts-mentioned self)))) (mentioned (qif-file:accts-mentioned self)))
(let ((defs (qif-file:default-acct-xtns self))) ;; add the near account to the mentioned-list
(qif-file:set-default-acct-xtns! self (+ 1 defs)) ;; but only for the first split
(if (and (eq? 0 defs) (if (and (eq? (car splits) split)
(not (member (qif-file:default-account self) (not (member (car accts) mentioned)))
(qif-file:accts-mentioned self)))) (qif-file:set-accts-mentioned!
(qif-file:set-accts-mentioned! self (cons (car accts) mentioned)))
self (cons (qif-file:default-account self) ;; add the far account for each split
(qif-file:accts-mentioned self))))))) (set! mentioned (qif-file:accts-mentioned self))
(for-each (if (not (member (cadr accts) mentioned))
(lambda (split) (qif-file:set-accts-mentioned!
(if (and (qif-split:category-is-account? split) self (cons (cadr accts) mentioned)))))
(not (member (qif-split:category split) splits))
(qif-file:accts-mentioned self))))
(qif-file:set-accts-mentioned!
self (cons (qif-split:category split)
(qif-file:accts-mentioned self)))))
(qif-xtn:splits xtn))
(qif-file:set-xtns! self (qif-file:set-xtns! self
(cons xtn (qif-file:xtns self)))) (cons xtn (qif-file:xtns self))))

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

@ -130,6 +130,8 @@
(cond (cond
((string=? mangled-string "bank") ((string=? mangled-string "bank")
GNC-BANK-TYPE) GNC-BANK-TYPE)
((string=? mangled-string "port")
GNC-BANK-TYPE)
((string=? mangled-string "cash") ((string=? mangled-string "cash")
GNC-CASH-TYPE) GNC-CASH-TYPE)
((string=? mangled-string "ccard") ((string=? mangled-string "ccard")
@ -188,9 +190,9 @@
'div) 'div)
((divx) ((divx)
'divx) 'divx)
((intinc aktzu) ;; zinsen ((int intinc aktzu) ;; zinsen
'intinc) 'intinc)
((intincx) ((intx intincx)
'intincx) 'intincx)
((cglong) ;; Kapitalgewinnsteuer ((cglong) ;; Kapitalgewinnsteuer
'cglong) 'cglong)
@ -202,6 +204,12 @@
'cgshortx) 'cgshortx)
((shrsin) ((shrsin)
'shrsin) 'shrsin)
((xin)
'xin)
((xout)
'xout)
((stksplit)
'stksplit)
((reinvdiv) ((reinvdiv)
'reinvdiv) 'reinvdiv)
((reinvint) ((reinvint)
@ -212,9 +220,18 @@
'reinvsh) 'reinvsh)
((reinvlg reinvkur) ((reinvlg reinvkur)
'reinvlg) 'reinvlg)
((miscinc)
'miscinc)
((miscincx)
'miscincx)
((miscexp)
'miscexp)
((miscexpx)
'miscexpx)
(else (else
action-symbol)))) (display "qif-parse:parse-action-field : unknown action field ")
(write read-value) (newline)
'unknown))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse-cleared-field : in a C (cleared) field in a QIF transaction, ;; parse-cleared-field : in a C (cleared) field in a QIF transaction,

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

@ -52,7 +52,7 @@
(gnc:account-begin-edit new-acct 1) (gnc:account-begin-edit new-acct 1)
;; if this is a copy of an existing gnc account, ;; if this is a copy of an existing gnc account,
2 ;; copy the account properties ;; copy the account properties
(if (not make-new-acct) (if (not make-new-acct)
(begin (begin
(gnc:account-set-name (gnc:account-set-name
@ -206,13 +206,11 @@
(qif-file:xtns qif-file)) (qif-file:xtns qif-file))
(qif-file:set-markable-xtns! qif-file markable-xtns))) (qif-file:set-markable-xtns! qif-file markable-xtns)))
qif-files-list) qif-files-list)
;; iterate over files. Going in the sort order by number of ;; iterate over files. Going in the sort order by number of
;; transactions should give us a small speed advantage. ;; transactions should give us a small speed advantage.
(for-each (for-each
(lambda (qif-file) (lambda (qif-file)
;; iterate over markable transactions. The non-transfer
;; ones are already weeded out.
(for-each (for-each
(lambda (xtn) (lambda (xtn)
(if (not (qif-xtn:mark xtn)) (if (not (qif-xtn:mark xtn))
@ -221,7 +219,7 @@
;; xtns that refer to the same xtn ;; xtns that refer to the same xtn
(qif-xtn:set-mark! xtn #t) (qif-xtn:set-mark! xtn #t)
(qif-import:mark-matching-xtns xtn qif-file qif-files-list) (qif-import:mark-matching-xtns xtn qif-file qif-files-list)
;; create and fill in the GNC transaction ;; create and fill in the GNC transaction
(let ((gnc-xtn (gnc:transaction-create))) (let ((gnc-xtn (gnc:transaction-create)))
(gnc:transaction-init gnc-xtn) (gnc:transaction-init gnc-xtn)
@ -262,7 +260,7 @@
gnc-acct-hash mapping-data) gnc-acct-hash mapping-data)
(let ((splits (qif-xtn:splits qif-xtn)) (let ((splits (qif-xtn:splits qif-xtn))
(gnc-near-split (gnc:split-create)) (gnc-near-split (gnc:split-create))
(near-split-total 0) (near-split-total 0.0)
(qif-cat-map (caddr mapping-data)) (qif-cat-map (caddr mapping-data))
(qif-acct-map (cadr mapping-data)) (qif-acct-map (cadr mapping-data))
(near-acct-info #f) (near-acct-info #f)
@ -292,7 +290,7 @@
(set! near-acct-name (set! near-acct-name
(list-ref near-acct-info 1)) (list-ref near-acct-info 1))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name)) (set! near-acct (hash-ref gnc-acct-hash near-acct-name))
;; iterate over QIF splits. Each split defines one "far ;; iterate over QIF splits. Each split defines one "far
;; end" for the transaction. ;; end" for the transaction.
(for-each (for-each
@ -304,6 +302,8 @@
(far-acct #f) (far-acct #f)
(split-amt (qif-split:amount qif-split)) (split-amt (qif-split:amount qif-split))
(memo (qif-split:memo qif-split))) (memo (qif-split:memo qif-split)))
(if (not split-amt) (set! split-amt 0.0))
;; fill the splits in (near first). This handles files in ;; fill the splits in (near first). This handles files in
;; multiple currencies by pulling the currency value from the ;; multiple currencies by pulling the currency value from the
@ -342,7 +342,6 @@
(gnc:transaction-append-split gnc-xtn gnc-near-split) (gnc:transaction-append-split gnc-xtn gnc-near-split)
(gnc:account-insert-split near-acct gnc-near-split)) (gnc:account-insert-split near-acct gnc-near-split))
;; STOCK TRANSACTIONS: the near/far accounts depend on the ;; STOCK TRANSACTIONS: the near/far accounts depend on the
;; "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
@ -351,6 +350,7 @@
(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-near-acct #f) (qif-near-acct #f)
(qif-far-acct #f) (qif-far-acct #f)
(far-acct-info #f) (far-acct-info #f)
@ -358,92 +358,95 @@
(far-acct #f) (far-acct #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 split-amt) (set! split-amt 0.0))
;; I don't think this should ever happen, but I want ;; I don't think this should ever happen, but I want
;; to keep this check just in case. ;; to keep this check just in case.
(if (> (length splits) 1) (if (> (length splits) 1)
(begin (begin
(display "qif-import:qif-xtn-to-gnc-xtn : ") (display "qif-import:qif-xtn-to-gnc-xtn : ")
(display "splits in stock transaction!") (newline))) (display "splits in stock transaction!") (newline)))
(set! qif-accts
(qif-split:accounts-affected (qif-xtn:splits qif-xtn)
qif-xtn))
;; the near split: where is the money going TO? (set! qif-near-acct (car qif-accts))
(case action-sym (set! qif-far-acct (cadr qif-accts))
((buy buyx sell sellx reinvdiv reinvsg reinvsh reinvlg shrsin)
(set! qif-near-acct qif-security))
((div cgshort cglong intinc)
(set! qif-near-acct (qif-xtn:from-acct qif-xtn)))
((divx cgshortx cglongx intincx)
(set! qif-near-acct
(qif-split:category (car (qif-xtn:splits qif-xtn)))))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; the far split: where is the money coming from? ;; translate the QIF account names into Gnucash accounts
(case action-sym (if (and qif-near-acct qif-far-acct)
((buy sell) (begin
(set! qif-far-acct (qif-xtn:from-acct qif-xtn))) (set! near-acct-info
((buyx sellx) (or (hash-ref qif-acct-map qif-near-acct)
(set! qif-far-acct (hash-ref qif-cat-map qif-near-acct)))
(qif-split:category (car (qif-xtn:splits qif-xtn))))) (set! near-acct-name
((cgshort cgshortx reinvsg reinvsh) (list-ref near-acct-info 1))
(set! qif-far-acct (set! near-acct (hash-ref gnc-acct-hash near-acct-name))
(default-cgshort-acct qif-security)))
((cglong cglongx reinvlg) (set! far-acct-info
(set! qif-far-acct (or (hash-ref qif-acct-map qif-far-acct)
(default-cglong-acct qif-security))) (hash-ref qif-cat-map qif-far-acct)))
((intinc intincx reinvint) (set! far-acct-name
(set! qif-far-acct (list-ref far-acct-info 1))
(default-interest-acct qif-security))) (set! far-acct (hash-ref gnc-acct-hash far-acct-name))))
((div divx reinvdiv)
(set! qif-far-acct
(default-dividend-acct qif-security)))
((shrsin)
(set! qif-far-acct
(default-equity-account)))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; 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 action-sym
((buy buyx reinvdiv reinvsg reinvsh reinvlg shrsin) ((buy buyx reinvint reinvdiv reinvsg reinvsh reinvlg shrsin)
(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)
(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)
(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))
(set! near-acct-info ((xout)
(hash-ref qif-acct-map qif-near-acct)) (gnc:split-set-base-value gnc-near-split (- split-amt) currency)
(set! near-acct-name (gnc:split-set-base-value gnc-far-split split-amt currency))
(list-ref near-acct-info 1))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name)) ;; stock splits are a pain in the butt: QIF just specifies
;; the split ratio, not the number of shares in and out,
(set! far-acct-info ;; so we have to fetch the number of shares from the
(hash-ref qif-acct-map qif-far-acct)) ;; security account
(set! far-acct-name ((stksplit)
(list-ref far-acct-info 1)) (let* ((splitratio (/ num-shares 10))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name)) (in-shares
(gnc:account-get-share-balance near-acct))
(out-shares (* in-shares splitratio)))
(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)))
(let ((cleared (qif-split:matching-cleared (let ((cleared (qif-split:matching-cleared
(car (qif-xtn:splits qif-xtn))))) (car (qif-xtn:splits qif-xtn)))))
(if (or (eq? 'cleared cleared) (if (or (eq? 'cleared cleared)
(eq? 'reconciled cleared)) (eq? 'reconciled cleared))
(gnc:split-set-reconcile gnc-far-split #\c))) (gnc:split-set-reconcile gnc-far-split #\c)))
(gnc:transaction-append-split gnc-xtn gnc-near-split) (if (and qif-near-acct qif-far-acct)
(gnc:account-insert-split near-acct gnc-near-split) (begin
(gnc:transaction-append-split gnc-xtn gnc-near-split)
(gnc:transaction-append-split gnc-xtn gnc-far-split) (gnc:account-insert-split near-acct gnc-near-split)
(gnc:account-insert-split far-acct gnc-far-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 ;; set properties of the whole transaction
(apply gnc:transaction-set-date gnc-xtn (qif-xtn:date qif-xtn)) (apply gnc:transaction-set-date gnc-xtn (qif-xtn:date qif-xtn))
@ -475,37 +478,35 @@
(qif-split:set-mark! split #t) (qif-split:set-mark! split #t)
(qif-split:set-matching-cleared! (qif-split:set-matching-cleared!
split split
(qif-import:mark-matching-split split xtn qif-file qif-files)) (qif-import:mark-matching-split
split xtn qif-file qif-files))
(qif-split:set-mark! split #t))))) (qif-split:set-mark! split #t)))))
(qif-xtn:splits xtn)) (qif-xtn:splits xtn))
(qif-xtn:set-mark! xtn #t)) (qif-xtn:set-mark! xtn #t))
(define (qif-import:mark-matching-split split xtn qif-file qif-files) (define (qif-import:mark-matching-split split xtn qif-file qif-files)
(let ((near-acct-name #f) (let* ((near-acct-name #f)
(far-acct-name (qif-split:category split)) (far-acct-name (qif-split:category split))
(date (qif-xtn:date xtn)) (date (qif-xtn:date xtn))
(amount (- (qif-split:amount split))) (amount (- (qif-split:amount split)))
(memo (qif-split:memo split)) (memo (qif-split:memo split))
(bank-xtn? (not (qif-xtn:security-name xtn))) (security-name (qif-xtn:security-name xtn))
(cleared? #f) (action (qif-xtn:number xtn))
(done #f)) (bank-xtn? (not security-name))
(cleared? #f)
(done #f))
;; FIXME security stuff
(if bank-xtn? (if bank-xtn?
(let ((near (qif-xtn:from-acct xtn))) (let ((near (qif-xtn:from-acct xtn)))
(set! far-acct-name (qif-split:category split))
(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))))
(set! near-acct-name (qif-xtn:security-name xtn))) (let ((qif-accts
(qif-split:accounts-affected split xtn)))
(set! near-acct-name (car qif-accts))
(set! far-acct-name (cadr qif-accts))))
;; (display "mark-matching-split : near-acct = ")
;; (write near-acct-name)
;; (display " far-acct = ")
;; (write far-acct-name)
;; (display " date = ")
;; (write date)
;; (newline)
;; 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.
@ -578,3 +579,71 @@
;; is the memo the same? (is this true?) ;; is the memo the same? (is this true?)
;; ignore it for now ;; ignore it for now
)) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (qif-split:accounts-affected split xtn)
;; Get the near and far ends of a split, returned as a list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-split:accounts-affected split xtn)
(let ((near-acct-name #f)
(far-acct-name #f)
(security (qif-xtn:security-name xtn))
(action (qif-xtn:number 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! 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
((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh
reinvlg shrsin stksplit)
(set! near-acct-name 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
(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?
;; Either the brokerage account, the category,
;; or an external account
(case action-sym
((buy sell)
(set! far-acct-name (qif-xtn:from-acct xtn)))
((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))
((cgshort cgshortx reinvsg reinvsh)
(set! far-acct-name
(default-cgshort-acct security)))
((cglong cglongx reinvlg)
(set! far-acct-name
(default-cglong-acct security)))
((intinc intincx reinvint)
(set! far-acct-name
(default-interest-acct security)))
((div divx reinvdiv)
(set! far-acct-name
(default-dividend-acct security)))
((shrsin)
(set! far-acct-name
(default-equity-account))))))
(list near-acct-name far-acct-name)))

16
src/scm/report/average-balance.scm
View File

@ -338,12 +338,17 @@
(gncq (gnc:malloc-query)) (gncq (gnc:malloc-query))
(slist '())) (slist '()))
(if (null? accounts) (cond ((null? accounts)
(set! rept-text (set! rept-text
(list "<TR><TD>" (list "<TR><TD>"
(string-db 'lookup 'no-account) (string-db 'lookup 'no-account)
"</TD></TR>")) "</TD></TR>")))
(begin ((gnc:timepair-le enddate begindate)
(set! rept-text
(list "<TR><TD><EM>"
(string-db 'lookup 'dates-reversed)
"</EM></TD></TR>")))
(else (begin
; Grab account names ; Grab account names
(set! acctname (set! acctname
@ -401,7 +406,7 @@
(system (system
(string-append "echo \"" preplot "plot '" (string-append "echo \"" preplot "plot '"
fn "'" plotstr fn "'" plotstr
"\"|gnuplot -persist " )))))) "\"|gnuplot -persist " )))))))
(append prefix (append prefix
(if (null? accounts) (if (null? accounts)
@ -426,6 +431,7 @@
(string-db 'store 'gain "Gain") (string-db 'store 'gain "Gain")
(string-db 'store 'loss "Loss") (string-db 'store 'loss "Loss")
(string-db 'store 'no-account "You have not selected an account.") (string-db 'store 'no-account "You have not selected an account.")
(string-db 'store 'dates-reversed "Please choose appropriate dates - the \"To\" date should be *after* the \"From\" date.")
(string-db 'store 'period-ending "Period Ending") (string-db 'store 'period-ending "Period Ending")
(string-db 'store 'report-for "Report for %s.") (string-db 'store 'report-for "Report for %s.")
(string-db 'store 'report-for-and "Report for %s and all subaccounts.") (string-db 'store 'report-for-and "Report for %s and all subaccounts.")