Skip to content

Commit

Permalink
ENH: Add debit/credit friendly names in subheading rendering
Browse files Browse the repository at this point in the history 
Also add UI to toggle friendly headers
  • Loading branch information
@christopherlam
christopherlam committed Dec 23, 2017
1 parent 139e2aa commit 3de3d3c
Showing 1 changed file with 72 additions and 25 deletions.
97 changes: 72 additions & 25 deletions gnucash/report/standard-reports/transaction.scm
View file
Expand Up @@ -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"))
Expand Down Expand Up @@ -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
;;
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 '())
Expand Down Expand Up @@ -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)
Expand All @@ -1409,20 +1456,20 @@ 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?)))))

(gnc:html-table-set-col-headers! table (concatenate (list headings-left-columns headings-right-columns)))

(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))
Expand Down

0 comments on commit 3de3d3c

Please sign in to comment.