IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2026-08-04 18:33:36 -05:00
Code Issues Packages Projects Releases Wiki Activity

* src/engine/gnc-numeric.c: fix stupid. stupid. stupid. stupid

Browse Source 
log10 error

        * src/guile/gnc-helpers.c: start to fix scm_to_gint64 for
        guile-1.3.. this is sort of a duct-tape fix.  We need to port some
        stuff from the guile-1.4 source tree.  Should work fine unless you
        are Bill Gates and you do your accounting in lira.

        * src/gnome/dialog-style-sheet.c: handle WM delete event

        * src/scm/qif-import/qif-to-gnc.scm: fix backtrace-if-exception
        usage; add preliminary memo/payee-to-account mapping.

        * src/scm/utilities.scm: define hash-fold if it's not builtin


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3652 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
2001-02-13 23:20:29 +00:00
parent a26a55428a
commit 9a7f5b18d4
10 changed files with 307 additions and 235 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ChangeLog
+17
View File
@@ -1,3 +1,20 @@
2001-02-13 Bill Gribble <grib@billgribble.com>
* src/engine/gnc-numeric.c: fix stupid. stupid. stupid. stupid
log10 error
* src/guile/gnc-helpers.c: start to fix scm_to_gint64 for
guile-1.3.. this is sort of a duct-tape fix. We need to port some
stuff from the guile-1.4 source tree. Should work fine unless you
are Bill Gates and you do your accounting in lira.
* src/gnome/dialog-style-sheet.c: handle WM delete event
* src/scm/qif-import/qif-to-gnc.scm: fix backtrace-if-exception
usage; add preliminary memo/payee-to-account mapping.
* src/scm/utilities.scm: define hash-fold if it's not builtin
2001-02-12 Bill Gribble <grib@billgribble.com>
* src/scm/html-style-info.scm: minor fixes to html style
src/engine/gnc-numeric.c
+17 -7
View File
@@ -503,10 +503,15 @@ gnc_numeric_convert(gnc_numeric in, gint64 denom, gint how) {
break;
case GNC_DENOM_SIGFIG:
ratio = gnc_numeric_to_double(in);
logratio = log10(ratio);
logratio = ((logratio > 0.0) ?
(floor(logratio)+1.0) : (ceil(logratio)));
ratio = fabs(gnc_numeric_to_double(in));
if(ratio < 10e-20) {
logratio = 0;
}
else {
logratio = log10(ratio);
logratio = ((logratio > 0.0) ?
(floor(logratio)+1.0) : (ceil(logratio)));
}
sigfigs = GNC_NUMERIC_GET_SIGFIGS(how);
if(sigfigs-logratio >= 0) {
@@ -803,9 +808,14 @@ double_to_gnc_numeric(double in, gint64 denom, gint how) {
double sigfigs;
if((denom == GNC_DENOM_AUTO) && (how & GNC_DENOM_SIGFIG)) {
logval = log10(in);
logval = ((logval > 0.0) ?
(floor(logval)+1.0) : (ceil(logval)));
if(fabs(in) < 10e-20) {
logval = 0;
}
else {
logval = log10(fabs(in));
logval = ((logval > 0.0) ?
(floor(logval)+1.0) : (ceil(logval)));
}
sigfigs = GNC_NUMERIC_GET_SIGFIGS(how);
if(sigfigs-logval >= 0) {
denom = (gint64)(pow(10, sigfigs-logval));
src/gnome/dialog-account-picker.c
+2
View File
@@ -129,6 +129,8 @@ build_acct_tree(QIFAccountPickerDialog * picker, QIFImportWindow * import) {
&test_str_cmp);
gtk_ctree_select(GTK_CTREE(picker->treeview), new_sel);
gtk_ctree_node_moveto(GTK_CTREE(picker->treeview), new_sel, 0,
0.5, 0.0);
}
}
src/gnome/dialog-style-sheet.c
+9
View File
@@ -201,6 +201,13 @@ gnc_style_sheet_delete_cb(GtkWidget * w, gpointer user_data) {
}
static int
gnc_style_sheet_dialog_close_cb(GtkWidget * w, GdkEventAny * ev,
gpointer user_data) {
StyleSheetDialog * ss = user_data;
gtk_widget_hide(GTK_WIDGET(ss->toplevel));
}
static StyleSheetDialog *
gnc_style_sheet_dialog_create() {
StyleSheetDialog * ss = g_new0(StyleSheetDialog, 1);
@@ -222,6 +229,8 @@ gnc_style_sheet_dialog_create() {
gnc_style_sheet_new_cb, ss);
gtk_signal_connect(GTK_OBJECT(delete_button), "clicked",
gnc_style_sheet_delete_cb, ss);
gtk_signal_connect(GTK_OBJECT(ss->toplevel), "delete_event",
gnc_style_sheet_dialog_close_cb, ss);
gnc_style_sheet_dialog_fill(ss, SCM_BOOL_F);
gtk_window_set_policy(GTK_WINDOW(ss->toplevel), FALSE, TRUE, FALSE);
src/gnome/druid-qif-import.c
+3 -2
View File
@@ -543,8 +543,9 @@ gnc_ui_qif_import_load_file_next_cb(GnomeDruidPage * page,
/* create the <qif-file> object */
scm_qiffile = gh_call0(make_qif_file);
imported_files = gh_cons(scm_qiffile, imported_files);
wind->selected_file = scm_qiffile;
scm_unprotect_object(wind->selected_file);
wind->selected_file = scm_qiffile;
scm_protect_object(wind->selected_file);
/* load the file */
src/scm/qif-import/qif-dialog-utils.scm
+7 -6
View File
@@ -488,12 +488,12 @@
(key-string #f))
;; for each split: if there's a category, do nothing.
;; if there's a payee, use that as the
;; key. otherwise, use the split memo.
;; key otherwise, use the split memo.
(cond ((and cat
(or (not (string? cat))
(not (string=? cat ""))))
(set! key-string #f))
(payee
((and payee (= (length splits) 1))
(set! key-string payee))
(memo
(set! key-string memo)))
@@ -649,9 +649,9 @@
;; accounts the importer thinks it's going to make. Passed to the
;; account picker.
;;
;; returned is a tree-structured list of all the old and new
;; accounts like so :
;; (name new? children)
;; returned is a tree-structured list of all the old and new accounts
;; like so : (name new? children). trees are sorted alphabetically.
;; This should probably change but it's beeter than no sort at all.
(define (qif-import:get-all-accts extra-maps)
(define (cvt-to-tree path new?)
@@ -683,7 +683,8 @@
(loop (car tree-left) (cdr tree-left))
(set! newtree (cons (cvt-to-tree path new?)
newtree))))))
newtree))))
(sort newtree (lambda (a b) (string<? (car a) (car b))))))))
(let ((accts '())
(acct-tree '())
src/scm/qif-import/qif-file.scm
-2
View File
@@ -86,7 +86,6 @@
(set! ignore-accounts #f)
(set! current-xtn (make-qif-xtn))
(set! default-split (make-qif-split))
(qif-split:set-category! default-split "")
(set! first-xtn #t))
((type:class)
(set! current-xtn (make-qif-class)))
@@ -226,7 +225,6 @@
(set! current-xtn (make-qif-xtn))
(set! current-split #f)
(set! default-split (make-qif-split))
(if progress-dialog
(begin
(gnc:progress-dialog-set-value
src/scm/qif-import/qif-to-gnc.scm
+199 -176
View File
@@ -171,176 +171,171 @@
qif-memo-map stock-map
default-currency-name)
(gnc:backtrace-if-exception
qif-import:qif-to-gnc-unsafe
qif-acct-map qif-cat-map qif-memo-map stock-map default-currency-name))
(lambda ()
(let* ((old-group (gnc:get-current-group))
(new-group (gnc:malloc-account-group))
(gnc-acct-hash (make-hash-table 20))
(separator (string-ref (gnc:account-separator-char) 0))
(default-currency
(gnc:commodity-table-find-full
(gnc:engine-commodities)
GNC_COMMODITY_NS_ISO default-currency-name))
(sorted-accounts-list '())
(markable-xtns '())
(sorted-qif-files-list
(sort qif-files-list
(lambda (a b)
(> (length (qif-file:xtns a))
(length (qif-file:xtns b))))))
(progress-dialog #f)
(work-to-do 0)
(work-done 0))
;; first, build a local account tree that mirrors the gnucash
;; accounts in the mapping data. we need to iterate over the
;; cat-map and the acct-map to build the list
(hash-fold
(lambda (k v p)
(if (qif-map-entry:display? v)
(set! sorted-accounts-list
(cons v sorted-accounts-list)))
#t)
#t qif-acct-map)
(define (qif-import:qif-to-gnc-unsafe qif-files-list
qif-acct-map qif-cat-map qif-memo-map
stock-map
default-currency-name)
(let* ((old-group (gnc:get-current-group))
(new-group (gnc:malloc-account-group))
(gnc-acct-hash (make-hash-table 20))
(separator (string-ref (gnc:account-separator-char) 0))
(default-currency
(gnc:commodity-table-find-full
(gnc:engine-commodities)
GNC_COMMODITY_NS_ISO default-currency-name))
(sorted-accounts-list '())
(markable-xtns '())
(sorted-qif-files-list
(sort qif-files-list
(lambda (a b)
(> (length (qif-file:xtns a))
(length (qif-file:xtns b))))))
(progress-dialog #f)
(work-to-do 0)
(work-done 0))
;; first, build a local account tree that mirrors the gnucash
;; accounts in the mapping data. we need to iterate over the
;; cat-map and the acct-map to build the list
(for-each
(lambda (bin)
(for-each
(lambda (hashpair)
(let* ((acctinfo (cdr hashpair)))
(if (qif-map-entry:display? acctinfo)
(set! sorted-accounts-list
(cons acctinfo sorted-accounts-list)))))
bin))
(vector->list qif-acct-map))
(for-each
(lambda (bin)
(for-each
(lambda (hashpair)
(let* ((acctinfo (cdr hashpair)))
(if (qif-map-entry:display? acctinfo)
(set! sorted-accounts-list
(cons acctinfo sorted-accounts-list)))))
bin))
(vector->list qif-cat-map))
(hash-fold
(lambda (k v p)
(if (qif-map-entry:display? v)
(set! sorted-accounts-list
(cons v sorted-accounts-list)))
#t)
#t qif-cat-map)
;; sort the account info on the depth of the account path. if a
;; short part is explicitly mentioned, make sure it gets created
;; before the deeper path, which will create the parent accounts
;; without the information about their type.
(set! sorted-accounts-list
(sort sorted-accounts-list
(lambda (a b)
(let ((a-depth
(length
(string-split-on (qif-map-entry:gnc-name a)
separator)))
(b-depth
(length
(string-split-on (qif-map-entry:gnc-name b)
separator))))
(< a-depth b-depth)))))
;; make all the accounts
(for-each
(lambda (acctinfo)
(let* ((security
(and stock-map
(hash-ref stock-map
(qif-import:get-account-name
(qif-map-entry:qif-name acctinfo)))))
(ok-types (qif-map-entry:allowed-types acctinfo))
(equity? (memq GNC-EQUITY-TYPE ok-types)))
(cond ((and equity? security) ;; a "retained holdings" acct
(qif-import:find-or-make-acct acctinfo
security security
gnc-acct-hash
old-group new-group))
(security
(qif-import:find-or-make-acct
acctinfo default-currency security
gnc-acct-hash old-group new-group))
(#t
(qif-import:find-or-make-acct
acctinfo default-currency default-currency
gnc-acct-hash old-group new-group)))))
sorted-accounts-list)
;; before trying to mark transactions, prune down the list of
;; ones to match.
(for-each
(lambda (qif-file)
(hash-fold
(lambda (k v p)
(if (qif-map-entry:display? v)
(set! sorted-accounts-list
(cons v sorted-accounts-list)))
#t)
#t qif-memo-map)
;; sort the account info on the depth of the account path. if a
;; short part is explicitly mentioned, make sure it gets created
;; before the deeper path, which will create the parent accounts
;; without the information about their type.
(set! sorted-accounts-list
(sort sorted-accounts-list
(lambda (a b)
(let ((a-depth
(length
(string-split-on (qif-map-entry:gnc-name a)
separator)))
(b-depth
(length
(string-split-on (qif-map-entry:gnc-name b)
separator))))
(< a-depth b-depth)))))
;; make all the accounts
(for-each
(lambda (xtn)
(set! work-to-do (+ 1 work-to-do))
(let splitloop ((splits (qif-xtn:splits xtn)))
(if (qif-split:category-is-account? (car splits))
(begin
(set! markable-xtns (cons xtn markable-xtns))
(set! work-to-do (+ 1 work-to-do)))
(if (not (null? (cdr splits)))
(splitloop (cdr splits))))))
(qif-file:xtns qif-file)))
qif-files-list)
(if (> work-to-do 100)
(begin
(set! progress-dialog (gnc:progress-dialog-new #f #f))
(gnc:progress-dialog-set-title progress-dialog "Progress")
(gnc:progress-dialog-set-heading progress-dialog
"Importing transactions...")
(gnc:progress-dialog-set-limits progress-dialog 0.0 100.0)))
(lambda (acctinfo)
(let* ((security
(and stock-map
(hash-ref stock-map
(qif-import:get-account-name
(qif-map-entry:qif-name acctinfo)))))
(ok-types (qif-map-entry:allowed-types acctinfo))
(equity? (memq GNC-EQUITY-TYPE ok-types)))
(cond ((and equity? security) ;; a "retained holdings" acct
(qif-import:find-or-make-acct acctinfo
security security
gnc-acct-hash
old-group new-group))
(security
(qif-import:find-or-make-acct
acctinfo default-currency security
gnc-acct-hash old-group new-group))
(#t
(qif-import:find-or-make-acct
acctinfo default-currency default-currency
gnc-acct-hash old-group new-group)))))
sorted-accounts-list)
;; before trying to mark transactions, prune down the list of
;; ones to match.
(for-each
(lambda (qif-file)
(for-each
(lambda (xtn)
(set! work-to-do (+ 1 work-to-do))
(let splitloop ((splits (qif-xtn:splits xtn)))
(if (qif-split:category-is-account? (car splits))
(begin
(set! markable-xtns (cons xtn markable-xtns))
(set! work-to-do (+ 1 work-to-do)))
(if (not (null? (cdr splits)))
(splitloop (cdr splits))))))
(qif-file:xtns qif-file)))
qif-files-list)
(if (> work-to-do 100)
(begin
(set! progress-dialog (gnc:progress-dialog-new #f #f))
(gnc:progress-dialog-set-title progress-dialog "Progress")
(gnc:progress-dialog-set-heading progress-dialog
"Importing transactions...")
(gnc:progress-dialog-set-limits progress-dialog 0.0 100.0)))
;; now run through the markable transactions marking any
;; duplicates. marked transactions/splits won't get imported.
(if (> (length markable-xtns) 1)
(let xloop ((xtn (car markable-xtns))
(rest (cdr markable-xtns)))
(set! work-done (+ 1 work-done))
(if progress-dialog
(begin
(gnc:progress-dialog-set-value
progress-dialog (* 100 (/ work-done work-to-do)))
(gnc:progress-dialog-update progress-dialog)))
(if (not (qif-xtn:mark xtn))
(qif-import:mark-matching-xtns xtn rest))
(if (not (null? (cdr rest)))
(xloop (car rest) (cdr rest)))))
;; iterate over files. Going in the sort order by number of
;; transactions should give us a small speed advantage.
(for-each
(lambda (qif-file)
;; now run through the markable transactions marking any
;; duplicates. marked transactions/splits won't get imported.
(if (> (length markable-xtns) 1)
(let xloop ((xtn (car markable-xtns))
(rest (cdr markable-xtns)))
(set! work-done (+ 1 work-done))
(if progress-dialog
(begin
(gnc:progress-dialog-set-value
progress-dialog (* 100 (/ work-done work-to-do)))
(gnc:progress-dialog-update progress-dialog)))
(if (not (qif-xtn:mark xtn))
(qif-import:mark-matching-xtns xtn rest))
(if (not (null? (cdr rest)))
(xloop (car rest) (cdr rest)))))
;; iterate over files. Going in the sort order by number of
;; transactions should give us a small speed advantage.
(for-each
(lambda (xtn)
(set! work-done (+ 1 work-done))
(if progress-dialog
(begin
(gnc:progress-dialog-set-value
progress-dialog (* 100 (/ work-done work-to-do)))
(gnc:progress-dialog-update progress-dialog)))
(if (not (qif-xtn:mark xtn))
(begin
;; create and fill in the GNC transaction
(let ((gnc-xtn (gnc:transaction-create)))
(gnc:transaction-begin-edit gnc-xtn)
;; build the transaction
(qif-import:qif-xtn-to-gnc-xtn
xtn qif-file gnc-xtn gnc-acct-hash
qif-acct-map qif-cat-map)
;; rebalance and commit everything
(gnc:transaction-commit-edit gnc-xtn)))))
(qif-file:xtns qif-file)))
sorted-qif-files-list)
;; get rid of the progress dialog
(if progress-dialog
(gnc:progress-dialog-destroy progress-dialog))
new-group))
(lambda (qif-file)
(for-each
(lambda (xtn)
(set! work-done (+ 1 work-done))
(if progress-dialog
(begin
(gnc:progress-dialog-set-value
progress-dialog (* 100 (/ work-done work-to-do)))
(gnc:progress-dialog-update progress-dialog)))
(if (not (qif-xtn:mark xtn))
(begin
;; create and fill in the GNC transaction
(let ((gnc-xtn (gnc:transaction-create)))
(gnc:transaction-begin-edit gnc-xtn)
;; build the transaction
(qif-import:qif-xtn-to-gnc-xtn
xtn qif-file gnc-xtn gnc-acct-hash
qif-acct-map qif-cat-map qif-memo-map)
;; rebalance and commit everything
(gnc:transaction-commit-edit gnc-xtn)))))
(qif-file:xtns qif-file)))
sorted-qif-files-list)
;; get rid of the progress dialog
(if progress-dialog
(gnc:progress-dialog-destroy progress-dialog))
new-group))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:qif-xtn-to-gnc-xtn
@@ -349,7 +344,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:qif-xtn-to-gnc-xtn qif-xtn qif-file gnc-xtn
gnc-acct-hash qif-acct-map qif-cat-map)
gnc-acct-hash
qif-acct-map qif-cat-map qif-memo-map)
(let ((splits (qif-xtn:splits qif-xtn))
(gnc-near-split (gnc:split-create))
(near-split-total (gnc:numeric-zero))
@@ -411,10 +407,10 @@
(far-acct-type #f)
(far-acct #f)
(split-amt (amt-cvt (qif-split:amount qif-split)))
(memo (qif-split:memo qif-split)))
(if (not split-amt) (set! split-amt 0.0))
(memo (qif-split:memo qif-split))
(cat (qif-split:category qif-split)))
(if (not split-amt) (set! split-amt (gnc:numeric-zero)))
;; fill the splits in (near first). This handles
;; files in multiple currencies by pulling the
;; currency value from the file import.
@@ -425,13 +421,40 @@
(if memo (gnc:split-set-memo gnc-far-split memo))
(if (qif-split:category-is-account? qif-split)
(set! far-acct-info
(hash-ref qif-acct-map
(qif-split:category qif-split)))
(set! far-acct-info
(hash-ref qif-cat-map
(qif-split:category qif-split))))
;; figure out what the far acct is
(cond
;; if the category is valid, use that. look it up
;; in the acct-hash if it's an account.
((and (not (string=? cat ""))
(qif-split:category-is-account? qif-split))
(set! far-acct-info
(hash-ref qif-acct-map
(qif-split:category qif-split))))
;; .. look it up in the cat-hash if it's a category
((not (string=? cat ""))
(set! far-acct-info
(hash-ref qif-cat-map
(qif-split:category qif-split))))
;; otherwise, try to find the payee in the
;; memo-map if it's likely to have been used (only
;; 1 split). then try the memo. if neither
;; works, go back to the Unspecified account.
(#t
(set! far-acct-info
(or
(and (string? qif-payee)
(not (string=? qif-payee ""))
(= (length splits) 1)
(hash-ref qif-memo-map qif-payee))
(and (string? memo)
(not (string=? qif-memo ""))
(hash-ref qif-memo-map memo))))
(if (not far-acct-info)
(set! far-acct-info
(hash-ref
qif-cat-map
(qif-split:category qif-split))))))
(set! far-acct-name (qif-map-entry:gnc-name far-acct-info))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name))
src/scm/report.scm
+42 -42
View File
@@ -248,49 +248,49 @@
#f)))
(define (gnc:report-run id)
(gnc:backtrace-if-exception gnc:report-run-unsafe id))
(define (gnc:report-run-unsafe id)
(let ((report (gnc:find-report id))
(start-time (gettimeofday)))
(if report
(if (and (not (gnc:report-dirty? report))
(gnc:backtrace-if-exception
(lambda ()
(let ((report (gnc:find-report id))
(start-time (gettimeofday)))
(if report
(if (and (not (gnc:report-dirty? report))
(gnc:report-ctext report))
;; if there's clean cached text, return it
(begin
(gnc:report-ctext report))
;; if there's clean cached text, return it
(begin
(gnc:report-ctext report))
;; otherwise, rerun the report
(let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report))))
(if template
(let* ((renderer (gnc:report-template-renderer template))
(stylesheet-name
(symbol->string (gnc:option-value
(gnc:lookup-option
(gnc:report-options report)
(N_ "General")
(N_ "Stylesheet")))))
(stylesheet
(gnc:html-style-sheet-find stylesheet-name))
(doc (renderer report))
(html #f)
(formlist #f)
(collapsed-list #f))
(gnc:html-document-set-style-sheet! doc stylesheet)
(set! formlist (gnc:html-document-render doc))
(set! collapsed-list (gnc:report-tree-collapse formlist))
(set! html (apply string-append collapsed-list))
(gnc:report-set-ctext! report html)
(gnc:report-set-dirty?! report #f)
(display "total time to run report: ")
(display (gnc:time-elapsed start-time (gettimeofday)))
(newline)
;; otherwise, rerun the report
(let ((template (hash-ref *gnc:_report-templates_*
(gnc:report-type report))))
(if template
(let* ((renderer (gnc:report-template-renderer template))
(stylesheet-name
(symbol->string (gnc:option-value
(gnc:lookup-option
(gnc:report-options report)
(N_ "General")
(N_ "Stylesheet")))))
(stylesheet
(gnc:html-style-sheet-find stylesheet-name))
(doc (renderer report))
(html #f)
(formlist #f)
(collapsed-list #f))
(gnc:html-document-set-style-sheet! doc stylesheet)
(set! formlist (gnc:html-document-render doc))
(set! collapsed-list
(gnc:report-tree-collapse formlist))
(set! html (apply string-append collapsed-list))
(gnc:report-set-ctext! report html)
(gnc:report-set-dirty?! report #f)
(display "total time to run report: ")
(display (gnc:time-elapsed start-time (gettimeofday)))
(newline)
html)
#f)))
#f)))
html)
#f)))
#f)))))
(gnc:hook-add-dangler gnc:*main-window-opened-hook* gnc:report-menu-setup)
src/scm/utilities.scm
+11
View File
@@ -18,6 +18,17 @@
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org
(if (not (defined? 'hash-fold))
(define (hash-fold proc init table)
(for-each
(lambda (bin)
(for-each
(lambda (elt)
(set! init (proc (car elt) (cdr elt) init)))
bin))
(vector->list table))))
(define (directory? path)
;; This follows symlinks normally.
(let* ((status (false-if-exception (stat path)))