aherman
/
gnucash
mirror of https://github.com/Gnucash/gnucash
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2104 57a11ea4-9604-0410-9ed3-97b8803252fd
zzzoldreleases/1.4
Dave Peticolas 27 years ago
parent 3d6fc24d2b
commit e6a025cd57
15 changed files with 3976 additions and 2548 deletions
Show Stats Download Patch File Download Diff File

3
config.h.in
Unescape View File

@ -55,6 +55,9 @@
/* Use the new XmHTML widdget instead of the old htmlw widget */
#define HAVE_LIBXMHTML 1
/* use gnomeprint if it's available */
#undef HAVE_LIBGNOMEPRINT
/* misc image and compression libs needed by html widget */
#undef HAVE_ZLIB
#undef HAVE_PNG

4451
configure vendored
View File

File diff suppressed because it is too large Load Diff

58
configure.in
Unescape View File

@ -44,9 +44,6 @@ AC_CHECK_FUNCS(stpcpy)
### Variables
### Set up all the initial variable values...
# USE_QUICKFILL:
AC_DEFINE(USE_QUICKFILL,1)
@ -77,6 +74,19 @@ AC_ARG_ENABLE( warnings,
LDFLAGS="${LDFLAGS} -g -Wall"
AC_DEFINE(DEBUG_MEMORY,1) AC_DEFINE(USE_DEBUG,1) )
### --------------------------------------------------------------------------
### i18n
AC_ARG_WITH( locale-dir,
[ --with-locale-dir=PATH specify where to look for locale-specific information],
LOCALE_DIR="$with_locale_dir",
LOCALE_DIR="$prefix/share/locale")
AC_SUBST(LOCALE_DIR)
AC_CHECK_HEADER(locale.h, ac_cv_header_locale_h=yes, ac_cv_header_locale_h=no)
AC_CAN_USE_GNU_GETTEXT
### --------------------------------------------------------------------------
## qt-version of gnucash
# The qt version of gnucash is far from doing anything usefull, so most people
@ -336,28 +346,37 @@ AC_TRY_CPP([#include <gtk-xmhtml/gtk-xmhtml.h>], AC_MSG_RESULT(yes) ,
#undo damage to CPPFLAGS
CPPFLAGS="$OLDCPPFLAGS"
OLDLDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS `$GNOME_CONFIG_BIN --libs gtkxmhtml`"
### --------------------------------------------------------------------------
# If readline exists, just assume that guile needs it. It probably does.
AC_CHECK_LIB(readline, readline)
### --------------------------------------------------------------------------
EXTRALIBS=`$GNOME_CONFIG_BIN --libs gtkxmhtml`
#check for gtkxmhtml, export library link to variable GTK_XMHTML
AC_CHECK_LIB(gtkxmhtml, gtk_xmhtml_new,
GTK_XMHTML="gtkxmhtml",
AC_MSG_WARN([Cannotfind libgtkxmhtml -- gnome build disabled (not required for motif)])
GNOME_TARGET="gnome.disabled"
GNOME_STATIC_TARGET="gnome.disabled")
GNOME_STATIC_TARGET="gnome.disabled",
$EXTRALIBS)
AC_SUBST(GTK_XMHTML)
LDFLAGS="$OLDLDFLAGS"
### --------------------------------------------------------------------------
EXTRALIBS=`$GNOME_CONFIG_BIN --libs print`
# check for gnome-print and enable it via HAVE_LIBGNOMEPRINT
# if found
AC_CHECK_LIB(gnomeprint, gnome_print_context_new, , , $EXTRALIBS)
# XXX - should we export these here or later in the configure script?
AC_SUBST(GNOME_TARGET)
AC_SUBST(GNOME_STATIC_TARGET)
### --------------------------------------------------------------------------
# If readline exists, just assume that guile needs it. It probably does.
AC_CHECK_LIB(readline, readline)
### --------------------------------------------------------------------------
### Guile (libraries and executable)
@ -523,19 +542,6 @@ AC_SUBST(GNC_RUNTIME_PERLLIBPATH)
ABSOLUTE_TOP_SRCDIR=`pwd`
AC_SUBST(ABSOLUTE_TOP_SRCDIR)
### Begin i18n
AC_ARG_WITH( locale-dir,
[ --with-locale-dir=PATH specify where to look for locale-specific information],
LOCALE_DIR="$with_locale_dir",
LOCALE_DIR="$prefix/share/locale")
AC_SUBST(LOCALE_DIR)
AC_CHECK_HEADER(locale.h, ac_cv_header_locale_h=yes, ac_cv_header_locale_h=no)
AC_CAN_USE_GNU_GETTEXT
### End i18n
AC_CONFIG_HEADER(config.h)
AC_OUTPUT(Makefile

6
src/gnome/Makefile.in
Unescape View File

@ -42,7 +42,7 @@ LDFLAGS = @LDFLAGS@
GUILELIBS = @GUILELIBS@
LIBS = -L$(prefix)/lib @LIBS@ \
$(shell ${GNOME_CONFIG_BIN} --libs gnomeui @GTK_XMHTML@) $(GUILELIBS) \
$(shell ${GNOME_CONFIG_BIN} --libs gnomeui print @GTK_XMHTML@) $(GUILELIBS) \
@top_srcdir@/lib/g-wrap-install/lib/libgwrapguile.a
ifeq (${HAVE_PLOTUTILS},1)
@ -70,8 +70,8 @@ GNOME_SRCS := top-level.c window-main.c window-register.c window-adjust.c \
dialog-add.c dialog-edit.c dialog-utils.c \
extensions.c query-user.c reconcile-list.c \
window-report.c global-options.c \
dialog-qif-import.c glade-qif-import.c \
dialog-account-picker.c glade-account-picker.c
dialog-qif-import.c glade-gnc-dialogs.c \
dialog-account-picker.c print-session.c
######################################################################
all: gnome

1148
src/gnome/gnc-dialogs.glade
View File

File diff suppressed because it is too large Load Diff

4
src/gnome/window-register.c
Unescape View File

@ -968,8 +968,8 @@ print_check_cb(GtkWidget * widget, gpointer data)
gh_str02scm(memo)));
}
#else
gnc_info_dialog_parented(reg_data->dialog,
_"You need to install the gnome-print library.");
gnc_info_dialog_parented(GTK_WINDOW(reg_data->window),
_("You need to install the gnome-print library."));
#endif
}

