html-utilities.scm: new home (gnc:html-render-options-changed)

We want to sanitize render-options-changed, therefore it must return
an html-object. Unfortunately this is not accessible to
app-utils/options.scm. If we move this function to
report-system/html-utilities.scm, it can access html-objects.

Also rename it to gnc:html-render-options-changed

gnucash/report/report-system/html-utilities.scm

@@ -818,6 +818,65 @@
        "")
       (_ "Edit report options")))))
 
+(define* (gnc:html-render-options-changed options #:optional plaintext?)
+  ;; options -> html-object or string, depending on plaintext?.  This
+  ;; summarises options that were changed by the user. Set plaintext?
+  ;; to #t for unit-tests only.
+  (define (disp d)
+    ;; option-value -> string.  The option is passed to various
+    ;; scm->string converters; ultimately a generic stringify
+    ;; function handles symbol/string/other types.
+    (define (try proc)
+      ;; Try proc with d as a parameter, catching 'wrong-type-arg
+      ;; exceptions to return #f to the or evaluator.
+      (catch 'wrong-type-arg
+        (lambda () (proc d))
+        (const #f)))
+    (or (and (boolean? d) (if d (_ "Enabled") (_ "Disabled")))
+        (and (null? d) "null")
+        (and (list? d) (string-join (map disp d) ", "))
+        (and (pair? d) (format #f "~a . ~a"
+                               (car d)
+                               (if (eq? (car d) 'absolute)
+                                   (qof-print-date (cdr d))
+                                   (disp (cdr d)))))
+        (try gnc-commodity-get-mnemonic)
+        (try xaccAccountGetName)
+        (try gnc-budget-get-name)
+        (format #f "~a" d)))
+  (let ((render-list '()))
+    (define (add-option-if-changed option)
+      (let* ((section (gnc:option-section option))
+             (name (gnc:option-name option))
+             (default-value (gnc:option-default-value option))
+             (value (gnc:option-value option))
+             (retval (cons (format #f "~a / ~a" section name)
+                           (disp value))))
+        (if (not (or (equal? default-value value)
+                     (char=? (string-ref section 0) #\_)))
+            (set! render-list (cons retval render-list)))))
+    (gnc:options-for-each add-option-if-changed options)
+    (if plaintext?
+        (string-append
+         (string-join
+          (map (lambda (item)
+                 (format #f "~a: ~a\n" (car item) (cdr item)))
+               render-list)
+          "")
+         "\n")
+        (apply
+         gnc:make-html-text
+         (apply
+          append
+          (map
+           (lambda (item)
+             (list
+              (gnc:html-markup-b (car item))
+              ": "
+              (cdr item)
+              (gnc:html-markup-br)))
+           render-list))))))
+
 (define (gnc:html-make-generic-warning
          report-title-string report-id
          warning-title-string warning-string)
@@ -877,3 +936,5 @@
             ((#\>) ">")
             (else c))))
        str))))
+
+

gnucash/report/report-system/report-system.scm

@@ -112,6 +112,7 @@
 (export gnc:html-build-acct-table)
 (export gnc:first-html-build-acct-table)
 (export gnc:html-make-exchangerates)
+(export gnc:html-render-options-changed)
 (export gnc:html-make-generic-warning)
 (export gnc:html-make-no-account-warning)
 (export gnc:html-make-generic-budget-warning)

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

@@ -134,7 +134,7 @@
         (lambda () (xml->sxml render))
         (lambda (k . args)
           (test-assert k #f)            ; XML parse error doesn't cause a crash but logs as a failure
-          (format #t "see render output at ~a\n~a" filename (gnc:render-options-changed options #t)))))))
+          (format #t "see render output at ~a\n~a" filename (gnc:html-render-options-changed options #t)))))))
 
 (define (get-row-col sxml row col)
   ;; sxml, row & col (numbers or #f) -> list-of-string

gnucash/report/standard-reports/transaction.scm

@@ -1880,7 +1880,7 @@ be excluded from periodic reporting.")
           (if (memq infobox-display '(always no-match))
               (gnc:html-document-add-object!
                document
-               (gnc:render-options-changed options))))
+               (gnc:html-render-options-changed options))))
 
         (begin
 
@@ -1956,7 +1956,7 @@ be excluded from periodic reporting.")
                 (if (memq infobox-display '(always no-match))
                     (gnc:html-document-add-object!
                      document
-                     (gnc:render-options-changed options))))
+                     (gnc:html-render-options-changed options))))
 
               (let-values (((table grid) (make-split-table splits options custom-calculated-cells)))
 
@@ -1985,7 +1985,7 @@ be excluded from periodic reporting.")
                 (if (eq? infobox-display 'always)
                     (gnc:html-document-add-object!
                      document
-                     (gnc:render-options-changed options)))
+                     (gnc:html-render-options-changed options)))
 
                 (gnc:html-document-add-object! document table)))))
 

libgnucash/app-utils/app-utils.scm

@@ -101,7 +101,6 @@
 (export gnc:make-radiobutton-option)
 (export gnc:make-radiobutton-callback-option)
 (export gnc:make-list-option)
-(export gnc:render-options-changed)
 (export gnc:options-make-end-date!)
 (export gnc:options-make-date-interval!)
 (export gnc:option-make-internal!)

libgnucash/app-utils/options.scm

@@ -2001,64 +2001,6 @@
                                   (gnc:option-value src-option)))))
     src-options)))
 
-(define* (gnc:render-options-changed options #:optional plaintext?)
-  ;;
-  ;; options -> string
-  ;;
-  ;; this function will generate an string of options that were changed by the user.
-  ;; by default, it produces an html string.
-  ;; the optional plaintext? = #t will ensure the output is suitable for console output
-  ;; omitting all html elements, and is expected to be used for unit tests only.
-  ;;
-  (let ((row-contents '()))
-    (define (disp d)
-      ;; this function will intelligently display the option value. the option-value is subject to various tests
-      ;; the or clause below will test for boolean, null, list, and pairs. each will trigger a custom function
-      ;; returning a string. the pair option is handled differently because its car will define the data type
-      ;; for its cdr which is either a symbol, time64 number, percent or pixels. if the option does not satisfy
-      ;; any of the above, the function attempts to pass it as a parameter to gnc-commodity-get-mnemonic, or
-      ;; xaccAccountGetName, or gnc-budget-get-name; success leads to application of these functions, failure
-      ;; then leads to a generic stringify function which will handle symbol/string/other types.
-      (define (try thunk arg)
-        ;; this helper function will attempt to run thunk with arg as a parameter. we will catch any 
-        ;; 'wrong-type-arg exception, and return the #f value to the or evaluator below.
-        (catch 'wrong-type-arg
-          (lambda () (thunk arg))
-          (lambda (k . args) #f)))
-      (or (and (boolean? d) (if d (_ "Enabled") (_ "Disabled")))
-          (and (null? d) "null")
-          (and (list? d) (string-join (map disp d) ", "))
-          (and (pair? d) (string-append
-                          (disp (car d)) " . "
-                          (case (car d)
-                            ((relative) (symbol->string (cdr d)))
-                            ((absolute) (qof-print-date (cdr d)))
-                            ((pixels percent) (number->string (cdr d)))
-                            (else (format #f "unknown car of pair, cannot determine format for ~A" (cdr d))))))
-          (try gnc-commodity-get-mnemonic d)
-          (try xaccAccountGetName d)
-          (try gnc-budget-get-name d)
-          (format #f "~A" d)))
-    (define (disp-option-if-changed option)
-      ;; this function is called by gnc:options-for-each on each option, and will test whether default value
-      ;; has been changed and the option is not hidden, and display it using (disp val) as above.
-      (let* ((section (gnc:option-section option))
-             (name (gnc:option-name option))
-             (default-value (gnc:option-default-value option))
-             (value (gnc:option-value option))
-             (return-string (string-append (if plaintext? "" "<b>")
-                                           section " / " name
-                                           (if plaintext? "" "</b>")
-                                           ": "
-                                           (disp value))))
-        (if (not (or (equal? default-value value)
-                     (char=? (string-ref section 0) #\_)))
-            (set! row-contents (cons return-string row-contents)))))
-    (gnc:options-for-each disp-option-if-changed options)
-    (string-append (string-join (reverse row-contents)
-                                (if plaintext? "\n" "<br />\n"))
-                   (if plaintext? "\n\n" "<br />\n<br />\n"))))
-
 (define (gnc:send-options db_handle options)
   (gnc:options-for-each
    (lambda (option)