gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Mon Mar 25 05:39:45 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/d27b1658 (commit)
via https://github.com/Gnucash/gnucash/commit/b1571f25 (commit)
via https://github.com/Gnucash/gnucash/commit/50e96402 (commit)
via https://github.com/Gnucash/gnucash/commit/0b8ff4b5 (commit)
via https://github.com/Gnucash/gnucash/commit/4f634496 (commit)
via https://github.com/Gnucash/gnucash/commit/98811d7e (commit)
via https://github.com/Gnucash/gnucash/commit/07f44ad7 (commit)
via https://github.com/Gnucash/gnucash/commit/523837dd (commit)
via https://github.com/Gnucash/gnucash/commit/b47ab716 (commit)
via https://github.com/Gnucash/gnucash/commit/1d11ee21 (commit)
via https://github.com/Gnucash/gnucash/commit/bc553ed0 (commit)
via https://github.com/Gnucash/gnucash/commit/9b9d264a (commit)
via https://github.com/Gnucash/gnucash/commit/dedccd56 (commit)
from https://github.com/Gnucash/gnucash/commit/480d13ba (commit)
commit d27b1658791f5490dfbd37e3299a593a36ef39f1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Mar 25 07:32:12 2019 +0800
[report] deprecate legacy functions
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index eb5e360cb..6e300c28a 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -832,6 +832,8 @@ not found.")))
;; load a saved-reports file version 2.0
(define (gnc:report-template-new-options/name template-name)
+ (issue-deprecation-warning
+ "gnc:report-template-new-options/name is deprecated.")
(let ((templ #f))
(hash-for-each
(lambda (id rec)
@@ -842,6 +844,8 @@ not found.")))
(gnc:report-template-new-options templ))))
(define (gnc:report-template-menu-name/name template-name)
+ (issue-deprecation-warning
+ "gnc:report-template-menu-name/name is deprecated.")
(let ((templ #f))
(hash-for-each
(lambda (id rec)
@@ -853,6 +857,8 @@ not found.")))
(gnc:report-template-name templ)))))
(define (gnc:report-template-renderer/name template-name)
+ (issue-deprecation-warning
+ "gnc:report-template-renderer/name is deprecated.")
(let ((templ #f))
(hash-for-each
(lambda (id rec)
@@ -865,6 +871,8 @@ not found.")))
;; Used internally only to convert a report template name into a corresponding guid
;; Note that this may fail if several reports exist with the same name
(define (gnc:report-template-name-to-id template-name)
+ (issue-deprecation-warning
+ "gnc:report-template-name-to-id is deprecated.")
(let ((template-id #f))
(hash-for-each
(lambda (id rec)
@@ -878,6 +886,8 @@ not found.")))
(define gnc:restore-report
(let ((first-warn? #t))
(lambda (id template-name options)
+ (issue-deprecation-warning
+ "gnc:restore-report is deprecated.")
(cond
(options
(let* ((constructor (record-constructor <report>))
commit b1571f25480a73c684b749d4cb1df16a58b2914f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Mar 25 07:27:08 2019 +0800
[report] annotate and reindent
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 5b5030f9d..eb5e360cb 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -678,6 +678,7 @@ not found.")))
;; (ie a template that is stored in the savefile already)
;; 2. an overwrite is requestes by setting overwrite? to #t
(define (gnc:report-to-template report overwrite?)
+ ;; This implements the Save Report Configuration tasks
(let* ((custom-template-id (gnc:report-custom-template report))
(overwrite-ok? (and (gnc:report-template-is-custom/template-guid?
custom-template-id)
@@ -694,17 +695,20 @@ not found.")))
(begin
;; If it's ok to overwrite the old template, delete it now.
(if overwrite-ok?
- (let ((templ-name (gnc:report-template-name (hash-ref *gnc:_report-templates_* custom-template-id))))
+ (let ((templ-name
+ (gnc:report-template-name
+ (hash-ref *gnc:_report-templates_* custom-template-id))))
;; We're overwriting, which needs some additional steps
;; 1. Remove the newly generated template from the template list again
- (hash-remove! *gnc:_report-templates_* (gnc:report-template-report-guid save-result))
- ;; 2. We still have the template record available though, so adapt it to
- ;; the template we want to override (ie update guid and name)
+ (hash-remove! *gnc:_report-templates_*
+ (gnc:report-template-report-guid save-result))
+ ;; 2. We still have the template record available
+ ;; though, so adapt it to the template we want to
+ ;; override (ie update guid and name)
(gnc:report-template-set-report-guid! save-result custom-template-id)
(gnc:report-template-set-name save-result templ-name)
;; 3. Overwrite the template with the new one
- (hash-set! *gnc:_report-templates_* custom-template-id save-result)
- ))
+ (hash-set! *gnc:_report-templates_* custom-template-id save-result)))
;; Regardless of how we got here, we now have a new template to write
;; so let's write it
commit 50e9640243f74e577d9fe436e666ca94855b66e5
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Mar 24 23:48:24 2019 +0800
[report] simplify functions to use srfi-1, annotate
hash-map->list is simpler than hash-fold
All refactored functions are tested in test-report-system.scm
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 00968a1f6..5b5030f9d 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -461,37 +461,30 @@ not found.")))
;; Load and save helper functions
+;; list of all report guids in existence (includes standard & custom
+;; reports, but not instantiated ones)
(define (gnc:all-report-template-guids)
- (hash-fold
- (lambda (k v p)
- (cons k p))
- '() *gnc:_report-templates_*))
+ (map car (hash-map->list cons *gnc:_report-templates_*)))
;; return a list of the custom report template guids.
(define (gnc:custom-report-template-guids)
- (hash-fold
- (lambda (k v p)
- (if (gnc:report-template-parent-type v)
- (begin
- (gnc:debug "template " v)
- (cons k p))
- p))
- '() *gnc:_report-templates_*))
+ (map car (gnc:custom-report-templates-list)))
-(define (gnc:find-report-template report-type)
- (hash-ref *gnc:_report-templates_* report-type))
+(define (gnc:find-report-template guid)
+ (hash-ref *gnc:_report-templates_* guid))
(define (gnc:report-template-is-custom/template-guid? guid)
- (let* ((custom-template (and (string? guid)
- (not (string-null? guid))
- (hash-ref *gnc:_report-templates_* guid))))
- (and custom-template
- (gnc:report-template-parent-type custom-template)
- #t)))
+ (assoc guid (gnc:custom-report-templates-list)))
(define (gnc:is-custom-report-type report)
(gnc:report-template-is-custom/template-guid? (gnc:report-custom-template report)))
+;; list of reports saved within the saved-reports; returns a list of
+;; pairs whose cars = guid <string> and cdrs = report-template <record>
+(define (gnc:custom-report-templates-list)
+ (filter (compose gnc:report-template-parent-type cdr)
+ (hash-map->list cons *gnc:_report-templates_*)))
+
;; This function should be called right before changing a custom-template's name
;; to test if the new name is unique among the existting custom reports.
;; If not the calling function can prevent the name from being updated.
@@ -740,18 +733,14 @@ not found.")))
;; saved-reports file aside as a backup
;; return #t if all templates were saved successfully
(define (gnc:save-all-reports)
- (let ((save-ok? #t))
- (gnc-saved-reports-backup)
- (gnc-saved-reports-write-to-file "" #t)
- (hash-for-each
- (lambda (k v)
- (if (gnc:report-template-parent-type v)
- (begin
- (gnc:debug "saving report " k)
- (if (not (gnc:report-template-save-to-savefile v))
- (set! save-ok? #f)))))
- *gnc:_report-templates_*)
- save-ok?))
+ (gnc-saved-reports-backup)
+ (gnc-saved-reports-write-to-file "" #t)
+ (every identity
+ (map
+ (lambda (p)
+ (gnc:debug "saving report " (car p))
+ (gnc:report-template-save-to-savefile (cdr p)))
+ (gnc:custom-report-templates-list))))
;; gets the renderer from the report template;
commit 0b8ff4b5d64899414cb4e01a34279e9f3da34453
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Mar 24 22:05:00 2019 +0800
[options] deprecate gnc:save-options
this is unused.
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index 06d2861fa..a05a719fd 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -2030,6 +2030,8 @@ the option '~a'."))
options))
(define (gnc:save-options options options-string file header truncate?)
+ (issue-deprecation-warning
+ "gnc:save-options is deprecated.")
(let ((code (gnc:generate-restore-forms options options-string))
(port (false-if-exception
(if truncate?
commit 4f6344963d88b3b05fda121cf2f63013e7e5a5a4
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Mar 24 21:23:38 2019 +0800
[options] simplify gnc:value->string
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index bc0a99e8a..06d2861fa 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -209,9 +209,7 @@ the option '~a'."))
")))")))
(define (gnc:value->string value)
- (let ((result (call-with-output-string
- (lambda (port) (write value port)))))
- result))
+ (format #f "~s" value))
(define (gnc:make-string-option
section
commit 98811d7e71945c21d3455ed3e5caccb352b54b02
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Mar 23 13:07:34 2019 +0800
[customer-summary] rewrite string-expand
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 05c4c9b42..80df98c12 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -202,22 +202,15 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (string-expand string character replace-string)
- (define (car-line chars)
- (take-while (lambda (c) (not (eqv? c character))) chars))
- (define (cdr-line chars)
- (let ((rest (drop-while (lambda (c) (not (eqv? c character))) chars)))
- (if (null? rest)
- '()
- (cdr rest))))
- (define (line-helper chars)
- (if (null? chars)
- ""
- (let ((first (car-line chars))
- (rest (cdr-line chars)))
- (string-append (list->string first)
- (if (null? rest) "" replace-string)
- (line-helper rest)))))
- (line-helper (string->list string)))
+ (with-output-to-string
+ (lambda ()
+ (string-for-each
+ (lambda (c)
+ (display
+ (if (char=? c character)
+ replace-string
+ c)))
+ string))))
(define (query-toplevel-setup query account-list start-date end-date)
(xaccQueryAddAccountMatch query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
commit 07f44ad7c544ce12268fdcce27f2d4b3fcab184f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Mar 23 12:43:29 2019 +0800
[customer-summary] convert loop to srfi-1
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index b72765b13..05c4c9b42 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -305,26 +305,12 @@
(* 100 (gnc-numeric-div profit sales 1000 GNC-HOW-RND-ROUND))))
(define (query-split-value sub-query toplevel-query)
- (let ((splits (qof-query-run-subquery sub-query toplevel-query))
- (total (gnc-numeric-zero))
- )
- (for-each
- (lambda (split)
- (set! total (gnc-numeric-add-fixed total (xaccSplitGetValue split)))
- )
- splits) ;; END for-each splits
- total))
+ (let ((splits (qof-query-run-subquery sub-query toplevel-query)))
+ (apply + (map xaccSplitGetValue splits))))
(define (single-query-split-value query)
- (let ((splits (qof-query-run query))
- (total (gnc-numeric-zero))
- )
- (for-each
- (lambda (split)
- (set! total (gnc-numeric-add-fixed total (xaccSplitGetValue split)))
- )
- splits) ;; END for-each splits
- total))
+ (let ((splits (qof-query-run query)))
+ (apply + (map xaccSplitGetValue splits))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
commit 523837ddbe3847ded82cfdff8762b347aacfbfc3
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Mar 23 20:41:42 2019 +0800
[customer-summary] remove unused functions
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 4ab7f785d..b72765b13 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -50,13 +50,13 @@
(define optname-incomeaccounts (N_ "Income Accounts"))
(define opthelp-incomeaccounts
(N_ "The income accounts where the sales and income was recorded."))
-;(define optname-account-ar (N_ "A/R Account"))
+
;; The line break in the next expressions will suppress above comment as translator comments.
(define pagename-expenseaccounts
(N_ "Expense Accounts"))
(define optname-expenseaccounts (N_ "Expense Accounts"))
-;(define optname-account-ap (N_ "A/P Account"))
+
;; The line break in the next expressions will suppress above comment as translator comments.
(define opthelp-expenseaccounts
(N_ "The expense accounts where the expenses are recorded which are subtracted from the sales to give the profit."))
@@ -73,15 +73,6 @@
(define desc-header (N_ "Description"))
(define amount-header (N_ "Amount"))
-;;(define optname-invoicelines (N_ "Show Invoices"))
-;;(define opthelp-invoicelines (N_ "Show Invoice Transactions and include them in the balance."))
-
-;(define optname-paymentlines (N_ "(Experimental) Show Payments"))
-;(define opthelp-paymentlines (N_ "Show Payment Transactions and include them in the balance."))
-
-;(define optname-show-txn-table (N_ "(Experimental) Show Transaction Table"))
-;(define opthelp-show-txn-table (N_ "Show the table with all transactions. If false, only show the total amount per customer."))
-
;; The line break in the next expression will suppress above comments as translator comments.
(define optname-show-zero-lines
@@ -95,244 +86,6 @@
(define optname-sortascending (N_ "Sort Order"))
(define opthelp-sortascending (N_ "Choose the ordering of the column sort: Either ascending or descending."))
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (date-col columns-used)
- (vector-ref columns-used 0))
-(define (num-col columns-used)
- (vector-ref columns-used 2))
-(define (type-col columns-used)
- (vector-ref columns-used 3))
-(define (memo-col columns-used)
- (vector-ref columns-used 4))
-(define (value-col columns-used)
- (vector-ref columns-used 5))
-
-(define columns-used-size 6)
-
-(define (build-column-used options)
- (define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option options section name)))
- (define (make-set-col col-vector)
- (let ((col 0))
- (lambda (used? index)
- (if used?
- (begin
- (vector-set! col-vector index col)
- (set! col (+ col 1)))
- (vector-set! col-vector index #f)))))
-
- (let* ((col-vector (make-vector columns-used-size #f))
- (set-col (make-set-col col-vector)))
- (set-col #t 0) ;;(opt-val pagename-columndisplay date-header) 0)
- (set-col #t 2) ;;(opt-val pagename-columndisplay reference-header) 2)
- (set-col #t 3) ;;(opt-val pagename-columndisplay type-header) 3)
- (set-col #t 4) ;;(opt-val pagename-columndisplay desc-header) 4)
- (set-col #t 5) ;;(opt-val pagename-columndisplay amount-header) 5)
- col-vector))
-
-(define (make-heading-list column-vector)
- (let ((heading-list '()))
- (if (date-col column-vector)
- (addto! heading-list (_ date-header)))
- (if (num-col column-vector)
- (addto! heading-list (_ reference-header)))
- (if (type-col column-vector)
- (addto! heading-list (_ type-header)))
- (if (memo-col column-vector)
- (addto! heading-list (_ desc-header)))
- (if (value-col column-vector)
- (addto! heading-list (_ amount-header)))
- (reverse heading-list)))
-
-
-
-;;
-;; Make a row list based on the visible columns
-;;
-(define (make-row column-vector date due-date num type-str memo monetary)
- (let ((row-contents '()))
- (if (date-col column-vector)
- (addto! row-contents (qof-print-date date)))
- (if (num-col column-vector)
- (addto! row-contents num))
- (if (type-col column-vector)
- (addto! row-contents type-str))
- (if (memo-col column-vector)
- (addto! row-contents memo))
- (if (value-col column-vector)
- (addto! row-contents
- (gnc:make-html-table-cell/markup "number-cell" monetary)))
- row-contents))
-
-;;
-;; Adds the 'Balance' row to the table if it has not been printed and
-;; total is not zero
-;;
-;; Returns printed?
-;;
-(define (add-balance-row table column-vector txn odd-row? printed? start-date total)
- (if (not printed?)
- (begin
- (set! printed? #t)
- (if (not (gnc-numeric-zero-p total))
- (let ((row (make-row column-vector start-date #f "" (_ "Balance") ""
- (gnc:make-gnc-monetary (xaccTransGetCurrency txn) total)))
- (row-style (if odd-row? "normal-row" "alternate-row")))
- (gnc:html-table-append-row/markup! table row-style (reverse row))
- (set! odd-row? (not odd-row?))
- (set! row-style (if odd-row? "normal-row" "alternate-row")))
- )))
- printed?)
-
-;;
-;; Make sure the caller checks the type first and only calls us with
-;; invoice and payment transactions. we don't verify it here.
-;;
-;; Return a list of (printed? value odd-row?)
-;;
-(define (add-txn-row table txn acc column-vector odd-row? printed?
- inv-str reverse? start-date total)
- (let* ((type (xaccTransGetTxnType txn))
- (date (xaccTransGetDate txn))
- (due-date #f)
- (value (xaccTransGetAccountValue txn acc))
- (split (xaccTransGetSplit txn 0))
- (invoice (gncInvoiceGetInvoiceFromTxn txn))
- (currency (xaccTransGetCurrency txn))
- (type-str
- (cond
- ((equal? type TXN-TYPE-INVOICE)
- (if (not (null? invoice))
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:invoice-anchor-text invoice)
- inv-str))
- inv-str))
- ((equal? type TXN-TYPE-PAYMENT)
- (if (not (null? txn))
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:transaction-anchor-text txn)
- (_ "Payment")))
- (_ "Payment")))
- (else (_ "Unknown"))))
- )
-
- (if reverse?
- (set! value (gnc-numeric-neg value)))
-
- (if (< start-date date)
- (begin
-
- ;; Adds 'balance' row if needed
- (set! printed? (add-balance-row table column-vector txn odd-row? printed? start-date total))
-
- ;; Now print out the invoice row
- (if (not (null? invoice))
- (set! due-date (gncInvoiceGetDateDueTT invoice)))
-
- (let ((row (make-row column-vector date due-date (gnc-get-num-action txn split)
- type-str (xaccSplitGetMemo split)
- (gnc:make-gnc-monetary currency value)))
- (row-style (if odd-row? "normal-row" "alternate-row")))
-
- (gnc:html-table-append-row/markup! table row-style
- (reverse row)))
-
- (set! odd-row? (not odd-row?))
- ))
-
- (list printed? value odd-row?)
- ))
-
-
-(define (make-txn-table options txns acc start-date end-date)
- (define (opt-val pagename optname)
- (gnc:option-value (gnc:lookup-option options pagename optname)))
- (let ((used-columns (build-column-used options))
- (total (gnc-numeric-zero))
- (currency (xaccAccountGetCommodity acc))
- (table (gnc:make-html-table))
- (inv-str (opt-val "__reg" "inv-str"))
- (reverse? (opt-val "__reg" "reverse?"))
- (print-invoices? #t) ;;(opt-val gnc:pagename-general optname-invoicelines))
- )
-
- (define (should-print-txn? txn-type)
- (or (and print-invoices?
- (equal? txn-type TXN-TYPE-INVOICE))
- (and #f
- (equal? txn-type TXN-TYPE-PAYMENT))))
-
- (gnc:html-table-set-col-headers!
- table
- (make-heading-list used-columns))
-
- ;; Order the transactions properly
- (set! txns (sort txns (lambda (a b) (> 0 (xaccTransOrder a b)))))
-
- (let ((printed? #f)
- (odd-row? #t))
- (for-each
- (lambda (txn)
- (let ((type (xaccTransGetTxnType txn)))
- (if
- (should-print-txn? type)
- (let ((result (add-txn-row table txn acc used-columns odd-row? printed?
- inv-str reverse? start-date total)))
-
- (set! printed? (car result))
- (if printed?
- (set! total (gnc-numeric-add-fixed total (cadr result))))
- (set! odd-row? (caddr result))
- ))))
- txns)
- ;; Balance row may not have been added if all transactions were before
- ;; start-date (and no other rows would be added either) so add it now
- (if (and (not (null? txns)) (and print-invoices? #f))
- (add-balance-row table used-columns (car txns) odd-row? printed? start-date total)
- ))
-
- (gnc:html-table-append-row/markup!
- table
- "grand-total"
- (append (cons (gnc:make-html-table-cell/markup
- "total-label-cell"
- ;;(if (gnc-numeric-negative-p total)
- ;; (_ "Total Credit")
- ;; (_ "Total Due")))
- (_ "Total")
- " "
- ;; (xaccAccountGetName acc)
- (gnc:html-account-anchor acc))
- '())
- (list (gnc:make-html-table-cell/size/markup
- 1 (value-col used-columns)
- "total-number-cell"
- (gnc:make-gnc-monetary currency total)))))
-
- (list table total)))
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (find-first-account acct-type-list)
- (define (find-first account-list)
- (if (null? account-list)
- '()
- (let* ((this-account (car account-list))
- (account-type (xaccAccountGetType this-account)))
- (if (if (null? acct-type-list)
- #t
- (member account-type acct-type-list))
- this-account
- (find-first (cdr account-list))))))
-
- (let* ((current-root (gnc-get-current-root-account))
- (account-list (gnc-account-get-descendants-sorted current-root)))
- (find-first account-list)))
-
(define (options-generator acct-type-list owner-type inv-str reverse?)
@@ -355,23 +108,6 @@
gnc:pagename-general optname-from-date optname-to-date
"b")
-; (add-option
-; (gnc:make-simple-boolean-option
-; gnc:pagename-general optname-invoicelines
-; "m" opthelp-invoicelines #t))
-
-; (add-option
-; (gnc:make-simple-boolean-option
-; gnc:pagename-display optname-paymentlines
-; "n" opthelp-paymentlines #f))
-
-
-; (add-option
-; (gnc:make-account-sel-limited-option
-; pagename-incomeaccounts optname-account-ar
-; "a" (N_ "The account to search for transactions")
-; #f #f (list ACCT-TYPE-RECEIVABLE)))
-
(add-option
(gnc:make-account-list-option
pagename-incomeaccounts optname-incomeaccounts
@@ -383,17 +119,8 @@
(gnc:filter-accountlist-type
(list ACCT-TYPE-INCOME)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
- ;;(lambda ()
- ;;(list (find-first-account acct-type-list)))
#f #t))
-
-; (add-option
-; (gnc:make-account-sel-limited-option
-; pagename-expenseaccounts optname-account-ap
-; "a" (N_ "The account to search for transactions")
-; #f #f (list ACCT-TYPE-PAYABLE)))
-
(add-option
(gnc:make-account-list-option
pagename-expenseaccounts optname-expenseaccounts
@@ -405,36 +132,8 @@
(gnc:filter-accountlist-type
(list ACCT-TYPE-EXPENSE)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
- ;;(lambda ()
- ;;(list (find-first-account acct-type-list)))
#f #t))
-
-; (add-option
-; (gnc:make-simple-boolean-option
-; pagename-columndisplay date-header
-; "b" (N_ "Display the transaction date?") #t))
-
-; (add-option
-; (gnc:make-simple-boolean-option
-; pagename-columndisplay reference-header
-; "d" (N_ "Display the transaction reference?") #t))
-
-; (add-option
-; (gnc:make-simple-boolean-option
-; pagename-columndisplay type-header
-; "g" (N_ "Display the transaction type?") #t))
-
-; (add-option
-; (gnc:make-simple-boolean-option
-; pagename-columndisplay desc-header
-; "h" (N_ "Display the transaction description?") #t))
-
-; (add-option
-; (gnc:make-simple-boolean-option
-; pagename-columndisplay amount-header
-; "i" (N_ "Display the transaction amount?") #t))
-
(add-option
(gnc:make-multichoice-option
gnc:pagename-display optname-sortkey
@@ -491,11 +190,6 @@
gnc:pagename-display optname-show-column-expense
"g" opthelp-show-column-expense #t))
-; (add-option
-; (gnc:make-simple-boolean-option
-; gnc:pagename-display optname-show-txn-table
-; "h" opthelp-show-txn-table #f))
-
(gnc:options-set-default-section options gnc:pagename-general)
options)
@@ -504,13 +198,6 @@
(options-generator (list ACCT-TYPE-RECEIVABLE) GNC-OWNER-CUSTOMER
(_ "Invoice") #t)) ;; FIXME: reverse?=#t but originally #f
-(define (vendor-options-generator)
- (options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-VENDOR
- (_ "Bill") #t))
-
-(define (employee-options-generator)
- (options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE
- (_ "Expense Report") #t))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -570,42 +257,6 @@
(qof-query-set-book q (gnc-get-current-book))
q))
-(define (make-owner-table owner)
- (let ((table (gnc:make-html-table)))
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 0)
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 0))
- (gnc:html-table-append-row!
- table
- (list
- (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
- (gnc:html-table-append-row!
- table
- (list "<br/>"))
- (gnc:html-table-set-last-row-style!
- table "td"
- 'attribute (list "valign" "top"))
- table))
-
-(define (make-date-row! table label date)
- (gnc:html-table-append-row!
- table
- (list
- (string-append label ": ")
- (string-expand (qof-print-date date) #\space " "))))
-
-(define (make-date-table)
- (let ((table (gnc:make-html-table)))
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 0)
- 'attribute (list "cellpadding" 0))
- (gnc:html-table-set-last-row-style!
- table "td"
- 'attribute (list "valign" "top"))
- table))
(define (make-myname-table book date-format)
(let* ((table (gnc:make-html-table))
commit b47ab716c900c1599c7c3d34b937ea37085eca61
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Mar 24 14:20:49 2019 +0800
[average-balance] tidy loop conditionals
Previously the splits handling used nested conditionals. Rearrange and
tidy; i.e. handle empty-splits or empty-interval-splits first, and use
last conditional to test for internal-transactions handling. This
avoids nested conditionals.
diff --git a/gnucash/report/standard-reports/average-balance.scm b/gnucash/report/standard-reports/average-balance.scm
index a5c6c6152..235aaf47c 100644
--- a/gnucash/report/standard-reports/average-balance.scm
+++ b/gnucash/report/standard-reports/average-balance.scm
@@ -314,48 +314,12 @@
(car interval-dates)
(cdr interval-dates)))
- ;; we're still within interval. there are splits
- ;; remaining. test whether 'internal' and optionally
- ;; skip 2 splits; otherwise add split details
- ((and (pair? splits)
- (< (xaccTransGetDate (xaccSplitGetParent (car splits)))
- (car interval-dates)))
- (let* ((this (car splits))
- (rest (cdr splits))
- (next (and (pair? rest) (car rest)))
- (this-txn (xaccSplitGetParent this))
- (next-txn (and next (xaccSplitGetParent next))))
- (if (and (not internal-included)
- (= 2 (xaccTransCountSplits this-txn))
- (equal? this-txn next-txn))
- (loop results
- interval-bals
- interval-amts ;interval-amt unchanged
- (cddr splits) ;skip two splits
- daily-balances
- daily-dates
- interval-start
- interval-dates)
- (loop results
- interval-bals
- (cons (gnc:gnc-monetary-amount
- (exchange-fn
- (gnc:make-gnc-monetary
- (xaccAccountGetCommodity
- (xaccSplitGetAccount (car splits)))
- (xaccSplitGetAmount (car splits)))
- report-currency
- (car interval-dates)))
- interval-amts) ;add split amt to list
- rest ;and move to next
- daily-balances
- daily-dates
- interval-start
- interval-dates))))
-
- ;; we're still within interval, no more splits
- ;; left. add daily balance to interval.
- (else
+ ;; we're still within interval, no more splits left
+ ;; within current interval. add daily balance to
+ ;; interval.
+ ((or (null? splits)
+ (> (xaccTransGetDate (xaccSplitGetParent (car splits)))
+ (car interval-dates)))
(loop results
(cons (car daily-balances) interval-bals)
interval-amts
@@ -363,6 +327,46 @@
(cdr daily-balances)
(cdr daily-dates)
interval-start
+ interval-dates))
+
+ ;; we're still within interval. 'internal' is
+ ;; disallowed; there are at least 2 splits remaining,
+ ;; both from the same transaction. skip them. NOTE we
+ ;; should really expand this conditional whereby all
+ ;; splits are internal, however the option is labelled
+ ;; as 2-splits only. best maintain current behaviour.
+ ((and (not internal-included)
+ (pair? (cdr splits))
+ (= 2 (xaccTransCountSplits (xaccSplitGetParent (car splits))))
+ (equal? (xaccSplitGetParent (car splits))
+ (xaccSplitGetParent (cadr splits))))
+ (loop results
+ interval-bals
+ interval-amts ;interval-amts unchanged
+ (cddr splits) ;skip two splits.
+ daily-balances
+ daily-dates
+ interval-start
+ interval-dates))
+
+ ;; we're still within interval. there are splits
+ ;; remaining. add split details to interval-amts
+ (else
+ (loop results
+ interval-bals
+ (cons (gnc:gnc-monetary-amount
+ (exchange-fn
+ (gnc:make-gnc-monetary
+ (xaccAccountGetCommodity
+ (xaccSplitGetAccount (car splits)))
+ (xaccSplitGetAmount (car splits)))
+ report-currency
+ (car interval-dates)))
+ interval-amts) ;add split amt to list
+ (cdr splits) ;and loop to next split
+ daily-balances
+ daily-dates
+ interval-start
interval-dates)))))
(gnc:report-percent-done 70)
commit 1d11ee21bc76f3ac6943d493c45e21e9dbe6335f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Mar 24 13:56:19 2019 +0800
[average-balance] no need sanity check
accounts is not null (from prior sanity check) so don't need to
recheck.
diff --git a/gnucash/report/standard-reports/average-balance.scm b/gnucash/report/standard-reports/average-balance.scm
index 27f30b640..a5c6c6152 100644
--- a/gnucash/report/standard-reports/average-balance.scm
+++ b/gnucash/report/standard-reports/average-balance.scm
@@ -247,9 +247,6 @@
(gnc:account-get-balances-at-dates
acc daily-dates))
accounts))
- (accounts-balances-transposed (if (null? accounts-balances)
- '()
- (apply zip accounts-balances)))
(balances (map
(lambda (date accounts-balance)
(gnc:gnc-monetary-amount
@@ -259,7 +256,7 @@
(lambda (monetary target-curr)
(exchange-fn monetary target-curr date)))))
daily-dates
- accounts-balances-transposed)))
+ (apply zip accounts-balances))))
(qof-query-destroy query)
;; this is a complicated tight loop. start with:
commit bc553ed00e28770b620ada26cfbf5ca0fe6a450c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Mar 23 12:42:17 2019 +0800
[average-balance] destroy the query after using it
also fix comments and whitespace
diff --git a/gnucash/report/standard-reports/average-balance.scm b/gnucash/report/standard-reports/average-balance.scm
index ba1803a2d..27f30b640 100644
--- a/gnucash/report/standard-reports/average-balance.scm
+++ b/gnucash/report/standard-reports/average-balance.scm
@@ -260,6 +260,7 @@
(exchange-fn monetary target-curr date)))))
daily-dates
accounts-balances-transposed)))
+ (qof-query-destroy query)
;; this is a complicated tight loop. start with:
;; daily-balances & daily-dates, interval-dates, and the
@@ -307,9 +308,9 @@
(apply + (filter positive? interval-amts))
(- (apply + (filter negative? interval-amts)))
(apply + interval-amts))
- results)
- '()
- '()
+ results) ;process interval amts&bals
+ '() ;reset interval-bals
+ '() ;and interval-amts
splits
daily-balances
daily-dates
diff --git a/gnucash/report/standard-reports/test/test-average-balance.scm b/gnucash/report/standard-reports/test/test-average-balance.scm
index c55c1b224..c40ca3d22 100644
--- a/gnucash/report/standard-reports/test/test-average-balance.scm
+++ b/gnucash/report/standard-reports/test/test-average-balance.scm
@@ -46,17 +46,12 @@
(define (test-average-balance)
(let* ((env (create-test-env))
(account-alist (env-create-account-structure-alist env structure))
- (options (gnc:make-report-options uuid))
+ (options (gnc:make-report-options uuid))
(bank (cdr (assoc "Bank" account-alist)))
(bank2 (cdr (assoc "Another Bank" account-alist)))
(income (cdr (assoc "Income" account-alist))))
(define (default-testing-options)
- ;; To ease testing of transaction report, we will set default
- ;; options for generating reports. We will elable extra columns
- ;; for Exporting, disable generation of informational text, and
- ;; disable indenting. These options will be tested separately as
- ;; the first test group. By default, we'll select the modern dates.
(let ((options (gnc:make-report-options uuid)))
(set-option! options "Accounts" "Accounts" (list bank bank2))
(set-option! options "Display" "Show table" #t)
commit 9b9d264a0471c8ef9482081a73e11143daf2f124
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Mar 23 12:42:46 2019 +0800
[daily-reports] destroy query after using it
diff --git a/gnucash/report/standard-reports/daily-reports.scm b/gnucash/report/standard-reports/daily-reports.scm
index ec4a24bae..4e5203fb0 100644
--- a/gnucash/report/standard-reports/daily-reports.scm
+++ b/gnucash/report/standard-reports/daily-reports.scm
@@ -255,6 +255,7 @@
;; get the query results
(set! splits (qof-query-run query))
+ (qof-query-destroy query)
(gnc:report-percent-done 40)
;; each split is analyzed... the amount is converted to
commit dedccd56f3f018e1c13a1894b09ea9991a54c654
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Mar 25 17:12:52 2019 +0800
[test-average-balance] test ignore-internal? algorithms
tests gain/loss ignore-internal? algorithms
diff --git a/gnucash/report/standard-reports/test/test-average-balance.scm b/gnucash/report/standard-reports/test/test-average-balance.scm
index 2221f8d5c..c55c1b224 100644
--- a/gnucash/report/standard-reports/test/test-average-balance.scm
+++ b/gnucash/report/standard-reports/test/test-average-balance.scm
@@ -37,6 +37,7 @@
(define structure
(list "Root" (list (cons 'type ACCT-TYPE-ASSET))
(list "Bank")
+ (list "Another Bank")
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))))
(define (get-row-col sxml row col)
@@ -47,6 +48,7 @@
(account-alist (env-create-account-structure-alist env structure))
(options (gnc:make-report-options uuid))
(bank (cdr (assoc "Bank" account-alist)))
+ (bank2 (cdr (assoc "Another Bank" account-alist)))
(income (cdr (assoc "Income" account-alist))))
(define (default-testing-options)
@@ -56,7 +58,7 @@
;; disable indenting. These options will be tested separately as
;; the first test group. By default, we'll select the modern dates.
(let ((options (gnc:make-report-options uuid)))
- (set-option! options "Accounts" "Accounts" (list bank))
+ (set-option! options "Accounts" "Accounts" (list bank bank2))
(set-option! options "Display" "Show table" #t)
(set-option! options "General" "Start Date"
(cons 'absolute (gnc-dmy2time64 01 01 1979)))
@@ -81,4 +83,24 @@
(test-equal "net"
'("0.00" "100.00" "0.00" "100.00" "0.00" "0.00")
(get-row-col sxml #f 8)))
+
+ (env-transfer env 15 03 1979 bank bank2 25)
+ (let* ((options (default-testing-options))
+ (sxml (options->sxml options "include-internal")))
+ (test-equal "gains-include-internal"
+ '("0.00" "100.00" "25.00" "100.00" "0.00" "0.00")
+ (get-row-col sxml #f 6))
+ (test-equal "loss-include-internal"
+ '("0.00" "0.00" "25.00" "0.00" "0.00" "0.00")
+ (get-row-col sxml #f 7)))
+
+ (let* ((options (default-testing-options)))
+ (set-option! options "Accounts" "Exclude transactions between selected accounts" #t)
+ (let ((sxml (options->sxml options "exclude-internal")))
+ (test-equal "gain-exclude-internal"
+ '("0.00" "100.00" "0.00" "100.00" "0.00" "0.00")
+ (get-row-col sxml #f 6))
+ (test-equal "loss-exclude-internal"
+ '("0.00" "0.00" "0.00" "0.00" "0.00" "0.00")
+ (get-row-col sxml #f 7))))
(teardown)))
Summary of changes:
.../report/business-reports/customer-summary.scm | 400 +--------------------
gnucash/report/report-system/report.scm | 79 ++--
.../report/standard-reports/average-balance.scm | 100 +++---
gnucash/report/standard-reports/daily-reports.scm | 1 +
.../standard-reports/test/test-average-balance.scm | 31 +-
libgnucash/app-utils/options.scm | 6 +-
6 files changed, 135 insertions(+), 482 deletions(-)
More information about the gnucash-changes
mailing list