mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge Chris Lam's 'scheme-progress' into maint.
This commit is contained in:
commit
d8be4e36e5
@ -266,11 +266,6 @@ for styling the invoice. Please see the exported report for the CSS class names.
|
|||||||
(gnc:register-inv-option (gnc:make-internal-option "Display" "My Company" #f))
|
(gnc:register-inv-option (gnc:make-internal-option "Display" "My Company" #f))
|
||||||
(gnc:register-inv-option (gnc:make-internal-option "Display" "My Company ID" #f))
|
(gnc:register-inv-option (gnc:make-internal-option "Display" "My Company ID" #f))
|
||||||
|
|
||||||
(gnc:register-inv-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "Display") (N_ "Title")
|
|
||||||
"a" (N_ "Display invoice title and invoice ID?") #t))
|
|
||||||
|
|
||||||
(gnc:register-inv-option
|
(gnc:register-inv-option
|
||||||
(gnc:make-simple-boolean-option
|
(gnc:make-simple-boolean-option
|
||||||
(N_ "Display") (N_ "Due Date")
|
(N_ "Display") (N_ "Due Date")
|
||||||
@ -826,17 +821,14 @@ for styling the invoice. Please see the exported report for the CSS class names.
|
|||||||
(qof-print-date (current-time))))))
|
(qof-print-date (current-time))))))
|
||||||
(layout-lookup (lambda (loc) (cdr (assq (opt-val "Layout" loc) layout-lookup-table)))))
|
(layout-lookup (lambda (loc) (cdr (assq (opt-val "Layout" loc) layout-lookup-table)))))
|
||||||
|
|
||||||
(gnc:html-document-set-title! document invoice-title)
|
|
||||||
|
|
||||||
(gnc:html-document-set-style-text! document (opt-val "Layout" "CSS"))
|
(gnc:html-document-set-style-text! document (opt-val "Layout" "CSS"))
|
||||||
|
|
||||||
(let ((main-table (gnc:make-html-table)))
|
(let ((main-table (gnc:make-html-table)))
|
||||||
|
|
||||||
(if (opt-val "Display" "Title")
|
|
||||||
(gnc:html-table-append-row! main-table
|
(gnc:html-table-append-row! main-table
|
||||||
(gnc:make-html-table-cell/size
|
(gnc:make-html-table-cell/size
|
||||||
1 2 (gnc:make-html-div/markup
|
1 2 (gnc:make-html-div/markup
|
||||||
"invoice-title" invoice-title))))
|
"invoice-title" invoice-title)))
|
||||||
|
|
||||||
(gnc:html-table-append-row! main-table
|
(gnc:html-table-append-row! main-table
|
||||||
(list (layout-lookup "Row 1 Left")
|
(list (layout-lookup "Row 1 Left")
|
||||||
|
@ -719,6 +719,8 @@
|
|||||||
(export gnc:report-finished)
|
(export gnc:report-finished)
|
||||||
(export gnc:accounts-count-splits)
|
(export gnc:accounts-count-splits)
|
||||||
(export gnc-commodity-collector-allzero?)
|
(export gnc-commodity-collector-allzero?)
|
||||||
|
(export gnc:monetary+)
|
||||||
|
(export gnc:monetaries-add)
|
||||||
(export gnc:account-get-trans-type-balance-interval)
|
(export gnc:account-get-trans-type-balance-interval)
|
||||||
(export gnc:account-get-trans-type-balance-interval-with-closing)
|
(export gnc:account-get-trans-type-balance-interval-with-closing)
|
||||||
(export gnc:account-get-total-flow)
|
(export gnc:account-get-total-flow)
|
||||||
|
@ -383,6 +383,26 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
|
|||||||
(map gnc:gnc-monetary-amount
|
(map gnc:gnc-monetary-amount
|
||||||
(collector 'format gnc:make-gnc-monetary #f))))
|
(collector 'format gnc:make-gnc-monetary #f))))
|
||||||
|
|
||||||
|
;; add any number of gnc-monetary objects into a commodity-collector
|
||||||
|
;; usage: (gnc:monetaries-add monetary1 monetary2 ...)
|
||||||
|
;; output: a commodity-collector object
|
||||||
|
(define (gnc:monetaries-add . monetaries)
|
||||||
|
(let ((coll (gnc:make-commodity-collector)))
|
||||||
|
(for-each
|
||||||
|
(lambda (mon)
|
||||||
|
(coll 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon)))
|
||||||
|
monetaries)
|
||||||
|
coll))
|
||||||
|
|
||||||
|
;; special case for gnc:monetaries-add whereby only 1 currency is expected
|
||||||
|
;; usage: (gnc:monetaries-add monetary1 monetary2 ...)
|
||||||
|
;; output: a monetary object
|
||||||
|
(define (gnc:monetary+ . monetaries)
|
||||||
|
(let ((coll (apply gnc:monetaries-add monetaries)))
|
||||||
|
(if (= 1 (gnc-commodity-collector-commodity-count coll))
|
||||||
|
(car (coll 'format gnc:make-gnc-monetary #f))
|
||||||
|
(throw "gnc:monetary+ expects 1 currency " (gnc:strify monetaries)))))
|
||||||
|
|
||||||
;; get the account balance at the specified date. if include-children?
|
;; get the account balance at the specified date. if include-children?
|
||||||
;; is true, the balances of all children (not just direct children)
|
;; is true, the balances of all children (not just direct children)
|
||||||
;; are included in the calculation.
|
;; are included in the calculation.
|
||||||
|
@ -21,6 +21,7 @@
|
|||||||
(test-gnc:monetary->string)
|
(test-gnc:monetary->string)
|
||||||
(test-commodity-collector)
|
(test-commodity-collector)
|
||||||
(test-get-account-balances)
|
(test-get-account-balances)
|
||||||
|
(test-monetary-adders)
|
||||||
(test-end "report-utilities"))
|
(test-end "report-utilities"))
|
||||||
|
|
||||||
(define (NDayDelta t64 n)
|
(define (NDayDelta t64 n)
|
||||||
@ -472,3 +473,45 @@
|
|||||||
(collector->list
|
(collector->list
|
||||||
(gnc:get-assoc-account-balances-total account-balances)))))
|
(gnc:get-assoc-account-balances-total account-balances)))))
|
||||||
(teardown)))
|
(teardown)))
|
||||||
|
|
||||||
|
(define (test-monetary-adders)
|
||||||
|
(define (monetary->pair mon)
|
||||||
|
(let ((comm (gnc:gnc-monetary-commodity mon))
|
||||||
|
(amt (gnc:gnc-monetary-amount mon)))
|
||||||
|
(cons (gnc-commodity-get-mnemonic comm) amt)))
|
||||||
|
(let* ((book (gnc-get-current-book))
|
||||||
|
(comm-table (gnc-commodity-table-get-table book))
|
||||||
|
(USD (gnc-commodity-table-lookup comm-table "CURRENCY" "USD"))
|
||||||
|
(GBP (gnc-commodity-table-lookup comm-table "CURRENCY" "GBP"))
|
||||||
|
(EUR (gnc-commodity-table-lookup comm-table "CURRENCY" "EUR"))
|
||||||
|
(usd10 (gnc:make-gnc-monetary USD 10))
|
||||||
|
(usd8 (gnc:make-gnc-monetary USD 8))
|
||||||
|
(gbp10 (gnc:make-gnc-monetary GBP 10))
|
||||||
|
(gbp8 (gnc:make-gnc-monetary GBP 8))
|
||||||
|
(eur10 (gnc:make-gnc-monetary EUR 10))
|
||||||
|
(eur8 (gnc:make-gnc-monetary EUR 8)))
|
||||||
|
|
||||||
|
(test-equal "gnc:monetaries-add 1 currency"
|
||||||
|
'(("USD" . 20))
|
||||||
|
(collector->list
|
||||||
|
(gnc:monetaries-add usd10 usd10)))
|
||||||
|
|
||||||
|
(test-equal "gnc:monetaries-add 2 currencies"
|
||||||
|
'(("GBP" . 8) ("USD" . 10))
|
||||||
|
(collector->list
|
||||||
|
(gnc:monetaries-add usd10 gbp8)))
|
||||||
|
|
||||||
|
(test-equal "gnc:monetaries-add 3 currencies"
|
||||||
|
'(("EUR" . 8) ("GBP" . 8) ("USD" . 20))
|
||||||
|
(collector->list
|
||||||
|
(gnc:monetaries-add usd10 gbp8 eur8 usd10)))
|
||||||
|
|
||||||
|
(test-equal "gnc:monetary+ with 1 currency succeeds"
|
||||||
|
'("USD" . 28)
|
||||||
|
(monetary->pair
|
||||||
|
(gnc:monetary+ usd10 usd10 usd8)))
|
||||||
|
|
||||||
|
(test-error
|
||||||
|
"gnc:monetary+ with >1 currency fails"
|
||||||
|
#t
|
||||||
|
(gnc:monetary+ usd10 usd10 eur8))))
|
||||||
|
@ -241,21 +241,6 @@
|
|||||||
collector report-currency exchange-fn)
|
collector report-currency exchange-fn)
|
||||||
)
|
)
|
||||||
|
|
||||||
;; Add two or more gnc-monetary objects
|
|
||||||
(define (monetary+ a . blist)
|
|
||||||
(if (null? blist)
|
|
||||||
a
|
|
||||||
(let ((b (apply monetary+ blist)))
|
|
||||||
(if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
|
|
||||||
(let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
|
|
||||||
(amount (gnc-numeric-add (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b) GNC-DENOM-AUTO GNC-RND-ROUND)))
|
|
||||||
(if same-currency?
|
|
||||||
(gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
|
|
||||||
(warn "incompatible currencies in monetary+: " a b)))
|
|
||||||
(warn "wrong arguments for monetary+: " a b)))
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
;; Convert gnc:monetary to number (used to generate data for the chart)
|
;; Convert gnc:monetary to number (used to generate data for the chart)
|
||||||
(define (monetary->double monetary)
|
(define (monetary->double monetary)
|
||||||
(gnc-numeric-to-double (gnc:gnc-monetary-amount monetary))
|
(gnc-numeric-to-double (gnc:gnc-monetary-amount monetary))
|
||||||
@ -279,7 +264,7 @@
|
|||||||
(money-out-collector (cdr (assq 'money-out-collector result)))
|
(money-out-collector (cdr (assq 'money-out-collector result)))
|
||||||
(money-in (sum-collector money-in-collector))
|
(money-in (sum-collector money-in-collector))
|
||||||
(money-out (sum-collector money-out-collector))
|
(money-out (sum-collector money-out-collector))
|
||||||
(money-net (monetary+ money-in (gnc:monetary-neg money-out)))
|
(money-net (gnc:monetary+ money-in (gnc:monetary-neg money-out)))
|
||||||
)
|
)
|
||||||
(set! in-list (cons money-in in-list))
|
(set! in-list (cons money-in in-list))
|
||||||
(set! out-list (cons money-out out-list))
|
(set! out-list (cons money-out out-list))
|
||||||
@ -291,18 +276,18 @@
|
|||||||
(if show-in?
|
(if show-in?
|
||||||
(begin
|
(begin
|
||||||
(set! in-list (reverse in-list))
|
(set! in-list (reverse in-list))
|
||||||
(set! total-in (apply monetary+ in-list))
|
(set! total-in (apply gnc:monetary+ in-list))
|
||||||
))
|
))
|
||||||
(if show-out?
|
(if show-out?
|
||||||
(begin
|
(begin
|
||||||
(set! out-list (reverse out-list))
|
(set! out-list (reverse out-list))
|
||||||
(set! total-out (apply monetary+ out-list))
|
(set! total-out (apply gnc:monetary+ out-list))
|
||||||
))
|
))
|
||||||
|
|
||||||
(if show-net?
|
(if show-net?
|
||||||
(begin
|
(begin
|
||||||
(set! net-list (reverse net-list))
|
(set! net-list (reverse net-list))
|
||||||
(set! total-net (apply monetary+ net-list))
|
(set! total-net (apply gnc:monetary+ net-list))
|
||||||
))
|
))
|
||||||
(gnc:report-percent-done 90)
|
(gnc:report-percent-done 90)
|
||||||
|
|
||||||
|
@ -341,21 +341,6 @@ developing over time"))
|
|||||||
c report-currency
|
c report-currency
|
||||||
(lambda (a b) (exchange-fn a b date)))))))
|
(lambda (a b) (exchange-fn a b date)))))))
|
||||||
|
|
||||||
(define (monetaries-add . monetaries)
|
|
||||||
(let ((coll (gnc:make-commodity-collector)))
|
|
||||||
(for-each
|
|
||||||
(lambda (mon)
|
|
||||||
(coll 'add (gnc:gnc-monetary-commodity mon) (gnc:gnc-monetary-amount mon)))
|
|
||||||
monetaries)
|
|
||||||
coll))
|
|
||||||
|
|
||||||
;; Special case for monetaries-add whereby only 1 currency is expected
|
|
||||||
(define (monetary+ . monetaries)
|
|
||||||
(let ((coll (apply monetaries-add monetaries)))
|
|
||||||
(if (= 1 (gnc-commodity-collector-commodity-count coll))
|
|
||||||
(car (coll 'format gnc:make-gnc-monetary #f))
|
|
||||||
(gnc:warn "monetary+ expects 1 currency " (gnc:strify monetaries)))))
|
|
||||||
|
|
||||||
(define (collector-minus a b)
|
(define (collector-minus a b)
|
||||||
(let ((coll (gnc:make-commodity-collector)))
|
(let ((coll (gnc:make-commodity-collector)))
|
||||||
(coll 'merge a #f)
|
(coll 'merge a #f)
|
||||||
@ -396,7 +381,7 @@ developing over time"))
|
|||||||
(member (car entry) accountslist))
|
(member (car entry) accountslist))
|
||||||
account-balances-alist))
|
account-balances-alist))
|
||||||
(selected-monetaries (map cdr selected-balances))
|
(selected-monetaries (map cdr selected-balances))
|
||||||
(list-of-mon-collectors (apply map monetaries-add selected-monetaries)))
|
(list-of-mon-collectors (apply map gnc:monetaries-add selected-monetaries)))
|
||||||
(let loop ((list-of-mon-collectors list-of-mon-collectors)
|
(let loop ((list-of-mon-collectors list-of-mon-collectors)
|
||||||
(dates-list dates-list)
|
(dates-list dates-list)
|
||||||
(result '()))
|
(result '()))
|
||||||
@ -494,7 +479,7 @@ developing over time"))
|
|||||||
(filter (lambda (l)
|
(filter (lambda (l)
|
||||||
(not (zero?
|
(not (zero?
|
||||||
(gnc:gnc-monetary-amount
|
(gnc:gnc-monetary-amount
|
||||||
(apply monetary+ (cadr l))))))
|
(apply gnc:monetary+ (cadr l))))))
|
||||||
(traverse-accounts 1 topl-accounts))
|
(traverse-accounts 1 topl-accounts))
|
||||||
(cond
|
(cond
|
||||||
((eq? sort-method 'acct-code)
|
((eq? sort-method 'acct-code)
|
||||||
@ -511,8 +496,8 @@ developing over time"))
|
|||||||
xaccAccountGetName) (car b)))))
|
xaccAccountGetName) (car b)))))
|
||||||
(else
|
(else
|
||||||
(lambda (a b)
|
(lambda (a b)
|
||||||
(> (gnc:gnc-monetary-amount (apply monetary+ (cadr a)))
|
(> (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr a)))
|
||||||
(gnc:gnc-monetary-amount (apply monetary+ (cadr b)))))))))
|
(gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr b)))))))))
|
||||||
;; Or rather sort by total amount?
|
;; Or rather sort by total amount?
|
||||||
;;(< (apply + (cadr a))
|
;;(< (apply + (cadr a))
|
||||||
;; (apply + (cadr b))))))
|
;; (apply + (cadr b))))))
|
||||||
@ -597,7 +582,7 @@ developing over time"))
|
|||||||
(let* ((start (take all-data (1- max-slices)))
|
(let* ((start (take all-data (1- max-slices)))
|
||||||
(finish (drop all-data (1- max-slices)))
|
(finish (drop all-data (1- max-slices)))
|
||||||
(other-sum (map
|
(other-sum (map
|
||||||
(lambda (l) (apply monetary+ l))
|
(lambda (l) (apply gnc:monetary+ l))
|
||||||
(apply zip (map cadr finish)))))
|
(apply zip (map cadr finish)))))
|
||||||
(set! all-data
|
(set! all-data
|
||||||
(append start
|
(append start
|
||||||
@ -758,7 +743,7 @@ developing over time"))
|
|||||||
(sumrow
|
(sumrow
|
||||||
(lambda (row)
|
(lambda (row)
|
||||||
(if (not (null? row))
|
(if (not (null? row))
|
||||||
(monetary+ (car row) (sumrow (cdr row)))
|
(gnc:monetary+ (car row) (sumrow (cdr row)))
|
||||||
(gnc:make-gnc-monetary report-currency 0)))))
|
(gnc:make-gnc-monetary report-currency 0)))))
|
||||||
(gnc:html-table-append-column!
|
(gnc:html-table-append-column!
|
||||||
table
|
table
|
||||||
|
@ -139,15 +139,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
|
|||||||
(gnc:option-value option)
|
(gnc:option-value option)
|
||||||
(gnc:error "gnc:lookup-option error: " section "/" name))))
|
(gnc:error "gnc:lookup-option error: " section "/" name))))
|
||||||
(letrec*
|
(letrec*
|
||||||
((monetary+ (lambda (a b)
|
((myadd (lambda (X Y) (if X (if Y (gnc:monetary+ X Y) X) Y))) ; custom monetary adder which understands #f
|
||||||
(if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
|
|
||||||
(let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
|
|
||||||
(amount (+ (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b))))
|
|
||||||
(if same-currency?
|
|
||||||
(gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
|
|
||||||
(gnc:error "incompatible currencies in monetary+: " a b)))
|
|
||||||
(gnc:error "wrong arguments for monetary+: " a b))))
|
|
||||||
(myadd (lambda (X Y) (if X (if Y (monetary+ X Y) X) Y))) ; custom adder which understands #f values
|
|
||||||
(myneg (lambda (X) (and X (gnc:monetary-neg X)))) ; custom monetary negator which understands #f
|
(myneg (lambda (X) (and X (gnc:monetary-neg X)))) ; custom monetary negator which understands #f
|
||||||
(accounts (opt-val gnc:pagename-accounts "Accounts"))
|
(accounts (opt-val gnc:pagename-accounts "Accounts"))
|
||||||
(tax-accounts (opt-val gnc:pagename-accounts "Tax Accounts"))
|
(tax-accounts (opt-val gnc:pagename-accounts "Tax Accounts"))
|
||||||
@ -155,8 +147,8 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
|
|||||||
(accounts-tax-paid (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-ASSET)) tax-accounts))
|
(accounts-tax-paid (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-ASSET)) tax-accounts))
|
||||||
(accounts-sales (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-INCOME)) accounts))
|
(accounts-sales (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-INCOME)) accounts))
|
||||||
(accounts-purchases (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-EXPENSE)) accounts))
|
(accounts-purchases (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-EXPENSE)) accounts))
|
||||||
(common-currency (and (opt-val gnc:pagename-general (_ "Common Currency")) ; if a common currency was specified,
|
(common-currency (and (opt-val gnc:pagename-general "Common Currency") ; if a common currency was specified,
|
||||||
(opt-val gnc:pagename-general (_ "Report's currency")))) ; use it
|
(opt-val gnc:pagename-general "Report's currency"))) ; use it
|
||||||
(split-date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
|
(split-date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
|
||||||
(split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
|
(split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
|
||||||
(split-adder (lambda (split accountlist)
|
(split-adder (lambda (split accountlist)
|
||||||
@ -201,13 +193,14 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
|
|||||||
(tax-payable (lambda (s) (myadd (tax-on-sales s) (myneg (tax-on-purchases s))))))
|
(tax-payable (lambda (s) (myadd (tax-on-sales s) (myneg (tax-on-purchases s))))))
|
||||||
(append
|
(append
|
||||||
;; each column will be a vector
|
;; each column will be a vector
|
||||||
;; (vector heading
|
;; (vector heading ;; string
|
||||||
;; calculator-function ;; (calculator-function split) to obtain amount
|
;; calculator-function ;; (calculator-function split) to obtain amount
|
||||||
;; reverse-column? ;; unused in GST report
|
;; reverse-column? ;; #t for income, #f for expense
|
||||||
;; subtotal? ;; #t - all columns need subtotals
|
;; subtotal? ;; #t - all columns need subtotals
|
||||||
;; start-dual-column? ;; unused in GST report
|
;; start-dual-column? ;; unused in GST report
|
||||||
;; friendly-heading-fn ;; unused in GST report
|
;; friendly-heading-fn ;; unused in GST report
|
||||||
(list (vector "TOTAL SALES"
|
;; Translators: "TOTAL SALES" refer to Net Sales + GST/VAT on Sales
|
||||||
|
(list (vector (_ "TOTAL SALES")
|
||||||
total-sales
|
total-sales
|
||||||
#t #t #f
|
#t #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
@ -217,7 +210,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
|
|||||||
#t #t #f
|
#t #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
accounts-sales)
|
accounts-sales)
|
||||||
(list (vector "Net Sales"
|
(list (vector (_ "Net Sales")
|
||||||
sales-without-tax
|
sales-without-tax
|
||||||
#t #t #f
|
#t #t #f
|
||||||
(lambda (a) ""))))
|
(lambda (a) ""))))
|
||||||
@ -227,11 +220,12 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
|
|||||||
#t #t #f
|
#t #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
accounts-tax-collected)
|
accounts-tax-collected)
|
||||||
(list (vector "Tax on Sales"
|
(list (vector (_ "Tax on Sales")
|
||||||
tax-on-sales
|
tax-on-sales
|
||||||
#t #t #f
|
#t #t #f
|
||||||
(lambda (a) ""))))
|
(lambda (a) ""))))
|
||||||
(list (vector "TOTAL PURCHASES"
|
;; Translators: "TOTAL PURCHASES" refer to Net Purchase + GST/VAT on Purchase
|
||||||
|
(list (vector (_ "TOTAL PURCHASES")
|
||||||
total-purchases
|
total-purchases
|
||||||
#f #t #f
|
#f #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
@ -241,7 +235,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
|
|||||||
#f #t #f
|
#f #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
accounts-purchases)
|
accounts-purchases)
|
||||||
(list (vector "Net Purchases"
|
(list (vector (_ "Net Purchases")
|
||||||
purchases-without-tax
|
purchases-without-tax
|
||||||
#f #t #f
|
#f #t #f
|
||||||
(lambda (a) ""))))
|
(lambda (a) ""))))
|
||||||
@ -251,24 +245,27 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
|
|||||||
#f #t #f
|
#f #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
accounts-tax-paid)
|
accounts-tax-paid)
|
||||||
(list (vector "Tax on Purchases"
|
(list (vector (_ "Tax on Purchases")
|
||||||
tax-on-purchases
|
tax-on-purchases
|
||||||
#f #t #f
|
#f #t #f
|
||||||
(lambda (a) ""))))
|
(lambda (a) ""))))
|
||||||
(if (opt-val gnc:pagename-display (N_ "Remittance amount"))
|
(if (opt-val gnc:pagename-display (N_ "Remittance amount"))
|
||||||
(list (vector "Remittance"
|
;; Translators: "Remittance" refer to TOTAL SALES - TOTAL PURCHASES in GST Report
|
||||||
|
(list (vector (_ "Remittance")
|
||||||
bank-remittance
|
bank-remittance
|
||||||
#f #t #f
|
#f #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
'())
|
'())
|
||||||
(if (opt-val gnc:pagename-display (N_ "Net Income"))
|
(if (opt-val gnc:pagename-display (N_ "Net Income"))
|
||||||
(list (vector "Net Income"
|
;; Translators: "Net Income" refer to Net Sales - Net Purchases in GST Report
|
||||||
|
(list (vector (_ "Net Income")
|
||||||
net-income
|
net-income
|
||||||
#f #t #f
|
#f #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
'())
|
'())
|
||||||
(if (opt-val gnc:pagename-display (N_ "Tax payable"))
|
(if (opt-val gnc:pagename-display (N_ "Tax payable"))
|
||||||
(list (vector "Tax Payable"
|
;; Translators: "Tax Payable" refer to the difference GST Sales - GST Purchases
|
||||||
|
(list (vector (_ "Tax Payable")
|
||||||
tax-payable
|
tax-payable
|
||||||
#f #t #f
|
#f #t #f
|
||||||
(lambda (a) "")))
|
(lambda (a) "")))
|
||||||
|
@ -248,16 +248,6 @@
|
|||||||
c report-currency
|
c report-currency
|
||||||
(lambda (a b) (exchange-fn a b date))))
|
(lambda (a b) (exchange-fn a b date))))
|
||||||
|
|
||||||
;; Add two gnc-monetary objects in the same currency.
|
|
||||||
(define (monetary+ a b)
|
|
||||||
(if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b))
|
|
||||||
(let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b)))
|
|
||||||
(amount (+ (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b))))
|
|
||||||
(if same-currency?
|
|
||||||
(gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount)
|
|
||||||
(warn "incompatible currencies in monetary+: " a b)))
|
|
||||||
(warn "wrong arguments for monetary+: " a b)))
|
|
||||||
|
|
||||||
;; gets an account alist balances
|
;; gets an account alist balances
|
||||||
;; output: (list acc bal0 bal1 bal2 ...)
|
;; output: (list acc bal0 bal1 bal2 ...)
|
||||||
(define (account->balancelist account)
|
(define (account->balancelist account)
|
||||||
@ -297,21 +287,10 @@
|
|||||||
;; (list acc2 bal0 bal1 bal2 ...) ...)
|
;; (list acc2 bal0 bal1 bal2 ...) ...)
|
||||||
;; whereby list of balances are gnc-monetary objects
|
;; whereby list of balances are gnc-monetary objects
|
||||||
;; output: (list <mon-coll0> <mon-coll1> <mon-coll2>)
|
;; output: (list <mon-coll0> <mon-coll1> <mon-coll2>)
|
||||||
(define list-of-collectors
|
(define (call thunk) (thunk))
|
||||||
(let loop ((n (length dates)) (result '()))
|
(if (null? lst)
|
||||||
(if (zero? n) result
|
(map call (make-list (length dates) gnc:make-commodity-collector))
|
||||||
(loop (1- n) (cons (gnc:make-commodity-collector) result)))))
|
(apply map gnc:monetaries-add (map cdr lst))))
|
||||||
(let loop ((lst lst))
|
|
||||||
(when (pair? lst)
|
|
||||||
(let innerloop ((list-of-collectors list-of-collectors)
|
|
||||||
(list-of-balances (cdar lst)))
|
|
||||||
(when (pair? list-of-balances)
|
|
||||||
((car list-of-collectors) 'add
|
|
||||||
(gnc:gnc-monetary-commodity (car list-of-balances))
|
|
||||||
(gnc:gnc-monetary-amount (car list-of-balances)))
|
|
||||||
(innerloop (cdr list-of-collectors) (cdr list-of-balances))))
|
|
||||||
(loop (cdr lst))))
|
|
||||||
list-of-collectors)
|
|
||||||
|
|
||||||
(let loop ((dates dates)
|
(let loop ((dates dates)
|
||||||
(acct-balances (acc-balances->list-of-balances filtered-account-balances))
|
(acct-balances (acc-balances->list-of-balances filtered-account-balances))
|
||||||
@ -358,7 +337,7 @@
|
|||||||
dates-list #f))
|
dates-list #f))
|
||||||
(dummy (gnc:report-percent-done 80))
|
(dummy (gnc:report-percent-done 80))
|
||||||
|
|
||||||
(difference-balances (map monetary+ minuend-balances subtrahend-balances))
|
(difference-balances (map gnc:monetary+ minuend-balances subtrahend-balances))
|
||||||
|
|
||||||
(dates-list (if inc-exp?
|
(dates-list (if inc-exp?
|
||||||
(list-head dates-list (1- (length dates-list)))
|
(list-head dates-list (1- (length dates-list)))
|
||||||
|
@ -1389,16 +1389,18 @@ be excluded from periodic reporting.")
|
|||||||
(reverse result)
|
(reverse result)
|
||||||
(let* ((mon (retrieve-commodity (car columns) commodity))
|
(let* ((mon (retrieve-commodity (car columns) commodity))
|
||||||
(this-column (and mon (gnc:gnc-monetary-amount mon))))
|
(this-column (and mon (gnc:gnc-monetary-amount mon))))
|
||||||
(if (car merge-list)
|
(cond
|
||||||
|
|
||||||
;; We're merging. If a subtotal exists, send to next loop iteration.
|
;; We're merging. If a subtotal exists, send to next loop iteration.
|
||||||
|
((car merge-list)
|
||||||
(loop #t
|
(loop #t
|
||||||
this-column
|
this-column
|
||||||
(cdr columns)
|
(cdr columns)
|
||||||
(cdr merge-list)
|
(cdr merge-list)
|
||||||
result)
|
result))
|
||||||
(begin
|
|
||||||
(if merging?
|
|
||||||
;; We're completing merge. Display debit-credit in correct column.
|
;; We're completing merge. Display debit-credit in correct column.
|
||||||
|
(merging?
|
||||||
(let* ((sum (and (or last-column this-column)
|
(let* ((sum (and (or last-column this-column)
|
||||||
(- (or last-column 0) (or this-column 0))))
|
(- (or last-column 0) (or this-column 0))))
|
||||||
(sum-table-cell (and sum (gnc:make-html-table-cell/markup
|
(sum-table-cell (and sum (gnc:make-html-table-cell/markup
|
||||||
@ -1413,14 +1415,16 @@ be excluded from periodic reporting.")
|
|||||||
(cdr merge-list)
|
(cdr merge-list)
|
||||||
(cons* (or credit-col "")
|
(cons* (or credit-col "")
|
||||||
(or debit-col "")
|
(or debit-col "")
|
||||||
result)))
|
result))))
|
||||||
;; Default; not merging nor completed merge. Just add amount to result.
|
|
||||||
|
;; Not merging nor completed merge. Just add amount to result.
|
||||||
|
(else
|
||||||
(loop #f
|
(loop #f
|
||||||
#f
|
#f
|
||||||
(cdr columns)
|
(cdr columns)
|
||||||
(cdr merge-list)
|
(cdr merge-list)
|
||||||
(cons (gnc:make-html-table-cell/markup "total-number-cell" mon)
|
(cons (gnc:make-html-table-cell/markup "total-number-cell" mon)
|
||||||
result)))))))))
|
result))))))))
|
||||||
|
|
||||||
;; take the first column of each commodity, add onto the subtotal grid
|
;; take the first column of each commodity, add onto the subtotal grid
|
||||||
(set! grid (grid-add grid row col
|
(set! grid (grid-add grid row col
|
||||||
|
@ -91,9 +91,12 @@
|
|||||||
(gnc:html-document-add-object!
|
(gnc:html-document-add-object!
|
||||||
doc
|
doc
|
||||||
(gnc:make-html-text
|
(gnc:make-html-text
|
||||||
(gnc:html-markup-h2 (format (_ "Welcome to GnuCash ~a !") gnc:version))
|
(gnc:html-markup-h2
|
||||||
(gnc:html-markup-p (format
|
(format #f (_ "Welcome to GnuCash ~a !")
|
||||||
(_ "GnuCash ~a has lots of nice features. Here are a few.") gnc:version))))
|
gnc:version))
|
||||||
|
(gnc:html-markup-p
|
||||||
|
(format #f (_ "GnuCash ~a has lots of nice features. Here are a few.")
|
||||||
|
gnc:version))))
|
||||||
doc))
|
doc))
|
||||||
|
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
|
Loading…
Reference in New Issue
Block a user