Merge Chris Lam's cleanup-report-utilities into maint.

This commit is contained in:
John Ralls 2018-09-09 11:10:23 -07:00
commit f8a9be2c7f
8 changed files with 394 additions and 613 deletions

View File

@ -20,16 +20,6 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc-commodity-collector-contains-commodity? collector commodity)
(let ((ret #f))
(gnc-commodity-collector-map
collector
(lambda (comm amt)
(set! ret (or ret (gnc-commodity-equiv comm commodity)))))
ret
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to get splits with interesting data from accounts.
@ -104,6 +94,8 @@
;; Helper for warnings below.
(define (gnc-commodity-numeric->string commodity numeric)
(issue-deprecation-warning "gnc-commodity-numeric->string deprecated. \
construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
(gnc:monetary->string
(gnc:make-gnc-monetary commodity numeric)))
@ -167,13 +159,6 @@
value-amount share-amount))
#f)))
;;(warn "gnc:get-commodity-totalavg-prices: value "
;; (gnc-commodity-numeric->string
;;(first foreignlist) (second foreignlist))
;; " bought shares "
;; (gnc-commodity-numeric->string
;;price-commodity (third foreignlist)))
;; Try EURO exchange if necessary
(if (and foreignlist
(not (gnc-commodity-equiv (first foreignlist)
@ -195,14 +180,17 @@
(begin
(warn "gnc:get-commodity-totalavg-prices: "
"Sorry, currency exchange not yet implemented:"
(gnc-commodity-numeric->string
(first foreignlist) (second foreignlist))
(gnc:monetary->string
(gnc:make-gnc-monetary
(first foreignlist) (second foreignlist)))
" (buying "
(gnc-commodity-numeric->string
price-commodity (third foreignlist))
(gnc:monetary->string
(gnc:make-gnc-monetary
price-commodity (third foreignlist)))
") =? "
(gnc-commodity-numeric->string
report-currency (gnc-numeric-zero)))
(gnc:monetary->string
(gnc:make-gnc-monetary
report-currency (gnc-numeric-zero))))
(gnc-numeric-zero))
(begin
(set! total-foreign (gnc-numeric-add total-foreign
@ -282,13 +270,6 @@
(list transaction-comm
value-amount share-amount))))
;;(warn "get-commodity-inst-prices: value "
;; (gnc-commodity-numeric->string
;; (first foreignlist) (second foreignlist))
;; " bought shares "
;;(gnc-commodity-numeric->string
;; price-commodity (third foreignlist)))
;; Try EURO exchange if necessary
(if (not (gnc-commodity-equiv (first foreignlist)
report-currency))
@ -308,14 +289,17 @@
(begin
(warn "get-commodity-inst-prices: "
"Sorry, currency exchange not yet implemented:"
(gnc-commodity-numeric->string
(first foreignlist) (second foreignlist))
" (buying "
(gnc-commodity-numeric->string
price-commodity (third foreignlist))
") =? "
(gnc-commodity-numeric->string
report-currency (gnc-numeric-zero)))
(gnc:monetary->string
(gnc:make-gnc-monetary
(first foreignlist) (second foreignlist)))
" (buying "
(gnc:monetary->string
(gnc:make-gnc-monetary
price-commodity (third foreignlist)))
") =? "
(gnc:monetary->string
(gnc:make-gnc-monetary
report-currency (gnc-numeric-zero))))
(gnc-numeric-zero))
(if (not (zero? (third foreignlist)))
(gnc-numeric-div
@ -398,8 +382,7 @@
(let ((price
(gnc:pricelist-price-find-nearest
plist date)))
(if price
price
(or price
(gnc-numeric-zero)))
(gnc-numeric-zero))))
@ -498,14 +481,14 @@
;; resolve the exchange rate to this currency.
(warn "gnc:resolve-unknown-comm:"
"can't calculate rate for "
(gnc-commodity-value->string
(list (car pair) ((caadr pair) 'total #f)))
(gnc:monetary->string
(gnc:make-gnc-monetary (car pair) ((caadr pair) 'total #f)))
" = "
(gnc-commodity-value->string
(list (car otherlist) ((cdadr pair) 'total #f)))
(gnc:monetary->string
(gnc:make-gnc-monetary (car otherlist) ((cdadr pair) 'total #f)))
" to "
(gnc-commodity-value->string
(list report-commodity (gnc-numeric-zero))))
(gnc:monetary->string
(gnc:make-gnc-monetary report-commodity (gnc-numeric-zero))))
(if (and pair-a pair-b)
;; If both currencies are found then something
;; went wrong inside
@ -513,11 +496,11 @@
;; better thing to do in this case.
(warn "gnc:resolve-unknown-comm:"
"Oops - exchange rate ambiguity error: "
(gnc-commodity-value->string
(list (car pair) ((caadr pair) 'total #f)))
(gnc:monetary->string
(gnc:make-gnc-monetary (car pair) ((caadr pair) 'total #f)))
" = "
(gnc-commodity-value->string
(list (car otherlist)
(gnc:monetary->string
(gnc:make-gnc-monetary (car otherlist)
((cdadr pair) 'total #f))))
(let
;; Usual case: one of pair-{a,b} was found
@ -531,23 +514,12 @@
(list (car pair)
(make-newrate (caadr pair)
(cdadr pair) pair-a)))))
;; (warn "created new rate: "
;; (gnc-commodity-value->string (list (car
;; newrate) ((caadr newrate) 'total #f))) "
;; = " (gnc-commodity-value->string (list
;; report-commodity ((cdadr newrate) 'total
;; #f))))
(set! reportlist (cons newrate reportlist))))))
;; Huh, the report-currency showed up on the wrong side
;; -- we will just add it to the reportlist on the
;; right side.
(let ((newrate (list (car otherlist)
(cons (cdadr pair) (caadr pair)))))
;; (warn "created new rate: "
;; (gnc-commodity-value->string (list (car newrate)
;; ((caadr newrate) 'total #f))) " = "
;; (gnc-commodity-value->string (list
;; report-commodity ((cdadr newrate) 'total #f))))
(set! reportlist (cons newrate reportlist)))))
(cadr otherlist))))
sumlist)
@ -785,9 +757,8 @@
;; #f if the commodities don't match. Therefore, if you use this
;; function in a mixed commodity context, stuff will probably crash.
(define (gnc:exchange-if-same foreign domestic)
(if (gnc-commodity-equiv (gnc:gnc-monetary-commodity foreign) domestic)
foreign
#f))
(and (gnc-commodity-equiv (gnc:gnc-monetary-commodity foreign) domestic)
foreign))
;; This one returns the ready-to-use function for calculation of the
;; exchange rates. The returned function takes a <gnc-monetary> and
@ -798,43 +769,41 @@
(lambda (foreign domestic)
(gnc:debug "foreign: " (gnc:monetary->string foreign))
(gnc:debug "domestic: " (gnc-commodity-get-printname domestic))
(if foreign
(or (gnc:exchange-by-euro foreign domestic #f)
(gnc:exchange-if-same foreign domestic)
(gnc:make-gnc-monetary
domestic
(let ((pair (assoc (gnc:gnc-monetary-commodity foreign)
exchangelist))
(foreign-amount (gnc:gnc-monetary-amount foreign)))
(if (or (not pair)
(gnc-numeric-zero-p foreign-amount))
(gnc-numeric-zero)
(gnc-numeric-mul foreign-amount
(cadr pair)
(gnc-commodity-get-fraction domestic)
GNC-RND-ROUND)))))
#f))))
(and foreign
(or (gnc:exchange-by-euro foreign domestic #f)
(gnc:exchange-if-same foreign domestic)
(gnc:make-gnc-monetary
domestic
(let ((pair (assoc (gnc:gnc-monetary-commodity foreign)
exchangelist))
(foreign-amount (gnc:gnc-monetary-amount foreign)))
(if (or (not pair)
(gnc-numeric-zero-p foreign-amount))
(gnc-numeric-zero)
(gnc-numeric-mul foreign-amount
(cadr pair)
(gnc-commodity-get-fraction domestic)
GNC-RND-ROUND)))))))))
;; Helper for the gnc:exchange-by-pricalist* below. Exchange the
;; <gnc:monetary> 'foreign' into the <gnc:commodity*> 'domestic' by
;; the <gnc:numeric> 'price-value'. Returns a <gnc:monetary>.
(define (gnc:exchange-by-pricevalue-helper
foreign domestic price-value)
(if (gnc:gnc-monetary? foreign)
(gnc:make-gnc-monetary
domestic
(if price-value
(gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
price-value
(gnc-commodity-get-fraction domestic)
GNC-RND-ROUND)
(begin
(warn "gnc:exchange-by-pricevalue-helper: No price found for "
(gnc:monetary->string foreign) " into "
(gnc:monetary->string
(gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
(gnc-numeric-zero))))
#f))
(and (gnc:gnc-monetary? foreign)
(gnc:make-gnc-monetary
domestic
(if price-value
(gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
price-value
(gnc-commodity-get-fraction domestic)
GNC-RND-ROUND)
(begin
(warn "gnc:exchange-by-pricevalue-helper: No price found for "
(gnc:monetary->string foreign) " into "
(gnc:monetary->string
(gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
(gnc-numeric-zero))))))
;; Helper for gnc:exchange-by-pricedb-* below. 'price' gets tested for
;; #f here, and gets unref'd here too. Exchange the <gnc:monetary>
@ -842,24 +811,23 @@
;; 'price'. Returns a <gnc:monetary>.
(define (gnc:exchange-by-pricedb-helper
foreign domestic price)
(if (gnc:gnc-monetary? foreign)
(gnc:make-gnc-monetary
domestic
(if price
(let ((result
(gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
(gnc-price-get-value price)
(gnc-commodity-get-fraction domestic)
GNC-RND-ROUND)))
(gnc-price-unref price)
result)
(begin
(warn "gnc:exchange-by-pricedb-helper: No price found for "
(gnc:monetary->string foreign) " into "
(gnc:monetary->string
(gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
(gnc-numeric-zero))))
#f))
(and (gnc:gnc-monetary? foreign)
(gnc:make-gnc-monetary
domestic
(if price
(let ((result
(gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
(gnc-price-get-value price)
(gnc-commodity-get-fraction domestic)
GNC-RND-ROUND)))
(gnc-price-unref price)
result)
(begin
(warn "gnc:exchange-by-pricedb-helper: No price found for "
(gnc:monetary->string foreign) " into "
(gnc:monetary->string
(gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
(gnc-numeric-zero))))))
;; This is another ready-to-use function for calculation of exchange
;; rates. (Note that this is already the function itself. It doesn't
@ -870,17 +838,17 @@
;; returns a <gnc-monetary>.
(define (gnc:exchange-by-pricedb-latest
foreign domestic)
(if (and (record? foreign) (gnc:gnc-monetary? foreign))
(or (gnc:exchange-by-euro foreign domestic #f)
(gnc:exchange-if-same foreign domestic)
(gnc:make-gnc-monetary
domestic
(gnc-pricedb-convert-balance-latest-price
(gnc-pricedb-get-db (gnc-get-current-book))
(gnc:gnc-monetary-amount foreign)
(gnc:gnc-monetary-commodity foreign)
domestic)))
#f))
(and (record? foreign)
(gnc:gnc-monetary? foreign)
(or (gnc:exchange-by-euro foreign domestic #f)
(gnc:exchange-if-same foreign domestic)
(gnc:make-gnc-monetary
domestic
(gnc-pricedb-convert-balance-latest-price
(gnc-pricedb-get-db (gnc-get-current-book))
(gnc:gnc-monetary-amount foreign)
(gnc:gnc-monetary-commodity foreign)
domestic)))))
;; Yet another ready-to-use function for calculation of exchange
;; rates. (Note that this is already the function itself. It doesn't
@ -892,18 +860,18 @@
;; <gnc-monetary>.
(define (gnc:exchange-by-pricedb-nearest
foreign domestic date)
(if (and (record? foreign) (gnc:gnc-monetary? foreign)
date)
(or (gnc:exchange-by-euro foreign domestic date)
(gnc:exchange-if-same foreign domestic)
(gnc:make-gnc-monetary
domestic
(gnc-pricedb-convert-balance-nearest-price-t64
(gnc-pricedb-get-db (gnc-get-current-book))
(gnc:gnc-monetary-amount foreign)
(gnc:gnc-monetary-commodity foreign)
domestic (time64CanonicalDayTime date))))
#f))
(and (record? foreign)
(gnc:gnc-monetary? foreign)
date
(or (gnc:exchange-by-euro foreign domestic date)
(gnc:exchange-if-same foreign domestic)
(gnc:make-gnc-monetary
domestic
(gnc-pricedb-convert-balance-nearest-price-t64
(gnc-pricedb-get-db (gnc-get-current-book))
(gnc:gnc-monetary-amount foreign)
(gnc:gnc-monetary-commodity foreign)
domestic (time64CanonicalDayTime date))))))
;; Exchange by the nearest price from pricelist. This function takes
;; the <gnc-monetary> 'foreign' amount, the <gnc:commodity*>
@ -913,26 +881,19 @@
;; function returns a <gnc-monetary>.
(define (gnc:exchange-by-pricealist-nearest
pricealist foreign domestic date)
(begin
(gnc:debug "foreign " (gnc:monetary->string foreign))
(gnc:debug "domestic " (gnc-commodity-get-printname domestic))
(gnc:debug "pricealist " pricealist)
(if (and (record? foreign) (gnc:gnc-monetary? foreign)
date)
(or (gnc:exchange-by-euro foreign domestic date)
(gnc:exchange-if-same foreign domestic)
(if (not (null? pricealist))
(gnc:debug "foreign " (gnc:monetary->string foreign))
(gnc:debug "domestic " (gnc-commodity-get-printname domestic))
(gnc:debug "pricealist " pricealist)
(and (record? foreign)
(gnc:gnc-monetary? foreign)
date
(or (gnc:exchange-by-euro foreign domestic date)
(gnc:exchange-if-same foreign domestic)
(and (pair? pricealist)
(gnc:exchange-by-pricevalue-helper
foreign domestic
(gnc:pricealist-lookup-nearest-in-time
pricealist (gnc:gnc-monetary-commodity foreign) date))
#f))
#f)))
pricealist (gnc:gnc-monetary-commodity foreign) date))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Choosing exchange functions made easy -- get the right function by
@ -1036,63 +997,58 @@
;; Returns a <gnc-monetary> with the domestic commodity and its
;; corresponding balance. If the foreign balance is #f, it returns #f.
(define (gnc:sum-collector-commodity foreign domestic exchange-fn)
(cond ((and foreign exchange-fn)
(let ((balance (gnc:make-commodity-collector)))
(foreign
'format
(lambda (curr val)
(if (gnc-commodity-equiv domestic curr)
(balance 'add domestic val)
(balance 'add domestic
(gnc:gnc-monetary-amount
;; BUG?: this bombs if the exchange-fn
;; returns #f instead of an actual
;; <gnc:monetary>. Better to just return #f.
(exchange-fn (gnc:make-gnc-monetary curr val)
domestic)))))
#f)
(balance 'getmonetary domestic #f)))
(else #f)))
(and foreign
exchange-fn
(let ((balance (gnc:make-commodity-collector)))
(foreign
'format
(lambda (curr val)
(if (gnc-commodity-equiv domestic curr)
(balance 'add domestic val)
(balance 'add domestic
(gnc:gnc-monetary-amount
;; BUG?: this bombs if the exchange-fn
;; returns #f instead of an actual
;; <gnc:monetary>. Better to just return #f.
(exchange-fn (gnc:make-gnc-monetary curr val)
domestic)))))
#f)
(balance 'getmonetary domestic #f))))
;; As above, but adds only the commodities of other stocks and
;; mutual-funds. Returns a commodity-collector, (not a <gnc:monetary>)
;; which (still) may have several different commodities in it -- if
;; there have been different *currencies*, not only stocks.
(define (gnc:sum-collector-stocks foreign domestic exchange-fn)
(if foreign
(let ((balance (gnc:make-commodity-collector)))
(foreign
'format
(lambda (curr val)
(if (gnc-commodity-equiv domestic curr)
(balance 'add domestic val)
(if (gnc-commodity-is-currency curr)
(balance 'add curr val)
(balance 'add domestic
(gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary curr val)
domestic))))))
#f)
balance)
#f))
(and foreign
(let ((balance (gnc:make-commodity-collector)))
(foreign
'format
(lambda (curr val)
(if (gnc-commodity-equiv domestic curr)
(balance 'add domestic val)
(if (gnc-commodity-is-currency curr)
(balance 'add curr val)
(balance 'add domestic
(gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary curr val)
domestic))))))
#f)
balance)))
;; Returns the number of commodities in a commodity-collector.
;; (If this were implemented as a record, I would be able to
;; just (length ...) the alist, but....)
(define (gnc-commodity-collector-commodity-count collector)
(let ((commodities 0))
(gnc-commodity-collector-map
collector
(lambda (comm amt)
(set! commodities (+ commodities 1))))
commodities
))
(length (collector 'format (lambda (comm amt) comm) #f)))
(define (gnc-commodity-collector-contains-commodity? collector commodity)
(member commodity
(collector 'format (lambda (comm amt) comm) #f)
gnc-commodity-equiv))
(define (gnc:uniform-commodity? amt report-commodity)
;; function to see if the commodity-collector amt
;; contains any foreign commodities
(let ((elts (gnc-commodity-collector-commodity-count amt)))
(or (equal? elts 0)
(and (equal? elts 1)
(or (zero? elts)
(and (= elts 1)
(gnc-commodity-collector-contains-commodity?
amt report-commodity)))))

View File

@ -675,9 +675,6 @@
(acct-comm (xaccAccountGetCommodity acct))
(shares (xaccSplitGetAmount split))
(hash (hash-ref hash-table guid)))
; (gnc:debug "Merging split for " (xaccAccountGetName acct) " for "
; (gnc-commodity-numeric->string acct-comm shares)
; " into hash entry " hash)
(if (not hash)
(begin (set! hash (gnc:make-commodity-collector))
(hash-set! hash-table guid hash)))
@ -735,13 +732,12 @@
;; ( acct . balance ) cells
(define (get-balance acct-balances acct)
(let ((this-collector (gnc:make-commodity-collector)))
(gnc-commodity-collector-merge
this-collector
(this-collector
'merge
(or (hash-ref acct-balances (gncAccountGetGUID acct))
;; return a zero commodity collector
(gnc:make-commodity-collector)
)
)
(gnc:make-commodity-collector))
#f)
this-collector
)
)
@ -757,9 +753,9 @@
(let ((this-collector (gnc:make-commodity-collector)))
;; get the balance of the parent account and stick it on the collector
;; that nice shiny *NEW* collector!!
(gnc-commodity-collector-merge this-collector (get-balance acct-balances account))
(this-collector 'merge (get-balance acct-balances account) #f)
(for-each
(lambda (x) (if x (gnc-commodity-collector-merge this-collector x)))
(lambda (x) (if x (this-collector 'merge x #f)))
(gnc:account-map-descendants
(lambda (a)
(get-balance acct-balances a ))
@ -1146,8 +1142,8 @@
;; readable.
(let* ((table (gnc:make-html-table))
)
(gnc-commodity-collector-map
amount
(amount
'format
(lambda (curr val)
(let ((bal (gnc:make-gnc-monetary curr val)))
(gnc:html-table-append-row!
@ -1165,7 +1161,8 @@
"number-cell" (exchange-fn bal report-commodity))
)
)
)))
))
#f)
(gnc:html-table-set-style! table "table" 'attribute(list "style" "width:100%; max-width:20em") 'attribute (list "cellpadding" "0"))
table))

View File

@ -281,18 +281,15 @@
;; commodity
(commodity-row-helper!
my-name #f
(if balance
(gnc-commodity-collector-assoc
balance report-commodity reverse-balance?)
#f)
(and balance
(balance 'getmonetary report-commodity reverse-balance?))
main-row-style)
;; Special case for stock-accounts: then the foreign commodity
;; gets displayed in this line rather then the following lines
;; (loop below). Is also used if is-stock-account? is true.
(let ((my-balance
(if balance
(gnc-commodity-collector-assoc
balance my-commodity reverse-balance?) #f)))
(and balance
(balance 'getmonetary my-commodity reverse-balance?))))
(set! already-printed my-commodity)
(commodity-row-helper!
my-name
@ -304,8 +301,8 @@
;; balance and its corresponding value in the
;; report-currency. One row for each non-report-currency.
(if (and balance (not is-stock-account?))
(gnc-commodity-collector-map
balance
(balance
'format
(lambda (curr val)
(if (or (gnc-commodity-equiv curr report-commodity)
(and already-printed
@ -323,7 +320,7 @@
bal
(exchange-fn bal report-commodity)
other-rows-style))))
))))
#f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -466,8 +463,7 @@
(let ((this-collector (my-get-balance-nosub account)))
(for-each
(lambda (x) (if x
(gnc-commodity-collector-merge
this-collector x )))
(this-collector 'merge x #f)))
(gnc:account-map-descendants
(lambda (a)
;; Important: Calculate the balance if and only if the
@ -639,7 +635,7 @@
subaccounts my-get-balance
gnc-reverse-balance)))
(if thisbalance
(gnc-commodity-collector-merge subbalance thisbalance))
(subbalance 'merge thisbalance #f))
subbalance)
heading-style
#t #f)))))

View File

@ -20,27 +20,26 @@
(use-modules (srfi srfi-13))
(define (list-ref-safe list elt)
(if (> (length list) elt)
(list-ref list elt)
#f))
(and (> (length list) elt)
(list-ref list elt)))
(define (list-set-safe! l elt val)
(if (and (list? l) (> (length l) elt))
(unless (list? l)
(set! l '()))
(if (> (length l) elt)
(list-set! l elt val)
(let ((filler (list val)))
(if (not (list? l))
(set! l '()))
(let loop ((i (length l)))
(if (< i elt)
(begin
(set! filler (cons #f filler))
(loop (+ 1 i)))))
(set! l (append! l filler))))
(let loop ((filler (list val))
(i (length l)))
(if (< i elt)
(loop (cons #f filler) (1+ i))
(set! l (append! l filler)))))
l)
;; pair is a list of one gnc:commodity and one gnc:numeric
;; value. Deprecated -- use <gnc-monetary> instead.
(define (gnc-commodity-value->string pair)
(issue-deprecation-warning "gnc-commodity-value->string deprecated. \
construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(xaccPrintAmount
(cadr pair) (gnc-commodity-print-info (car pair) #t)))
@ -145,10 +144,8 @@
;; Get all children of this list of accounts.
(define (gnc:acccounts-get-all-subaccounts accountlist)
(append-map
(lambda (a)
(gnc-account-get-descendants-sorted a))
accountlist))
(append-map gnc-account-get-descendants-sorted
accountlist))
;;; Here's a statistics collector... Collects max, min, total, and makes
;;; it easy to get at the mean.
@ -247,21 +244,13 @@
;; This is a collector of values -- works similar to the stats-collector but
;; has much less overhead. It is used by the currency-collector (see below).
(define (gnc:make-value-collector)
(let ;;; values
((value 0))
(lambda (action amount) ;;; Dispatch function
(let ((value 0))
(lambda (action amount)
(case action
((add) (if (number? amount)
(set! value (+ amount value))))
(set! value (+ amount value))))
((total) value)
(else (gnc:warn "bad value-collector action: " action))))))
;; Bah. Let's get back to normal data types -- this procedure thingy
;; from above makes every code almost unreadable. First step: replace
;; all 'action function calls by the normal functions below.
(define (gnc:value-collector-add collector amount)
(collector 'add amount))
(define (gnc:value-collector-total collector)
(collector 'total #f))
;; A commodity collector. This is intended to handle multiple
;; currencies' amounts. The amounts are accumulated via 'add, the
@ -320,7 +309,7 @@
;; and add it to the alist
(set! commoditylist (cons pair commoditylist))))
;; add the value
(gnc:value-collector-add (cadr pair) rvalue)))
((cadr pair) 'add rvalue)))
;; helper function to walk an association list, adding each
;; (commodity -> collector) pair to our list at the appropriate
@ -329,14 +318,14 @@
(cond ((null? clist) '())
(else (add-commodity-value
(caar clist)
(gnc:value-collector-total (cadar clist)))
((cadar clist) 'total #f))
(add-commodity-clist (cdr clist)))))
(define (minus-commodity-clist clist)
(cond ((null? clist) '())
(else (add-commodity-value
(caar clist)
(- (gnc:value-collector-total (cadar clist))))
(- ((cadar clist) 'total #f)))
(minus-commodity-clist (cdr clist)))))
;; helper function walk the association list doing a callback on
@ -344,44 +333,32 @@
(define (process-commodity-list fn clist)
(map
(lambda (pair) (fn (car pair)
(gnc:value-collector-total (cadr pair))))
((cadr pair) 'total #f)))
clist))
;; helper function which is given a commodity and returns, if
;; existing, a list (gnc:commodity gnc:numeric). If the second
;; argument was #t, the sign gets reversed.
;; existing, a list (gnc:commodity gnc:numeric).
(define (getpair c sign?)
(let ((pair (assoc c commoditylist)))
(cons c (cons
(if (not pair)
(gnc-numeric-zero)
(if sign?
(gnc-numeric-neg
(gnc:value-collector-total (cadr pair)))
(gnc:value-collector-total (cadr pair))))
'()))))
(let* ((pair (assoc c commoditylist))
(total (and pair ((cadr pair) 'total #f))))
(list c (if pair (if sign? (- total) total) 0))))
;; helper function which is given a commodity and returns, if
;; existing, a <gnc:monetary> value. If the second argument was
;; #t, the sign gets reversed.
;; existing, a <gnc:monetary> value.
(define (getmonetary c sign?)
(let ((pair (assoc c commoditylist)))
(let* ((pair (assoc c commoditylist))
(total (and pair ((cadr pair) 'total #f))))
(gnc:make-gnc-monetary
c (if (not pair)
(gnc-numeric-zero)
(if sign?
(gnc-numeric-neg
(gnc:value-collector-total (cadr pair)))
(gnc:value-collector-total (cadr pair)))))))
c (if pair (if sign? (- total) total) 0))))
;; Dispatch function
(lambda (action commodity amount)
(case action
((add) (add-commodity-value commodity amount))
((merge) (add-commodity-clist
(gnc-commodity-collector-list commodity)))
(commodity 'list #f #f)))
((minusmerge) (minus-commodity-clist
(gnc-commodity-collector-list commodity)))
(commodity 'list #f #f)))
((format) (process-commodity-list commodity commoditylist))
((reset) (set! commoditylist '()))
((getpair) (getpair commodity amount))
@ -390,49 +367,20 @@
(else (gnc:warn "bad commodity-collector action: " action))))))
(define (gnc:commodity-collector-get-negated collector)
(let
((negated (gnc:make-commodity-collector)))
(let ((negated (gnc:make-commodity-collector)))
(negated 'minusmerge collector #f)
negated))
(define (gnc:commodity-collectorlist-get-merged collectorlist)
(let
((merged (gnc:make-commodity-collector)))
(let ((merged (gnc:make-commodity-collector)))
(for-each (lambda (collector) (merged 'merge collector #f)) collectorlist)
merged))
;; Bah. Let's get back to normal data types -- this procedure thingy
;; from above makes every code almost unreadable. First step: replace
;; all 'action function calls by the normal functions below.
;; CAS: ugh. Having two usages is even *more* confusing, so let's
;; please settle on one or the other. What's Step 2? How 'bout
;; documenting the new functions?
(define (gnc-commodity-collector-add collector commodity amount)
(collector 'add commodity amount))
(define (gnc-commodity-collector-merge collector other-collector)
(collector 'merge other-collector #f))
(define (gnc-commodity-collector-minusmerge collector other-collector)
(collector 'minusmerge other-collector #f))
(define (gnc-commodity-collector-map collector function)
(collector 'format function #f))
(define (gnc-commodity-collector-assoc collector commodity sign?)
(collector 'getmonetary commodity sign?))
(define (gnc-commodity-collector-assoc-pair collector commodity sign?)
(collector 'getpair commodity sign?))
(define (gnc-commodity-collector-list collector)
(collector 'list #f #f))
;; Returns zero if all entries in this collector are zero.
(define (gnc-commodity-collector-allzero? collector)
(let ((result #t))
(gnc-commodity-collector-map
collector
(lambda (commodity amount)
(if (not (gnc-numeric-zero-p amount))
(set! result #f))))
result))
(every zero?
(map gnc:gnc-monetary-amount
(collector 'format gnc:make-gnc-monetary #f))))
;; get the account balance at the specified date. if include-children?
;; is true, the balances of all children (not just direct children)
@ -440,8 +388,7 @@
(define (gnc:account-get-balance-at-date account date include-children?)
(let ((collector (gnc:account-get-comm-balance-at-date
account date include-children?)))
(cadr (gnc-commodity-collector-assoc-pair
collector (xaccAccountGetCommodity account) #f))))
(cadr (collector 'getpair (xaccAccountGetCommodity account) #f))))
;; This works similar as above but returns a commodity-collector,
;; thus takes care of children accounts with different currencies.
@ -457,7 +404,7 @@
(if include-children?
(for-each
(lambda (x)
(gnc-commodity-collector-merge balance-collector x))
(balance-collector 'merge x #f))
(gnc:account-map-descendants
(lambda (child)
(gnc:account-get-comm-balance-at-date child date #f))
@ -477,9 +424,9 @@
(qof-query-destroy query)
(if (and splits (not (null? splits)))
(gnc-commodity-collector-add balance-collector
(xaccAccountGetCommodity account)
(xaccSplitGetBalance (car splits))))
(balance-collector 'add
(xaccAccountGetCommodity account)
(xaccSplitGetBalance (car splits))))
balance-collector))
;; Calculate the increase in the balance of the account in terms of
@ -496,7 +443,7 @@
(if include-children?
(for-each
(lambda (x)
(gnc-commodity-collector-merge value-collector x))
(value-collector 'merge x #f))
(gnc:account-map-descendants
(lambda (d)
(gnc:account-get-comm-value-interval d start-date end-date #f))
@ -543,10 +490,10 @@
(let ((collector (gnc:make-commodity-collector)))
(for-each
(lambda (acct)
((if (reverse-balance-fn acct)
gnc-commodity-collector-minusmerge
gnc-commodity-collector-merge)
collector (get-balance-fn acct)))
(collector
(if (reverse-balance-fn acct) 'minusmerge 'merge)
(get-balance-fn acct)
#f))
accounts)
collector))
@ -599,19 +546,14 @@
(define (gnc:account-get-balance-interval account from to include-children?)
(let ((collector (gnc:account-get-comm-balance-interval
account from to include-children?)))
(cadr (gnc-commodity-collector-assoc-pair
collector (xaccAccountGetCommodity account) #f))))
(cadr (collector 'getpair (xaccAccountGetCommodity account) #f))))
;; the version which returns a commodity-collector
(define (gnc:account-get-comm-balance-interval
account from to include-children?)
(let ((account-list (if include-children?
(let ((sub-accts (gnc-account-get-descendants-sorted account)))
(if sub-accts
(append (list account) sub-accts)
(list account)))
(list account))))
(gnc:account-get-trans-type-balance-interval account-list #f from to)))
(define (gnc:account-get-comm-balance-interval account from to include-children?)
(let ((sub-accts (gnc-account-get-descendants-sorted account)))
(gnc:account-get-trans-type-balance-interval
(cons account (or (and include-children? sub-accts) '()))
#f from to)))
;; This calculates the increase in the balance(s) of all accounts in
;; <accountlist> over the period from <from-date> to <to-date>.
@ -685,10 +627,7 @@
;; function to count the total number of splits to be iterated
(define (gnc:accounts-count-splits accounts)
(if (not (null? accounts))
(+ (length (xaccAccountGetSplitList (car accounts)))
(gnc:accounts-count-splits (cdr accounts)))
0))
(apply + (map length (map xaccAccountGetSplitList accounts))))
;; Sums up any splits of a certain type affecting a set of accounts.
;; the type is an alist '((str "match me") (cased #f) (regexp #f))
@ -702,105 +641,48 @@
(xaccSplitGetAccount split)))
(txn (xaccSplitGetParent split)))
(if type
(gnc-commodity-collector-add total acct-comm shares)
(if (not (xaccTransGetIsClosingTxn txn))
(gnc-commodity-collector-add total acct-comm shares)
)))
)
(total 'add acct-comm shares)
(if (not (xaccTransGetIsClosingTxn txn))
(total 'add acct-comm shares)))))
(gnc:account-get-trans-type-splits-interval
account-list type start-date end-date)
)
total
)
)
account-list type start-date end-date))
total))
;; Sums up any splits of a certain type affecting a set of accounts.
;; the type is an alist '((str "match me") (cased #f) (regexp #f))
;; If type is #f, sums all splits in the interval (even closing splits)
(define (gnc:account-get-trans-type-balance-interval-with-closing
account-list type start-date end-date)
(let* ((total (gnc:make-commodity-collector)))
(let ((total (gnc:make-commodity-collector)))
(map (lambda (split)
(let* ((shares (xaccSplitGetAmount split))
(acct-comm (xaccAccountGetCommodity
(xaccSplitGetAccount split)))
)
(gnc-commodity-collector-add total acct-comm shares)
)
)
(xaccSplitGetAccount split))))
(total 'add acct-comm shares)))
(gnc:account-get-trans-type-splits-interval
account-list type start-date end-date)
)
total
)
)
account-list type start-date end-date))
total))
;; Filters the splits from the source to the target accounts
;; returns a commodity collector
;; does NOT do currency exchanges
(define (gnc:account-get-total-flow direction target-account-list from-date to-date)
(let* (
(total-flow (gnc:make-commodity-collector))
)
;; ------------------------------------------------------------------
;; process all target accounts
;; ------------------------------------------------------------------
(let ((total-flow (gnc:make-commodity-collector)))
(for-each
(lambda (target-account)
;; -------------------------------------
;; process all splits of current account
;; -------------------------------------
(for-each
(lambda (target-account-split)
;; ----------------------------------------------------
;; only target account splits that are within the specified time range
;; ----------------------------------------------------
(let* (
(transaction (xaccSplitGetParent target-account-split))
(transaction-date-posted (xaccTransGetDate transaction))
)
(if (and
(<= transaction-date-posted to-date)
(>= transaction-date-posted from-date)
)
;; -------------------------------------------------------------
;; get the split information
;; -------------------------------------------------------------
(let* (
(transaction-currency (xaccTransGetCurrency transaction))
(transaction-value (gnc-numeric-zero))
(split-value (xaccSplitGetAmount target-account-split))
)
;; -------------------------------------------------------------
;; update the return value
;; -------------------------------------------------------------
(case direction
((in)
(if (gnc-numeric-positive-p split-value)
(total-flow 'add transaction-currency split-value)
)
)
((out)
(if (gnc-numeric-negative-p split-value)
(total-flow 'add transaction-currency split-value)
)
)
(else (gnc:warn "bad gnc:account-get-total-flow action: " direction))
)
)
)
)
)
(xaccAccountGetSplitList target-account)
)
)
target-account-list
)
total-flow ;; RETURN
)
)
(lambda (target-account)
(for-each
(lambda (target-account-split)
(let* ((transaction (xaccSplitGetParent target-account-split))
(split-value (xaccSplitGetAmount target-account-split)))
(if (and (<= from-date (xaccTransGetDate transaction) to-date)
(or (and (eq? direction 'in)
(positive? split-value))
(and (eq? direction 'out)
(negative? split-value))))
(total-flow 'add (xaccTransGetCurrency transaction) split-value))))
(xaccAccountGetSplitList target-account)))
target-account-list)
total-flow))
;; similar, but only counts transactions with non-negative shares and
;; *ignores* any closing entries
@ -855,7 +737,7 @@
(xaccSplitGetAccount split)))
)
(or (gnc-numeric-negative-p shares)
(gnc-commodity-collector-add total acct-comm shares)
(total 'add acct-comm shares)
)
)
)
@ -970,15 +852,11 @@
(define (gnc:budget-accountlist-helper accountlist get-fn)
(let
(
(net (gnc:make-commodity-collector)))
(let ((net (gnc:make-commodity-collector)))
(for-each
(lambda (account)
(net 'merge
(get-fn account)
#f))
accountlist)
(lambda (account)
(net 'merge (get-fn account) #f))
accountlist)
net))
;; Sums budget values for a single account from start-period (inclusive) to
@ -989,17 +867,14 @@
;;
;; Returns a commodity-collector.
(define (gnc:budget-account-get-net budget account start-period end-period)
(if (not start-period) (set! start-period 0))
(if (not end-period) (set! end-period (gnc-budget-get-num-periods budget)))
(let*
(
(period start-period)
(net (gnc:make-commodity-collector))
(acct-comm (xaccAccountGetCommodity account)))
(let* ((period (or start-period 0))
(net (gnc:make-commodity-collector))
(acct-comm (xaccAccountGetCommodity account)))
(while (< period end-period)
(net 'add acct-comm
(gnc-budget-get-account-period-value budget account period))
(set! period (+ period 1)))
(gnc-budget-get-account-period-value budget account period))
(set! period (1+ period)))
net))
;; Sums budget values for accounts in accountlist from start-period (inclusive)
@ -1046,18 +921,10 @@
;; Return value:
;; budget value to use for account for specified period.
(define (budget-account-sum budget children period)
(let* ((sum
(cond
((null? children) (gnc-numeric-zero))
(else
(gnc-numeric-add
(gnc:get-account-period-rolledup-budget-value budget (car children) period)
(budget-account-sum budget (cdr children) period)
GNC-DENOM-AUTO GNC-RND-ROUND))
)
))
sum)
)
(apply + (map
(lambda (child)
(gnc:get-account-period-rolledup-budget-value budget child period))
children)))
;; Calculate the value to use for the budget of an account for a specific period.
;; - If the account has a budget value set for the period, use it
@ -1073,14 +940,11 @@
;; sum of all budgets for list of children for specified period.
(define (gnc:get-account-period-rolledup-budget-value budget acct period)
(let* ((bgt-set? (gnc-budget-is-account-period-value-set budget acct period))
(children (gnc-account-get-children acct))
(amount (cond
(bgt-set? (gnc-budget-get-account-period-value budget acct period))
((not (null? children)) (budget-account-sum budget children period))
(else (gnc-numeric-zero)))
))
amount)
)
(children (gnc-account-get-children acct)))
(cond
(bgt-set? (gnc-budget-get-account-period-value budget acct period))
((not (null? children)) (budget-account-sum budget children period))
(else 0))))
;; Sums rolled-up budget values for a single account from start-period (inclusive) to
;; end-period (exclusive).
@ -1093,57 +957,45 @@
;;
;; Returns a gnc-numeric value
(define (gnc:budget-account-get-rolledup-net budget account start-period end-period)
(if (not start-period) (set! start-period 0))
(if (not end-period) (set! end-period (gnc-budget-get-num-periods budget)))
(let*
(
(period start-period)
(net (gnc-numeric-zero))
(acct-comm (xaccAccountGetCommodity account)))
(while (< period end-period)
(set! net (gnc-numeric-add net
(gnc:get-account-period-rolledup-budget-value budget account period)
GNC-DENOM-AUTO GNC-RND-ROUND))
(set! period (+ period 1)))
net))
(let* ((start (or start-period 0))
(end (or end-period (gnc-budget-get-num-periods budget)))
(numperiods (- end start -1)))
(apply +
(map
(lambda (period)
(gnc:get-account-period-rolledup-budget-value budget account period))
(iota numperiods start 1)))))
;; ***************************************************************************
;; The following 3 functions belong together
;; Input: accounts, get-balance-fn
;; Output: account-balances, a list of 2-element lists
(define (gnc:get-assoc-account-balances accounts get-balance-fn)
(let*
(
(initial-balances (list)))
(for-each
(lambda (account)
(set! initial-balances
(append initial-balances
(list (list account (get-balance-fn account))))))
accounts)
initial-balances))
(map
(lambda (acct)
(list acct (get-balance-fn acct)))
accounts))
;; Input: account-balances, account
;; Output: commodity-collector
(define (gnc:select-assoc-account-balance account-balances account)
(let*
(
(account-balance (car account-balances))
(result
(if
(equal? account-balance '())
#f
(if
(equal? (car account-balance) account)
(car (cdr account-balance))
(gnc:select-assoc-account-balance
(cdr account-balances)
account)))))
result))
(let ((found (find
(lambda (acct-bal)
(equal? (car acct-bal) account))
account-balances)))
(and found (cadr found))))
;; Input: account-balances
;; Output: commodity-collector
(define (gnc:get-assoc-account-balances-total account-balances)
(let
(
(total (gnc:make-commodity-collector)))
(let ((total (gnc:make-commodity-collector)))
(for-each
(lambda (account-balance)
(total 'merge (car (cdr account-balance)) #f))
account-balances)
(lambda (account-balance)
(total 'merge (cadr account-balance) #f))
account-balances)
total))
;; ***************************************************************************
;; Adds "file:///" to the beginning of a URL if it doesn't already exist
;;

View File

@ -72,9 +72,6 @@
(define gnc:optname-stylesheet (N_ "Stylesheet"))
(define gnc:menuname-business-reports (N_ "_Business"))
(define gnc:optname-invoice-number (N_ "Invoice Number"))
(define test-report-system-flag #f)
(export test-report-system-flag)
;; We want to warn users if they've got an old-style, non-guid custom
;; report-template, but only once
@ -142,7 +139,7 @@
;; FIXME: We should pass the top-level window
;; instead of the '() to gnc-error-dialog, but I
;; have no idea where to get it from.
(if (not test-report-system-flag)
(if (gnucash-ui-is-running)
(gnc-error-dialog '() (string-append
(_ "One of your reports has a report-guid that is a duplicate. Please check the report system, especially your saved reports, for a report with this report-guid: ")
report-guid))
@ -175,14 +172,14 @@
(if (not gnc:old-style-report-warned)
(begin
(set! gnc:old-style-report-warned #t)
(if (not test-report-system-flag) ;; do not call this during "make test"
(if (gnucash-ui-is-running)
(gnc-error-dialog '() (string-append (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))))
(hash-set! *gnc:_report-templates_* (gnc:report-template-report-guid report-rec) report-rec)
)
)
)
;;there is no parent -> this is an inital faulty report definition
(if (not test-report-system-flag) ;; do not call this during "make test"
(if (gnucash-ui-is-running)
(gnc-error-dialog '() (string-append (_ "Wrong report definition: ")
(gnc:report-template-name report-rec)
(_ " Report is missing a GUID.")))

View File

@ -8,7 +8,6 @@
(use-modules (gnucash engine test srfi64-extras))
(define (run-test)
(set! test-report-system-flag #t)
(test-runner-factory gnc:test-runner)
(test-begin "Testing/Temporary/test-report-system") ;; if (test-runner-factory gnc:test-runner) is commented out, this
;; will create Testing/Temporary/test-asset-performance.log
@ -16,7 +15,6 @@
(test-assert "Missing GUID detection" (test-check2))
(test-assert "Detect double GUID" (test-check3))
(test-assert "Report with Full Argument Set" (test-check4))
(set! test-report-system-flag #f)
(test-end "Testing/Temporary/test-report-system")
)

View File

@ -473,10 +473,10 @@ by preventing negative stock balances.<br/>")
(exchange-fn fromunits tocurrency)))
(gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
(if price
(gnc-commodity-value->string
(list (gnc-price-get-currency price) (gnc-price-get-value price)))
#f))
(and price
(gnc:monetary->string
(gnc:make-gnc-monetary
(gnc-price-get-currency price) (gnc-price-get-value price)))))
;; If we have a price that can't be converted to the report currency
;; don't use it
@ -535,7 +535,8 @@ by preventing negative stock balances.<br/>")
;; Now that we have a pricing transaction if needed, set the value of the asset
(set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))
(gnc:debug "Value " (gnc:monetary->string value)
" from " (gnc-commodity-numeric->string commodity units))
" from " (gnc:monetary->string
(gnc:make-gnc-monetary commodity units)))
(for-each
;; we're looking at each split we find in the account. these splits

View File

@ -1305,10 +1305,8 @@ be excluded from periodic reporting.")
(define indent-level
(+ primary-indent secondary-indent))
(define (add-subheading data subheading-style split level)
(let* ((row-contents '())
(sortkey (opt-val pagename-sorting
(let* ((sortkey (opt-val pagename-sorting
(case level
((primary) optname-prime-sortkey)
((secondary) optname-sec-sortkey))))
@ -1316,31 +1314,36 @@ be excluded from periodic reporting.")
((primary total) 0)
((secondary) primary-indent)))
(right-indent (- indent-level left-indent)))
(for-each (lambda (cell) (addto! row-contents cell))
(gnc:html-make-empty-cells left-indent))
(if (and (opt-val pagename-sorting optname-show-informal-headers)
(column-uses? 'amount-double)
(member sortkey SORTKEY-INFORMAL-HEADERS))
(begin
(if export?
(begin
(addto! row-contents (gnc:make-html-table-cell data))
(for-each (lambda (cell) (addto! row-contents cell))
(gnc:html-make-empty-cells (+ right-indent width-left-columns -1))))
(addto! row-contents (gnc:make-html-table-cell/size
1 (+ right-indent width-left-columns) data)))
(for-each (lambda (cell)
(addto! row-contents
(gnc:make-html-text
(gnc:html-markup-b
((vector-ref cell 5)
((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) sortkey 'renderer-fn) split))))))
calculated-cells))
(addto! row-contents (gnc:make-html-table-cell/size
1 (+ right-indent width-left-columns width-right-columns) data)))
(if (not (column-uses? 'subtotals-only))
(gnc:html-table-append-row/markup! table subheading-style (reverse row-contents)))))
(unless (column-uses? 'subtotals-only)
(gnc:html-table-append-row/markup!
table subheading-style
(append
(gnc:html-make-empty-cells left-indent)
(if (and (opt-val pagename-sorting optname-show-informal-headers)
(column-uses? 'amount-double)
(member sortkey SORTKEY-INFORMAL-HEADERS))
(append
(if export?
(cons
(gnc:make-html-table-cell data)
(gnc:html-make-empty-cells
(+ right-indent width-left-columns -1)))
(list
(gnc:make-html-table-cell/size
1 (+ right-indent width-left-columns) data)))
(map (lambda (cell)
(gnc:make-html-text
(gnc:html-markup-b
((vector-ref cell 5)
((keylist-get-info (sortkey-list BOOK-SPLIT-ACTION)
sortkey 'renderer-fn)
split)))))
calculated-cells))
(list
(gnc:make-html-table-cell/size
1 (+ right-indent width-left-columns width-right-columns)
data))))))))
(define (add-subtotal-row subtotal-string subtotal-collectors subtotal-style level row col)
(let* ((left-indent (case level
@ -1506,65 +1509,46 @@ be excluded from periodic reporting.")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (add-split-row split cell-calculators row-style transaction-row?)
(let* ((row-contents '())
(trans (xaccSplitGetParent split))
(account (xaccSplitGetAccount split)))
(let* ((account (xaccSplitGetAccount split))
(reversible-account? (if account-types-to-reverse
(member (xaccAccountGetType account)
account-types-to-reverse)
(gnc-reverse-balance account)))
(cells (map (lambda (cell)
(let* ((split->monetary (vector-ref cell 1)))
(vector (split->monetary split)
(vector-ref cell 2) ;reverse?
(vector-ref cell 3) ;subtotal?
)))
cell-calculators)))
(define left-cols
(map (lambda (left-col)
(let* ((col-fn (vector-ref left-col 1))
(col-data (col-fn split transaction-row?)))
col-data))
left-columns))
(define cells
(map (lambda (cell)
(let* ((calculator (vector-ref cell 1))
(reverse? (vector-ref cell 2))
(subtotal? (vector-ref cell 3))
(calculated (calculator split)))
(vector calculated
reverse?
subtotal?)))
cell-calculators))
(for-each (lambda (cell) (addto! row-contents cell))
(gnc:html-make-empty-cells indent-level))
(for-each (lambda (col)
(addto! row-contents col))
left-cols)
(for-each (lambda (cell)
(let ((cell-content (vector-ref cell 0))
;; reverse? returns a bool - will check if the cell type has reversible sign,
;; whether the account is also reversible according to Report Option, or
;; if Report Option follows Global Settings, will retrieve bool from it.
(reverse? (and (vector-ref cell 1)
(if account-types-to-reverse
(member (xaccAccountGetType account) account-types-to-reverse)
(gnc-reverse-balance account)))))
(if cell-content
(addto! row-contents
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:html-transaction-anchor
trans
;; if conditions for reverse are satisfied, apply sign reverse to
;; monetary amount
(if reverse?
(gnc:monetary-neg cell-content)
cell-content))))
(addto! row-contents (gnc:html-make-empty-cell)))))
cells)
(if (not (column-uses? 'subtotals-only))
(gnc:html-table-append-row/markup! table row-style (reverse row-contents)))
(unless (column-uses? 'subtotals-only)
(gnc:html-table-append-row/markup!
table row-style
(append
(gnc:html-make-empty-cells indent-level)
(map (lambda (left-col)
((vector-ref left-col 1)
split transaction-row?))
left-columns)
(map (lambda (cell)
(let ((cell-monetary (vector-ref cell 0))
(reverse? (and (vector-ref cell 1)
reversible-account?)))
(and cell-monetary
(gnc:make-html-table-cell/markup
"number-cell"
(gnc:html-transaction-anchor
(xaccSplitGetParent split)
(if reverse?
(gnc:monetary-neg cell-monetary)
cell-monetary))))))
cells))))
(map (lambda (cell)
(let ((cell-content (vector-ref cell 0))
(let ((cell-monetary (vector-ref cell 0))
(subtotal? (vector-ref cell 2)))
(and subtotal? cell-content)))
(and subtotal? cell-monetary)))
cells)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1621,23 +1605,23 @@ be excluded from periodic reporting.")
(add-split-row othersplits calculated-cells def:alternate-row-style #f))
(delete current (xaccTransGetSplitList (xaccSplitGetParent current)))))
(map (lambda (collector value)
(if value
(collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
primary-subtotal-collectors
split-values)
(for-each
(lambda (collector value)
(if value
(collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
primary-subtotal-collectors split-values)
(map (lambda (collector value)
(if value
(collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
secondary-subtotal-collectors
split-values)
(for-each
(lambda (collector value)
(if value
(collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
secondary-subtotal-collectors split-values)
(map (lambda (collector value)
(if value
(collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
total-collectors
split-values)
(for-each
(lambda (collector value)
(if value
(collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))))
total-collectors split-values)
(if (and primary-subtotal-comparator
(or (not next)