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 branch 'maint'

Browse Source
This commit is contained in:
Christopher Lam 2019-07-20 21:13:54 +08:00
commit 63f484c555
13 changed files with 131 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
gnucash/register/register-gnome/CMakeLists.txt
View File

@ -1,4 +1,5 @@
add_subdirectory(test)
include(CheckSymbolExists)
#GTK before 3.14 didn't have GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK
check_symbol_exists(GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK gdk/gdktypes.h have_mod_mask)

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

@ -121,11 +121,12 @@
;; 'accounts', excluding the 'exclude-commodity'.
(define (gnc:accounts-get-commodities accounts exclude-commodity)
(delete exclude-commodity
(delete-duplicates
(sort (map xaccAccountGetCommodity accounts)
(lambda (a b)
(string<? (or (gnc-commodity-get-mnemonic a) "")
(or (gnc-commodity-get-mnemonic b) "")))))))
(sort-and-delete-duplicates
(map xaccAccountGetCommodity accounts)
(lambda (a b)
(string<? (gnc-commodity-get-mnemonic a)
(gnc-commodity-get-mnemonic b)))
gnc-commodity-equiv)))
;; Returns the depth of the current account hierarchy, that is, the
@ -140,6 +141,15 @@
(append-map gnc-account-get-descendants-sorted
accountlist))
;; Return accountslist *and* their descendant accounts
(define (gnc:accounts-and-all-descendants accountslist)
(sort-and-delete-duplicates
(append accountslist
(gnc:acccounts-get-all-subaccounts accountslist))
(lambda (a b)
(string<? (gnc-account-get-full-name a) (gnc-account-get-full-name b)))
equal?))
;;; Here's a statistics collector... Collects max, min, total, and makes
;;; it easy to get at the mean.

1
gnucash/report/report.scm
View File

@ -698,6 +698,7 @@
(export gnc:account-get-type-string-plural)
(export gnc:accounts-get-commodities)
(export gnc:get-current-account-tree-depth)
(export gnc:accounts-and-all-descendants)
(export gnc:acccounts-get-all-subaccounts)
(export gnc:make-value-collector)
(export gnc:make-number-collector) ;deprecated

16
gnucash/report/reports/example/daily-reports.scm
View File

