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

REFACTOR: gnc-numeric not available in scheme anymore

Browse Source
This commit is contained in:
Christopher Lam 2017-12-24 00:25:59 +08:00
parent e6dcc0cc1e
commit aeb62724e5
1 changed files with 17 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1097,16 +1097,16 @@ tags within description, notes or memo. ")
(timespecCanonicalDayTime trans-date)))) (timespecCanonicalDayTime trans-date))))
(split-value (lambda (s) (convert s (damount s)))) ; used for correct debit/credit (split-value (lambda (s) (convert s (damount s)))) ; used for correct debit/credit
(amount (lambda (s) (split-value s))) (amount (lambda (s) (split-value s)))
(debit-amount (lambda (s) (and (gnc-numeric-positive-p (gnc:gnc-monetary-amount (split-value s))) (debit-amount (lambda (s) (and (positive? (gnc:gnc-monetary-amount (split-value s)))
(split-value s)))) (split-value s))))
(credit-amount (lambda (s) (if (gnc-numeric-positive-p (gnc:gnc-monetary-amount (split-value s))) (credit-amount (lambda (s) (if (positive? (gnc:gnc-monetary-amount (split-value s)))
#f #f
(gnc:monetary-neg (split-value s))))) (gnc:monetary-neg (split-value s)))))
(original-amount (lambda (s) (gnc:make-gnc-monetary (currency s) (damount s)))) (original-amount (lambda (s) (gnc:make-gnc-monetary (currency s) (damount s))))
(original-debit-amount (lambda (s) (if (gnc-numeric-positive-p (damount s)) (original-debit-amount (lambda (s) (if (positive? (damount s))
(original-amount s) (original-amount s)
#f))) #f)))
(original-credit-amount (lambda (s) (if (gnc-numeric-positive-p (damount s)) (original-credit-amount (lambda (s) (if (positive? (damount s))
#f #f
(gnc:monetary-neg (original-amount s))))) (gnc:monetary-neg (original-amount s)))))
(running-balance (lambda (s) (gnc:make-gnc-monetary (currency s) (xaccSplitGetBalance s))))) (running-balance (lambda (s) (gnc:make-gnc-monetary (currency s) (xaccSplitGetBalance s)))))
@ -1117,7 +1117,7 @@ tags within description, notes or memo. ")
;; reverse-column? ;; to optionally reverse signs ;; reverse-column? ;; to optionally reverse signs
;; subtotal? ;; subtotal? to allow subtotals (ie irrelevant for running balance) ;; 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) ;; (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) ;; merging-function)) ;; function to apply to dual-subtotal (+ / -)
;; friendly-heading-fn ;; retrieve friendly heading name for account debit/credit ;; friendly-heading-fn ;; retrieve friendly heading name for account debit/credit
(if (column-uses? 'amount-single) (if (column-uses? 'amount-single)
(list (vector (header-commodity (_ "Amount")) (list (vector (header-commodity (_ "Amount"))
@ -1128,11 +1128,11 @@ tags within description, notes or memo. ")
(if (column-uses? 'amount-double) (if (column-uses? 'amount-double)
(list (vector (header-commodity (_ "Debit")) (list (vector (header-commodity (_ "Debit"))
debit-amount #f #t debit-amount #f #t
(vector #t gnc-numeric-add) (vector #t +)
friendly-debit) friendly-debit)
(vector (header-commodity (_ "Credit")) (vector (header-commodity (_ "Credit"))
credit-amount #f #t credit-amount #f #t
(vector #f gnc-numeric-sub) (vector #f -)
friendly-credit)) friendly-credit))
'()) '())
@ -1148,11 +1148,11 @@ tags within description, notes or memo. ")
(column-uses? 'amount-double)) (column-uses? 'amount-double))
(list (vector (_ "Debit") (list (vector (_ "Debit")
original-debit-amount #f #t original-debit-amount #f #t
(vector #t gnc-numeric-add) (vector #t +)
friendly-debit) friendly-debit)
(vector (_ "Credit") (vector (_ "Credit")
original-credit-amount #f #t original-credit-amount #f #t
(vector #f gnc-numeric-sub) (vector #f -)
friendly-credit)) friendly-credit))
'()) '())
@ -1254,20 +1254,19 @@ tags within description, notes or memo. ")
(define (add-columns commodity) (define (add-columns commodity)
(let ((start-dual-column? #f) (let ((start-dual-column? #f)
(dual-subtotal (gnc:make-gnc-numeric 0 1))) (dual-subtotal 0))
(for-each (lambda (column merge-entry) (for-each (lambda (column merge-entry)
(let* ((mon (retrieve-commodity column commodity)) (let* ((mon (retrieve-commodity column commodity))
(column-amount (and mon (gnc:gnc-monetary-amount mon))) (column-amount (and mon (gnc:gnc-monetary-amount mon)))
(merge? (vector-ref merge-entry 0)) (merge? (vector-ref merge-entry 0))
(merge-fn (vector-ref merge-entry 1))) (merge-fn (vector-ref merge-entry 1)))
(if merge? (if merge?
;; We're merging. Run merge-fn (usu gnc-numeric-add or sub) ;; We're merging. Run merge-fn (usu + or -)
;; and store total in dual-subtotal. Do NOT add column. ;; and store total in dual-subtotal. Do NOT add column.
(begin (begin
(if column-amount (if column-amount
(set! dual-subtotal (set! dual-subtotal
(merge-fn dual-subtotal column-amount (merge-fn dual-subtotal column-amount)))
GNC-DENOM-AUTO GNC-HOW-RND-ROUND)))
(set! start-dual-column? #t)) (set! start-dual-column? #t))
(if start-dual-column? (if start-dual-column?
(begin (begin
@ -1275,9 +1274,8 @@ tags within description, notes or memo. ")
;; and add the columns. ;; and add the columns.
(if column-amount (if column-amount
(set! dual-subtotal (set! dual-subtotal
(merge-fn dual-subtotal column-amount (merge-fn dual-subtotal column-amount)))
GNC-DENOM-AUTO GNC-HOW-RND-ROUND))) (if (positive? dual-subtotal)
(if (gnc-numeric-positive-p dual-subtotal)
(begin (begin
(addto! row-contents (addto! row-contents
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
@ -1291,9 +1289,9 @@ tags within description, notes or memo. ")
"total-number-cell" "total-number-cell"
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
commodity commodity
(gnc-numeric-neg dual-subtotal)))))) (- dual-subtotal))))))
(set! start-dual-column? #f) (set! start-dual-column? #f)
(set! dual-subtotal (gnc:make-gnc-numeric 0 1))) (set! dual-subtotal 0))
;; Default; not merging/completed merge. Just ;; Default; not merging/completed merge. Just
;; display monetary amount ;; display monetary amount
(addto! row-contents (addto! row-contents
@ -1689,7 +1687,7 @@ tags within description, notes or memo. ")
((corresponding-acc-code) (lambda (s) (xaccSplitGetCorrAccountCode s))) ((corresponding-acc-code) (lambda (s) (xaccSplitGetCorrAccountCode s)))
((reconciled-status) (lambda (s) (length (memq (xaccSplitGetReconcile s) ((reconciled-status) (lambda (s) (length (memq (xaccSplitGetReconcile s)
'(#\n #\c #\y #\f #\v))))) '(#\n #\c #\y #\f #\v)))))
((amount) (lambda (s) (gnc-numeric-to-double (xaccSplitGetValue s)))) ((amount) (lambda (s) (gnc-numeric-to-scm (xaccSplitGetValue s))))
((description) (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s)))) ((description) (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s))))
((number) (lambda (s) ((number) (lambda (s)
(if BOOK-SPLIT-ACTION (if BOOK-SPLIT-ACTION