gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Mon Jul 12 20:41:38 EDT 2021


Updated	 via  https://github.com/Gnucash/gnucash/commit/0fb186ca (commit)
	 via  https://github.com/Gnucash/gnucash/commit/074729bf (commit)
	 via  https://github.com/Gnucash/gnucash/commit/d1997c59 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/dc516bd5 (commit)
	 via  https://github.com/Gnucash/gnucash/commit/d258d59c (commit)
	 via  https://github.com/Gnucash/gnucash/commit/07bdfe6e (commit)
	 via  https://github.com/Gnucash/gnucash/commit/17e1ea46 (commit)
	from  https://github.com/Gnucash/gnucash/commit/b7deb6dd (commit)



commit 0fb186ca56b1c5d73c45824708c32691e36249f8
Merge: b7deb6ddc 074729bf1
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Tue Jul 13 08:31:58 2021 +0800

    Bug 797596 - New-owner - improved representation of payments with multiple non-APAR splits
    
    Moves function to a module.


commit 074729bf19fda23350256116bf6d27be229d74a3
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jul 8 21:22:55 2021 +0800

    [report-utilities] simplify gnc:payment-txn->payment-info
    
    store lot splits in a separate identifier

diff --git a/gnucash/report/report-utilities.scm b/gnucash/report/report-utilities.scm
index e38aa1c0f..cbb87301b 100644
--- a/gnucash/report/report-utilities.scm
+++ b/gnucash/report/report-utilities.scm
@@ -1006,28 +1006,26 @@ query instead.")
        (lp rest invoices (+ overpayment (xaccSplitGetAmount split))
            opposing-splits))
       ((split . rest)
-       (let ((lot (xaccSplitGetLot split)))
-         (define (equal-to-split? s) (equal? s split))
+       (let* ((lot (xaccSplitGetLot split))
+              (lot-all-splits (gnc-lot-get-split-list lot)))
+         (define split=? (cut equal? <> split))
          (match (gncInvoiceGetInvoiceFromLot lot)
-           (() (let lp1 ((lot-splits (gnc-lot-get-split-list lot))
+           (() (let lp1 ((lot-splits lot-all-splits)
                          (overpayment overpayment)
                          (opposing-splits opposing-splits))
                  (match lot-splits
                    (() (lp rest invoices overpayment opposing-splits))
-                   (((? equal-to-split?) . tail)
-                    (lp1 tail overpayment opposing-splits))
+                   (((? split=?) . tail) (lp1 tail overpayment opposing-splits))
                    ((s . tail)
-                    (let* ((s-lot (xaccSplitGetLot s))
-                           (sum
+                    (let* ((lot-bal (gnc-lot-get-balance lot))
+                           (lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
+                                        0 lot-bal))
+                           (derived? (not (zero? lot-bal)))
+                           (partial-amount
                             (fold
                              (lambda (a b)
                                (if (equal? s a) b (+ b (xaccSplitGetAmount a))))
-                             0 (gnc-lot-get-split-list s-lot)))
-                           (lot-bal (gnc-lot-get-balance s-lot))
-                           (lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
-                                        0 lot-bal))
-                           (partial-amount (- sum lot-bal))
-                           (derived? (not (zero? lot-bal))))
+                             (- lot-bal) lot-all-splits)))
                       (lp1 tail (+ overpayment partial-amount)
                            (cons (list s partial-amount derived?)
                                  opposing-splits)))))))

commit d1997c59bcc3435ed8b0574618bfe0222521365f
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jul 8 20:21:15 2021 +0800

    [report-utilities] fix gnc:owner-splits->aging-list prepayment calc
    
    aging-list uses the exported function instead of calculating
    overpayment using a different algorithm.

diff --git a/gnucash/report/report-utilities.scm b/gnucash/report/report-utilities.scm
index 6cbce24f2..e38aa1c0f 100644
--- a/gnucash/report/report-utilities.scm
+++ b/gnucash/report/report-utilities.scm
@@ -1085,23 +1085,18 @@ query instead.")
                 (loop (1+ idx) (cdr bucket-dates))))
           (lp (cdr splits))))
 
-       ;; next split is a payment. analyse its sister APAR splits. any
-       ;; split whose lot has no invoice is an overpayment.
+       ;; next split is a payment. analyze using
+       ;; gnc:payment-txn->payment-info and use its overpayment
        ((eqv? (xaccTransGetTxnType (xaccSplitGetParent (car splits)))
               TXN-TYPE-PAYMENT)
         (let* ((txn (xaccSplitGetParent (car splits)))
-               (splitlist (xaccTransGetAPARAcctSplitList txn #f))
-               (overpayment
-                (fold
-                 (lambda (a b)
-                   (if (null? (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot a)))
-                       (- b (gnc-lot-get-balance (xaccSplitGetLot a)))
-                       b))
-                 0 splitlist)))
+               (payment-info (gnc:payment-txn->payment-info txn))
+               (overpayment (vector-ref payment-info 2)))
+          (define (not-txn? s) (not (equal? txn (xaccSplitGetParent s))))
           (gnc:msg "next " (gnc:strify (car splits))
                    " overpayment " overpayment)
           (addbucket! (1- num-buckets) (if receivable? (- overpayment) overpayment))
-          (lp (cdr splits))))
+          (lp (filter not-txn? splits))))
 
        ;; not invoice/prepayment. regular or payment split.
        (else

commit dc516bd5d7b0f749fc3da16a423301486a7fbba0
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jul 8 20:07:20 2021 +0800

    [report-utilities] gnc:payment-txn->payment-info is exported
    
    move payment-txn analysis function into report-utilities.scm module.

diff --git a/gnucash/report/report-utilities.scm b/gnucash/report/report-utilities.scm
index 98ad3369c..6cbce24f2 100644
--- a/gnucash/report/report-utilities.scm
+++ b/gnucash/report/report-utilities.scm
@@ -97,6 +97,7 @@
 (export gnc:select-assoc-account-balance)
 (export gnc:get-assoc-account-balances-total)
 (export gnc:multiline-to-html-text)
+(export gnc:payment-txn->payment-info)
 (export make-file-url)
 (export gnc:strify)
 (export gnc:pk)
@@ -983,6 +984,59 @@ query instead.")
 ;; ***************************************************************************
 ;; Business Functions
 
+(define (sign-equal? a b) (or (= 0 a b) (< 0 (* a b))))
+(define (not-APAR? s)
+  (not (xaccAccountIsAPARType (xaccAccountGetType (xaccSplitGetAccount s)))))
+;; analyse a payment transaction and return a 3-element vector:
+;; (vector invoices opposing-splits overpayment)
+;;
+;; invoices: a list of (cons invoice inv-APAR-split)
+;; opposing-splits: a list of (list pmt-APAR-split partial-amount derived?)
+;;                 partial-amount is a number, derived? is #true if the partial
+;;                 amount does not match the transaction amount
+;; overpayment: a number indicating overpayment amount
+(define (gnc:payment-txn->payment-info txn)
+  (let lp ((splits (xaccTransGetSplitList txn))
+           (invoices '())
+           (overpayment 0)
+           (opposing-splits '()))
+    (match splits
+      (() (vector invoices opposing-splits overpayment))
+      (((? not-APAR? split) . rest)
+       (lp rest invoices (+ overpayment (xaccSplitGetAmount split))
+           opposing-splits))
+      ((split . rest)
+       (let ((lot (xaccSplitGetLot split)))
+         (define (equal-to-split? s) (equal? s split))
+         (match (gncInvoiceGetInvoiceFromLot lot)
+           (() (let lp1 ((lot-splits (gnc-lot-get-split-list lot))
+                         (overpayment overpayment)
+                         (opposing-splits opposing-splits))
+                 (match lot-splits
+                   (() (lp rest invoices overpayment opposing-splits))
+                   (((? equal-to-split?) . tail)
+                    (lp1 tail overpayment opposing-splits))
+                   ((s . tail)
+                    (let* ((s-lot (xaccSplitGetLot s))
+                           (sum
+                            (fold
+                             (lambda (a b)
+                               (if (equal? s a) b (+ b (xaccSplitGetAmount a))))
+                             0 (gnc-lot-get-split-list s-lot)))
+                           (lot-bal (gnc-lot-get-balance s-lot))
+                           (lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
+                                        0 lot-bal))
+                           (partial-amount (- sum lot-bal))
+                           (derived? (not (zero? lot-bal))))
+                      (lp1 tail (+ overpayment partial-amount)
+                           (cons (list s partial-amount derived?)
+                                 opposing-splits)))))))
+           (inv
+            (lp rest
+                (cons (cons inv split) invoices)
+                (+ overpayment (xaccSplitGetAmount split))
+                opposing-splits))))))))
+
 ;; create a stepped list, then add a date in the infinite future for
 ;; the "current" bucket
 (define (make-extended-interval-list to-date num-buckets)
diff --git a/gnucash/report/reports/standard/new-owner-report.scm b/gnucash/report/reports/standard/new-owner-report.scm
index bb4fb5454..490e43483 100644
--- a/gnucash/report/reports/standard/new-owner-report.scm
+++ b/gnucash/report/reports/standard/new-owner-report.scm
@@ -642,52 +642,6 @@ and do not match the transaction."))))))))
                      (cons (car lot-txn-splits) non-document)
                      result))))))))))
 
