gnucash unstable: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Tue Oct 31 20:25:36 EDT 2017
Updated via https://github.com/Gnucash/gnucash/commit/a6f4ea65 (commit)
via https://github.com/Gnucash/gnucash/commit/f4acb6c0 (commit)
via https://github.com/Gnucash/gnucash/commit/3913c528 (commit)
via https://github.com/Gnucash/gnucash/commit/46b3e1ca (commit)
via https://github.com/Gnucash/gnucash/commit/85e56512 (commit)
via https://github.com/Gnucash/gnucash/commit/9c7ba523 (commit)
via https://github.com/Gnucash/gnucash/commit/2fcd1efd (commit)
via https://github.com/Gnucash/gnucash/commit/3c8eeb8b (commit)
from https://github.com/Gnucash/gnucash/commit/a8407484 (commit)
commit a6f4ea65e94efd11f6dc495660b4fc19c48ba9ab
Merge: a840748 f4acb6c
Author: John Ralls <jralls at ceridwen.us>
Date: Tue Oct 31 17:24:44 2017 -0700
Merge J. Marino's 'fix/report-net-barchart' into unstable
commit f4acb6c00071a8c4e900bf0f2ee479826c5eb372
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Wed Oct 18 14:44:54 2017 -0600
report/category-barchart: fix unit test to work with gnc-monetary
The unit test for category-barchart did not initialize html stylesheets.
Without any stylesheets available, the renderer defaults to a
trivial renderer. This works fine if the table in the report is
populated by doubles. However, now it is populated by gnc-monetary
and they need a stylesheet to be properly formatted.
This commit makes sure to initialize the html stylesheet code in
the unit test and adapts the parsing code to the new formatting.
diff --git a/gnucash/report/standard-reports/test/test-generic-category-report.scm b/gnucash/report/standard-reports/test/test-generic-category-report.scm
index e5a0473..a93ac17 100644
--- a/gnucash/report/standard-reports/test/test-generic-category-report.scm
+++ b/gnucash/report/standard-reports/test/test-generic-category-report.scm
@@ -32,6 +32,7 @@
(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
(use-modules (sw_engine))
+(use-modules (gnucash report stylesheets))
(use-modules (gnucash report report-system collectors))
(use-modules (gnucash engine test test-extras))
@@ -114,8 +115,8 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
- (list "<number> ([^<]*)</td>" 1))
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(every (lambda (date value-list)
(let ((day (second date))
@@ -172,12 +173,12 @@
(columns (columns-from-report-document html-document))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
html-document))))
;(format #t "~a" html-document)
(and (= 6 (length columns))
@@ -188,7 +189,7 @@
(define (columns-from-report-document doc)
(let ((columns (stream->list (pattern-streamer "<th>"
- (list (list "<string> ([^<]*)</" 1))
+ (list (list "<th>([^<]*)</" 1))
doc))))
(map caar columns)))
@@ -231,8 +232,8 @@
(columns (columns-from-report-document html-document))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
- (list "<number> ([^<]*)</td>" 1))
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>" 1 2 3)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
html-document)))
(row-count (tbl-row-count tbl)))
(and (member "account-1" columns)
commit 3913c528f10200e3bc1e5c46fa47c828a41d4b42
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Wed Oct 18 14:32:25 2017 -0600
report/category-barchart: calculate using gnc-monetary instead of double
Perform and store all calculations using gnc-monetary instead of double.
Conversion to double is only needed as a last step when adding data
to the chart (using new local function "monetary->double").
When a table is displayed, since the values are gnc-monetary, they are
properly formatted as monetary values.
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index 22b0482..3cb4bb2 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -302,19 +302,24 @@ developing over time"))
(averaging-multiplier
(if averaging-fraction-func
;; Calculate the divisor of the amounts so that an
- ;; average is shown
+ ;; average is shown. Multiplier factor is a gnc-numeric
(let* ((start-frac-avg (averaging-fraction-func (gnc:timepair->secs from-date-tp)))
(end-frac-avg (averaging-fraction-func (+ 1 (gnc:timepair->secs to-date-tp))))
(diff-avg (- end-frac-avg start-frac-avg))
+ (diff-avg-numeric (gnc:make-gnc-numeric
+ (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
+ 1000000))
(start-frac-int (interval-fraction-func (gnc:timepair->secs from-date-tp)))
(end-frac-int (interval-fraction-func (+ 1 (gnc:timepair->secs to-date-tp))))
(diff-int (- end-frac-int start-frac-int))
+ (diff-int-numeric (gnc:make-gnc-numeric
+ (inexact->exact diff-int) 1))
)
;; Extra sanity check to ensure a number smaller than 1
(if (> diff-avg diff-int)
- (/ diff-int diff-avg)
- 1))
- 1))
+ (gnc-numeric-div diff-int-numeric diff-avg-numeric GNC-DENOM-AUTO GNC-RND-ROUND)
+ (gnc:make-gnc-numeric 1 1)))
+ (gnc:make-gnc-numeric 1 1)))
;; If there is averaging, the report-title is extended
;; accordingly.
(report-title
@@ -323,6 +328,7 @@ developing over time"))
((WeekDelta) (string-append report-title " " (_ "Weekly Average")))
((DayDelta) (string-append report-title " " (_ "Daily Average")))
(else report-title)))
+ (currency-frac (gnc-commodity-get-fraction report-currency))
;; This is the list of date intervals to calculate.
(dates-list (if do-intervals?
(gnc:make-date-interval-list
@@ -349,24 +355,52 @@ developing over time"))
date-list-item)))
dates-list))
- ;; Converts a commodity-collector into one single double
- ;; number, depending on the report's currency and the
- ;; exchange-fn calculated above. Returns a double, multiplied
- ;; by the averaging-multiplies (smaller than one; multiplication
+ ;; Converts a commodity-collector into gnc-monetary in the report's
+ ;; currency using the exchange-fn calculated above. Returns a gnc-monetary
+ ;; multiplied by the averaging-multiplier (smaller than one; multiplication
;; instead of division to avoid division-by-zero issues) in case
;; the user wants to see the amounts averaged over some value.
- (define (collector->double c date)
- ;; Future improvement: Let the user choose which kind of
- ;; currency combining she want to be done.
- (if (not (gnc:timepair? date))
- (throw 'wrong))
- (*
- (gnc-numeric-to-double
+ (define (collector->monetary c date)
+ (if (not (gnc:timepair? date))
+ (throw 'wrong))
+ (gnc:make-gnc-monetary
+ report-currency
+ (gnc-numeric-mul
(gnc:gnc-monetary-amount
(gnc:sum-collector-commodity
c report-currency
- (lambda (a b) (exchange-fn a b date)))))
- averaging-multiplier))
+ (lambda (a b) (exchange-fn a b date))))
+ averaging-multiplier currency-frac GNC-RND-ROUND)
+ ))
+
+ ;; Add two or more gnc-monetary objects
+ (define (monetary+ a . blist)
+ (if (null? blist)
+ a
+ (let ((b (apply monetary+ blist)))
+ (if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
+ (let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
+ (amount (gnc-numeric-add (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b) GNC-DENOM-AUTO GNC-RND-ROUND)))
+ (if same-currency?
+ (gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
+ (warn "incompatible currencies in monetary+: " a b)))
+ (warn "wrong arguments for monetary+: " a b)))
+ )
+ )
+
+ ;; Extract value of gnc-monetary and return it as double
+ (define (monetary->double monetary)
+ (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary)))
+
+ ;; copy of gnc:not-all-zeros using gnc-monetary
+ (define (not-all-zeros data)
+ (define (myor list)
+ (begin
+ (if (null? list) #f
+ (or (car list) (myor (cdr list))))))
+ (cond ((gnc:gnc-monetary? data) (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount data))))
+ ((list? data) (myor (map not-all-zeros data)))
+ (else #f)))
(define (count-accounts current-depth accts)
(if (< current-depth tree-depth)
@@ -394,7 +428,7 @@ developing over time"))
;; would forget an account that is selected but not its
;; parent.
(define (apply-sign account x)
- (if (reverse-balance? account) (- x) x))
+ (if (reverse-balance? account) (gnc:monetary-neg x) x))
(define (calculate-report accounts progress-range)
(let* ((the-acount-destination-alist (account-destination-alist accounts
account-types
@@ -404,7 +438,7 @@ developing over time"))
(lambda (account result)
(map (lambda (collector datepair)
(let ((date (second datepair)))
- (apply-sign account (collector->double collector date))))
+ (apply-sign account (collector->monetary collector date))))
result dates-list))
(lambda (account result)
(let ((commodity-collector (gnc:make-commodity-collector)))
@@ -412,8 +446,8 @@ developing over time"))
(commodity-collector 'merge next #f)
(collector-add list-collector
(apply-sign account
- (collector->double commodity-collector
- date))))
+ (collector->monetary commodity-collector
+ date))))
(collector-into-list)
result dates-list))))))
@@ -446,7 +480,8 @@ developing over time"))
;; Sort the account list according to the account code field.
(set! all-data (sort
(filter (lambda (l)
- (not (= 0.0 (apply + (cadr l)))))
+ (not (gnc-numeric-equal (gnc-numeric-zero)
+ (gnc:gnc-monetary-amount (apply monetary+ (cadr l))))))
(calculate-report accounts (cons 0 90)))
(cond
((eq? sort-method 'acct-code)
@@ -463,8 +498,10 @@ developing over time"))
xaccAccountGetName) (car b)))))
(else
(lambda (a b)
- (> (apply + (cadr a))
- (apply + (cadr b))))))))
+ (> (gnc-numeric-compare (gnc:gnc-monetary-amount (apply monetary+ (cadr a)))
+ (gnc:gnc-monetary-amount (apply monetary+ (cadr b))))
+ 0)))
+ )))
;; Or rather sort by total amount?
;;(< (apply + (cadr a))
;; (apply + (cadr b))))))
@@ -478,7 +515,7 @@ developing over time"))
;; Proceed if the data is non-zeros
(if
(and (not (null? all-data))
- (gnc:not-all-zeros (map cadr all-data)))
+ (not-all-zeros (map cadr all-data)))
(begin
(set! date-string-list (datelist->stringlist dates-list))
(qof-date-format-set QOF-DATE-FORMAT-ISO)
@@ -547,7 +584,7 @@ developing over time"))
(let* ((start (take all-data (- max-slices 1)))
(finish (drop all-data (- max-slices 1)))
(other-sum (map
- (lambda (l) (apply + l))
+ (lambda (l) (apply monetary+ l))
(apply zip (map cadr finish)))))
(set! all-data
(append start
@@ -576,7 +613,9 @@ developing over time"))
(if (not (null? all-data))
(gnc:html-barchart-set-data!
chart
- (apply zip (map cadr all-data))))
+ (apply zip (map (lambda (mlist)
+ (map monetary->double mlist))
+ (map cadr all-data)))))
;; Labels and colors
(gnc:report-percent-done 94)
@@ -596,7 +635,9 @@ developing over time"))
(if (not (null? all-data))
(gnc:html-linechart-set-data!
chart
- (apply zip (map cadr all-data))))
+ (apply zip (map (lambda (mlist)
+ (map monetary->double mlist))
+ (map cadr all-data)))))
;; Labels and colors
(gnc:report-percent-done 94)
@@ -716,8 +757,8 @@ developing over time"))
(sumrow
(lambda (row)
(if (not (null? row))
- (+ (car row) (sumrow (cdr row)))
- 0
+ (monetary+ (car row) (sumrow (cdr row)))
+ (gnc:make-gnc-monetary report-currency (gnc-numeric-zero))
)
)
))
commit 46b3e1caad3b585727803cd46e6f8d9d20a65d81
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Wed Oct 18 09:53:09 2017 -0600
report/net-linechart: fix unit test to work with gnc-monetary
The unit test for net-linechart did not initialize html stylesheets.
Without any stylesheets available, the renderer defaults to a
trivial renderer. This works fine if the table in the net-linechart
report is populated by doubles. However, now it is populated by
gnc-monetary and they need a stylesheet to be properly formatted.
This commit makes sure to initialize the html stylesheet code in
the unit test and adapts the parsing code to the new formatting.
diff --git a/gnucash/report/standard-reports/test/test-generic-net-linechart.scm b/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
index dd79472..3b26dfe 100644
--- a/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
+++ b/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
@@ -25,6 +25,7 @@
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/report/report-system" 0)
+(use-modules (gnucash report stylesheets))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash engine test test-extras))
@@ -97,11 +98,11 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (= 1 (tbl-ref->number tbl 0 1))
(= 0 (tbl-ref->number tbl 0 2))
@@ -151,11 +152,11 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row)
(and (equal? (second row) (fourth row))
@@ -205,11 +206,11 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row)
(and (= (string->number (car (fourth row)))
commit 85e56512023f67bf6b8843625c427a836ec5eb88
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Wed Oct 18 09:46:50 2017 -0600
report/net-linechart: calculate using gnc-monetary instead of double
Perform and store all calculations using gnc-monetary instead of double.
Conversion to double is only needed as a last step when adding data
to the chart (using new function "monetary->double").
If the table is displayed, its values are properly formatted as monetary
values since they are gnc-monetary instead of doubles.
diff --git a/gnucash/report/standard-reports/net-linechart.scm b/gnucash/report/standard-reports/net-linechart.scm
index 2738187..13a37bf 100644
--- a/gnucash/report/standard-reports/net-linechart.scm
+++ b/gnucash/report/standard-reports/net-linechart.scm
@@ -242,26 +242,36 @@
#f))
;; This exchanges the commodity-collector 'c' to one single
- ;; 'report-currency' according to the exchange-fn. Returns a
- ;; double.
- (define (collector->double c date)
+ ;; 'report-currency' according to the exchange-fn. Returns a gnc:monetary
+ (define (collector->monetary c date)
(if (not (gnc:timepair? date))
(throw 'wrong))
- (gnc-numeric-to-double
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- c report-currency
- (lambda (a b) (exchange-fn a b date))))))
+ (gnc:sum-collector-commodity
+ c report-currency
+ (lambda (a b) (exchange-fn a b date))))
+
+ ;; Add two gnc-monetary objects in the same currency.
+ (define (monetary+ a b)
+ (if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
+ (let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
+ (amount (gnc-numeric-add (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b) GNC-DENOM-AUTO GNC-RND-ROUND)))
+ (if same-currency?
+ (gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
+ (warn "incompatible currencies in monetary+: " a b)))
+ (warn "wrong arguments for monetary+: " a b)))
+
+ (define (monetary->double monetary)
+ (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary)))
;; This calculates the balances for all the 'accounts' for each
;; element of the list 'dates'. If income?==#t, the signs get
;; reversed according to income-sign-reverse general option
- ;; settings. Uses the collector->double conversion function
- ;; above. Returns a list of doubles.
+ ;; settings. Uses the collector->monetary conversion function
+ ;; above. Returns a list of gnc-monetary.
(define (process-datelist accounts dates income?)
(map
(lambda (date)
- (collector->double
+ (collector->monetary
((if inc-exp?
(if income?
gnc:accounts-get-comm-total-income
@@ -325,14 +335,14 @@
(account-reformat (if inc-exp?
(lambda (account result)
(map (lambda (collector date-interval)
- (- (collector->double collector (second date-interval))))
+ (gnc:monetary-neg (collector->monetary collector (second date-interval))))
result dates-list))
(lambda (account result)
(let ((commodity-collector (gnc:make-commodity-collector)))
(collector-end (fold (lambda (next date list-collector)
(commodity-collector 'merge next #f)
(collector-add list-collector
- (collector->double
+ (collector->monetary
commodity-collector date)))
(collector-into-list)
result
@@ -346,15 +356,19 @@
(rpt (category-by-account-report-do-work work progress-range))
(assets (assoc-ref rpt 'asset))
(liabilities (assoc-ref rpt 'liability)))
- (set! assets-list (if assets (car assets)
- (map (lambda (d) 0) dates-list)))
- (set! liability-list (if liabilities (car liabilities)
- (map (lambda (d) 0) dates-list)))
+ (set! assets-list (if assets (car assets)
+ (map (lambda (d)
+ (gnc:make-gnc-monetary report-currency (gnc-numeric-zero)))
+ dates-list)))
+ (set! liability-list (if liabilities (car liabilities)
+ (map (lambda (d)
+ (gnc:make-gnc-monetary report-currency (gnc-numeric-zero)))
+ dates-list)))
)
(gnc:report-percent-done 80)
(set! net-list
- (map + assets-list liability-list))
+ (map monetary+ assets-list liability-list))
(gnc:report-percent-done 90)
(gnc:html-linechart-set-title!
@@ -379,13 +393,13 @@
;; Add the data
(if show-sep?
(begin
- (add-column! assets-list)
+ (add-column! (map monetary->double assets-list))
(add-column! ;;(if inc-exp?
- (map - liability-list)
+ (map - (map monetary->double liability-list))
;;liability-list)
)))
(if show-net?
- (add-column! net-list))
+ (add-column! (map monetary->double net-list)))
;; Legend labels, colors
(gnc:html-linechart-set-col-labels!
commit 9c7ba5231526914d922bcaf944fbe379a202e054
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Tue Oct 17 15:09:20 2017 -0600
report/net-barchart: fix unit test to work with gnc-monetary
The unit test for net-barchart did not initialize html stylesheets.
Without any stylesheets available, the renderer defaults to a
trivial renderer. This works fine if the table in the net-barchart
report is populated by doubles. However, now it is populated by
gnc-monetary and they need a stylesheet to be properly formatted.
Using doubles and the trivial renderer, a table cell looks like:
<td class="number-cell"><number> 6.0</td>
Using gnc-monetary and the trivial renderer, a table cell looks like:
<td class="number-cell"><gnc-monetary> #[unknown]</td>
Initializing the html stylesheets, the table cell looks like:
<td class="number-cell">$6.00</td>
This commit makes sure to initialize the html stylesheet code in
the unit test and adapts the parsing code to the new formatting.
diff --git a/gnucash/report/standard-reports/test/test-generic-net-barchart.scm b/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
index 91a1a48..ac475e6 100644
--- a/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
+++ b/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
@@ -25,6 +25,7 @@
(use-modules (gnucash gnc-module))
(gnc:module-load "gnucash/report/report-system" 0)
+(use-modules (gnucash report stylesheets))
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system test test-extras))
@@ -99,11 +100,11 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (= 1 (tbl-ref->number tbl 0 1))
(= 0 (tbl-ref->number tbl 0 2))
@@ -153,11 +154,11 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row)
(and (equal? (second row) (fourth row))
@@ -207,11 +208,11 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row)
(and (= (string->number (car (fourth row)))
@@ -263,11 +264,11 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row)
(and (= (string->number (car (fourth row)))
@@ -328,11 +329,11 @@
(let* ((result (gnc:html-document-render doc #f))
(tbl (stream->list
(pattern-streamer "<tr>"
- (list (list "<string> ([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
+ (list (list "<td>([0-9][0-9])/([0-9][0-9])/([0-9][0-9])</td>"
1 2 3)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1)
- (list "<number> ([^<]*)</td>" 1))
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1)
+ (list "<td class=\"number-cell\">[^0-9]*([^<]*)</td>" 1))
result))))
(and (every (lambda (row)
(and (= (string->number (car (fourth row)))
commit 2fcd1efd6dc1a157143a8e010b9d59de5b628ccd
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Tue Oct 17 14:51:52 2017 -0600
report/net-barchart: default to list of zeros instead of empty list
This was the original behavior before the change to gnc-monetary.
diff --git a/gnucash/report/standard-reports/net-barchart.scm b/gnucash/report/standard-reports/net-barchart.scm
index 4e82854..83f4890 100644
--- a/gnucash/report/standard-reports/net-barchart.scm
+++ b/gnucash/report/standard-reports/net-barchart.scm
@@ -312,8 +312,14 @@
(rpt (category-by-account-report-do-work work progress-range))
(assets (assoc-ref rpt 'asset))
(liabilities (assoc-ref rpt 'liability)))
- (set! assets-list (if assets (car assets) '()))
- (set! liability-list (if liabilities (car liabilities) '()))
+ (set! assets-list (if assets (car assets)
+ (map (lambda (d)
+ (gnc:make-gnc-monetary report-currency (gnc:make-gnc-numeric 0 1)))
+ dates-list)))
+ (set! liability-list (if liabilities (car liabilities)
+ (map (lambda (d)
+ (gnc:make-gnc-monetary report-currency (gnc:make-gnc-numeric 0 1)))
+ dates-list)))
)
(gnc:report-percent-done 80)
commit 3c8eeb8b3bdb54683fe5a804aa35d87b60693657
Author: Jose Marino <jmarino at users.noreply.github.com>
Date: Fri Oct 13 10:40:52 2017 -0600
report/net-barchart: calculate using gnc-monetary instead of double
Perform and store all calculations using gnc-monetary instead of double.
Conversion to double is only needed as a last step when adding data
to the chart (using new function "monetary->double").
When a table is displayed, since the values are gnc-monetary, they are
properly formatted as monetary values.
diff --git a/gnucash/report/standard-reports/net-barchart.scm b/gnucash/report/standard-reports/net-barchart.scm
index a180983..4e82854 100644
--- a/gnucash/report/standard-reports/net-barchart.scm
+++ b/gnucash/report/standard-reports/net-barchart.scm
@@ -205,26 +205,36 @@
#f))
;; This exchanges the commodity-collector 'c' to one single
- ;; 'report-currency' according to the exchange-fn. Returns a
- ;; double.
- (define (collector->double c date)
+ ;; 'report-currency' according to the exchange-fn. Returns a gnc:monetary
+ (define (collector->monetary c date)
(if (not (gnc:timepair? date))
(throw 'wrong))
- (gnc-numeric-to-double
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- c report-currency
- (lambda (a b) (exchange-fn a b date))))))
+ (gnc:sum-collector-commodity
+ c report-currency
+ (lambda (a b) (exchange-fn a b date))))
+
+ ;; Add two gnc-monetary objects in the same currency.
+ (define (monetary+ a b)
+ (if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
+ (let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
+ (amount (gnc-numeric-add (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b) GNC-DENOM-AUTO GNC-RND-ROUND)))
+ (if same-currency?
+ (gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
+ (warn "incompatible currencies in monetary+: " a b)))
+ (warn "wrong arguments for monetary+: " a b)))
+
+ (define (monetary->double monetary)
+ (gnc-numeric-to-double (gnc:gnc-monetary-amount monetary)))
;; This calculates the balances for all the 'accounts' for each
;; element of the list 'dates'. If income?==#t, the signs get
;; reversed according to income-sign-reverse general option
- ;; settings. Uses the collector->double conversion function
- ;; above. Returns a list of doubles.
+ ;; settings. Uses the collector->monetary conversion function
+ ;; above. Returns a list of gnc-monetary.
(define (process-datelist accounts dates income?)
(map
(lambda (date)
- (collector->double
+ (collector->monetary
((if inc-exp?
(if income?
gnc:accounts-get-comm-total-income
@@ -281,14 +291,14 @@
(account-reformat (if inc-exp?
(lambda (account result)
(map (lambda (collector date-interval)
- (- (collector->double collector (second date-interval))))
+ (gnc:monetary-neg (collector->monetary collector (second date-interval))))
result dates-list))
(lambda (account result)
(let ((commodity-collector (gnc:make-commodity-collector)))
(collector-end (fold (lambda (next date list-collector)
(commodity-collector 'merge next #f)
(collector-add list-collector
- (collector->double
+ (collector->monetary
commodity-collector date)))
(collector-into-list)
result
@@ -302,15 +312,13 @@
(rpt (category-by-account-report-do-work work progress-range))
(assets (assoc-ref rpt 'asset))
(liabilities (assoc-ref rpt 'liability)))
- (set! assets-list (if assets (car assets)
- (map (lambda (d) 0) dates-list)))
- (set! liability-list (if liabilities (car liabilities)
- (map (lambda (d) 0) dates-list)))
+ (set! assets-list (if assets (car assets) '()))
+ (set! liability-list (if liabilities (car liabilities) '()))
)
(gnc:report-percent-done 80)
(set! net-list
- (map + assets-list liability-list))
+ (map monetary+ assets-list liability-list))
(gnc:report-percent-done 90)
(gnc:html-barchart-set-title!
@@ -335,13 +343,13 @@
;; Add the data
(if show-sep?
(begin
- (add-column! assets-list)
+ (add-column! (map monetary->double assets-list))
(add-column! ;;(if inc-exp?
- (map - liability-list)
+ (map - (map monetary->double liability-list))
;;liability-list)
)))
(if show-net?
- (add-column! net-list))
+ (add-column! (map monetary->double net-list)))
;; Legend labels, colors
(gnc:html-barchart-set-col-labels!
Summary of changes:
.../report/standard-reports/category-barchart.scm | 101 +++++++++++++++------
gnucash/report/standard-reports/net-barchart.scm | 52 +++++++----
gnucash/report/standard-reports/net-linechart.scm | 56 +++++++-----
.../test/test-generic-category-report.scm | 23 ++---
.../test/test-generic-net-barchart.scm | 41 +++++----
.../test/test-generic-net-linechart.scm | 25 ++---
6 files changed, 185 insertions(+), 113 deletions(-)
More information about the gnucash-changes
mailing list