gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Mon Aug 17 11:42:38 EDT 2020


Updated	 via  https://github.com/Gnucash/gnucash/commit/d149042d (commit)
	 via  https://github.com/Gnucash/gnucash/commit/3296da00 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/f8e976e9 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/582ded39 (commit)
	from  https://github.com/Gnucash/gnucash/commit/6d44d067 (commit)



commit d149042d74911c9f2cd02fea7a74c515abfe4a4d
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Aug 17 23:07:37 2020 +0800

    [net-charts] CSV export uses ISO dates
    
    * also add CSV export-error if no export-string

diff --git a/gnucash/report/reports/standard/net-charts.scm b/gnucash/report/reports/standard/net-charts.scm
index 6f5928098..2c72da5e3 100644
--- a/gnucash/report/reports/standard/net-charts.scm
+++ b/gnucash/report/reports/standard/net-charts.scm
@@ -444,14 +444,19 @@
 
              (cond
               ((eq? export-type 'csv)
-               (gnc:html-document-set-export-string
-                document
-                (gnc:lists->csv
-                 (cons (if inc-exp?
-                           (map G_ '("Date" "Income" "Expense" "Net Profit"))
-                           (map G_ '("Date" "Assets" "Liabilities" "Net Worth")))
-                       (map list date-string-list minuend-balances
-                            subtrahend-balances difference-balances)))))))
+               (let ((old-fmt (qof-date-format-get)))
+                 (qof-date-format-set QOF-DATE-FORMAT-ISO)
+                 (gnc:html-document-set-export-string
+                  document
+                  (gnc:lists->csv
+                   (cons (if inc-exp?
+                             (map G_ '("Date" "Income" "Expense" "Net Profit"))
+                             (map G_ '("Date" "Assets" "Liabilities" "Net Worth")))
+                         (map list
+                              (map qof-print-date dates-list)
+                              minuend-balances
+                              subtrahend-balances difference-balances))))
+                 (qof-date-format-set old-fmt)))))
            (gnc:html-document-add-object!
             document
             (gnc:html-make-empty-data-warning
@@ -463,6 +468,9 @@
       (gnc:html-make-no-account-warning
        report-title (gnc:report-id report-obj))))
 
+    (unless (gnc:html-document-export-string document)
+      (gnc:html-document-set-export-error document (G_ "No exportable data")))
+
     (gnc:report-finished)
     document))
 

commit 3296da001c40642fb0ac6b5004f681dcc60910ef
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Aug 17 23:06:08 2020 +0800

    [category-barchart] add CSV export for table data

diff --git a/gnucash/report/reports/standard/category-barchart.scm b/gnucash/report/reports/standard/category-barchart.scm
index de8277a27..772ba5de2 100644
--- a/gnucash/report/reports/standard/category-barchart.scm
+++ b/gnucash/report/reports/standard/category-barchart.scm
@@ -212,7 +212,8 @@ developing over time"))
 ;; *really* complicated.
 
 (define (category-barchart-renderer report-obj reportname reportguid
-                                    account-types do-intervals? reverse-bal?)
+                                    account-types do-intervals? reverse-bal?
+                                    export-type)
   ;; A helper functions for looking up option values.
   (define (get-option section name)
     (gnc:option-value
@@ -635,7 +636,38 @@ developing over time"))
                        (list (G_ "Grand Total"))
                        '())))
 
-                 (gnc:html-document-add-object! document table))))
+                 (gnc:html-document-add-object! document table)))
+
+             (cond
+              ((eq? export-type 'csv)
+               (let ((old-fmt (qof-date-format-get)))
+                 (qof-date-format-set 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"))
+                              '()))
+                         (map
+                          (lambda (date row)
+                            (append
+                             (list date)
+                             row
+                             (if (pair? (cdr all-data))
+                                 (list (apply gnc:monetary+ row))
+                                 '())))
+                          (map qof-print-date dates-list)
+                          (apply zip (map cadr all-data))))))
+                 (qof-date-format-set old-fmt)))))
 
            ;; else if empty data
            (gnc:html-document-add-object!
@@ -649,6 +681,9 @@ developing over time"))
          (gnc:html-make-no-account-warning
           report-title (gnc:report-id report-obj))))
 
