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

*** empty log message ***

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2092 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-03-19 23:46:52 +00:00
parent 97d248f32f
commit cd329e1944
10 changed files with 277 additions and 233 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
README.SuSE-6.3
View File

@ -1,7 +1,7 @@
How to install gnucash-1.3.0 on SuSE-6.3 How to install gnucash-1.3.0 on SuSE-6.3
======================================== ========================================
(written 2000-01-07 by Peter Pointner <peter@wuzel.m.isar.de>) (written 2000-01-07 by Peter Pointner <peter@wuzel.m.isar.de>)
(changed for gnucash-1.3.0 2000-03-01 by Herbert Thoma (tma@iis.fhg.de)) (changed for gnucash-1.3.x 2000-03-01 by Herbert Thoma (tma@iis.fhg.de))
Notes: Notes:
@ -13,6 +13,8 @@ Notes:
- This is definitely for SuSE 6.3 (Intel). Earlier SuSE distributions - This is definitely for SuSE 6.3 (Intel). Earlier SuSE distributions
lack some required packages. Later SuSE distributions didn't exist lack some required packages. Later SuSE distributions didn't exist
at the time of writing. at the time of writing.
NOTE: You can install new packages to older versions of SuSE from
CD or ftp.suse.de or ftp.suse.com
Let's go: Let's go:
@ -22,7 +24,7 @@ Let's go:
* Install the following packages: * Install the following packages:
+ from series d + from series d
eperl guile nana swig xmhtml xmhtmld eperl guile nana swig xmhtml xmhtmld gettext
and optionally and optionally
autoconf automake libtool autoconf automake libtool
(You must install libtool if you have autoconf/automake (You must install libtool if you have autoconf/automake
@ -33,6 +35,8 @@ Let's go:
lesstiff lesstifd lesstiff lesstifd
+ from series gnm + from series gnm
gnlibs gnlibsd gnlibs gnlibsd
+ from series gra
imlib imlibdev
* Download slib from * Download slib from
ftp://ftp.gnu.org/pub/gnu/jacal/slib2c7.zip ftp://ftp.gnu.org/pub/gnu/jacal/slib2c7.zip
@ -58,3 +62,6 @@ Let's go:
make gnome for gnome version (recommended) or make gnome for gnome version (recommended) or
make qt for qt/KDE version (pre alpha, may even not compile) make qt for qt/KDE version (pre alpha, may even not compile)
su root -c "make install" su root -c "make install"
* You may need to run GnuCash once as root, because guile needs to set up
some things for slib.

1
src/scm/main.scm
View File

@ -17,7 +17,6 @@
(gnc:depend "doc.scm") (gnc:depend "doc.scm")
(gnc:depend "extensions.scm") (gnc:depend "extensions.scm")
(gnc:depend "text-export.scm") (gnc:depend "text-export.scm")
; (gnc:depend "importqif.scm")
(gnc:depend "report.scm") (gnc:depend "report.scm")
(gnc:depend "report/report-list.scm") (gnc:depend "report/report-list.scm")

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

@ -21,6 +21,7 @@
(qif-acct:set-description! (list-ref old-map 5) new-descript)) (qif-acct:set-description! (list-ref old-map 5) new-descript))
(#t (#t
(list-set! old-map 5 new-descript))))) (list-set! old-map 5 new-descript)))))
;; the account-display is a 3-columned list of accounts in the QIF ;; the account-display is a 3-columned list of accounts in the QIF
;; import dialog (the "Account" page of the notebook). Column 1 is ;; import dialog (the "Account" page of the notebook). Column 1 is
@ -31,7 +32,7 @@
(define (qif-dialog:make-account-display qif-files gnc-acct-info) (define (qif-dialog:make-account-display qif-files gnc-acct-info)
(let ((acct-hash (make-hash-table 20)) (let ((acct-hash (make-hash-table 20))
(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 and implicit "this" description
;; out of each file. These are the best sources of info because ;; out of each file. These are the best sources of info because
@ -40,7 +41,7 @@
;; the transactions. Hopefully we'll have most of the accounts ;; the transactions. Hopefully we'll have most of the accounts
;; already located by that point. Otherwise, we have to guess ;; already located by that point. 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?)
;; acct-hash hashes QIF account name to a list that's composed of ;; acct-hash hashes QIF account name to a list that's composed of
@ -60,7 +61,7 @@
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 ;; then make an implicit account entry for the file
(if (and (qif-file:account file) (if (and (qif-file:account file)
(qif-file:account-type file)) (qif-file:account-type file))
@ -84,7 +85,7 @@
(length (qif-file:xtns file)) (length (qif-file:xtns file))
#f))))))) #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
;; transactions. Hopefully the accounts are all there already. ;; transactions. Hopefully the accounts are all there already.
;; stock accounts can have both a category/account and another ;; stock accounts can have both a category/account and another
@ -151,14 +152,14 @@
;; 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-list 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.
@ -234,13 +235,13 @@
;; 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-list 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))
@ -261,4 +262,3 @@
#f #f
file)) file))
list-of-files))) list-of-files)))

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

