Revert "Revert "Merge Stefan Bayer's 'SepaInternalTransfer' into maint.""

The original merge was of a PR based on master into maint, bringing
along all of the development changes in master along with it. We don't
want that so the merge was reverted and the PR's two changes
cherry-picked in. That fixed maint, but then the next regular merge of
maint into master naturally included that revert commit undoing the
changes in master. Not so good. Reverting the revert, this commit,
restores the changes, albeit with messed up history.
This commit is contained in:
John Ralls
2022-01-08 14:29:08 -08:00
parent 5603acba31
commit c1c75e8f81
54 changed files with 858 additions and 5322 deletions

View File

@@ -127,14 +127,6 @@ gnc_add_scheme_targets(scm-engine-2
add_custom_target(scm-engine ALL DEPENDS scm-engine-2 scm-engine-1 scm-engine-0)
set(scm_gnc_module_DEPENDS
gnucash-guile)
gnc_add_scheme_targets(scm-gnc-module
SOURCES gnc-module.scm
OUTPUT_DIR gnucash
DEPENDS "${scm_gnc_module_DEPENDS}")
set_local_dist(guile_DIST_local
CMakeLists.txt
core-utils.scm

View File

@@ -30,7 +30,6 @@
(export gnc:owner-get-address-dep)
(export gnc:owner-get-name-and-address-dep)
(export gnc:owner-get-owner-id)
(export gnc:owner-from-split)
(export gnc:split->owner)
(define (gnc:owner-get-address owner)
@@ -105,37 +104,9 @@
(gnc:owner-get-owner-id (gncJobGetOwner (gncOwnerGetJob owner))))
(else ""))))
;; 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))
(issue-deprecation-warning
"gnc:owner-from-split is deprecated in 4.x. use gnc:split->owner instead.")
(let* ((trans (xaccSplitGetParent split))
(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 '()))))
;; optimized from above, and simpler: does not search all transaction
;; splits. It will allocate and memoize (cache) the owners because
;; gncOwnerGetOwnerFromLot is slow. after use, it must be called with
;; #f to free the owners.
;; this function aims to find a split's owner. It will allocate and
;; memoize (cache) the owners because gncOwnerGetOwnerFromLot is
;; slow. after use, it must be called with #f to free the owners.
(define gnc:split->owner
(let ((ht (make-hash-table)))
(lambda (split)

View File

@@ -30,44 +30,3 @@
(gnucash engine business-core)
(gnucash engine commodity-table)
(gnucash engine gnc-numeric))
(export gnc-pricedb-lookup-latest-before-t64)
(export gnc-pricedb-lookup-latest-before-any-currency-t64)
(export gnc:account-map-descendants)
(export gnc:account-map-children)
(export account-full-name<?)
(export accounts-get-children-depth)
(define (gnc-pricedb-lookup-latest-before-t64 . args)
(issue-deprecation-warning "gnc-pricedb-lookup-latest-before-t64 has been renamed to gnc-pricedb-lookup-nearest-before-t64")
(apply gnc-pricedb-lookup-nearest-before-t64 args))
(define (gnc-pricedb-lookup-latest-before-any-currency-t64 . args)
(issue-deprecation-warning "gnc-pricedb-lookup-latest-before-any-currency-t64 has been renamed to gnc-pricedb-lookup-nearest-before-any-currency-t64")
(apply gnc-pricedb-lookup-nearest-before-any-currency-t64 args))
;; A few account related utility functions which used to be in engine-utilities.scm
(define (gnc:account-map-descendants thunk account)
(issue-deprecation-warning "gnc:account-map-descendants is deprecated.")
(map thunk (or (gnc-account-get-descendants-sorted account) '())))
(define (gnc:account-map-children thunk account)
(issue-deprecation-warning "gnc:account-map-children is deprecated.")
(map thunk (or (gnc-account-get-children-sorted account) '())))
;; account related functions
;; helper for sorting of account list
(define (account-full-name<? a b)
(issue-deprecation-warning
"account-full-name<? is deprecated. use gnc:account-full-name<? instead.")
(string<? (gnc-account-get-full-name a) (gnc-account-get-full-name b)))
;; return maximum depth over accounts and their children, if any
(define (accounts-get-children-depth accounts)
(issue-deprecation-warning "accounts-get-children-depth is deprecated. use \
gnc:accounts-get-children-depth instead.")
(1- (apply max
(map (lambda (acct)
(+ (gnc-account-get-current-depth acct)
(gnc-account-get-tree-depth acct)))
accounts))))

View File

@@ -1,88 +0,0 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; gnc-module.scm
;;; Guile module which allows initialization of the gnucash module
;;; system from Scheme
;;;
;;; Copyright 2001 Linux Developers Group
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash gnc-module))
(use-modules (ice-9 match))
(define (deprecate . lst)
;; 4.x deprecation. remove in 5.x
(issue-deprecation-warning (string-concatenate lst)))
(define (no-op-deprecation-warning)
(deprecate "* WARNING * Guile wrappers for the gnc module system have been \
deprecated. This particular function call is now a no-op. Please use \
equivalent (use-modules ...) calls instead."))
(define-public gnc:module-system-init no-op-deprecation-warning)
(define-public gnc:module-system-refresh no-op-deprecation-warning)
(define-public gnc:module-load-optional no-op-deprecation-warning)
(define-public gnc:module-unload no-op-deprecation-warning)
(define-public (gnc:module-load gnc-mod-name mod-sys-version)
(let* ((mod-name-split (string-split gnc-mod-name #\/))
(mod-name-str (string-join mod-name-split " "))
(scm-mod-name (map string->symbol mod-name-split)))
(match gnc-mod-name
("gnucash/app-utils"
(deprecate "* WARNING * 'gnc:module-load (\"gnucash/app-utils\" 0)' has \
been deprecated and will be removed in gnucash 5.0. Use '(use-modules (gnucash \
engine) (gnucash app-utils))' instead. Use of the '(gnucash engine)' guile \
module is optional and depends on whether or not you use functions from \
this module in your code or not.")
(use-modules (gnucash engine) (gnucash app-utils)))
((or "gnucash/tax/de_DE" "gnucash/tax/us")
(set! scm-mod-name `(gnucash locale ,(list-ref scm-mod-name 2) tax))
(set! mod-name-str (string-join (map symbol->string scm-mod-name) " "))
(deprecate "* WARNING * '(gnc:module-load \"" gnc-mod-name "\" 0)' has \
been deprecated. Use '(use-modules (" mod-name-str "))' instead.")
(module-use! (current-module) (resolve-interface scm-mod-name)))
((or "gnucash/gnome-utils" "gnucash/report/report-system")
(when (string=? gnc-mod-name "gnucash/report/report-system")
(set! mod-name-str "gnucash report"))
(set! scm-mod-name '(gnucash report))
(deprecate "* WARNING * '(gnc:module-load \"" gnc-mod-name "\" 0)' has \
been deprecated. Use '(use-modules (gnucash engine) (gnucash app-utils) \
(" mod-name-str "))' instead. Use of the '(gnucash engine)' or \
'(gnucash app-utils)' guile modules is optional and depends on whether \
or not you use functions from this module in your code or not.")
(use-modules (gnucash engine) (gnucash app-utils))
(module-use! (current-module) (resolve-interface scm-mod-name)))
("gnucash/html"
(deprecate "* WARNING * '(gnc:module-load \"gnucash/html\" 0)' has \
been deprecated. Use '(use-modules (gnucash html))' instead.")
(use-modules (gnucash html))
(module-use! (current-module) (resolve-interface scm-mod-name)))
(_ (deprecate "* WARNING * '(gnc:module-load \"" gnc-mod-name "\" 0)' \
has been deprecated. Use '(use-modules (" mod-name-str "))' instead. \
Additional guile modules may have to be loaded depending on your specific code.")
(module-use! (current-module) (resolve-interface scm-mod-name))))))

View File

@@ -31,7 +31,6 @@ set(bindings_test_SCHEME
#list(APPEND engine_test_SCHEME test-scm-query-import.scm) Fails
set(GUILE_DEPENDS
scm-gnc-module
scm-app-utils
scm-core-utils
scm-engine)
@@ -41,12 +40,6 @@ gnc_add_scheme_test_targets(scm-test-engine-extras
OUTPUT_DIR "tests"
DEPENDS "${GUILE_DEPENDS}")
# Module interfaces deprecated in 4.x, will be removed for 5.x
gnc_add_scheme_deprecated_module (
OLD_MODULE "gnucash engine test test-extras"
NEW_MODULE "tests test-engine-extras"
DEPENDS "scm-test-engine-extras")
gnc_add_scheme_test_targets(scm-test-engine
SOURCES "${bindings_test_SCHEME}"
OUTPUT_DIR "tests"
@@ -69,12 +62,6 @@ if (HAVE_SRFI64)
OUTPUT_DIR "tests"
DEPENDS "${GUILE_DEPENDS};scm-test-engine-extras;scm-srfi64-extras")
# Module interfaces deprecated in 4.x, will be removed for 5.x
gnc_add_scheme_deprecated_module (
OLD_MODULE "gnucash engine test srfi64-extras"
NEW_MODULE "tests srfi64-extras"
DEPENDS "scm-srfi64-extras")
gnc_add_scheme_test_targets (scm-test-with-srfi64
SOURCES "${scm_tests_with_srfi64_SOURCES}"
OUTPUT_DIR "tests"
@@ -91,7 +78,6 @@ set(test_scm_SCHEME
)
set(GUILE_DEPENDS
scm-gnc-module
scm-app-utils
scm-engine
scm-srfi64-extras
@@ -130,6 +116,7 @@ set(test_guile_DIST
)
# Define two imaginary deprecated guile modules to test the compat file generation code
# See commit bbcffa3ec for old code using this function.
gnc_add_scheme_deprecated_module (OLD_MODULE "gnucash deprecated-module")
gnc_add_scheme_deprecated_module (
OLD_MODULE "gnucash superseded-module"

View File

@@ -242,57 +242,4 @@
(env-transfer env 01 01 1990
(get-acct "Income-GBP") (get-acct "Bank-GBP") 10)
(let ((new-owner (gncOwnerNew)))
(test-equal "new-owner is initially empty"
""
(gncOwnerGetName new-owner))
(test-equal "gnc:owner-from-split (from AR) return"
"cust-1-name"
(gncOwnerGetName
(gnc:owner-from-split
(last (xaccAccountGetSplitList (get-acct "AR-USD")))
new-owner)))
(test-equal "gnc:owner-from-split (from AR) mutated"
"cust-1-name"
(gncOwnerGetName new-owner))
(set! new-owner (gncOwnerNew))
(test-equal "gnc:owner-from-split (from inc-acct) return"
"cust-1-name"
(gncOwnerGetName
(gnc:owner-from-split
(last (xaccAccountGetSplitList (get-acct "Income-USD")))
new-owner)))
(test-equal "gnc:owner-from-split (from inc-acct) mutated"
"cust-1-name"
(gncOwnerGetName new-owner))
(set! new-owner (gncOwnerNew))
(test-equal "gnc:owner-from-split (from payment txn) return"
"cust-1-name"
(gncOwnerGetName
(gnc:owner-from-split
(last (xaccAccountGetSplitList (get-acct "Bank-USD")))
new-owner)))
(test-equal "gnc:owner-from-split (from payment txn) mutated"
"cust-1-name"
(gncOwnerGetName new-owner))
(set! new-owner 'reset)
(test-equal "gnc:owner-from-split (non-business split) return"
""
(gncOwnerGetName
(gnc:owner-from-split
(last (xaccAccountGetSplitList (get-acct "Bank-GBP")))
new-owner)))
(test-equal "gnc:owner-from-split (non-business split) mutated"
'reset
new-owner))
))

View File

@@ -11,10 +11,4 @@
(define (test-engine)
(test-begin "testing function availability")
(test-assert "testing gnc-pricedb-lookup-latest-before-t64"
(gnc-pricedb-lookup-latest-before-t64 '() '() '() 0))
(test-assert "testing gnc-pricedb-lookup-latest-before-any-currency-t64"
(gnc-pricedb-lookup-latest-before-any-currency-t64 '() '() 0))
(test-end "testing deprecated functions"))

View File

@@ -7,25 +7,12 @@
(define (run-test)
(test-runner-factory gnc:test-runner)
(test-begin "test-scm-utilities.scm")
(test-traverse-vec)
(test-substring-replace)
(test-sort-and-delete-duplicates)
(test-gnc:html-string-sanitize)
(test-gnc:list-flatten)
(test-end "test-scm-utilities.scm"))
(define (test-traverse-vec)
(test-begin "traverse-vec")
(test-equal "list->vec"
(vector 1 (vector 2 3))
(traverse-list->vec
(list 1 (list 2 3))))
(test-equal "vec->list"
(list 1 (list 2 3))
(traverse-vec->list
(vector 1 (vector 2 3))))
(test-end "traverse-vec"))
(define (test-substring-replace)
(test-begin "substring-replace")
@@ -34,35 +21,6 @@
"fooxyzfooxyz"
(gnc:substring-replace "foobarfoobar" "bar" "xyz"))
;; note the following 2 tests illustrate code behaviour: start from
;; 2nd matched substring, and perform either 2 or 1 substitution.
(test-equal "gnc:substring-replace-from-to ... ... 2 2"
"foobarfooxyzfooxyz"
(gnc:substring-replace-from-to "foobarfoobarfoobar" "bar" "xyz" 2 2))
(test-equal "gnc:substring-replace-from-to ... ... 2 1"
"foobarfooxyzfoobar"
(gnc:substring-replace-from-to "foobarfoobarfoobar" "bar" "xyz" 2 1))
;; comprehensive test suite for gnc:substring-replace-from-to:
(test-equal "gnc:substring-replace-from-to ... ... 2 1"
"foo xxx foo foo foo foo foo foo"
(gnc:substring-replace-from-to
"foo foo foo foo foo foo foo foo"
"foo" "xxx" 2 1))
(test-equal "gnc:substring-replace-from-to ... ... 1 1"
"xxx foo foo foo foo foo foo foo"
(gnc:substring-replace-from-to
"foo foo foo foo foo foo foo foo"
"foo" "xxx" 1 1))
(test-equal "gnc:substring-replace-from-to ... ... 4 -1"
"foo foo foo xxx xxx xxx xxx xxx"
(gnc:substring-replace-from-to
"foo foo foo foo foo foo foo foo"
"foo" "xxx" 4 -1))
(test-end "substring-replace"))
(define (test-sort-and-delete-duplicates)

View File

@@ -32,8 +32,6 @@
(export addto!)
(export sort-and-delete-duplicates)
(export gnc:list-flatten)
(export traverse-list->vec)
(export traverse-vec->list)
(export gnc:substring-replace-from-to)
(export gnc:substring-replace)
(export gnc:html-string-sanitize)
@@ -66,22 +64,6 @@
(define-syntax-rule (addto! alist element)
(set! alist (cons element alist)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; pair of utility functions for use with guile-json which requires
;; lists converted vectors to save as json arrays. traverse list
;; converting into vectors, and vice versa.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (traverse-list->vec lst)
(issue-deprecation-warning "traverse-list->vec unused.")
(cond
((list? lst) (list->vector (map traverse-list->vec lst)))
(else lst)))
(define (traverse-vec->list vec)
(issue-deprecation-warning "traverse-vec->list unused.")
(cond
((vector? vec) (map traverse-vec->list (vector->list vec)))
(else vec)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; general and efficient string-replace-substring function, based on
@@ -126,26 +108,6 @@
(define (gnc:substring-replace s1 s2 s3)
(string-replace-substring s1 s2 s3))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:substring-replace-from-to
;; same as gnc:substring-replace extended by:
;; start: from which occurrence onwards the replacement shall start
;; end-after: max. number times the replacement should executed
;;
;; Example: (gnc:substring-replace-from-to "foobarfoobarfoobar" "bar" "xyz" 2 1)
;; returns "foobarfooxyzfoobar".
;;
;; start=1 and end-after<=0 will call gnc:substring-replace (replace all)
;; start>1 and end-after<=0 will the replace from "start" until end of file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:substring-replace-from-to s1 s2 s3 start end-after)
(issue-deprecation-warning "gnc:substring-replace-from-to is deprecated in 4.x.")
(string-replace-substring
s1 s2 s3 0 (string-length s1) (max 0 (1- start))
(and (positive? end-after) (+ (max 0 (1- start)) (1- end-after)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; function to sanitize strings. the resulting string can be safely
;; added to html.