From 867aa78f91274c759b0de9d63512af1ff09d6196 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 12 Sep 2018 18:10:34 +0800 Subject: [PATCH 01/11] [test-charts] add SRFI-64 teardown function --- .../report/standard-reports/test/test-charts.scm | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/gnucash/report/standard-reports/test/test-charts.scm b/gnucash/report/standard-reports/test/test-charts.scm index 342ef1be1c..2094f285ba 100644 --- a/gnucash/report/standard-reports/test/test-charts.scm +++ b/gnucash/report/standard-reports/test/test-charts.scm @@ -45,12 +45,8 @@ (define (run-test) (test-runner-factory gnc:test-runner) (test-begin "net-charts.scm") - (for-each (lambda (variant) - (null-test variant)) - (map car variant-alist)) - (for-each (lambda (variant) - (net-charts-test variant)) - (map car variant-alist)) + (for-each null-test (map car variant-alist)) + (for-each test-chart (map car variant-alist)) (test-end "net-charts.scm")) (define (options->render variant options test-title) @@ -74,7 +70,12 @@ (test-assert (format #f "null-test: ~a" variant) (options->render uuid options "null-test")))) -(define (net-charts-test variant) +(define (test-chart variant) + (test-group-with-cleanup (format #f "test variant ~a" variant) + (test-chart-variant variant) + (gnc-clear-current-session))) + +(define (test-chart-variant variant) (define (set-option! options section name value) (let ((option (gnc:lookup-option options section name))) (if option From 3e9cd1fc1170165299a1fe30c434825444eeab2a Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 12 Sep 2018 18:11:06 +0800 Subject: [PATCH 02/11] [test-extras] augment (gnc:options->sxml) to allow tag stripping An html render containing a tag will not typically be parsable by sxml. This augmentation will strip an html tag from the render. Therefore we can use (gnc:options->sxml ... #:strip-tag "script") which will strip off the whole " tags too, but should cover common cases. --- .../report/report-system/test/test-extras.scm | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm index e6e02bf16e..acfaa61880 100644 --- a/gnucash/report/report-system/test/test-extras.scm +++ b/gnucash/report/report-system/test/test-extras.scm @@ -117,14 +117,27 @@ (display render))) render))) +(define (strip-string s1 s2) + (let loop ((str s1)) + (let ((startpos (string-contains str (format #f "<~a" s2))) + (endpos (string-contains str (format #f "" s2)))) + (if (and startpos endpos) + (loop (string-append + (string-take str startpos) + (string-drop str (+ endpos (string-length s2) 3)))) + str)))) + (export gnc:options->sxml) -(define (gnc:options->sxml uuid options prefix test-title) +(define* (gnc:options->sxml uuid options prefix test-title #:key strip-tag) ;; This functions calls the above gnc:options->render to render ;; report. Then report is converted to SXML. It catches XML - ;; parsing errors, dumping the options changed. + ;; parsing errors, dumping the options changed. Also optionally strip + ;; an HTML tag from the render, e.g. (let ((render (gnc:options->render uuid options prefix test-title))) (catch 'parser-error - (lambda () (xml->sxml render + (lambda () (xml->sxml (if strip-tag + (strip-string render strip-tag) + render) #:trim-whitespace? #t #:entities '((nbsp . "\xa0")))) (lambda (k . args) From 9bba9474cbbc9c4702c06a7804f812e2e2acf41f Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 12 Sep 2018 18:19:43 +0800 Subject: [PATCH 03/11] [test-charts] add daily txns and test range This test (for net-worth-barchart only) adds daily transactions from 1/1/70 for 100 days, and aims to test the date ranges for net-charts is accurate. --- .../standard-reports/test/test-charts.scm | 28 ++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/gnucash/report/standard-reports/test/test-charts.scm b/gnucash/report/standard-reports/test/test-charts.scm index 2094f285ba..edd4b88fa6 100644 --- a/gnucash/report/standard-reports/test/test-charts.scm +++ b/gnucash/report/standard-reports/test/test-charts.scm @@ -116,7 +116,33 @@ (let* ((options (default-testing-options))) (test-assert (format #f "basic report exists: ~a" variant) - (options->render uuid options (format #f "net-charts-test ~a default options" variant)))) + (options->render uuid options (format #f "test-null ~a default options" variant)))) + + ;; test net worth barchart amounts + (when (eq? variant 'net-worth-barchart) + ;; create 100 daily transactions from 1/1/70. this is meant to + ;; test chart date ranges. day 0 = $0, day 1 = $1, etc + (let loop ((date (gnc-dmy2time64 1 1 1970)) (idx 0)) + (when (<= idx 100) + (env-create-transaction env date bank income idx) + (loop (incdate date DayDelta) (1+ idx)))) + (let* ((options (default-testing-options))) + (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 15 1 1970))) + (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 15 3 1970))) + (set-option! options "General" "Step Size" 'DayDelta) + (set-option! options "Display" "Show table" #t) + (let ((sxml (gnc:options->sxml uuid options (format #f "test-net-charts ~a 2 months" variant) + "test-table" #:strip-tag "script"))) + (test-equal "net-worth-barchart: first row" + '("Date" "Assets" "Liabilities" "Net Worth") + (sxml->table-row-col sxml 1 0 #f)) + (test-equal "net-worth-barchart: first data row" + '("01/15/70" "$105.00" "$0.00" "$105.00") + (sxml->table-row-col sxml 1 1 #f)) + (test-equal "net-worth-barchart: last data row" + '("03/15/70" "$2,701.00" "$0.00" "$2,701.00") + (sxml->table-row-col sxml 1 -1 #f)) + ))) (case variant ((liability-piechart stock-piechart asset-piechart expense-piechart income-piechart) From 381293655ff60bde76698a58a7b588f1cd20efb1 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 12 Sep 2018 18:35:11 +0800 Subject: [PATCH 04/11] [test-charts] also test income-expense-barchart amounts --- .../standard-reports/test/test-charts.scm | 29 ++++++++++++++++--- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/gnucash/report/standard-reports/test/test-charts.scm b/gnucash/report/standard-reports/test/test-charts.scm index edd4b88fa6..850b472279 100644 --- a/gnucash/report/standard-reports/test/test-charts.scm +++ b/gnucash/report/standard-reports/test/test-charts.scm @@ -119,14 +119,16 @@ (options->render uuid options (format #f "test-null ~a default options" variant)))) ;; test net worth barchart amounts - (when (eq? variant 'net-worth-barchart) + (when (or (eq? variant 'net-worth-barchart) + (eq? variant 'income-expense-barchart)) ;; create 100 daily transactions from 1/1/70. this is meant to ;; test chart date ranges. day 0 = $0, day 1 = $1, etc (let loop ((date (gnc-dmy2time64 1 1 1970)) (idx 0)) (when (<= idx 100) (env-create-transaction env date bank income idx) (loop (incdate date DayDelta) (1+ idx)))) - (let* ((options (default-testing-options))) + (when (eq? variant 'net-worth-barchart) + (let* ((options (default-testing-options))) (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 15 1 1970))) (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 15 3 1970))) (set-option! options "General" "Step Size" 'DayDelta) @@ -141,8 +143,27 @@ (sxml->table-row-col sxml 1 1 #f)) (test-equal "net-worth-barchart: last data row" '("03/15/70" "$2,701.00" "$0.00" "$2,701.00") - (sxml->table-row-col sxml 1 -1 #f)) - ))) + (sxml->table-row-col sxml 1 -1 #f))))) + + (when (eq? variant 'income-expense-barchart) + (let* ((options (default-testing-options))) + (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 15 1 1970))) + (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 15 3 1970))) + (set-option! options "General" "Step Size" 'DayDelta) + (set-option! options "Display" "Show table" #t) + (set-option! options "Accounts" "Accounts" (list income expense)) + (let ((sxml (gnc:options->sxml uuid options (format #f "test-net-charts ~a 2 years" variant) + "test-table" #:strip-tag "script"))) + (test-equal "income-expense-barchart: first row" + '("Date" "Income" "Expense" "Net Profit") + (sxml->table-row-col sxml 1 0 #f)) + (test-equal "income-expense: first data row" + '("01/15/70" "$14.00" "$0.00" "$14.00") + (sxml->table-row-col sxml 1 1 #f)) + (test-equal "income-expense: last data row" + '("03/15/70" "$73.00" "$0.00" "$73.00") + (sxml->table-row-col sxml 1 -1 #f)))) + )) (case variant ((liability-piechart stock-piechart asset-piechart expense-piechart income-piechart) From 2832b8e63c5218d630f6220ff5952785ec323608 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 14 Sep 2018 17:08:11 +0800 Subject: [PATCH 05/11] [report-utilities] compact functions --- .../report/report-system/report-utilities.scm | 113 ++++++++---------- 1 file changed, 51 insertions(+), 62 deletions(-) diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm index 58aeaf6b05..02c5e467cc 100644 --- a/gnucash/report/report-system/report-utilities.scm +++ b/gnucash/report/report-system/report-utilities.scm @@ -633,34 +633,31 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.") ;; the type is an alist '((str "match me") (cased #f) (regexp #f)) ;; If type is #f, sums all non-closing splits in the interval (define (gnc:account-get-trans-type-balance-interval - account-list type start-date end-date) + account-list type start-date end-date) (let* ((total (gnc:make-commodity-collector))) - (map (lambda (split) - (let* ((shares (xaccSplitGetAmount split)) - (acct-comm (xaccAccountGetCommodity - (xaccSplitGetAccount split))) - (txn (xaccSplitGetParent split))) - (if type - (total 'add acct-comm shares) - (if (not (xaccTransGetIsClosingTxn txn)) - (total 'add acct-comm shares))))) - (gnc:account-get-trans-type-splits-interval - account-list type start-date end-date)) + (for-each + (lambda (split) + (if (or type (not (xaccTransGetIsClosingTxn (xaccSplitGetParent split)))) + (total 'add + (xaccAccountGetCommodity (xaccSplitGetAccount split)) + (xaccSplitGetAmount split)))) + (gnc:account-get-trans-type-splits-interval + account-list type start-date end-date)) total)) ;; Sums up any splits of a certain type affecting a set of accounts. ;; the type is an alist '((str "match me") (cased #f) (regexp #f)) ;; If type is #f, sums all splits in the interval (even closing splits) (define (gnc:account-get-trans-type-balance-interval-with-closing - account-list type start-date end-date) + account-list type start-date end-date) (let ((total (gnc:make-commodity-collector))) - (map (lambda (split) - (let* ((shares (xaccSplitGetAmount split)) - (acct-comm (xaccAccountGetCommodity - (xaccSplitGetAccount split)))) - (total 'add acct-comm shares))) - (gnc:account-get-trans-type-splits-interval - account-list type start-date end-date)) + (for-each + (lambda (split) + (total 'add + (xaccAccountGetCommodity (xaccSplitGetAccount split)) + (xaccSplitGetAmount split))) + (gnc:account-get-trans-type-splits-interval + account-list type start-date end-date)) total)) ;; Filters the splits from the source to the target accounts @@ -757,44 +754,36 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.") (define (gnc:account-get-trans-type-splits-interval account-list type start-date end-date) (if (null? account-list) - ;; No accounts given. Return empty list. '() - ;; The normal case: There are accounts given. - (let* ((query (qof-query-create-for-splits)) - (query2 #f) - (splits #f) - (get-val (lambda (alist key) - (let ((lst (assoc-ref alist key))) - (if lst (car lst) lst)))) - (matchstr (get-val type 'str)) - (case-sens (if (get-val type 'cased) #t #f)) - (regexp (if (get-val type 'regexp) #t #f)) - (closing (if (get-val type 'closing) #t #f)) - ) - (qof-query-set-book query (gnc-get-current-book)) - (gnc:query-set-match-non-voids-only! query (gnc-get-current-book)) - (xaccQueryAddAccountMatch query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND) - (xaccQueryAddDateMatchTT - query - (and start-date #t) (if start-date start-date 0) - (and end-date #t) (if end-date end-date 0) - QOF-QUERY-AND) - (if (or matchstr closing) - (begin - (set! query2 (qof-query-create-for-splits)) - (if matchstr (xaccQueryAddDescriptionMatch - query2 matchstr case-sens regexp QOF-COMPARE-CONTAINS QOF-QUERY-OR)) - (if closing (xaccQueryAddClosingTransMatch query2 1 QOF-QUERY-OR)) - (qof-query-merge-in-place query query2 QOF-QUERY-AND) - (qof-query-destroy query2) - )) - - (set! splits (qof-query-run query)) - (qof-query-destroy query) - splits - ) - ) - ) + (let* ((query (qof-query-create-for-splits)) + (get-val (lambda (key) + (let ((lst (assq-ref type key))) + (and lst (car lst))))) + (matchstr (get-val 'str)) + (case-sens (get-val 'cased)) + (regexp (get-val 'regexp)) + (closing (get-val 'closing))) + (qof-query-set-book query (gnc-get-current-book)) + (gnc:query-set-match-non-voids-only! query (gnc-get-current-book)) + (xaccQueryAddAccountMatch query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND) + (xaccQueryAddDateMatchTT + query + (and start-date #t) (or start-date 0) + (and end-date #t) (or end-date 0) + QOF-QUERY-AND) + (when (or matchstr closing) + (let ((query2 (qof-query-create-for-splits))) + (if matchstr + (xaccQueryAddDescriptionMatch + query2 matchstr case-sens regexp + QOF-COMPARE-CONTAINS QOF-QUERY-OR)) + (if closing + (xaccQueryAddClosingTransMatch query2 1 QOF-QUERY-OR)) + (qof-query-merge-in-place query query2 QOF-QUERY-AND) + (qof-query-destroy query2))) + (let ((splits (qof-query-run query))) + (qof-query-destroy query) + splits)))) ;; utility to assist with double-column balance tables ;; a request is made with the argument @@ -867,12 +856,12 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.") ;; ;; Returns a commodity-collector. (define (gnc:budget-account-get-net budget account start-period end-period) - (if (not end-period) (set! end-period (gnc-budget-get-num-periods budget))) (let* ((period (or start-period 0)) - (net (gnc:make-commodity-collector)) - (acct-comm (xaccAccountGetCommodity account))) - (while (< period end-period) - (net 'add acct-comm + (maxperiod (or end-period (gnc-budget-get-num-periods budget))) + (net (gnc:make-commodity-collector))) + (while (< period maxperiod) + (net 'add + (xaccAccountGetCommodity account) (gnc-budget-get-account-period-value budget account period)) (set! period (1+ period))) net)) From 984501e95168726f9e86dbfa4c8fd21fe8fcd6e1 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 12 Sep 2018 18:26:48 +0800 Subject: [PATCH 06/11] [report-utilities] improve (gnc:account-get-comm-balance-at-date) This improves (gnc:account-get-comm-balance-at-date) to use (xaccAccountBalanceAsOfDate) instead of cycling through a split list. This function is used in numerous charts and should speed them up tremendously. --- .../report/report-system/report-utilities.scm | 48 +++++-------------- 1 file changed, 13 insertions(+), 35 deletions(-) diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm index 02c5e467cc..8b09b530ec 100644 --- a/gnucash/report/report-system/report-utilities.scm +++ b/gnucash/report/report-system/report-utilities.scm @@ -392,42 +392,20 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.") ;; This works similar as above but returns a commodity-collector, ;; thus takes care of children accounts with different currencies. -;; -;; Also note that the commodity-collector contains -;; values rather than double values. -(define (gnc:account-get-comm-balance-at-date account - date include-children?) +(define (gnc:account-get-comm-balance-at-date + account date include-children?) (let ((balance-collector (gnc:make-commodity-collector)) - (query (qof-query-create-for-splits)) - (splits #f)) - - (if include-children? - (for-each - (lambda (x) - (balance-collector 'merge x #f)) - (gnc:account-map-descendants - (lambda (child) - (gnc:account-get-comm-balance-at-date child date #f)) - account))) - - (qof-query-set-book query (gnc-get-current-book)) - (xaccQueryAddSingleAccountMatch query account QOF-QUERY-AND) - (xaccQueryAddDateMatchTT query #f date #t date QOF-QUERY-AND) - (qof-query-set-sort-order query - (list SPLIT-TRANS TRANS-DATE-POSTED) - (list QUERY-DEFAULT-SORT) - '()) - (qof-query-set-sort-increasing query #t #t #t) - (qof-query-set-max-results query 1) - - (set! splits (qof-query-run query)) - (qof-query-destroy query) - - (if (and splits (not (null? splits))) - (balance-collector 'add - (xaccAccountGetCommodity account) - (xaccSplitGetBalance (car splits)))) - balance-collector)) + (accounts (cons account + (if include-children? + (gnc-account-get-descendants account) + '())))) + (for-each + (lambda (acct) + (balance-collector 'add + (xaccAccountGetCommodity acct) + (xaccAccountGetBalanceAsOfDate acct date))) + accounts) + balance-collector)) ;; Calculate the increase in the balance of the account in terms of ;; "value" (as opposed to "amount") between the specified dates. From 77063afa735d30cb44a51b1a487056bb03f522b3 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 14 Sep 2018 09:18:32 +0800 Subject: [PATCH 07/11] [report-utilities] improve (gnc:account-get-comm-value-interval) This commit will marginally speed up this function when include-children? is #t. The original code would create a new query for each descendant. This commit will create one query only for all accounts when include-children? is #t. Unfortunately there is no actual live code whereby include-children? is enabled. Anyway this code is cleaned up. --- .../report/report-system/report-utilities.scm | 48 ++++++++----------- 1 file changed, 21 insertions(+), 27 deletions(-) diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm index 8b09b530ec..1b8cde8f04 100644 --- a/gnucash/report/report-system/report-utilities.scm +++ b/gnucash/report/report-system/report-utilities.scm @@ -413,41 +413,35 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.") ;; just direct children) are are included in the calculation. The results ;; are returned in a commodity collector. (define (gnc:account-get-comm-value-interval account start-date end-date - include-children?) + include-children?) (let ((value-collector (gnc:make-commodity-collector)) - (query (qof-query-create-for-splits)) - (splits #f)) - - (if include-children? - (for-each - (lambda (x) - (value-collector 'merge x #f)) - (gnc:account-map-descendants - (lambda (d) - (gnc:account-get-comm-value-interval d start-date end-date #f)) - account))) + (query (qof-query-create-for-splits)) + (accounts (cons account + (if include-children? + (gnc-account-get-descendants account) + '())))) ;; Build a query to find all splits between the indicated dates. (qof-query-set-book query (gnc-get-current-book)) - (xaccQueryAddSingleAccountMatch query account QOF-QUERY-AND) + (xaccQueryAddAccountMatch query accounts + QOF-GUID-MATCH-ANY + QOF-QUERY-AND) (xaccQueryAddDateMatchTT query - (and start-date #t) (if start-date start-date 0) - (and end-date #t) (if end-date end-date 0) + (and start-date #t) (or start-date 0) + (and end-date #t) (or end-date 0) QOF-QUERY-AND) ;; Get the query results. - (set! splits (qof-query-run query)) - (qof-query-destroy query) - - ;; Add the "value" of each split returned (which is measured - ;; in the transaction currency). - (for-each - (lambda (split) - (value-collector 'add - (xaccTransGetCurrency (xaccSplitGetParent split)) - (xaccSplitGetValue split))) - splits) - + (let ((splits (qof-query-run query))) + (qof-query-destroy query) + ;; Add the "value" of each split returned (which is measured + ;; in the transaction currency). + (for-each + (lambda (split) + (value-collector 'add + (xaccTransGetCurrency (xaccSplitGetParent split)) + (xaccSplitGetValue split))) + splits)) value-collector)) ;; Calculate the balance of the account in terms of "value" (rather From 941acee04e3598c18eda8cb68c3b024da6f73ab1 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 12 Sep 2018 17:28:26 +0800 Subject: [PATCH 08/11] [net-charts] deoptimize accounts-list This aims to partially undo commit 8aed5c3f660. --- .../report/standard-reports/net-charts.scm | 56 ++++--------------- 1 file changed, 10 insertions(+), 46 deletions(-) diff --git a/gnucash/report/standard-reports/net-charts.scm b/gnucash/report/standard-reports/net-charts.scm index 9e1e885a02..5a633e3fde 100644 --- a/gnucash/report/standard-reports/net-charts.scm +++ b/gnucash/report/standard-reports/net-charts.scm @@ -33,8 +33,6 @@ (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) -(use-modules (gnucash report report-system report-collectors)) -(use-modules (gnucash report report-system collectors)) (use-modules (gnucash report standard-reports category-barchart)) ; for guids of called reports (gnc:module-load "gnucash/report/report-system" 0) @@ -306,50 +304,16 @@ (if (not (null? accounts)) - (let* ((the-account-destination-alist - (if inc-exp? - (append (map (lambda (account) (cons account 'asset)) - (assoc-ref classified-accounts ACCT-TYPE-INCOME)) - (map (lambda (account) (cons account 'liability)) - (assoc-ref classified-accounts ACCT-TYPE-EXPENSE))) - (append (map (lambda (account) (cons account 'asset)) - (assoc-ref classified-accounts ACCT-TYPE-ASSET)) - (map (lambda (account) (cons account 'liability)) - (assoc-ref classified-accounts ACCT-TYPE-LIABILITY))))) - (account-reformat (if inc-exp? - (lambda (account result) - (map (lambda (collector date-interval) - (gnc:monetary-neg (collector->monetary collector (second date-interval)))) - result dates-list)) - (lambda (account result) - (let ((commodity-collector (gnc:make-commodity-collector))) - (collector-end (fold (lambda (next date list-collector) - (commodity-collector 'merge next #f) - (collector-add list-collector - (collector->monetary - commodity-collector date))) - (collector-into-list) - result - dates-list)))))) - (work (category-by-account-report-work inc-exp? - dates-list - the-account-destination-alist - (lambda (account date) - (make-gnc-collector-collector)) - account-reformat)) - (rpt (category-by-account-report-do-work work (cons 50 90))) - (assets (assoc-ref rpt 'asset)) - (liabilities (assoc-ref rpt 'liability)) - (assets-list (if assets - (car assets) - (map (lambda (d) - (gnc:make-gnc-monetary report-currency 0)) - dates-list))) - (liability-list (if liabilities - (car liabilities) - (map (lambda (d) - (gnc:make-gnc-monetary report-currency 0)) - dates-list))) + (let* ((assets-list (process-datelist + (if inc-exp? + accounts + (assoc-ref classified-accounts ACCT-TYPE-ASSET)) + dates-list #t)) + (liability-list (process-datelist + (if inc-exp? + accounts + (assoc-ref classified-accounts ACCT-TYPE-LIABILITY)) + dates-list #f)) (net-list (map monetary+ assets-list liability-list)) ;; Here the date strings for the x-axis labels are ;; created. From ad361d1e69edac8fb352c72305f723c81d9b354b Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 14 Sep 2018 19:24:12 +0800 Subject: [PATCH 09/11] [invoice] Add customer/vendor ID in client section This aims, but does not completely fixes bug 430259 or 742086 which would require data model changes. It upgrades invoice.scm to add the customer/vendor/employee internal ID. Job invoices will display the job owner's ID. --- gnucash/report/business-reports/invoice.scm | 27 +++++++++++++++++---- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm index 38d0421387..e5750f8091 100644 --- a/gnucash/report/business-reports/invoice.scm +++ b/gnucash/report/business-reports/invoice.scm @@ -110,10 +110,10 @@ (gnc:make-gnc-monetary currency numeric))) (define layout-key-list - (list (cons 'client (list (cons 'text "Client details") - (cons 'tip "Client name and address"))) + (list (cons 'client (list (cons 'text (_ "Their details")) + (cons 'tip (_ "Client or vendor name, address and ID")))) - (cons 'company (list (cons 'text "Company details") + (cons 'company (list (cons 'text "Our details") (cons 'tip "Company name, address and tax-ID"))) (cons 'invoice (list (cons 'text "Invoice details") @@ -333,6 +333,11 @@ for styling the invoice. Please see the exported report for the CSS class names. (N_ "Display") (N_ "Billing ID") "ta" (N_ "Display the billing id?") #t)) + (gnc:register-inv-option + (gnc:make-simple-boolean-option + (N_ "Display") (N_ "Invoice owner ID") + "tam" (N_ "Display the customer/vendor id?") #f)) + (gnc:register-inv-option (gnc:make-simple-boolean-option (N_ "Display") (N_ "Invoice Notes") @@ -669,7 +674,10 @@ for styling the invoice. Please see the exported report for the CSS class names. (gnc:make-html-text (gnc:html-markup-img img-url))) -(define (make-client-table owner orders) +(define (make-client-table owner orders options) + (define (opt-val section name) + (gnc:option-value + (gnc:lookup-option options section name))) ;; this is a single-column table. (let ((table (gnc:make-html-table))) @@ -686,6 +694,14 @@ for styling the invoice. Please see the exported report for the CSS class names. (multiline-to-html-text (gnc:owner-get-address-dep owner))))) + (if (opt-val "Display" "Invoice owner ID") + (gnc:html-table-append-row! table + (list + (gnc:make-html-div/markup + "maybe-align-right client-id" + (multiline-to-html-text + (gnc:owner-get-owner-id owner)))))) + (for-each (lambda (order) (let ((reference (gncOrderGetReference order))) @@ -793,7 +809,8 @@ for styling the invoice. Please see the exported report for the CSS class names. invoice options))) (cons 'client (gnc:make-html-div/markup "client-table" - (make-client-table owner orders))) + (make-client-table + owner orders options))) (cons 'company (gnc:make-html-div/markup "company-table" (make-company-table book))) From ce5854950666b43878b552f44971a36a57289f4b Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 14 Sep 2018 20:36:31 +0800 Subject: [PATCH 10/11] [invoice] mark strings in options as translatable --- gnucash/report/business-reports/invoice.scm | 23 ++++++++++++--------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm index e5750f8091..690534bd03 100644 --- a/gnucash/report/business-reports/invoice.scm +++ b/gnucash/report/business-reports/invoice.scm @@ -110,23 +110,26 @@ (gnc:make-gnc-monetary currency numeric))) (define layout-key-list + ;; Translators: "Their details" refer to the invoice 'other party' details i.e. client/vendor name/address/ID (list (cons 'client (list (cons 'text (_ "Their details")) (cons 'tip (_ "Client or vendor name, address and ID")))) - (cons 'company (list (cons 'text "Our details") - (cons 'tip "Company name, address and tax-ID"))) + ;; Translators: "Our details" refer to the book owner's details i.e. name/address/tax-ID + (cons 'company (list (cons 'text (_ "Our details")) + (cons 'tip (_ "Company name, address and tax-ID")))) - (cons 'invoice (list (cons 'text "Invoice details") - (cons 'tip "Invoice date, due date, billing ID, terms, job details"))) + (cons 'invoice (list (cons 'text (_ "Invoice details")) + (cons 'tip (_ "Invoice date, due date, billing ID, terms, job details")))) - (cons 'today (list (cons 'text "Today's date") - (cons 'tip "Today's date"))) + (cons 'today (list (cons 'text (_ "Today's date")) + (cons 'tip (_ "Today's date")))) - (cons 'picture (list (cons 'text "Picture") - (cons 'tip "Picture"))) + (cons 'picture (list (cons 'text (_ "Picture")) + (cons 'tip (_ "Picture")))) - (cons 'none (list (cons 'text "(empty)") - (cons 'tip "Empty space"))))) + ;; Translators: "(empty)" refers to invoice header section being left blank + (cons 'none (list (cons 'text (_ "(empty)")) + (cons 'tip (_ "Empty space")))))) (define variant-list (list From 395b42d620ae0136649d3e74b5eecf220f5550ef Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 14 Sep 2018 19:29:06 +0800 Subject: [PATCH 11/11] [average-balance] add styling to data table --- .../standard-reports/average-balance.scm | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/gnucash/report/standard-reports/average-balance.scm b/gnucash/report/standard-reports/average-balance.scm index ad6e78595b..9a633a72b1 100644 --- a/gnucash/report/standard-reports/average-balance.scm +++ b/gnucash/report/standard-reports/average-balance.scm @@ -555,17 +555,15 @@ table columns) (for-each (lambda (row) - (gnc:html-table-append-row! table row)) + (gnc:html-table-append-row! + table + (map + gnc:make-html-table-cell/markup + (list "date-cell" "date-cell" + "number-cell" "number-cell" "number-cell" + "number-cell" "number-cell" "number-cell") + row))) data) - - ;; set numeric columns to align right - (for-each - (lambda (col) - (gnc:html-table-set-col-style! - table col "td" - 'attribute (list "align" "right"))) - '(2 3 4 5 6 7)) - (gnc:html-document-add-object! document table)))) ;; if there are no accounts selected...