[new-owner-report] compact code

* reuse split->anchor for RHS splits
* use invoice->anchor for invoice anchor
This commit is contained in:
Christopher Lam 2020-01-25 00:29:50 +08:00
parent 4839a56367
commit a9be5d406f

View File

@ -251,6 +251,11 @@
(define (split-is-payment? split) (define (split-is-payment? split)
(txn-is-payment? (xaccSplitGetParent split))) (txn-is-payment? (xaccSplitGetParent split)))
(define (invoice->anchor inv)
(gnc:html-markup-anchor
(gnc:invoice-anchor-text inv)
(gncInvoiceGetID inv)))
(define (split->reference split) (define (split->reference split)
(let* ((txn (xaccSplitGetParent split)) (let* ((txn (xaccSplitGetParent split))
(type (xaccTransGetTxnType txn))) (type (xaccTransGetTxnType txn)))
@ -262,10 +267,7 @@
(gnc:split-anchor-text split) ref)))) (gnc:split-anchor-text split) ref))))
((eqv? type TXN-TYPE-INVOICE) ((eqv? type TXN-TYPE-INVOICE)
(let ((inv (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot split)))) (let ((inv (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot split))))
(gnc:make-html-text (gnc:make-html-text (invoice->anchor inv)))))))
(gnc:html-markup-anchor
(gnc:invoice-anchor-text inv)
(gncInvoiceGetID inv))))))))
(define (split->type-str split) (define (split->type-str split)
(let* ((txn (xaccSplitGetParent split)) (let* ((txn (xaccSplitGetParent split))
@ -434,6 +436,15 @@
link-option)) link-option))
(define mid-span (define mid-span
(if (eq? link-option 'detailed) (num-cols used-columns 'mid-spac) 0)) (if (eq? link-option 'detailed) (num-cols used-columns 'mid-spac) 0))
(define (split->anchor split negate?)
(gnc:html-markup-anchor
(gnc:split-anchor-text split)
(gnc:make-gnc-monetary
(xaccAccountGetCommodity (xaccSplitGetAccount split))
((if negate? - +)
(AP-negate (xaccSplitGetAmount split))))))
(define (print-totals total debit credit tax sale) (define (print-totals total debit credit tax sale)
(define (total-cell cell) (define (total-cell cell)
(gnc:make-html-table-cell/markup "total-number-cell" cell)) (gnc:make-html-table-cell/markup "total-number-cell" cell))
@ -535,13 +546,6 @@
(cons (let* ((lot-split (car lot-splits)) (cons (let* ((lot-split (car lot-splits))
(lot-txn (xaccSplitGetParent lot-split)) (lot-txn (xaccSplitGetParent lot-split))
(pmt-splits (xaccTransGetPaymentAcctSplitList lot-txn))) (pmt-splits (xaccTransGetPaymentAcctSplitList lot-txn)))
(define (split->anchor split negate?)
(gnc:html-markup-anchor
(gnc:split-anchor-text split)
(gnc:make-gnc-monetary
(xaccAccountGetCommodity (xaccSplitGetAccount split))
((if negate? - +)
(AP-negate (xaccSplitGetAmount split))))))
(make-link-data (make-link-data
(qof-print-date (xaccTransGetDate lot-txn)) (qof-print-date (xaccTransGetDate lot-txn))
(split->reference lot-split) (split->reference lot-split)
@ -598,16 +602,9 @@
(match splits (match splits
(() (cons (AP-negate overpayment) invoices)) (() (cons (AP-negate overpayment) invoices))
((split . rest) ((split . rest)
(let ((invoice (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot split)))) (match (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot split))
(if (null? invoice) (() (lp rest (- overpayment (xaccSplitGetAmount split)) invoices))
(lp rest (invoice (lp rest overpayment (cons (cons invoice split) invoices))))))))
(- overpayment (xaccSplitGetAmount split))
invoices)
(lp rest
overpayment
(if (member invoice invoices)
invoices
(cons (cons invoice split) invoices)))))))))
(define (make-payment->invoices-list txn) (define (make-payment->invoices-list txn)
(list (list
@ -616,10 +613,7 @@
gnc:make-html-text gnc:make-html-text
(map (map
(lambda (inv-split-pair) (lambda (inv-split-pair)
(let ((inv (car inv-split-pair))) (invoice->anchor (car inv-split-pair)))
(gnc:html-markup-anchor
(gnc:invoice-anchor-text inv)
(gncInvoiceGetID inv))))
(cdr (payment-txn->overpayment-and-invoices txn))))))) (cdr (payment-txn->overpayment-and-invoices txn)))))))
(define (make-payment->invoices-table txn) (define (make-payment->invoices-table txn)
@ -637,26 +631,15 @@
(gnc:make-gnc-monetary currency overpayment)) (gnc:make-gnc-monetary currency overpayment))
result))))) result)))))
(((inv . APAR-split) . rest) (((inv . APAR-split) . rest)
(let* ((tfr-txn (gncInvoiceGetPostedTxn inv))) (let* ((posting-split (lot-split->posting-split APAR-split)))
(lp rest (lp rest
(cons (make-link-data (cons (make-link-data
(qof-print-date (gncInvoiceGetDatePosted inv)) (qof-print-date (gncInvoiceGetDatePosted inv))
(gnc:make-html-text (gnc:make-html-text (invoice->anchor inv))
(gnc:html-markup-anchor
(gnc:invoice-anchor-text inv)
(gncInvoiceGetID inv)))
(gncInvoiceGetTypeString inv) (gncInvoiceGetTypeString inv)
(splits->desc (list APAR-split)) (splits->desc (list APAR-split))
(gnc:make-html-text (gnc:make-html-text (split->anchor APAR-split #t))
(gnc:html-markup-anchor (gnc:make-html-text (split->anchor posting-split #f)))
(gnc:split-anchor-text APAR-split)
(gnc:make-gnc-monetary
currency (AP-negate (- (xaccSplitGetAmount APAR-split))))))
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:split-anchor-text (lot-split->posting-split APAR-split))
(gnc:make-gnc-monetary
currency (invoice->total inv)))))
result))))))) result)))))))
(define (invoice->sale invoice) (define (invoice->sale invoice)