mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
REFACTOR: rewrite renderers to lookup 'renderer-key from sortlists
This commit is contained in:
Christopher Lam
parent
afc6ca078c
commit
8e4d72b544
@ -111,101 +111,100 @@ options specified in the Options panels."))
|
||||
'account-code 'corresponding-acc-code))
|
||||
|
||||
|
||||
|
||||
(define sortkey-list
|
||||
;;
|
||||
;; Defines the different sorting keys, as an association-list
|
||||
;; together with the subtotal functions. Each entry:
|
||||
;; Defines the different sorting keys, as an association-list
|
||||
;; together with the subtotal functions. Each entry:
|
||||
;; 'sortkey - sort parameter sent via qof-query
|
||||
;; 'split-sortvalue - function which retrieves number/string used for comparing splits
|
||||
;; 'text - text displayed in Display tab
|
||||
;; 'tip - tooltip displayed in Display tab
|
||||
;; 'renderer - helper symbol to select subtotal/subheading renderer
|
||||
;; 'renderer-key - helper symbol to select subtotal/subheading renderer
|
||||
;;
|
||||
(list (cons 'account-name (list (cons 'sortkey (list SPLIT-ACCT-FULLNAME))
|
||||
(cons 'split-sortvalue (lambda (a) (gnc-account-get-full-name (xaccSplitGetAccount a))))
|
||||
(cons 'text (N_ "Account Name"))
|
||||
(cons 'tip (N_ "Sort & subtotal by account name."))
|
||||
(cons 'renderer 'account)))
|
||||
|
||||
(cons 'renderer-key 'account)))
|
||||
|
||||
(cons 'account-code (list (cons 'sortkey (list SPLIT-ACCOUNT ACCOUNT-CODE-))
|
||||
(cons 'split-sortvalue (lambda (a) (xaccAccountGetCode (xaccSplitGetAccount a))))
|
||||
(cons 'text (N_ "Account Code"))
|
||||
(cons 'tip (N_ "Sort & subtotal by account code."))
|
||||
(cons 'renderer 'account)))
|
||||
(cons 'renderer-key 'account)))
|
||||
|
||||
(cons 'date (list (cons 'sortkey (list SPLIT-TRANS TRANS-DATE-POSTED))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Date"))
|
||||
(cons 'tip (N_ "Sort by date."))
|
||||
(cons 'renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(cons 'reconciled-date (list (cons 'sortkey (list SPLIT-DATE-RECONCILED))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Reconciled Date"))
|
||||
(cons 'tip (N_ "Sort by the Reconciled Date."))
|
||||
(cons 'renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(cons 'register-order (list (cons 'sortkey (list QUERY-DEFAULT-SORT))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Register Order"))
|
||||
(cons 'tip (N_ "Sort as in the register."))
|
||||
(cons 'renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(cons 'corresponding-acc-name (list (cons 'sortkey (list SPLIT-CORR-ACCT-NAME))
|
||||
(cons 'split-sortvalue (lambda (a) (xaccSplitGetCorrAccountFullName a)))
|
||||
(cons 'text (N_ "Other Account Name"))
|
||||
(cons 'tip (N_ "Sort by account transferred from/to's name."))
|
||||
(cons 'renderer 'other-acc)))
|
||||
(cons 'renderer-key 'other-acc)))
|
||||
|
||||
(cons 'corresponding-acc-code (list (cons 'sortkey (list SPLIT-CORR-ACCT-CODE))
|
||||
(cons 'split-sortvalue (lambda (a) (xaccSplitGetCorrAccountCode a)))
|
||||
(cons 'text (N_ "Other Account Code"))
|
||||
(cons 'tip (N_ "Sort by account transferred from/to's code."))
|
||||
(cons 'renderer 'other-acct)))
|
||||
(cons 'renderer-key 'other-acct)))
|
||||
|
||||
(cons 'amount (list (cons 'sortkey (list SPLIT-VALUE))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Amount"))
|
||||
(cons 'tip (N_ "Sort by amount."))
|
||||
(cons 'renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(cons 'description (list (cons 'sortkey (list SPLIT-TRANS TRANS-DESCRIPTION))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Description"))
|
||||
(cons 'tip (N_ "Sort by description."))
|
||||
(cons 'renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(if (qof-book-use-split-action-for-num-field (gnc-get-current-book))
|
||||
(cons 'number (list (cons 'sortkey (list SPLIT-ACTION))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Number/Action"))
|
||||
(cons 'tip (N_ "Sort by check number/action."))
|
||||
(cons 'renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(cons 'number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Number"))
|
||||
(cons 'tip (N_ "Sort by check/transaction number."))
|
||||
(cons 'renderer #f))))
|
||||
(cons 'renderer-key #f))))
|
||||
|
||||
(cons 't-number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Transaction Number"))
|
||||
(cons 'tip (N_ "Sort by transaction number."))
|
||||
(cons 'renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(cons 'memo (list (cons 'sortkey (list SPLIT-MEMO))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "Memo"))
|
||||
(cons 'tip (N_ "Sort by memo."))
|
||||
(cons 'renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(cons 'none (list (cons 'sortkey '())
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "None"))
|
||||
(cons 'tip (N_ "Do not sort."))
|
||||
(cons 'renderer #f)))))
|
||||
(cons 'renderer-key #f)))))
|
||||
|
||||
|
||||
(define (sortkey-get-info sortkey info)
|
||||
@ -221,40 +220,42 @@ options specified in the Options panels."))
|
||||
(define (split-year a) (timepair-year (gnc-transaction-get-date-posted (xaccSplitGetParent a))))
|
||||
|
||||
(define date-subtotal-list
|
||||
;; Extra list for date option. Each entry: (cons
|
||||
;; 'date-subtotal-option-value (vector subtotal-function
|
||||
;; subtotal-renderer))
|
||||
;; List for date option.
|
||||
;; Defines the different date sorting keys, as an association-list. Each entry:
|
||||
;; 'split-sortvalue - function which retrieves number/string used for comparing splits
|
||||
;; 'text - text displayed in Display tab
|
||||
;; 'tip - tooltip displayed in Display tab
|
||||
;; 'renderer-key - helper symbol to select subtotal/subheading renderer
|
||||
(list
|
||||
(cons 'none (list
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (N_ "None"))
|
||||
(cons 'tip (N_ "None."))
|
||||
(cons 'subheading-renderer #f)
|
||||
(cons 'subtotal-renderer #f)))
|
||||
(cons 'renderer-key #f)))
|
||||
|
||||
(cons 'weekly (list
|
||||
(cons 'split-sortvalue split-week)
|
||||
(cons 'text (N_ "Weekly"))
|
||||
(cons 'tip (N_ "Weekly."))
|
||||
(cons 'subheading-renderer render-week-subheading)
|
||||
(cons 'subtotal-renderer render-week-subtotal)))
|
||||
(cons 'renderer-key 'week)))
|
||||
|
||||
(cons 'monthly (list
|
||||
(cons 'split-sortvalue split-month)
|
||||
(cons 'text (N_ "Monthly"))
|
||||
(cons 'tip (N_ "Monthly."))
|
||||
(cons 'subheading-renderer render-month-subheading)
|
||||
(cons 'subtotal-renderer render-month-subtotal)))
|
||||
(cons 'renderer-key 'month)))
|
||||
|
||||
(cons 'quarterly (list
|
||||
(cons 'split-sortvalue split-quarter)
|
||||
(cons 'text (N_ "Quarterly"))
|
||||
(cons 'tip (N_ "Quarterly."))
|
||||
(cons 'subheading-renderer render-quarter-subheading)
|
||||
(cons 'subtotal-renderer render-quarter-subtotal)))
|
||||
(cons 'renderer-key 'quarter)))
|
||||
|
||||
(cons 'yearly (list
|
||||
(cons 'split-sortvalue split-year)
|
||||
(cons 'text (N_ "Yearly"))
|
||||
(cons 'tip (N_ "Yearly."))
|
||||
(cons 'subheading-renderer render-year-subheading)
|
||||
(cons 'subtotal-renderer render-year-subtotal)))))
|
||||
(cons 'renderer-key 'year)))))
|
||||
|
||||
(define (date-subtotal-get-info sortkey info)
|
||||
(cdr (assq info (cdr (assq sortkey date-subtotal-list)))))
|
||||
@ -702,12 +703,10 @@ Credit Card, and Income accounts."))))))
|
||||
;; Here comes the big function that builds the whole table.
|
||||
|
||||
(define (make-split-table splits options
|
||||
primary-subtotal-pred
|
||||
secondary-subtotal-pred
|
||||
primary-subheading-renderer
|
||||
secondary-subheading-renderer
|
||||
primary-subtotal-renderer
|
||||
secondary-subtotal-renderer)
|
||||
primary-subtotal-comparator
|
||||
secondary-subtotal-comparator
|
||||
primary-renderer-key
|
||||
secondary-renderer-key)
|
||||
|
||||
(define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name)))
|
||||
(define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book)))
|
||||
@ -852,81 +851,16 @@ Credit Card, and Income accounts."))))))
|
||||
(xaccAccountGetName account))
|
||||
""))))
|
||||
|
||||
;; render an account subheading - used-columns determines what is displayed
|
||||
(define (render-account-subheading split)
|
||||
(let ((account (xaccSplitGetAccount split)))
|
||||
(gnc:make-html-text
|
||||
(gnc:html-markup-anchor
|
||||
(gnc:account-anchor-text account)
|
||||
(account-namestring account
|
||||
(column-uses? 'sort-account-code used-columns)
|
||||
#t
|
||||
(column-uses? 'sort-account-full-name used-columns))))))
|
||||
|
||||
(define (render-corresponding-account-subheading split)
|
||||
(let ((account (xaccSplitGetAccount (xaccSplitGetOtherSplit split))))
|
||||
(gnc:make-html-text
|
||||
(gnc:html-markup-anchor
|
||||
(if (null? account)
|
||||
""
|
||||
(gnc:account-anchor-text account))
|
||||
(account-namestring account
|
||||
(column-uses? 'sort-account-code used-columns)
|
||||
#t
|
||||
(column-uses? 'sort-account-full-name used-columns))))))
|
||||
|
||||
(define (render-week-subheading split)
|
||||
(gnc:date-get-week-year-string
|
||||
(define (render-date renderer-key split)
|
||||
((case renderer-key
|
||||
((week) gnc:date-get-week-year-string)
|
||||
((month) gnc:date-get-month-year-string)
|
||||
((quarter) gnc:date-get-quarter-year-string)
|
||||
((year) gnc:date-get-year-string))
|
||||
(gnc:timepair->date
|
||||
(gnc-transaction-get-date-posted
|
||||
(xaccSplitGetParent split)))))
|
||||
|
||||
(define (render-month-subheading split)
|
||||
(gnc:date-get-month-year-string
|
||||
(gnc:timepair->date
|
||||
(gnc-transaction-get-date-posted
|
||||
(xaccSplitGetParent split)))))
|
||||
|
||||
(define (render-quarter-subheading split)
|
||||
(gnc:date-get-quarter-year-string
|
||||
(gnc:timepair->date
|
||||
(gnc-transaction-get-date-posted
|
||||
(xaccSplitGetParent split)))))
|
||||
|
||||
|
||||
(define (render-year-subheading split)
|
||||
(gnc:date-get-year-string
|
||||
(gnc:timepair->date
|
||||
(gnc-transaction-get-date-posted
|
||||
(xaccSplitGetParent split)))))
|
||||
|
||||
(define (render-account-subtotal split)
|
||||
(account-namestring (xaccSplitGetAccount split)
|
||||
(column-uses? 'sort-account-code used-columns)
|
||||
#t
|
||||
(column-uses? 'sort-account-full-name used-columns)))
|
||||
|
||||
(define (render-corresponding-account-subtotal split)
|
||||
(account-namestring (xaccSplitGetAccount (xaccSplitGetOtherSplit split))
|
||||
(column-uses? 'sort-account-code used-columns)
|
||||
#t
|
||||
(column-uses? 'sort-account-full-name used-columns)))
|
||||
|
||||
(define (render-week-subtotal split)
|
||||
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted (xaccSplitGetParent split)))))
|
||||
(gnc:date-get-week-year-string tm)))
|
||||
|
||||
(define (render-month-subtotal split)
|
||||
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted (xaccSplitGetParent split)))))
|
||||
(gnc:date-get-month-year-string tm)))
|
||||
|
||||
(define (render-quarter-subtotal split)
|
||||
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted (xaccSplitGetParent split)))))
|
||||
(gnc:date-get-quarter-year-string tm)))
|
||||
|
||||
(define (render-year-subtotal split)
|
||||
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted (xaccSplitGetParent split)))))
|
||||
(strftime "%Y" tm)))
|
||||
(define (render-account renderer-key split anchor?)
|
||||
(let* ((account (case renderer-key
|
||||
((account) (xaccSplitGetAccount split))
|
||||
@ -954,29 +888,7 @@ Credit Card, and Income accounts."))))))
|
||||
(define (render-grand-total)
|
||||
(_ "Grand Total"))
|
||||
|
||||
(define (subheading-renderer split key)
|
||||
((case key
|
||||
((week) render-week-subheading)
|
||||
((month) render-month-subheading)
|
||||
((quarter) render-quarter-subheading)
|
||||
((year) render-year-subheading)
|
||||
((account) render-account-subheading)
|
||||
((other-acc) render-corresponding-account-subheading))
|
||||
split))
|
||||
|
||||
(define (subtotal-renderer split key)
|
||||
((case key
|
||||
((week) render-week-subtotal)
|
||||
((month) render-month-subtotal)
|
||||
((quarter) render-quarter-subtotal)
|
||||
((year) render-year-subtotal)
|
||||
((account) render-account-subtotal)
|
||||
((other-acc) render-corresponding-account-subtotal))
|
||||
split))
|
||||
|
||||
|
||||
(define (add-split-row split row-style transaction-row?)
|
||||
|
||||
(let* ((row-contents '())
|
||||
(parent (xaccSplitGetParent split))
|
||||
(account (xaccSplitGetAccount split))
|
||||
@ -1199,28 +1111,25 @@ Credit Card, and Income accounts."))))))
|
||||
(if secondary-subtotal-pred
|
||||
|
||||
(begin
|
||||
|
||||
(add-subtotal-row (secondary-subtotal-renderer current used-columns)
|
||||
(add-subtotal-row (total-string
|
||||
(render-summary current secondary-renderer-key #f))
|
||||
secondary-subtotal-collector
|
||||
def:secondary-subtotal-style)
|
||||
|
||||
(secondary-subtotal-collector 'reset #f #f)))
|
||||
|
||||
(add-subtotal-row (primary-subtotal-renderer current used-columns)
|
||||
(add-subtotal-row (total-string
|
||||
(render-summary current primary-renderer-key #f))
|
||||
primary-subtotal-collector
|
||||
def:primary-subtotal-style)
|
||||
|
||||
(primary-subtotal-collector 'reset #f #f)
|
||||
|
||||
(if next
|
||||
|
||||
(begin
|
||||
|
||||
(add-subheading (primary-subheading-renderer next used-columns)
|
||||
(add-subheading (render-summary next primary-renderer-key #t)
|
||||
def:primary-subtotal-style)
|
||||
|
||||
(if secondary-subtotal-pred
|
||||
(add-subheading (secondary-subheading-renderer next used-columns)
|
||||
(if secondary-subtotal-comparator
|
||||
(add-subheading (render-summary next secondary-renderer-key #t)
|
||||
def:secondary-subtotal-style)))))
|
||||
|
||||
(if (and secondary-subtotal-pred
|
||||
@ -1228,15 +1137,15 @@ Credit Card, and Income accounts."))))))
|
||||
(and next
|
||||
(not (equal? (secondary-subtotal-pred current)
|
||||
(secondary-subtotal-pred next))))))
|
||||
|
||||
(begin (add-subtotal-row (secondary-subtotal-renderer current used-columns)
|
||||
(begin (add-subtotal-row (total-string
|
||||
(render-summary current secondary-renderer-key #f))
|
||||
secondary-subtotal-collector
|
||||
def:secondary-subtotal-style)
|
||||
|
||||
(secondary-subtotal-collector 'reset #f #f)
|
||||
|
||||
(if next
|
||||
(add-subheading (secondary-subheading-renderer next used-columns)
|
||||
(add-subheading (render-summary next secondary-renderer-key #t)
|
||||
def:secondary-subtotal-style)))))
|
||||
|
||||
(do-rows-with-subtotals rest
|
||||
@ -1245,38 +1154,21 @@ Credit Card, and Income accounts."))))))
|
||||
width
|
||||
multi-rows?
|
||||
(not odd-row?)
|
||||
export?
|
||||
account-types-to-reverse
|
||||
primary-subtotal-pred
|
||||
secondary-subtotal-pred
|
||||
primary-subheading-renderer
|
||||
secondary-subheading-renderer
|
||||
primary-subtotal-renderer
|
||||
secondary-subtotal-renderer
|
||||
primary-subtotal-collector
|
||||
secondary-subtotal-collector
|
||||
total-collector))))
|
||||
|
||||
(gnc:html-table-set-col-headers! table headings)
|
||||
|
||||
(if primary-subheading-renderer
|
||||
(add-subheading (primary-subheading-renderer (car splits) used-columns)
|
||||
(if primary-renderer-key
|
||||
(add-subheading (render-summary (car splits) primary-renderer-key #t)
|
||||
def:primary-subtotal-style))
|
||||
|
||||
(if secondary-subheading-renderer
|
||||
(add-subheading (secondary-subheading-renderer (car splits) used-columns)
|
||||
(if secondary-renderer-key
|
||||
(add-subheading (render-summary (car splits) secondary-renderer-key #t)
|
||||
def:secondary-subtotal-style))
|
||||
|
||||
(do-rows-with-subtotals splits table used-columns width
|
||||
is-multiline? #t
|
||||
export?
|
||||
account-types-to-reverse
|
||||
primary-subtotal-pred
|
||||
secondary-subtotal-pred
|
||||
primary-subheading-renderer
|
||||
secondary-subheading-renderer
|
||||
primary-subtotal-renderer
|
||||
secondary-subtotal-renderer
|
||||
(do-rows-with-subtotals splits #t
|
||||
(gnc:make-commodity-collector)
|
||||
(gnc:make-commodity-collector)
|
||||
(gnc:make-commodity-collector))
|
||||
@ -1445,20 +1337,12 @@ Credit Card, and Income accounts."))))))
|
||||
(subtotal-get-info optname-prime-sortkey
|
||||
optname-prime-subtotal
|
||||
optname-prime-date-subtotal
|
||||
'subheading-renderer)
|
||||
'renderer-key)
|
||||
(subtotal-get-info optname-sec-sortkey
|
||||
optname-sec-subtotal
|
||||
optname-sec-date-subtotal
|
||||
'subheading-renderer)
|
||||
(subtotal-get-info optname-prime-sortkey
|
||||
optname-prime-subtotal
|
||||
optname-prime-date-subtotal
|
||||
'subtotal-renderer)
|
||||
(subtotal-get-info optname-sec-sortkey
|
||||
optname-sec-subtotal
|
||||
optname-sec-date-subtotal
|
||||
'subtotal-renderer))))
|
||||
|
||||
'renderer-key))))
|
||||
|
||||
(gnc:html-document-set-title! document report-title)
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
|
||||
Loading…
Reference in New Issue
Block a user