gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Thu Jan 14 10:13:47 EST 2021


Updated	 via  https://github.com/Gnucash/gnucash/commit/0b0e96c5 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/d009ba3d (commit)
	 via  https://github.com/Gnucash/gnucash/commit/6605a6eb (commit)
	 via  https://github.com/Gnucash/gnucash/commit/9f09be4b (commit)
	from  https://github.com/Gnucash/gnucash/commit/e6b97849 (commit)



commit 0b0e96c500bb91e9e8c09039b833888ec970a629
Merge: d009ba3dc 9f09be4b6
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jan 14 23:07:27 2021 +0800

    Merge branch 'fix-memory-leak' of git://github.com/renatoaguiar/gnucash into maint #876


commit d009ba3dc883ff00a4fd8c6e9c35ae5b101a0414
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jan 14 23:00:18 2021 +0800

    Bug 798078 - Report 'Income Chart' prints stacktrace when end date before start date

diff --git a/gnucash/report/reports/standard/category-barchart.scm b/gnucash/report/reports/standard/category-barchart.scm
index 33fa9cf18..ac4c80019 100644
--- a/gnucash/report/reports/standard/category-barchart.scm
+++ b/gnucash/report/reports/standard/category-barchart.scm
@@ -281,6 +281,14 @@ developing over time"))
        (gnc:html-make-no-account-warning
         report-title (gnc:report-id report-obj))))
 
