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

Merge Chris Lam's 'scheme-progress' into maint.

Browse Source
This commit is contained in:
John Ralls 2018-12-25 14:17:47 -08:00
commit d8be4e36e5
10 changed files with 143 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gnucash/report/business-reports/invoice.scm
View File

@ -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 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:make-simple-boolean-option
(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))))))
(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"))
(let ((main-table (gnc:make-html-table)))
(if (opt-val "Display" "Title")
(gnc:html-table-append-row! main-table
(gnc:make-html-table-cell/size
1 2 (gnc:make-html-div/markup
"invoice-title" invoice-title))))
(gnc:html-table-append-row! main-table
(gnc:make-html-table-cell/size
1 2 (gnc:make-html-div/markup
"invoice-title" invoice-title)))
(gnc:html-table-append-row! main-table
(list (layout-lookup "Row 1 Left")

2
gnucash/report/report-system/report-system.scm
View File

@ -719,6 +719,8 @@
(export gnc:report-finished)
(export gnc:accounts-count-splits)
(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-with-closing)
(export gnc:account-get-total-flow)

20
gnucash/report/report-system/report-utilities.scm
View File

@ -383,6 +383,26 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(map gnc:gnc-monetary-amount
(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?
;; is true, the balances of all children (not just direct children)
;; are included in the calculation.

43
gnucash/report/report-system/test/test-report-utilities.scm
View File

@ -21,6 +21,7 @@
(test-gnc:monetary->string)
(test-commodity-collector)
(test-get-account-balances)
(test-monetary-adders)
(test-end "report-utilities"))
(define (NDayDelta t64 n)
@ -472,3 +473,45 @@
(collector->list
(gnc:get-assoc-account-balances-total account-balances)))))
(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))))

23
gnucash/report/standard-reports/cashflow-barchart.scm
View File

@ -241,21 +241,6 @@
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)
(define (monetary->double monetary)
(gnc-numeric-to-double (gnc:gnc-monetary-amount monetary))
@ -279,7 +264,7 @@
(money-out-collector (cdr (assq 'money-out-collector result)))
(money-in (sum-collector money-in-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! out-list (cons money-out out-list))
@ -291,18 +276,18 @@
(if show-in?
(begin
(set! in-list (reverse in-list))
(set! total-in (apply monetary+ in-list))
(set! total-in (apply gnc:monetary+ in-list))
))
(if show-out?
(begin
(set! out-list (reverse out-list))
(set! total-out (apply monetary+ out-list))
(set! total-out (apply gnc:monetary+ out-list))
))
(if show-net?
(begin
(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)

27
gnucash/report/standard-reports/category-barchart.scm
View File

@ -341,21 +341,6 @@ developing over time"))
c report-currency
(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)
(let ((coll (gnc:make-commodity-collector)))
(coll 'merge a #f)
@ -396,7 +381,7 @@ developing over time"))
(member (car entry) accountslist))
account-balances-alist))
(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)
(dates-list dates-list)
(result '()))
@ -494,7 +479,7 @@ developing over time"))
(filter (lambda (l)
(not (zero?
(gnc:gnc-monetary-amount
(apply monetary+ (cadr l))))))
(apply gnc:monetary+ (cadr l))))))
(traverse-accounts 1 topl-accounts))
(cond
((eq? sort-method 'acct-code)
@ -511,8 +496,8 @@ developing over time"))
xaccAccountGetName) (car b)))))
(else
(lambda (a b)
(> (gnc:gnc-monetary-amount (apply monetary+ (cadr a)))
(gnc:gnc-monetary-amount (apply monetary+ (cadr b)))))))))
(> (gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr a)))
(gnc:gnc-monetary-amount (apply gnc:monetary+ (cadr b)))))))))
;; Or rather sort by total amount?
;;(< (apply + (cadr a))
;; (apply + (cadr b))))))
@ -597,7 +582,7 @@ developing over time"))
(let* ((start (take all-data (1- max-slices)))
(finish (drop all-data (1- max-slices)))
(other-sum (map
(lambda (l) (apply monetary+ l))
(lambda (l) (apply gnc:monetary+ l))
(apply zip (map cadr finish)))))
(set! all-data
(append start
@ -758,7 +743,7 @@ developing over time"))
(sumrow
(lambda (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:html-table-append-column!
table

41
gnucash/report/standard-reports/income-gst-statement.scm
View File

@ -139,15 +139,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
(gnc:option-value option)
(gnc:error "gnc:lookup-option error: " section "/" name))))
(letrec*
((monetary+ (lambda (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)
(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
((myadd (lambda (X Y) (if X (if Y (gnc:monetary+ X Y) X) Y))) ; custom monetary adder 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"))
(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-sales (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-INCOME)) 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,
(opt-val gnc:pagename-general (_ "Report's currency")))) ; use it
(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
(split-date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
(split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
(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))))))
(append
;; each column will be a vector
;; (vector heading
;; (vector heading ;; string
;; 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
;; start-dual-column? ;; 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
#t #t #f
(lambda (a) "")))
@ -217,7 +210,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
#t #t #f
(lambda (a) "")))
accounts-sales)
(list (vector "Net Sales"
(list (vector (_ "Net Sales")
sales-without-tax
#t #t #f
(lambda (a) ""))))
@ -227,11 +220,12 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
#t #t #f
(lambda (a) "")))
accounts-tax-collected)
(list (vector "Tax on Sales"
(list (vector (_ "Tax on Sales")
tax-on-sales
#t #t #f
(lambda (a) ""))))
(list (vector "TOTAL PURCHASES"
;; Translators: "TOTAL PURCHASES" refer to Net Purchase + GST/VAT on Purchase
(list (vector (_ "TOTAL PURCHASES")
total-purchases
#f #t #f
(lambda (a) "")))
@ -241,7 +235,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
#f #t #f
(lambda (a) "")))
accounts-purchases)
(list (vector "Net Purchases"
(list (vector (_ "Net Purchases")
purchases-without-tax
#f #t #f
(lambda (a) ""))))
@ -251,24 +245,27 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
#f #t #f
(lambda (a) "")))
accounts-tax-paid)
(list (vector "Tax on Purchases"
(list (vector (_ "Tax on Purchases")
tax-on-purchases
#f #t #f
(lambda (a) ""))))
(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
#f #t #f
(lambda (a) "")))
'())
(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
#f #t #f
(lambda (a) "")))
'())
(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
#f #t #f
(lambda (a) "")))

