[TR] [bugfix] upgrade add-subtotal-row & grid for >1 commodities.

This aims to handle multiple commodities correctly. If a row contains
subtotals with more than one commodity, the row is duplicated so that
every commodity gets its own line in the grid.

This is accompanied by an upgrade to the test suite.

Sample output if prime-sortkey = accounts, sec-sortkey = monthly dates

        Jan-17  Feb-17  Mar-17   Total
Food    $22.00  $23.00  $35.00  $80.00
Books    $8.50   $9.55  $15.00  $33.05
Apps     £2.55   £5.00   £9.60  £17.15
Total                          $113.05
                                £17.15

(note monthly totals are not displayed because they're not actually
generated with the above sorting options)

gnucash/report/standard-reports/test/test-transaction.scm

@@ -115,6 +115,7 @@
               (list "USD Bank")
               (list "Wallet"))
         (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
+        (list "Income-GBP" (list (cons 'type ACCT-TYPE-INCOME)))
         (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
         (list "Liabilities" (list (cons 'type ACCT-TYPE-LIABILITY)))
         (list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))
@@ -134,6 +135,7 @@
          (usd-bank (cdr (assoc "USD Bank" account-alist)))
          (wallet (cdr (assoc "Wallet" account-alist)))
          (income (cdr (assoc "Income" account-alist)))
+         (gbp-income (cdr (assoc "Income-GBP" account-alist)))
          (expense (cdr (assoc "Expenses" account-alist)))
          (liability (cdr (assoc "Liabilities" account-alist)))
          (equity (cdr (assoc "Equity" account-alist)))
@@ -168,13 +170,22 @@
        (xaccAccountSetCommodity (cdr pair) (gnc-default-report-currency)))
      account-alist)
 
-    ;; Here we set foreign banks' currencies
+    ;; Here we set foreign currencies
+
+    (gnc-commodity-set-user-symbol foreign2 "£")
+
     (with-account
      gbp-bank
      (lambda ()
        (xaccAccountSetCode gbp-bank "01-GBP")
        (xaccAccountSetCommodity gbp-bank foreign2)))
 
+    (with-account
+     gbp-income
+     (lambda ()
+       (xaccAccountSetCode gbp-income "01-GBP")
+       (xaccAccountSetCommodity gbp-income foreign2)))
+
     (with-account
      usd-bank
      (lambda ()
@@ -239,7 +250,9 @@
     ;; run in modern times, otherwise these transactions will be mixed
     ;; up with the old transactions above. The year end net bank balance
     ;; should be (* 12 (+ 103 109 -22)) = $2280.
+    ;; there will also be a £51 income monthly, tested at end of file
     (for-each (lambda (m)
+                (env-transfer env 08 (1+ m) YEAR gbp-income gbp-bank 51 #:description "£51 income")
                 (env-transfer env 03 (1+ m) YEAR income bank  103 #:description "$103 income")
                 (env-transfer env 15 (1+ m) YEAR bank expense  22 #:description "$22 expense")
                 (env-transfer env 09 (1+ m) YEAR income bank  109 #:description "$109 income"))
@@ -728,13 +741,13 @@
       (set-option! options "Sorting" "Secondary Subtotal for Date Key" 'quarterly)
       (set-option! options "Sorting" "Show Informal Debit/Credit Headers" #t)
       (set-option! options "Sorting" "Show Account Description" #t)
-      (let* ((sxml (options->sxml options "sorting=date")))
+      (let* ((sxml (options->sxml options "sorting=date, friendly headers")))
         (test-equal "expense acc friendly headers"
           '("\n" "Expenses" "\n" "Expense" "\n" "Rebate")
-          (get-row-col sxml 47 #f))
+          (get-row-col sxml 69 #f))
         (test-equal "income acc friendly headers"
           '("\n" "Income" "\n" "Charge" "\n" "Income")
-          (get-row-col sxml 69 #f)))
+          (get-row-col sxml 91 #f)))
 
       (set-option! options "Accounts" "Accounts" (list bank))
       (set-option! options "Display" "Totals" #f)
@@ -781,7 +794,7 @@
     (test-begin "subtotal table")
 
     (let ((options (default-testing-options)))
-      (set-option! options "Accounts" "Accounts" (list bank income expense))
+      (set-option! options "Accounts" "Accounts" (list bank gbp-bank gbp-income income expense))
       (set-option! options "General" "Start Date" (cons 'relative 'start-cal-year))
       (set-option! options "General" "End Date" (cons 'relative 'end-cal-year))
       (set-option! options "Display" "Subtotal Table" #t)
@@ -794,18 +807,29 @@
           (list "Bank" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00"
                 "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$2,280.00")
           (get-row-col sxml 1 #f))
+        (test-equal "summary gbp bank-row is correct"
+          (list "GBP Bank" "£51.00" "£51.00" "£51.00" "£51.00" "£51.00" "£51.00"
+                "£51.00" "£51.00" "£51.00" "£51.00" "£51.00" "£51.00" "£612.00")
+          (get-row-col sxml 2 #f))
         (test-equal "summary expense-row is correct"
           (list "Expenses" "$22.00" "$22.00" "$22.00" "$22.00" "$22.00" "$22.00"
                 "$22.00" "$22.00" "$22.00" "$22.00" "$22.00" "$22.00" "$264.00")
-          (get-row-col sxml 2 #f))
+          (get-row-col sxml 3 #f))
         (test-equal "summary income-row is correct"
           (list "Income" "-$212.00" "-$212.00" "-$212.00" "-$212.00" "-$212.00"
                 "-$212.00" "-$212.00" "-$212.00" "-$212.00" "-$212.00" "-$212.00"
                 "-$212.00" "-$2,544.00")
-          (get-row-col sxml 3 #f))
+          (get-row-col sxml 4 #f))
+        (test-equal "summary gbp income-row is correct"
+          (list "Income-GBP" "-£51.00" "-£51.00" "-£51.00" "-£51.00" "-£51.00" "-£51.00"
+                "-£51.00" "-£51.00" "-£51.00" "-£51.00" "-£51.00" "-£51.00" "-£612.00")
+          (get-row-col sxml 5 #f))
+        (test-equal "summary gbp total-row is correct"
+          (list "Grand Total" "£0.00")
+          (get-row-col sxml 6 #f))
         (test-equal "summary total-row is correct"
-          (list "Grand Total" "$0.00")
+          (list "$0.00")
-          (get-row-col sxml 4 #f)))
+          (get-row-col sxml 7 #f)))
 
       (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 1969)))
       (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 12 1970)))

gnucash/report/standard-reports/transaction.scm

@@ -1375,9 +1375,11 @@ be excluded from periodic reporting.")
                                   (cons (gnc:make-html-table-cell/markup "total-number-cell" mon)
                                         result)))))))))
 
-        ;; we only wish to add the first column into the grid.
+        ;; take the first column of each commodity, add onto the subtotal grid
-        (if (pair? columns)
+        (set! grid (grid-add grid row col
-            (set! grid (grid-add grid row col (car columns))))
+                             (map (lambda (commodity)
+                                    (retrieve-commodity (car columns) commodity))
+                                  list-of-commodities)))
 
         ;; each commodity subtotal gets a separate line in the html-table
         ;; each line comprises: indenting, first-column, data-columns
@@ -1689,17 +1691,17 @@ be excluded from periodic reporting.")
 ;; grid data structure
 (define (make-grid)
   '())
-(define (grid-get grid row col)    ; grid filter - get all row/col - if #f then retrieve whole row/col
+(define (cell-match? cell row col)
-  (filter
-   (lambda (cell)
   (and (or (not row) (equal? row (vector-ref cell 0)))
        (or (not col) (equal? col (vector-ref cell 1)))))
+(define (grid-get grid row col)    ; grid filter - get all row/col - if #f then retrieve whole row/col
+  (filter
+   (lambda (cell) (cell-match? cell row col))
    grid))
 (define (grid-del grid row col)    ; grid filter - del all row/col - if #f then delete whole row/col - CAREFUL!
   (filter
    (lambda (cell)
-     (not (and (or (not row) (equal? row (vector-ref cell 0)))
+     (not (cell-match? cell row col)))
-               (or (not col) (equal? col (vector-ref cell 1))))))
    grid))
 (define (grid-rows grid)
   (delete-duplicates (map (lambda (cell) (vector-ref cell 0)) grid)))
@@ -1710,17 +1712,27 @@ be excluded from periodic reporting.")
   (set! grid (cons (vector row col data) grid)) ;add again. this is fine because the grid should
   grid)                                         ;never have duplicate data in the trep.
 (define (grid->html-table grid list-of-rows list-of-cols)
-  (define (make-table-cell row col)
+  (define (row->num-of-commodities row)
+    ;; for a row, find the maximum number of commodities being stored
+    (apply max
+           (map (lambda (col)
                   (let ((cell (grid-get grid row col)))
-      (if (pair? cell)
+                    (if (null? cell) 0
-          (gnc:make-html-table-cell/markup "number-cell" (car (vector-ref (car cell) 2)))
+                        (length (vector-ref (car cell) 2)))))
-          "")))
+                (cons 'col-total list-of-cols))))
-  (define (make-row row)
+  (define (make-table-cell row col commodity-idx)
+    (let ((cell (grid-get grid row col)))
+      (if (null? cell) ""
+          (gnc:make-html-table-cell/markup "number-cell" (list-ref-safe (vector-ref (car cell) 2) commodity-idx)))))
+  (define (make-row row commodity-idx)
     (append
-     (list (if (eq? row 'row-total) (_ "Grand Total") (cdr row)))
+     (list (cond
-     (map (lambda (col) (make-table-cell row col))
+            ((positive? commodity-idx) "")
+            ((eq? row 'row-total) (_ "Grand Total"))
+            (else (cdr row))))
+     (map (lambda (col) (make-table-cell row col commodity-idx))
           list-of-cols)
-     (list (make-table-cell row 'col-total))))
+     (list (make-table-cell row 'col-total commodity-idx))))
   (let ((table (gnc:make-html-table)))
     (gnc:html-table-set-caption! table optname-grid)
     (gnc:html-table-set-col-headers! table (append (list "") (map cdr list-of-cols) (list (_ "Total"))))
@@ -1728,10 +1740,12 @@ be excluded from periodic reporting.")
                                'attribute (list "class" "column-heading-right"))
     (for-each
      (lambda (row)
-       (gnc:html-table-append-row! table (make-row row)))
+       (for-each (lambda (commodity-idx)
-     list-of-rows)
+                   (gnc:html-table-append-row! table (make-row row commodity-idx)))
+                 (iota (row->num-of-commodities row))))
      (if (memq 'row-total (grid-rows grid))
-        (gnc:html-table-append-row! table (make-row 'row-total)))
+         (append list-of-rows '(row-total))
+         list-of-rows))
     table))
 
 ;; ;;;;;;;;;;;;;;;;;;;;