+     ((<= to-date-t64 from-date-t64)
+      (gnc:html-document-add-object!
+       document
+       (gnc:html-make-generic-warning
+        report-title (gnc:report-id report-obj)
+        (G_ "Invalid dates")
+        (G_ "Start date must be earlier than End date"))))
+
      (else
       (let* ((commodity-list (gnc:accounts-get-commodities
                               (gnc:accounts-and-all-descendants accounts)

commit 6605a6eb6621edd6bc5dc7326568ef812af17533
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jan 14 22:53:59 2021 +0800

    [category-barchart] refactor, handling error conditions first

diff --git a/gnucash/report/reports/standard/category-barchart.scm b/gnucash/report/reports/standard/category-barchart.scm
index 93e7af194..33fa9cf18 100644
--- a/gnucash/report/reports/standard/category-barchart.scm
+++ b/gnucash/report/reports/standard/category-barchart.scm
@@ -274,417 +274,394 @@ developing over time"))
                            account-levels))
 
     ;;(gnc:debug accounts)
-    (if (not (null? accounts))
-
-        ;; Define more helper variables.
-        (let* ((commodity-list #f)
-               (exchange-fn #f)
-               (averaging-fraction-func (gnc:date-get-fraction-func averaging-selection))
-               (interval-fraction-func (gnc:date-get-fraction-func interval))
-               (averaging-multiplier
-                (if averaging-fraction-func
-                    ;; Calculate the divisor of the amounts so that an
-                    ;; average is shown. Multiplier factor is a gnc-numeric
-                    (let* ((start-frac-avg (averaging-fraction-func from-date-t64))
-                           (end-frac-avg (averaging-fraction-func (1+ to-date-t64)))
-                           (diff-avg (- end-frac-avg start-frac-avg))
-                           (diff-avg-numeric (/ (inexact->exact (round (* diff-avg 1000000))) ; 6 decimals precision
-                                                1000000))
-                           (start-frac-int (interval-fraction-func from-date-t64))
-                           (end-frac-int (interval-fraction-func (1+ to-date-t64)))
-                           (diff-int (- end-frac-int start-frac-int))
-                           (diff-int-numeric (inexact->exact diff-int)))
-                      ;; Extra sanity check to ensure a number smaller than 1
-                      (if (> diff-avg diff-int)
-                          (/ diff-int-numeric diff-avg-numeric)
-                          1))
-                    1))
-               ;; If there is averaging, the report-title is extended
-               ;; accordingly.
-               (report-title
-                (case averaging-selection
-                  ((MonthDelta) (string-append report-title " " (G_ "Monthly Average")))
-                  ((WeekDelta) (string-append report-title " " (G_ "Weekly Average")))
-                  ((DayDelta) (string-append report-title " " (G_ "Daily Average")))
-                  (else report-title)))
-               (currency-frac (gnc-commodity-get-fraction report-currency))
-               ;; This is the list of date intervals to calculate.
-               (dates-list (gnc:make-date-list
-                            ((if do-intervals?
-                                 gnc:time64-start-day-time
-                                 gnc:time64-end-day-time) from-date-t64)
-                            (gnc:time64-end-day-time to-date-t64)
-                            (gnc:deltasym-to-delta interval)))
-               ;; Here the date strings for the x-axis labels are
-               ;; created.
-               (other-anchor "")
-               (all-data '()))
-
-          ;; Converts a commodity-collector into gnc-monetary in the report's
-          ;; currency using the exchange-fn calculated above. Returns a gnc-monetary
-          ;; multiplied by the averaging-multiplier (smaller than one; multiplication
-          ;; instead of division to avoid division-by-zero issues) in case
-          ;; the user wants to see the amounts averaged over some value.
-          (define (collector->monetary c date)
-            (gnc:make-gnc-monetary
-             report-currency
-             (* averaging-multiplier
-                (gnc:gnc-monetary-amount
-                 (gnc:sum-collector-commodity
-                  c report-currency
-                  (lambda (a b) (exchange-fn a b date)))))))
-
-          ;; copy of gnc:not-all-zeros using gnc-monetary
-          (define (not-all-zeros data)
-            (cond ((gnc:gnc-monetary? data) (not (zero? (gnc:gnc-monetary-amount data))))
-                  ((list? data) (or-map not-all-zeros data))
-                  (else #f)))
-
-          ;; this is an alist of account-balances
-          ;; (list (list acc0 bal0 bal1 bal2 ...)
-          ;;       (list acc1 bal0 bal1 bal2 ...)
-          ;;       ...)
-          ;; whereby each balance is a gnc-monetary
-          (define account-balances-alist
-            (map
-             (lambda (acc)
-               (let* ((comm (xaccAccountGetCommodity acc))
-                      (split->elt (if reverse-bal?
-                                      (lambda (s)
-                                        (gnc:make-gnc-monetary
-                                         comm (- (xaccSplitGetNoclosingBalance s))))
-                                      (lambda (s)
-                                        (gnc:make-gnc-monetary
-                                         comm (xaccSplitGetNoclosingBalance s))))))
-                 (cons acc
-                       (gnc:account-accumulate-at-dates
-                        acc dates-list
-                        #:split->elt split->elt
-                        #:nosplit->elt (gnc:make-gnc-monetary comm 0)))))
-             ;; all selected accounts (of report-specific type), *and*
-             ;; their descendants (of any type) need to be scanned.
-             (gnc:accounts-and-all-descendants accounts)))
-
-          ;; Creates the <balance-list> to be used in the function
-          ;; below.
-          (define (account->balance-list account subacct?)
-            (let* ((accountslist (cons account
-                                   (if subacct?
-                                       (gnc-account-get-descendants account)
-                                       '())))
-                   (selected-balances (filter
-                                       (lambda (entry)
-                                         (member (car entry) accountslist))
-                                       account-balances-alist))
-                   (selected-monetaries (map cdr selected-balances))
-                   (list-of-mon-collectors (apply map gnc:monetaries-add selected-monetaries)))
-              (let loop ((list-of-mon-collectors list-of-mon-collectors)
-                         (dates-list dates-list)
-                         (result '()))
-                (if (null? (if do-intervals?
-                               (cdr list-of-mon-collectors)
-                               list-of-mon-collectors))
-                    (reverse result)
-                    (loop (cdr list-of-mon-collectors)
-                          (cdr dates-list)
-                          (cons (if do-intervals?
-                                    (collector->monetary
-                                     (gnc:collector- (cadr list-of-mon-collectors)
-                                                     (car list-of-mon-collectors))
-                                     (cadr dates-list))
-                                    (collector->monetary
-                                     (car list-of-mon-collectors)
-                                     (car dates-list)))
-                                result))))))
-
-          (define (count-accounts current-depth accts)
-            (if (< current-depth tree-depth)
-                (let ((sum 0))
-                  (for-each
-                   (lambda (a)
-                     (set! sum (+ sum (1+ (count-accounts (1+ current-depth)
-                                                          (gnc-account-get-children a))))))
-                   accts)
-                  sum)
-                (length (filter show-acct? accts))))
-
-          ;; Calculates all account's balances. Returns a list of pairs:
-          ;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
-          ;; (Gifts (12.3 14.5))), where each element of <balance-list>
-          ;; is the balance corresponding to one element in
-          ;; <dates-list>.
-          ;;
-          ;; If current-depth >= tree-depth, then the balances are
-          ;; calculated *with* subaccount's balances. Else only the
-          ;; current account is regarded. Note: All accounts in accts
-          ;; and all their subaccounts are processed, but a balances is
-          ;; calculated and returned *only* for those accounts where
-          ;; show-acct? is true. This is necessary because otherwise we
-          ;; would forget an account that is selected but not its
-          ;; parent.
-          (define (traverse-accounts current-depth accts)
-            (if (< current-depth tree-depth)
-                (let ((res '()))
-                  (for-each
-                   (lambda (a)
-                     (begin
-                       (set! work-done (1+ work-done))
-                       (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
-                       (if (show-acct? a)
-                           (set! res
-                             (cons (list a (account->balance-list a #f))
-                                   res)))
-                       (set! res (append
-                                  (traverse-accounts
-                                   (1+ current-depth)
-                                   (gnc-account-get-children a))
-                                  res))))
-                   accts)
-                  res)
-                ;; else (i.e. current-depth == tree-depth)
-                (map
+    (cond
+     ((null? accounts)
+      (gnc:html-document-add-object!
+       document
+       (gnc:html-make-no-account-warning
+        report-title (gnc:report-id report-obj))))
+
+     (else
+      (let* ((commodity-list (gnc:accounts-get-commodities
+                              (gnc:accounts-and-all-descendants accounts)
+                              report-currency))
+             (exchange-fn (gnc:case-exchange-time-fn
+                           price-source report-currency
+                           commodity-list to-date-t64
+                           5 15))
+             (averaging-fraction-func (gnc:date-get-fraction-func averaging-selection))
+             (interval-fraction-func (gnc:date-get-fraction-func interval))
+             (averaging-multiplier
+              (if averaging-fraction-func
+                  ;; Calculate the divisor of the amounts so that an
+                  ;; average is shown. Multiplier factor is a gnc-numeric
+                  (let* ((start-frac-avg (averaging-fraction-func from-date-t64))
+                         (end-frac-avg (averaging-fraction-func (1+ to-date-t64)))
+                         (diff-avg (- end-frac-avg start-frac-avg))
+                         (diff-avg-numeric
+                          (/ (inexact->exact (round (* diff-avg 1000000)))
+                             ;; 6 decimals precision
+                             1000000))
+                         (start-frac-int (interval-fraction-func from-date-t64))
+                         (end-frac-int (interval-fraction-func (1+ to-date-t64)))
+                         (diff-int (- end-frac-int start-frac-int))
+                         (diff-int-numeric (inexact->exact diff-int)))
+                    ;; Extra sanity check to ensure a number smaller than 1
+                    (if (> diff-avg diff-int)
+                        (/ diff-int-numeric diff-avg-numeric)
+                        1))
+                  1))
+             ;; If there is averaging, the report-title is extended
+             ;; accordingly.
+             (report-title
+              (case averaging-selection
+                ((MonthDelta) (string-append report-title " " (G_ "Monthly Average")))
+                ((WeekDelta) (string-append report-title " " (G_ "Weekly Average")))
+                ((DayDelta) (string-append report-title " " (G_ "Daily Average")))
+                (else report-title)))
+             (currency-frac (gnc-commodity-get-fraction report-currency))
+             ;; This is the list of date intervals to calculate.
+             (dates-list (gnc:make-date-list
+                          ((if do-intervals?
+                               gnc:time64-start-day-time
+                               gnc:time64-end-day-time) from-date-t64)
+                          (gnc:time64-end-day-time to-date-t64)
+                          (gnc:deltasym-to-delta interval)))
+             ;; Here the date strings for the x-axis labels are
+             ;; created.
+             (other-anchor ""))
+
+        ;; Converts a commodity-collector into gnc-monetary in the report's
+        ;; currency using the exchange-fn calculated above. Returns a gnc-monetary
+        ;; multiplied by the averaging-multiplier (smaller than one; multiplication
+        ;; instead of division to avoid division-by-zero issues) in case
+        ;; the user wants to see the amounts averaged over some value.
+        (define (collector->monetary c date)
+          (gnc:make-gnc-monetary
+           report-currency
+           (* averaging-multiplier
+              (gnc:gnc-monetary-amount
+               (gnc:sum-collector-commodity
+                c report-currency
+                (lambda (a b) (exchange-fn a b date)))))))
+
+        (define (all-zeros data)
+          (cond
+           ((gnc:gnc-monetary? data) (zero? (gnc:gnc-monetary-amount data)))
+           ((pair? data) (every all-zeros data))
+           (else (error 'huh))))
+
+        ;; this is an alist of account-balances
+        ;; (list (list acc0 bal0 bal1 bal2 ...)
+        ;;       (list acc1 bal0 bal1 bal2 ...)
+        ;;       ...)
+        ;; whereby each balance is a gnc-monetary
+        (define account-balances-alist
+          (map
+           (lambda (acc)
+             (let* ((comm (xaccAccountGetCommodity acc))
+                    (split->elt (if reverse-bal?
+                                    (lambda (s)
+                                      (gnc:make-gnc-monetary
+                                       comm (- (xaccSplitGetNoclosingBalance s))))
+                                    (lambda (s)
+                                      (gnc:make-gnc-monetary
+                                       comm (xaccSplitGetNoclosingBalance s))))))
+               (cons acc
+                     (gnc:account-accumulate-at-dates
+                      acc dates-list
+                      #:split->elt split->elt
+                      #:nosplit->elt (gnc:make-gnc-monetary comm 0)))))
+           ;; all selected accounts (of report-specific type), *and*
+           ;; their descendants (of any type) need to be scanned.
+           (gnc:accounts-and-all-descendants accounts)))
+
+        ;; Creates the <balance-list> to be used in the function
+        ;; below.
+        (define (account->balance-list account subacct?)
+          (let* ((accountslist (cons account
+                                     (if subacct?
+                                         (gnc-account-get-descendants account)
+                                         '())))
+                 (selected-balances (filter
+                                     (lambda (entry)
+                                       (member (car entry) accountslist))
+                                     account-balances-alist))
+                 (selected-monetaries (map cdr selected-balances))
+                 (list-of-mon-collectors (apply map gnc:monetaries-add selected-monetaries)))
+            (let loop ((list-of-mon-collectors list-of-mon-collectors)
+                       (dates-list dates-list)
+                       (result '()))
+              (if (null? (if do-intervals?
+                             (cdr list-of-mon-collectors)
+                             list-of-mon-collectors))
+                  (reverse result)
+                  (loop (cdr list-of-mon-collectors)
+                        (cdr dates-list)
+                        (cons (if do-intervals?
+                                  (collector->monetary
+                                   (gnc:collector- (cadr list-of-mon-collectors)
+                                                   (car list-of-mon-collectors))
+                                   (cadr dates-list))
+                                  (collector->monetary
+                                   (car list-of-mon-collectors)
+                                   (car dates-list)))
+                              result))))))
+
+        (define (count-accounts current-depth accts)
+          (if (< current-depth tree-depth)
+              (let ((sum 0))
+                (for-each
+                 (lambda (a)
+                   (set! sum
+                     (+ sum (1+ (count-accounts (1+ current-depth)
+                                                (gnc-account-get-children a))))))
+                 accts)
+                sum)
+              (length (filter show-acct? accts))))
+
+        (set! work-to-do (count-accounts 1 topl-accounts))
+
+        ;; Calculates all account's balances. Returns a list of pairs:
+        ;; (<account> <balance-list>), like '((Earnings (10.0 11.2))
+        ;; (Gifts (12.3 14.5))), where each element of <balance-list>
+        ;; is the balance corresponding to one element in
+        ;; <dates-list>.
+        ;;
+        ;; If current-depth >= tree-depth, then the balances are
+        ;; calculated *with* subaccount's balances. Else only the
+        ;; current account is regarded. Note: All accounts in accts
+        ;; and all their subaccounts are processed, but a balances is
+        ;; calculated and returned *only* for those accounts where
+        ;; show-acct? is true. This is necessary because otherwise we
+        ;; would forget an account that is selected but not its
+        ;; parent.
+        (define (traverse-accounts current-depth accts)
+          (if (< current-depth tree-depth)
+              (let ((res '()))
+                (for-each
                  (lambda (a)
                    (set! work-done (1+ work-done))
                    (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
-                   (list a (account->balance-list a #t)))
-                 (filter show-acct? accts))))
-
-
-          ;; The percentage done numbers here are a hack so that
-          ;; something gets displayed. On my system the
-          ;; gnc:case-exchange-time-fn takes about 20% of the time
-          ;; building up a list of prices for later use. Either this
-          ;; routine needs to send progress reports, or the price
-          ;; lookup should be distributed and done when actually
-          ;; needed so as to amortize the cpu time properly.
-          (gnc:report-percent-done 1)
-          (set! commodity-list (gnc:accounts-get-commodities
-                                (gnc:accounts-and-all-descendants accounts)
-                                report-currency))
-          (set! exchange-fn (gnc:case-exchange-time-fn
-                             price-source report-currency
-                             commodity-list to-date-t64
-                             5 15))
-
-          (set! work-to-do (count-accounts 1 topl-accounts))
-
-          ;; Sort the account list according to the account code field.
-          (set! all-data
-            (sort
-             (filter (lambda (l)
-                       (not (zero? (gnc:gnc-monetary-amount
-                                    (apply gnc:monetary+ (cadr l))))))
-                     (traverse-accounts 1 topl-accounts))
-             (case sort-method
-               ((alphabetical)
-                (lambda (a b)
-                  (if show-fullname?
-                      (gnc:string-locale<? (gnc-account-get-full-name (car a))
-                                           (gnc-account-get-full-name (car b)))
-                      (gnc:string-locale<? (xaccAccountGetName (car a))
-                                           (xaccAccountGetName (car b))))))
-               ((acct-code)
-                (lambda (a b)
-                  (gnc:string-locale<? (xaccAccountGetCode (car a))
-                                       (xaccAccountGetCode (car b)))))
-               ((amount)
-                (lambda (a b)
-                  (> (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr a)))
-                     (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr b)))))))))
-
-          ;; Proceed if the data is non-zeros
-          (if
-           (and (not (null? all-data))
-                (not-all-zeros  (map cadr all-data)))
-
-           (let* ((dates-list (if do-intervals?
-                                  (list-head dates-list (1- (length dates-list)))
-                                  dates-list))
-                  (date-string-list (map qof-print-date dates-list)))
-
-             ;; Set chart title, subtitle etc.
-
-             (gnc:html-chart-set-type!
-              chart (if (eq? chart-type 'barchart) 'bar 'line))
-
-             (gnc:html-chart-set-title!
-              chart (list report-title
-                          (format #f
-                                  (if do-intervals?
-                                      (G_ "~a to ~a")
-                                      (G_ "Balances ~a to ~a"))
-                                  (qof-print-date from-date-t64)
-                                  (qof-print-date to-date-t64))))
-
-             (gnc:html-chart-set-width! chart width)
-             (gnc:html-chart-set-height! chart height)
-
-             (gnc:html-chart-set-data-labels! chart date-string-list)
-             (gnc:html-chart-set-y-axis-label!
-              chart (gnc-commodity-get-mnemonic report-currency))
-
-             ;; If we have too many categories, we sum them into a new
-             ;; 'other' category and add a link to a new report with just
-             ;; those accounts.
-             (if (> (length all-data) max-slices)
-                 (let* ((start (take all-data (1- max-slices)))
-                        (finish (drop all-data (1- max-slices)))
-                        (other-sum (map
-                                    (lambda (l) (apply gnc:monetary+ l))
-                                    (apply zip (map cadr finish)))))
-                   (set! all-data
-                     (append start
-                             (list (list (G_ "Other") other-sum))))
-                   (let* ((options (gnc:make-report-options reportguid)))
-                     ;; now copy all the options
-                     (gnc:options-copy-values
-                      (gnc:report-options report-obj) options)
-                     ;; and set the destination accounts
-                     (gnc:option-set-value
-                      (gnc:lookup-option options gnc:pagename-accounts
-                                         optname-accounts)
-                      (map car finish))
-                     ;; Set the URL to point to this report.
-                     (set! other-anchor
-                       (gnc:report-anchor-text
-                        (gnc:make-report reportguid options))))))
-
-             (gnc:report-percent-done 92)
-
-             (for-each
-              (lambda (series color stack)
-                (let* ((acct (car series))
-                       (label (cond
-                               ((string? acct)
-                                (car series))
-                               (show-fullname?
-                                (gnc-account-get-full-name acct))
-                               (else (xaccAccountGetName acct))))
-                       (amounts (map gnc:gnc-monetary-amount (cadr series)))
-                       (stack (if stacked?
-                                  "default"
-                                  (number->string stack)))
-                       (fill (eq? chart-type 'barchart))
-                       (urls (cond
-                              ((string? acct)
-                               other-anchor)
-
-                              ((null? (gnc-account-get-children acct))
-                               (gnc:account-anchor-text acct))
-
-                              ;; because the tree-depth option for
-                              ;; accounts/levels goes up to 6. FIXME:
-                              ;; magic number.
-                              ((>= tree-depth 6)
-                               (gnc:account-anchor-text acct))
-
-                              (else
-                               (gnc:make-report-anchor
-                                reportguid report-obj
+                   (if (show-acct? a)
+                       (set! res
+                         (cons (list a (account->balance-list a #f))
+                               res)))
+                   (set! res
+                     (append (traverse-accounts
+                              (1+ current-depth)
+                              (gnc-account-get-children a))
+                             res)))
+                 accts)
+                res)
+              ;; else (i.e. current-depth == tree-depth)
+              (map
+               (lambda (a)
+                 (set! work-done (1+ work-done))
+                 (gnc:report-percent-done (+ 20 (* 70 (/ work-done work-to-do))))
+                 (list a (account->balance-list a #t)))
+               (filter show-acct? accts))))
+
+        ;; Sort the account list according to the account code field.
+        (define all-data
+          (sort
+           (filter (lambda (l)
+                     (not (zero? (gnc:gnc-monetary-amount
+                                  (apply gnc:monetary+ (cadr l))))))
+                   (traverse-accounts 1 topl-accounts))
+           (case sort-method
+             ((alphabetical)
+              (lambda (a b)
+                (if show-fullname?
+                    (gnc:string-locale<? (gnc-account-get-full-name (car a))
+                                         (gnc-account-get-full-name (car b)))
+                    (gnc:string-locale<? (xaccAccountGetName (car a))
+                                         (xaccAccountGetName (car b))))))
+             ((acct-code)
+              (lambda (a b)
+                (gnc:string-locale<? (xaccAccountGetCode (car a))
+                                     (xaccAccountGetCode (car b)))))
+             ((amount)
+              (lambda (a b)
+                (> (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr a)))
+                   (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr b)))))))))
+
+        (cond
+         ((or (null? all-data) (all-zeros (map cadr all-data)))
+          (gnc:html-document-add-object!
+           document
+           (gnc:html-make-empty-data-warning
+            report-title (gnc:report-id report-obj))))
+
+         (else
+          (let* ((dates-list (if do-intervals?
+                                 (list-head dates-list (1- (length dates-list)))
+                                 dates-list))
+                 (date-string-list (map qof-print-date dates-list)))
+
+            ;; Set chart title, subtitle etc.
+            (gnc:html-chart-set-type!
+             chart (if (eq? chart-type 'barchart) 'bar 'line))
+
+            (gnc:html-chart-set-title!
+             chart (list report-title
+                         (format #f
+                                 (if do-intervals?
+                                     (G_ "~a to ~a")
+                                     (G_ "Balances ~a to ~a"))
+                                 (qof-print-date from-date-t64)
+                                 (qof-print-date to-date-t64))))
+
+            (gnc:html-chart-set-width! chart width)
+            (gnc:html-chart-set-height! chart height)
+
+            (gnc:html-chart-set-data-labels! chart date-string-list)
+            (gnc:html-chart-set-y-axis-label!
+             chart (gnc-commodity-get-mnemonic report-currency))
+
+            ;; If we have too many categories, we sum them into a new
+            ;; 'other' category and add a link to a new report with just
+            ;; those accounts.
+            (if (> (length all-data) max-slices)
+                (let* ((start (take all-data (1- max-slices)))
+                       (finish (drop all-data (1- max-slices)))
+                       (other-sum (map
+                                   (lambda (l) (apply gnc:monetary+ l))
+                                   (apply zip (map cadr finish)))))
+                  (set! all-data
+                    (append start
+                            (list (list (G_ "Other") other-sum))))
+                  (let* ((options (gnc:make-report-options reportguid)))
+                    ;; now copy all the options
+                    (gnc:options-copy-values
+                     (gnc:report-options report-obj) options)
+                    ;; and set the destination accounts
+                    (gnc:option-set-value
+                     (gnc:lookup-option options gnc:pagename-accounts
+                                        optname-accounts)
+                     (map car finish))
+                    ;; Set the URL to point to this report.
+                    (set! other-anchor
+                      (gnc:report-anchor-text
+                       (gnc:make-report reportguid options))))))
+
+            (gnc:report-percent-done 92)
+
+            (for-each
+             (lambda (series color stack)
+               (let* ((acct (car series))
+                      (label (cond
+                              ((string? acct) (car series))
+                              (show-fullname? (gnc-account-get-full-name acct))
+                              (else (xaccAccountGetName acct))))
+                      (amounts (map gnc:gnc-monetary-amount (cadr series)))
+                      (stack (if stacked? "default" (number->string stack)))
+                      (fill (eq? chart-type 'barchart))
+                      (urls (cond
+                             ((string? acct) other-anchor)
+                             ((null? (gnc-account-get-children acct))
+                              (gnc:account-anchor-text acct))
+
+                             ;; because the tree-depth option for
+                             ;; accounts/levels goes up to 6. FIXME:
+                             ;; magic number.
+                             ((>= tree-depth 6) (gnc:account-anchor-text acct))
+
+                             (else
+                              (gnc:make-report-anchor
+                               reportguid report-obj
+                               (list
+                                (list gnc:pagename-accounts optname-accounts
+                                      (cons acct (gnc-account-get-children acct)))
+                                (list gnc:pagename-accounts optname-levels
+                                      (1+ tree-depth))
+                                (list gnc:pagename-general
+                                      gnc:optname-reportname
+                                      (if show-fullname?
+                                          (gnc-account-get-full-name acct)
+                                          (xaccAccountGetName acct)))))))))
+                 (gnc:html-chart-add-data-series!
+                  chart label amounts color
+                  'stack stack 'fill fill 'urls urls)))
+             all-data
+             (gnc:assign-colors (length all-data))
+             (iota (length all-data)))
+
+            (gnc:html-chart-set-stacking?! chart stacked?)
+            (gnc:html-chart-set-currency-iso!
+             chart (gnc-commodity-get-mnemonic report-currency))
+            (gnc:html-chart-set-currency-symbol!
+             chart (gnc-commodity-get-nice-symbol report-currency))
+
+            (gnc:report-percent-done 98)
+            (gnc:html-document-add-object! document chart)
+
+            (when show-table?
+              (let ((table (gnc:make-html-table))
+                    (scu (gnc-commodity-get-fraction report-currency))
+                    (cols>1? (pair? (cdr all-data))))
+
+                (define (make-cell contents)
+                  (gnc:make-html-table-cell/markup "number-cell" contents))
+
+                (for-each
+                 (lambda (date row)
+                   (gnc:html-table-append-row!
+                    table
+                    (append (list (make-cell date))
+                            (map make-cell row)
+                            (if cols>1?
                                 (list
-                                 (list gnc:pagename-accounts optname-accounts
-                                       (cons acct (gnc-account-get-children acct)))
-                                 (list gnc:pagename-accounts optname-levels
-                                       (1+ tree-depth))
-                                 (list gnc:pagename-general
-                                       gnc:optname-reportname
-                                       (if show-fullname?
-                                           (gnc-account-get-full-name acct)
-                                           (xaccAccountGetName acct)))))))))
-                  (gnc:html-chart-add-data-series!
-                   chart label amounts color
-                   'stack stack 'fill fill 'urls urls)))
-              all-data
-              (gnc:assign-colors (length all-data))
-              (iota (length all-data)))
-
-             (gnc:html-chart-set-stacking?! chart stacked?)
-             (gnc:html-chart-set-currency-iso!
-              chart (gnc-commodity-get-mnemonic report-currency))
-             (gnc:html-chart-set-currency-symbol!
-              chart (gnc-commodity-get-nice-symbol report-currency))
-
-             (gnc:report-percent-done 98)
-             (gnc:html-document-add-object! document chart)
-
-             (when show-table?
-               (let ((table (gnc:make-html-table))
-                     (scu (gnc-commodity-get-fraction report-currency))
-                     (cols>1? (pair? (cdr all-data))))
-
-                 (define (make-cell contents)
-                   (gnc:make-html-table-cell/markup "number-cell" contents))
-
-                 (for-each
-                  (lambda (date row)
-                    (gnc:html-table-append-row!
-                     table
-                     (append (list (make-cell date))
-                             (map make-cell row)
-                             (if cols>1?
-                                 (list
-                                  (make-cell (apply gnc:monetary+ row)))
-                                 '()))))
-                  date-string-list
-                  (apply zip (map cadr all-data)))
-
-                 (gnc:html-table-set-col-headers!
-                  table
-                  (append
-                   (list (G_ "Date"))
-                   (map
-                    (lambda (col)
-                      (cond
-                       ((string? col) col)
-                       (show-fullname? (gnc-account-get-full-name col))
-                       (else (xaccAccountGetName col))))
-                    (map car all-data))
-                   (if cols>1?
-                       (list (G_ "Grand Total"))
-                       '())))
-
-                 (gnc:html-document-add-object! document table)))
-
-             (cond
-              ((eq? export-type 'csv)
-               (let ((iso-date (qof-date-format-get-string QOF-DATE-FORMAT-ISO)))
-                 (gnc:html-document-set-export-string
-                  document
-                  (gnc:lists->csv
-                   (cons (append
-                          (list (G_ "Date"))
-                          (map
-                           (lambda (col)
-                             (cond
-                              ((string? col) col)
-                              (show-fullname? (gnc-account-get-full-name col))
-                              (else (xaccAccountGetName col))))
-                           (map car all-data))
-                          (if (pair? (cdr all-data))
-                              (list (G_ "Grand Total"))
-                              '()))
+                                 (make-cell (apply gnc:monetary+ row)))
+                                '()))))
+                 date-string-list
+                 (apply zip (map cadr all-data)))
+
+                (gnc:html-table-set-col-headers!
+                 table
+                 (append
+                  (list (G_ "Date"))
+                  (map
+                   (lambda (col)
+                     (cond
+                      ((string? col) col)
+                      (show-fullname? (gnc-account-get-full-name col))
+                      (else (xaccAccountGetName col))))
+                   (map car all-data))
+                  (if cols>1?
+                      (list (G_ "Grand Total"))
+                      '())))
+
+                (gnc:html-document-add-object! document table)))
+
+            (cond
+             ((eq? export-type 'csv)
+              (let ((iso-date (qof-date-format-get-string QOF-DATE-FORMAT-ISO)))
+                (gnc:html-document-set-export-string
+                 document
+                 (gnc:lists->csv
+                  (cons (append
+                         (list (G_ "Date"))
                          (map
-                          (lambda (date row)
-                            (append
-                             (list date)
-                             row
-                             (if (pair? (cdr all-data))
-                                 (list (apply gnc:monetary+ row))
-                                 '())))
-                          (map (cut gnc-print-time64 <> iso-date) dates-list)
-                          (apply zip (map cadr all-data))))))))))
-
-           ;; else if empty data
-           (gnc:html-document-add-object!
-            document
-            (gnc:html-make-empty-data-warning
-             report-title (gnc:report-id report-obj)))))
-
-        ;; else if no accounts selected
-        (gnc:html-document-add-object!
-         document
-         (gnc:html-make-no-account-warning
-          report-title (gnc:report-id report-obj))))
+                          (lambda (col)
+                            (cond
+                             ((string? col) col)
+                             (show-fullname? (gnc-account-get-full-name col))
+                             (else (xaccAccountGetName col))))
+                          (map car all-data))
+                         (if (pair? (cdr all-data))
+                             (list (G_ "Grand Total"))
+                             '()))
+                        (map
+                         (lambda (date row)
+                           (append
+                            (list date)
+                            row
+                            (if (pair? (cdr all-data))
+                                (list (apply gnc:monetary+ row))
+                                '())))
+                         (map (cut gnc-print-time64 <> iso-date) dates-list)
+                         (apply zip (map cadr all-data)))))))))))))))
 
     (unless (gnc:html-document-export-string document)
       (gnc:html-document-set-export-error document (G_ "No exportable data")))

commit 9f09be4b648a1519909c99b15a2144d649b0429f
Author: Renato Aguiar <renato at renatoaguiar.net>
Date:   Thu Jan 14 06:49:46 2021 -0800

    Fix memory leak in import-export

diff --git a/gnucash/import-export/import-main-matcher.c b/gnucash/import-export/import-main-matcher.c
index 92d3f7b08..bcab57276 100644
--- a/gnucash/import-export/import-main-matcher.c
+++ b/gnucash/import-export/import-main-matcher.c
@@ -708,13 +708,15 @@ gnc_gen_trans_assign_transfer_account (GtkTreeView *treeview,
     Account *old_acc;
     gboolean ok_pressed;
     gchar *path_str = gtk_tree_path_to_string (path);
+    gchar *acct_str = gnc_get_account_name_for_register (*new_acc);
 
     ENTER("");
     DEBUG("first = %s", *first ? "true" : "false");
     DEBUG("is_selection = %s", is_selection ? "true" : "false");
     DEBUG("path  = %s", path_str);
     g_free (path_str);
-    DEBUG("account passed in = %s", gnc_get_account_name_for_register (*new_acc));
+    DEBUG("account passed in = %s", acct_str);
+    g_free (acct_str);
 
     // only allow response at the top level
     if (gtk_tree_path_get_depth (path) != 1)



Summary of changes:
 gnucash/import-export/import-main-matcher.c        |   4 +-
 .../report/reports/standard/category-barchart.scm  | 797 ++++++++++-----------
 2 files changed, 394 insertions(+), 407 deletions(-)



More information about the gnucash-changes mailing list