mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
(infobox)->(gnc:render-options-changed) in options.scm
This commit will change (infobox) to a general-purpose renderer for "all options changed by user" in options.scm and can be inserted into any report. It reduces the number of strings required.
This commit is contained in:
Christopher Lam
parent
01e604d8ee
commit
12f3099f59
@ -14,8 +14,6 @@
|
||||
;; - add custom sorter in scheme
|
||||
;; - common currency - optionally show original currency amount
|
||||
;; and enable multiple data columns
|
||||
;; - add informational box, summarising options used, useful
|
||||
;; to troubleshoot reports
|
||||
;; - add support for indenting for better grouping
|
||||
;; - add defaults suitable for a reconciliation report
|
||||
;;
|
||||
@ -1717,83 +1715,6 @@ tags within description, notes or memo. ")
|
||||
(generic-less? X Y 'date 'none #t))
|
||||
|
||||
|
||||
;; infobox
|
||||
(define (infobox)
|
||||
(define (highlight title . data)
|
||||
(string-append "<b>" title "</b>: " (string-join data " ") "<br>"))
|
||||
(define (bool->string tf)
|
||||
(if tf
|
||||
(_ "Enabled")
|
||||
(_ "Disabled")))
|
||||
(gnc:make-html-text
|
||||
(if (string-null? account-matcher)
|
||||
""
|
||||
(string-append
|
||||
(highlight
|
||||
(string-append optname-account-matcher
|
||||
(if (opt-val pagename-filter optname-account-matcher-regex)
|
||||
(_ " regex")
|
||||
""))
|
||||
account-matcher)
|
||||
(highlight
|
||||
(_ "Accounts produced")
|
||||
(string-join (map xaccAccountGetName c_account_1) ", "))))
|
||||
(if (eq? filter-mode 'none)
|
||||
""
|
||||
(highlight
|
||||
(keylist-get-info filter-list filter-mode 'text)
|
||||
(string-join (map xaccAccountGetName c_account_2) ", ")))
|
||||
(if (string-null? transaction-matcher)
|
||||
""
|
||||
(string-append
|
||||
(highlight
|
||||
(string-append optname-transaction-matcher
|
||||
(if (opt-val pagename-filter optname-transaction-matcher-regex)
|
||||
(_ " regex")
|
||||
""))
|
||||
transaction-matcher)))
|
||||
(if reconcile-status-filter
|
||||
(highlight
|
||||
optname-reconcile-status
|
||||
(keylist-get-info reconcile-status-list reconcile-status-filter 'text))
|
||||
"")
|
||||
(if (eq? void-status 'non-void-only)
|
||||
""
|
||||
(highlight
|
||||
optname-void-transactions
|
||||
(keylist-get-info show-void-list void-status 'text)))
|
||||
(if (eq? primary-key 'none)
|
||||
""
|
||||
(highlight
|
||||
optname-prime-sortkey
|
||||
(keylist-get-info sortkey-list primary-key 'text)
|
||||
(keylist-get-info ascending-list primary-order 'text)))
|
||||
(if (eq? primary-key 'none)
|
||||
""
|
||||
(if (member primary-key DATE-SORTING-TYPES)
|
||||
(highlight
|
||||
optname-prime-date-subtotal
|
||||
(keylist-get-info date-subtotal-list primary-date-subtotal 'text))
|
||||
(highlight
|
||||
optname-prime-subtotal
|
||||
(bool->string (opt-val pagename-sorting optname-prime-subtotal)))))
|
||||
(if (eq? secondary-key 'none)
|
||||
""
|
||||
(highlight
|
||||
optname-sec-sortkey
|
||||
(keylist-get-info sortkey-list secondary-key 'text)
|
||||
(keylist-get-info ascending-list secondary-order 'text)))
|
||||
(if (eq? secondary-key 'none)
|
||||
""
|
||||
(if (member secondary-key DATE-SORTING-TYPES)
|
||||
(highlight
|
||||
optname-sec-date-subtotal
|
||||
(keylist-get-info date-subtotal-list secondary-date-subtotal 'text))
|
||||
(highlight
|
||||
optname-sec-subtotal
|
||||
(bool->string (opt-val pagename-sorting optname-sec-subtotal)))))
|
||||
"<br>"))
|
||||
|
||||
(if (or (null? c_account_1) (and-map not c_account_1))
|
||||
|
||||
(if (null? c_account_0)
|
||||
@ -1814,7 +1735,7 @@ tags within description, notes or memo. ")
|
||||
(if (member 'no-match infobox-display)
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(infobox)))))
|
||||
(gnc:render-options-changed options)))))
|
||||
|
||||
(begin
|
||||
|
||||
@ -1881,7 +1802,7 @@ tags within description, notes or memo. ")
|
||||
(if (member 'no-match infobox-display)
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(infobox))))
|
||||
(gnc:render-options-changed options))))
|
||||
|
||||
(let ((table (make-split-table splits options)))
|
||||
|
||||
@ -1899,7 +1820,7 @@ tags within description, notes or memo. ")
|
||||
(if (member 'match infobox-display)
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(infobox)))
|
||||
(gnc:render-options-changed options)))
|
||||
|
||||
(gnc:html-document-add-object! document table)))))
|
||||
|
||||
|
||||
@ -101,6 +101,7 @@
|
||||
(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!)
|
||||
|
||||
|
||||
@ -1987,6 +1987,64 @@
|
||||
(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>"))
|
||||
(if plaintext? "\n\n" "<br><br>"))))
|
||||
|
||||
(define (gnc:send-options db_handle options)
|
||||
(gnc:options-for-each
|
||||
(lambda (option)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user