31
gnucash/report/standard-reports/net-charts.scm
View File

@ -248,16 +248,6 @@
c report-currency
(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
;; output: (list acc bal0 bal1 bal2 ...)
(define (account->balancelist account)
@ -297,21 +287,10 @@
;; (list acc2 bal0 bal1 bal2 ...) ...)
;; whereby list of balances are gnc-monetary objects
;; output: (list <mon-coll0> <mon-coll1> <mon-coll2>)
(define list-of-collectors
(let loop ((n (length dates)) (result '()))
(if (zero? n) result
(loop (1- n) (cons (gnc:make-commodity-collector) result)))))
(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)
(define (call thunk) (thunk))
(if (null? lst)
(map call (make-list (length dates) gnc:make-commodity-collector))
(apply map gnc:monetaries-add (map cdr lst))))
(let loop ((dates dates)
(acct-balances (acc-balances->list-of-balances filtered-account-balances))
@ -358,7 +337,7 @@
dates-list #f))
(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?
(list-head dates-list (1- (length dates-list)))

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

@ -1389,38 +1389,42 @@ be excluded from periodic reporting.")
(reverse result)
(let* ((mon (retrieve-commodity (car columns) commodity))
(this-column (and mon (gnc:gnc-monetary-amount mon))))
(if (car merge-list)
;; We're merging. If a subtotal exists, send to next loop iteration.
(loop #t
this-column
(cond
;; We're merging. If a subtotal exists, send to next loop iteration.
((car merge-list)
(loop #t
this-column
(cdr columns)
(cdr merge-list)
result))
;; We're completing merge. Display debit-credit in correct column.
(merging?
(let* ((sum (and (or last-column this-column)
(- (or last-column 0) (or this-column 0))))
(sum-table-cell (and sum (gnc:make-html-table-cell/markup
"total-number-cell"
(gnc:make-gnc-monetary
commodity (abs sum)))))
(debit-col (and sum (positive? sum) sum-table-cell))
(credit-col (and sum (not (positive? sum)) sum-table-cell)))
(loop #f
#f
(cdr columns)
(cdr merge-list)
result)
(begin
(if merging?
;; We're completing merge. Display debit-credit in correct column.
(let* ((sum (and (or last-column this-column)
(- (or last-column 0) (or this-column 0))))
(sum-table-cell (and sum (gnc:make-html-table-cell/markup
"total-number-cell"
(gnc:make-gnc-monetary
commodity (abs sum)))))
(debit-col (and sum (positive? sum) sum-table-cell))
(credit-col (and sum (not (positive? sum)) sum-table-cell)))
(loop #f
#f
(cdr columns)
(cdr merge-list)
(cons* (or credit-col "")
(or debit-col "")
result)))
;; Default; not merging nor completed merge. Just add amount to result.
(loop #f
#f
(cdr columns)
(cdr merge-list)
(cons (gnc:make-html-table-cell/markup "total-number-cell" mon)
result)))))))))
(cons* (or credit-col "")
(or debit-col "")
result))))
;; Not merging nor completed merge. Just add amount to result.
(else
(loop #f
#f
(cdr columns)
(cdr merge-list)
(cons (gnc:make-html-table-cell/markup "total-number-cell" mon)
result))))))))
;; take the first column of each commodity, add onto the subtotal grid
(set! grid (grid-add grid row col

9
gnucash/report/utility-reports/welcome-to-gnucash.scm
View File

@ -91,9 +91,12 @@
(gnc:html-document-add-object!
doc
(gnc:make-html-text
(gnc:html-markup-h2 (format (_ "Welcome to GnuCash ~a !") gnc:version))
(gnc:html-markup-p (format
(_ "GnuCash ~a has lots of nice features. Here are a few.") gnc:version))))
(gnc:html-markup-h2
(format #f (_ "Welcome to GnuCash ~a !")
gnc:version))
(gnc:html-markup-p
(format #f (_ "GnuCash ~a has lots of nice features. Here are a few.")
gnc:version))))
doc))
(gnc:define-report