gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Fri Mar 8 08:03:00 EST 2019
Updated via https://github.com/Gnucash/gnucash/commit/863303b1 (commit)
via https://github.com/Gnucash/gnucash/commit/4f333ee1 (commit)
via https://github.com/Gnucash/gnucash/commit/414992f8 (commit)
via https://github.com/Gnucash/gnucash/commit/edd87fa4 (commit)
via https://github.com/Gnucash/gnucash/commit/c7f7f078 (commit)
via https://github.com/Gnucash/gnucash/commit/7d508b77 (commit)
via https://github.com/Gnucash/gnucash/commit/beb6e508 (commit)
via https://github.com/Gnucash/gnucash/commit/9dd139f3 (commit)
from https://github.com/Gnucash/gnucash/commit/b795773e (commit)
commit 863303b1720d79a9809db4650d18c1c62660274b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 24 14:18:25 2018 +0800
[test-commodity-utils] upgrade to test DMLR prices
This commit adds:
* checking and capgains account in old DEM currency
* buy & sell DEM/DMLR transactions in DEM with capgains
* and tests prices in EUR currency
This aims to test the old intra-euro currency conversion in the
totalavg and inst price calculators.
diff --git a/gnucash/report/report-system/test/test-commodity-utils.scm b/gnucash/report/report-system/test/test-commodity-utils.scm
index 8d59112d8..6c61bab2a 100644
--- a/gnucash/report/report-system/test/test-commodity-utils.scm
+++ b/gnucash/report/report-system/test/test-commodity-utils.scm
@@ -53,6 +53,7 @@
(list "Assets"(list (cons 'type ACCT-TYPE-ASSET))
(list "Current"
(list "Savings" (list (cons 'type ACCT-TYPE-BANK)))
+ (list "Checking-DEM" (list (cons 'type ACCT-TYPE-BANK)))
(list "Checking" (list (cons 'type ACCT-TYPE-BANK))))
(list "Investment"
(list "Broker A"
@@ -61,6 +62,7 @@
(list "AAPL-A")
(list "IBM-A")
(list "MSFT-A")
+ (list "DMLR-A")
(list "TSLA-A")))
(list "Broker B"
(list "Cash-B" (list (cons 'type ACCT-TYPE-BANK)))
@@ -74,6 +76,7 @@
(list "Stocks" (list (cons 'type ACCT-TYPE-STOCK))
(list "RDSA")))))
(list "Income" (list (cons 'type ACCT-TYPE-INCOME))
+ (list "Capital Gains-DEM")
(list "Capital Gains"))
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
(list "Liability" (list (cons 'type ACCT-TYPE-LIABILITY)))
@@ -93,22 +96,26 @@
;; Yeah, this is fake, it's for testing DEM->EUR conversions.
(DMLR (gnc-commodity-new book "Daimler Motors" "FSE" "DMLR" "" 1))
(EUR (gnc-commodity-table-lookup comm-table "CURRENCY" "EUR"))
+ (DEM (gnc-commodity-table-lookup comm-table "CURRENCY" "DEM"))
(GBP (gnc-commodity-table-lookup comm-table "CURRENCY" "GBP"))
(USD (gnc-commodity-table-lookup comm-table "CURRENCY" "USD"))
(account-alist (env-create-account-structure-alist env test-accounts))
(checking (cdr (assoc "Checking" account-alist)))
+ (checking-dem (cdr (assoc "Checking-DEM" account-alist)))
(saving (cdr (assoc "Savings" account-alist)))
(cash-a (cdr (assoc "Cash-A" account-alist)))
(aapl-a (cdr (assoc "AAPL-A" account-alist)))
(ibm-a (cdr (assoc "IBM-A" account-alist)))
(msft-a (cdr (assoc "MSFT-A" account-alist)))
(tsla-a (cdr (assoc "TSLA-A" account-alist)))
+ (dmlr-a (cdr (assoc "DMLR-A" account-alist)))
(cash-b (cdr (assoc "Cash-B" account-alist)))
(aapl-b (cdr (assoc "AAPL-B" account-alist)))
(ibm-b (cdr (assoc "IBM-B" account-alist)))
(msft-b (cdr (assoc "MSFT-B" account-alist)))
(tsla-b (cdr (assoc "TSLA-B" account-alist)))
(capgain (cdr (assoc "Capital Gains" account-alist)))
+ (capgain-dem (cdr (assoc "Capital Gains-DEM" account-alist)))
(openbal (cdr (assoc "Opening Balances" account-alist))))
;; Set account commodities
(gnc-commodity-table-insert comm-table AAPL)
@@ -116,10 +123,14 @@
(gnc-commodity-table-insert comm-table IBM)
(gnc-commodity-table-insert comm-table RDSA)
(gnc-commodity-table-insert comm-table TSLA)
+ (gnc-commodity-table-insert comm-table DMLR)
+ (xaccAccountSetCommodity checking-dem DEM)
+ (xaccAccountSetCommodity capgain-dem DEM)
(xaccAccountSetCommodity aapl-a AAPL)
(xaccAccountSetCommodity ibm-a IBM)
(xaccAccountSetCommodity msft-a MSFT)
(xaccAccountSetCommodity tsla-a TSLA)
+ (xaccAccountSetCommodity dmlr-a DMLR)
(xaccAccountSetCommodity aapl-b AAPL)
(xaccAccountSetCommodity ibm-b IBM)
(xaccAccountSetCommodity msft-b MSFT)
@@ -135,6 +146,12 @@
#:description "Buy IBM 200") ;;200 @ $179.16
(env-transfer-foreign env 15 01 2012 cash-a msft-a 4216500/100 1500
#:description "Buy MSFT 1500") ;;1500 @ $28.11
+ (env-transfer-foreign env 20 01 2012 checking-dem dmlr-a 1500 80
+ #:description "Buy DMLR 80") ;;80 @ DM1500.00
+ (env-transfer-foreign env 20 02 2012 checking-dem dmlr-a -1610 80
+ #:description "Sell DMLR 80") ;;80 @ DM1610.00
+ (env-transfer-foreign env 20 02 2012 capgain-dem dmlr-a 110 0
+ #:description "DMLR 80 G/L") ;;80 @ DM1610.00
(env-transfer-foreign env 9 8 2013 cash-a aapl-a 3684000/100 600
#:description "Buy AAPL 600") ;;600 @ $61.40
(env-transfer-foreign env 5 12 2014 cash-a msft-a -2421000/100 -500
@@ -550,7 +567,24 @@
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))
(cadr (assoc (gnc-dmy2time64-neutral 11 3 2016)
report-list))))
- (test-end "Microsoft-USD"))
+ (test-end "Microsoft-USD")
+
+ (test-begin "Daimler-DEM")
+ (let* ((curraccts (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account)))
+ (report-list
+ (gnc:get-commodity-totalavg-prices curraccts
+ (gnc-dmy2time64 4 7 2016)
+ DMLR EUR)))
+ (test-equal "DMLR totalavg 2012-01-20"
+ 38347/4000
+ (cadr (assoc (gnc-dmy2time64-neutral 20 01 2012)
+ report-list)))
+ (test-equal "DMLR totalavg 2012-02-20"
+ 39753/4000
+ (cadr (assoc (gnc-dmy2time64-neutral 20 02 2012)
+ report-list))))
+ (test-end "Daimler-DEM"))
(teardown)))
(define (test-get-commodity-inst-prices)
@@ -586,5 +620,22 @@
(test-equal "MSFT inst 2016-03-11" (/ 4776300/100 900)
(cadr (assoc (gnc-dmy2time64-neutral 11 3 2016)
report-list))))
- (test-end "Microsoft-USD"))
+ (test-end "Microsoft-USD")
+
+ (test-begin "Daimler-DEM")
+ (let* ((curraccts (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account)))
+ (report-list
+ (gnc:get-commodity-inst-prices curraccts
+ (gnc-dmy2time64 4 7 2016)
+ DMLR EUR)))
+ (test-equal "DMLR inst 2012-01-20"
+ 38347/4000
+ (cadr (assoc (gnc-dmy2time64-neutral 20 01 2012)
+ report-list)))
+ (test-equal "DMLR inst 2012-02-20"
+ 41159/4000
+ (cadr (assoc (gnc-dmy2time64-neutral 20 02 2012)
+ report-list))))
+ (test-end "Daimler-DEM"))
(teardown)))
commit 4f333ee13c1106a209d70f7c1387de69dbbe5b95
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Mar 7 22:25:04 2019 +0800
[budget-flow] don't write raw html
diff --git a/gnucash/report/standard-reports/budget-flow.scm b/gnucash/report/standard-reports/budget-flow.scm
index e1da0c713..1b496fdb1 100644
--- a/gnucash/report/standard-reports/budget-flow.scm
+++ b/gnucash/report/standard-reports/budget-flow.scm
@@ -169,8 +169,11 @@
(string-append (_ "Total") ":")
bgt-total-numeric act-total-numeric)
- ;; Display hr FIXME: kind of a hack
- (gnc:html-table-append-row! html-table "<tr><td colspan='3'><hr></td></tr>")
+ (gnc:html-table-append-row!
+ html-table
+ (list
+ (gnc:make-html-table-cell/size
+ 1 3 (gnc:make-html-text (gnc:html-markup-hr)))))
;; Return (list budgeted-total actual-total)
(list bgt-total-numeric act-total-numeric))))
commit 414992f8ec6cb11a303b0c38a35b2b179192a344
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Mar 7 22:00:38 2019 +0800
[budget-flow] *reindent/delete-trailing-whitespace/untabify*
diff --git a/gnucash/report/standard-reports/budget-flow.scm b/gnucash/report/standard-reports/budget-flow.scm
index d15b81e64..e1da0c713 100644
--- a/gnucash/report/standard-reports/budget-flow.scm
+++ b/gnucash/report/standard-reports/budget-flow.scm
@@ -26,7 +26,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report standard-reports budget-flow))
-(use-modules (gnucash utilities))
+(use-modules (gnucash utilities))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -51,130 +51,129 @@
;; Option to select Budget
(gnc:register-option
- options
- (gnc:make-budget-option
- gnc:pagename-general optname-budget
- "a" (N_ "Budget to use.")))
+ options
+ (gnc:make-budget-option
+ gnc:pagename-general optname-budget
+ "a" (N_ "Budget to use.")))
;; Option to select Period of selected Budget
(gnc:register-option
- options
- (gnc:make-number-range-option
- gnc:pagename-general optname-periods
- ;; FIXME: It would be nice if the max number of budget periods (60) was
- ;; defined globally somewhere so we could reference it here. However, it
- ;; only appears to be defined currently in
- ;; src/gnome/gtkbuilder/gnc-plugin-page-budget.glade.
- ;; FIXME: It would be even nicer if the max number of budget
- ;; periods was determined by the number of periods in the
- ;; currently selected budget
- "b" (N_ "Period number.") 1 1 60 0 1))
+ options
+ (gnc:make-number-range-option
+ gnc:pagename-general optname-periods
+ ;; FIXME: It would be nice if the max number of budget periods (60) was
+ ;; defined globally somewhere so we could reference it here. However, it
+ ;; only appears to be defined currently in
+ ;; src/gnome/gtkbuilder/gnc-plugin-page-budget.glade.
+ ;; FIXME: It would be even nicer if the max number of budget
+ ;; periods was determined by the number of periods in the
+ ;; currently selected budget
+ "b" (N_ "Period number.") 1 1 60 0 1))
;; Option to select the currency the report will be shown in
(gnc:options-add-currency!
- options gnc:pagename-general
- optname-report-currency "d")
+ options gnc:pagename-general
+ optname-report-currency "d")
;; Option to select the price source used in currency conversion
(gnc:options-add-price-source!
- options gnc:pagename-general optname-price-source "c" 'pricedb-latest)
+ options gnc:pagename-general optname-price-source "c" 'pricedb-latest)
;;Option to select the accounts to that will be displayed
- (gnc:register-option
- options
- (gnc:make-account-list-option
- gnc:pagename-accounts optname-accounts
- (string-append "a" "c")
- (N_ "Report on these accounts.")
- (lambda ()
- (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
- #f #t))
-
+ (gnc:register-option
+ options
+ (gnc:make-account-list-option
+ gnc:pagename-accounts optname-accounts
+ (string-append "a" "c")
+ (N_ "Report on these accounts.")
+ (lambda ()
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
+ #f #t))
+
;; Set the general page as default option tab
(gnc:options-set-default-section options gnc:pagename-general)
- options
-))
-
+ options))
;; Append a row to html-table with markup and values
-(define (gnc:html-table-add-budget-row!
- html-table markup text total1 total2)
+(define (gnc:html-table-add-budget-row!
+ html-table markup text total1 total2)
;; Cell order is text, budgeted, actual
- (gnc:html-table-append-row/markup! html-table "normal-row"
- (list
- (gnc:make-html-table-cell/markup "text-cell" text)
- (gnc:make-html-table-cell/markup markup total1)
- (gnc:make-html-table-cell/markup markup total2)
-
-)))
+ (gnc:html-table-append-row/markup!
+ html-table "normal-row"
+ (list
+ (gnc:make-html-table-cell/markup "text-cell" text)
+ (gnc:make-html-table-cell/markup markup total1)
+ (gnc:make-html-table-cell/markup markup total2))))
;; For each account in acct-table:
;; Retrieve the budgeted and actual amount
;; Display the row
-;;
+;;
;; Display the grand total for acct-table
;;
;; Return: (list budgeted-grand-total actual-grand-total)
;;
(define (gnc:html-table-add-budget-accounts!
- html-table acct-table budget period exchange-fn report-currency)
+ html-table acct-table budget period exchange-fn report-currency)
- (let* (
- ;; Used to sum up the budgeted and actual totals
- (bgt-total (gnc:make-commodity-collector))
- (act-total (gnc:make-commodity-collector))
- )
+ ;; Used to sum up the budgeted and actual totals
+ (let* ((bgt-total (gnc:make-commodity-collector))
+ (act-total (gnc:make-commodity-collector)))
;; Loop though each account
;;
;; FIXME: because gnc:budget-get-account-period-actual-value
- ;; sums the total for a parent and all child accounts displaying
+ ;; sums the total for a parent and all child accounts displaying
;; and summing a parent account cause the totals to be off.
;; so we do not display parent accounts
;;
- (for-each (lambda (acct)
-
- ;; If acct has children do nto display (see above)
- (if (null? (gnc-account-get-children acct))
- (let* (
- ;; Retrieve the budgeted and actual amount and convert to <gnc:monetary>
- (comm (xaccAccountGetCommodity acct))
- (bgt-numeric (gnc-budget-get-account-period-value budget acct (- period 1)))
- (bgt-monetary (gnc:make-gnc-monetary comm bgt-numeric))
- (act-numeric (gnc-budget-get-account-period-actual-value budget acct (- period 1)))
- (act-monetary (gnc:make-gnc-monetary comm act-numeric))
- )
-
- ;; Add amounts to collectors
- (bgt-total 'add comm bgt-numeric)
- (act-total 'add comm act-numeric)
-
- ;; Display row
- (gnc:html-table-add-budget-row! html-table "number-cell"
- (gnc:make-html-text (gnc:html-markup-anchor (gnc:account-anchor-text acct) (gnc-account-get-full-name acct)))
+ (for-each
+ (lambda (acct)
+ ;; If acct has children do nto display (see above)
+ (if (null? (gnc-account-get-children acct))
+ ;; Retrieve the budgeted and actual amount and
+ ;; convert to <gnc:monetary>
+ (let* ((comm (xaccAccountGetCommodity acct))
+ (bgt-numeric (gnc-budget-get-account-period-value
+ budget acct (1- period)))
+ (bgt-monetary (gnc:make-gnc-monetary comm bgt-numeric))
+ (act-numeric (gnc-budget-get-account-period-actual-value
+ budget acct (1- period)))
+ (act-monetary (gnc:make-gnc-monetary comm act-numeric)))
+
+ ;; Add amounts to collectors
+ (bgt-total 'add comm bgt-numeric)
+ (act-total 'add comm act-numeric)
+
+ ;; Display row
+ (gnc:html-table-add-budget-row!
+ html-table "number-cell"
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc:account-anchor-text acct)
+ (gnc-account-get-full-name acct)))
bgt-monetary
- act-monetary
- ))))
+ act-monetary))))
- acct-table
- )
+ acct-table)
;; Total collectors and display
- (let* (
- (bgt-total-numeric (gnc:sum-collector-commodity bgt-total report-currency exchange-fn))
- (act-total-numeric (gnc:sum-collector-commodity act-total report-currency exchange-fn))
- )
- (gnc:html-table-add-budget-row! html-table "total-number-cell" (string-append (_ "Total") ":") bgt-total-numeric act-total-numeric)
-
+ (let* ((bgt-total-numeric
+ (gnc:sum-collector-commodity bgt-total report-currency exchange-fn))
+ (act-total-numeric
+ (gnc:sum-collector-commodity act-total report-currency exchange-fn)))
+ (gnc:html-table-add-budget-row!
+ html-table "total-number-cell"
+ (string-append (_ "Total") ":")
+ bgt-total-numeric act-total-numeric)
+
;; Display hr FIXME: kind of a hack
(gnc:html-table-append-row! html-table "<tr><td colspan='3'><hr></td></tr>")
-
- ;; Return (list budgeted-total actual-total)
- (list bgt-total-numeric act-total-numeric)
-))) ;; end of define
+ ;; Return (list budgeted-total actual-total)
+ (list bgt-total-numeric act-total-numeric))))
;; Displays account types
;;
@@ -183,75 +182,67 @@
;; Return: a assoc list of (type (budgeted-grand-total actual-grand-total))
;;
(define (gnc:html-table-add-budget-types!
- html-table acct-table budget period exchange-fn report-currency)
-
- ;;Account totals is the assoc list that is returned
+ html-table acct-table budget period exchange-fn report-currency)
+ ;;Account totals is the assoc list that is returned
(let* ((accounts-totals '()))
-
;;Display each account type
- (for-each (lambda (pair)
-
- ;; key - type
- ;; value - list of accounts
- (let* ((key (car pair)) (value (cdr pair)))
-
- ;; Display and add totals
- (set! accounts-totals (assoc-set! accounts-totals key
- (gnc:html-table-add-budget-accounts! html-table value budget period exchange-fn report-currency)
- ))
- ))
-
- acct-table
- )
-
+ (for-each
+ (lambda (pair)
+ ;; key - type
+ ;; value - list of accounts
+ (let* ((key (car pair)) (value (cdr pair)))
+ ;; Display and add totals
+ (set! accounts-totals
+ (assoc-set!
+ accounts-totals key
+ (gnc:html-table-add-budget-accounts!
+ html-table value budget period exchange-fn report-currency)))))
+ acct-table)
;; Reutrn assoc list
- accounts-totals
-))
+ accounts-totals))
;; Displays type-totals
;;
;; type-totals: a list of (type (budget-total actual-total))
;;
(define (gnc:html-table-add-budget-totals!
- html-table type-totals exchange-fn report-currency)
-
- (let* (
- ;; Collector of grand totals
- (bgt-total-collector (gnc:make-commodity-collector))
- (act-total-collector (gnc:make-commodity-collector))
- )
-
- ;; Loop though each pair
- (for-each (lambda (pair)
- (let* (
- ;; tuple is (type (budgeted actual))
- (key (car pair))
- (value (cdr pair))
- (bgt-total (car value))
- (act-total (cadr value))
- )
-
- ;; Add to collectors
- (bgt-total-collector 'add (gnc:gnc-monetary-commodity bgt-total) (gnc:gnc-monetary-amount bgt-total))
- (act-total-collector 'add (gnc:gnc-monetary-commodity act-total) (gnc:gnc-monetary-amount act-total))
-
- ;; Display row
- (gnc:html-table-add-budget-row! html-table "number-cell" (gnc:account-get-type-string-plural key) bgt-total act-total)
- ))
-
- type-totals
- )
- (let* (
- ;; Sum collectors
- (bgt-total-numeric (gnc:sum-collector-commodity bgt-total-collector report-currency exchange-fn))
- (act-total-numeric (gnc:sum-collector-commodity act-total-collector report-currency exchange-fn))
- )
+ html-table type-totals exchange-fn report-currency)
- ;; Display Grand Total
- (gnc:html-table-add-budget-row! html-table "total-number-cell" (string-append (_ "Total") ":") bgt-total-numeric act-total-numeric)
-
-)))
+ ;; Collector of grand totals
+ (let* ((bgt-total-collector (gnc:make-commodity-collector))
+ (act-total-collector (gnc:make-commodity-collector)))
+ ;; Loop though each pair
+ (for-each
+ (lambda (pair)
+ ;; tuple is (type (budgeted actual))
+ (let* ((key (car pair))
+ (value (cdr pair))
+ (bgt-total (car value))
+ (act-total (cadr value)))
+
+ ;; Add to collectors
+ (bgt-total-collector 'add
+ (gnc:gnc-monetary-commodity bgt-total)
+ (gnc:gnc-monetary-amount bgt-total))
+ (act-total-collector 'add (gnc:gnc-monetary-commodity act-total)
+ (gnc:gnc-monetary-amount act-total))
+ ;; Display row
+ (gnc:html-table-add-budget-row!
+ html-table "number-cell"
+ (gnc:account-get-type-string-plural key) bgt-total act-total)))
+ type-totals)
+ ;; Sum collectors
+ (let* ((bgt-total-numeric
+ (gnc:sum-collector-commodity
+ bgt-total-collector report-currency exchange-fn))
+ (act-total-numeric
+ (gnc:sum-collector-commodity
+ act-total-collector report-currency exchange-fn)))
+ ;; Display Grand Total
+ (gnc:html-table-add-budget-row!
+ html-table "total-number-cell"
+ (string-append (_ "Total") ":") bgt-total-numeric act-total-numeric))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-renderer
@@ -263,69 +254,66 @@
;; Helper function retrieves options
(define (get-option pagename optname)
(gnc:option-value
- (gnc:lookup-option
- (gnc:report-options report-obj) pagename optname)))
+ (gnc:lookup-option
+ (gnc:report-options report-obj) pagename optname)))
;; Update progress bar
(gnc:report-starting reportname)
;; get all option's values
- (let* (
- (budget (get-option gnc:pagename-general optname-budget))
- (budget-valid? (and budget (not (null? budget))))
- (accounts (get-option gnc:pagename-accounts optname-accounts))
- (period (inexact->exact (get-option gnc:pagename-general
- optname-periods)))
- (report-currency (get-option gnc:pagename-general
- optname-report-currency))
- (price-source (get-option gnc:pagename-general
- optname-price-source))
-
- ;; calculate the exchange rates
- (exchange-fn (gnc:case-exchange-fn
- price-source report-currency #f))
-
- ;; The HTML document
- (doc (gnc:make-html-document))
- )
+ (let* ((budget (get-option gnc:pagename-general optname-budget))
+ (budget-valid? (and budget (not (null? budget))))
+ (accounts (get-option gnc:pagename-accounts optname-accounts))
+ (period (inexact->exact (get-option gnc:pagename-general
+ optname-periods)))
+ (report-currency (get-option gnc:pagename-general
+ optname-report-currency))
+ (price-source (get-option gnc:pagename-general
+ optname-price-source))
+
+ ;; calculate the exchange rates
+ (exchange-fn (gnc:case-exchange-fn
+ price-source report-currency #f))
+
+ ;; The HTML document
+ (doc (gnc:make-html-document)))
(cond
- ((null? accounts)
- ;; No accounts selected
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-no-account-warning
- reportname (gnc:report-id report-obj))))
-
- ((not budget-valid?)
- ;; No budget selected.
- (gnc:html-document-add-object!
- doc (gnc:html-make-generic-budget-warning reportname)))
-
- (else (begin
- (let* (
- (html-table (gnc:make-html-table))
- (report-name (get-option gnc:pagename-general
- gnc:optname-reportname))
-
- ;; decompose the account list
- (split-up-accounts (gnc:decompose-accountlist accounts))
- (accounts-totals '())
-
- )
+ ((null? accounts)
+ ;; No accounts selected
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-no-account-warning
+ reportname (gnc:report-id report-obj))))
+
+ ((not budget-valid?)
+ ;; No budget selected.
+ (gnc:html-document-add-object!
+ doc (gnc:html-make-generic-budget-warning reportname)))
+
+ (else
+ (let* ((html-table (gnc:make-html-table))
+ (report-name (get-option gnc:pagename-general gnc:optname-reportname))
+ ;; decompose the account list
+ (split-up-accounts (gnc:decompose-accountlist accounts))
+ (accounts-totals '()))
;; Display Title Name - Budget - Period
(gnc:html-document-set-title!
- doc (format #f (_ "~a: ~a - ~a")
- report-name (gnc-budget-get-name budget)
- (qof-print-date (gnc-budget-get-period-start-date budget (- period 1)))))
+ doc (format #f (_ "~a: ~a - ~a")
+ report-name (gnc-budget-get-name budget)
+ (qof-print-date (gnc-budget-get-period-start-date
+ budget (1- period)))))
;; Display accounts and totals
- (set! accounts-totals (gnc:html-table-add-budget-types! html-table split-up-accounts budget period exchange-fn report-currency))
- (gnc:html-table-add-budget-totals! html-table accounts-totals exchange-fn report-currency)
+ (set! accounts-totals
+ (gnc:html-table-add-budget-types!
+ html-table split-up-accounts budget period exchange-fn report-currency))
+ (gnc:html-table-add-budget-totals!
+ html-table accounts-totals exchange-fn report-currency)
;; Display table
- (gnc:html-document-add-object! doc html-table)))))
+ (gnc:html-document-add-object! doc html-table))))
;; Update progress bar
(gnc:report-finished)
commit edd87fa47cc6a95e1f5d50b4e93a7770d877e473
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Mar 7 20:45:24 2019 +0800
[cash-flow] preprocess accounts/money-in/out-accounts
this avoids set! calls
diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index 611ecad7e..fd61a006d 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -160,7 +160,8 @@
(filter (lambda (acc) (not (member acc accounts)))
(if show-subaccts?
(gnc:acccounts-get-all-subaccounts accounts)
- '())))))
+ '()))))
+ (accounts (sort accounts account-full-name<?)))
(define (add-accounts-flow accounts accounts-alist)
(let loop ((accounts accounts)
@@ -244,19 +245,19 @@
(cons 'report-currency report-currency)
(cons 'include-trading-accounts include-trading-accounts)
(cons 'to-report-currency to-report-currency)))))
- (let ((money-in-accounts (cdr (assq 'money-in-accounts result)))
+ (let ((money-in-accounts (sort
+ (cdr (assq 'money-in-accounts result))
+ account-full-name<?))
(money-in-alist (cdr (assq 'money-in-alist result)))
(money-in-collector (cdr (assq 'money-in-collector result)))
- (money-out-accounts (cdr (assq 'money-out-accounts result)))
+ (money-out-accounts (sort
+ (cdr (assq 'money-out-accounts result))
+ account-full-name<?))
(money-out-alist (cdr (assq 'money-out-alist result)))
(money-out-collector (cdr (assq 'money-out-collector result))))
(money-diff-collector 'merge money-in-collector #f)
(money-diff-collector 'minusmerge money-out-collector #f)
- (set! accounts (sort accounts account-full-name<?))
- (set! money-in-accounts (sort money-in-accounts account-full-name<?))
- (set! money-out-accounts (sort money-out-accounts account-full-name<?))
-
(gnc:html-document-add-object!
doc
(gnc:make-html-text (_ "Selected Accounts")))
commit c7f7f078ec819b4255230420bd3e1ee8590abdcf
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Mar 7 20:38:45 2019 +0800
[cash-flow] convert account-disp-list to srfi-1
diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index ae7bf0c1d..611ecad7e 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -199,9 +199,26 @@
display-depth))
(money-diff-collector (gnc:make-commodity-collector))
- (account-disp-list '())
+ (account-disp-list
+ (map
+ (lambda (account)
+ (gnc:html-markup/format
+ (if (and (= (gnc-account-get-current-depth account) tree-depth)
+ (pair? (gnc-account-get-children account)))
+ (if show-subaccts?
+ (_ "~a and subaccounts")
+ (_ "~a and selected subaccounts"))
+ "~a")
+ (gnc:html-markup-anchor
+ (gnc:account-anchor-text account)
+ (if show-full-names?
+ (gnc-account-get-full-name account)
+ (xaccAccountGetName account)))))
+ (filter
+ (lambda (account)
+ (<= (gnc-account-get-current-depth account) tree-depth))
+ accounts)))
- (time-exchange-fn #f)
(commodity-list (gnc:accounts-get-commodities
accounts
report-currency))
@@ -240,31 +257,6 @@
(set! money-in-accounts (sort money-in-accounts account-full-name<?))
(set! money-out-accounts (sort money-out-accounts account-full-name<?))
-
- (set! work-done 0)
- (set! work-to-do (length accounts))
- (for-each
- (lambda (account)
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (+ 85 (* 5 (/ work-done work-to-do))))
- (if (<= (gnc-account-get-current-depth account) tree-depth)
- (let* ((anchor (gnc:html-markup/format
- (if (and (= (gnc-account-get-current-depth account) tree-depth)
- (not (eq? (gnc-account-get-children account) '())))
- (if show-subaccts?
- (_ "~a and subaccounts")
- (_ "~a and selected subaccounts"))
- "~a")
- (gnc:html-markup-anchor
- (gnc:account-anchor-text account)
- (if show-full-names?
- (gnc-account-get-full-name account)
- (xaccAccountGetName account))))))
-
- (set! account-disp-list (cons anchor account-disp-list)))))
- accounts)
-
-
(gnc:html-document-add-object!
doc
(gnc:make-html-text (_ "Selected Accounts")))
@@ -273,7 +265,7 @@
doc
(gnc:make-html-text
(gnc:html-markup-ul
- (reverse account-disp-list))))
+ account-disp-list)))
(gnc:html-table-append-ruler! table 2)
commit 7d508b7731e994eb35330d9097d62839b130e4b2
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Mar 7 20:31:38 2019 +0800
[cash-flow] combine common add-accounts-flow code
diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index c24c105f0..ae7bf0c1d 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -131,9 +131,6 @@
optname-accounts))
(include-trading-accounts (get-option gnc:pagename-accounts
optname-include-trading-accounts))
- (row-num 0)
- (work-done 0)
- (work-to-do 0)
(report-currency (get-option gnc:pagename-general
optname-report-currency))
(price-source (get-option gnc:pagename-general
@@ -165,6 +162,29 @@
(gnc:acccounts-get-all-subaccounts accounts)
'())))))
+ (define (add-accounts-flow accounts accounts-alist)
+ (let loop ((accounts accounts)
+ (odd-row? #t))
+ (unless (null? accounts)
+ (let* ((pair (assoc (car accounts) accounts-alist))
+ (acct (car pair)))
+ (gnc:html-table-append-row/markup!
+ table
+ (if odd-row? "normal-row" "alternate-row")
+ (list
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc:account-anchor-text acct)
+ (if show-full-names?
+ (gnc-account-get-full-name acct)
+ (xaccAccountGetName acct))))
+ (gnc:make-html-table-header-cell/markup
+ "number-cell"
+ (gnc:sum-collector-commodity
+ (cadr pair) report-currency exchange-fn)))))
+ (loop (cdr accounts)
+ (not odd-row?)))))
+
(gnc:html-document-set-title!
doc (string-append
(get-option gnc:pagename-general gnc:optname-reportname)
@@ -264,30 +284,7 @@
(_ "Money into selected accounts comes from")
""))
- (set! row-num 0)
- (set! work-done 0)
- (set! work-to-do (length money-in-alist))
- (for-each
- (lambda (account)
- (set! row-num (+ 1 row-num))
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (+ 90 (* 5 (/ work-done work-to-do))))
- (let* ((pair (assoc account money-in-alist))
- (acct (car pair)))
- (gnc:html-table-append-row/markup!
- table
- (if (odd? row-num) "normal-row" "alternate-row")
- (list
- ;(gnc:html-account-anchor acct)
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:account-anchor-text acct)
- (if show-full-names?
- (gnc-account-get-full-name acct)
- (xaccAccountGetName acct))))
- (gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))))
- money-in-accounts)
+ (add-accounts-flow money-in-accounts money-in-alist)
(gnc:html-table-append-row/markup!
table
@@ -308,30 +305,7 @@
(_ "Money out of selected accounts goes to")
""))
- (set! row-num 0)
- (set! work-done 0)
- (set! work-to-do (length money-out-alist))
- (for-each
- (lambda (account)
- (set! row-num (+ 1 row-num))
- (set! work-done (+ 1 work-done))
- (gnc:report-percent-done (+ 95 (* 5 (/ work-done work-to-do))))
- (let* ((pair (assoc account money-out-alist))
- (acct (car pair)))
- (gnc:html-table-append-row/markup!
- table
- (if (odd? row-num) "normal-row" "alternate-row")
- (list
- ;(gnc:html-account-anchor acct)
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:account-anchor-text acct)
- (if show-full-names?
- (gnc-account-get-full-name acct)
- (xaccAccountGetName acct))))
- (gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:sum-collector-commodity (cadr pair) report-currency exchange-fn))))))
- money-out-accounts)
+ (add-accounts-flow money-out-accounts money-out-alist)
(gnc:html-table-append-row/markup!
table
commit beb6e508a43e2b22f5f1aa72145687d15c95c892
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Mar 7 20:27:46 2019 +0800
[cash-flow] reduce code line length
diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index 7357e26b8..c24c105f0 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -295,7 +295,9 @@
(list
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Money In"))
(gnc:make-html-table-header-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity money-in-collector report-currency exchange-fn))))
+ "total-number-cell"
+ (gnc:sum-collector-commodity
+ money-in-collector report-currency exchange-fn))))
(gnc:html-table-append-ruler! table 2)
@@ -337,7 +339,9 @@
(list
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Money Out"))
(gnc:make-html-table-header-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity money-out-collector report-currency exchange-fn))))
+ "total-number-cell"
+ (gnc:sum-collector-commodity
+ money-out-collector report-currency exchange-fn))))
(gnc:html-table-append-ruler! table 2)
@@ -347,7 +351,9 @@
(list
(gnc:make-html-table-header-cell/markup "text-cell" (_ "Difference"))
(gnc:make-html-table-header-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity money-diff-collector report-currency exchange-fn))))
+ "total-number-cell"
+ (gnc:sum-collector-commodity
+ money-diff-collector report-currency exchange-fn))))
(gnc:html-document-add-object! doc table)
commit 9dd139f3ed95de5df312c56cbd2979200fa829e6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Mar 7 20:02:55 2019 +0800
[cash-flow] convert subaccounts to srfi-1
neater
diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index ecb31a3f8..7357e26b8 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -157,7 +157,13 @@
(doc (gnc:make-html-document))
(table (gnc:make-html-table))
- (txt (gnc:make-html-text)))
+
+ ;;add subaccounts if requested
+ (accounts (append accounts
+ (filter (lambda (acc) (not (member acc accounts)))
+ (if show-subaccts?
+ (gnc:acccounts-get-all-subaccounts accounts)
+ '())))))
(gnc:html-document-set-title!
doc (string-append
@@ -166,17 +172,6 @@
(format #f (_ "~a to ~a")
(qof-print-date from-date-t64) (qof-print-date to-date-t64))))
-
- ;; add subaccounts if requested
- (if show-subaccts?
- (let ((sub-accounts (gnc:acccounts-get-all-subaccounts accounts)))
- (for-each
- (lambda (sub-account)
- (if (not (member sub-account accounts))
- (set! accounts (cons sub-account accounts))))
- sub-accounts)))
-
-
(if (not (null? accounts))
(let* ((tree-depth (if (equal? display-depth 'all)
Summary of changes:
.../report-system/test/test-commodity-utils.scm | 55 ++-
gnucash/report/standard-reports/budget-flow.scm | 375 ++++++++++-----------
gnucash/report/standard-reports/cash-flow.scm | 168 ++++-----
3 files changed, 304 insertions(+), 294 deletions(-)
More information about the gnucash-changes
mailing list