IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

ENH: Add debit/credit friendly names in subheading rendering

Browse Source 
Also add UI to toggle friendly headers
This commit is contained in:
Christopher Lam 2017-11-30 16:07:27 +08:00
parent 139e2aa7f2
commit 3de3d3cc9a
1 changed files with 72 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
gnucash/report/standard-reports/transaction.scm
View File

@ -71,6 +71,7 @@
(define optname-full-account-name (N_ "Show Full Account Name"))
(define optname-show-account-code (N_ "Show Account Code"))
(define optname-show-account-description (N_ "Show Account Description"))
(define optname-show-informal-headers (N_ "Show Informal Debit/Credit Headers"))
(define optname-sec-sortkey (N_ "Secondary Key"))
(define optname-sec-subtotal (N_ "Secondary Subtotal"))
(define optname-sec-sortorder (N_ "Secondary Sort Order"))
@ -117,6 +118,7 @@ options specified in the Options panels."))
(define SUBTOTAL-ENABLED (list 'account-name 'corresponding-acc-name
'account-code 'corresponding-acc-code))
(define SORTKEY-INFORMAL-HEADERS (list 'account-name 'account-code))
(define sortkey-list
;;
@ -556,6 +558,11 @@ tags within description, notes or memo. ")
(or (and prime-sortkey-subtotal-enabled prime-sortkey-subtotal-true)
(and sec-sortkey-subtotal-enabled sec-sortkey-subtotal-true)))
(gnc-option-db-set-option-selectable-by-name
options pagename-sorting optname-show-informal-headers
(or (member prime-sortkey (list 'account-name 'account-code))
(member sec-sortkey (list 'account-name 'account-code))))
(gnc-option-db-set-option-selectable-by-name
options pagename-sorting optname-prime-date-subtotal
prime-date-sortingtype-enabled)
@ -595,7 +602,15 @@ tags within description, notes or memo. ")
"j3"
(_ "Show the account description for subheadings?")
#f))
(gnc:register-trep-option
(gnc:make-simple-boolean-option
pagename-sorting optname-show-informal-headers
"j4"
(_ "Show the informal headers for debit/credit accounts?")
#f))
(gnc:register-trep-option
(gnc:make-complex-boolean-option
pagename-sorting optname-prime-subtotal
@ -984,6 +999,8 @@ tags within description, notes or memo. ")
(report-currency (lambda (s) (if (column-uses? 'common-currency)
(opt-val gnc:pagename-general optname-currency)
(currency s))))
(friendly-debit (lambda (a) (gnc:get-debit-string (xaccAccountGetType a))))
(friendly-credit (lambda (a) (gnc:get-credit-string (xaccAccountGetType a))))
(header-commodity (lambda (str)
(string-append
str
@ -1019,47 +1036,55 @@ tags within description, notes or memo. ")
(running-balance (lambda (s) (gnc:make-gnc-monetary (currency s) (xaccSplitGetBalance s)))))
(append
;; each column will be a vector
;; (vector heading calculator-function reverse-column? subtotal? (vector start-dual-column? merging-function))
;; (calculator-function split) to obtain amount
;; reverse? to optionally reverse signs
;; subtotal? to allow subtotals (ie irrelevant for running balance)
;; merge? to merge with the next cell (ie for debit/credit cells)
;; merging-function - function (usually gnc-numeric-add/sub-fixed to apply to dual-subtotal
;; (vector heading
;; calculator-function ;; (calculator-function split) to obtain amount
;; reverse-column? ;; to optionally reverse signs
;; subtotal? ;; subtotal? to allow subtotals (ie irrelevant for running balance)
;; (vector start-dual-column? ;; #t for the left side of a dual column (i.e. debit/credit)
;; merging-function)) ;; function to apply to dual-subtotal (gnc-numeric-add/sub)
;; friendly-heading-fn ;; retrieve friendly heading name for account debit/credit
(if (column-uses? 'amount-single)
(list (vector (header-commodity (_ "Amount"))
amount #t #t
(vector #f #f)))
(vector #f #f)
(lambda (a) "")))
'())
(if (column-uses? 'amount-double)
(list (vector (header-commodity (_ "Debit"))
debit-amount #f #t
(vector #t gnc-numeric-add))
(vector #t gnc-numeric-add)
friendly-debit)
(vector (header-commodity (_ "Credit"))
credit-amount #f #t
(vector #f gnc-numeric-sub)))
(vector #f gnc-numeric-sub)
friendly-credit))
'())
(if (and (column-uses? 'amount-original-currency)
(column-uses? 'amount-single))
(list (vector (_ "Amount")
original-amount #t #t
(vector #f #f)))
(vector #f #f)
(lambda (a) "")))
'())
(if (and (column-uses? 'amount-original-currency)
(column-uses? 'amount-double))
(list (vector (_ "Debit")
original-debit-amount #f #t
(vector #t gnc-numeric-add))
(vector #t gnc-numeric-add)
friendly-debit)
(vector (_ "Credit")
original-credit-amount #f #t
(vector #f gnc-numeric-sub)))
(vector #f gnc-numeric-sub)
friendly-credit))
'())
(if (column-uses? 'running-balance)
(list (vector (_ "Running Balance")
running-balance #t #f
(vector #f #f)))
(vector #f #f)
(lambda (a) "")))
'()))))
(define headings-left-columns
@ -1075,11 +1100,33 @@ tags within description, notes or memo. ")
(define width-left-columns (length left-columns))
(define width-right-columns (length calculated-cells))
(define (add-subheading data subheading-style)
(let ((heading-cell (gnc:make-html-table-cell data)))
(gnc:html-table-cell-set-colspan! heading-cell (+ width-left-columns width-right-columns))
(gnc:html-table-append-row/markup!
table subheading-style (list heading-cell))))
(define (add-subheading data subheading-style split level)
(let ((sortkey (opt-val pagename-sorting
(case level
((primary) optname-prime-sortkey)
((secondary) optname-sec-sortkey)))))
(if (and (opt-val pagename-sorting optname-show-informal-headers)
(member sortkey SORTKEY-INFORMAL-HEADERS))
(let ((row-contents '()))
(begin
(if export?
(begin (addto! row-contents (gnc:make-html-table-cell subheading-style data))
(for-each (lambda (cell) (addto! row-contents cell))
(gnc:html-make-empty-cells (- width-left-columns 1))))
(addto! row-contents (gnc:make-html-table-cell/size 1 width-left-columns data)))
(map (lambda (col)
(addto! row-contents
(gnc:make-html-table-cell
"<b>"
((vector-ref col 5)
((keylist-get-info sortkey-list sortkey 'renderer-fn) split))
"</b>")))
calculated-cells)
(gnc:html-table-append-row/markup! table subheading-style (reverse row-contents))))
(let ((heading-cell (gnc:make-html-table-cell data)))
(gnc:html-table-cell-set-colspan! heading-cell (+ width-left-columns width-right-columns))
(gnc:html-table-append-row/markup!
table subheading-style (list heading-cell))))))
(define (add-subtotal-row subtotal-string subtotal-collectors subtotal-style)
(let* ((row-contents '())
@ -1391,10 +1438,10 @@ tags within description, notes or memo. ")
(if next
(begin
(add-subheading (render-summary next 'primary #t)
def:primary-subtotal-style)
def:primary-subtotal-style next 'primary)
(if secondary-subtotal-comparator
(add-subheading (render-summary next 'secondary #t)
def:secondary-subtotal-style)))))
def:secondary-subtotal-style next 'secondary)))))
(if (and secondary-subtotal-comparator
(or (not next)
@ -1409,7 +1456,7 @@ tags within description, notes or memo. ")
secondary-subtotal-collectors)
(if next
(add-subheading (render-summary next 'secondary #t)
def:secondary-subtotal-style)))))
def:secondary-subtotal-style next 'secondary)))))
(do-rows-with-subtotals rest (not odd-row?)))))
@ -1417,12 +1464,12 @@ tags within description, notes or memo. ")
(if (primary-get-info 'renderer-fn)
(add-subheading (render-summary (car splits) 'primary #t)
def:primary-subtotal-style))
def:primary-subtotal-style (car splits) 'primary))
(if (secondary-get-info 'renderer-fn)
(add-subheading (render-summary (car splits) 'secondary #t)
def:secondary-subtotal-style))
def:secondary-subtotal-style (car splits) 'secondary))
(do-rows-with-subtotals splits #t)
table))