gnucash stable: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sat Dec 30 08:38:39 EST 2023
Updated via https://github.com/Gnucash/gnucash/commit/4380f1b8 (commit)
via https://github.com/Gnucash/gnucash/commit/56e2425e (commit)
from https://github.com/Gnucash/gnucash/commit/5591660f (commit)
commit 4380f1b85abbeac4724c6a322fc3252eb6e5d531
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Dec 30 21:20:13 2023 +0800
[trep-engine] accumulate subtotals within add-split-row
it's cleaner; add-split-row won't need to return a monetary to be
processed later.
diff --git a/gnucash/report/trep-engine.scm b/gnucash/report/trep-engine.scm
index d2da97cc78..96d9c017f3 100644
--- a/gnucash/report/trep-engine.scm
+++ b/gnucash/report/trep-engine.scm
@@ -1802,6 +1802,15 @@ be excluded from periodic reporting.")
(define (render-grand-total)
(G_ "Grand Total"))
+ (define primary-subtotal-collectors
+ (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
+
+ (define secondary-subtotal-collectors
+ (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
+
+ (define total-collectors
+ (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
+
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; add-split-row
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1841,10 +1850,21 @@ be excluded from periodic reporting.")
cell-content)))))
cell-calculators))))
- (map (lambda (cell)
- (and (assq-ref cell 'subtotal?)
- ((assq-ref cell 'calc-fn) split transaction-row?)))
- cell-calculators)))
+ (when transaction-row?
+ (for-each
+ (lambda (prime-collector sec-collector tot-collector cell)
+ (when (assq-ref cell 'subtotal?)
+ (let ((value ((assq-ref cell 'calc-fn) split transaction-row?)))
+ (when value
+ (let ((comm (gnc:gnc-monetary-commodity value))
+ (amt (gnc:gnc-monetary-amount value)))
+ (prime-collector 'add comm amt)
+ (sec-collector 'add comm amt)
+ (tot-collector 'add comm amt))))))
+ primary-subtotal-collectors
+ secondary-subtotal-collectors
+ total-collectors
+ cell-calculators))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1852,15 +1872,6 @@ be excluded from periodic reporting.")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (define primary-subtotal-collectors
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
-
- (define secondary-subtotal-collectors
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
-
- (define total-collectors
- (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells))
-
(define grid (make-grid))
(define primary-subtotal-comparator (report-uses? 'primary-key/split-sortvalue))
(define secondary-subtotal-comparator (report-uses? 'secondary-key/split-sortvalue))
@@ -1901,14 +1912,13 @@ be excluded from periodic reporting.")
(let* ((current (car splits))
(rest (cdr splits))
- (next (and (pair? rest) (car rest)))
- (split-values (add-split-row
- current
- calculated-cells
- (if (or odd-row? (report-uses? 'multiline))
- def:normal-row-style
- def:alternate-row-style)
- #t)))
+ (next (and (pair? rest) (car rest))))
+
+ (add-split-row current calculated-cells
+ (if (or odd-row? (report-uses? 'multiline))
+ def:normal-row-style
+ def:alternate-row-style)
+ #t)
(when (report-uses? 'multiline)
(for-each
@@ -1918,19 +1928,6 @@ be excluded from periodic reporting.")
(delete current (xaccTransGetSplitList
(xaccSplitGetParent current)))))
- (for-each
- (lambda (prime-collector sec-collector tot-collector value)
- (when (gnc:gnc-monetary? value)
- (let ((comm (gnc:gnc-monetary-commodity value))
- (val (gnc:gnc-monetary-amount value)))
- (prime-collector 'add comm val)
- (sec-collector 'add comm val)
- (tot-collector 'add comm val))))
- primary-subtotal-collectors
- secondary-subtotal-collectors
- total-collectors
- split-values)
-
(cond
((and primary-subtotal-comparator
(or (not next)
commit 56e2425eb5160378b80eeca238d111ddaa00ff20
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Dec 30 20:36:44 2023 +0800
[invoice.scm] reorder defines to allow compilation
Interestingly this doesn't seem to be consistently required.
diff --git a/gnucash/report/reports/standard/invoice.scm b/gnucash/report/reports/standard/invoice.scm
index 13fe92d997..6036b89112 100644
--- a/gnucash/report/reports/standard/invoice.scm
+++ b/gnucash/report/reports/standard/invoice.scm
@@ -107,6 +107,210 @@
(string-append (gnc:default-html-gnc-numeric-renderer numeric #f) " " (G_ "%"))
(gnc:make-gnc-monetary currency numeric)))
+
+(define (make-client-table options)
+
+ (define (get-orders invoice)
+ (fold
+ (lambda (a b)
+ (let ((order (gncEntryGetOrder a)))
+ (if (member order b) b (cons order b))))
+ '() (gncInvoiceGetEntries invoice)))
+
+ (define (opt-val section name)
+ (gnc-optiondb-lookup-value options section name))
+
+ ;; this is a single-column table.
+ (let* ((invoice (opt-val gnc:pagename-general gnc:optname-invoice-number))
+ (owner (gncInvoiceGetOwner invoice))
+ (references? (opt-val "Display" "References"))
+ (orders (if references? (get-orders invoice) '()))
+ (table (gnc:make-html-table)))
+
+ (gnc:html-table-append-row! table
+ (list
+ (gnc:make-html-div/markup
+ "maybe-align-right client-name"
+ (gnc:owner-get-name-dep owner))))
+
+ (gnc:html-table-append-row! table
+ (list
+ (gnc:make-html-div/markup
+ "maybe-align-right client-address"
+ (multiline-to-html-text
+ (gnc:owner-get-address-dep owner)))))
+
+ (if (opt-val "Display" "Invoice owner ID")
+ (gnc:html-table-append-row! table
+ (list
+ (gnc:make-html-div/markup
+ "maybe-align-right client-id"
+ (multiline-to-html-text
+ (gnc:owner-get-owner-id owner))))))
+
+ (for-each
+ (lambda (order)
+ (let ((reference (gncOrderGetReference order)))
+ (if (and reference (not (string-null? reference)))
+ (gnc:html-table-append-row! table
+ (list (string-append
+ (G_ "REF") " "
+ reference))))))
+ orders)
+
+ (gnc:make-html-div/markup "client-table" table)))
+
+(define (make-company-table options)
+
+ (define (opt-val section name)
+ (gnc-optiondb-lookup-value options section name))
+
+ ;; single-column table. my name, address, and printdate
+ (let* ((table (gnc:make-html-table))
+ (book (gncInvoiceGetBook (opt-val gnc:pagename-general gnc:optname-invoice-number)))
+ (name (gnc:company-info book gnc:*company-name*))
+ (addy (gnc:company-info book gnc:*company-addy*))
+ (phone (gnc:company-info book gnc:*company-phone*))
+ (fax (gnc:company-info book gnc:*company-fax*))
+ (email (gnc:company-info book gnc:*company-email*))
+ (url (gnc:company-info book gnc:*company-url*))
+ (taxnr (gnc:book-get-option-value book gnc:*tax-label* gnc:*tax-nr-label*))
+ (taxid (gnc:company-info book gnc:*company-id*)))
+
+ (if (and name (not (string-null? name)))
+ (gnc:html-table-append-row! table (list
+ (gnc:make-html-div/markup
+ "maybe-align-right company-name" name))))
+
+ (if (and addy (not (string-null? addy)))
+ (gnc:html-table-append-row! table (list
+ (gnc:make-html-div/markup
+ "maybe-align-right company-address" (multiline-to-html-text addy)))))
+
+ (if (and phone (not (string-null? phone)))
+ (gnc:html-table-append-row! table (list
+ (gnc:make-html-div/markup
+ "maybe-align-right company-phone" phone))))
+
+ (if (and fax (not (string-null? fax)))
+ (gnc:html-table-append-row! table (list
+ (gnc:make-html-div/markup
+ "maybe-align-right company-fax" fax))))
+
+ (if (and email (not (string-null? email)))
+ (gnc:html-table-append-row! table (list
+ (gnc:make-html-div/markup
+ "maybe-align-right company-email" email))))
+
+ (if (and url (not (string-null? url)))
+ (gnc:html-table-append-row! table (list
+ (gnc:make-html-div/markup
+ "maybe-align-right company-url" url))))
+
+ (if (and taxid (not (string-null? taxid)))
+ (gnc:html-table-append-row! table (list
+ (gnc:make-html-div/markup
+ "maybe-align-right company-tax-id" taxid))))
+
+ (if (and taxnr (not (string-null? taxnr)))
+ (gnc:html-table-append-row!
+ table (list (gnc:make-html-div/markup
+ "maybe-align-right company-tax-nr" taxnr))))
+
+ (gnc:make-html-div/markup "company-table" table)))
+
+
+(define (make-date-row label date date-format)
+ (list
+ (string-append label ":")
+ (gnc:make-html-div/markup
+ "div-align-right"
+ (gnc-print-time64 date date-format))))
+
+(define (make-invoice-details-table options)
+ ;; dual-column. invoice date/due, billingID, terms, job name/number
+ (define (opt-val section name)
+ (gnc-optiondb-lookup-value options section name))
+ (let* ((invoice-details-table (gnc:make-html-table))
+ (invoice (opt-val gnc:pagename-general gnc:optname-invoice-number))
+ (book (gncInvoiceGetBook invoice))
+ (date-format (gnc:options-fancy-date book))
+ (jobnumber (gncJobGetID (gncOwnerGetJob (gncInvoiceGetOwner invoice))))
+ (jobname (gncJobGetName (gncOwnerGetJob (gncInvoiceGetOwner invoice)))))
+
+ (if (gncInvoiceIsPosted invoice)
+
+ (begin
+ (gnc:html-table-append-row!
+ invoice-details-table
+ (make-date-row (G_ "Date") (gncInvoiceGetDatePosted invoice) date-format))
+
+ (if (opt-val "Display" "Due Date")
+ (gnc:html-table-append-row!
+ invoice-details-table
+ (make-date-row (G_ "Due Date") (gncInvoiceGetDateDue invoice) date-format))))
+
+ (gnc:html-table-append-row! invoice-details-table
+ (gnc:make-html-table-cell/size
+ 1 2 (gnc:make-html-span/markup
+ "invoice-in-progress"
+ (gnc:make-html-text
+ (G_ "Invoice in progress…"))))))
+
+ (if (opt-val "Display" "Billing ID")
+ (let ((billing-id (gncInvoiceGetBillingID invoice)))
+ (if (and billing-id (not (string-null? billing-id)))
+ (begin
+ (gnc:html-table-append-row! invoice-details-table
+ (list
+ (G_ "Reference:")
+ (gnc:make-html-div/markup
+ "div-align-right"
+ (multiline-to-html-text billing-id))))
+ (gnc:html-table-append-row! invoice-details-table '())))))
+
+ (if (opt-val "Display" "Billing Terms")
+ (let* ((term (gncInvoiceGetTerms invoice))
+ (terms (gncBillTermGetDescription term)))
+ (if (and terms (not (string-null? terms)))
+ (gnc:html-table-append-row! invoice-details-table
+ (list
+ (G_ "Terms:")
+ (gnc:make-html-div/markup
+ "div-align-right"
+ (multiline-to-html-text terms)))))))
+
+ ;; Add job number and name to invoice if requested and if it exists
+ (if (and (opt-val "Display" "Job Details")
+ (not (string-null? jobnumber)))
+ (begin
+ (gnc:html-table-append-row! invoice-details-table
+ (list (G_ "Job number:")
+ (gnc:make-html-div/markup
+ "div-align-right"
+ jobnumber)))
+ (gnc:html-table-append-row! invoice-details-table
+ (list (G_ "Job name:")
+ (gnc:make-html-div/markup
+ "div-align-right"
+ jobname)))))
+
+ (gnc:make-html-div/markup "invoice-details-table" invoice-details-table)))
+
+(define (make-picture options)
+ (define (opt-val section name)
+ (gnc-optiondb-lookup-value options section name))
+ (let ((img-url (opt-val "Layout" "Picture Location")))
+ (gnc:make-html-div/markup
+ "picture"
+ (gnc:make-html-text
+ (gnc:html-markup-img
+ (make-file-url img-url))))))
+
+(define (make-today options)
+ (gnc:make-html-div/markup
+ "invoice-print-date" (qof-print-date (current-time))))
+
(define layout-key-list
(list (list 'client
(cons 'renderer make-client-table)
@@ -545,207 +749,6 @@ for styling the invoice. Please see the exported report for the CSS class names.
table)))
-(define (make-invoice-details-table options)
- ;; dual-column. invoice date/due, billingID, terms, job name/number
- (define (opt-val section name)
- (gnc-optiondb-lookup-value options section name))
- (let* ((invoice-details-table (gnc:make-html-table))
- (invoice (opt-val gnc:pagename-general gnc:optname-invoice-number))
- (book (gncInvoiceGetBook invoice))
- (date-format (gnc:options-fancy-date book))
- (jobnumber (gncJobGetID (gncOwnerGetJob (gncInvoiceGetOwner invoice))))
- (jobname (gncJobGetName (gncOwnerGetJob (gncInvoiceGetOwner invoice)))))
-
- (if (gncInvoiceIsPosted invoice)
-
- (begin
- (gnc:html-table-append-row!
- invoice-details-table
- (make-date-row (G_ "Date") (gncInvoiceGetDatePosted invoice) date-format))
-
- (if (opt-val "Display" "Due Date")
- (gnc:html-table-append-row!
- invoice-details-table
- (make-date-row (G_ "Due Date") (gncInvoiceGetDateDue invoice) date-format))))
-
- (gnc:html-table-append-row! invoice-details-table
- (gnc:make-html-table-cell/size
- 1 2 (gnc:make-html-span/markup
- "invoice-in-progress"
- (gnc:make-html-text
- (G_ "Invoice in progress…"))))))
-
- (if (opt-val "Display" "Billing ID")
- (let ((billing-id (gncInvoiceGetBillingID invoice)))
- (if (and billing-id (not (string-null? billing-id)))
- (begin
- (gnc:html-table-append-row! invoice-details-table
- (list
- (G_ "Reference:")
- (gnc:make-html-div/markup
- "div-align-right"
- (multiline-to-html-text billing-id))))
- (gnc:html-table-append-row! invoice-details-table '())))))
-
- (if (opt-val "Display" "Billing Terms")
- (let* ((term (gncInvoiceGetTerms invoice))
- (terms (gncBillTermGetDescription term)))
- (if (and terms (not (string-null? terms)))
- (gnc:html-table-append-row! invoice-details-table
- (list
- (G_ "Terms:")
- (gnc:make-html-div/markup
- "div-align-right"
- (multiline-to-html-text terms)))))))
-
- ;; Add job number and name to invoice if requested and if it exists
- (if (and (opt-val "Display" "Job Details")
- (not (string-null? jobnumber)))
- (begin
- (gnc:html-table-append-row! invoice-details-table
- (list (G_ "Job number:")
- (gnc:make-html-div/markup
- "div-align-right"
- jobnumber)))
- (gnc:html-table-append-row! invoice-details-table
- (list (G_ "Job name:")
- (gnc:make-html-div/markup
- "div-align-right"
- jobname)))))
-
- (gnc:make-html-div/markup "invoice-details-table" invoice-details-table)))
-
-(define (make-picture options)
- (define (opt-val section name)
- (gnc-optiondb-lookup-value options section name))
- (let ((img-url (opt-val "Layout" "Picture Location")))
- (gnc:make-html-div/markup
- "picture"
- (gnc:make-html-text
- (gnc:html-markup-img
- (make-file-url img-url))))))
-
-(define (make-client-table options)
-
- (define (get-orders invoice)
- (fold
- (lambda (a b)
- (let ((order (gncEntryGetOrder a)))
- (if (member order b) b (cons order b))))
- '() (gncInvoiceGetEntries invoice)))
-
- (define (opt-val section name)
- (gnc-optiondb-lookup-value options section name))
-
- ;; this is a single-column table.
- (let* ((invoice (opt-val gnc:pagename-general gnc:optname-invoice-number))
- (owner (gncInvoiceGetOwner invoice))
- (references? (opt-val "Display" "References"))
- (orders (if references? (get-orders invoice) '()))
- (table (gnc:make-html-table)))
-
- (gnc:html-table-append-row! table
- (list
- (gnc:make-html-div/markup
- "maybe-align-right client-name"
- (gnc:owner-get-name-dep owner))))
-
- (gnc:html-table-append-row! table
- (list
- (gnc:make-html-div/markup
- "maybe-align-right client-address"
- (multiline-to-html-text
- (gnc:owner-get-address-dep owner)))))
-
- (if (opt-val "Display" "Invoice owner ID")
- (gnc:html-table-append-row! table
- (list
- (gnc:make-html-div/markup
- "maybe-align-right client-id"
- (multiline-to-html-text
- (gnc:owner-get-owner-id owner))))))
-
- (for-each
- (lambda (order)
- (let ((reference (gncOrderGetReference order)))
- (if (and reference (not (string-null? reference)))
- (gnc:html-table-append-row! table
- (list (string-append
- (G_ "REF") " "
- reference))))))
- orders)
-
- (gnc:make-html-div/markup "client-table" table)))
-
-(define (make-date-row label date date-format)
- (list
- (string-append label ":")
- (gnc:make-html-div/markup
- "div-align-right"
- (gnc-print-time64 date date-format))))
-
-(define (make-company-table options)
-
- (define (opt-val section name)
- (gnc-optiondb-lookup-value options section name))
-
- ;; single-column table. my name, address, and printdate
- (let* ((table (gnc:make-html-table))
- (book (gncInvoiceGetBook (opt-val gnc:pagename-general gnc:optname-invoice-number)))
- (name (gnc:company-info book gnc:*company-name*))
- (addy (gnc:company-info book gnc:*company-addy*))
- (phone (gnc:company-info book gnc:*company-phone*))
- (fax (gnc:company-info book gnc:*company-fax*))
- (email (gnc:company-info book gnc:*company-email*))
- (url (gnc:company-info book gnc:*company-url*))
- (taxnr (gnc:book-get-option-value book gnc:*tax-label* gnc:*tax-nr-label*))
- (taxid (gnc:company-info book gnc:*company-id*)))
-
- (if (and name (not (string-null? name)))
- (gnc:html-table-append-row! table (list
- (gnc:make-html-div/markup
- "maybe-align-right company-name" name))))
-
- (if (and addy (not (string-null? addy)))
- (gnc:html-table-append-row! table (list
- (gnc:make-html-div/markup
- "maybe-align-right company-address" (multiline-to-html-text addy)))))
-
- (if (and phone (not (string-null? phone)))
- (gnc:html-table-append-row! table (list
- (gnc:make-html-div/markup
- "maybe-align-right company-phone" phone))))
-
- (if (and fax (not (string-null? fax)))
- (gnc:html-table-append-row! table (list
- (gnc:make-html-div/markup
- "maybe-align-right company-fax" fax))))
-
- (if (and email (not (string-null? email)))
- (gnc:html-table-append-row! table (list
- (gnc:make-html-div/markup
- "maybe-align-right company-email" email))))
-
- (if (and url (not (string-null? url)))
- (gnc:html-table-append-row! table (list
- (gnc:make-html-div/markup
- "maybe-align-right company-url" url))))
-
- (if (and taxid (not (string-null? taxid)))
- (gnc:html-table-append-row! table (list
- (gnc:make-html-div/markup
- "maybe-align-right company-tax-id" taxid))))
-
- (if (and taxnr (not (string-null? taxnr)))
- (gnc:html-table-append-row!
- table (list (gnc:make-html-div/markup
- "maybe-align-right company-tax-nr" taxnr))))
-
- (gnc:make-html-div/markup "company-table" table)))
-
-(define (make-today options)
- (gnc:make-html-div/markup
- "invoice-print-date" (qof-print-date (current-time))))
(define (reg-renderer report-obj)
(let* ((document (gnc:make-html-document))
Summary of changes:
gnucash/report/reports/standard/invoice.scm | 405 ++++++++++++++--------------
gnucash/report/trep-engine.scm | 65 +++--
2 files changed, 235 insertions(+), 235 deletions(-)
More information about the gnucash-changes
mailing list