-
-  (define (not-APAR? s)
-    (not (xaccAccountIsAPARType (xaccAccountGetType (xaccSplitGetAccount s)))))
-
-  (define (payment-txn->payment-info txn)
-    (let lp ((splits (xaccTransGetSplitList txn))
-             (invoices '())
-             (overpayment 0)
-             (opposing-splits '()))
-      (match splits
-        (() (vector invoices opposing-splits overpayment))
-        (((? not-APAR? split) . rest)
-         (lp rest invoices (+ overpayment (xaccSplitGetAmount split))
-             opposing-splits))
-        ((split . rest)
-         (let ((lot (xaccSplitGetLot split)))
-           (define (equal-to-split? s) (equal? s split))
-           (match (gncInvoiceGetInvoiceFromLot lot)
-             (() (let lp1 ((lot-splits (gnc-lot-get-split-list lot))
-                           (overpayment overpayment)
-                           (opposing-splits opposing-splits))
-                   (match lot-splits
-                     (() (lp rest invoices overpayment opposing-splits))
-                     (((? equal-to-split?) . tail)
-                      (lp1 tail overpayment opposing-splits))
-                     ((s . tail)
-                      (let* ((s-lot (xaccSplitGetLot s))
-                             (sum
-                              (fold
-                               (lambda (a b)
-                                 (if (equal? s a) b (+ b (xaccSplitGetAmount a))))
-                               0 (gnc-lot-get-split-list s-lot)))
-                             (lot-bal (gnc-lot-get-balance s-lot))
-                             (lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
-                                          0 lot-bal))
-                             (partial-amount (- sum lot-bal))
-                             (derived? (not (zero? lot-bal))))
-                        (lp1 tail (+ overpayment partial-amount)
-                             (cons (list s partial-amount derived?)
-                                   opposing-splits)))))))
-             (inv
-              (lp rest
-                  (cons (cons inv split) invoices)
-                  (+ overpayment (xaccSplitGetAmount split))
-                  opposing-splits))))))))
-
   (define (make-payment->invoices-list txn)
     (list
      (list
@@ -754,7 +708,7 @@ and do not match the transaction."))))))))
                     currency ((if payable? + -) overpayment))))
                  (gncTransGetGUID txn)))))
 
