"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "gnucash/report/trep-engine.scm" between
gnucash-5.0.tar.bz2 and gnucash-5.1.tar.bz2

About: GnuCash is personal and small-business financial-accounting software.

trep-engine.scm  (gnucash-5.0.tar.bz2)	:	trep-engine.scm  (gnucash-5.1.tar.bz2)
skipping to change at line 59		skipping to change at line 59
(gnucash report report-utilities)		(gnucash report report-utilities)
(gnucash report options-utilities)		(gnucash report options-utilities)
(gnucash report commodity-utilities)		(gnucash report commodity-utilities)
(gnucash report html-document)		(gnucash report html-document)
(gnucash report html-style-info)		(gnucash report html-style-info)
(gnucash report html-utilities)		(gnucash report html-utilities)
(gnucash report html-table)		(gnucash report html-table)
(gnucash report html-text))		(gnucash report html-text))
(use-modules (srfi srfi-11))		(use-modules (srfi srfi-11))
(use-modules (srfi srfi-1))		(use-modules (srfi srfi-1))
		(use-modules (srfi srfi-9))
		(use-modules (srfi srfi-26))
(use-modules (ice-9 match))		(use-modules (ice-9 match))
(export gnc:trep-options-generator)		(export gnc:trep-options-generator)
(export gnc:trep-renderer)		(export gnc:trep-renderer)
(export gnc:lists->csv)		(export gnc:lists->csv)
;; Define the strings here to avoid typos and make changes easier.		;; Define the strings here to avoid typos and make changes easier.
;;Accounts		;;Accounts
(define optname-accounts (N_ "Accounts"))		(define optname-accounts (N_ "Accounts"))
skipping to change at line 919		skipping to change at line 921
(list (N_ "Use Full Account Name") "f" (G_ "Display the full accou nt name?") #t)		(list (N_ "Use Full Account Name") "f" (G_ "Display the full accou nt name?") #t)
(list (N_ "Account Code") "g" (G_ "Display the account co de?") #f)		(list (N_ "Account Code") "g" (G_ "Display the account co de?") #f)
;; other account name option appears here		;; other account name option appears here
(list (N_ "Use Full Other Account Name") "i" (G_ "Display the full accou nt name?") #f)		(list (N_ "Use Full Other Account Name") "i" (G_ "Display the full accou nt name?") #f)
(list (N_ "Other Account Code") "j" (G_ "Display the other acco unt code?") #f)		(list (N_ "Other Account Code") "j" (G_ "Display the other acco unt code?") #f)
(list (N_ "Shares") "k" (G_ "Display the number of shares?") #f)		(list (N_ "Shares") "k" (G_ "Display the number of shares?") #f)
(list (N_ "Link") "l5" (G_ "Display the transactio n linked document") #f)		(list (N_ "Link") "l5" (G_ "Display the transactio n linked document") #f)
(list (N_ "Price") "l" (G_ "Display the shares pri ce?") #f)		(list (N_ "Price") "l" (G_ "Display the shares pri ce?") #f)
;; note the "Amount" multichoice option in between here		;; note the "Amount" multichoice option in between here
(list optname-grid "m5" (G_ "Display a subtotal sum mary table.") #f)		(list optname-grid "m5" (G_ "Display a subtotal sum mary table.") #f)
(list (N_ "Running Balance") "n" (G_ "Display a running bala nce?") #f)		(list (N_ "Account Balance") "n" (G_ "Display the balance of the underlying account on each line?") #f)
(list (N_ "Totals") "o" (G_ "Display the totals?") #t)))		(list (N_ "Totals") "o" (G_ "Display the totals?") #t)))
(when BOOK-SPLIT-ACTION		(when BOOK-SPLIT-ACTION
(gnc-register-simple-boolean-option options		(gnc-register-simple-boolean-option options
gnc:pagename-display (N_ "Trans Number")		gnc:pagename-display (N_ "Trans Number")
"b2" (G_ "Display the trans number?") #f))		"b2" (G_ "Display the trans number?") #f))
;; Add an option to display the memo, and disable the notes option		;; Add an option to display the memo, and disable the notes option
;; when memos are not included.		;; when memos are not included.
(gnc-register-complex-boolean-option options		(gnc-register-complex-boolean-option options
skipping to change at line 993		skipping to change at line 995
;; this hidden option will toggle whether the default		;; this hidden option will toggle whether the default
;; qof-query is run, or a different query which ensures		;; qof-query is run, or a different query which ensures
;; no transaction is duplicated. It can be enabled in		;; no transaction is duplicated. It can be enabled in
;; a derived report (eg income-gst-statement.scm)		;; a derived report (eg income-gst-statement.scm)
(gnc-register-internal-option options "__trep" "unique-transactions" #f)		(gnc-register-internal-option options "__trep" "unique-transactions" #f)
(GncOptionDBPtr-set-default-section options gnc:pagename-general)		(GncOptionDBPtr-set-default-section options gnc:pagename-general)
options))		options))
		(define (upgrade-vector-to-assoclist list-of-columns)
		(map (lambda (col)
		(list (cons 'heading (vector-ref col 0))
		(cons 'calc-fn (lambda (s tr?) ((vector-ref col 1) s)))
		(cons 'reverse-column? (vector-ref col 2))
		(cons 'subtotal? (vector-ref col 3))
		(cons 'start-dual-column? (vector-ref col 4))
		(cons 'friendly-heading-fn (vector-ref col 5))
		;; the following is a backward-compatibility hack
		;; being used by income-gst-statement.scm
		(cons 'merge-dual-column? (and (<= 7 (vector-length col))
		(vector-ref col 6)))))
		list-of-columns))
		(define (invalid-cell? cell)
		(let lp ((fields '(heading calc-fn reverse-column? subtotal? start-dual-column
		?
		friendly-heading-fn merge-dual-column?)))
		(match fields
		(() #f)
		(((? (cut assq <> cell)) . rest) (lp rest))
		((fld . _) (gnc:error "field " fld " missing in cell " cell) #t))))
;; ;;;;;;;;;;;;;;;;;;;;		;; ;;;;;;;;;;;;;;;;;;;;
;; Here comes the big function that builds the whole table.		;; Here comes the big function that builds the whole table.
(define (make-split-table splits options custom-calculated-cells		(define (make-split-table splits options custom-calculated-cells
begindate enddate c_account_1)		begindate enddate c_account_1)
(define (opt-val section name)		(define (opt-val section name)
(gnc-optiondb-lookup-value (gnc:optiondb options) section name))		(gnc-optiondb-lookup-value (gnc:optiondb options) section name))
(define BOOK-SPLIT-ACTION		(define BOOK-SPLIT-ACTION
skipping to change at line 1034		skipping to change at line 1058
(cons 'amount-double (eq? amount-setting 'double))		(cons 'amount-double (eq? amount-setting 'double))
(cons 'common-currency (opt-val pagename-currency optname-common-curre ncy))		(cons 'common-currency (opt-val pagename-currency optname-common-curre ncy))
(cons 'amount-original-currency		(cons 'amount-original-currency
(and (opt-val pagename-currency optname-common-currency)		(and (opt-val pagename-currency optname-common-currency)
(opt-val pagename-currency optname-orig-currency)))		(opt-val pagename-currency optname-orig-currency)))
(cons 'indenting (opt-val pagename-sorting optname-indenting))		(cons 'indenting (opt-val pagename-sorting optname-indenting))
(cons 'subtotals-only		(cons 'subtotals-only
(and (opt-val pagename-sorting optname-show-subtotals-only)		(and (opt-val pagename-sorting optname-show-subtotals-only)
(or (primary-get-info 'renderer-fn)		(or (primary-get-info 'renderer-fn)
(secondary-get-info 'renderer-fn))))		(secondary-get-info 'renderer-fn))))
(cons 'running-balance (opt-val gnc:pagename-display (N_ "Running Bala nce")))		(cons 'running-balance (opt-val gnc:pagename-display "Account Balance" ))
(cons 'account-full-name		(cons 'account-full-name
(opt-val gnc:pagename-display (N_ "Use Full Account Name")))		(opt-val gnc:pagename-display (N_ "Use Full Account Name")))
(cons 'memo (opt-val gnc:pagename-display (N_ "Memo")))		(cons 'memo (opt-val gnc:pagename-display (N_ "Memo")))
(cons 'account-code (opt-val gnc:pagename-display (N_ "Account Code")) )		(cons 'account-code (opt-val gnc:pagename-display (N_ "Account Code")) )
(cons 'other-account-code		(cons 'other-account-code
(and detail-is-single?		(and detail-is-single?
(opt-val gnc:pagename-display (N_ "Other Account Code"))))		(opt-val gnc:pagename-display (N_ "Other Account Code"))))
(cons 'other-account-full-name		(cons 'other-account-full-name
(and detail-is-single?		(and detail-is-single?
(opt-val gnc:pagename-display (N_ "Use Full Other Account N ame"))))		(opt-val gnc:pagename-display (N_ "Use Full Other Account N ame"))))
skipping to change at line 1092		skipping to change at line 1116
(export? (opt-val gnc:pagename-general optname-table-export)))		(export? (opt-val gnc:pagename-general optname-table-export)))
(define (acc-reverse? acc)		(define (acc-reverse? acc)
(if account-types-to-reverse		(if account-types-to-reverse
(memv (xaccAccountGetType acc) account-types-to-reverse)		(memv (xaccAccountGetType acc) account-types-to-reverse)
(gnc-reverse-balance acc)))		(gnc-reverse-balance acc)))
(define (column-uses? param)		(define (column-uses? param)
(assq-ref used-columns param))		(assq-ref used-columns param))
		;; Helper function to decide if an account balance can be displayed
		;; as a running balance with a balance forward at the top.
		;; It implies most default options are maintained :
		;; - Detail level is set to one transaction per line,
		;; - Date filter is set to date posted
		;; - Filtering on transactions is kept as per default
		;; - The primary sort is set to account name (or code)
		;; - The primary subtotals are displayed (to separate accounts)
		;; - The secondary sort is set to register order or date ascending.
		(define show-bal-bf?
		(and (eq? (opt-val gnc:pagename-display optname-detail-level) 'single)
		(eq? (opt-val gnc:pagename-general optname-date-source) 'posted)
		(string-null? (opt-val pagename-filter optname-transaction-matcher))
		(eq? (opt-val pagename-filter optname-reconcile-status) 'all)
		(eq? (opt-val pagename-filter optname-void-transactions) 'non-void-on
		ly)
		(memq (opt-val pagename-sorting optname-prime-sortkey) '(account-name
		account-code))
		(memq (opt-val pagename-sorting optname-sec-sortkey) '(register-order
		date))
		(opt-val pagename-sorting optname-prime-subtotal)
		(eq? (opt-val pagename-sorting optname-sec-sortorder) 'ascend)))
(define exchange-fn		(define exchange-fn
(if (column-uses? 'common-currency)		(if (column-uses? 'common-currency)
(gnc:case-exchange-time-fn		(gnc:case-exchange-time-fn
(opt-val pagename-currency optname-price-source)		(opt-val pagename-currency optname-price-source)
(opt-val pagename-currency optname-currency)		(opt-val pagename-currency optname-currency)
(gnc:accounts-get-commodities c_account_1 #f) enddate #f #f)		(gnc:accounts-get-commodities c_account_1 #f) enddate #f #f)
gnc:exchange-by-pricedb-nearest))		gnc:exchange-by-pricedb-nearest))
(define left-columns		(define left-columns
(let* ((add-if (lambda (pred? . items) (if pred? items '())))		(let* ((add-if (lambda (pred? . items) (if pred? items '())))
(left-cols-list		(left-cols-list
(append		(append
(add-if (column-uses? 'date)		(add-if (column-uses? 'date)
(vector (G_ "Date")		(list (cons 'heading (G_ "Date"))
(lambda (split transaction-row?)		(cons 'renderer-fn
(and transaction-row?		(lambda (split transaction-row?)
(gnc:make-html-table-cell/markup		(and transaction-row?
"date-cell"		(gnc:make-html-table-cell/markup
(qof-print-date		"date-cell"
(xaccTransGetDate		(qof-print-date
(xaccSplitGetParent split))))))))		(xaccTransGetDate
		(xaccSplitGetParent split)))))))))
(add-if (column-uses? 'entered)		(add-if (column-uses? 'entered)
(vector (G_ "Date Entered")		(list (cons 'heading (G_ "Date Entered"))
(lambda (split transaction-row?)		(cons 'renderer-fn (lambda (split transaction-row?)
(and transaction-row?		(and transaction-row?
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell
"date-cell" (qof-print-date		/markup
(xaccTransRetDateEntered		"date-cell" (qof-print-d
(xaccSplitGetParent split))		ate
))))))		(xaccTransR
		etDateEntered
		(xaccSplit
		GetParent split)))))))))
(add-if (column-uses? 'reconciled-date)		(add-if (column-uses? 'reconciled-date)
(vector (G_ "Reconciled Date")		(list (cons 'heading (G_ "Reconciled Date"))
(lambda (split transaction-row?)		(cons 'renderer-fn
(let ((reconcile-date		(lambda (split transaction-row?)
(and (char=? (xaccSplitGetReconcile spli		(let ((reconcile-date
t) #\y)		(and (char=? (xaccSplitGetReconcile
(xaccSplitGetDateReconciled split))		split) #\y)
))		(xaccSplitGetDateReconciled spl
(and reconcile-date		it))))
(gnc:make-html-table-cell/markup		(and reconcile-date
"date-cell"		(gnc:make-html-table-cell/markup
(qof-print-date reconcile-date)))))))		"date-cell"
		(qof-print-date reconcile-date)))))
		)))
(add-if (column-uses? 'num)		(add-if (column-uses? 'num)
(vector (if (and BOOK-SPLIT-ACTION		(list (cons 'heading (if (and BOOK-SPLIT-ACTION
(opt-val gnc:pagename-display		(opt-val gnc:pagename-displ
(N_ "Trans Number")))		ay
(G_ "Num/T-Num")		(N_ "Trans Number"
(G_ "Num"))		)))
(lambda (split transaction-row?)		(G_ "Num/T-Num")
(let* ((trans (xaccSplitGetParent split))		(G_ "Num")))
(num (gnc-get-num-action trans split))		(cons 'renderer-fn
(t-num (if (and BOOK-SPLIT-ACTION		(lambda (split transaction-row?)
(opt-val		(let* ((trans (xaccSplitGetParent split))
gnc:pagename-display		(num (gnc-get-num-action trans split
(N_ "Trans Number")))		))
(gnc-get-num-action trans #f)		(t-num (if (and BOOK-SPLIT-ACTION
""))		(opt-val
(num-string (if (string-null? t-num)		gnc:pagename-displa
num		y
(string-append num "/" t		(N_ "Trans Number")
-num))))		))
(and transaction-row?		(gnc-get-num-action trans
(gnc:make-html-table-cell/markup		#f)
"text-cell" num-string))))))		""))
		(num-string (if (string-null? t-num)
		num
		(string-append num "
		/" t-num))))
		(and transaction-row?
		(gnc:make-html-table-cell/markup
		"text-cell" num-string)))))))
(add-if (column-uses? 'description)		(add-if (column-uses? 'description)
(vector (G_ "Description")		(list (cons 'heading (G_ "Description"))
(lambda (split transaction-row?)		(cons 'renderer-fn
(define trans (xaccSplitGetParent split))		(lambda (split transaction-row?)
(and transaction-row?		(define trans (xaccSplitGetParent split))
(gnc:make-html-table-cell/markup		(and transaction-row?
"text-cell"		(gnc:make-html-table-cell/markup
(xaccTransGetDescription trans))))))		"text-cell"
		(xaccTransGetDescription trans)))))))
(add-if (column-uses? 'memo)		(add-if (column-uses? 'memo)
(vector (if (column-uses? 'notes)		(list (cons 'heading (if (column-uses? 'notes)
(string-append (G_ "Memo") "/" (G_ "Notes"))		(string-append (G_ "Memo") "/" (
(G_ "Memo"))		G_ "Notes"))
(lambda (split transaction-row?)		(G_ "Memo")))
(define trans (xaccSplitGetParent split))		(cons 'renderer-fn
(define memo (xaccSplitGetMemo split))		(lambda (split transaction-row?)
(if (and (string-null? memo) (column-uses? 'not		(define trans (xaccSplitGetParent split))
es))		(define memo (xaccSplitGetMemo split))
(xaccTransGetNotes trans)		(if (and (string-null? memo) (column-uses?
memo))))		'notes))
		(xaccTransGetNotes trans)
		memo)))))
(add-if (or (column-uses? 'account-name) (column-uses? 'account-c ode))		(add-if (or (column-uses? 'account-name) (column-uses? 'account-c ode))
(vector (G_ "Account")		(list (cons 'heading (G_ "Account"))
(lambda (split transaction-row?)		(cons 'renderer-fn
(account-namestring		(lambda (split transaction-row?)
(xaccSplitGetAccount split)		(account-namestring
(column-uses? 'account-code)		(xaccSplitGetAccount split)
(column-uses? 'account-name)		(column-uses? 'account-code)
(column-uses? 'account-full-name)))))		(column-uses? 'account-name)
		(column-uses? 'account-full-name))))))
(add-if (or (column-uses? 'other-account-name)		(add-if (or (column-uses? 'other-account-name)
(column-uses? 'other-account-code))		(column-uses? 'other-account-code))
(vector (G_ "Transfer from/to")		(list (cons 'heading (G_ "Transfer from/to"))
(lambda (split transaction-row?)		(cons 'renderer-fn
(and (< 1 (xaccTransCountSplits		(lambda (split transaction-row?)
(xaccSplitGetParent split)))		(and (< 1 (xaccTransCountSplits
(account-namestring		(xaccSplitGetParent split)))
(xaccSplitGetAccount		(account-namestring
(xaccSplitGetOtherSplit split))		(xaccSplitGetAccount
(column-uses? 'other-account-code)		(xaccSplitGetOtherSplit split))
(column-uses? 'other-account-name)		(column-uses? 'other-account-code)
(column-uses? 'other-account-full-name)))		(column-uses? 'other-account-name)
)))		(column-uses? 'other-account-full-nam
		e)))))))
(add-if (column-uses? 'shares)		(add-if (column-uses? 'shares)
(vector (G_ "Shares")		(list (cons 'heading (G_ "Shares"))
(lambda (split transaction-row?)		(cons 'renderer-fn
(gnc:make-html-table-cell/markup		(lambda (split transaction-row?)
"number-cell"		(gnc:make-html-table-cell/markup
(xaccSplitGetAmount split)))))		"number-cell"
		(xaccSplitGetAmount split))))))
(add-if (column-uses? 'link)		(add-if (column-uses? 'link)
(vector ""		(list (cons 'heading "")
(lambda (split transaction-row?)		(cons 'renderer-fn
(let ((url (xaccTransGetDocLink		(lambda (split transaction-row?)
(xaccSplitGetParent split))))		(let ((url (xaccTransGetDocLink
(and (not (string-null? url))		(xaccSplitGetParent split))))
(gnc:make-html-table-cell/markup		(and (not (string-null? url))
"text-cell"		(gnc:make-html-table-cell/markup
(if opt-use-links?		"text-cell"
(gnc:html-transaction-doclink-ancho		(if opt-use-links?
r		(gnc:html-transaction-doclink-a
(xaccSplitGetParent split)		nchor
;; Translators: 'L' is short for L		(xaccSplitGetParent split)
inked Document		;; Translators: 'L' is short f
(C_ "Column header for 'Document L		or Linked Document
ink'" "L"))		(C_ "Column header for 'Docume
(C_ "Column header for 'Document Li		nt Link'" "L"))
nk'" "L"))))))))		(C_ "Column header for 'Documen
		t Link'" "L")))))))))
(add-if (column-uses? 'price)		(add-if (column-uses? 'price)
(vector (G_ "Price")		(list (cons 'heading (G_ "Price"))
(lambda (split transaction-row?)		(cons 'renderer-fn
(gnc:make-html-table-cell/markup		(lambda (split transaction-row?)
"number-cell"		(gnc:make-html-table-cell/markup
(gnc:default-price-renderer		"number-cell"
(xaccTransGetCurrency (xaccSplitGetParent spl		(gnc:default-price-renderer
it))		(xaccTransGetCurrency (xaccSplitGetParent
(xaccSplitGetSharePrice split)))))))))		split))
		(xaccSplitGetSharePrice split))))))))))
(if (or (column-uses? 'subtotals-only)		(if (or (column-uses? 'subtotals-only)
(and (null? left-cols-list)		(and (null? left-cols-list)
(or (opt-val gnc:pagename-display "Totals")		(or (opt-val gnc:pagename-display "Totals")
(primary-get-info 'renderer-fn)		(primary-get-info 'renderer-fn)
(secondary-get-info 'renderer-fn))))		(secondary-get-info 'renderer-fn))))
(list (vector "" (lambda (s t) #f)))		`(((heading . "") (renderer-fn . ,(const #f))))
left-cols-list)))		left-cols-list)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;		;;
;; calculated-cells		;; calculated-cells
;;		;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define default-calculated-cells		(define default-calculated-cells
(letrec		(letrec
skipping to change at line 1264		skipping to change at line 1318
(header-commodity (lambda (str)		(header-commodity (lambda (str)
(string-append		(string-append
str		str
(if (column-uses? 'common-currency)		(if (column-uses? 'common-currency)
(format #f " (~a)"		(format #f " (~a)"
(gnc-commodity-get-mnemonic		(gnc-commodity-get-mnemonic
(opt-val pagename-currency		(opt-val pagename-currency
optname-currency)))		optname-currency)))
""))))		""))))
;; For conversion to row-currency.		;; For conversion to row-currency.
(converted-amount (lambda (s)		(converted-amount (lambda (s tr?)
(exchange-fn		(exchange-fn
(gnc:make-gnc-monetary (split-currency s)		(gnc:make-gnc-monetary (split-currency s)
(split-amount s))		(split-amount s))
(row-currency s)		(row-currency s)
(xaccTransGetDate (xaccSplitGetParent s)))))		(xaccTransGetDate (xaccSplitGetParent s)))))
(converted-debit-amount (lambda (s) (and (positive? (split-amount s))		(converted-debit-amount (lambda (s tr?) (and (positive? (split-amount
(converted-amount s))))		s))
(converted-credit-amount (lambda (s)		(converted-amount s tr?)
		)))
		(converted-credit-amount (lambda (s tr?)
(and (not (positive? (split-amount s)))		(and (not (positive? (split-amount s)))
(gnc:monetary-neg (converted-amount s		(gnc:monetary-neg (converted-amount s
)))))		tr?)))))
(original-amount (lambda (s)		(converted-account-balance (lambda (s tr?)
		(exchange-fn
		(gnc:make-gnc-monetary
		(split-currency s)
		(xaccSplitGetBalance s))
		(row-currency s)
		(time64CanonicalDayTime
		(xaccTransGetDate (xaccSplitGetParent
		s))))))
		(original-amount (lambda (s tr?)
(gnc:make-gnc-monetary		(gnc:make-gnc-monetary
(split-currency s) (split-amount s))))		(split-currency s) (split-amount s))))
(original-debit-amount (lambda (s)		(original-debit-amount (lambda (s tr?)
(and (positive? (split-amount s))		(and (positive? (split-amount s))
(original-amount s))))		(original-amount s tr?))))
(original-credit-amount (lambda (s)		(original-credit-amount (lambda (s tr?)
(and (not (positive? (split-amount s)))		(and (not (positive? (split-amount s)))
(gnc:monetary-neg (original-amount s))		(gnc:monetary-neg (original-amount s t
)))		r?)))))
(running-balance (lambda (s)		(original-account-balance (lambda (s tr?)
(gnc:make-gnc-monetary		(gnc:make-gnc-monetary
(split-currency s) (xaccSplitGetBalance s)))))		(split-currency s) (xaccSplitGetBalance
		s)))))
(append		(append
;; each column will be a vector		;; each column will be a list of pairs whose car is a metadata header,
;; (vector heading		;; and whose cdr is the procedure, string or bool to obtain the metadat
;; calculator-function (calculator-function split) to obtain am		a
ount		;; 'heading the heading string
;; reverse-column? #t to allow reverse signs		;; 'calc-fn (calc-fn split transaction-row?) to obtain gnc
;; subtotal? #t to allow subtotals (ie must be #f for		:monetary
;; running balance)		;; 'reverse-column? #t to allow reverse signs
;; start-dual-column? #t for the debit side of a dual column		;; 'subtotal? #t to allow subtotals (ie must be #f for
;; (i.e. debit/credit) which means the next		;; running balance)
;; column must be the credit side		;; 'start-dual-column? #t for the debit side of a dual column
;; friendly-heading-fn (friendly-heading-fn account) to retriev		;; (i.e. debit/credit) which means the next
e		;; column must be the credit side
;; friendly name for account debit/credit		;; 'friendly-heading-fn (friendly-heading-fn account) to retrieve
;; or 'bal-bf for balance-brought-forward		;; friendly name for account debit/credit
;; start-dual-column? #t: merge with next cell for subtotal ta		;; or 'bal-bf for balance-brought-forward
ble.		;; or 'original-bal-bf for bal-bf in original cur
		rency
		;; when currency conversion is used
		;; 'merge-dual-column? #t: merge with next cell.
(if (column-uses? 'amount-single)		(if (column-uses? 'amount-single)
(list (vector (header-commodity (G_ "Amount"))		(list (list (cons 'heading (header-commodity (G_ "Amount")))
converted-amount #t #t #f		(cons 'calc-fn converted-amount)
(lambda (a) "") #f))		(cons 'reverse-column? #t)
		(cons 'subtotal? #t)
		(cons 'start-dual-column? #f)
		(cons 'friendly-heading-fn (const ""))
		(cons 'merge-dual-column? #f)))
'())		'())
(if (column-uses? 'amount-double)		(if (column-uses? 'amount-double)
(list (vector (header-commodity (G_ "Debit"))		(list (list (cons 'heading (header-commodity (G_ "Debit")))
converted-debit-amount #f #t #t		(cons 'calc-fn converted-debit-amount)
friendly-debit #t)		(cons 'reverse-column? #f)
(vector (header-commodity (G_ "Credit"))		(cons 'subtotal? #t)
converted-credit-amount #f #t #f		(cons 'start-dual-column? #t)
friendly-credit #f))		(cons 'friendly-heading-fn friendly-debit)
		(cons 'merge-dual-column? #t))
		(list (cons 'heading (header-commodity (G_ "Credit")))
		(cons 'calc-fn converted-credit-amount)
		(cons 'reverse-column? #f)
		(cons 'subtotal? #t)
		(cons 'start-dual-column? #f)
		(cons 'friendly-heading-fn friendly-credit)
		(cons 'merge-dual-column? #f)))
		'())
		(if (column-uses? 'running-balance)
		(if show-bal-bf?
		(list (list (cons 'heading (header-commodity (G_ "Running Balan
		ce")))
		(cons 'calc-fn converted-account-balance)
		(cons 'reverse-column? #t)
		(cons 'subtotal? #f)
		(cons 'start-dual-column? #f)
		(cons 'friendly-heading-fn 'bal-bf)
		(cons 'merge-dual-column? #f)))
		(list (list (cons 'heading (header-commodity (G_ "Account Balan
		ce")))
		(cons 'calc-fn converted-account-balance)
		(cons 'reverse-column? #t)
		(cons 'subtotal? #f)
		(cons 'start-dual-column? #f)
		(cons 'friendly-heading-fn #f)
		(cons 'merge-dual-column? #f))))
'())		'())
(if (and (column-uses? 'amount-original-currency)		(if (and (column-uses? 'amount-original-currency)
(column-uses? 'amount-single))		(column-uses? 'amount-single))
(list (vector (G_ "Amount")		(list (list (cons 'heading (G_ "Amount"))
original-amount #t #t #f		(cons 'calc-fn original-amount)
(lambda (a) "") #f))		(cons 'reverse-column? #t)
		(cons 'subtotal? #t)
		(cons 'start-dual-column? #f)
		(cons 'friendly-heading-fn (const ""))
		(cons 'merge-dual-column? #f)))
'())		'())
(if (and (column-uses? 'amount-original-currency)		(if (and (column-uses? 'amount-original-currency)
(column-uses? 'amount-double))		(column-uses? 'amount-double))
(list (vector (G_ "Debit")		(list (list (cons 'heading (G_ "Debit"))
original-debit-amount #f #t #t		(cons 'calc-fn original-debit-amount)
friendly-debit #t)		(cons 'reverse-column? #f)
(vector (G_ "Credit")		(cons 'subtotal? #t)
original-credit-amount #f #t #f		(cons 'start-dual-column? #t)
friendly-credit #f))		(cons 'friendly-heading-fn friendly-debit)
		(cons 'merge-dual-column? #t))
		(list (cons 'heading (G_ "Credit"))
		(cons 'calc-fn original-credit-amount)
		(cons 'reverse-column? #f)
		(cons 'subtotal? #t)
		(cons 'start-dual-column? #f)
		(cons 'friendly-heading-fn friendly-credit)
		(cons 'merge-dual-column? #f)))
'())		'())
(if (column-uses? 'running-balance)		(if (and (column-uses? 'amount-original-currency)
(list (vector (G_ "Running Balance")		(column-uses? 'running-balance))
running-balance #t #f #f		(if show-bal-bf?
'bal-bf #f))		(list (list (cons 'heading (G_ "Running Balance"))
		(cons 'calc-fn original-account-balance)
		(cons 'reverse-column? #t)
		(cons 'subtotal? #f)
		(cons 'start-dual-column? #f)
		(cons 'friendly-heading-fn 'original-bal-bf)
		(cons 'merge-dual-column? #f)))
		(list (list (cons 'heading (G_ "Account Balance"))
		(cons 'calc-fn original-account-balance)
		(cons 'reverse-column? #t)
		(cons 'subtotal? #f)
		(cons 'start-dual-column? #f)
		(cons 'friendly-heading-fn #f)
		(cons 'merge-dual-column? #f))))
'()))))		'()))))
(define calculated-cells		(define calculated-cells
;; this part will check whether custom-calculated-cells were specified. th is		;; this part will check whether custom-calculated-cells were specified. th is
;; describes a custom function which consumes an options list, and generat es		;; describes a custom function which consumes an options list, and generat es
;; a vectorlist similar to default-calculated-cells as above.		;; an association list similar to default-calculated-cells as above.
(if custom-calculated-cells		(if custom-calculated-cells
(custom-calculated-cells options)		(let ((cc (custom-calculated-cells options)))
		(cond
		((not (pair? cc)) (gnc:error "welp" cc) default-calculated-cells)
		((vector? (car cc)) (upgrade-vector-to-assoclist cc))
		((any invalid-cell? cc) (gnc:error "welp" cc) default-calculated-ce
		lls)
		(else cc)))
default-calculated-cells))		default-calculated-cells))
(define headings-left-columns		(define headings-left-columns
(map (lambda (column)		(map (cut assq-ref <> 'heading) left-columns))
(vector-ref column 0))
left-columns))
(define headings-right-columns		(define headings-right-columns
(map (lambda (column)		(map (cut assq-ref <> 'heading) calculated-cells))
(vector-ref column 0))
calculated-cells))
(define width-left-columns (length left-columns))		(define width-left-columns (length left-columns))
(define width-right-columns (length calculated-cells))		(define width-right-columns (length calculated-cells))
(define primary-indent		(define primary-indent
(if (and (column-uses? 'indenting)		(if (and (column-uses? 'indenting)
(primary-get-info 'renderer-fn))		(primary-get-info 'renderer-fn))
1 0))		1 0))
(define secondary-indent		(define secondary-indent
skipping to change at line 1379		skipping to change at line 1500
1 0))		1 0))
(define indent-level		(define indent-level
(+ primary-indent secondary-indent))		(+ primary-indent secondary-indent))
(define (add-subheading data subheading-style split level)		(define (add-subheading data subheading-style split level)
(let* ((sortkey (opt-val pagename-sorting		(let* ((sortkey (opt-val pagename-sorting
(case level		(case level
((primary) optname-prime-sortkey)		((primary) optname-prime-sortkey)
((secondary) optname-sec-sortkey))))		((secondary) optname-sec-sortkey))))
(data (if (and (any (lambda (c) (eq? 'bal-bf (vector-ref c 5)))		(data (if (and (any (lambda (c) (eq? 'bal-bf (assq-ref c 'friendly- heading-fn)))
calculated-cells)		calculated-cells)
(memq sortkey ACCOUNT-SORTING-TYPES))		(memq sortkey ACCOUNT-SORTING-TYPES))
;; Translators: Balance b/f stands for "Balance		;; Translators: Balance b/f stands for "Balance
;; brought forward".		;; brought forward".
(string-append data ": " (G_ "Balance b/f"))		(string-append data ": " (G_ "Balance b/f"))
data))		data))
(renderer-fn (keylist-get-info		(renderer-fn (keylist-get-info
(sortkey-list BOOK-SPLIT-ACTION)		(sortkey-list BOOK-SPLIT-ACTION)
sortkey 'renderer-fn))		sortkey 'renderer-fn))
(left-indent (case level		(left-indent (case level
skipping to change at line 1401		skipping to change at line 1522
((secondary) primary-indent)))		((secondary) primary-indent)))
(right-indent (- indent-level left-indent)))		(right-indent (- indent-level left-indent)))
(unless (column-uses? 'subtotals-only)		(unless (column-uses? 'subtotals-only)
(gnc:html-table-append-row/markup!		(gnc:html-table-append-row/markup!
table subheading-style		table subheading-style
(append		(append
(gnc:html-make-empty-cells left-indent)		(gnc:html-make-empty-cells left-indent)
(if export?		(if export?
(cons		(cons
(gnc:make-html-table-cell data)		(gnc:make-html-table-cell/markup "total-label-cell" data)
(gnc:html-make-empty-cells		(gnc:html-make-empty-cells
(+ right-indent width-left-columns -1)))		(+ right-indent width-left-columns -1)))
(list		(list
(gnc:make-html-table-cell/size		(gnc:make-html-table-cell/size/markup
1 (+ right-indent width-left-columns) data)))		1 (+ right-indent width-left-columns) "total-label-cell" data)
		))
(map		(map
(lambda (cell)		(lambda (cell)
(match (vector-ref cell 5)		(match (assq-ref cell 'friendly-heading-fn)
(#f #f)		(#f #f)
('bal-bf		('bal-bf
(let* ((acc (xaccSplitGetAccount split))		(let* ((acc (xaccSplitGetAccount split))
		(bal (exchange-fn
		(gnc:make-gnc-monetary
		(xaccAccountGetCommodity acc)
		(xaccAccountGetBalanceAsOfDate acc begindate))
		(if (column-uses? 'common-currency)
		(opt-val pagename-currency optname-currency)
		(xaccAccountGetCommodity acc))
		(time64CanonicalDayTime
		(xaccTransGetDate (xaccSplitGetParent split)))))
		)
		(and (memq sortkey ACCOUNT-SORTING-TYPES)
		(gnc:make-html-table-cell/markup
		"number-cell"
		(if (acc-reverse? acc) (gnc:monetary-neg bal) bal)))))
		('original-bal-bf
		(let* ((acc (xaccSplitGetAccount split))
(bal (xaccAccountGetBalanceAsOfDate acc begindate)))		(bal (xaccAccountGetBalanceAsOfDate acc begindate)))
(and (memq sortkey ACCOUNT-SORTING-TYPES)		(and (memq sortkey ACCOUNT-SORTING-TYPES)
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"number-cell"		"number-cell"
(gnc:make-gnc-monetary		(gnc:make-gnc-monetary
(xaccAccountGetCommodity acc)		(xaccAccountGetCommodity acc)
(if (acc-reverse? acc) (- bal) bal))))))		(if (acc-reverse? acc) (- bal) bal))))))
(fn		(fn
(and (opt-val pagename-sorting optname-show-informal-headers)		(and (opt-val pagename-sorting optname-show-informal-headers)
(column-uses? 'amount-double)		(column-uses? 'amount-double)
(memq sortkey SORTKEY-INFORMAL-HEADERS)		(memq sortkey SORTKEY-INFORMAL-HEADERS)
(gnc:make-html-text		(gnc:make-html-text
(gnc:html-markup-b		(gnc:html-markup-b
(fn (xaccSplitGetAccount split))))))))		(fn (xaccSplitGetAccount split))))))))
calculated-cells))))))		calculated-cells))))))
;; check first calculated-cell vector's 7th cell. originally these		;; check first calculated-cell merge-dual-column status.
;; had only 6 cells. backward-compatible upgrade. useful for the
;; next function, add-subtotal-row.
(define first-column-merge?		(define first-column-merge?
(let ((first-cell (and (pair? calculated-cells) (car calculated-cells))))		(and (pair? calculated-cells)
(and first-cell		(assq-ref (car calculated-cells) 'merge-dual-column?)))
(<= 7 (vector-length first-cell))
(vector-ref first-cell 6))))
(define (add-subtotal-row subtotal-string subtotal-collectors		(define (add-subtotal-row subtotal-string subtotal-collectors
subtotal-style level row col)		subtotal-style level row col)
(let* ((left-indent (case level		(let* ((left-indent (case level
((total) 0)		((total) 0)
((primary) primary-indent)		((primary) primary-indent)
((secondary) (+ primary-indent secondary-indent))))		((secondary) (+ primary-indent secondary-indent))))
(right-indent (- indent-level left-indent))		(right-indent (- indent-level left-indent))
(merge-list (map (lambda (cell) (vector-ref cell 4)) calculated-cel ls))		(merge-list (map (cut assq-ref <> 'start-dual-column?) calculated-c ells))
(columns (map (lambda (coll)		(columns (map (lambda (coll)
(coll 'format gnc:make-gnc-monetary #f))		(coll 'format gnc:make-gnc-monetary #f))
subtotal-collectors))		subtotal-collectors))
(list-of-commodities		(list-of-commodities
(delete-duplicates		(delete-duplicates
(map gnc:gnc-monetary-commodity (concatenate columns))		(map gnc:gnc-monetary-commodity (concatenate columns))
gnc-commodity-equal)))		gnc-commodity-equal)))
(define (retrieve-commodity list-of-monetary commodity)		(define (retrieve-commodity list-of-monetary commodity)
(find (lambda (mon)		(find (lambda (mon)
skipping to change at line 1625		skipping to change at line 1757
(define (add-split-row split cell-calculators row-style transaction-row?)		(define (add-split-row split cell-calculators row-style transaction-row?)
(let* ((account (xaccSplitGetAccount split))		(let* ((account (xaccSplitGetAccount split))
(reversible-account? (acc-reverse? account)))		(reversible-account? (acc-reverse? account)))
(unless (column-uses? 'subtotals-only)		(unless (column-uses? 'subtotals-only)
(gnc:html-table-append-row/markup!		(gnc:html-table-append-row/markup!
table row-style		table row-style
(append		(append
(gnc:html-make-empty-cells indent-level)		(gnc:html-make-empty-cells indent-level)
(map (lambda (left-col)		(map (lambda (left-col)
((vector-ref left-col 1)		((assq-ref left-col 'renderer-fn) split transaction-row?))
split transaction-row?))
left-columns)		left-columns)
(map (lambda (cell)		(map (lambda (cell)
(let* ((cell-monetary ((vector-ref cell 1) split))		(let* ((cell-monetary ((assq-ref cell 'calc-fn)
(reverse? (and (vector-ref cell 2) reversible-account?		split transaction-row?))
))		(reverse? (and (assq-ref cell 'reverse-column?)
		reversible-account?))
(cell-content (and cell-monetary		(cell-content (and cell-monetary
(if reverse?		(if reverse?
(gnc:monetary-neg cell-monetary )		(gnc:monetary-neg cell-monetary )
cell-monetary))))		cell-monetary))))
(and cell-content		(and cell-content
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"number-cell"		"number-cell"
(if opt-use-links?		(if opt-use-links?
(gnc:html-split-anchor split cell-content)		(gnc:html-split-anchor split cell-content)
cell-content)))))		cell-content)))))
cell-calculators))))		cell-calculators))))
(map (lambda (cell) (and (vector-ref cell 3) ((vector-ref cell 1) split)		(map (lambda (cell)
))		(and (assq-ref cell 'subtotal?)
		((assq-ref cell 'calc-fn) split transaction-row?)))
cell-calculators)))		cell-calculators)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; do-rows-with-subtotals		;; do-rows-with-subtotals
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;		;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define primary-subtotal-collectors		(define primary-subtotal-collectors
(map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))		(map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
skipping to change at line 1797		skipping to change at line 1932
(lambda (coll)		(lambda (coll)
(coll 'reset #f #f))		(coll 'reset #f #f))
secondary-subtotal-collectors)		secondary-subtotal-collectors)
(when next		(when next
(add-subheading (render-summary next 'secondary #t)		(add-subheading (render-summary next 'secondary #t)
def:secondary-subtotal-style next 'secondary)) )))		def:secondary-subtotal-style next 'secondary)) )))
(loop rest (not odd-row?) (1+ work-done)))))		(loop rest (not odd-row?) (1+ work-done)))))
(let ((csvlist (cond		(let ((csvlist (cond
((any (lambda (cell) (vector-ref cell 4)) calculated-cells)		((any (cut assq-ref <> 'start-dual-column?) calculated-cells )
;; there are mergeable cells. don't return a list.		;; there are mergeable cells. don't return a list.
(N_ "CSV disabled for double column amounts"))		(N_ "CSV disabled for double column amounts"))
(else		(else
(map		(map
(lambda (cell coll)		(lambda (cell coll)
(cons (vector-ref cell 0)		(cons (assq-ref cell 'heading)
(coll 'format gnc:make-gnc-monetary #f)))		(coll 'format gnc:make-gnc-monetary #f)))
calculated-cells total-collectors)))))		calculated-cells total-collectors)))))
(values table grid csvlist))))		(values table grid csvlist))))
;; grid data structure		;; grid data structure
(define (make-grid)		(define (make-grid)
'())		'())
(define (cell-match? cell row col)		(define (cell-match? cell row col)
(and (or (not row) (equal? row (vector-ref cell 0)))		(and (or (not row) (equal? row (vector-ref cell 0)))
(or (not col) (equal? col (vector-ref cell 1)))))		(or (not col) (equal? col (vector-ref cell 1)))))
skipping to change at line 1905		skipping to change at line 2040
(define* (gnc:trep-renderer		(define* (gnc:trep-renderer
report-obj #:key custom-calculated-cells empty-report-message		report-obj #:key custom-calculated-cells empty-report-message
custom-split-filter split->date split->date-include-false?		custom-split-filter split->date split->date-include-false?
custom-source-accounts		custom-source-accounts
export-type)		export-type)
;; the trep-renderer is a define* function which, at minimum, takes		;; the trep-renderer is a define* function which, at minimum, takes
;; the report object		;; the report object
;;		;;
;; the optional arguments are:		;; the optional arguments are:
;; #:custom-calculated-cells - a list of vectors to define customized data col umns		;; #:custom-calculated-cells - a list of pairs to define customized data colum ns
;; #:empty-report-message - a str or html-object displayed at the initial run		;; #:empty-report-message - a str or html-object displayed at the initial run
;; #:custom-split-filter - a split->bool function to add to the split filter		;; #:custom-split-filter - a split->bool function to add to the split filter
;; #:split->date - a split->time64 which overrides the default posted date fil ter		;; #:split->date - a split->time64 which overrides the default posted date fil ter
;; if a derived report specifies this, the Date Filter option		;; if a derived report specifies this, the Date Filter option
;; becomes unused and should be hidden via gnc:option-make-internal!		;; becomes unused and should be hidden via gnc:option-make-internal!
;; #:split->date-include-false? - addendum to above, specifies filter behaviou r if		;; #:split->date-include-false? - addendum to above, specifies filter behaviou r if
;; split->date returns #f. useful to include unreconciled splits in reconc ile		;; split->date returns #f. useful to include unreconciled splits in reconc ile
;; report. it can be useful for alternative date filtering, e.g. filter by		;; report. it can be useful for alternative date filtering, e.g. filter by
;; transaction->invoice->payment date.		;; transaction->invoice->payment date.
;; #:export-type - are provided for CSV export		;; #:export-type - are provided for CSV export
skipping to change at line 2119		skipping to change at line 2254
(xaccQueryAddClearedMatch query cleared-filter QOF-QUERY-AND)		(xaccQueryAddClearedMatch query cleared-filter QOF-QUERY-AND)
(when (eq? date-source 'posted)		(when (eq? date-source 'posted)
(xaccQueryAddDateMatchTT query #t begindate #t enddate QOF-QUERY-AND))		(xaccQueryAddDateMatchTT query #t begindate #t enddate QOF-QUERY-AND))
(when (boolean? closing-match)		(when (boolean? closing-match)
(xaccQueryAddClosingTransMatch query closing-match QOF-QUERY-AND))		(xaccQueryAddClosingTransMatch query closing-match QOF-QUERY-AND))
(unless custom-sort?		(unless custom-sort?
(qof-query-set-sort-order		(qof-query-set-sort-order
query		query
(keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) primary-key 'sortkey )		(keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) primary-key 'sortkey )
(keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) secondary-key 'sortk ey)		(keylist-get-info (sortkey-list BOOK-SPLIT-ACTION) secondary-key 'sortk ey)
'())		(list QUERY-DEFAULT-SORT))
(qof-query-set-sort-increasing		(qof-query-set-sort-increasing
query (eq? primary-order 'ascend) (eq? secondary-order 'ascend)		query (eq? primary-order 'ascend) (eq? secondary-order 'ascend)
#t))		#t))
(if (opt-val "__trep" "unique-transactions")		(if (opt-val "__trep" "unique-transactions")
(set! splits (xaccQueryGetSplitsUniqueTrans query))		(set! splits (xaccQueryGetSplitsUniqueTrans query))
(set! splits (qof-query-run query)))		(set! splits (qof-query-run query)))
(qof-query-destroy query)		(qof-query-destroy query)
End of changes. 48 change blocks.
201 lines changed or deleted		358 lines changed or added

---