@ -62,12 +62,12 @@
((eq? qstate-type 'type:cat) ((eq? qstate-type 'type:cat)
(set! current-xtn (make-qif-cat))) (set! current-xtn (make-qif-cat)))
((eq? qstate-type 'account) ((eq? qstate-type 'account)
(set! current-xtn (make-qif-acct))) (set! current-xtn (make-qif-acct)))))
(#t ; (#t
(display "qif-file:read-file can't handle ") ; (display "qif-file:read-file can't handle ")
(write qstate-type) ; (write qstate-type)
(display " transactions yet.") ; (display " transactions yet.")
(newline)))) ; (newline))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; account transactions ;; account transactions
@ -140,7 +140,7 @@
;; O : adjustment (stock transactions) ;; O : adjustment (stock transactions)
((#\O) ((#\O)
(qif-xtn:set-adjustment! (qif-xtn:set-adjustment!
current-xtn (qif-file:parse-value self value))) current-xtn (qif-file:parse-value/decimal self value)))
;; L : category ;; L : category
((#\L) ((#\L)
@ -167,7 +167,9 @@
;; what the $ signifies. I'll do it later. ;; what the $ signifies. I'll do it later.
(if (not (eq? qstate-type 'type:invst)) (if (not (eq? qstate-type 'type:invst))
(qif-split:set-amount! (qif-split:set-amount!
current-split (qif-file:parse-value self value)))) current-split
(qif-file:parse-value/decimal self value))))
;; ^ : end-of-record ;; ^ : end-of-record
((#\^) ((#\^)
(if (and (qif-xtn:date current-xtn) (if (and (qif-xtn:date current-xtn)
@ -181,7 +183,7 @@
(display "qif-file:read-file : discarding xtn") (display "qif-file:read-file : discarding xtn")
(newline) (newline)
(qif-xtn:print current-xtn))) (qif-xtn:print current-xtn)))
(if (and first-xtn (if (and first-xtn
(string? (qif-xtn:payee current-xtn)) (string? (qif-xtn:payee current-xtn))
(string=? (qif-xtn:payee current-xtn) (string=? (qif-xtn:payee current-xtn)
@ -240,12 +242,8 @@
(set! first-xtn #f) (set! first-xtn #f)
(set! current-xtn (make-qif-xtn)) (set! current-xtn (make-qif-xtn))
(set! default-split (make-qif-split))) (set! default-split (make-qif-split)))))
(else
(display "qif-file:read-file : unknown Bank slot ")
(display tag)
(newline))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Class transactions ;; Class transactions
@ -265,7 +263,6 @@
;; end-of-record ;; end-of-record
((#\^) ((#\^)
(qif-file:add-class! self current-xtn) (qif-file:add-class! self current-xtn)
; (qif-class:print current-xtn)
(set! current-xtn (make-qif-class))) (set! current-xtn (make-qif-class)))
(else (else
@ -290,7 +287,7 @@
((#\L) ((#\L)
(qif-acct:set-limit! (qif-acct:set-limit!
current-xtn (qif-file:parse-value self value))) current-xtn (qif-file:parse-value/decimal self value)))
((#\^) ((#\^)
(qif-file:add-account! self current-xtn) (qif-file:add-account! self current-xtn)
@ -304,19 +301,20 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Category (Cat) transactions ;; Category (Cat) transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((eq? qstate-type 'type:cat) ((eq? qstate-type 'type:cat)
(case tag (case tag
;; N : category name ;; N : category name
((#\N) ((#\N)
(qif-cat:set-name! current-xtn (qif-cat:set-name! current-xtn
(qif-file:parse-string self value))) (qif-file:parse-string self value)))
;; D : category description ;; D : category description
((#\D) ((#\D)
(qif-cat:set-description! current-xtn (qif-cat:set-description! current-xtn
(qif-file:parse-string (qif-file:parse-string
self value))) self value)))
;; E : is this a taxable category? ;; E : is this a taxable category?
((#\T) ((#\T)
(qif-cat:set-taxable! current-xtn #t)) (qif-cat:set-taxable! current-xtn #t))
@ -333,12 +331,12 @@
;; seems to be an integer) ;; seems to be an integer)
((#\R) ((#\R)
(qif-cat:set-tax-rate! (qif-cat:set-tax-rate!
current-xtn (qif-file:parse-value self value))) current-xtn (qif-file:parse-value/decimal self value)))
;; B : budget amount. not really supported. ;; B : budget amount. not really supported.
((#\B) ((#\B)
(qif-cat:set-budget-amt! (qif-cat:set-budget-amt!
current-xtn (qif-file:parse-value self value))) current-xtn (qif-file:parse-value/decimal self value)))
;; end-of-record ;; end-of-record
((#\^) ((#\^)
@ -350,7 +348,7 @@
(display "qif-file:read-file : unknown Cat slot ") (display "qif-file:read-file : unknown Cat slot ")
(display tag) (newline)))) (display tag) (newline))))
;; trying to sneak on by, eh? ;; trying to sneak one by, eh?
(#t (#t
(if (not qstate-type) (if (not qstate-type)
(begin (begin
@ -368,7 +366,7 @@
(if (and (not heinous-error) (if (and (not heinous-error)
(not (eof-object? line))) (not (eof-object? line)))
(line-loop)))))) (line-loop))))))
(if (not heinous-error) (if (not heinous-error)
(begin (begin
;; now that the file is read in, figure out if either ;; now that the file is read in, figure out if either
@ -394,23 +392,39 @@
(if (eq? 'unknown (qif-file:account self)) (if (eq? 'unknown (qif-file:account self))
(qif-file:set-account! (qif-file:set-account!
self (qif-file:path-to-accountname self))) self (qif-file:path-to-accountname self)))
;; reparse values and dates if we figured out the format. ;; reparse values and dates if we figured out the format.
(for-each (let ((reparse-ok #t))
(lambda (xtn) (for-each
(qif-xtn:reparse xtn self)) (lambda (xtn)
(qif-file:xtns self)) (set! reparse-ok
(and reparse-ok (qif-xtn:reparse xtn self))))
(for-each (qif-file:xtns self))
(lambda (cat)
(qif-cat:reparse cat self)) (if (not reparse-ok)
(qif-file:cats self)) (begin
(display "xtn reparse failed") (newline)))
(for-each
(lambda (acct) (for-each
(qif-acct:reparse acct self)) (lambda (cat)
(qif-file:accounts self)) (set! reparse-ok
#t) (and reparse-ok (qif-cat:reparse cat self))))
(qif-file:cats self))
(if (not reparse-ok)
(begin
(display "cat reparse failed") (newline)))
(for-each
(lambda (acct)
(set! reparse-ok
(and reparse-ok (qif-acct:reparse acct self))))
(qif-file:accounts self))
(if (not reparse-ok)
(begin
(display "acct reparse failed") (newline)))
reparse-ok))
(begin (begin
(display "There was a heinous error. Failed to read file.") (display "There was a heinous error. Failed to read file.")
(newline) (newline)

3
src/scm/qif-import/qif-import.scm
View File

@ -7,6 +7,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(gnc:support "qif-import.scm") (gnc:support "qif-import.scm")
(gnc:depend "simple-obj.scm") (gnc:depend "simple-obj.scm")
(gnc:depend "qif-objects.scm") ;; class definitions (gnc:depend "qif-objects.scm") ;; class definitions
(gnc:depend "qif-parse.scm") ;; string-to-value, date parsing (gnc:depend "qif-parse.scm") ;; string-to-value, date parsing
@ -15,3 +16,5 @@
(gnc:depend "qif-dialog-utils.scm") ;; build displays for dialog (gnc:depend "qif-dialog-utils.scm") ;; build displays for dialog
(gnc:depend "qif-guess-map.scm") ;; build QIF->gnc acct mappings (gnc:depend "qif-guess-map.scm") ;; build QIF->gnc acct mappings
(gnc:depend "qif-to-gnc.scm") ;; conv QIF xtns/acct to GNC xtns/acct (gnc:depend "qif-to-gnc.scm") ;; conv QIF xtns/acct to GNC xtns/acct

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

@ -9,6 +9,7 @@
(gnc:support "qif-objects.scm") (gnc:support "qif-objects.scm")
(gnc:depend "simple-obj.scm") (gnc:depend "simple-obj.scm")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-file class ;; qif-file class
;; radix-format : one of 'decimal 'comma or 'unspecified ;; radix-format : one of 'decimal 'comma or 'unspecified
@ -301,38 +302,51 @@
self)) self))
(define (qif-xtn:reparse self qif-file) (define (qif-xtn:reparse self qif-file)
;; share price (let ((reparse-ok #t))
(if (string? (qif-xtn:share-price self)) ;; share price
(qif-xtn:set-share-price! (if (string? (qif-xtn:share-price self))
self (qif-xtn:set-share-price!
(qif-file:parse-value qif-file (qif-xtn:share-price self)))) self
(qif-file:parse-value qif-file (qif-xtn:share-price self))))
;; number of shares
(if (string? (qif-xtn:num-shares self))
(qif-xtn:set-num-shares!
self
(qif-file:parse-value qif-file (qif-xtn:num-shares self))))
;; adjustment
(if (string? (qif-xtn:adjustment self))
(qif-xtn:set-adjustment!
self
(qif-file:parse-value qif-file (qif-xtn:adjustment self))))
(if (or (string? (qif-xtn:share-price self))
(string? (qif-xtn:num-shares self))
(string? (qif-xtn:adjustment self)))
(set! reparse-ok #f))
;; number of shares ;; reparse the amount of each split
(if (string? (qif-xtn:num-shares self)) (for-each
(qif-xtn:set-num-shares! (lambda (split)
self (if (string? (qif-split:amount split))
(qif-file:parse-value qif-file (qif-xtn:num-shares self)))) (qif-split:set-amount!
split
;; adjustment (qif-file:parse-value qif-file (qif-split:amount split))))
(if (string? (qif-xtn:adjustment self)) (if (string? (qif-split:amount split))
(qif-xtn:set-adjustment! (set! reparse-ok #f)))
self
(qif-file:parse-value qif-file (qif-xtn:adjustment self)))) (qif-xtn:splits self))
;; reparse the amount of each split ;; reparse the date
(for-each (if (string? (qif-xtn:date self))
(lambda (split) (qif-xtn:set-date! self
(if (string? (qif-split:amount split)) (qif-file:parse-date qif-file
(qif-split:set-amount! (qif-xtn:date self))))
split (if (string? (qif-xtn:date self))
(qif-file:parse-value qif-file (qif-split:amount split))))) (set! reparse-ok #f))
(qif-xtn:splits self))
reparse-ok))
;; reparse the date
(if (string? (qif-xtn:date self))
(qif-xtn:set-date! self
(qif-file:parse-date qif-file
(qif-xtn:date self)))))
(define (qif-xtn:print self) (define (qif-xtn:print self)
(simple-obj-print self <qif-xtn>)) (simple-obj-print self <qif-xtn>))
@ -386,7 +400,11 @@
(define (qif-acct:reparse self file) (define (qif-acct:reparse self file)
(if (string? (qif-acct:limit self)) (if (string? (qif-acct:limit self))
(qif-acct:set-limit! (qif-acct:set-limit!
self (qif-file:parse-value file (qif-acct:limit self))))) self (qif-file:parse-value file (qif-acct:limit self))))
(if (or (string? (qif-acct:limit self))
(string? (qif-acct:type self)))
#f
#t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -496,7 +514,11 @@
(if (string? (qif-cat:budget-amt self)) (if (string? (qif-cat:budget-amt self))
(qif-cat:set-budget-amt! (qif-cat:set-budget-amt!
self (qif-file:parse-value file (qif-cat:budget-amt self))))) self (qif-file:parse-value file (qif-cat:budget-amt self))))
(if (or (string? (qif-cat:tax-rate self))
(string? (qif-cat:budget-amt self)))
#f #t))
(define (qif-file:add-xtn! self xtn) (define (qif-file:add-xtn! self xtn)

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

@ -126,7 +126,13 @@
GNC-ASSET-TYPE) GNC-ASSET-TYPE)
((string=? mangled-string "oth l") ((string=? mangled-string "oth l")
GNC-LIABILITY-TYPE) GNC-LIABILITY-TYPE)
(#t read-value)))) ((string=? mangled-string "mutual")
GNC-MUTUAL-TYPE)
(#t
(display "qif-file:parse-acct-type : unhandled account type ")
(display read-value)
(display "... substituting Bank.")
GNC-BANK-TYPE))))
(define (qif-file:state-to-account-type self qstate) (define (qif-file:state-to-account-type self qstate)
(cond ((eq? qstate 'type:bank) (cond ((eq? qstate 'type:bank)
@ -208,7 +214,7 @@
(set! numeric-date-parts (set! numeric-date-parts
(map (lambda (elt) (map (lambda (elt)
(with-input-from-string elt (with-input-from-string elt
(lambda () (read)))) (lambda () (read))))
date-parts)) date-parts))
(cond (cond
@ -349,29 +355,53 @@
(string-remove-leading-space (string-remove-trailing-space str))) (string-remove-leading-space (string-remove-trailing-space str)))
(define decimal-radix-regexp
(make-regexp
"^-?[0-9]+$|^-?[0-9]?[0-9]?[0-9]?(,[0-9][0-9][0-9])*(\\.[0-9]*)?$"))
(define comma-radix-regexp
(make-regexp
"^-?[0-9]+$|^-?[0-9]?[0-9]?[0-9]?(\\.[0-9][0-9][0-9])*(,[0-9]*)?$"))
(define (value-is-decimal-radix? value)
(if (regexp-exec decimal-radix-regexp value)
#t #f))
(define (value-is-comma-radix? value)
(if (regexp-exec comma-radix-regexp value)
#t #f))
(define (qif-file:parse-value/decimal self value-string)
(+ 0.0
(with-input-from-string (string-remove-char value-string #\,)
(lambda () (read)))))
(define (qif-file:parse-value/comma self value-string)
(+ 0.0
(with-input-from-string
(string-replace-char! (string-remove-char value-string #\.)
#\, #\.)
(lambda () (read)))))
(define (qif-file:parse-value self value-string) (define (qif-file:parse-value self value-string)
(if (or (not (string? value-string)) (if (or (not (string? value-string))
(not (> (string-length value-string) 0))) (not (> (string-length value-string) 0)))
(set! value-string "0")) (set! value-string "0")
(set! value-string (string-remove-leading-space
(string-remove-trailing-space value-string))))
(let ((comma-index (string-rindex value-string #\,)) (let ((possibly-comma-radix? (value-is-comma-radix? value-string))
(decimal-index (string-rindex value-string #\.)) (possibly-decimal-radix? (value-is-decimal-radix? value-string)))
(comma-count (string-char-count value-string #\,))
(decimal-count (string-char-count value-string #\.)))
;; if we don't know the radix format, it might be appropriate to
;; guess. guessed radix format doesn't affect parsing at all
;; until you set the radix-format from the guessed-radix-format
;; and call reparse-values on all the values.
(if (and (eq? (qif-file:radix-format self) 'unknown) (if (and (eq? (qif-file:radix-format self) 'unknown)
(not (eq? (qif-file:guessed-radix-format self) 'inconsistent))) (not (eq? (qif-file:guessed-radix-format self) 'inconsistent)))
(cond (cond
;; already think it's decimal ;; already think it's decimal
((eq? (qif-file:guessed-radix-format self) 'decimal) ((eq? (qif-file:guessed-radix-format self) 'decimal)
(if (or (> decimal-count 1) (if (and possibly-comma-radix?
(and decimal-index comma-index (not possibly-decimal-radix?))
(> comma-index decimal-index)))
(begin (begin
(qif-file:set-guessed-radix-format! self 'inconsistent) (qif-file:set-guessed-radix-format! self 'inconsistent)
(display "this QIF file has inconsistent radix notation!") (display "this QIF file has inconsistent radix notation!")
@ -379,9 +409,8 @@
;; already think it's comma ;; already think it's comma
((eq? (qif-file:guessed-radix-format self) 'comma) ((eq? (qif-file:guessed-radix-format self) 'comma)
(if (or (> comma-count 1) (if (and possibly-decimal-radix?
(and decimal-index comma-index (not possibly-comma-radix?))
(> decimal-index comma-index)))
(begin (begin
(qif-file:set-guessed-radix-format! self 'inconsistent) (qif-file:set-guessed-radix-format! self 'inconsistent)
(display "this QIF file has inconsistent radix notation!") (display "this QIF file has inconsistent radix notation!")
@ -389,86 +418,29 @@
;; don't know : look for numbers that are giveaways. ;; don't know : look for numbers that are giveaways.
((eq? (qif-file:guessed-radix-format self) 'unknown) ((eq? (qif-file:guessed-radix-format self) 'unknown)
;; case 1: there's a decimal and a comma, and the (cond ((and possibly-decimal-radix?
;; decimal is to the right of the comma, and there's (not possibly-comma-radix?))
;; only one decimal : it's a decimal number. (qif-file:set-guessed-radix-format! self 'decimal))
(if (and decimal-index comma-index ((and possibly-comma-radix?
(> decimal-index comma-index) (not possibly-decimal-radix?))
(eq? decimal-count 1)) (qif-file:set-guessed-radix-format! self 'comma))))))
(qif-file:set-guessed-radix-format! self 'decimal)) (cond
((eq? (qif-file:radix-format self) 'decimal)
;; case 2: the opposite. (if possibly-decimal-radix?
(if (and decimal-index comma-index (qif-file:parse-value/decimal self value-string)
(> comma-index decimal-index) (begin
(eq? comma-count 1)) (display "Format is decimal-radix, but number is")
(qif-file:set-guessed-radix-format! self 'comma)) (write value-string)
(newline)
;; case 3: there's no decimal and more than one comma: 0.0)))
;; it's a decimal number. I wish I had more transactions ((eq? (qif-file:radix-format self) 'comma)
;; like this! (if possibly-comma-radix?
(if (and (eq? decimal-count 0) (qif-file:parse-value/comma self value-string)
(> comma-count 1)) (begin
(qif-file:set-guessed-radix-format! self 'decimal)) (display "Format is comma-radix, but number is")
(write value-string)
;; case 4: the opposite (no comma, multiple decimals) (newline)
(if (and (eq? comma-count 0) 0.0)))
(> decimal-count 1)) (#t
(qif-file:set-guessed-radix-format! self 'comma))
;; case 5: one decimal, no commas, and not-3 digits
;; after it --> decimal.
(if (and (eq? comma-count 0)
(eq? decimal-count 1)
(not (eq? (- (string-length value-string)
decimal-index)
4)))
(qif-file:set-guessed-radix-format! self 'decimal))
;; case 6: the opposite --> comma
(if (and (eq? comma-count 1)
(eq? decimal-count 0)
(not (eq? (- (string-length value-string)
comma-index)
4)))
(begin
(display "hey!") (display comma-count)
(display comma-index) (display (string-length value-string))
(newline)
(qif-file:set-guessed-radix-format! self 'comma))))))
(cond
;; decimal radix (US format)
;; number can't have more than one ., and the rightmost
;; . must be to the right of the rightmost ,
;; , are ignored otherwise
((eq? 'decimal (qif-file:radix-format self))
(if (or (and decimal-count
(> decimal-count 1))
(and decimal-index comma-index
(> comma-index decimal-index)))
(error "badly-formed decimal-radix number" value-string)
(+ 0.0
(with-input-from-string (string-remove-char value-string #\,)
(lambda () (read))))))
;; comma radix (German format)
;; number can't have more than one , and the rightmost
;; , must be to the right of the rightmost .
;; . are ignored otherwise. Substitute . for , before
;; parsing.
((eq? 'comma (qif-file:radix-format self))
(if (or (and comma-count
(> comma-count 1))
(and decimal-index comma-index
(> decimal-index comma-index)))
(error "badly formed comma-radix number" value-string)
(+ 0.0
(with-input-from-string (string-replace-char!
(string-remove-char value-string #\.)
#\, #\.)
(lambda () (read))))))
;; unknown radix - store the string and we can process it
;; later.
(#t
value-string)))) value-string))))

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

@ -207,7 +207,7 @@
(let ((gnc-xtn (gnc:transaction-create))) (let ((gnc-xtn (gnc:transaction-create)))
(gnc:transaction-init gnc-xtn) (gnc:transaction-init gnc-xtn)
(gnc:transaction-begin-edit gnc-xtn 1) (gnc:transaction-begin-edit gnc-xtn 1)
;; destroy any automagic splits in the transaction ;; destroy any automagic splits in the transaction
(let ((numsplits (gnc:transaction-get-split-count gnc-xtn))) (let ((numsplits (gnc:transaction-get-split-count gnc-xtn)))
(if (not (eqv? 0 numsplits)) (if (not (eqv? 0 numsplits))
@ -216,14 +216,14 @@
(gnc:transaction-get-split gnc-xtn ind)) (gnc:transaction-get-split gnc-xtn ind))
(if (> ind 0) (if (> ind 0)
(loop (- ind 1)))))) (loop (- ind 1))))))
;; build the transaction ;; build the transaction
(qif-import:qif-xtn-to-gnc-xtn (qif-import:qif-xtn-to-gnc-xtn
xtn qif-file gnc-xtn gnc-acct-hash mapping-data) xtn qif-file gnc-xtn gnc-acct-hash mapping-data)
;; rebalance and commit everything ;; rebalance and commit everything
(gnc:transaction-commit-edit gnc-xtn))))) (gnc:transaction-commit-edit gnc-xtn)))))
(qif-file:xtns qif-file))) (qif-file:xtns qif-file)))
sorted-qif-files-list) sorted-qif-files-list)
@ -241,6 +241,8 @@
(define (qif-import:qif-xtn-to-gnc-xtn qif-xtn qif-file gnc-xtn (define (qif-import:qif-xtn-to-gnc-xtn qif-xtn qif-file gnc-xtn
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))
(near-split-total 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)
@ -257,19 +259,37 @@
;; find the GNC account for the near end of the transaction ;; find the GNC account for the near end of the transaction
;; (all splits have the same near end) ;; (all splits have the same near end)
(set! near-acct-info (if (qif-xtn:bank-xtn? qif-xtn)
(hash-ref qif-acct-map (begin
(if (qif-xtn:bank-xtn? qif-xtn) (set! near-acct-info
(qif-file:account qif-file) (hash-ref qif-acct-map
(qif-xtn:security-name qif-xtn)))) (qif-file:account qif-file)))
(set! near-acct-name (list-ref near-acct-info 1)) (set! near-acct-name
(set! near-acct (hash-ref gnc-acct-hash near-acct-name)) (list-ref near-acct-info 1))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name)))
(begin
(set! near-acct-info
(hash-ref qif-acct-map
(qif-xtn:security-name qif-xtn)))
(set! near-acct-name
(list-ref near-acct-info 1))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name))))
(if (qif-split:memo (car (qif-xtn:splits qif-xtn)))
(gnc:split-set-memo gnc-near-split
(qif-split:memo (car (qif-xtn:splits qif-xtn)))))
(let ((cleared (qif-xtn:cleared qif-xtn)))
(cond ((eq? 'cleared cleared)
(gnc:split-set-reconcile gnc-near-split #\c))
((eq? 'reconciled cleared)
(gnc:split-set-reconcile gnc-near-split #\r))))
;; iterate over QIF splits ;; iterate over QIF splits
(for-each (for-each
(lambda (qif-split) (lambda (qif-split)
(let ((gnc-near-split (gnc:split-create)) (let ((gnc-far-split (gnc:split-create))
(gnc-far-split (gnc:split-create))
(far-acct-info #f) (far-acct-info #f)
(far-acct-name #f) (far-acct-name #f)
(far-acct-type #f) (far-acct-type #f)
@ -281,19 +301,13 @@
;; 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
;; file import. ;; file import.
(if split-amt (set! near-split-total
(begin (+ near-split-total split-amt))
(gnc:split-set-base-value gnc-near-split (gnc:split-set-base-value gnc-far-split
split-amt (- split-amt) currency)
currency)
(gnc:split-set-base-value gnc-far-split
(- split-amt)
currency))
(error "No amount in split!" qif-split "txn:" qif-xtn))
(if memo (if memo
(begin (begin
(gnc:split-set-memo gnc-near-split memo)
(gnc:split-set-memo gnc-far-split memo))) (gnc:split-set-memo gnc-far-split memo)))
;; my guess is that you can't have Quicken splits ;; my guess is that you can't have Quicken splits
@ -304,15 +318,15 @@
(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)))
(let ((price (qif-xtn:share-price qif-xtn))) (let ((price (qif-xtn:share-price qif-xtn)))
(gnc:split-set-share-price gnc-near-split price) (gnc:split-set-share-price gnc-near-split price)
(gnc:split-set-share-price gnc-far-split price))) (gnc:split-set-share-price gnc-far-split price)))
(begin (begin
(gnc:split-set-share-price gnc-near-split 1.0) (gnc:split-set-share-price gnc-near-split 1.0)
(gnc:split-set-share-price gnc-far-split 1.0))) (gnc:split-set-share-price gnc-far-split 1.0)))
(if (qif-xtn:num-shares qif-xtn) (if (qif-xtn:num-shares qif-xtn)
(let ((numshares (qif-xtn:num-shares qif-xtn))) (let ((numshares (qif-xtn:num-shares qif-xtn)))
(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 : ")
@ -355,14 +369,24 @@
(list-ref far-acct-info 1)) (list-ref far-acct-info 1))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name)))) (set! far-acct (hash-ref gnc-acct-hash far-acct-name))))
;; set the reconcile status
(let ((cleared (qif-xtn:cleared qif-xtn)))
(cond ((eq? 'cleared cleared)
(gnc:split-set-reconcile gnc-far-split #\c))
((eq? 'reconciled cleared)
(gnc:split-set-reconcile gnc-far-split #\r))))
;; finally, plug the splits into the accounts ;; finally, plug the splits into the accounts
(gnc:transaction-append-split gnc-xtn gnc-near-split)
(gnc:transaction-append-split gnc-xtn gnc-far-split) (gnc:transaction-append-split gnc-xtn gnc-far-split)
(gnc:account-insert-split near-acct gnc-near-split) (gnc:account-insert-split far-acct gnc-far-split)))
(gnc:account-insert-split far-acct gnc-far-split)))
splits) splits)
(gnc:split-set-base-value gnc-near-split
near-split-total
(qif-file:currency qif-file))
(gnc:transaction-append-split gnc-xtn gnc-near-split)
(gnc:account-insert-split near-acct gnc-near-split)
;; return the modified transaction (though it's ignored). ;; return the modified transaction (though it's ignored).
gnc-xtn)) gnc-xtn))

11
src/scm/qif-import/qif-utils.scm
View File

@ -38,7 +38,10 @@
""))) "")))
(define (string-remove-char str char) (define (string-remove-char str char)
(let ((rexpstr (make-string 1 char))) (let ((rexpstr
(if (not (eq? char #\.))
(make-string 1 char)
"\\.")))
(regexp-substitute/global #f rexpstr str 'pre 'post))) (regexp-substitute/global #f rexpstr str 'pre 'post)))
(define (string-char-count str char) (define (string-char-count str char)
@ -46,7 +49,10 @@
(string->list str)))) (string->list str))))
(define (string-replace-char! str old new) (define (string-replace-char! str old new)
(let ((rexpstr (make-string 1 old)) (let ((rexpstr
(if (not (eq? old #\.))
(make-string 1 old)
"\\."))
(newstr (make-string 1 new))) (newstr (make-string 1 new)))
(regexp-substitute/global #f rexpstr str 'pre newstr 'post))) (regexp-substitute/global #f rexpstr str 'pre newstr 'post)))
@ -62,3 +68,4 @@
(loop first-char)) (loop first-char))
(set! parts (cons (substring str 0 last-char) parts)))) (set! parts (cons (substring str 0 last-char) parts))))
parts)) parts))

4
src/scm/report/budget-report.scm
View File

@ -515,7 +515,3 @@
budget-list) budget-list)
(html-end-table) (html-end-table)
(html-end-document)))))) (html-end-document))))))