-    (let* ((payment-info (payment-txn->payment-info txn))
+    (let* ((payment-info (gnc:payment-txn->payment-info txn))
            (invoices-result (invoices-list (vector-ref payment-info 0)))
            (payment-result (payments-list (vector-ref payment-info 1)))
            (overpayment-result (overpayment-list (vector-ref payment-info 2))))

commit d258d59c2958144b883bd1da7ba137e5f27c93a6
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jul 8 20:02:34 2021 +0800

    [new-owner-report] use vector instead of record for payment-info
    
    because the function will be exported, use a vector instead of a
    record. simplifies export.

diff --git a/gnucash/report/reports/standard/new-owner-report.scm b/gnucash/report/reports/standard/new-owner-report.scm
index 9e98dabd8..bb4fb5454 100644
--- a/gnucash/report/reports/standard/new-owner-report.scm
+++ b/gnucash/report/reports/standard/new-owner-report.scm
@@ -130,13 +130,6 @@
   (make-link-blank)
   link-blank?)
 
-(define-record-type :payment-info
-  (make-payment-info invoices opposing-splits overpayment)
-  payment-info?
-  (invoices payment-info-invoices)
-  (opposing-splits payment-info-opposing-splits)
-  (overpayment payment-info-overpayment))
-
 ;; Names in Option panel (Untranslated! Because it is used for option
 ;; naming and lookup only, and the display of the option name will be
 ;; translated somewhere else.)
@@ -659,7 +652,7 @@ and do not match the transaction."))))))))
              (overpayment 0)
              (opposing-splits '()))
       (match splits
-        (() (make-payment-info invoices opposing-splits overpayment))
+        (() (vector invoices opposing-splits overpayment))
         (((? not-APAR? split) . rest)
          (lp rest invoices (+ overpayment (xaccSplitGetAmount split))
              opposing-splits))
@@ -703,12 +696,12 @@ and do not match the transaction."))))))))
        (map
         (lambda (inv-split-pair)
           (invoice->anchor (car inv-split-pair)))
-        (payment-info-invoices (payment-txn->payment-info txn)))))))
+        (vector-ref (gnc:payment-txn->payment-info txn) 0))))))
 
   (define (make-payment->payee-table txn payable?)
 
-    (define (invoices-list payment-info)
-      (let lp ((invoice-split-pairs (payment-info-invoices payment-info))
+    (define (invoices-list invoice-split-pairs)
+      (let lp ((invoice-split-pairs invoice-split-pairs)
                (result '()))
         (match invoice-split-pairs
           (() (reverse result))
@@ -725,8 +718,8 @@ and do not match the transaction."))))))))
                         (gncInvoiceReturnGUID inv))
                        result)))))))
 
-    (define (payments-list payment-info)
-      (let lp1 ((opposing-splits (payment-info-opposing-splits payment-info))
+    (define (payments-list opposing-splits)
+      (let lp1 ((opposing-splits opposing-splits)
                 (pmt-list '()))
         (match opposing-splits
           (() (reverse pmt-list))
@@ -750,8 +743,7 @@ and do not match the transaction."))))))))
                   (gncTransGetGUID (xaccSplitGetParent s)))
                  pmt-list))))))
 
-    (define (overpayment-list payment-info)
-      (define overpayment (payment-info-overpayment payment-info))
+    (define (overpayment-list overpayment)
       (if (zero? overpayment)
           '()
           (list (make-link-desc-amount
@@ -763,9 +755,9 @@ and do not match the transaction."))))))))
                  (gncTransGetGUID txn)))))
 
     (let* ((payment-info (payment-txn->payment-info txn))
-           (invoices-result (invoices-list payment-info))
-           (payment-result (payments-list payment-info))
-           (overpayment-result (overpayment-list payment-info)))
+           (invoices-result (invoices-list (vector-ref payment-info 0)))
+           (payment-result (payments-list (vector-ref payment-info 1)))
+           (overpayment-result (overpayment-list (vector-ref payment-info 2))))
       (append invoices-result payment-result overpayment-result)))
 
   (define (amount->anchor split amount)

commit 07bdfe6e94161d6b25d8edfbe350c6a70ebb0b6b
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jul 8 20:36:53 2021 +0800

    [new-owner-report] refine payment->payment linked details
    
    refactor - overpayment calculation derived from payment txn and does
    not require LHS amount.

diff --git a/gnucash/report/reports/standard/new-owner-report.scm b/gnucash/report/reports/standard/new-owner-report.scm
index 6f508f40e..9e98dabd8 100644
--- a/gnucash/report/reports/standard/new-owner-report.scm
+++ b/gnucash/report/reports/standard/new-owner-report.scm
@@ -705,14 +705,13 @@ and do not match the transaction."))))))))
           (invoice->anchor (car inv-split-pair)))
         (payment-info-invoices (payment-txn->payment-info txn)))))))
 