6
src/scm/main.scm
Unescape View File

@ -25,7 +25,13 @@
"/scm/qif-import")
(gnc:config-var-value-get gnc:*load-path*)))
(gnc:config-var-value-set! gnc:*load-path* #f
(cons (string-append gnc:_share-dir-default_
"/scm/printing")
(gnc:config-var-value-get gnc:*load-path*)))
(gnc:depend "qif-import.scm")
(gnc:depend "print-check.scm")
;; Load the system configs
(if (not (gnc:load-system-config-if-needed))

112
src/scm/printing/number-to-words.scm
Unescape View File

@ -0,0 +1,112 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; number-to-words.scm
;;; convert a number into a sentence for check printing
;;;
;;; Copyright 2000 Bill Gribble <grib@billgribble.com>
;;; $Id$
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(gnc:support "number-to-words.scm")
(define (integer-to-words val)
(let ((current-string "")
(small-numbers
#("zero" "one" "two" "three" "four" "five"
"six" "seven" "eight" "nine" "ten"
"eleven" "twelve" "thirteen" "fourteen" "fifteen"
"sixteen" "seventeen" "eighteen" "nineteen" "twenty"))
(medium-numbers
#("zero" "ten" "twenty" "thirty" "forty" "fifty"
"sixty" "seventy" "eighty" "ninety"))
(big-numbers
#("hundred" "thousand" "million" "billion" "trillion"
"quadrillion" "quintillion")))
(cond
((< val 20)
(vector-ref small-numbers val))
((< val 100)
(let ((this-part (quotient val 10))
(that-part (remainder val 10)))
(set! current-string (vector-ref medium-numbers this-part))
(if (> that-part 0)
(set! current-string
(string-append current-string "-"
(vector-ref small-numbers that-part))))
current-string))
((< val 1000)
(let ((this-part (quotient val 100))
(that-part (remainder val 100)))
(set! current-string
(string-append current-string
(vector-ref small-numbers this-part) " "
(vector-ref big-numbers 0)))
(if (> that-part 0)
(set! current-string
(string-append current-string
" " (integer-to-words that-part))))
current-string))
(#t
(let* ((log-val (inexact->exact
(truncate (+ .00001 (/ (log10 val) 3)))))
(this-part (quotient val
(inexact->exact
(truncate
(+ .00001 (expt 10 (* 3 log-val)))))))
(that-part (remainder val
(inexact->exact
(+ .00001
(truncate
(expt 10 (* 3 log-val))))))))
(if (> this-part 0)
(set! current-string
(string-append (integer-to-words this-part)
" " (vector-ref big-numbers log-val))))
(if (> that-part 0)
(set! current-string
(string-append current-string
" " (integer-to-words that-part))))
current-string)))))
;; return a string with the number properly truncated and zero padded
;; for check printing
(define (printable-value val frac-denom)
(let* ((int-part (inexact->exact (truncate val)))
(frac-part (inexact->exact
(truncate
(+ (/ .5 frac-denom) (* frac-denom
(- val int-part)))))))
(with-output-to-string
(lambda ()
(write int-part) (display ".")
(if (< frac-part 10) (display "0"))
(write frac-part)))))
(define (number-to-words val frac-denom)
(let* ((negative?
(if (< val 0)
(begin (set! val (- val))
#t)
#f))
(int-part (inexact->exact (truncate val)))
(frac-part (inexact->exact
(truncate
(+ (/ .5 frac-denom) (* frac-denom (- val int-part))))))
(result-string ""))
(set! result-string
(string-append (integer-to-words int-part) " and "
(with-output-to-string
(lambda ()
(write frac-part)
(display "/")
(write frac-denom)))))
(string-set! result-string 0
(char-upcase (string-ref result-string 0)))
result-string))

59
src/scm/printing/print-check.scm
Unescape View File

@ -0,0 +1,59 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; print-check.scm
;;; print a check from a transaction.
;;;
;;; Copyright 2000 Bill Gribble <grib@billgribble.com>
;;; $Id$
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(gnc:support "print-check.scm")
(gnc:depend "number-to-words.scm")
;; format notes (I found a GIF of the check form and am measuring from
;; that, so this is definitely not perfect) positions are lower-left
;; text origin, (0,0) at lower left of page, in inches, for
;; US-Letter format paper.
(define quicken-check-3up-at-top-us-letter
'((payee . (1.0625 9.625))
(amount-words . (1.0625 9.325))
(amount-number . (6.5 9.625))
(date . (6.5 10.1))
(memo . (1.0625 8.15))))
(define (gnc:print-check payee amount date memo)
(let* ((int-part (inexact->exact (truncate amount)))
(frac-part (inexact->exact
(truncate
(+ (/ .5 100) (* 100 (- amount int-part))))))
(ps (gnc:print-session-create))
(format quicken-check-3up-at-top-us-letter)
(inches-to-points
(lambda (inches)
(* inches 72))))
(let ((date-pos (assq 'date format)))
(gnc:print-session-moveto ps
(inches-to-points (cadr date-pos))
(inches-to-points (caddr date-pos)))
(gnc:print-session-text ps date))
(let ((payee-pos (assq 'payee format)))
(gnc:print-session-moveto ps
(inches-to-points (cadr payee-pos))
(inches-to-points (caddr payee-pos)))
(gnc:print-session-text ps payee))
(let ((number-pos (assq 'amount-number format)))
(gnc:print-session-moveto ps
(inches-to-points (cadr number-pos))
(inches-to-points (caddr number-pos)))
(gnc:print-session-text ps (printable-value amount 100)))
(let ((words-pos (assq 'amount-words format)))
(gnc:print-session-moveto ps
(inches-to-points (cadr words-pos))
(inches-to-points (caddr words-pos)))
(gnc:print-session-text ps (number-to-words amount 100)))
(gnc:print-session-done ps)
(gnc:print-dialog-create ps)))

558
src/scm/qif-import/qif-file.scm
Unescape View File

@ -28,9 +28,10 @@
(tag #f)
(value #f)
(heinous-error #f)
(valid-acct-types '(type:bank type:cash
type:ccard type:invst
#{type:oth\ a}# #{type:oth\ l}#)))
(valid-acct-types
'(type:bank type:cash
type:ccard type:invst
#{type:oth\ a}# #{type:oth\ l}#)))
(with-input-from-file path
(lambda ()
;; loop over lines
@ -63,186 +64,196 @@
(set! current-xtn (make-qif-cat)))
((eq? qstate-type 'account)
(set! current-xtn (make-qif-acct)))))
; (#t
; (display "qif-file:read-file can't handle ")
; (write qstate-type)
; (display " transactions yet.")
; (newline))))
;;; (#t
;;; (display "qif-file:read-file can't handle ")
;;; (write qstate-type)
;;; (display " transactions yet.")
;;; (newline))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; account transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((member qstate-type valid-acct-types)
(case tag
;; D : transaction date
((#\D)
(qif-xtn:set-date! current-xtn
(qif-file:parse-date self value)))
;; T : total amount
((#\T)
(qif-split:set-amount! default-split
(qif-file:parse-value self value)))
;; P : payee
((#\P)
(qif-xtn:set-payee! current-xtn
(qif-file:parse-string self value)))
;; A : address
;; multiple "A" lines are appended together with
;; newlines; some Quicken files have a lot of
;; A lines.
((#\A)
(qif-xtn:set-address!
current-xtn
(let ((current (qif-xtn:address current-xtn)))
(if (not (string? current))
(set! current ""))
(string-append
current "\n"
(qif-file:parse-string self value)))))
;; N : check number / transaction number /xtn direction
;; this could be a number or a string; no point in
;; keeping it numeric just yet.
((#\N)
(qif-xtn:set-number!
current-xtn (qif-file:parse-string self value)))
;; C : cleared flag
((#\C)
(qif-xtn:set-cleared!
current-xtn (qif-file:parse-cleared-field self value)))
;; M : memo
((#\M)
(qif-split:set-memo! default-split
;; D : transaction date
((#\D)
(qif-xtn:set-date! current-xtn
(qif-file:parse-date self value)))
;; T : total amount
((#\T)
(qif-split:set-amount!
default-split (qif-file:parse-value/decimal self value))
(if (not (number? (qif-split:amount default-split)))
(begin
(display "value not a number : ")
(display value) (display " ")
(write (qif-split:amount default-split))
(newline))))
;; P : payee
((#\P)
(qif-xtn:set-payee! current-xtn
(qif-file:parse-string self value)))
;; I : share price (stock transactions)
((#\I)
(qif-xtn:set-share-price!
current-xtn (qif-file:parse-value self value)))
;; Q : share price (stock transactions)
((#\Q)
(qif-xtn:set-num-shares!
current-xtn (qif-file:parse-value self value))
(qif-xtn:set-bank-xtn?! current-xtn #f))
;; Y : name of security (stock transactions)
((#\Y)
(qif-xtn:set-security-name!
current-xtn (qif-file:parse-string self value)))
;; O : adjustment (stock transactions)
((#\O)
(qif-xtn:set-adjustment!
current-xtn (qif-file:parse-value/decimal self value)))
;; L : category
((#\L)
(qif-split:set-category!
default-split (qif-file:parse-string self value)))
;; S : split category
((#\S)
(set! current-split (make-qif-split))
(qif-split:set-category!
current-split (qif-file:parse-string self value))
(qif-xtn:set-splits!
current-xtn
(cons current-split (qif-xtn:splits current-xtn))))
;; E : split memo (?)
((#\E)
(qif-split:set-memo!
current-split (qif-file:parse-string self value)))
;; $ : split amount (if there are splits)
((#\$)
;; if this is 'Type:Invst, I can't figure out
;; what the $ signifies. I'll do it later.
(if (not (eq? qstate-type 'type:invst))
(qif-split:set-amount!
current-split
(qif-file:parse-value/decimal self value))))
;; ^ : end-of-record
((#\^)
(if (and (qif-xtn:date current-xtn)
(qif-split:amount default-split))
(begin
(if (null? (qif-xtn:splits current-xtn))
(qif-xtn:set-splits! current-xtn
(list default-split)))
(qif-file:add-xtn! self current-xtn))
(begin
(display "qif-file:read-file : discarding xtn")
(newline)
(qif-xtn:print current-xtn)))
(if (and first-xtn
(string? (qif-xtn:payee current-xtn))
(string=? (qif-xtn:payee current-xtn)
"Opening Balance")
(eq? (length (qif-xtn:splits current-xtn)) 1)
(qif-split:category-is-account?
(car (qif-xtn:splits current-xtn))))
(begin
(qif-file:set-account!
self (qif-split:category
(car (qif-xtn:splits current-xtn))))
(qif-split:set-category!
(car (qif-xtn:splits current-xtn))
"Opening Balance")))
;; A : address
;; multiple "A" lines are appended together with
;; newlines; some Quicken files have a lot of
;; A lines.
((#\A)
(qif-xtn:set-address!
current-xtn
(let ((current (qif-xtn:address current-xtn)))
(if (not (string? current))
(set! current ""))
(string-append
current "\n"
(qif-file:parse-string self value)))))
;; some special love for stock transactions
(if (and (qif-xtn:security-name current-xtn)
(string? (qif-xtn:number current-xtn)))
(begin
(cond
((and
(or (string=? (qif-xtn:number current-xtn)
"ReinvDiv")
(string=? (qif-xtn:number current-xtn)
"ReinvLg")
(string=? (qif-xtn:number current-xtn)
"ReinvSh")
(string=? (qif-xtn:number current-xtn)
"Div"))
(string=?
"" (qif-split:category
(car
(qif-xtn:splits current-xtn)))))
(qif-split:set-category!
(car (qif-xtn:splits current-xtn))
"Dividend")
;; KLUDGE! for brokerage accounts
;; where Dividend pays into the
;; brokerage account.
(if (and (qif-xtn:bank-xtn? current-xtn)
(string?
(qif-xtn:security-name
current-xtn)))
(qif-xtn:set-payee!
current-xtn (qif-xtn:security-name
current-xtn))))
((or (string=? (qif-xtn:number current-xtn)
"SellX")
(string=? (qif-xtn:number current-xtn)
"Sell"))
(qif-xtn:set-num-shares!
current-xtn
(string-append
"-" (qif-xtn:num-shares current-xtn)))))))
;; N : check number / transaction number /xtn direction
;; this could be a number or a string; no point in
;; keeping it numeric just yet.
((#\N)
(qif-xtn:set-number!
current-xtn (qif-file:parse-string self value)))
;; C : cleared flag
((#\C)
(qif-xtn:set-cleared!
current-xtn (qif-file:parse-cleared-field self value)))
;; M : memo
((#\M)
(qif-split:set-memo! default-split
(qif-file:parse-string self value)))
;; I : share price (stock transactions)
((#\I)
(qif-xtn:set-share-price!
current-xtn (qif-file:parse-value self value)))
;; Q : share price (stock transactions)
((#\Q)
(qif-xtn:set-num-shares!
current-xtn (qif-file:parse-value self value))
(qif-xtn:set-bank-xtn?! current-xtn #f))
(set! first-xtn #f)
(set! current-xtn (make-qif-xtn))
(set! default-split (make-qif-split)))))
;; Y : name of security (stock transactions)
((#\Y)
(qif-xtn:set-security-name!
current-xtn (qif-file:parse-string self value)))
;; O : adjustment (stock transactions)
((#\O)
(qif-xtn:set-adjustment!
current-xtn (qif-file:parse-value/decimal self value)))
;; L : category
((#\L)
(qif-split:set-category!
default-split (qif-file:parse-string self value)))
;; S : split category
((#\S)
(set! current-split (make-qif-split))
(qif-split:set-category!
current-split (qif-file:parse-string self value))
(qif-xtn:set-splits!
current-xtn
(cons current-split (qif-xtn:splits current-xtn))))
;; E : split memo (?)
((#\E)
(qif-split:set-memo!
current-split (qif-file:parse-string self value)))
;; $ : split amount (if there are splits)
((#\$)
;; if this is 'Type:Invst, I can't figure out
;; what the $ signifies. I'll do it later.
(if (not (eq? qstate-type 'type:invst))
(qif-split:set-amount!
current-split
(qif-file:parse-value/decimal self value))))
;; ^ : end-of-record
((#\^)
(if (and (qif-xtn:date current-xtn)
(qif-split:amount default-split))
(begin
(if (null? (qif-xtn:splits current-xtn))
(qif-xtn:set-splits! current-xtn
(list default-split)))
(qif-file:add-xtn! self current-xtn))
(begin
(display "qif-file:read-file : discarding xtn")
(newline)
(qif-xtn:print current-xtn)))
(if (and first-xtn
(string? (qif-xtn:payee current-xtn))
(string=? (qif-xtn:payee current-xtn)
"Opening Balance")
(eq? (length (qif-xtn:splits current-xtn)) 1)
(qif-split:category-is-account?
(car (qif-xtn:splits current-xtn))))
(begin
(qif-file:set-account!
self (qif-split:category
(car (qif-xtn:splits current-xtn))))
(qif-split:set-category!
(car (qif-xtn:splits current-xtn))
"Opening Balance")))
;; some special love for stock transactions
(if (and (qif-xtn:security-name current-xtn)
(string? (qif-xtn:number current-xtn)))
(begin
(cond
((and
(or (string=? (qif-xtn:number current-xtn)
"ReinvDiv")
(string=? (qif-xtn:number current-xtn)
"ReinvLg")
(string=? (qif-xtn:number current-xtn)
"ReinvSh")
(string=? (qif-xtn:number current-xtn)
"Div"))
(string=?
"" (qif-split:category
(car
(qif-xtn:splits current-xtn)))))
(qif-split:set-category!
(car (qif-xtn:splits current-xtn))
"Dividend")
;; KLUDGE! for brokerage accounts
;; where Dividend pays into the
;; brokerage account.
(if (and (qif-xtn:bank-xtn? current-xtn)
(string?
(qif-xtn:security-name
current-xtn)))
(qif-xtn:set-payee!
current-xtn (qif-xtn:security-name
current-xtn))))
((or (string=? (qif-xtn:number current-xtn)
"SellX")
(string=? (qif-xtn:number current-xtn)
"Sell"))
(let ((shrs (qif-xtn:num-shares current-xtn)))
(cond ((string? shrs)
(qif-xtn:set-num-shares!
current-xtn
(string-append "-" shrs)))
((number? shrs)
(qif-xtn:set-num-shares!
current-xtn (- shrs)))))))))
(set! first-xtn #f)
(set! current-xtn (make-qif-xtn))
(set! default-split (make-qif-split)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -250,103 +261,103 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((eq? qstate-type 'type:class)
(case tag
;; N : name
((#\N)
(qif-class:set-name! current-xtn
(qif-file:parse-string self value)))
;; D : description
((#\D)
(qif-class:set-description!
current-xtn (qif-file:parse-string self value)))
;; end-of-record
((#\^)
(qif-file:add-class! self current-xtn)
(set! current-xtn (make-qif-class)))
(else
(display "qif-file:read-file : unknown Class slot ")
(display tag) (newline))))
;; N : name
((#\N)
(qif-class:set-name! current-xtn
(qif-file:parse-string self value)))
;; D : description
((#\D)
(qif-class:set-description!
current-xtn (qif-file:parse-string self value)))
;; end-of-record
((#\^)
(qif-file:add-class! self current-xtn)
(set! current-xtn (make-qif-class)))
(else
(display "qif-file:read-file : unknown Class slot ")
(display tag) (newline))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Account definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((eq? qstate-type 'account)
(case tag
((#\N)
(qif-acct:set-name! current-xtn
(qif-file:parse-string self value)))
((#\D)
(qif-acct:set-description!
current-xtn (qif-file:parse-string self value)))
((#\T)
(qif-acct:set-type!
current-xtn (qif-file:parse-acct-type self value)))
((#\L)
(qif-acct:set-limit!
current-xtn (qif-file:parse-value/decimal self value)))
((#\^)
(qif-file:add-account! self current-xtn)
; (qif-acct:print current-xtn)
(set! current-xtn (make-qif-acct)))
(else
(display "qif-file:read-file : unknown Account slot ")
(display tag) (newline))))
((#\N)
(qif-acct:set-name! current-xtn
(qif-file:parse-string self value)))
((#\D)
(qif-acct:set-description!
current-xtn (qif-file:parse-string self value)))
((#\T)
(qif-acct:set-type!
current-xtn (qif-file:parse-acct-type self value)))
((#\L)
(qif-acct:set-limit!
current-xtn (qif-file:parse-value/decimal self value)))
((#\^)
(qif-file:add-account! self current-xtn)
;;; (qif-acct:print current-xtn)
(set! current-xtn (make-qif-acct)))
(else
(display "qif-file:read-file : unknown Account slot ")
(display tag) (newline))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Category (Cat) transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((eq? qstate-type 'type:cat)
(case tag
;; N : category name
((#\N)
(qif-cat:set-name! current-xtn
(qif-file:parse-string self value)))
;; D : category description
((#\D)
(qif-cat:set-description! current-xtn
(qif-file:parse-string
self value)))
;; E : is this a taxable category?
((#\T)
(qif-cat:set-taxable! current-xtn #t))
;; E : is this an expense category?
((#\E)
(qif-cat:set-expense-cat! current-xtn #t))
;; I : is this an income category?
((#\I)
(qif-cat:set-income-cat! current-xtn #t))
;; R : what is the tax rate (from some table?
;; seems to be an integer)
((#\R)
(qif-cat:set-tax-rate!
current-xtn (qif-file:parse-value/decimal self value)))
;; B : budget amount. not really supported.
((#\B)
(qif-cat:set-budget-amt!
current-xtn (qif-file:parse-value/decimal self value)))
;; end-of-record
((#\^)
(qif-file:add-cat! self current-xtn)
; (qif-cat:print current-xtn)
(set! current-xtn (make-qif-cat)))
(else
(display "qif-file:read-file : unknown Cat slot ")
(display tag) (newline))))
;; N : category name
((#\N)
(qif-cat:set-name! current-xtn
(qif-file:parse-string self value)))
;; D : category description
((#\D)
(qif-cat:set-description! current-xtn
(qif-file:parse-string
self value)))
;; E : is this a taxable category?
((#\T)
(qif-cat:set-taxable! current-xtn #t))
;; E : is this an expense category?
((#\E)
(qif-cat:set-expense-cat! current-xtn #t))
;; I : is this an income category?
((#\I)
(qif-cat:set-income-cat! current-xtn #t))
;; R : what is the tax rate (from some table?
;; seems to be an integer)
((#\R)
(qif-cat:set-tax-rate!
current-xtn (qif-file:parse-value/decimal self value)))
;; B : budget amount. not really supported.
((#\B)
(qif-cat:set-budget-amt!
current-xtn (qif-file:parse-value/decimal self value)))
;; end-of-record
((#\^)
(qif-file:add-cat! self current-xtn)
;;; (qif-cat:print current-xtn)
(set! current-xtn (make-qif-cat)))
(else
(display "qif-file:read-file : unknown Cat slot ")
(display tag) (newline))))
;; trying to sneak one by, eh?
(#t
@ -392,40 +403,33 @@
(if (eq? 'unknown (qif-file:account self))
(qif-file:set-account!
self (qif-file:path-to-accountname self)))
;; reparse values and dates if we figured out the format.
(let ((reparse-ok #t))
(for-each
(lambda (xtn)
(set! reparse-ok
(and reparse-ok (qif-xtn:reparse xtn self))))
(if (eq? reparse-ok #t)
(set! reparse-ok
(qif-xtn:reparse xtn self))))
(qif-file:xtns self))
(if (not reparse-ok)
(begin
(display "xtn reparse failed") (newline)))
(for-each
(lambda (cat)
(set! reparse-ok
(and reparse-ok (qif-cat:reparse cat self))))
(if (eq? reparse-ok #t)
(set! 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))))
(if (eq? reparse-ok #t)
(set! reparse-ok
(qif-acct:reparse acct self))))
(qif-file:accounts self))
(if (not reparse-ok)
(begin
(display "acct reparse failed") (newline)))
(display "reparse-ok == ") (write reparse-ok) (newline)
reparse-ok))
(begin
(display "There was a heinous error. Failed to read file.")
(newline)
#f))))

4
src/scm/qif-import/qif-guess-map.scm
Unescape View File

@ -53,7 +53,9 @@
(let* ((name (gnc:account-get-name child-acct))
(fullname
(if (string? root-name)
(string-append root-name ":" name)
(string-append root-name
(gnc:account-separator-char)
name)
name)))
(set! names
(append (cons (list name fullname child-acct)

27
src/scm/qif-import/qif-objects.scm
Unescape View File

@ -324,8 +324,12 @@
(if (or (string? (qif-xtn:share-price self))
(string? (qif-xtn:num-shares self))
(string? (qif-xtn:adjustment self)))
(set! reparse-ok #f))
(begin
(display "qif-import: failed to reparse stock info")
(newline)
(set! reparse-ok
(list #f "Could not autodetect radix format."))))
;; reparse the amount of each split
(for-each
(lambda (split)
@ -334,8 +338,11 @@
split
(qif-file:parse-value qif-file (qif-split:amount split))))
(if (string? (qif-split:amount split))
(set! reparse-ok #f)))
(begin
(display "qif-import: failed to reparse value")
(write (qif-split:amount split)) (newline)
(set! reparse-ok
(list #f "Could not autodetect radix format.")))))
(qif-xtn:splits self))
;; reparse the date
@ -344,8 +351,11 @@
(qif-file:parse-date qif-file
(qif-xtn:date self))))
(if (string? (qif-xtn:date self))
(set! reparse-ok #f))
(begin
(display "qif-import: failed to reparse date")
(write (qif-xtn:date self)) (newline)
(set! reparse-ok
(list #f "Could not autodetect date format."))))
reparse-ok))
(define (qif-xtn:print self)
@ -403,7 +413,7 @@
self (qif-file:parse-value file (qif-acct:limit self))))
(if (or (string? (qif-acct:limit self))
(string? (qif-acct:type self)))
#f
(list #f "Could not autodetect radix for fields in Account record")
#t))
@ -518,7 +528,8 @@
(if (or (string? (qif-cat:tax-rate self))
(string? (qif-cat:budget-amt self)))
#f #t))
(list #f "Could not autodetect radix for fields in Category record")
#t))
(define (qif-file:add-xtn! self xtn)

50
src/scm/qif-import/qif-parse.scm
Unescape View File

@ -1,4 +1,4 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; qif-parse.scm
;;; routines to parse values and dates in QIF files.
;;;
@ -199,11 +199,13 @@
(display "qif-import: Substituting 1/1/2999 for date.") (newline)
(set! date-string "1/1/2999")))
(set! date-string (string-remove-trailing-space date-string))
(let ((date-parts '())
(numeric-date-parts '())
(retval date-string)
(match
(string-match "([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+)"
(string-match "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+) *$"
date-string)))
(if match
(set! date-parts (list (match:substring match 1)
@ -223,7 +225,7 @@
((not (eq? 3 (length date-parts)))
(begin
(display "qif-file:parse-date : can't interpret date ")
(display date-string) (newline)))
(display date-string) (display " ") (write date-parts)(newline)))
;; if the format is unknown, don't try to fully interpret the
;; number, just look for a good guess or an inconsistency with
@ -254,7 +256,7 @@
(qif-file:set-guessed-date-format! self 'inconsistent))))
;; current guess is y/d/m (is this really possible?)
((eq? (qif-file:guessed-date-format self) 'y-m-d)
((eq? (qif-file:guessed-date-format self) 'y-d-m)
(let ((d (cadr numeric-date-parts))
(m (caddr numeric-date-parts)))
(if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31))
@ -357,11 +359,11 @@
(define decimal-radix-regexp
(make-regexp
"^-?[0-9]+$|^-?[0-9]?[0-9]?[0-9]?(,[0-9][0-9][0-9])*(\\.[0-9]*)?$"))
"^\\$?-?\\$?[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]*)?$"))
"^\\$?-?\\$?[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)
@ -371,19 +373,35 @@
(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)))))
(set! value-string (string-remove-trailing-space value-string))
(if (value-is-decimal-radix? value-string)
(let ((read-val
(with-input-from-string
(string-remove-char
(string-remove-char value-string #\,)
#\$)
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f))
#f))
(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)))))
(set! value-string (string-remove-trailing-space value-string))
(if (value-is-comma-radix? value-string)
(let ((read-val
(with-input-from-string
(string-remove-char
(string-replace-char!
(string-remove-char value-string #\.)
#\, #\.)
#\$)
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f))
#f))
(define (qif-file:parse-value self value-string)
(if (or (not (string? value-string))

25
src/scm/qif-import/qif-to-gnc.scm
Unescape View File

@ -17,15 +17,16 @@
(define (qif-import:find-or-make-acct gnc-name gnc-acct-hash
gnc-type qif-info acct-group)
(let ((existing-account (hash-ref gnc-acct-hash gnc-name))
(same-gnc-account (gnc:get-account-from-full-name acct-group
gnc-name
#\:))
(check-full-name #f)
(make-new-acct #f)
(default-currency
(gnc:option-value
(gnc:lookup-global-option "International" "Default Currency"))))
(let* ((separator (string-ref (gnc:account-separator-char) 0))
(existing-account (hash-ref gnc-acct-hash gnc-name))
(same-gnc-account (gnc:get-account-from-full-name acct-group
gnc-name
separator))
(check-full-name #f)
(make-new-acct #f)
(default-currency
(gnc:option-value
(gnc:lookup-global-option "International" "Default Currency"))))
(if (or (pointer-token-null? same-gnc-account)
(and (not (pointer-token-null? same-gnc-account))
@ -45,11 +46,11 @@
(parent-name #f)
(acct-name #f)
(last-colon #f))
(set! last-colon (string-rindex gnc-name #\:))
(set! last-colon (string-rindex gnc-name separator))
(gnc:init-account new-acct)
(gnc:account-begin-edit new-acct 1)
;; if this is a copy of an existing gnc account,
;; copy the account properties
(if (not make-new-acct)

13
src/scm/qif-import/qif-utils.scm
Unescape View File

@ -39,9 +39,16 @@
(define (string-remove-char str char)
(let ((rexpstr
(if (not (eq? char #\.))
(make-string 1 char)
"\\.")))
(case char
((#\.) "\\.")
((#\^) "\\^")
((#\$) "\\$")
((#\*) "\\*")
((#\+) "\\+")
((#\\) "\\\\")
((#\?) "\\?")
(else
(make-string 1 char)))))
(regexp-substitute/global #f rexpstr str 'pre 'post)))
(define (string-char-count str char)

Write Preview
Loading…
Cancel
Save