mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
REFACTOR: remove 'renderer-key lookup symbol, simplify custom sorter
This commit is contained in:
Christopher Lam
parent
39dceb5534
commit
a81c348310
@ -125,102 +125,101 @@ options specified in the Options panels."))
|
||||
;; '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
|
||||
;; 'renderer-fn - helper function to select subtotal/subheading renderer
|
||||
;; behaviour varies according to sortkey.
|
||||
;; account-types converts split->account
|
||||
;; #f means the sortkey cannot be subtotalled
|
||||
;;
|
||||
(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 (_ "Account Name"))
|
||||
(cons 'tip (_ "Sort & subtotal by account name."))
|
||||
(cons 'renderer-key 'account)))
|
||||
(cons 'renderer-fn (lambda (a) (xaccSplitGetAccount a)))))
|
||||
|
||||
(cons 'account-code (list (cons 'sortkey (list SPLIT-ACCOUNT ACCOUNT-CODE-))
|
||||
(cons 'split-sortvalue (lambda (a) (xaccAccountGetCode (xaccSplitGetAccount a))))
|
||||
(cons 'text (_ "Account Code"))
|
||||
(cons 'tip (_ "Sort & subtotal by account code."))
|
||||
(cons 'renderer-key 'account)))
|
||||
(cons 'renderer-fn (lambda (a) (xaccSplitGetAccount a)))))
|
||||
|
||||
(cons 'date (list (cons 'sortkey (list SPLIT-TRANS TRANS-DATE-POSTED))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "Date"))
|
||||
(cons 'tip (_ "Sort by date."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #f)))
|
||||
|
||||
(cons 'reconciled-date (list (cons 'sortkey (list SPLIT-DATE-RECONCILED))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "Reconciled Date"))
|
||||
(cons 'tip (_ "Sort by the Reconciled Date."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #f)))
|
||||
|
||||
(cons 'register-order (list (cons 'sortkey (list QUERY-DEFAULT-SORT))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "Register Order"))
|
||||
(cons 'tip (_ "Sort as in the register."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #f)))
|
||||
|
||||
(cons 'corresponding-acc-name (list (cons 'sortkey (list SPLIT-CORR-ACCT-NAME))
|
||||
(cons 'split-sortvalue (lambda (a) (xaccSplitGetCorrAccountFullName a)))
|
||||
(cons 'text (_ "Other Account Name"))
|
||||
(cons 'tip (_ "Sort by account transferred from/to's name."))
|
||||
(cons 'renderer-key 'other-acc)))
|
||||
(cons 'renderer-fn (lambda (a) (xaccSplitGetAccount (xaccSplitGetOtherSplit a))))))
|
||||
|
||||
(cons 'corresponding-acc-code (list (cons 'sortkey (list SPLIT-CORR-ACCT-CODE))
|
||||
(cons 'split-sortvalue (lambda (a) (xaccSplitGetCorrAccountCode a)))
|
||||
(cons 'text (_ "Other Account Code"))
|
||||
(cons 'tip (_ "Sort by account transferred from/to's code."))
|
||||
(cons 'renderer-key 'other-acct)))
|
||||
(cons 'renderer-fn (lambda (a) (xaccSplitGetAccount (xaccSplitGetOtherSplit a))))))
|
||||
|
||||
(cons 'amount (list (cons 'sortkey (list SPLIT-VALUE))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "Amount"))
|
||||
(cons 'tip (_ "Sort by amount."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #f)))
|
||||
|
||||
(cons 'description (list (cons 'sortkey (list SPLIT-TRANS TRANS-DESCRIPTION))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "Description"))
|
||||
(cons 'tip (_ "Sort by description."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #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 (_ "Number/Action"))
|
||||
(cons 'tip (_ "Sort by check number/action."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #f)))
|
||||
|
||||
(cons 'number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "Number"))
|
||||
(cons 'tip (_ "Sort by check/transaction number."))
|
||||
(cons 'renderer-key #f))))
|
||||
(cons 'renderer-fn #f))))
|
||||
|
||||
(cons 't-number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "Transaction Number"))
|
||||
(cons 'tip (_ "Sort by transaction number."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #f)))
|
||||
|
||||
(cons 'memo (list (cons 'sortkey (list SPLIT-MEMO))
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "Memo"))
|
||||
(cons 'tip (_ "Sort by memo."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #f)))
|
||||
|
||||
(cons 'none (list (cons 'sortkey '())
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "None"))
|
||||
(cons 'tip (_ "Do not sort."))
|
||||
(cons 'renderer-key #f)))))
|
||||
|
||||
(cons 'renderer-fn #f)))))
|
||||
|
||||
(define (time64-year t64) (gnc:date-get-year (gnc-localtime t64)))
|
||||
(define (time64-quarter t64) (+ (* 10 (gnc:date-get-year (gnc-localtime t64))) (gnc:date-get-quarter (gnc-localtime t64))))
|
||||
(define (time64-month t64) (+ (* 100 (gnc:date-get-year (gnc-localtime t64))) (gnc:date-get-month (gnc-localtime t64))))
|
||||
(define (time64-week t64) (gnc:date-get-week (gnc-localtime t64)))
|
||||
(define (split-week a) (time64-week (xaccTransGetDate (xaccSplitGetParent a))))
|
||||
(define (split-month a) (time64-month (xaccTransGetDate (xaccSplitGetParent a))))
|
||||
(define (split-quarter a) (time64-quarter (xaccTransGetDate (xaccSplitGetParent a))))
|
||||
(define (split-year a) (time64-year (xaccTransGetDate (xaccSplitGetParent a))))
|
||||
(define (split->time64 s) (xaccTransGetDate (xaccSplitGetParent s)))
|
||||
|
||||
(define date-subtotal-list
|
||||
;; List for date option.
|
||||
@ -228,41 +227,39 @@ options specified in the Options panels."))
|
||||
;; '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
|
||||
;; 'renderer-fn - func retrieve string for subtotal/subheading renderer
|
||||
;; #f means the date sortkey is not grouped
|
||||
;; otherwise it converts split->string
|
||||
(list
|
||||
(cons 'none (list
|
||||
(cons 'split-sortvalue #f)
|
||||
(cons 'text (_ "None"))
|
||||
(cons 'tip (_ "None."))
|
||||
(cons 'renderer-key #f)))
|
||||
(cons 'renderer-fn #f)))
|
||||
|
||||
(cons 'weekly (list
|
||||
(cons 'split-sortvalue split-week)
|
||||
(cons 'split-sortvalue (lambda (s) (time64-week (split->time64 s))))
|
||||
(cons 'text (_ "Weekly"))
|
||||
(cons 'tip (_ "Weekly."))
|
||||
(cons 'renderer-key 'weekly)
|
||||
(cons 'renderer-fn gnc:date-get-week-year-string)))
|
||||
|
||||
(cons 'renderer-fn (lambda (s) (gnc:date-get-week-year-string (gnc-localtime (split->time64 s)))))))
|
||||
|
||||
(cons 'monthly (list
|
||||
(cons 'split-sortvalue split-month)
|
||||
(cons 'split-sortvalue (lambda (s) (time64-month (split->time64 s))))
|
||||
(cons 'text (_ "Monthly"))
|
||||
(cons 'tip (_ "Monthly."))
|
||||
(cons 'renderer-key 'monthly)
|
||||
(cons 'renderer-fn gnc:date-get-month-year-string)))
|
||||
(cons 'renderer-fn (lambda (s) (gnc:date-get-month-year-string (gnc-localtime (split->time64 s)))))))
|
||||
|
||||
(cons 'quarterly (list
|
||||
(cons 'split-sortvalue split-quarter)
|
||||
(cons 'split-sortvalue (lambda (s) (time64-quarter (split->time64 s))))
|
||||
(cons 'text (_ "Quarterly"))
|
||||
(cons 'tip (_ "Quarterly."))
|
||||
(cons 'renderer-key 'quarterly)
|
||||
(cons 'renderer-fn gnc:date-get-quarter-year-string)))
|
||||
(cons 'renderer-fn (lambda (s) (gnc:date-get-quarter-year-string (gnc-localtime (split->time64 s)))))))
|
||||
|
||||
(cons 'yearly (list
|
||||
(cons 'split-sortvalue split-year)
|
||||
(cons 'split-sortvalue (lambda (s) (time64-year (split->time64 s))))
|
||||
(cons 'text (_ "Yearly"))
|
||||
(cons 'tip (_ "Yearly."))
|
||||
(cons 'renderer-key 'yearly)
|
||||
(cons 'renderer-fn gnc:date-get-year-string)))))
|
||||
(cons 'renderer-fn (lambda (s) (gnc:date-get-year-string (gnc-localtime (split->time64 s)))))))))
|
||||
|
||||
(define filter-list
|
||||
(list
|
||||
@ -947,8 +944,8 @@ tags within description, notes or memo. ")
|
||||
|
||||
(if (and (null? left-cols-list)
|
||||
(or (opt-val gnc:pagename-display "Totals")
|
||||
(primary-get-info 'renderer-key)
|
||||
(secondary-get-info 'renderer-key)))
|
||||
(primary-get-info 'renderer-fn)
|
||||
(secondary-get-info 'renderer-fn)))
|
||||
(list (vector "" (lambda (s t) #f)))
|
||||
left-cols-list)))
|
||||
|
||||
@ -1178,16 +1175,13 @@ tags within description, notes or memo. ")
|
||||
(xaccAccountGetName account))
|
||||
""))))
|
||||
|
||||
(define (render-date renderer-key split)
|
||||
((keylist-get-info date-subtotal-list renderer-key 'renderer-fn)
|
||||
(gnc-localtime
|
||||
(xaccTransGetDate
|
||||
(xaccSplitGetParent split)))))
|
||||
;; retrieve date renderer from the date-subtotal-list
|
||||
(define (render-date date-subtotal-key split)
|
||||
((keylist-get-info date-subtotal-list date-subtotal-key 'renderer-fn) split))
|
||||
|
||||
(define (render-account renderer-key split anchor?)
|
||||
(let* ((account (case renderer-key
|
||||
((account) (xaccSplitGetAccount split))
|
||||
((other-acc) (xaccSplitGetAccount (xaccSplitGetOtherSplit split)))))
|
||||
;; generate account name, optionally with anchor to account register
|
||||
(define (render-account sortkey split anchor?)
|
||||
(let* ((account ((keylist-get-info sortkey-list sortkey 'renderer-fn) split))
|
||||
(name (account-namestring account
|
||||
(column-uses? 'sort-account-code)
|
||||
#t
|
||||
@ -1203,14 +1197,18 @@ tags within description, notes or memo. ")
|
||||
name)))
|
||||
|
||||
(define (render-summary split level anchor?)
|
||||
(let ((renderer-key (case level
|
||||
((primary) (primary-get-info 'renderer-key))
|
||||
((secondary) (secondary-get-info 'renderer-key)))))
|
||||
(case renderer-key
|
||||
((weekly monthly quarterly yearly) (render-date renderer-key split))
|
||||
((account other-acc) (render-account renderer-key split anchor?))
|
||||
(else #f))))
|
||||
|
||||
(let ((sortkey (opt-val pagename-sorting
|
||||
(case level
|
||||
((primary) optname-prime-sortkey)
|
||||
((secondary) optname-sec-sortkey))))
|
||||
(date-subtotal-key (opt-val pagename-sorting
|
||||
(case level
|
||||
((primary) optname-prime-date-subtotal)
|
||||
((secondary) optname-sec-date-subtotal)))))
|
||||
(if (member sortkey DATE-SORTING-TYPES)
|
||||
(render-date date-subtotal-key split)
|
||||
(render-account sortkey split anchor?))))
|
||||
|
||||
(define (render-grand-total)
|
||||
(_ "Grand Total"))
|
||||
|
||||
@ -1398,11 +1396,11 @@ tags within description, notes or memo. ")
|
||||
|
||||
(gnc:html-table-set-col-headers! table (concatenate (list headings-left-columns headings-right-columns)))
|
||||
|
||||
(if (primary-get-info 'renderer-key)
|
||||
(if (primary-get-info 'renderer-fn)
|
||||
(add-subheading (render-summary (car splits) 'primary #t)
|
||||
def:primary-subtotal-style))
|
||||
|
||||
(if (secondary-get-info 'renderer-key)
|
||||
|
||||
(if (secondary-get-info 'renderer-fn)
|
||||
(add-subheading (render-summary (car splits) 'secondary #t)
|
||||
def:secondary-subtotal-style))
|
||||
|
||||
@ -1480,21 +1478,16 @@ tags within description, notes or memo. ")
|
||||
(define (generic-less? X Y key date-subtotal ascend?)
|
||||
(define comparator-function
|
||||
(if (member key DATE-SORTING-TYPES)
|
||||
(let* ((date (lambda (s)
|
||||
(case key
|
||||
((date) (xaccTransGetDate (xaccSplitGetParent s)))
|
||||
((reconciled-date) (xaccSplitGetDateReconciled s)))))
|
||||
(year (lambda (s) (gnc:date-get-year (gnc-localtime (date s)))))
|
||||
(month (lambda (s) (gnc:date-get-month (gnc-localtime (date s)))))
|
||||
(quarter (lambda (s) (gnc:date-get-quarter (gnc-localtime (date s)))))
|
||||
(week (lambda (s) (gnc:date-get-week (gnc-localtime (date s)))))
|
||||
(secs (lambda (s) (date s))))
|
||||
(let ((date (lambda (s)
|
||||
(case key
|
||||
((date) (xaccTransGetDate (xaccSplitGetParent s)))
|
||||
((reconciled-date) (xaccSplitGetDateReconciled s))))))
|
||||
(case date-subtotal
|
||||
((yearly) (lambda (s) (year s)))
|
||||
((monthly) (lambda (s) (+ (* 100 (year s)) (month s))))
|
||||
((quarterly) (lambda (s) (+ (* 10 (year s)) (quarter s))))
|
||||
((weekly) (lambda (s) (week s)))
|
||||
((none) (lambda (s) (secs s)))))
|
||||
((yearly) (lambda (s) (time64-year (date s))))
|
||||
((monthly) (lambda (s) (time64-month (date s))))
|
||||
((quarterly) (lambda (s) (time64-quarter (date s))))
|
||||
((weekly) (lambda (s) (time64-week (date s))))
|
||||
((none) (lambda (s) (date s)))))
|
||||
(case key
|
||||
((account-name) (lambda (s) (gnc-account-get-full-name (xaccSplitGetAccount s))))
|
||||
((account-code) (lambda (s) (xaccAccountGetCode (xaccSplitGetAccount s))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user