mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[customer-summary] fix sorting to apply within currency groups
* profit/sales/expense are sorted within currency groups. each group is prepended by currency-mnemonic header. header is rendered only if num(currencies) > 1. * markup/customername have no currency grouping. * customername sorting ensures 'No Customer' entries are last.
This commit is contained in:
Christopher Lam
parent
54c322c2dd
commit
9ed0174cb0
@ -284,6 +284,7 @@
|
||||
(gnc:date-option-absolute-time
|
||||
(opt-val gnc:pagename-general optname-to-date))))
|
||||
(sort-order (opt-val gnc:pagename-display optname-sortascending))
|
||||
(sort-key (opt-val gnc:pagename-display optname-sortkey))
|
||||
(show-zero-lines? (opt-val gnc:pagename-display optname-show-zero-lines))
|
||||
(show-column-expense?
|
||||
(opt-val gnc:pagename-display optname-show-column-expense))
|
||||
@ -294,6 +295,7 @@
|
||||
(commodities (delete-duplicates
|
||||
(map xaccAccountGetCommodity all-accounts)
|
||||
gnc-commodity-equiv))
|
||||
(commodities>1? (> (length commodities) 1))
|
||||
(book (gnc-get-current-book))
|
||||
(date-format (gnc:options-fancy-date book))
|
||||
(ownerlist (gncBusinessGetOwnerList
|
||||
@ -336,7 +338,6 @@
|
||||
(total-sales (gnc:make-commodity-collector))
|
||||
(total-expense (gnc:make-commodity-collector))
|
||||
(headings (cons* (_ "Customer")
|
||||
(_ "Currency")
|
||||
(_ "Profit")
|
||||
(_ "Markup")
|
||||
(_ "Sales")
|
||||
@ -351,19 +352,19 @@
|
||||
(expense (filter-splits splits expense-accounts))
|
||||
(profit (coll-minus sales expense)))
|
||||
(list owner profit sales expense)))
|
||||
ownerlist)))
|
||||
ownerlist))
|
||||
(sortingtable '()))
|
||||
|
||||
(define (add-row str curr markup profit sales expense url)
|
||||
(gnc:html-table-append-row!
|
||||
table (cons* (if url
|
||||
(gnc:make-html-text (gnc:html-markup-anchor url str))
|
||||
str)
|
||||
(gnc-commodity-get-mnemonic curr)
|
||||
(map
|
||||
(lambda (cell)
|
||||
(gnc:make-html-table-cell/markup "number-cell" cell))
|
||||
(cons* profit
|
||||
(format #f "~a%" (round markup))
|
||||
(and markup (format #f "~a%" (round markup)))
|
||||
sales
|
||||
(if show-column-expense?
|
||||
(list expense)
|
||||
@ -375,24 +376,7 @@
|
||||
(toplevel-total-sales 'merge sales #f)
|
||||
(toplevel-total-expense 'merge expense #f))
|
||||
|
||||
(let* ((owner<? (lambda (a b)
|
||||
((if (eq? sort-order 'descend) string>? string<?)
|
||||
(gncOwnerGetName (car a))
|
||||
(gncOwnerGetName (car b)))))
|
||||
(op (if (eq? sort-order 'descend) > <))
|
||||
(<? (case sort-key
|
||||
((profit) (lambda (a b) (op (gnc:gnc-monetary-amount (cadr a))
|
||||
(gnc:gnc-monetary-amount (cadr b)))))
|
||||
((markup) (lambda (a b) (op (caddr a) (caddr b))))
|
||||
((sales) (lambda (a b) (op (gnc:gnc-monetary-amount (cadddr a))
|
||||
(gnc:gnc-monetary-amount (cadddr b)))))
|
||||
((expense) (lambda (a b) (op (gnc:gnc-monetary-amount (last a))
|
||||
(gnc:gnc-monetary-amount (last b)))))
|
||||
(else #f))))
|
||||
(set! results (sort results owner<?))
|
||||
(if <? (set! results (sort results <?))))
|
||||
|
||||
;; The actual content
|
||||
;; The actual content - add onto sortingtable
|
||||
(for-each
|
||||
(lambda (row)
|
||||
(let* ((owner (car row))
|
||||
@ -409,16 +393,18 @@
|
||||
(markup (markup-percent comm-profit comm-sales)))
|
||||
(when (or show-zero-lines?
|
||||
(not (and (zero? comm-profit) (zero? comm-sales))))
|
||||
(add-row (gncOwnerGetName owner) comm markup
|
||||
(gnc:make-gnc-monetary comm comm-profit)
|
||||
(gnc:make-gnc-monetary comm comm-sales)
|
||||
(gnc:make-gnc-monetary comm comm-expense)
|
||||
(set! sortingtable
|
||||
(cons (vector
|
||||
(gncOwnerGetName owner) comm markup
|
||||
comm-profit comm-sales comm-expense
|
||||
(gnc:report-anchor-text
|
||||
(gnc:owner-report-create owner '() #:currency comm))))))
|
||||
(gnc:owner-report-create owner '() #:currency comm)))
|
||||
sortingtable)))))
|
||||
commodities)))
|
||||
results)
|
||||
|
||||
;; The "No Customer" lines
|
||||
;; Add the "No Customer" lines to the sortingtable for sorting
|
||||
;; as well
|
||||
(let* ((other-sales (coll-minus toplevel-total-sales total-sales))
|
||||
(other-expense (coll-minus toplevel-total-expense total-expense))
|
||||
(other-profit (coll-minus other-sales other-expense)))
|
||||
@ -429,13 +415,64 @@
|
||||
(expense (cadr (other-expense 'getpair comm #f)))
|
||||
(markup (markup-percent profit sales)))
|
||||
(unless (and (zero? profit) (zero? sales))
|
||||
(add-row (_ "No Customer") comm markup
|
||||
(gnc:make-gnc-monetary comm profit)
|
||||
(gnc:make-gnc-monetary comm sales)
|
||||
(gnc:make-gnc-monetary comm expense)
|
||||
#f))))
|
||||
(set! sortingtable
|
||||
(cons (vector
|
||||
(_ "No Customer") comm markup profit sales expense #f)
|
||||
sortingtable)))))
|
||||
commodities))
|
||||
|
||||
;; Stable-sort the sortingtable according to column, then
|
||||
;; stable-sort according to currency. This results in group-by
|
||||
;; currency then sort by columns.
|
||||
(let* ((str-op (if (eq? sort-order 'descend) string>? string<?))
|
||||
(op (if (eq? sort-order 'descend) > <)))
|
||||
(define (<? key)
|
||||
(case key
|
||||
;; customername sorting is handled differently;
|
||||
;; this conditional ensures "No Customer" lines
|
||||
;; are printed last.
|
||||
((customername)
|
||||
(lambda (a b)
|
||||
(cond
|
||||
((string=? (vector-ref b 0) (_ "No Customer")) #t)
|
||||
((string=? (vector-ref a 0) (_ "No Customer")) #f)
|
||||
(else (str-op (vector-ref a 0) (vector-ref b 0))))))
|
||||
;; currency sorting always alphabetical a-z
|
||||
((currency)
|
||||
(lambda (a b) (string<?
|
||||
(gnc-commodity-get-mnemonic (vector-ref a 1))
|
||||
(gnc-commodity-get-mnemonic (vector-ref b 1)))))
|
||||
((markup)
|
||||
(lambda (a b) (op (vector-ref a 2) (vector-ref b 2))))
|
||||
((profit)
|
||||
(lambda (a b) (op (vector-ref a 3) (vector-ref b 3))))
|
||||
((sales)
|
||||
(lambda (a b) (op (vector-ref a 4) (vector-ref b 4))))
|
||||
((expense)
|
||||
(lambda (a b) (op (vector-ref a 5) (vector-ref b 5))))))
|
||||
(set! sortingtable (stable-sort! sortingtable (<? sort-key)))
|
||||
(when (memq sort-key '(profit sales expense))
|
||||
(set! sortingtable (stable-sort! sortingtable (<? 'currency)))))
|
||||
|
||||
;; After sorting, add the entries to the resultant table
|
||||
(let lp ((sortingtable sortingtable)
|
||||
(last-comm #f))
|
||||
(unless (null? sortingtable)
|
||||
(let* ((elt (car sortingtable))
|
||||
(comm (vector-ref elt 1)))
|
||||
(when (and commodities>1?
|
||||
(memq sort-key '(profit sales expense))
|
||||
(not (and last-comm (gnc-commodity-equiv last-comm comm))))
|
||||
(add-row (gnc-commodity-get-mnemonic comm) #f #f #f #f #f #f))
|
||||
(add-row (vector-ref elt 0)
|
||||
comm
|
||||
(vector-ref elt 2)
|
||||
(gnc:make-gnc-monetary comm (vector-ref elt 3))
|
||||
(gnc:make-gnc-monetary comm (vector-ref elt 4))
|
||||
(gnc:make-gnc-monetary comm (vector-ref elt 5))
|
||||
(vector-ref elt 6))
|
||||
(lp (cdr sortingtable) comm))))
|
||||
|
||||
;; One horizontal ruler before the summary
|
||||
(gnc:html-table-append-row!
|
||||
table (list
|
||||
@ -451,7 +488,12 @@
|
||||
(sales (cadr (toplevel-total-sales 'getpair comm #f)))
|
||||
(expense (cadr (toplevel-total-expense 'getpair comm #f)))
|
||||
(markup (markup-percent profit sales)))
|
||||
(add-row (_ "Total") comm markup
|
||||
(add-row (if commodities>1?
|
||||
(format #f "~a (~a)"
|
||||
(_ "Total")
|
||||
(gnc-commodity-get-mnemonic comm))
|
||||
(_ "Total"))
|
||||
comm markup
|
||||
(gnc:make-gnc-monetary comm profit)
|
||||
(gnc:make-gnc-monetary comm sales)
|
||||
(gnc:make-gnc-monetary comm expense)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user