Merge Chris Lam's 'maint-scheme-progress' into maint.

gnucash/report/business-reports/customer-summary.scm

@@ -650,8 +650,8 @@
     (gnc:html-markup-br))))
 
 (define (markup-percent profit sales)
-  (let ((m (gnc-numeric-div profit sales 1000 GNC-HOW-RND-ROUND)))
-    (* 100 (gnc-numeric-to-double m))))
+  (if (zero? sales) 0
+      (* 100 (gnc-numeric-div profit sales 1000 GNC-HOW-RND-ROUND))))
 
 (define (query-split-value sub-query toplevel-query)
   (let ((splits (qof-query-run-subquery sub-query toplevel-query))

gnucash/report/business-reports/invoice.scm

@@ -675,7 +675,8 @@ for styling the invoice. Please see the exported report for the CSS class names.
 (define (make-img img-url)
   ;; just an image
   (gnc:make-html-text
-   (gnc:html-markup-img img-url)))
+   (gnc:html-markup-img
+    (make-file-url img-url))))
 
 (define (make-client-table owner orders options)
   (define (opt-val section name)

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

@@ -472,6 +472,16 @@
              (length ((sxpath '(// (table 1) // (tr -1) // td)) sxml))
              1)))
 
+      (set-option! options "Display" "Enable links" #f)
+      (let ((sxml (options->sxml options "disable hyperlinks")))
+        (test-assert "no anchor when disabling hyperlinks"
+          (zero? (length ((sxpath '(// a // *text*)) sxml)))))
+
+      (set-option! options "Display" "Enable links" #t)
+      (let ((sxml (options->sxml options "enable hyperlinks")))
+        (test-assert "anchors exist when enabling hyperlinks"
+          (positive? (length ((sxpath '(// a // *text*)) sxml)))))
+
       (set-option! options "Display" "Amount" 'none)
       (let ((sxml (options->sxml options "no columns")))
         (test-assert "all display columns off, without amount nor subtotals, there should be 0 column"

gnucash/report/standard-reports/transaction.scm

@@ -844,7 +844,7 @@ be excluded from periodic reporting.")
         (disp-accname? #t)
         (disp-other-accname? #f)
         (detail-is-single? #t)
-        (amount-is-single? #t))
+        (amount-value 'single))
 
     (define (apply-selectable-by-name-display-options)
       (gnc-option-db-set-option-selectable-by-name
@@ -857,11 +857,15 @@ be excluded from periodic reporting.")
 
       (gnc-option-db-set-option-selectable-by-name
        options gnc:pagename-display (N_ "Sign Reverses")
-       amount-is-single?)
+       (eq? amount-value 'single))
 
       (gnc-option-db-set-option-selectable-by-name
        options gnc:pagename-display optname-grid
-       amount-is-single?)
+       (eq? amount-value 'single))
+
+      (gnc-option-db-set-option-selectable-by-name
+       options gnc:pagename-display "Enable links"
+       (not (eq? amount-value 'none)))
 
       (gnc-option-db-set-option-selectable-by-name
        options gnc:pagename-display (N_ "Use Full Other Account Name")
@@ -960,16 +964,21 @@ be excluded from periodic reporting.")
      (gnc:make-multichoice-callback-option
       gnc:pagename-display (N_ "Amount")
       "m" (_ "Display the amount?")
-      'single
+      amount-value
       (list
        (vector 'none   (_ "None") (_ "No amount display."))
        (vector 'single (_ "Single") (_ "Single Column Display."))
        (vector 'double (_ "Double") (_ "Two Column Display.")))
       #f
       (lambda (x)
-        (set! amount-is-single? (eq? x 'single))
+        (set! amount-value x)
         (apply-selectable-by-name-display-options))))
 
+    (gnc:register-trep-option
+     (gnc:make-simple-boolean-option
+      gnc:pagename-display (N_ "Enable links")
+      "m2" (_ "Enable hyperlinks in amounts.") #t))
+
     (gnc:register-trep-option
      (gnc:make-multichoice-option
       gnc:pagename-display (N_ "Sign Reverses")
@@ -1056,6 +1065,7 @@ be excluded from periodic reporting.")
          (work-done 0)
          (table (gnc:make-html-table))
          (used-columns (build-columns-used))
+         (opt-use-links? (opt-val gnc:pagename-display "Enable links"))
          (account-types-to-reverse
           (keylist-get-info sign-reverse-list
                             (opt-val gnc:pagename-display (N_ "Sign Reverses"))
@@ -1472,7 +1482,8 @@ be excluded from periodic reporting.")
                                    (not (string-null? (xaccAccountGetDescription account))))
                               (string-append ": " (xaccAccountGetDescription account))
                               "")))
-        (if (and anchor? (not (null? account))) ;html anchor for 2-split transactions only
+        (if (and anchor? opt-use-links?
+                 (not (null? account))) ;html anchor for 2-split transactions only
             (gnc:make-html-text
              (gnc:html-markup-anchor (gnc:account-anchor-text account) name)
              description)
@@ -1532,17 +1543,21 @@ be excluded from periodic reporting.")
                     split transaction-row?))
                  left-columns)
             (map (lambda (cell)
-                   (let ((cell-monetary (vector-ref cell 0))
-                         (reverse? (and (vector-ref cell 1)
-                                        reversible-account?)))
-                     (and cell-monetary
+                   (let* ((cell-monetary (vector-ref cell 0))
+                          (reverse? (and (vector-ref cell 1)
+                                         reversible-account?))
+                          (cell-content (and cell-monetary
+                                             (if reverse?
+                                                 (gnc:monetary-neg cell-monetary)
+                                                 cell-monetary))))
+                     (and cell-content
                           (gnc:make-html-table-cell/markup
                            "number-cell"
-                           (gnc:html-transaction-anchor
-                            (xaccSplitGetParent split)
-                            (if reverse?
-                                (gnc:monetary-neg cell-monetary)
-                                cell-monetary))))))
+                           (if opt-use-links?
+                               (gnc:html-transaction-anchor
+                                (xaccSplitGetParent split)
+                                cell-content)
+                               cell-content)))))
                  cells))))
 
         (map (lambda (cell)

libgnucash/engine/test/test-extras.scm

@@ -142,20 +142,20 @@
     txn))
 
 (define (gnc-pricedb-create currency commodity time64 value)
-  ;; I think adding pricedb for a DMY date will clobber any existing
-  ;; pricedb entry for that date.
-  (let ((price (gnc-price-create (gnc-get-current-book)))
-        (pricedb (gnc-pricedb-get-db (gnc-get-current-book))))
-    (gnc-price-begin-edit price)
-    (gnc-price-set-commodity price commodity)
-    (gnc-price-set-currency price currency)
-    (gnc-price-set-time64 price time64)
-    (gnc-price-set-source price PRICE-SOURCE-XFER-DLG-VAL)
-    (gnc-price-set-source-string price "test-price")
-    (gnc-price-set-typestr price "test")
-    (gnc-price-set-value price value)
-    (gnc-price-commit-edit price)
-    (gnc-pricedb-add-price pricedb price)))
+  ;; does not check for pre-existing pricedb data on date
+  (unless (gnc-commodity-equiv currency commodity)
+    (let ((price (gnc-price-create (gnc-get-current-book)))
+          (pricedb (gnc-pricedb-get-db (gnc-get-current-book))))
+      (gnc-price-begin-edit price)
+      (gnc-price-set-commodity price commodity)
+      (gnc-price-set-currency price currency)
+      (gnc-price-set-time64 price time64)
+      (gnc-price-set-source price PRICE-SOURCE-XFER-DLG-VAL)
+      (gnc-price-set-source-string price "test-price")
+      (gnc-price-set-typestr price "test")
+      (gnc-price-set-value price value)
+      (gnc-price-commit-edit price)
+      (gnc-pricedb-add-price pricedb price))))
 
 ;; When creating stock transactions always put the stock account and the number
 ;; of shares second, using negative numbers for a sale. e.g., to buy 100 shares