diff --git a/bindings/guile/business-core.scm b/bindings/guile/business-core.scm index 3093cb8f51..30c56d73e5 100644 --- a/bindings/guile/business-core.scm +++ b/bindings/guile/business-core.scm @@ -99,6 +99,8 @@ ;; 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. use gnc:split->owner instead.") (let* ((trans (xaccSplitGetParent split)) (invoice (notnull (gncInvoiceGetInvoiceFromTxn trans))) (temp (gncOwnerNew)) @@ -114,3 +116,27 @@ (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. +(define gnc:split->owner + (let ((ht (make-hash-table))) + (lambda (split) + (cond + ((not split) + (hash-for-each (lambda (k v) (gncOwnerFree v)) ht) + (hash-clear! ht)) + ((hashv-ref ht (string-hash (gncSplitGetGUID split))) => identity) + (else + (let ((lot (xaccSplitGetLot split)) + (owner (gncOwnerNew))) + (unless (gncOwnerGetOwnerFromLot lot owner) + (gncOwnerCopy (gncOwnerGetEndOwner + (gncInvoiceGetOwner + (gncInvoiceGetInvoiceFromLot lot))) + owner)) + (hashv-set! ht (string-hash (gncSplitGetGUID split)) owner) + owner)))))) diff --git a/bindings/guile/engine.scm b/bindings/guile/engine.scm index 06f8d0af49..da91cf47cf 100644 --- a/bindings/guile/engine.scm +++ b/bindings/guile/engine.scm @@ -73,6 +73,7 @@ (export gnc:owner-get-name-and-address-dep) (export gnc:owner-get-owner-id) (export gnc:owner-from-split) +(export gnc:split->owner) (load-from-path "gnucash/engine/gnc-numeric") (load-from-path "gnucash/engine/commodity-table") diff --git a/gnucash/report/reports/standard/new-aging.scm b/gnucash/report/reports/standard/new-aging.scm index fa8858c005..a03483b0fc 100644 --- a/gnucash/report/reports/standard/new-aging.scm +++ b/gnucash/report/reports/standard/new-aging.scm @@ -171,10 +171,10 @@ exist but have no suitable transactions.")) (eqv? type TXN-TYPE-PAYMENT))))) (define (split-has-owner? split owner) - (gncOwnerEqual (split->owner split) owner)) + (gncOwnerEqual (gnc:split->owner split) owner)) (define (split-owner-is-invalid? split) - (not (gncOwnerIsValid (split->owner split)))) + (not (gncOwnerIsValid (gnc:split->owner split)))) (define (split-from-acct? split acct) (equal? acct (xaccSplitGetAccount split))) @@ -183,28 +183,6 @@ exist but have no suitable transactions.")) (let-values (((list-yes list-no) (partition (lambda (elt) (fn elt cmp)) lst))) (cons list-yes list-no))) -;; optimized from gnc:owner-from-split. 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 split->owner - (let ((ht (make-hash-table))) - (lambda (split) - (cond - ((not split) - (hash-for-each (lambda (k v) (gncOwnerFree v)) ht) - (hash-clear! ht)) - ((hashv-ref ht (string-hash (gncSplitGetGUID split))) => identity) - (else - (let ((lot (xaccSplitGetLot split)) - (owner (gncOwnerNew))) - (unless (gncOwnerGetOwnerFromLot lot owner) - (gncOwnerCopy (gncOwnerGetEndOwner - (gncInvoiceGetOwner - (gncInvoiceGetInvoiceFromLot lot))) - owner)) - (hashv-set! ht (string-hash (gncSplitGetGUID split)) owner) - owner)))))) - (define (aging-renderer report-obj receivable) (define options (gnc:report-options report-obj)) (define (op-value section name) @@ -264,6 +242,10 @@ exist but have no suitable transactions.")) (let* ((splits (xaccQueryGetSplitsUniqueTrans query))) (qof-query-destroy query) + ;; split->owner hashtable should be empty at the start of + ;; report renderer. clear it anyway. + (gnc:split->owner #f) + ;; loop into each APAR account (let loop ((accounts accounts) (splits splits) @@ -345,7 +327,7 @@ exist but have no suitable transactions.")) acc-totals))))) (reverse accounts-and-owners)) - (split->owner #f) ;free the gncOwners + (gnc:split->owner #f) ;free the gncOwners (gnc:html-document-add-object! document table) (unless (null? invalid-splits) @@ -402,7 +384,7 @@ exist but have no suitable transactions.")) owners-and-aging)) ((this . _) - (match-let* ((owner (split->owner this)) + (match-let* ((owner (gnc:split->owner this)) ((owner-splits . other-owner-splits) (list-split acc-splits split-has-owner? owner)) (aging (gnc:owner-splits->aging-list