-  (define (make-payment->payee-table txn lhs-amount payable?)
+  (define (make-payment->payee-table txn payable?)
 
-    (define (invoices-list payment-info lhs-amount)
+    (define (invoices-list payment-info)
       (let lp ((invoice-split-pairs (payment-info-invoices payment-info))
-               (result '())
-               (lhs-amount lhs-amount))
+               (result '()))
         (match invoice-split-pairs
-          (() (cons lhs-amount result))
+          (() (reverse result))
           (((inv . APAR-split) . rest)
            (let* ((posting-split (lot-split->posting-split APAR-split)))
              (lp rest
@@ -724,26 +723,15 @@ and do not match the transaction."))))))))
                         (gnc:make-html-text (split->anchor APAR-split #t))
                         (gnc:make-html-text (split->anchor posting-split #f))
                         (gncInvoiceReturnGUID inv))
-                       result)
-                 (- lhs-amount (xaccSplitGetAmount APAR-split))))))))
+                       result)))))))
 
-    (define (payments-list payment-info invoices-list-result)
+    (define (payments-list payment-info)
       (let lp1 ((opposing-splits (payment-info-opposing-splits payment-info))
-                (pmt-list (cdr invoices-list-result)))
+                (pmt-list '()))
         (match opposing-splits
-          (() (reverse
-               (if (zero? (payment-info-overpayment payment-info))
-                   pmt-list
-                   (cons (make-link-desc-amount
-                          (G_ "Pre-Payment")
-                          (gnc:make-html-text
-                           (gnc:monetary->string
-                            (gnc:make-gnc-monetary
-                             currency ((if payable? + -) (payment-info-overpayment payment-info)))))
-                          (gncTransGetGUID txn))
-                         pmt-list))))
-          (((s partial-amount paid?). rest)
-           (unless paid?
+          (() (reverse pmt-list))
+          (((s partial-amount derived?). rest)
+           (when derived?
              (set! add-derived-amounts-disclaimer? #t))
            (lp1 rest
                 (cons
@@ -753,7 +741,7 @@ and do not match the transaction."))))))))
                   (split->type-str s payable?)
                   (splits->desc (list s))
                   (gnc:make-html-text
-                   (if paid? "" "* ")
+                   (if derived? "* " "")
                    (gnc:html-markup-anchor
                     (gnc:split-anchor-text s)
                     (gnc:monetary->string
@@ -762,9 +750,23 @@ and do not match the transaction."))))))))
                   (gncTransGetGUID (xaccSplitGetParent s)))
                  pmt-list))))))
 
+    (define (overpayment-list payment-info)
+      (define overpayment (payment-info-overpayment payment-info))
+      (if (zero? overpayment)
+          '()
+          (list (make-link-desc-amount
+                 (G_ "Pre-Payment")
+                 (gnc:make-html-text
+                  (gnc:monetary->string
+                   (gnc:make-gnc-monetary
+                    currency ((if payable? + -) overpayment))))
+                 (gncTransGetGUID txn)))))
+
     (let* ((payment-info (payment-txn->payment-info txn))
-           (invoices-list-result (invoices-list payment-info lhs-amount)))
-      (payments-list payment-info invoices-list-result)))
+           (invoices-result (invoices-list payment-info))
+           (payment-result (payments-list payment-info))
+           (overpayment-result (overpayment-list payment-info)))
+      (append invoices-result payment-result overpayment-result)))
 
   (define (amount->anchor split amount)
     (gnc:make-html-text
@@ -898,7 +900,7 @@ and do not match the transaction."))))))))
          link-option
          (case link-option
            ((simple) (make-payment->invoices-list txn))
-           ((detailed) (make-payment->payee-table txn orig-value payable?))
+           ((detailed) (make-payment->payee-table txn payable?))
            (else '(()))))
 
         (lp printed? (not odd-row?) (cdr amt/next-pair) invalid-splits (+ total value)

commit 17e1ea46813567dc92d86e33ff9f7303e19fd552
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Thu Jul 8 18:55:57 2021 +0800

    [new-owner-report] move overpayment calculation into make-payment-info
    
    overpayment calculation needs to be moved during payment txn
    processing because the latter will be moved to report-utilities.scm
    module

diff --git a/gnucash/report/reports/standard/new-owner-report.scm b/gnucash/report/reports/standard/new-owner-report.scm
index 483b636bb..6f508f40e 100644
--- a/gnucash/report/reports/standard/new-owner-report.scm
+++ b/gnucash/report/reports/standard/new-owner-report.scm
@@ -131,10 +131,11 @@
   link-blank?)
 
 (define-record-type :payment-info
-  (make-payment-info invoices opposing-splits)
+  (make-payment-info invoices opposing-splits overpayment)
   payment-info?
   (invoices payment-info-invoices)
-  (opposing-splits payment-info-opposing-splits))
+  (opposing-splits payment-info-opposing-splits)
+  (overpayment payment-info-overpayment))
 
 ;; Names in Option panel (Untranslated! Because it is used for option
 ;; naming and lookup only, and the display of the option name will be
@@ -649,28 +650,49 @@ and do not match the transaction."))))))))
                      result))))))))))
 
 
