mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge J. Marino's 'fix/report-net-barchart' into unstable
This commit is contained in:
John Ralls
@@ -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))
|
||||
)
|
||||
)
|
||||
))
|
||||
|
||||
@@ -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
|
||||
@@ -303,14 +313,18 @@
|
||||
(assets (assoc-ref rpt 'asset))
|
||||
(liabilities (assoc-ref rpt 'liability)))
|
||||
(set! assets-list (if assets (car assets)
|
||||
(map (lambda (d) 0) dates-list)))
|
||||
(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) 0) dates-list)))
|
||||
(map (lambda (d)
|
||||
(gnc:make-gnc-monetary report-currency (gnc:make-gnc-numeric 0 1)))
|
||||
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-barchart-set-title!
|
||||
@@ -335,13 +349,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!
|
||||
|
||||
@@ -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!
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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)))
|
||||
|
||||
Reference in New Issue
Block a user