gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Fri Jun 28 11:10:38 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/9ed0174c (commit)
via https://github.com/Gnucash/gnucash/commit/54c322c2 (commit)
via https://github.com/Gnucash/gnucash/commit/3785059a (commit)
via https://github.com/Gnucash/gnucash/commit/7e9c9187 (commit)
via https://github.com/Gnucash/gnucash/commit/e19fdf51 (commit)
via https://github.com/Gnucash/gnucash/commit/d1a7d37c (commit)
via https://github.com/Gnucash/gnucash/commit/5cdd1b07 (commit)
via https://github.com/Gnucash/gnucash/commit/7f19abaa (commit)
via https://github.com/Gnucash/gnucash/commit/0f5d3e20 (commit)
via https://github.com/Gnucash/gnucash/commit/0115dc1a (commit)
via https://github.com/Gnucash/gnucash/commit/cc4944e5 (commit)
via https://github.com/Gnucash/gnucash/commit/a23d72de (commit)
via https://github.com/Gnucash/gnucash/commit/b4409ed6 (commit)
via https://github.com/Gnucash/gnucash/commit/551a346c (commit)
from https://github.com/Gnucash/gnucash/commit/cdf348df (commit)
commit 9ed0174cb04d478d1ea8bd49d8e1964931e7b1f2
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Jun 27 09:13:14 2019 +0800
[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.
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 665a3d325..fb637897d 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -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)
commit 54c322c2dd32cdc6b21312dc354eed17ce9d864b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jun 26 05:24:37 2019 +0800
[customer-summary] upgrade to handle multiple currencies per owner
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 768827db7..665a3d325 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -192,13 +192,15 @@
(define (query owner account-list start-date end-date)
(let* ((q (qof-query-create-for-splits))
- (guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
- (qof-query-add-guid-match
- q (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-OWNER OWNER-PARENTG)
- guid QOF-QUERY-OR)
- (qof-query-add-guid-match
- q (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-BILLTO OWNER-PARENTG)
- guid QOF-QUERY-OR)
+ (guid (and owner
+ (gncOwnerReturnGUID (gncOwnerGetEndOwner owner)))))
+ (when owner
+ (qof-query-add-guid-match
+ q (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-OWNER OWNER-PARENTG)
+ guid QOF-QUERY-OR)
+ (qof-query-add-guid-match
+ q (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-BILLTO OWNER-PARENTG)
+ guid QOF-QUERY-OR))
;; Apparently those query terms are unneeded because we never take
;; lots into account?!?
;; (qof-query-add-guid-match
@@ -250,11 +252,15 @@
(* 100 (/ profit sales))))
(define (filter-splits splits accounts)
- (apply + (map xaccSplitGetAmount
- (filter
- (lambda (s)
- (member (xaccSplitGetAccount s) accounts))
- splits))))
+ (apply gnc:monetaries-add
+ (map (lambda (s)
+ (gnc:make-gnc-monetary
+ (xaccTransGetCurrency (xaccSplitGetParent s))
+ (xaccSplitGetValue s)))
+ (filter
+ (lambda (s)
+ (member (xaccSplitGetAccount s) accounts))
+ splits))))
(define (coll-minus minuend subtrahend)
(let ((coll (gnc:make-commodity-collector)))
@@ -311,22 +317,6 @@
(gnc:html-document-add-object!
document (make-myname-table book date-format)))
- (for-each
- (lambda (acc)
- (toplevel-total-sales
- 'add (xaccAccountGetCommodity acc)
- (- (xaccAccountGetBalanceAsOfDate acc start-date)
- (xaccAccountGetBalanceAsOfDate acc end-date))))
- sales-accounts)
-
- (for-each
- (lambda (acc)
- (toplevel-total-expense
- 'add (xaccAccountGetCommodity acc)
- (- (xaccAccountGetBalanceAsOfDate acc end-date)
- (xaccAccountGetBalanceAsOfDate acc start-date))))
- expense-accounts)
-
(cond
((null? sales-accounts)
(gnc:html-document-add-object!
@@ -346,6 +336,7 @@
(total-sales (gnc:make-commodity-collector))
(total-expense (gnc:make-commodity-collector))
(headings (cons* (_ "Customer")
+ (_ "Currency")
(_ "Profit")
(_ "Markup")
(_ "Sales")
@@ -355,34 +346,34 @@
(results (map
(lambda (owner)
(let* ((splits (query owner all-accounts start-date end-date))
- (currency (gncOwnerGetCurrency owner))
- (sales (- (filter-splits splits sales-accounts)))
+ (sales (gnc:commodity-collector-get-negated
+ (filter-splits splits sales-accounts)))
(expense (filter-splits splits expense-accounts))
- (profit (- sales expense)))
- (list owner
- (gnc:make-gnc-monetary currency profit)
- (markup-percent profit sales)
- (gnc:make-gnc-monetary currency sales)
- (gnc:make-gnc-monetary currency expense))))
+ (profit (coll-minus sales expense)))
+ (list owner profit sales expense)))
ownerlist)))
- (define (add-row str markup profit sales expense url)
+ (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)
- (map
- (lambda (cell)
- (gnc:make-html-table-cell/markup "number-cell" cell))
- (cons* profit
- (format #f "~a%" (round markup))
- sales
- (if show-column-expense?
- (list expense)
- '()))))))
-
- ;; Heading line
- (gnc:html-table-set-col-headers! table headings)
+ 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))
+ sales
+ (if show-column-expense?
+ (list expense)
+ '()))))))
+
+ (let ((sales (gnc:commodity-collector-get-negated
+ (filter-splits all-splits sales-accounts)))
+ (expense (filter-splits all-splits expense-accounts)))
+ (toplevel-total-sales 'merge sales #f)
+ (toplevel-total-expense 'merge expense #f))
(let* ((owner<? (lambda (a b)
((if (eq? sort-order 'descend) string>? string<?)
@@ -405,19 +396,26 @@
(for-each
(lambda (row)
(let* ((owner (car row))
- (curr (gncOwnerGetCurrency owner))
(profit (cadr row))
- (markupfloat (caddr row))
- (sales (cadddr row))
- (expense (last row)))
- (total-sales 'add curr (gnc:gnc-monetary-amount sales))
- (total-expense 'add curr (gnc:gnc-monetary-amount expense))
- (if (or show-zero-lines?
- (not (and (zero? (gnc:gnc-monetary-amount profit))
- (zero? (gnc:gnc-monetary-amount sales)))))
- (add-row (gncOwnerGetName owner) markupfloat profit sales expense
- (gnc:report-anchor-text
- (gnc:owner-report-create owner '()))))))
+ (sales (caddr row))
+ (expense (cadddr row)))
+ (total-sales 'merge sales #f)
+ (total-expense 'merge expense #f)
+ (for-each
+ (lambda (comm)
+ (let* ((comm-profit (cadr (profit 'getpair comm #f)))
+ (comm-sales (cadr (sales 'getpair comm #f)))
+ (comm-expense (cadr (expense 'getpair comm #f)))
+ (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)
+ (gnc:report-anchor-text
+ (gnc:owner-report-create owner '() #:currency comm))))))
+ commodities)))
results)
;; The "No Customer" lines
@@ -429,11 +427,9 @@
(let* ((profit (cadr (other-profit 'getpair comm #f)))
(sales (cadr (other-sales 'getpair comm #f)))
(expense (cadr (other-expense 'getpair comm #f)))
- (markupfloat (markup-percent profit sales)))
+ (markup (markup-percent profit sales)))
(unless (and (zero? profit) (zero? sales))
- (add-row (string-append (_ "No Customer") " "
- (gnc-commodity-get-mnemonic comm))
- markupfloat
+ (add-row (_ "No Customer") comm markup
(gnc:make-gnc-monetary comm profit)
(gnc:make-gnc-monetary comm sales)
(gnc:make-gnc-monetary comm expense)
@@ -454,16 +450,17 @@
(let* ((profit (cadr (total-profit 'getpair comm #f)))
(sales (cadr (toplevel-total-sales 'getpair comm #f)))
(expense (cadr (toplevel-total-expense 'getpair comm #f)))
- (markupfloat (markup-percent profit sales)))
- (add-row (string-append (_ "Total") " "
- (gnc-commodity-get-mnemonic comm))
- markupfloat
+ (markup (markup-percent profit sales)))
+ (add-row (_ "Total") comm markup
(gnc:make-gnc-monetary comm profit)
(gnc:make-gnc-monetary comm sales)
(gnc:make-gnc-monetary comm expense)
#f)))
commodities))
+ ;; Heading line
+ (gnc:html-table-set-col-headers! table headings)
+
;; Set the formatting styles
(gnc:html-table-set-style!
table "td"
commit 3785059ae0d450104738b90e096e4cee016f1abf
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Jun 25 11:40:31 2019 +0800
[customer-summary] add url to owner-report
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 65b13603b..768827db7 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -43,6 +43,7 @@
;; let's define a name for the report-guid's, much prettier
(define customer-report-guid "4166a20981985fd2b07ff8cb3b7d384e")
+(define owner-report-guid "c146317be32e4948a561ec7fc89d15c1")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -337,9 +338,7 @@
(gnc:html-document-add-object!
document
(gnc:make-html-text
- (string-append
- (_ "No valid customer selected.")
- " " (_ "Click on the \"Options\" button to select a company.")))))
+ (_ "No valid customer found."))))
(else
(let ((all-splits (query #f all-accounts start-date end-date))
@@ -367,9 +366,11 @@
(gnc:make-gnc-monetary currency expense))))
ownerlist)))
- (define (add-row owner markup profit sales expense)
+ (define (add-row str markup profit sales expense url)
(gnc:html-table-append-row!
- table (cons owner
+ table (cons (if url
+ (gnc:make-html-text (gnc:html-markup-anchor url str))
+ str)
(map
(lambda (cell)
(gnc:make-html-table-cell/markup "number-cell" cell))
@@ -414,7 +415,9 @@
(if (or show-zero-lines?
(not (and (zero? (gnc:gnc-monetary-amount profit))
(zero? (gnc:gnc-monetary-amount sales)))))
- (add-row (gncOwnerGetName owner) markupfloat profit sales expense))))
+ (add-row (gncOwnerGetName owner) markupfloat profit sales expense
+ (gnc:report-anchor-text
+ (gnc:owner-report-create owner '()))))))
results)
;; The "No Customer" lines
@@ -433,7 +436,8 @@
markupfloat
(gnc:make-gnc-monetary comm profit)
(gnc:make-gnc-monetary comm sales)
- (gnc:make-gnc-monetary comm expense)))))
+ (gnc:make-gnc-monetary comm expense)
+ #f))))
commodities))
;; One horizontal ruler before the summary
@@ -456,7 +460,8 @@
markupfloat
(gnc:make-gnc-monetary comm profit)
(gnc:make-gnc-monetary comm sales)
- (gnc:make-gnc-monetary comm expense))))
+ (gnc:make-gnc-monetary comm expense)
+ #f)))
commodities))
;; Set the formatting styles
commit 7e9c9187c2cd1e5f128440b871f7ee5f152b9ce2
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Jun 25 11:02:49 2019 +0800
[customer-summary] remove references to vendor/employee
* there's only customer-summary, no vendor/employee-summary. remove
dead code and unused hidden options.
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index ed2c07c80..65b13603b 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -87,31 +87,19 @@
(define opthelp-sortascending (N_ "Choose the ordering of the column sort: Either ascending or descending."))
-(define (options-generator acct-type-list owner-type inv-str)
-
+(define (options-generator)
(define options (gnc:new-options))
(define (add-option new-option)
(gnc:register-option options new-option))
- (add-option
- (gnc:make-internal-option "__reg" "inv-str" inv-str))
-
- (add-option
- (gnc:make-internal-option "__reg" "owner-type" owner-type))
-
(gnc:options-add-date-interval!
- options
- gnc:pagename-general optname-from-date optname-to-date
- "b")
+ options gnc:pagename-general optname-from-date optname-to-date "b")
(add-option
(gnc:make-account-list-option
pagename-incomeaccounts optname-incomeaccounts
- "b"
- opthelp-incomeaccounts
- ;; This default-getter finds the first account of this type. TODO:
- ;; Find not only the first one, but all of them!
+ "b" opthelp-incomeaccounts
(lambda ()
(gnc:filter-accountlist-type
(list ACCT-TYPE-INCOME)
@@ -121,10 +109,7 @@
(add-option
(gnc:make-account-list-option
pagename-expenseaccounts optname-expenseaccounts
- "b"
- opthelp-expenseaccounts
- ;; This default-getter finds the first account of this type. TODO:
- ;; Find not only the first one, but all of them!
+ "b" opthelp-expenseaccounts
(lambda ()
(gnc:filter-accountlist-type
(list ACCT-TYPE-EXPENSE)
@@ -191,11 +176,6 @@
options)
-(define (customer-options-generator)
- (options-generator (list ACCT-TYPE-RECEIVABLE) GNC-OWNER-CUSTOMER
- (_ "Invoice")))
-
-
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-expand string character replace-string)
@@ -238,10 +218,8 @@
(define (make-myname-table book date-format)
(let* ((table (gnc:make-html-table))
- (table-outer (gnc:make-html-table))
(name (gnc:company-info book gnc:*company-name*))
(addy (gnc:company-info book gnc:*company-addy*)))
-
(gnc:html-table-set-style!
table "table"
'attribute (list "border" 0)
@@ -250,25 +228,21 @@
'attribute (list "valign" "top")
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
-
- (gnc:html-table-append-row! table (list (or name "")))
- (gnc:html-table-append-row! table (list (string-expand
- (or addy "")
- #\newline "<br/>")))
+ (if name (gnc:html-table-append-row! table (list name)))
+ (if addy (gnc:html-table-append-row!
+ table (list (string-expand addy #\newline "<br/>"))))
(gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format)))
-
- (gnc:html-table-set-style!
- table-outer "table"
- 'attribute (list "border" 0)
- 'attribute (list "width" "100%")
- 'attribute (list "valign" "top")
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 0))
-
- (gnc:html-table-append-row! table-outer (list table))
-
- table-outer))
+ (let ((table-outer (gnc:make-html-table)))
+ (gnc:html-table-set-style!
+ table-outer "table"
+ 'attribute (list "border" 0)
+ 'attribute (list "width" "100%")
+ 'attribute (list "valign" "top")
+ 'attribute (list "cellspacing" 0)
+ 'attribute (list "cellpadding" 0))
+ (gnc:html-table-append-row! table-outer (list table))
+ table-outer)))
(define (markup-percent profit sales)
(if (zero? sales) 0
@@ -315,18 +289,13 @@
gnc-commodity-equiv))
(book (gnc-get-current-book))
(date-format (gnc:options-fancy-date book))
- (type (opt-val "__reg" "owner-type"))
(ownerlist (gncBusinessGetOwnerList
book
- (gncOwnerTypeToQofIdType type)
+ (gncOwnerTypeToQofIdType GNC-OWNER-CUSTOMER)
(opt-val gnc:pagename-display optname-show-inactive)))
(toplevel-total-sales (gnc:make-commodity-collector))
(toplevel-total-expense (gnc:make-commodity-collector))
- (type-str (cond
- ((eqv? type GNC-OWNER-CUSTOMER) (N_ "Customer"))
- ((eqv? type GNC-OWNER-VENDOR) (N_ "Vendor"))
- ((eqv? type GNC-OWNER-EMPLOYEE) (N_ "Employee"))
- (else ""))))
+ (type-str (N_ "Customer")))
(gnc:html-document-set-title!
document (string-append (_ type-str) " " (_ "Report")))
@@ -369,10 +338,7 @@
document
(gnc:make-html-text
(string-append
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER) (_ "No valid customer selected."))
- ((eqv? type GNC-OWNER-VENDOR) (_ "No valid vendor selected."))
- ((eqv? type GNC-OWNER-EMPLOYEE) (_ "No valid employee selected.")))
+ (_ "No valid customer selected.")
" " (_ "Click on the \"Options\" button to select a company.")))))
(else
@@ -521,7 +487,7 @@
'name (N_ "Customer Summary")
'report-guid customer-report-guid
'menu-path (list gnc:menuname-business-reports)
- 'options-generator customer-options-generator
+ 'options-generator options-generator
'renderer reg-renderer
'in-menu? #t)
commit e19fdf51e380c5a664a724d2c89225f90c898265
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Jun 25 08:57:49 2019 +0800
[customer-summary] refactor report
* handle error cases centrally
* inline numerous single-use functions
* deduplicate common code
* remove reverse? option is always #t, rename income to sales
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 9accee689..ed2c07c80 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -87,7 +87,7 @@
(define opthelp-sortascending (N_ "Choose the ordering of the column sort: Either ascending or descending."))
-(define (options-generator acct-type-list owner-type inv-str reverse?)
+(define (options-generator acct-type-list owner-type inv-str)
(define options (gnc:new-options))
@@ -97,9 +97,6 @@
(add-option
(gnc:make-internal-option "__reg" "inv-str" inv-str))
- (add-option
- (gnc:make-simple-boolean-option "__reg" "reverse?" "" "" reverse?))
-
(add-option
(gnc:make-internal-option "__reg" "owner-type" owner-type))
@@ -196,7 +193,7 @@
(define (customer-options-generator)
(options-generator (list ACCT-TYPE-RECEIVABLE) GNC-OWNER-CUSTOMER
- (_ "Invoice") #t)) ;; FIXME: reverse?=#t but originally #f
+ (_ "Invoice")))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -212,8 +209,9 @@
c)))
string))))
-(define (query-setup q owner account-list start-date end-date)
- (let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
+(define (query owner account-list start-date end-date)
+ (let* ((q (qof-query-create-for-splits))
+ (guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
(qof-query-add-guid-match
q (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-OWNER OWNER-PARENTG)
guid QOF-QUERY-OR)
@@ -234,7 +232,9 @@
(xaccQueryAddAccountMatch q account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
(xaccQueryAddDateMatchTT q #t start-date #t end-date QOF-QUERY-AND)
(qof-query-set-book q (gnc-get-current-book))
- q))
+ (let ((result (qof-query-run q)))
+ (qof-query-destroy q)
+ result)))
(define (make-myname-table book date-format)
(let* ((table (gnc:make-html-table))
@@ -251,9 +251,9 @@
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
- (gnc:html-table-append-row! table (list (if name name "")))
+ (gnc:html-table-append-row! table (list (or name "")))
(gnc:html-table-append-row! table (list (string-expand
- (if addy addy "")
+ (or addy "")
#\newline "<br/>")))
(gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format)))
@@ -270,16 +270,23 @@
table-outer))
-(define (make-break! document)
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-br))))
-
(define (markup-percent profit sales)
(if (zero? sales) 0
(* 100 (/ profit sales))))
+(define (filter-splits splits accounts)
+ (apply + (map xaccSplitGetAmount
+ (filter
+ (lambda (s)
+ (member (xaccSplitGetAccount s) accounts))
+ splits))))
+
+(define (coll-minus minuend subtrahend)
+ (let ((coll (gnc:make-commodity-collector)))
+ (coll 'merge minuend #f)
+ (coll 'minusmerge subtrahend #f)
+ coll))
+
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (reg-renderer report-obj)
@@ -295,317 +302,215 @@
(end-date (gnc:time64-end-day-time
(gnc:date-option-absolute-time
(opt-val gnc:pagename-general optname-to-date))))
+ (sort-order (opt-val gnc:pagename-display optname-sortascending))
(show-zero-lines? (opt-val gnc:pagename-display optname-show-zero-lines))
- (show-column-expense? (opt-val gnc:pagename-display optname-show-column-expense))
- (table-num-columns (if show-column-expense? 5 4))
+ (show-column-expense?
+ (opt-val gnc:pagename-display optname-show-column-expense))
(show-own-address? (opt-val gnc:pagename-display optname-show-own-address))
(expense-accounts (opt-val pagename-expenseaccounts optname-expenseaccounts))
- (income-accounts (opt-val pagename-incomeaccounts optname-incomeaccounts))
- (all-accounts (append income-accounts expense-accounts))
+ (sales-accounts (opt-val pagename-incomeaccounts optname-incomeaccounts))
+ (all-accounts (append sales-accounts expense-accounts))
(commodities (delete-duplicates
(map xaccAccountGetCommodity all-accounts)
gnc-commodity-equiv))
(book (gnc-get-current-book))
(date-format (gnc:options-fancy-date book))
(type (opt-val "__reg" "owner-type"))
- (reverse? (opt-val "__reg" "reverse?"))
(ownerlist (gncBusinessGetOwnerList
book
(gncOwnerTypeToQofIdType type)
(opt-val gnc:pagename-display optname-show-inactive)))
- (toplevel-total-income (gnc:make-commodity-collector))
+ (toplevel-total-sales (gnc:make-commodity-collector))
(toplevel-total-expense (gnc:make-commodity-collector))
- (any-valid-owner? #f)
(type-str (cond
((eqv? type GNC-OWNER-CUSTOMER) (N_ "Customer"))
((eqv? type GNC-OWNER-VENDOR) (N_ "Vendor"))
((eqv? type GNC-OWNER-EMPLOYEE) (N_ "Employee"))
- (else "")))
- (currency (gnc-default-currency)))
+ (else ""))))
(gnc:html-document-set-title!
document (string-append (_ type-str) " " (_ "Report")))
+ (gnc:html-document-set-title!
+ document (format #f (_ "~a ~a - ~a")
+ report-title
+ (qof-print-date start-date)
+ (qof-print-date end-date)))
+
+ (when show-own-address?
+ (gnc:html-document-add-object!
+ document (make-myname-table book date-format)))
+
(for-each
(lambda (acc)
- (toplevel-total-income
+ (toplevel-total-sales
'add (xaccAccountGetCommodity acc)
- ((if reverse? - identity)
- (- (xaccAccountGetBalanceAsOfDate acc end-date)
- (xaccAccountGetBalanceAsOfDate acc start-date)))))
- income-accounts)
+ (- (xaccAccountGetBalanceAsOfDate acc start-date)
+ (xaccAccountGetBalanceAsOfDate acc end-date))))
+ sales-accounts)
(for-each
(lambda (acc)
(toplevel-total-expense
'add (xaccAccountGetCommodity acc)
- ((if reverse? - identity)
- (- (xaccAccountGetBalanceAsOfDate acc end-date)
- (xaccAccountGetBalanceAsOfDate acc start-date)))))
+ (- (xaccAccountGetBalanceAsOfDate acc end-date)
+ (xaccAccountGetBalanceAsOfDate acc start-date))))
expense-accounts)
- ;; Continue if we have non-null accounts
- (if (null? income-accounts)
-
- ;; error condition: no accounts specified
- ;; is this *really* necessary?? i'd be fine with an all-zero
- ;; account summary that would, technically, be correct....
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj)))
-
- ;; otherwise, generate the report...
-
- (let ((resulttable
- ;; Loop over all owners
- (map
- (lambda (owner)
- ;; Now create the line for one single owner
- (let ((total-income 0)
- (total-expense 0)
- (owner-query (qof-query-create-for-splits))
- (currency (gncOwnerGetCurrency owner)))
- ;; Run one query on all accounts
- (query-setup owner-query owner all-accounts start-date end-date)
- (set! any-valid-owner? #t)
-
- (let ((splits (qof-query-run owner-query)))
-
- (set! total-income
- (gnc:make-gnc-monetary
- currency
- ((if reverse? - identity)
- (apply + (map xaccSplitGetValue
- (filter
- (lambda (s)
- (member (xaccSplitGetAccount s)
- income-accounts))
- splits))))))
-
- (set! total-expense
- (gnc:make-gnc-monetary
- currency
- ((if reverse? - identity)
- (apply + (map xaccSplitGetValue
- (filter
- (lambda (s)
- (member (xaccSplitGetAccount s)
- expense-accounts))
- splits)))))))
-
- ;; Clean up the query
- (qof-query-destroy owner-query)
-
- ;; We print the summary now
- (let* ((profit (gnc:monetary+ total-income total-expense))
- (markupfloat (markup-percent
- (gnc:gnc-monetary-amount profit)
- (gnc:gnc-monetary-amount total-income))))
-
- ;; Result of this customer
- (list owner profit markupfloat total-income total-expense))))
- ownerlist)))
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; If asked for, we also print the company name
- (if show-own-address?
- (gnc:html-document-add-object!
- document
- (make-myname-table book date-format)))
-
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;; Now print the resulttable here:
- (let ((table (gnc:make-html-table))
- (sort-descending? (eq? (opt-val gnc:pagename-display optname-sortascending) 'descend))
- (sort-key (opt-val gnc:pagename-display optname-sortkey))
- (total-sales (gnc:make-commodity-collector))
- (total-expense (gnc:make-commodity-collector))
- (heading-list
- (list (_ "Customer")
- (_ "Profit")
- ;; Translators: "Markup" is profit amount divided by sales amount
- (_ "Markup")
- (_ "Sales"))))
-
- ;; helper for sorting an owner list
- (define (owner-name<? a b)
- (string<? (gncOwnerGetName a) (gncOwnerGetName b)))
-
- ;; Heading line
- (if show-column-expense?
- (set! heading-list (append heading-list (list (_ "Expense")))))
- (gnc:html-table-set-col-headers! table heading-list)
-
- ;; Sorting: First sort everything alphabetically
- ;; (ascending) so that we have one stable sorting order
- (set! resulttable
- (sort resulttable
- (lambda (a b)
- (owner-name<? (car a) (car b)))))
-
- ;; Secondly sort by the actual sort key
- (let ((cmp (if sort-descending? > <))
- (strcmp (if sort-descending? string>? string<?)))
- (set! resulttable
- (sort resulttable
- (cond
- ((eq? sort-key 'customername)
- (lambda (a b)
- (strcmp (gncOwnerGetName (car a)) (gncOwnerGetName (car b)))))
- ((eq? sort-key 'profit)
- (lambda (a b)
- (cmp (gnc-numeric-compare (cadr a) (cadr b)) 0)))
- ((eq? sort-key 'markup)
- (lambda (a b)
- (cmp (list-ref a 2) (list-ref b 2))))
- ((eq? sort-key 'sales)
- (lambda (a b)
- (cmp (gnc-numeric-compare (list-ref a 3) (list-ref b 3)) 0)))
- ((eq? sort-key 'expense)
- (lambda (a b)
- (cmp (gnc-numeric-compare (list-ref a 4) (list-ref b 4)) 0)))))))
-
- ;; The actual content
- (for-each
- (lambda (row)
- (if (eq? (length row) 5)
- (let ((owner (list-ref row 0))
- (profit (list-ref row 1))
- (markupfloat (list-ref row 2))
- (sales (list-ref row 3))
- (expense (list-ref row 4)))
-
- (total-sales 'add (gnc:gnc-monetary-commodity sales)
- (gnc:gnc-monetary-amount sales))
- (total-expense 'add (gnc:gnc-monetary-commodity expense)
- (gnc:gnc-monetary-amount expense))
- (if (or show-zero-lines?
- (not (and (zero? (gnc:gnc-monetary-amount profit))
- (zero? (gnc:gnc-monetary-amount sales)))))
- (gnc:html-table-append-row!
- table (append
- (list (gncOwnerGetName owner)
- profit
- (format #f "~2,0f%" markupfloat)
- sales)
- (if show-column-expense?
- (list expense) '())))))
- (gnc:warn "Oops, encountered a row with wrong length=" (length row))))
- resulttable) ;; END for-each row
-
- ;; The "No Customer" lines
- (let* ((other-sales (let ((coll (gnc:make-commodity-collector)))
- (coll 'merge toplevel-total-income #f)
- (coll 'minusmerge total-sales #f)
- coll))
- (other-expense (let ((coll (gnc:make-commodity-collector)))
- (coll 'merge toplevel-total-expense #f)
- (coll 'minusmerge total-expense #f)
- coll))
- (other-profit (let ((coll (gnc:make-commodity-collector)))
- (coll 'merge other-sales #f)
- (coll 'merge other-expense #f)
- coll)))
- (for-each
- (lambda (comm)
- (let* ((profit (cadr (other-profit 'getpair comm #f)))
- (sales (cadr (other-sales 'getpair comm #f)))
- (expense (cadr (other-expense 'getpair comm #f)))
- (markupfloat (markup-percent profit sales)))
- (if (or show-zero-lines?
- (not (and (zero? profit) (zero? sales))))
- (gnc:html-table-append-row!
- table
- (append
- (list (string-append (_ "No Customer")
- " "
- (gnc-commodity-get-mnemonic comm))
- (gnc:make-gnc-monetary comm profit)
- (format #f "~2,0f%" markupfloat)
- (gnc:make-gnc-monetary comm sales))
- (if show-column-expense?
- (list (gnc:make-gnc-monetary comm (- expense)))
- '()))))))
- commodities))
-
- ;; One horizontal ruler before the summary
- ;;;(gnc:html-table-append-ruler!
- ;;; table table-num-columns) ;; better use the "noshade" attribute:
- (gnc:html-table-append-row!
- table
- (list
- (gnc:make-html-table-cell/size
- 1 table-num-columns
- (gnc:make-html-text (gnc:html-markup/attr/no-end "hr" "noshade")))))
-
- ;; One summary line
- (let* ((total-profit (let ((coll (gnc:make-commodity-collector)))
- (coll 'merge toplevel-total-income #f)
- (coll 'merge toplevel-total-expense #f)
- coll)))
- (for-each
- (lambda (comm)
- (let* ((profit (cadr (total-profit 'getpair comm #f)))
- (sales (cadr (toplevel-total-income 'getpair comm #f)))
- (expense (cadr (toplevel-total-expense 'getpair comm #f)))
- (markupfloat (markup-percent profit sales)))
- (gnc:html-table-append-row!
- table
- (append (list (string-append (_ "Total") " "
- (gnc-commodity-get-mnemonic comm))
- (gnc:make-gnc-monetary comm profit)
- (format #f "~2,0f%" markupfloat)
- (gnc:make-gnc-monetary comm sales))
- (if show-column-expense?
- (list (gnc:make-gnc-monetary currency (- expense)))
- '())))))
- commodities))
-
- ;; Set the formatting styles
- (gnc:html-table-set-style!
- table "td"
- 'attribute '("align" "right")
- 'attribute '("valign" "top"))
-
- (gnc:html-table-set-col-style!
- table 0 "td"
- 'attribute '("align" "left"))
-
- (gnc:html-table-set-style!
- table "table"
- ;;'attribute (list "border" 1)
- 'attribute (list "cellspacing" 2)
- 'attribute (list "cellpadding" 4))
-
- ;; And add the table to the document
- (gnc:html-document-add-object!
- document table))))
-
- (if any-valid-owner?
- ;; Report contains valid data
- (let ((headline (format #f (_ "~a ~a - ~a")
- report-title
- (qof-print-date start-date)
- (qof-print-date end-date))))
- (gnc:html-document-set-title! document headline))
-
- ;; else....
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (string-append
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER)
- (_ "No valid customer selected."))
- ((eqv? type GNC-OWNER-VENDOR)
- (_ "No valid vendor selected."))
- ((eqv? type GNC-OWNER-EMPLOYEE)
- (_ "No valid employee selected.")))
- " "
- (_ "Click on the \"Options\" button to select a company.")))))
+ (cond
+ ((null? sales-accounts)
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj))))
+
+ ((null? ownerlist)
+ (gnc:html-document-add-object!
+ document
+ (gnc:make-html-text
+ (string-append
+ (cond
+ ((eqv? type GNC-OWNER-CUSTOMER) (_ "No valid customer selected."))
+ ((eqv? type GNC-OWNER-VENDOR) (_ "No valid vendor selected."))
+ ((eqv? type GNC-OWNER-EMPLOYEE) (_ "No valid employee selected.")))
+ " " (_ "Click on the \"Options\" button to select a company.")))))
+
+ (else
+ (let ((all-splits (query #f all-accounts start-date end-date))
+ (table (gnc:make-html-table))
+ (total-sales (gnc:make-commodity-collector))
+ (total-expense (gnc:make-commodity-collector))
+ (headings (cons* (_ "Customer")
+ (_ "Profit")
+ (_ "Markup")
+ (_ "Sales")
+ (if show-column-expense?
+ (list (_ "Expense"))
+ '())))
+ (results (map
+ (lambda (owner)
+ (let* ((splits (query owner all-accounts start-date end-date))
+ (currency (gncOwnerGetCurrency owner))
+ (sales (- (filter-splits splits sales-accounts)))
+ (expense (filter-splits splits expense-accounts))
+ (profit (- sales expense)))
+ (list owner
+ (gnc:make-gnc-monetary currency profit)
+ (markup-percent profit sales)
+ (gnc:make-gnc-monetary currency sales)
+ (gnc:make-gnc-monetary currency expense))))
+ ownerlist)))
+
+ (define (add-row owner markup profit sales expense)
+ (gnc:html-table-append-row!
+ table (cons owner
+ (map
+ (lambda (cell)
+ (gnc:make-html-table-cell/markup "number-cell" cell))
+ (cons* profit
+ (format #f "~a%" (round markup))
+ sales
+ (if show-column-expense?
+ (list expense)
+ '()))))))
+
+ ;; Heading line
+ (gnc:html-table-set-col-headers! table headings)
+
+ (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
+ (for-each
+ (lambda (row)
+ (let* ((owner (car row))
+ (curr (gncOwnerGetCurrency owner))
+ (profit (cadr row))
+ (markupfloat (caddr row))
+ (sales (cadddr row))
+ (expense (last row)))
+ (total-sales 'add curr (gnc:gnc-monetary-amount sales))
+ (total-expense 'add curr (gnc:gnc-monetary-amount expense))
+ (if (or show-zero-lines?
+ (not (and (zero? (gnc:gnc-monetary-amount profit))
+ (zero? (gnc:gnc-monetary-amount sales)))))
+ (add-row (gncOwnerGetName owner) markupfloat profit sales expense))))
+ results)
+
+ ;; The "No Customer" lines
+ (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)))
+ (for-each
+ (lambda (comm)
+ (let* ((profit (cadr (other-profit 'getpair comm #f)))
+ (sales (cadr (other-sales 'getpair comm #f)))
+ (expense (cadr (other-expense 'getpair comm #f)))
+ (markupfloat (markup-percent profit sales)))
+ (unless (and (zero? profit) (zero? sales))
+ (add-row (string-append (_ "No Customer") " "
+ (gnc-commodity-get-mnemonic comm))
+ markupfloat
+ (gnc:make-gnc-monetary comm profit)
+ (gnc:make-gnc-monetary comm sales)
+ (gnc:make-gnc-monetary comm expense)))))
+ commodities))
+
+ ;; One horizontal ruler before the summary
+ (gnc:html-table-append-row!
+ table (list
+ (gnc:make-html-table-cell/size
+ 1 (length headings)
+ (gnc:make-html-text (gnc:html-markup/attr/no-end "hr" "noshade")))))
+
+ ;; Summary lines - 1 per currency
+ (let ((total-profit (coll-minus toplevel-total-sales toplevel-total-expense)))
+ (for-each
+ (lambda (comm)
+ (let* ((profit (cadr (total-profit 'getpair comm #f)))
+ (sales (cadr (toplevel-total-sales 'getpair comm #f)))
+ (expense (cadr (toplevel-total-expense 'getpair comm #f)))
+ (markupfloat (markup-percent profit sales)))
+ (add-row (string-append (_ "Total") " "
+ (gnc-commodity-get-mnemonic comm))
+ markupfloat
+ (gnc:make-gnc-monetary comm profit)
+ (gnc:make-gnc-monetary comm sales)
+ (gnc:make-gnc-monetary comm expense))))
+ commodities))
+
+ ;; Set the formatting styles
+ (gnc:html-table-set-style!
+ table "td"
+ 'attribute '("align" "right")
+ 'attribute '("valign" "top"))
+
+ (gnc:html-table-set-col-style!
+ table 0 "td"
+ 'attribute '("align" "left"))
+
+ (gnc:html-table-set-style!
+ table "table"
+ ;;'attribute (list "border" 1)
+ 'attribute (list "cellspacing" 2)
+ 'attribute (list "cellpadding" 4))
+
+ ;; And add the table to the document
+ (gnc:html-document-add-object! document table))))
document))
commit d1a7d37c18398e5a184a8a835e2cfaebf067650e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Jun 25 07:33:01 2019 +0800
[customer-summary] upgrade to handle multiple currencies
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 225d542c2..9accee689 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -212,44 +212,30 @@
c)))
string))))
-(define (query-toplevel-setup query account-list start-date end-date)
- (xaccQueryAddAccountMatch query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT query #t start-date #t end-date QOF-QUERY-AND)
- (qof-query-set-book query (gnc-get-current-book))
- query)
-
-(define (query-owner-setup q owner)
+(define (query-setup q owner account-list start-date end-date)
(let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
(qof-query-add-guid-match
- q
- (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-OWNER
- OWNER-PARENTG)
+ q (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-OWNER OWNER-PARENTG)
guid QOF-QUERY-OR)
(qof-query-add-guid-match
- q
- (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-BILLTO
- OWNER-PARENTG)
+ q (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-BILLTO OWNER-PARENTG)
guid QOF-QUERY-OR)
;; Apparently those query terms are unneeded because we never take
;; lots into account?!?
- ;; (qof-query-add-guid-match
- ;; q
- ;; (list SPLIT-LOT OWNER-FROM-LOT OWNER-PARENTG)
- ;; guid QOF-QUERY-OR)
- ;; (qof-query-add-guid-match
- ;; q
- ;; (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-OWNER
- ;; OWNER-PARENTG)
- ;; guid QOF-QUERY-OR)
- ;; (qof-query-add-guid-match
- ;; q
- ;; (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-BILLTO
- ;; OWNER-PARENTG)
- ;; guid QOF-QUERY-OR)
+ ;; (qof-query-add-guid-match
+ ;; q (list SPLIT-LOT OWNER-FROM-LOT OWNER-PARENTG)
+ ;; guid QOF-QUERY-OR)
+ ;; (qof-query-add-guid-match
+ ;; q (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-OWNER OWNER-PARENTG)
+ ;; guid QOF-QUERY-OR)
+ ;; (qof-query-add-guid-match
+ ;; q (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-BILLTO OWNER-PARENTG)
+ ;; guid QOF-QUERY-OR)
+ (xaccQueryAddAccountMatch q account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
+ (xaccQueryAddDateMatchTT q #t start-date #t end-date QOF-QUERY-AND)
(qof-query-set-book q (gnc-get-current-book))
q))
-
(define (make-myname-table book date-format)
(let* ((table (gnc:make-html-table))
(table-outer (gnc:make-html-table))
@@ -294,14 +280,6 @@
(if (zero? sales) 0
(* 100 (/ profit sales))))
-(define (query-split-value sub-query toplevel-query)
- (let ((splits (qof-query-run-subquery sub-query toplevel-query)))
- (apply + (map xaccSplitGetValue splits))))
-
-(define (single-query-split-value query)
- (let ((splits (qof-query-run query)))
- (apply + (map xaccSplitGetValue splits))))
-
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (reg-renderer report-obj)
@@ -324,6 +302,9 @@
(expense-accounts (opt-val pagename-expenseaccounts optname-expenseaccounts))
(income-accounts (opt-val pagename-incomeaccounts optname-incomeaccounts))
(all-accounts (append income-accounts expense-accounts))
+ (commodities (delete-duplicates
+ (map xaccAccountGetCommodity all-accounts)
+ gnc-commodity-equiv))
(book (gnc-get-current-book))
(date-format (gnc:options-fancy-date book))
(type (opt-val "__reg" "owner-type"))
@@ -332,11 +313,8 @@
book
(gncOwnerTypeToQofIdType type)
(opt-val gnc:pagename-display optname-show-inactive)))
- (toplevel-income-query (qof-query-create-for-splits))
- (toplevel-expense-query (qof-query-create-for-splits))
- (toplevel-total-income #f)
- (toplevel-total-expense #f)
- (owner-query (qof-query-create-for-splits))
+ (toplevel-total-income (gnc:make-commodity-collector))
+ (toplevel-total-expense (gnc:make-commodity-collector))
(any-valid-owner? #f)
(type-str (cond
((eqv? type GNC-OWNER-CUSTOMER) (N_ "Customer"))
@@ -348,23 +326,23 @@
(gnc:html-document-set-title!
document (string-append (_ type-str) " " (_ "Report")))
- ;; Set up the toplevel query
- (query-toplevel-setup toplevel-income-query income-accounts start-date end-date)
-
- ;; Run the query to be able to use the results in a sub-query, and
- ;; also use the amount as the actual grand total (both assigned
- ;; and not assigned to customers)
- (set! toplevel-total-income
- (single-query-split-value toplevel-income-query))
- (if reverse?
- (set! toplevel-total-income (- toplevel-total-income)))
-
- ;; Total expenses as well
- (query-toplevel-setup toplevel-expense-query expense-accounts start-date end-date)
- (set! toplevel-total-expense
- (single-query-split-value toplevel-expense-query))
- (if reverse?
- (set! toplevel-total-expense (- toplevel-total-expense)))
+ (for-each
+ (lambda (acc)
+ (toplevel-total-income
+ 'add (xaccAccountGetCommodity acc)
+ ((if reverse? - identity)
+ (- (xaccAccountGetBalanceAsOfDate acc end-date)
+ (xaccAccountGetBalanceAsOfDate acc start-date)))))
+ income-accounts)
+
+ (for-each
+ (lambda (acc)
+ (toplevel-total-expense
+ 'add (xaccAccountGetCommodity acc)
+ ((if reverse? - identity)
+ (- (xaccAccountGetBalanceAsOfDate acc end-date)
+ (xaccAccountGetBalanceAsOfDate acc start-date)))))
+ expense-accounts)
;; Continue if we have non-null accounts
(if (null? income-accounts)
@@ -385,36 +363,45 @@
(lambda (owner)
;; Now create the line for one single owner
(let ((total-income 0)
- (total-expense 0))
-
- (set! currency (xaccAccountGetCommodity (car all-accounts)))
+ (total-expense 0)
+ (owner-query (qof-query-create-for-splits))
+ (currency (gncOwnerGetCurrency owner)))
+ ;; Run one query on all accounts
+ (query-setup owner-query owner all-accounts start-date end-date)
(set! any-valid-owner? #t)
- ;; Run one query on all income accounts
- (query-owner-setup owner-query owner)
-
- (set! total-income
- (query-split-value owner-query toplevel-income-query))
- (if reverse?
- (set! total-income (- total-income)))
+ (let ((splits (qof-query-run owner-query)))
+
+ (set! total-income
+ (gnc:make-gnc-monetary
+ currency
+ ((if reverse? - identity)
+ (apply + (map xaccSplitGetValue
+ (filter
+ (lambda (s)
+ (member (xaccSplitGetAccount s)
+ income-accounts))
+ splits))))))
+
+ (set! total-expense
+ (gnc:make-gnc-monetary
+ currency
+ ((if reverse? - identity)
+ (apply + (map xaccSplitGetValue
+ (filter
+ (lambda (s)
+ (member (xaccSplitGetAccount s)
+ expense-accounts))
+ splits)))))))
;; Clean up the query
- (qof-query-clear owner-query)
-
- ;; And run one query on all expense accounts
- (query-owner-setup owner-query owner)
-
- (set! total-expense
- (query-split-value owner-query toplevel-expense-query))
- (if reverse?
- (set! total-expense (- total-expense)))
-
- ;; Clean up the query
- (qof-query-clear owner-query)
+ (qof-query-destroy owner-query)
;; We print the summary now
- (let* ((profit (+ total-income total-expense))
- (markupfloat (markup-percent profit total-income)))
+ (let* ((profit (gnc:monetary+ total-income total-expense))
+ (markupfloat (markup-percent
+ (gnc:gnc-monetary-amount profit)
+ (gnc:gnc-monetary-amount total-income))))
;; Result of this customer
(list owner profit markupfloat total-income total-expense))))
@@ -434,9 +421,8 @@
(let ((table (gnc:make-html-table))
(sort-descending? (eq? (opt-val gnc:pagename-display optname-sortascending) 'descend))
(sort-key (opt-val gnc:pagename-display optname-sortkey))
- (total-profit 0)
- (total-sales 0)
- (total-expense 0)
+ (total-sales (gnc:make-commodity-collector))
+ (total-expense (gnc:make-commodity-collector))
(heading-list
(list (_ "Customer")
(_ "Profit")
@@ -491,48 +477,59 @@
(markupfloat (list-ref row 2))
(sales (list-ref row 3))
(expense (list-ref row 4)))
- (set! total-profit (+ total-profit profit))
- (set! total-sales (+ total-sales sales))
- (set! total-expense (+ total-expense expense))
+
+ (total-sales 'add (gnc:gnc-monetary-commodity sales)
+ (gnc:gnc-monetary-amount sales))
+ (total-expense 'add (gnc:gnc-monetary-commodity expense)
+ (gnc:gnc-monetary-amount expense))
(if (or show-zero-lines?
- (not (and (zero? profit) (zero? sales))))
- (let ((row-content (list
- (gncOwnerGetName owner)
- (gnc:make-gnc-monetary currency profit)
- ;;(format #f (if (< (abs markupfloat) 10) "~2.1f%%" "%2.0f%%") markupfloat)
- (format #f "~2,0f%" markupfloat)
- (gnc:make-gnc-monetary currency sales))))
- (if show-column-expense?
- (set! row-content
- (append row-content
- (list
- (gnc:make-gnc-monetary currency (- expense))))))
- (gnc:html-table-append-row!
- table row-content))))
+ (not (and (zero? (gnc:gnc-monetary-amount profit))
+ (zero? (gnc:gnc-monetary-amount sales)))))
+ (gnc:html-table-append-row!
+ table (append
+ (list (gncOwnerGetName owner)
+ profit
+ (format #f "~2,0f%" markupfloat)
+ sales)
+ (if show-column-expense?
+ (list expense) '())))))
(gnc:warn "Oops, encountered a row with wrong length=" (length row))))
resulttable) ;; END for-each row
- ;; The "No Customer" line
- (let* ((other-sales (- toplevel-total-income total-sales))
- (other-expense (- toplevel-total-expense total-expense))
- (other-profit (+ other-sales other-expense))
- (markupfloat (markup-percent other-profit other-sales))
- (row-content
- (list
- (_ "No Customer")
- (gnc:make-gnc-monetary currency other-profit)
- (format #f "~2,0f%" markupfloat)
- (gnc:make-gnc-monetary currency other-sales))))
- (if show-column-expense?
- (set! row-content
- (append row-content
- (list
- (gnc:make-gnc-monetary currency (- other-expense))))))
- (if (or show-zero-lines?
- (not (and (zero? other-profit) (zero? other-sales))))
-
- (gnc:html-table-append-row!
- table row-content)))
+ ;; The "No Customer" lines
+ (let* ((other-sales (let ((coll (gnc:make-commodity-collector)))
+ (coll 'merge toplevel-total-income #f)
+ (coll 'minusmerge total-sales #f)
+ coll))
+ (other-expense (let ((coll (gnc:make-commodity-collector)))
+ (coll 'merge toplevel-total-expense #f)
+ (coll 'minusmerge total-expense #f)
+ coll))
+ (other-profit (let ((coll (gnc:make-commodity-collector)))
+ (coll 'merge other-sales #f)
+ (coll 'merge other-expense #f)
+ coll)))
+ (for-each
+ (lambda (comm)
+ (let* ((profit (cadr (other-profit 'getpair comm #f)))
+ (sales (cadr (other-sales 'getpair comm #f)))
+ (expense (cadr (other-expense 'getpair comm #f)))
+ (markupfloat (markup-percent profit sales)))
+ (if (or show-zero-lines?
+ (not (and (zero? profit) (zero? sales))))
+ (gnc:html-table-append-row!
+ table
+ (append
+ (list (string-append (_ "No Customer")
+ " "
+ (gnc-commodity-get-mnemonic comm))
+ (gnc:make-gnc-monetary comm profit)
+ (format #f "~2,0f%" markupfloat)
+ (gnc:make-gnc-monetary comm sales))
+ (if show-column-expense?
+ (list (gnc:make-gnc-monetary comm (- expense)))
+ '()))))))
+ commodities))
;; One horizontal ruler before the summary
;;;(gnc:html-table-append-ruler!
@@ -545,21 +542,27 @@
(gnc:make-html-text (gnc:html-markup/attr/no-end "hr" "noshade")))))
;; One summary line
- (let* ((total-profit (+ toplevel-total-income toplevel-total-expense))
- (markupfloat (markup-percent total-profit toplevel-total-income))
- (row-content
- (list
- (_ "Total")
- (gnc:make-gnc-monetary currency total-profit)
- (format #f "~2,0f%" markupfloat)
- (gnc:make-gnc-monetary currency toplevel-total-income))))
- (if show-column-expense?
- (set! row-content
- (append row-content
- (list
- (gnc:make-gnc-monetary currency (- toplevel-total-expense))))))
- (gnc:html-table-append-row!
- table row-content))
+ (let* ((total-profit (let ((coll (gnc:make-commodity-collector)))
+ (coll 'merge toplevel-total-income #f)
+ (coll 'merge toplevel-total-expense #f)
+ coll)))
+ (for-each
+ (lambda (comm)
+ (let* ((profit (cadr (total-profit 'getpair comm #f)))
+ (sales (cadr (toplevel-total-income 'getpair comm #f)))
+ (expense (cadr (toplevel-total-expense 'getpair comm #f)))
+ (markupfloat (markup-percent profit sales)))
+ (gnc:html-table-append-row!
+ table
+ (append (list (string-append (_ "Total") " "
+ (gnc-commodity-get-mnemonic comm))
+ (gnc:make-gnc-monetary comm profit)
+ (format #f "~2,0f%" markupfloat)
+ (gnc:make-gnc-monetary comm sales))
+ (if show-column-expense?
+ (list (gnc:make-gnc-monetary currency (- expense)))
+ '())))))
+ commodities))
;; Set the formatting styles
(gnc:html-table-set-style!
@@ -604,10 +607,6 @@
" "
(_ "Click on the \"Options\" button to select a company.")))))
- (qof-query-destroy owner-query)
- (qof-query-destroy toplevel-income-query)
- (qof-query-destroy toplevel-expense-query)
-
document))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
commit 5cdd1b072df789347a56f6b6c2f6d5a329206155
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Jun 24 22:01:35 2019 +0800
[customer-summary] eradicate gnc-numeric
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 923035470..225d542c2 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -292,7 +292,7 @@
(define (markup-percent profit sales)
(if (zero? sales) 0
- (* 100 (gnc-numeric-div profit sales 1000 GNC-HOW-RND-ROUND))))
+ (* 100 (/ profit sales))))
(define (query-split-value sub-query toplevel-query)
(let ((splits (qof-query-run-subquery sub-query toplevel-query)))
@@ -357,14 +357,14 @@
(set! toplevel-total-income
(single-query-split-value toplevel-income-query))
(if reverse?
- (set! toplevel-total-income (gnc-numeric-neg toplevel-total-income)))
+ (set! toplevel-total-income (- toplevel-total-income)))
;; Total expenses as well
(query-toplevel-setup toplevel-expense-query expense-accounts start-date end-date)
(set! toplevel-total-expense
(single-query-split-value toplevel-expense-query))
(if reverse?
- (set! toplevel-total-expense (gnc-numeric-neg toplevel-total-expense)))
+ (set! toplevel-total-expense (- toplevel-total-expense)))
;; Continue if we have non-null accounts
(if (null? income-accounts)
@@ -384,8 +384,8 @@
(map
(lambda (owner)
;; Now create the line for one single owner
- (let ((total-income (gnc-numeric-zero))
- (total-expense (gnc-numeric-zero)))
+ (let ((total-income 0)
+ (total-expense 0))
(set! currency (xaccAccountGetCommodity (car all-accounts)))
(set! any-valid-owner? #t)
@@ -396,7 +396,7 @@
(set! total-income
(query-split-value owner-query toplevel-income-query))
(if reverse?
- (set! total-income (gnc-numeric-neg total-income)))
+ (set! total-income (- total-income)))
;; Clean up the query
(qof-query-clear owner-query)
@@ -407,13 +407,13 @@
(set! total-expense
(query-split-value owner-query toplevel-expense-query))
(if reverse?
- (set! total-expense (gnc-numeric-neg total-expense)))
+ (set! total-expense (- total-expense)))
;; Clean up the query
(qof-query-clear owner-query)
;; We print the summary now
- (let* ((profit (gnc-numeric-add-fixed total-income total-expense))
+ (let* ((profit (+ total-income total-expense))
(markupfloat (markup-percent profit total-income)))
;; Result of this customer
@@ -434,9 +434,9 @@
(let ((table (gnc:make-html-table))
(sort-descending? (eq? (opt-val gnc:pagename-display optname-sortascending) 'descend))
(sort-key (opt-val gnc:pagename-display optname-sortkey))
- (total-profit (gnc-numeric-zero))
- (total-sales (gnc-numeric-zero))
- (total-expense (gnc-numeric-zero))
+ (total-profit 0)
+ (total-sales 0)
+ (total-expense 0)
(heading-list
(list (_ "Customer")
(_ "Profit")
@@ -491,11 +491,11 @@
(markupfloat (list-ref row 2))
(sales (list-ref row 3))
(expense (list-ref row 4)))
- (set! total-profit (gnc-numeric-add-fixed total-profit profit))
- (set! total-sales (gnc-numeric-add-fixed total-sales sales))
- (set! total-expense (gnc-numeric-add-fixed total-expense expense))
+ (set! total-profit (+ total-profit profit))
+ (set! total-sales (+ total-sales sales))
+ (set! total-expense (+ total-expense expense))
(if (or show-zero-lines?
- (not (and (gnc-numeric-zero-p profit) (gnc-numeric-zero-p sales))))
+ (not (and (zero? profit) (zero? sales))))
(let ((row-content (list
(gncOwnerGetName owner)
(gnc:make-gnc-monetary currency profit)
@@ -506,16 +506,16 @@
(set! row-content
(append row-content
(list
- (gnc:make-gnc-monetary currency (gnc-numeric-neg expense))))))
+ (gnc:make-gnc-monetary currency (- expense))))))
(gnc:html-table-append-row!
table row-content))))
(gnc:warn "Oops, encountered a row with wrong length=" (length row))))
resulttable) ;; END for-each row
;; The "No Customer" line
- (let* ((other-sales (gnc-numeric-sub-fixed toplevel-total-income total-sales))
- (other-expense (gnc-numeric-sub-fixed toplevel-total-expense total-expense))
- (other-profit (gnc-numeric-add-fixed other-sales other-expense))
+ (let* ((other-sales (- toplevel-total-income total-sales))
+ (other-expense (- toplevel-total-expense total-expense))
+ (other-profit (+ other-sales other-expense))
(markupfloat (markup-percent other-profit other-sales))
(row-content
(list
@@ -527,9 +527,9 @@
(set! row-content
(append row-content
(list
- (gnc:make-gnc-monetary currency (gnc-numeric-neg other-expense))))))
+ (gnc:make-gnc-monetary currency (- other-expense))))))
(if (or show-zero-lines?
- (not (and (gnc-numeric-zero-p other-profit) (gnc-numeric-zero-p other-sales))))
+ (not (and (zero? other-profit) (zero? other-sales))))
(gnc:html-table-append-row!
table row-content)))
@@ -545,7 +545,7 @@
(gnc:make-html-text (gnc:html-markup/attr/no-end "hr" "noshade")))))
;; One summary line
- (let* ((total-profit (gnc-numeric-add-fixed toplevel-total-income toplevel-total-expense))
+ (let* ((total-profit (+ toplevel-total-income toplevel-total-expense))
(markupfloat (markup-percent total-profit toplevel-total-income))
(row-content
(list
@@ -557,7 +557,7 @@
(set! row-content
(append row-content
(list
- (gnc:make-gnc-monetary currency (gnc-numeric-neg toplevel-total-expense))))))
+ (gnc:make-gnc-monetary currency (- toplevel-total-expense))))))
(gnc:html-table-append-row!
table row-content))
commit 7f19abaabd5223e6498eb863dac780ceb143b8f2
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Jun 24 21:58:52 2019 +0800
[customer-summary] remove unneeded sanity check for owner
and all-accounts which will never be null? because it's made of
income-accounts and expense-accounts, and (null? income-accounts) has
already been handled by previous cond
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 62cbb2d55..923035470 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -383,43 +383,41 @@
;; Loop over all owners
(map
(lambda (owner)
- (if
- (and (gncOwnerIsValid owner)
- (> (length all-accounts) 0))
+ ;; Now create the line for one single owner
+ (let ((total-income (gnc-numeric-zero))
+ (total-expense (gnc-numeric-zero)))
- ;; Now create the line for one single owner
- (let ((total-income (gnc-numeric-zero))
- (total-expense (gnc-numeric-zero)))
+ (set! currency (xaccAccountGetCommodity (car all-accounts)))
+ (set! any-valid-owner? #t)
- (set! currency (xaccAccountGetCommodity (car all-accounts)))
- (set! any-valid-owner? #t)
+ ;; Run one query on all income accounts
+ (query-owner-setup owner-query owner)
- ;; Run one query on all income accounts
- (query-owner-setup owner-query owner)
+ (set! total-income
+ (query-split-value owner-query toplevel-income-query))
+ (if reverse?
+ (set! total-income (gnc-numeric-neg total-income)))
- (set! total-income (query-split-value owner-query toplevel-income-query))
- (if reverse?
- (set! total-income (gnc-numeric-neg total-income)))
+ ;; Clean up the query
+ (qof-query-clear owner-query)
- ;; Clean up the query
- (qof-query-clear owner-query)
+ ;; And run one query on all expense accounts
+ (query-owner-setup owner-query owner)
- ;; And run one query on all expense accounts
- (query-owner-setup owner-query owner)
+ (set! total-expense
+ (query-split-value owner-query toplevel-expense-query))
+ (if reverse?
+ (set! total-expense (gnc-numeric-neg total-expense)))
- (set! total-expense (query-split-value owner-query toplevel-expense-query))
- (if reverse?
- (set! total-expense (gnc-numeric-neg total-expense)))
+ ;; Clean up the query
+ (qof-query-clear owner-query)
- ;; Clean up the query
- (qof-query-clear owner-query)
+ ;; We print the summary now
+ (let* ((profit (gnc-numeric-add-fixed total-income total-expense))
+ (markupfloat (markup-percent profit total-income)))
- ;; We print the summary now
- (let* ((profit (gnc-numeric-add-fixed total-income total-expense))
- (markupfloat (markup-percent profit total-income)))
-
- ;; Result of this customer
- (list owner profit markupfloat total-income total-expense)))))
+ ;; Result of this customer
+ (list owner profit markupfloat total-income total-expense))))
ownerlist)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
commit 0f5d3e2029ba12656ecb9c5b351849ebf74bf2b8
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Jun 24 21:48:22 2019 +0800
[customer-summary] remove dead code
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 228d47a2e..62cbb2d55 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -317,8 +317,6 @@
(end-date (gnc:time64-end-day-time
(gnc:date-option-absolute-time
(opt-val gnc:pagename-general optname-to-date))))
- (print-invoices? #t);;(opt-val gnc:pagename-general optname-invoicelines))
- ;;(show-txn-table? (opt-val gnc:pagename-display optname-show-txn-table))
(show-zero-lines? (opt-val gnc:pagename-display optname-show-zero-lines))
(show-column-expense? (opt-val gnc:pagename-display optname-show-column-expense))
(table-num-columns (if show-column-expense? 5 4))
@@ -340,18 +338,13 @@
(toplevel-total-expense #f)
(owner-query (qof-query-create-for-splits))
(any-valid-owner? #f)
- (type-str "")
- (notification-str "")
+ (type-str (cond
+ ((eqv? type GNC-OWNER-CUSTOMER) (N_ "Customer"))
+ ((eqv? type GNC-OWNER-VENDOR) (N_ "Vendor"))
+ ((eqv? type GNC-OWNER-EMPLOYEE) (N_ "Employee"))
+ (else "")))
(currency (gnc-default-currency)))
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER)
- (set! type-str (N_ "Customer")))
- ((eqv? type GNC-OWNER-VENDOR)
- (set! type-str (N_ "Vendor")))
- ((eqv? type GNC-OWNER-EMPLOYEE)
- (set! type-str (N_ "Employee"))))
-
(gnc:html-document-set-title!
document (string-append (_ type-str) " " (_ "Report")))
@@ -596,13 +589,7 @@
report-title
(qof-print-date start-date)
(qof-print-date end-date))))
- (gnc:html-document-set-title! document headline)
-
- ;; Check the settings for taking invoice/payment lines into
- ;; account and print the ch
- (make-break! document)
- (gnc:html-document-add-object!
- document (gnc:make-html-text notification-str)))
+ (gnc:html-document-set-title! document headline))
;; else....
(gnc:html-document-add-object!
commit 0115dc1a27e359202378df40572f9ea4b838d0cf
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Jun 24 20:37:31 2019 +0800
[customer-summary] *delete-trailing-whitespace/untabify/reindent*
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index bb3ec87dc..228d47a2e 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -54,12 +54,12 @@
;; The line break in the next expressions will suppress above comment as translator comments.
(define pagename-expenseaccounts
- (N_ "Expense Accounts"))
+ (N_ "Expense Accounts"))
(define optname-expenseaccounts (N_ "Expense Accounts"))
;; The line break in the next expressions will suppress above comment as translator comments.
(define opthelp-expenseaccounts
- (N_ "The expense accounts where the expenses are recorded which are subtracted from the sales to give the profit."))
+ (N_ "The expense accounts where the expenses are recorded which are subtracted from the sales to give the profit."))
(define optname-show-column-expense (N_ "Show Expense Column"))
(define opthelp-show-column-expense (N_ "Show the column with the expenses per customer."))
@@ -76,7 +76,7 @@
;; The line break in the next expression will suppress above comments as translator comments.
(define optname-show-zero-lines
- (N_ "Show Lines with All Zeros"))
+ (N_ "Show Lines with All Zeros"))
(define opthelp-show-zero-lines (N_ "Show the table lines with customers which did not have any transactions in the reporting period, hence would show all zeros in the columns."))
(define optname-show-inactive (N_ "Show Inactive Customers"))
(define opthelp-show-inactive (N_ "Include customers that have been marked inactive."))
@@ -116,7 +116,7 @@
;; This default-getter finds the first account of this type. TODO:
;; Find not only the first one, but all of them!
(lambda ()
- (gnc:filter-accountlist-type
+ (gnc:filter-accountlist-type
(list ACCT-TYPE-INCOME)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
#f #t))
@@ -129,7 +129,7 @@
;; This default-getter finds the first account of this type. TODO:
;; Find not only the first one, but all of them!
(lambda ()
- (gnc:filter-accountlist-type
+ (gnc:filter-accountlist-type
(list ACCT-TYPE-EXPENSE)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
#f #t))
@@ -220,33 +220,32 @@
(define (query-owner-setup q owner)
(let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
-
(qof-query-add-guid-match
- q
+ q
(list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-OWNER
OWNER-PARENTG)
guid QOF-QUERY-OR)
(qof-query-add-guid-match
- q
+ q
(list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-BILLTO
OWNER-PARENTG)
guid QOF-QUERY-OR)
-;; Apparently those query terms are unneeded because we never take
-;; lots into account?!?
-; (qof-query-add-guid-match
-; q
-; (list SPLIT-LOT OWNER-FROM-LOT OWNER-PARENTG)
-; guid QOF-QUERY-OR)
-; (qof-query-add-guid-match
-; q
-; (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-OWNER
-; OWNER-PARENTG)
-; guid QOF-QUERY-OR)
-; (qof-query-add-guid-match
-; q
-; (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-BILLTO
-; OWNER-PARENTG)
-; guid QOF-QUERY-OR)
+ ;; Apparently those query terms are unneeded because we never take
+ ;; lots into account?!?
+ ;; (qof-query-add-guid-match
+ ;; q
+ ;; (list SPLIT-LOT OWNER-FROM-LOT OWNER-PARENTG)
+ ;; guid QOF-QUERY-OR)
+ ;; (qof-query-add-guid-match
+ ;; q
+ ;; (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-OWNER
+ ;; OWNER-PARENTG)
+ ;; guid QOF-QUERY-OR)
+ ;; (qof-query-add-guid-match
+ ;; q
+ ;; (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-BILLTO
+ ;; OWNER-PARENTG)
+ ;; guid QOF-QUERY-OR)
(qof-query-set-book q (gnc-get-current-book))
q))
@@ -312,14 +311,14 @@
(let* ((document (gnc:make-html-document))
(report-title (opt-val gnc:pagename-general gnc:optname-reportname))
- (start-date (gnc:time64-start-day-time
+ (start-date (gnc:time64-start-day-time
(gnc:date-option-absolute-time
(opt-val gnc:pagename-general optname-from-date))))
- (end-date (gnc:time64-end-day-time
+ (end-date (gnc:time64-end-day-time
(gnc:date-option-absolute-time
(opt-val gnc:pagename-general optname-to-date))))
(print-invoices? #t);;(opt-val gnc:pagename-general optname-invoicelines))
-; (show-txn-table? (opt-val gnc:pagename-display optname-show-txn-table))
+ ;;(show-txn-table? (opt-val gnc:pagename-display optname-show-txn-table))
(show-zero-lines? (opt-val gnc:pagename-display optname-show-zero-lines))
(show-column-expense? (opt-val gnc:pagename-display optname-show-column-expense))
(table-num-columns (if show-column-expense? 5 4))
@@ -332,9 +331,9 @@
(type (opt-val "__reg" "owner-type"))
(reverse? (opt-val "__reg" "reverse?"))
(ownerlist (gncBusinessGetOwnerList
- book
- (gncOwnerTypeToQofIdType type)
- (opt-val gnc:pagename-display optname-show-inactive)))
+ book
+ (gncOwnerTypeToQofIdType type)
+ (opt-val gnc:pagename-display optname-show-inactive)))
(toplevel-income-query (qof-query-create-for-splits))
(toplevel-expense-query (qof-query-create-for-splits))
(toplevel-total-income #f)
@@ -363,28 +362,28 @@
;; also use the amount as the actual grand total (both assigned
;; and not assigned to customers)
(set! toplevel-total-income
- (single-query-split-value toplevel-income-query))
+ (single-query-split-value toplevel-income-query))
(if reverse?
(set! toplevel-total-income (gnc-numeric-neg toplevel-total-income)))
;; Total expenses as well
(query-toplevel-setup toplevel-expense-query expense-accounts start-date end-date)
(set! toplevel-total-expense
- (single-query-split-value toplevel-expense-query))
+ (single-query-split-value toplevel-expense-query))
(if reverse?
(set! toplevel-total-expense (gnc-numeric-neg toplevel-total-expense)))
;; Continue if we have non-null accounts
(if (null? income-accounts)
-
+
;; error condition: no accounts specified
;; is this *really* necessary?? i'd be fine with an all-zero
;; account summary that would, technically, be correct....
- (gnc:html-document-add-object!
+ (gnc:html-document-add-object!
document
- (gnc:html-make-no-account-warning
+ (gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj)))
-
+
;; otherwise, generate the report...
(let ((resulttable
@@ -424,20 +423,11 @@
;; We print the summary now
(let* ((profit (gnc-numeric-add-fixed total-income total-expense))
- (markupfloat (markup-percent profit total-income))
- )
+ (markupfloat (markup-percent profit total-income)))
;; Result of this customer
- (list owner profit markupfloat total-income total-expense)
-
- )
-
- ) ;; END let
- ) ;; END if owner-is-valid
- )
- ownerlist) ;; END for-each all owners
-
- ))
+ (list owner profit markupfloat total-income total-expense)))))
+ ownerlist)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -457,9 +447,11 @@
(total-sales (gnc-numeric-zero))
(total-expense (gnc-numeric-zero))
(heading-list
- (list (_ "Customer") (_ "Profit")
- ;; Translators: "Markup" is profit amount divided by sales amount
- (_ "Markup") (_ "Sales"))))
+ (list (_ "Customer")
+ (_ "Profit")
+ ;; Translators: "Markup" is profit amount divided by sales amount
+ (_ "Markup")
+ (_ "Sales"))))
;; helper for sorting an owner list
(define (owner-name<? a b)
@@ -468,72 +460,65 @@
;; Heading line
(if show-column-expense?
(set! heading-list (append heading-list (list (_ "Expense")))))
- (gnc:html-table-set-col-headers!
- table heading-list)
+ (gnc:html-table-set-col-headers! table heading-list)
;; Sorting: First sort everything alphabetically
;; (ascending) so that we have one stable sorting order
(set! resulttable
- (sort resulttable (lambda (a b) (owner-name<? (car a) (car b)))))
+ (sort resulttable
+ (lambda (a b)
+ (owner-name<? (car a) (car b)))))
;; Secondly sort by the actual sort key
(let ((cmp (if sort-descending? > <))
(strcmp (if sort-descending? string>? string<?)))
- (set!
- resulttable
- (sort resulttable
- (cond
- ((eq? sort-key 'customername)
- (lambda (a b)
- (strcmp (gncOwnerGetName (car a)) (gncOwnerGetName (car b)))))
- ((eq? sort-key 'profit)
- (lambda (a b)
- (cmp (gnc-numeric-compare (cadr a) (cadr b)) 0)))
- ((eq? sort-key 'markup)
- (lambda (a b)
- (cmp (list-ref a 2) (list-ref b 2))))
- ((eq? sort-key 'sales)
- (lambda (a b)
- (cmp (gnc-numeric-compare (list-ref a 3) (list-ref b 3)) 0)))
- ((eq? sort-key 'expense)
- (lambda (a b)
- (cmp (gnc-numeric-compare (list-ref a 4) (list-ref b 4)) 0)))
- ) ;; END cond
- ) ;; END sort
- )) ;; END let
+ (set! resulttable
+ (sort resulttable
+ (cond
+ ((eq? sort-key 'customername)
+ (lambda (a b)
+ (strcmp (gncOwnerGetName (car a)) (gncOwnerGetName (car b)))))
+ ((eq? sort-key 'profit)
+ (lambda (a b)
+ (cmp (gnc-numeric-compare (cadr a) (cadr b)) 0)))
+ ((eq? sort-key 'markup)
+ (lambda (a b)
+ (cmp (list-ref a 2) (list-ref b 2))))
+ ((eq? sort-key 'sales)
+ (lambda (a b)
+ (cmp (gnc-numeric-compare (list-ref a 3) (list-ref b 3)) 0)))
+ ((eq? sort-key 'expense)
+ (lambda (a b)
+ (cmp (gnc-numeric-compare (list-ref a 4) (list-ref b 4)) 0)))))))
;; The actual content
(for-each
(lambda (row)
- (if
- (eq? (length row) 5)
- (let ((owner (list-ref row 0))
- (profit (list-ref row 1))
- (markupfloat (list-ref row 2))
- (sales (list-ref row 3))
- (expense (list-ref row 4)))
- (set! total-profit (gnc-numeric-add-fixed total-profit profit))
- (set! total-sales (gnc-numeric-add-fixed total-sales sales))
- (set! total-expense (gnc-numeric-add-fixed total-expense expense))
- (if (or show-zero-lines?
- (not (and (gnc-numeric-zero-p profit) (gnc-numeric-zero-p sales))))
- (let ((row-content
- (list
- (gncOwnerGetName owner)
- (gnc:make-gnc-monetary currency profit)
- ;;(format #f (if (< (abs markupfloat) 10) "~2.1f%%" "%2.0f%%") markupfloat)
- (format #f "~2,0f%" markupfloat)
- (gnc:make-gnc-monetary currency sales))))
- (if show-column-expense?
- (set!
- row-content
- (append row-content
- (list
- (gnc:make-gnc-monetary currency (gnc-numeric-neg expense))))))
- (gnc:html-table-append-row!
- table row-content)))
- )
- (gnc:warn "Oops, encountered a row with wrong length=" (length row))))
+ (if (eq? (length row) 5)
+ (let ((owner (list-ref row 0))
+ (profit (list-ref row 1))
+ (markupfloat (list-ref row 2))
+ (sales (list-ref row 3))
+ (expense (list-ref row 4)))
+ (set! total-profit (gnc-numeric-add-fixed total-profit profit))
+ (set! total-sales (gnc-numeric-add-fixed total-sales sales))
+ (set! total-expense (gnc-numeric-add-fixed total-expense expense))
+ (if (or show-zero-lines?
+ (not (and (gnc-numeric-zero-p profit) (gnc-numeric-zero-p sales))))
+ (let ((row-content (list
+ (gncOwnerGetName owner)
+ (gnc:make-gnc-monetary currency profit)
+ ;;(format #f (if (< (abs markupfloat) 10) "~2.1f%%" "%2.0f%%") markupfloat)
+ (format #f "~2,0f%" markupfloat)
+ (gnc:make-gnc-monetary currency sales))))
+ (if show-column-expense?
+ (set! row-content
+ (append row-content
+ (list
+ (gnc:make-gnc-monetary currency (gnc-numeric-neg expense))))))
+ (gnc:html-table-append-row!
+ table row-content))))
+ (gnc:warn "Oops, encountered a row with wrong length=" (length row))))
resulttable) ;; END for-each row
;; The "No Customer" line
@@ -548,11 +533,10 @@
(format #f "~2,0f%" markupfloat)
(gnc:make-gnc-monetary currency other-sales))))
(if show-column-expense?
- (set!
- row-content
- (append row-content
- (list
- (gnc:make-gnc-monetary currency (gnc-numeric-neg other-expense))))))
+ (set! row-content
+ (append row-content
+ (list
+ (gnc:make-gnc-monetary currency (gnc-numeric-neg other-expense))))))
(if (or show-zero-lines?
(not (and (gnc-numeric-zero-p other-profit) (gnc-numeric-zero-p other-sales))))
@@ -576,18 +560,15 @@
(list
(_ "Total")
(gnc:make-gnc-monetary currency total-profit)
- ;;(format #f (if (< (abs markupfloat) 10) "~2,1f%" "~2,0f%") markupfloat)
(format #f "~2,0f%" markupfloat)
(gnc:make-gnc-monetary currency toplevel-total-income))))
(if show-column-expense?
- (set!
- row-content
- (append row-content
- (list
- (gnc:make-gnc-monetary currency (gnc-numeric-neg toplevel-total-expense))))))
+ (set! row-content
+ (append row-content
+ (list
+ (gnc:make-gnc-monetary currency (gnc-numeric-neg toplevel-total-expense))))))
(gnc:html-table-append-row!
- table
- row-content))
+ table row-content))
;; Set the formatting styles
(gnc:html-table-set-style!
@@ -607,31 +588,21 @@
;; And add the table to the document
(gnc:html-document-add-object!
- document table)
- )
-
- ) ;; END let resulttable
-
- ) ;; END if null? income-accounts
+ document table))))
(if any-valid-owner?
;; Report contains valid data
- (let ((headline
- (format
- #f (_ "~a ~a - ~a")
- report-title
- (qof-print-date start-date)
- (qof-print-date end-date))))
- (gnc:html-document-set-title!
- document headline)
+ (let ((headline (format #f (_ "~a ~a - ~a")
+ report-title
+ (qof-print-date start-date)
+ (qof-print-date end-date))))
+ (gnc:html-document-set-title! document headline)
;; Check the settings for taking invoice/payment lines into
;; account and print the ch
(make-break! document)
(gnc:html-document-add-object!
- document
- (gnc:make-html-text notification-str))
- )
+ document (gnc:make-html-text notification-str)))
;; else....
(gnc:html-document-add-object!
commit cc4944e536fff07258aec299bc80785829b74c12
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jun 28 10:59:50 2019 +0800
[html-table] fix never-used function and deprecate
diff --git a/gnucash/report/report-system/html-table.scm b/gnucash/report/report-system/html-table.scm
index 357881b6d..7d6d5c762 100644
--- a/gnucash/report/report-system/html-table.scm
+++ b/gnucash/report/report-system/html-table.scm
@@ -569,11 +569,13 @@
(cons
(cons (cons current-new current-existing) (car rest-result))
(cdr rest-result)))))
+ (issue-deprecation-warning "gnc:html-table-prepend-column! is unused.")
(let* ((existing-data (reverse (gnc:html-table-data table)))
(existing-length (length existing-data))
(newcol-length (length newcol)))
(if (<= newcol-length existing-length)
- (gnc:html-table-set-data!
+ (gnc:html-table-set-data!
+ table
(reverse (car (prepend-to-element
newcol
existing-data
commit a23d72dec264883250a556a0652cb779aa18962f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jun 28 10:01:48 2019 +0800
[owner-report] timepair->time64
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 29872bc11..0c466af4b 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -242,7 +242,7 @@
(let* ((bal (gnc-lot-get-balance lot))
(invoice (gncInvoiceGetInvoiceFromLot lot))
(date (if (eq? date-type 'postdate)
- (gncInvoiceGetDatePostedTT invoice)
+ (gncInvoiceGetDatePosted invoice)
(gncInvoiceGetDateDue invoice)))
)
commit b4409ed6c8de675ed6cf861267d3edc1287886ea
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jun 26 05:39:44 2019 +0800
[owner-report] upgrade find-first-account to seek currency as well
* this is an optional upgrade -- (find-first-account type) will find
the first account of appropriate type; (find-first-account type
#:currency curr) will filter to appropriate currency too
diff --git a/gnucash/report/business-reports/business-reports.scm b/gnucash/report/business-reports/business-reports.scm
index ffc54ee97..9c331ee57 100644
--- a/gnucash/report/business-reports/business-reports.scm
+++ b/gnucash/report/business-reports/business-reports.scm
@@ -28,6 +28,7 @@
(use-modules (gnucash app-utils))
(use-modules (gnucash report report-system))
(use-modules (gnucash report standard-reports))
+(use-modules (srfi srfi-8))
;; to define gnc-build-url
(gnc:module-load "gnucash/html" 0)
@@ -126,10 +127,10 @@
(define (gnc:receivables-report-create account title show-zeros?)
(receivables-report-create-internal account title show-zeros?))
-(define (gnc:owner-report-create owner account)
+(define* (gnc:owner-report-create owner account #:key currency)
; Figure out an account to use if nothing exists here.
(if (null? account)
- (set! account (find-first-account-for-owner owner)))
+ (set! account (find-first-account-for-owner owner #:currency currency)))
(owner-report-create owner account))
(export gnc:invoice-report-create
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 8c4284e44..29872bc11 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -28,6 +28,7 @@
(define-module (gnucash report owner-report))
(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-8))
(use-modules (gnucash gnc-module))
(use-modules (gnucash utilities)) ; for gnc:debug
(use-modules (gnucash gettext))
@@ -818,36 +819,30 @@
(qof-query-destroy query)))))
document))
-(define (find-first-account type)
- (define (find-first account num index)
- (if (>= index num)
- '()
- (let* ((this-child (gnc-account-nth-child account index))
- (account-type (xaccAccountGetType this-child)))
- (if (eq? account-type type)
- this-child
- (find-first account num (+ index 1))))))
-
- (let* ((current-root (gnc-get-current-root-account))
- (num-accounts (gnc-account-n-children current-root)))
- (if (> num-accounts 0)
- (find-first current-root num-accounts 0)
- '())))
-
-(define (find-first-account-for-owner owner)
+(define* (find-first-account type #:key currency)
+ (or (find
+ (lambda (acc)
+ (and (eqv? type (xaccAccountGetType acc))
+ (or (not currency)
+ (gnc-commodity-equiv currency (xaccAccountGetCommodity acc)))))
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
+ '()))
+
+(define* (find-first-account-for-owner owner #:key currency)
(let ((type (gncOwnerGetType (gncOwnerGetEndOwner owner))))
(cond
((eqv? type GNC-OWNER-CUSTOMER)
- (find-first-account ACCT-TYPE-RECEIVABLE))
+ (find-first-account ACCT-TYPE-RECEIVABLE #:currency currency))
((eqv? type GNC-OWNER-VENDOR)
- (find-first-account ACCT-TYPE-PAYABLE))
+ (find-first-account ACCT-TYPE-PAYABLE #:currency currency))
((eqv? type GNC-OWNER-EMPLOYEE)
- (find-first-account ACCT-TYPE-PAYABLE))
+ (find-first-account ACCT-TYPE-PAYABLE #:currency currency))
((eqv? type GNC-OWNER-JOB)
- (find-first-account-for-owner (gncOwnerGetEndOwner owner)))
+ (find-first-account-for-owner (gncOwnerGetEndOwner owner)
+ #:currency currency))
(else
'()))))
commit 551a346cb1d207c92bf6621f7b67808bf8f9662a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Jun 26 22:25:01 2019 +0800
[report-utilities] improve commodity-collector documentation
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index e37ce42e2..a77bc0b3d 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -264,6 +264,8 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;;
;; New Example: But now USD is a <gnc:commodity*> and 123.4 a
;; <gnc:numeric>, so there is no simple example anymore.
+;
+;; Note amounts are rounded to the commodity's SCU.
;;
;; The functions:
;; 'add <commodity> <amount>: Add the given amount to the
@@ -283,36 +285,33 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; (even the fact that any commodity showed up at all).
;; 'getpair <commodity> signreverse?: Returns the two-element-list
;; with the <commodity> and its corresponding balance. If
-;; <commodity> doesn't exist, the balance will be
-;; (gnc-numeric-zero). If signreverse? is true, the result's
-;; sign will be reversed.
-;; (internal) 'list #f #f: get the association list of
-;; commodity->numeric-collector
+;; <commodity> doesn't exist, the balance will be 0. If
+;; signreverse? is true, the result's sign will be reversed.
+;; 'getmonetary <commodity> signreverse?: Returns a gnc-monetary
+;; of the <commodity> and its corresponding balance. If
+;; <commodity> doesn't exist, the balance will be 0. If
+;; signreverse? is true, the result's sign will be reversed.
+;; (internal) 'list #f #f: get the list of
+;; (cons commodity numeric-collector)
(define (gnc:make-commodity-collector)
- (let
- ;; the association list of (commodity -> value-collector) pairs.
- ((commoditylist '()))
+ ;; the association list of (commodity . value-collector) pairs.
+ (let ((commoditylist '()))
- ;; helper function to add a commodity->value pair to our list.
+ ;; helper function to add a (commodity . value) pair to our list.
;; If no pair with this commodity exists, we will create one.
(define (add-commodity-value commodity value)
- ;; lookup the corresponding pair
(let ((pair (assoc commodity commoditylist))
(rvalue (gnc-numeric-convert
value
(gnc-commodity-get-fraction commodity) GNC-RND-ROUND)))
- (if (not pair)
- (begin
- ;; create a new pair, using the gnc:value-collector
- (set! pair (list commodity (gnc:make-value-collector)))
- ;; and add it to the alist
- (set! commoditylist (cons pair commoditylist))))
- ;; add the value
+ (unless pair
+ (set! pair (list commodity (gnc:make-value-collector)))
+ (set! commoditylist (cons pair commoditylist)))
((cadr pair) 'add rvalue)))
;; helper function to walk an association list, adding each
- ;; (commodity -> collector) pair to our list at the appropriate
+ ;; (commodity . collector) pair to our list at the appropriate
;; place
(define (add-commodity-clist clist)
(cond ((null? clist) '())
@@ -331,25 +330,24 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; helper function walk the association list doing a callback on
;; each key-value pair.
(define (process-commodity-list fn clist)
- (map
- (lambda (pair) (fn (car pair)
- ((cadr pair) 'total #f)))
+ (map
+ (lambda (pair)
+ (fn (car pair) ((cadr pair) 'total #f)))
clist))
- ;; helper function which is given a commodity and returns, if
- ;; existing, a list (gnc:commodity gnc:numeric).
+ ;; helper function which is given a commodity and returns a list
+ ;; (list gnc:commodity number).
(define (getpair c sign?)
(let* ((pair (assoc c commoditylist))
- (total (and pair ((cadr pair) 'total #f))))
- (list c (if pair (if sign? (- total) total) 0))))
+ (total (if pair ((cadr pair) 'total #f) 0)))
+ (list c (if sign? (- total) total))))
- ;; helper function which is given a commodity and returns, if
- ;; existing, a <gnc:monetary> value.
+ ;; helper function which is given a commodity and returns a
+ ;; <gnc:monetary> value, whose amount may be 0.
(define (getmonetary c sign?)
(let* ((pair (assoc c commoditylist))
- (total (and pair ((cadr pair) 'total #f))))
- (gnc:make-gnc-monetary
- c (if pair (if sign? (- total) total) 0))))
+ (total (if pair ((cadr pair) 'total #f) 0)))
+ (gnc:make-gnc-monetary c (if sign? (- total) total))))
;; Dispatch function
(lambda (action commodity amount)
@@ -380,9 +378,7 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; Returns zero if all entries in this collector are zero.
(define (gnc-commodity-collector-allzero? collector)
- (every zero?
- (map gnc:gnc-monetary-amount
- (collector 'format gnc:make-gnc-monetary #f))))
+ (every zero? (map cdr (collector 'format cons #f))))
;; add any number of gnc-monetary objects into a commodity-collector
;; usage: (gnc:monetaries-add monetary1 monetary2 ...)
Summary of changes:
.../report/business-reports/business-reports.scm | 5 +-
.../report/business-reports/customer-summary.scm | 728 +++++++++------------
gnucash/report/business-reports/owner-report.scm | 39 +-
gnucash/report/report-system/html-table.scm | 4 +-
gnucash/report/report-system/report-utilities.scm | 62 +-
5 files changed, 351 insertions(+), 487 deletions(-)
More information about the gnucash-changes
mailing list