+  (define (not-APAR? s)
+    (not (xaccAccountIsAPARType (xaccAccountGetType (xaccSplitGetAccount s)))))
 
   (define (payment-txn->payment-info txn)
-    (let lp ((splits (xaccTransGetAPARAcctSplitList txn #f))
+    (let lp ((splits (xaccTransGetSplitList txn))
              (invoices '())
+             (overpayment 0)
              (opposing-splits '()))
       (match splits
-        (() (make-payment-info invoices opposing-splits))
+        (() (make-payment-info invoices opposing-splits overpayment))
+        (((? not-APAR? split) . rest)
+         (lp rest invoices (+ overpayment (xaccSplitGetAmount split))
+             opposing-splits))
         ((split . rest)
          (let ((lot (xaccSplitGetLot split)))
            (define (equal-to-split? s) (equal? s split))
            (match (gncInvoiceGetInvoiceFromLot lot)
              (() (let lp1 ((lot-splits (gnc-lot-get-split-list lot))
+                           (overpayment overpayment)
                            (opposing-splits opposing-splits))
                    (match lot-splits
-                     (() (lp rest
-                             invoices
-                             opposing-splits))
-                     (((? equal-to-split?) . tail) (lp1 tail opposing-splits))
-                     ((head . tail) (lp1 tail (cons head opposing-splits))))))
+                     (() (lp rest invoices overpayment opposing-splits))
+                     (((? equal-to-split?) . tail)
+                      (lp1 tail overpayment opposing-splits))
+                     ((s . tail)
+                      (let* ((s-lot (xaccSplitGetLot s))
+                             (sum
+                              (fold
+                               (lambda (a b)
+                                 (if (equal? s a) b (+ b (xaccSplitGetAmount a))))
+                               0 (gnc-lot-get-split-list s-lot)))
+                             (lot-bal (gnc-lot-get-balance s-lot))
+                             (lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s))
+                                          0 lot-bal))
+                             (partial-amount (- sum lot-bal))
+                             (derived? (not (zero? lot-bal))))
+                        (lp1 tail (+ overpayment partial-amount)
+                             (cons (list s partial-amount derived?)
+                                   opposing-splits)))))))
              (inv
               (lp rest
                   (cons (cons inv split) invoices)
+                  (+ overpayment (xaccSplitGetAmount split))
                   opposing-splits))))))))
 
   (define (make-payment->invoices-list txn)
@@ -707,49 +729,38 @@ and do not match the transaction."))))))))
 
     (define (payments-list payment-info invoices-list-result)
       (let lp1 ((opposing-splits (payment-info-opposing-splits payment-info))
-                (overpayment (car invoices-list-result))
                 (pmt-list (cdr invoices-list-result)))
         (match opposing-splits
           (() (reverse
-               (if (zero? overpayment)
+               (if (zero? (payment-info-overpayment payment-info))
                    pmt-list
                    (cons (make-link-desc-amount
                           (G_ "Pre-Payment")
                           (gnc:make-html-text
                            (gnc:monetary->string
                             (gnc:make-gnc-monetary
-                             currency ((if payable? - +) overpayment))))
+                             currency ((if payable? + -) (payment-info-overpayment payment-info)))))
                           (gncTransGetGUID txn))
                          pmt-list))))
-          ((s . rest)
-           (let* ((lot (xaccSplitGetLot s))
-                  (sum
-                   (fold
-                    (lambda (a b) (if (equal? s a) b (+ b (xaccSplitGetAmount a))))
-                    0 (gnc-lot-get-split-list lot)))
-                  (lot-bal (gnc-lot-get-balance lot))
-                  (lot-bal (if (sign-equal? lot-bal (xaccSplitGetAmount s)) 0 lot-bal))
-                  (partial-amount (- sum lot-bal))
-                  (paid? (zero? lot-bal)))
-             (unless paid?
-               (set! add-derived-amounts-disclaimer? #t))
-             (lp1 rest
-                  (- overpayment partial-amount)
-                  (cons
-                   (make-link-data
-                    (qof-print-date (xaccTransGetDate (xaccSplitGetParent s)))
-                    (split->reference s)
-                    (split->type-str s payable?)
-                    (splits->desc (list s))
-                    (gnc:make-html-text
-                     (if paid? "" "* ")
-                     (gnc:html-markup-anchor
-                      (gnc:split-anchor-text s)
-                      (gnc:monetary->string
-                       (gnc:make-gnc-monetary currency partial-amount))))
-                    (gnc:make-html-text (split->anchor s #f))
-                    (gncTransGetGUID (xaccSplitGetParent s)))
-                   pmt-list)))))))
+          (((s partial-amount paid?). rest)
+           (unless paid?
+             (set! add-derived-amounts-disclaimer? #t))
+           (lp1 rest
+                (cons
+                 (make-link-data
+                  (qof-print-date (xaccTransGetDate (xaccSplitGetParent s)))
+                  (split->reference s)
+                  (split->type-str s payable?)
+                  (splits->desc (list s))
+                  (gnc:make-html-text
+                   (if paid? "" "* ")
+                   (gnc:html-markup-anchor
+                    (gnc:split-anchor-text s)
+                    (gnc:monetary->string
+                     (gnc:make-gnc-monetary currency partial-amount))))
+                  (gnc:make-html-text (split->anchor s #f))
+                  (gncTransGetGUID (xaccSplitGetParent s)))
+                 pmt-list))))))
 
     (let* ((payment-info (payment-txn->payment-info txn))
            (invoices-list-result (invoices-list payment-info lhs-amount)))



Summary of changes:
 gnucash/report/report-utilities.scm                |  69 +++++++++--
 .../report/reports/standard/new-owner-report.scm   | 137 ++++++++-------------
 2 files changed, 106 insertions(+), 100 deletions(-)



More information about the gnucash-changes mailing list