+    (unless (gnc:html-document-export-string document)
+      (gnc:html-document-set-export-error document (G_ "No exportable data")))
+
     (gnc:report-finished)
     document))
 
@@ -665,9 +700,15 @@ developing over time"))
      'menu-name menuname
      'menu-tip menutip
      'options-generator (lambda () (options-generator account-types inc-exp?))
+     'export-types '(("CSV" . csv))
+     'export-thunk (lambda (report-obj export-type filename)
+                     (category-barchart-renderer
+                      report-obj reportname uuid account-types inc-exp? reverse-bal?
+                      export-type))
      'renderer (lambda (report-obj)
                  (category-barchart-renderer
-                  report-obj reportname uuid account-types inc-exp? reverse-bal?)))))
+                  report-obj reportname uuid account-types inc-exp? reverse-bal?
+                  #f)))))
  (list
   ;; reportname, account-types, inc-exp?,
   ;; menu-reportname, menu-tip, reverse-bal?, uuid

commit f8e976e91391c20355c5a338602c0b6ae51c5ba4
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Aug 17 23:07:55 2020 +0800

    [category-barchart] simplify table constructor

diff --git a/gnucash/report/reports/standard/category-barchart.scm b/gnucash/report/reports/standard/category-barchart.scm
index 50fe2ea76..de8277a27 100644
--- a/gnucash/report/reports/standard/category-barchart.scm
+++ b/gnucash/report/reports/standard/category-barchart.scm
@@ -602,28 +602,21 @@ developing over time"))
              (when show-table?
                (let ((table (gnc:make-html-table))
                      (scu (gnc-commodity-get-fraction report-currency))
-                     (cols>1? (> (length all-data) 1)))
+                     (cols>1? (pair? (cdr all-data))))
 
                  (define (make-cell contents)
                    (gnc:make-html-table-cell/markup "number-cell" contents))
 
-                 (define (monetary-round mon)
-                   (gnc:make-gnc-monetary
-                    report-currency
-                    (gnc-numeric-convert
-                     (gnc:gnc-monetary-amount mon)
-                     scu GNC-HOW-RND-ROUND)))
-
                  (for-each
                   (lambda (date row)
                     (gnc:html-table-append-row!
-                     table (map make-cell (append (list date)
-                                                  (map monetary-round row)
-                                                  (if cols>1?
-                                                      (list
-                                                       (monetary-round
-                                                        (apply gnc:monetary+ 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)))
 

commit 582ded399670de381d322dce783010b3e0abaee1
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Aug 17 22:04:42 2020 +0800

    [price-scatter] compact code, add more interval options
    
    fixes longstanding unreported bug - quarter/halfyear were not being
    handled!

diff --git a/gnucash/report/reports/standard/price-scatter.scm b/gnucash/report/reports/standard/price-scatter.scm
index d50326528..a10e7f130 100644
--- a/gnucash/report/reports/standard/price-scatter.scm
+++ b/gnucash/report/reports/standard/price-scatter.scm
@@ -30,6 +30,7 @@
 (use-modules (gnucash app-utils))
 (use-modules (gnucash report))
 (use-modules (srfi srfi-1))
+(use-modules (ice-9 match))
 
 (define optname-from-date (N_ "Start Date"))
 (define optname-to-date (N_ "End Date"))
@@ -133,6 +134,15 @@
     (gnc:option-value 
      (gnc:lookup-option (gnc:report-options report-obj) section name)))
 
+  (define intervals
+    (list (list 'DayDelta (G_ "Days") 86400)
+          (list 'WeekDelta (G_ "Weeks") 604800)
+          (list 'TwoWeekDelta (G_ "Double-Weeks") 1209600)
+          (list 'MonthDelta (G_ "Months") 2628000)
+          (list 'QuarterDelta (G_ "Quarters") (/ 31536000 4))
+          (list 'HalfYearDelta (G_ "Half Years") (/ 31536000 2))
+          (list 'YearDelta (G_ "Years") 31536000)))
+
   (let* ((to-date (gnc:time64-end-day-time 
                    (gnc:date-option-absolute-time
                     (get-option gnc:pagename-general 
@@ -173,6 +183,8 @@
 	 (invert (get-option pagename-price optname-invert))
          (amount-commodity (if invert price-commodity report-currency))
          (base-commodity (if invert report-currency price-commodity))
+         (int-label (car (assq-ref intervals interval)))
+         (int-secs (cadr (assq-ref intervals interval)))
          (data '()))
 
     ;; Short helper for all the warnings below
@@ -213,140 +225,98 @@
                            ((dash) "line")))
 
     (gnc:html-chart-set-y-axis-label!
-     chart
-     ;; Check for whether it is commodity against currency or
-     ;; the other way round. 
-     (gnc-commodity-get-mnemonic amount-commodity))
-    (gnc:html-chart-set-x-axis-label!
-     chart (case interval
-             ((DayDelta) (G_ "Days"))
-             ((WeekDelta) (G_ "Weeks"))
-             ((TwoWeekDelta) (G_ "Double-Weeks"))
-             ((MonthDelta) (G_ "Months"))
-             ((YearDelta) (G_ "Years"))))
-
-    (gnc:html-chart-set!
-     chart '(options scales xAxes (0) type) 'linear)
+     chart (gnc-commodity-get-mnemonic amount-commodity))
+
+    (gnc:html-chart-set-x-axis-label! chart int-label)
+
+    (gnc:html-chart-set! chart '(options scales xAxes (0) type) 'linear)
     (gnc:html-chart-set-custom-x-axis-ticks?! chart #f)
 
-    (if
-     (not (gnc-commodity-equiv report-currency price-commodity))
-     (begin
-       (if (or (not (null? currency-accounts))
-               (eq? price-source 'pricedb))
-           (set!
-            data
-            (case price-source
-              ((actual-transactions)
-               (gnc:get-commodity-inst-prices
-                currency-accounts to-date 
-                price-commodity report-currency))
-              ((weighted-average)
-               (gnc:get-commodity-totalavg-prices
-                currency-accounts to-date 
-                price-commodity report-currency))
-              ((pricedb)
-               (map (lambda (p)
-                      (list (gnc-price-get-time64 p)
-                            (gnc-price-get-value p)))
-                    (gnc-pricedb-get-prices
-                     (gnc-pricedb-get-db (gnc-get-current-book))
-                     price-commodity report-currency))))))
-
-       ;; the following transforms data in 1 assignment operation
-       ;; 1. filters prices within specified dates
-       ;; 2. transforms the price-date to numperiod since report start-date
-       ;; 3. inverts the price-ratio if required
-       (set! data
-         (map (lambda (datum)
-                (list
-                 (/ (- (car datum) from-date)
-                    ;; convert the dates to the x-axis scaling of the
-                    ;; scatterplot
-                    (case interval
-                      ((DayDelta) 86400)
-                      ((WeekDelta) 604800)
-                      ((TwoWeekDelta) 1209600)
-                      ((MonthDelta) 2628000)
-                      ((YearDelta) 31536000)))
-                 (if invert
-                     (/ 1 (cadr datum))
-                     (cadr datum))))
-              (filter
-               (lambda (datum)
-                 (<= from-date (car datum) to-date))
-               data)))
-
-       (gnc:html-chart-set-data-labels!
-        chart (map
-               (lambda (datum)
-                 (format #f "~2,2f ~a = ~a"
-                         (car datum)
-                         (case interval
-                           ((DayDelta) (G_ "Days"))
-                           ((WeekDelta) (G_ "Weeks"))
-                           ((TwoWeekDelta) (G_ "Double-Weeks"))
-                           ((MonthDelta) (G_ "Months"))
-                           ((YearDelta) (G_ "Years")))
-                         (gnc:monetary->string
-                          (gnc:make-gnc-monetary
-                           amount-commodity
-                           (cadr datum)))))
-               data))
-
-       (gnc:html-chart-add-data-series!
-        chart (G_ "Price")
-        (map
-         (lambda (datum)
-           (list
-            (cons 'x (car datum))
-            (cons 'y (cadr datum))))
-         data)
-        mcolor
-        'pointBorderColor mcolor
-        'fill #f
-        'borderColor "#4bb2c5"
-        'pointBackgroundColor (if (memq marker '(filledcircle filledsquare filleddiamond))
-                                  mcolor
-                                  "white"))
-
-       (cond
-        ((null? data)
-         (make-warning
-          (G_ "No data")
-          (G_ "There is no price information available for the \
+    (cond
+     ((gnc-commodity-equiv report-currency price-commodity)
+      (make-warning
+       (G_ "Identical commodities")
+       (G_ "Your selected commodity and the currency of the report \
+are identical. It doesn't make sense to show prices for identical \
+commodities.")))
+
+     (else
+      (when (or (not (null? currency-accounts)) (eq? price-source 'pricedb))
+        (set! data
+          (case price-source
+            ((actual-transactions)
+             (gnc:get-commodity-inst-prices
+              currency-accounts to-date price-commodity report-currency))
+            ((weighted-average)
+             (gnc:get-commodity-totalavg-prices
+              currency-accounts to-date price-commodity report-currency))
+            ((pricedb)
+             (map (lambda (p)
+                    (list (gnc-price-get-time64 p) (gnc-price-get-value p)))
+                  (gnc-pricedb-get-prices
+                   (gnc-pricedb-get-db (gnc-get-current-book))
+                   price-commodity report-currency))))))
+
+      ;; the following transforms data in 1 assignment operation
+      ;; 1. filters prices within specified dates
+      ;; 2. transforms the price-date to numperiod since report start-date
+      ;; 3. inverts the price-ratio if required
+      (set! data
+        (filter-map
+         (match-lambda
+           ((date amt)
+            (and (<= from-date date to-date)
+                 (list (/ (- date from-date) int-secs)
+                       (if invert (/ 1 amt) amt)))))
+         data))
+
+      (cond
+       ((null? data)
+        (make-warning
+         (G_ "No data")
+         (G_ "There is no price information available for the \
 selected commodities in the selected time period.")))
 
-        ((<= (length data) 1)
-         (make-warning
-          (G_ "Only one price")
-          (G_ "There was only one single price found for the \
+       ((<= (length data) 1)
+        (make-warning
+         (G_ "Only one price")
+         (G_ "There was only one single price found for the \
 selected commodities in the selected time period. This doesn't give \
 a useful plot.")))
 
-        ((apply equal? (map cadr data))
-         (make-warning
-          (G_ "All Prices equal")
-          (G_ "All the prices found are equal. \
+       ((apply equal? (map cadr data))
+        (make-warning
+         (G_ "All Prices equal")
+         (G_ "All the prices found are equal. \
 This would result in a plot with one straight line. \
 Unfortunately, the plotting tool can't handle that.")))
 
-        ((apply equal? (map car data))
-         (make-warning
-          (G_ "All Prices at the same date")
-          (G_ "All the prices found are from the same date. \
+       ((apply equal? (map car data))
+        (make-warning
+         (G_ "All Prices at the same date")
+         (G_ "All the prices found are from the same date. \
 This would result in a plot with one straight line. \
 Unfortunately, the plotting tool can't handle that.")))
 
-        (else
-         (gnc:html-document-add-object! document chart))))
-
-     ;; warning if report-currency == price-commodity
-     (make-warning
-      (G_ "Identical commodities")
-      (G_ "Your selected commodity and the currency of the report \
-are identical. It doesn't make sense to show prices for identical \
-commodities.")))
+       (else
+        (gnc:html-chart-set-data-labels!
+         chart (map
+                (match-lambda
+                  ((x y)
+                   (format #f "~2,2f ~a = ~a"
+                           x int-label (gnc:monetary->string
+                                        (gnc:make-gnc-monetary amount-commodity y)))))
+                data))
+
+        (gnc:html-chart-add-data-series!
+         chart (G_ "Price")
+         (map (match-lambda ((x y) (list (cons 'x x) (cons 'y y)))) data)
+         mcolor
+         'pointBorderColor mcolor 'fill #f 'borderColor "#4bb2c5"
+         'pointBackgroundColor
+         (if (memq marker '(filledcircle filledsquare filleddiamond)) mcolor "white"))
+
+        (gnc:html-document-add-object! document chart)))))
 
     document))
 



Summary of changes:
 .../report/reports/standard/category-barchart.scm  |  70 +++++--
 gnucash/report/reports/standard/net-charts.scm     |  24 ++-
 gnucash/report/reports/standard/price-scatter.scm  | 212 +++++++++------------
 3 files changed, 159 insertions(+), 147 deletions(-)



More information about the gnucash-changes mailing list