@ -224,20 +224,8 @@
;; if requested)
(gnc:report-percent-done 25)
(if dosubs?
(let ((subaccts '()))
(for-each
(lambda (acct)
(let ((this-acct-subs
(gnc-account-get-descendants-sorted acct)))
(if (list? this-acct-subs)
(set! subaccts
(append subaccts this-acct-subs)))))
accounts)
;; Beware: delete-duplicates is an O(n^2)
;; algorithm. More efficient method: sort the list,
;; then use a linear algorithm.
(set! accounts
(delete-duplicates (append accounts subaccts)))))
(set! accounts
(gnc:accounts-and-all-descendants accounts)))
(gnc:report-percent-done 30)
(xaccQueryAddAccountMatch

3
gnucash/report/reports/standard/balance-forecast.scm
View File

@ -167,8 +167,7 @@ date point, a projected minimum balance including scheduled transactions."))
(accum (gnc:make-commodity-collector))
(exchange-fn (gnc:case-exchange-time-fn
price currency
(delete-duplicates! (map xaccAccountGetCommodity accounts)
gnc-commodity-equiv)
(gnc:accounts-get-commodities accounts #f)
to-date #f #f))
(accounts-balancelist
(map

7
gnucash/report/reports/standard/balsheet-pnl.scm
View File

@ -802,12 +802,7 @@ also show overall period profit & loss."))
;; missing price, say so.
(get-exchange-rates-fn
(lambda (accounts col-idx)
(let ((commodities (delete
common-currency
(delete-duplicates
(map xaccAccountGetCommodity accounts)
gnc-commodity-equal)
gnc-commodity-equal))
(let ((commodities (gnc:accounts-get-commodities accounts common-currency))
(cell (gnc:make-html-text)))
(for-each
(lambda (commodity)

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

@ -370,8 +370,7 @@ developing over time"))
(xaccSplitGetAmount s))))))))
;; all selected accounts (of report-specific type), *and*
;; their descendants (of any type) need to be scanned.
(delete-duplicates
(append accounts (gnc:acccounts-get-all-subaccounts accounts)))))
(gnc:accounts-and-all-descendants accounts)))
;; Creates the <balance-list> to be used in the function
;; below.

4
gnucash/report/reports/standard/customer-summary.scm
View File

@ -291,9 +291,7 @@
(expense-accounts (opt-val pagename-expenseaccounts optname-expenseaccounts))
(sales-accounts (opt-val pagename-incomeaccounts optname-incomeaccounts))
(all-accounts (append sales-accounts expense-accounts))
(commodities (delete-duplicates
(map xaccAccountGetCommodity all-accounts)
gnc-commodity-equiv))
(commodities (gnc:accounts-get-commodities all-accounts #f))
(commodities>1? (> (length commodities) 1))
(book (gnc-get-current-book))
(date-format (gnc:options-fancy-date book))

42
gnucash/report/test/test-report-utilities.scm
View File

@ -22,6 +22,7 @@
(test-commodity-collector)
(test-get-account-balances)
(test-monetary-adders)
(test-utility-functions)
(test-end "report-utilities"))
(define (NDayDelta t64 n)
@ -244,7 +245,8 @@
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
(list "Income-GBP" (list (cons 'type ACCT-TYPE-INCOME)
(cons 'commodity (mnemonic->commodity "GBP"))))
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE))
(list "Fuel"))
(list "Liabilities" (list (cons 'type ACCT-TYPE-LIABILITY)))
(list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))
))
@ -465,6 +467,44 @@
(gnc:get-assoc-account-balances-total account-balances)))))
(teardown)))
(define (test-utility-functions)
(define (account-lookup str)
(gnc-account-lookup-by-name
(gnc-book-get-root-account (gnc-get-current-book))
str))
(test-group-with-cleanup "utility functions"
(create-test-data)
(test-equal "gnc:accounts-get-commodities"
(list "GBP" "USD")
(map gnc-commodity-get-mnemonic
(gnc:accounts-get-commodities (gnc-account-get-descendants-sorted
(gnc-get-current-root-account))
#f)))
(test-equal "gnc:get-current-account-tree-depth"
5
(gnc:get-current-account-tree-depth))
(test-equal "gnc:acccounts-get-all-subaccounts"
(list (account-lookup "Fuel")
(account-lookup "GBP Savings"))
(gnc:acccounts-get-all-subaccounts
(list (account-lookup "Expenses")
(account-lookup "GBP Bank"))))
(test-equal "gnc:accounts-and-all-descendants"
(list (account-lookup "GBP Bank")
(account-lookup "GBP Savings")
(account-lookup "Expenses")
(account-lookup "Fuel"))
(gnc:accounts-and-all-descendants
(list (account-lookup "Expenses")
(account-lookup "GBP Bank"))))
(teardown)))
(define (test-monetary-adders)
(define (monetary->pair mon)
(let ((comm (gnc:gnc-monetary-commodity mon))

6
libgnucash/backend/sql/gnc-transaction-sql.cpp
View File

@ -70,7 +70,7 @@ static QofLogModule log_module = G_LOG_DOMAIN;
#define TRANSACTION_TABLE "transactions"
#define TX_TABLE_VERSION 4
#define SPLIT_TABLE "splits"
#define SPLIT_TABLE_VERSION 4
#define SPLIT_TABLE_VERSION 5
struct split_info_t : public write_objects_t
{
@ -456,7 +456,9 @@ GncSqlSplitBackend::create_tables (GncSqlBackend* sql_be)
/* Upgrade:
1->2: 64 bit int handling
3->4: Split reconcile date can be NULL */
3->4: Split reconcile date can be NULL
4->5: Use DATETIME instead of TIMESTAMP in MySQL
*/
sql_be->upgrade_table(m_table_name.c_str(), split_col_table);
if (!sql_be->create_index("splits_tx_guid_index",
m_table_name.c_str(),

53
libgnucash/engine/business-core.scm
View File

@ -19,6 +19,7 @@
(define-module (gnucash business-core))
(use-modules (gnucash gnc-module))
(use-modules (srfi srfi-1))
(gnc:module-load "gnucash/engine" 0)
(define (gnc:owner-get-address owner)
@ -99,39 +100,29 @@
(let ((type type-val))
(equal? type GNC-AMT-TYPE-PERCENT)))
;; this function aims to find a split's owner. various splits are
;; supported: (1) any splits in the invoice posted transaction, in
;; APAR or income/expense accounts (2) any splits from invoice's
;; payments, in APAR or asset/liability accounts. it returns either
;; the owner or '() if not found. in addition, if owner was found, the
;; result-owner argument is mutated to it.
(define (gnc:owner-from-split split result-owner)
(define (notnull x) (and (not (null? x)) x))
(let* ((trans (xaccSplitGetParent split))
(invoice (gncInvoiceGetInvoiceFromTxn trans))
(temp-owner (gncOwnerNew))
(owner '()))
(if (not (null? invoice))
(set! owner (gncInvoiceGetOwner invoice))
(let ((split-list (xaccTransGetSplitList trans)))
(define (check-splits splits)
(if (and splits (not (null? splits)))
(let* ((split (car splits))
(lot (xaccSplitGetLot split)))
(if (not (null? lot))
(let* ((invoice (gncInvoiceGetInvoiceFromLot lot))
(owner? (gncOwnerGetOwnerFromLot
lot temp-owner)))
(if (not (null? invoice))
(set! owner (gncInvoiceGetOwner invoice))
(if owner?
(set! owner temp-owner)
(check-splits (cdr splits)))))
(check-splits (cdr splits))))))
(check-splits split-list)))
(if (not (null? owner))
(begin
(gncOwnerCopy (gncOwnerGetEndOwner owner) result-owner)
(gncOwnerFree temp-owner)
result-owner)
(begin
(gncOwnerFree temp-owner)
'()))))
(invoice (notnull (gncInvoiceGetInvoiceFromTxn trans)))
(temp (gncOwnerNew))
(owner (or (and invoice (gncInvoiceGetOwner invoice))
(any
(lambda (split)
(let* ((lot (xaccSplitGetLot split))
(invoice (notnull (gncInvoiceGetInvoiceFromLot lot))))
(or (and invoice (gncInvoiceGetOwner invoice))
(and (gncOwnerGetOwnerFromLot lot temp) temp))))
(xaccTransGetSplitList trans)))))
(gncOwnerFree temp)
(cond (owner (gncOwnerCopy (gncOwnerGetEndOwner owner) result-owner)
result-owner)
(else '()))))
(export gnc:owner-get-address)

26
libgnucash/scm/test/test-libgnucash-scm-utilities.scm
View File

@ -9,6 +9,7 @@
(test-begin "test-libgnucash-scm-utilities.scm")
(test-traverse-vec)
(test-substring-replace)
(test-sort-and-delete-duplicates)
(test-begin "test-libgnucash-scm-utilities.scm"))
(define (test-traverse-vec)
@ -61,3 +62,28 @@
"foo" "xxx" 4 -1))
(test-end "substring-replace"))
(define (test-sort-and-delete-duplicates)
(test-begin "sort-and-delete-duplicates")
(test-equal "sort-and-delete-duplicates empty"
'()
(sort-and-delete-duplicates '() <))
(test-equal "sort-and-delete-duplicates 1-element"
'(1)
(sort-and-delete-duplicates '(1) <))
(test-equal "sort-and-delete-duplicates 2-element, equal"
'(1)
(sort-and-delete-duplicates '(1 1) <))
(test-equal "sort-and-delete-duplicates 2-element, unequal"
'(1 2)
(sort-and-delete-duplicates '(2 1) <))
(test-equal "sort-and-delete-duplicates 3-element, equal"
'(1)
(sort-and-delete-duplicates '(1 1 1) <))
(test-equal "sort-and-delete-duplicates 3-element, 2-equal"
'(1 2)
(sort-and-delete-duplicates '(1 2 1) <))
(test-equal "sort-and-delete-duplicates 3-element, unequal"
'(1 2 3)
(sort-and-delete-duplicates '(3 1 2) <))
(test-end "sort-and-delete-duplicates"))

15
libgnucash/scm/utilities.scm
View File

@ -46,6 +46,7 @@
(export gnc:msg)
(export gnc:debug)
(export addto!)
(export sort-and-delete-duplicates)
;; Do this stuff very early -- but other than that, don't add any
;; executable code until the end of the file if you can help it.
@ -179,3 +180,17 @@
(lambda args
(gnc:warn "strftime may be buggy. use gnc-print-time64 instead.")
(apply strftime-old args))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; a basic sort-and-delete-duplicates. because delete-duplicates
;; usually run in O(N^2) and if the list must be sorted, it's more
;; efficient to sort first then delete adjacent elements. guile-2.0
;; uses quicksort internally.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define* (sort-and-delete-duplicates lst < #:optional (= =))
(let lp ((lst (sort lst <)) (result '()))
(cond
((null? lst) '())
((null? (cdr lst)) (reverse (cons (car lst) result)))
((= (car lst) (cadr lst)) (lp (cdr lst) result))
(else (lp (cdr lst) (cons (car lst) result))))))