gnucash master: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Mon Dec 2 10:44:06 EST 2019
Updated via https://github.com/Gnucash/gnucash/commit/ce32117f (commit)
via https://github.com/Gnucash/gnucash/commit/948a5f45 (commit)
via https://github.com/Gnucash/gnucash/commit/7833c598 (commit)
via https://github.com/Gnucash/gnucash/commit/7ad4c4af (commit)
via https://github.com/Gnucash/gnucash/commit/8bf54ebf (commit)
via https://github.com/Gnucash/gnucash/commit/ab20071d (commit)
via https://github.com/Gnucash/gnucash/commit/2333b6db (commit)
via https://github.com/Gnucash/gnucash/commit/3ee434ed (commit)
via https://github.com/Gnucash/gnucash/commit/4aa17ef6 (commit)
via https://github.com/Gnucash/gnucash/commit/a52d60f4 (commit)
via https://github.com/Gnucash/gnucash/commit/df1f033f (commit)
via https://github.com/Gnucash/gnucash/commit/0b11a073 (commit)
via https://github.com/Gnucash/gnucash/commit/c21bb66d (commit)
via https://github.com/Gnucash/gnucash/commit/def0caa0 (commit)
via https://github.com/Gnucash/gnucash/commit/e97b78df (commit)
via https://github.com/Gnucash/gnucash/commit/54c4575f (commit)
via https://github.com/Gnucash/gnucash/commit/34c14b44 (commit)
via https://github.com/Gnucash/gnucash/commit/7853f5a2 (commit)
via https://github.com/Gnucash/gnucash/commit/1af8e272 (commit)
via https://github.com/Gnucash/gnucash/commit/ff298b36 (commit)
via https://github.com/Gnucash/gnucash/commit/88644451 (commit)
via https://github.com/Gnucash/gnucash/commit/119fdc36 (commit)
from https://github.com/Gnucash/gnucash/commit/cbc8cc8d (commit)
commit ce32117f70dedaac18021430680d279b6fe891e1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 23:38:21 2019 +0800
[budget] use gnc:html-markup-ol
diff --git a/gnucash/report/reports/standard/budget.scm b/gnucash/report/reports/standard/budget.scm
index 4ff3beeef..ac9952a9b 100644
--- a/gnucash/report/reports/standard/budget.scm
+++ b/gnucash/report/reports/standard/budget.scm
@@ -263,9 +263,6 @@
options))
-(define (html-markup-ol lst)
- (apply gnc:html-markup "ol" (map (lambda (elt) (gnc:html-markup "li" elt)) lst)))
-
;; creates a footnotes collector. (make-footnote-collector) => coll
;; (coll elt) if elt is not null or "", adds elt to store, returns
;; html-text containing ref eg. <sup title='note'>1</sup>. calling
@@ -276,7 +273,7 @@
('list
(let lp ((notes notes) (res '()))
(match notes
- (() (gnc:make-html-text (html-markup-ol res)))
+ (() (gnc:make-html-text (gnc:html-markup-ol res)))
((note . rest) (lp rest (cons note res))))))
((or #f "") "")
(note
commit 948a5f45882d44fd4181296b77dadf99e12582fb
Merge: cbc8cc8d8 7833c5989
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 23:38:15 2019 +0800
Merge branch 'maint'
diff --cc gnucash/report/html-utilities.scm
index c3787441f,000000000..830fa34b3
mode 100644,000000..100644
--- a/gnucash/report/html-utilities.scm
+++ b/gnucash/report/html-utilities.scm
@@@ -1,353 -1,0 +1,341 @@@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; html-utilities.scm: Useful functions when using the HTML generator.
+;;
+;; Modified slightly by David Montenegro 2004.06.18.
+;;
+;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
+;; Boston, MA 02110-1301, USA gnu at gnu.org
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(use-modules (gnucash utilities))
+
+;; returns a list with n #f (empty cell) values
+(define (gnc:html-make-empty-cell) #f)
+(define (gnc:html-make-empty-cells n)
+ (if (> n 0)
+ (cons #f (gnc:html-make-empty-cells (- n 1)))
+ (list)))
+
+(define (gnc:register-guid type guid)
+ (gnc-build-url URL-TYPE-REGISTER (string-append type guid) ""))
+
+(define (gnc:account-anchor-text acct)
+ (gnc:register-guid "acct-guid=" (gncAccountGetGUID acct)))
+
+(define (gnc:split-anchor-text split)
+ (gnc:register-guid "split-guid=" (gncSplitGetGUID split)))
+
+(define (gnc:transaction-anchor-text trans)
+ (gnc:register-guid "trans-guid=" (gncTransGetGUID trans)))
+
+(define (gnc:report-anchor-text report-id)
+ (gnc-build-url URL-TYPE-REPORT
+ (string-append "id=" (number->string report-id))
+ ""))
+
+(define (gnc:price-anchor-text price)
+ (gnc-build-url URL-TYPE-PRICE
+ (string-append "price-guid=" (gncPriceGetGUID price))
+ ""))
+
+(define (guid-ref idstr type guid)
+ (gnc-build-url type (string-append idstr guid) ""))
+
+(define (gnc:customer-anchor-text customer)
+ (guid-ref "customer=" URL-TYPE-CUSTOMER (gncCustomerReturnGUID customer)))
+
+(define (gnc:job-anchor-text job)
+ (guid-ref "job=" URL-TYPE-JOB (gncJobReturnGUID job)))
+
+(define (gnc:vendor-anchor-text vendor)
+ (guid-ref "vendor=" URL-TYPE-VENDOR (gncVendorReturnGUID vendor)))
+
+(define (gnc:employee-anchor-text employee)
+ (guid-ref "employee=" URL-TYPE-EMPLOYEE (gncEmployeeReturnGUID employee)))
+
+(define (gnc:invoice-anchor-text invoice)
+ (guid-ref "invoice=" URL-TYPE-INVOICE (gncInvoiceReturnGUID invoice)))
+
+(define (gnc:owner-anchor-text owner)
+ (let ((type (gncOwnerGetType (gncOwnerGetEndOwner owner))))
+ (cond
+ ((eqv? type GNC-OWNER-CUSTOMER)
+ (gnc:customer-anchor-text (gncOwnerGetCustomer owner)))
+
+ ((eqv? type GNC-OWNER-VENDOR)
+ (gnc:vendor-anchor-text (gncOwnerGetVendor owner)))
+
+ ((eqv? type GNC-OWNER-EMPLOYEE)
+ (gnc:employee-anchor-text (gncOwnerGetEmployee owner)))
+
+ ((eqv? type GNC-OWNER-JOB)
+ (gnc:job-anchor-text (gncOwnerGetJob owner)))
+
+ (else
+ ""))))
+
+(define (gnc:owner-report-text owner acc)
+ (let* ((end-owner (gncOwnerGetEndOwner owner))
- (type (gncOwnerGetType end-owner))
- (ref #f))
-
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER)
- (set! ref "owner=c:"))
-
- ((eqv? type GNC-OWNER-VENDOR)
- (set! ref "owner=v:"))
-
- ((eqv? type GNC-OWNER-EMPLOYEE)
- (set! ref "owner=e:"))
-
- (else (set! ref "unknown-type=")))
-
- (if ref
- (begin
- (set! ref (string-append ref (gncOwnerReturnGUID end-owner)))
- (if (not (null? acc))
- (set! ref (string-append ref "&acct="
- (gncAccountGetGUID acc))))
- (gnc-build-url URL-TYPE-OWNERREPORT ref ""))
- ref)))
++ (type (gncOwnerGetType end-owner)))
++ (gnc-build-url
++ URL-TYPE-OWNERREPORT
++ (string-append
++ (cond ((eqv? type GNC-OWNER-CUSTOMER) "owner=c:")
++ ((eqv? type GNC-OWNER-VENDOR) "owner=v:")
++ ((eqv? type GNC-OWNER-EMPLOYEE) "owner=e:")
++ (else "unknown-type="))
++ (gncOwnerReturnGUID end-owner)
++ (if (null? acc) "" (string-append "&acct=" (gncAccountGetGUID acc))))
++ "")))
+
+;; Make a new report and return the anchor to it. The new report of
+;; type 'reportname' will have the option values copied from
+;; 'src-options', and additionally this function sets all options
+;; according to 'optionlist'. Each element of optionlist is a list of
+;; section, name, and value of the function.
+(define (gnc:make-report-anchor reportname src-report
+ optionlist)
+ (let ((src-options (gnc:report-options src-report))
+ (options (gnc:make-report-options reportname)))
+ (if options
+ (begin
+ (gnc:options-copy-values src-options options)
+ (for-each
+ (lambda (l)
+ (let ((o (gnc:lookup-option options (car l) (cadr l))))
+ (if o
+ (gnc:option-set-value o (caddr l))
+ (warn "gnc:make-report-anchor:" reportname
+ " No such option: " (car l) (cadr l)))))
+ optionlist)
+ (let ((id (gnc:make-report reportname options)))
+ (gnc:report-anchor-text id)))
+ (warn "gnc:make-report-anchor: No such report: " reportname))))
+
+
+;; returns the account name as html-text and anchor to the register.
+(define (gnc:html-account-anchor acct)
+ (gnc:make-html-text (if (and acct (not (null? acct)))
+ (gnc:html-markup-anchor
+ (gnc:account-anchor-text acct)
+ (xaccAccountGetName acct))
+ "")))
+
+(define (gnc:html-split-anchor split text)
+ (gnc:make-html-text (if (not (null? (xaccSplitGetAccount split)))
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text split)
+ text)
+ text)))
+
+(define (gnc:html-transaction-anchor trans text)
+ (gnc:make-html-text (gnc:html-markup-anchor
+ (gnc:transaction-anchor-text trans)
+ text)))
+
+(define (gnc:html-price-anchor price value)
+ (gnc:make-html-text (if price
+ (gnc:html-markup-anchor
+ (gnc:price-anchor-text price)
+ (if value
+ value
+ (gnc-price-get-value price)))
+ value)))
+
+(define (gnc:assign-colors num-colors)
+ ;; default CSS colours
+ ;; (define base-colors '("red" "orange" "yellow" "green"
+ ;; "cyan" "blue" "purple" "magenta"
+ ;; "orchid" "khaki" "gold" "orange"
+ ;; "red3" "orange3" "yellow3" "green3"
+ ;; "cyan3" "blue3" "purple3" "magenta3"
+ ;; "orchid3" "khaki3" "gold3" "orange3"))
+
+ ;; new base-colors from http://clrs.cc/ and flatuicolors.com
+ (define base-colors (list "#FF4136" "#FF851B" "#FFDC00" "#2ECC40"
+ "#0074D9" "#001f3f" "#85144b" "#7FDBFF"
+ "#F012BE" "#3D9970" "#39CCCC" "#f39c12"
+ "#e74c3c" "#e67e22" "#9b59b6" "#8e44ad"
+ "#16a085" "#d35400"))
+ (let lp ((i 0) (result '()) (colors base-colors))
+ (cond
+ ((<= num-colors i) (reverse result))
+ ((null? colors) (lp (1+ i) (cons (car base-colors) result) (cdr base-colors)))
+ (else (lp (1+ i) (cons (car colors) result) (cdr colors))))))
+
+(define (gnc:html-table-append-ruler! table colspan)
+ (gnc:html-table-append-row!
+ table (list (gnc:make-html-table-cell/size
+ 1 colspan (gnc:make-html-text (gnc:html-markup-hr))))))
+
+;; Create a html-table of all exchange rates. The report-commodity is
+;; 'common-commodity', the exchange rates are given through the
+;; function 'exchange-fn' and the 'accounts' determine which
+;; commodities to show. Returns a html-object, a <html-table>.
+(define (gnc:html-make-exchangerates common-commodity exchange-fn accounts)
+ (let ((comm-list (gnc:accounts-get-commodities accounts common-commodity))
+ (markup (lambda (c) (gnc:make-html-table-cell/markup "number-cell" c)))
+ (table (gnc:make-html-table)))
+ (unless (null? comm-list)
+ (for-each
+ (lambda (commodity)
+ (let* ((orig-amt (gnc:make-gnc-monetary commodity 1))
+ (exchanged (exchange-fn orig-amt common-commodity)))
+ (gnc:html-table-append-row!
+ table (map markup (list orig-amt exchanged)))))
+ comm-list)
+ (gnc:html-table-set-col-headers!
+ table (list (gnc:make-html-table-header-cell/size
+ 1 2 (if (null? (cdr comm-list))
+ (_ "Exchange rate")
+ (_ "Exchange rates"))))))
+ table))
+
+
+(define (gnc:html-make-generic-budget-warning report-title-string)
+ (gnc:html-make-generic-simple-warning
+ report-title-string
+ (_ "No budgets exist. You must create at least one budget.")))
+
+
+(define (gnc:html-make-generic-simple-warning report-title-string message)
+ (let ((p (gnc:make-html-text)))
+ (gnc:html-text-append!
+ p
+ (gnc:html-markup-h2 (string-append report-title-string ":"))
+ (gnc:html-markup-h2 "")
+ (gnc:html-markup-p message))
+ p))
+
+
+(define (gnc:html-make-options-link report-id)
+ (if report-id
+ (gnc:html-markup-p
+ (gnc:html-markup-anchor
+ (gnc-build-url URL-TYPE-OPTIONS
+ (string-append "report-id=" (format #f "~a" report-id))
+ "")
+ (_ "Edit report options")))))
+
+(define* (gnc:html-render-options-changed options #:optional plaintext?)
+ ;; options -> html-object or string, depending on plaintext?. This
+ ;; summarises options that were changed by the user. Set plaintext?
+ ;; to #t for unit-tests only.
+ (define (disp d)
+ ;; option-value -> string. The option is passed to various
+ ;; scm->string converters; ultimately a generic stringify
+ ;; function handles symbol/string/other types.
+ (define (try proc)
+ ;; Try proc with d as a parameter, catching 'wrong-type-arg
+ ;; exceptions to return #f to the or evaluator.
+ (catch 'wrong-type-arg
+ (lambda () (proc d))
+ (const #f)))
+ (or (and (boolean? d) (if d (_ "Enabled") (_ "Disabled")))
+ (and (null? d) "null")
+ (and (list? d) (string-join (map disp d) ", "))
+ (and (pair? d) (format #f "~a . ~a"
+ (car d)
+ (if (eq? (car d) 'absolute)
+ (qof-print-date (cdr d))
+ (disp (cdr d)))))
+ (try gnc-commodity-get-mnemonic)
+ (try xaccAccountGetName)
+ (try gnc-budget-get-name)
+ (format #f "~a" d)))
+ (let ((render-list '()))
+ (define (add-option-if-changed option)
+ (let* ((section (gnc:option-section option))
+ (name (gnc:option-name option))
+ (default-value (gnc:option-default-value option))
+ (value (gnc:option-value option))
+ (retval (cons (format #f "~a / ~a" section name)
+ (disp value))))
+ (if (not (or (equal? default-value value)
+ (char=? (string-ref section 0) #\_)))
+ (addto! render-list retval))))
+ (gnc:options-for-each add-option-if-changed options)
+ (if plaintext?
+ (string-append
+ (string-join
+ (map (lambda (item)
+ (format #f "~a: ~a\n" (car item) (cdr item)))
+ render-list)
+ "")
+ "\n")
+ (apply
+ gnc:make-html-text
+ (apply
+ append
+ (map
+ (lambda (item)
+ (list
+ (gnc:html-markup-b (car item))
+ ": "
+ (cdr item)
+ (gnc:html-markup-br)))
+ render-list))))))
+
+(define (gnc:html-make-generic-warning
+ report-title-string report-id
+ warning-title-string warning-string)
+ (let ((p (gnc:make-html-text)))
+ (gnc:html-text-append!
+ p
+ (gnc:html-markup-h2 (string-append (_ report-title-string) ":"))
+ (gnc:html-markup-h2 warning-title-string)
+ (gnc:html-markup-p warning-string)
+ (gnc:html-make-options-link report-id))
+ p))
+
+(define (gnc:html-make-generic-options-warning
+ report-title-string report-id)
+ (gnc:html-make-generic-warning
+ report-title-string
+ report-id
+ ""
+ (_ "This report requires you to specify certain report options.")))
+
+(define (gnc:html-make-no-account-warning
+ report-title-string report-id)
+ (gnc:html-make-generic-warning
+ report-title-string
+ report-id
+ (_ "No accounts selected")
+ (_ "This report requires accounts to be selected in the report options.")))
+
+(define (gnc:html-make-empty-data-warning
+ report-title-string report-id)
+ (gnc:html-make-generic-warning
+ report-title-string
+ report-id
+ (_ "No data")
+ (_ "The selected accounts contain no data/transactions (or only zeroes) for the selected time period")))
+
+(define (gnc:html-js-include file)
+ (format #f
+ "<script language=\"javascript\" type=\"text/javascript\" src=\"file:///~a\"></script>\n"
+ (gnc-path-find-localized-html-file file)))
+
+(define (gnc:html-css-include file)
+ (format #f
+ "<link rel=\"stylesheet\" type=\"text/css\" href=\"file:///~a\" />\n"
+ (gnc-path-find-localized-html-file file)))
+
+
+
diff --cc gnucash/report/reports/standard/test/test-balsheet-pnl.scm
index ff2d232bd,98e272c35..8b9a5e6d5
--- a/gnucash/report/reports/standard/test/test-balsheet-pnl.scm
+++ b/gnucash/report/reports/standard/test/test-balsheet-pnl.scm
@@@ -1,13 -1,15 +1,15 @@@
(use-modules (gnucash gnc-module))
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-(use-modules (gnucash engine test test-extras))
-(use-modules (gnucash report standard-reports balance-sheet))
-(use-modules (gnucash report standard-reports income-statement))
-(use-modules (gnucash report standard-reports balsheet-pnl))
-(use-modules (gnucash report standard-reports transaction))
-(use-modules (gnucash report stylesheets))
-(use-modules (gnucash report report-system))
-(use-modules (gnucash report report-system test test-extras))
+(use-modules (tests test-engine-extras))
+(use-modules (gnucash reports standard balance-sheet))
+(use-modules (gnucash reports standard income-statement))
++(use-modules (gnucash reports standard balsheet-pnl))
++(use-modules (gnucash reports standard transaction))
+(use-modules (gnucash report stylesheets plain)) ; For the default stylesheet, required for rendering
+(use-modules (gnucash report))
+(use-modules (tests test-report-extras))
(use-modules (srfi srfi-64))
-(use-modules (gnucash engine test srfi64-extras))
+(use-modules (tests srfi64-extras))
(use-modules (sxml simple))
(use-modules (sxml xpath))
commit 7833c59896b2d2705084732407277778ebb8ed85
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 16:38:25 2019 +0800
Bug 724219 - Customer Summary includes Closing Entries when reporting across the end of year
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 1f05883df..f2ed8f4de 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -203,6 +203,7 @@
;; guid QOF-QUERY-OR)
(xaccQueryAddAccountMatch q account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
(xaccQueryAddDateMatchTT q #t start-date #t end-date QOF-QUERY-AND)
+ (xaccQueryAddClosingTransMatch q #f QOF-QUERY-AND)
(qof-query-set-book q (gnc-get-current-book))
(let ((result (qof-query-run q)))
(qof-query-destroy q)
commit 7ad4c4afbdd50dec5751f93d5e25bea39c806e25
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 18:19:28 2019 +0800
[html-acct-table] compact gnc:html-acct-table-get-cell
diff --git a/gnucash/report/report-system/html-acct-table.scm b/gnucash/report/report-system/html-acct-table.scm
index e8cf33e12..71f668b82 100644
--- a/gnucash/report/report-system/html-acct-table.scm
+++ b/gnucash/report/report-system/html-acct-table.scm
@@ -850,12 +850,9 @@
(define (gnc:html-acct-table-get-cell acct-table row col)
;; we'll only ever store one object in an html-table-cell
;; returns the first object stored in that cell
- (let* ((cell (gnc:html-table-get-cell
- (gnc:_html-acct-table-matrix_ acct-table)
- row (+ col 1))))
- (and cell (car (gnc:html-table-cell-data cell)))
- )
- )
+ (and-let* ((cell (gnc:html-table-get-cell
+ (gnc:_html-acct-table-matrix_ acct-table) row (1+ col))))
+ (car (gnc:html-table-cell-data cell))))
(define (gnc:html-acct-table-set-cell! acct-table row col obj)
(gnc:html-table-set-cell!
commit 8bf54ebfc1c2da11bb1c16c41ed12d1e5ae2b2c8
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 08:50:56 2019 +0800
[html-acct-table] compact traverse-accounts!
* convert for-each to named-let
* allows reduction of set! calls
diff --git a/gnucash/report/report-system/html-acct-table.scm b/gnucash/report/report-system/html-acct-table.scm
index 721330c87..e8cf33e12 100644
--- a/gnucash/report/report-system/html-acct-table.scm
+++ b/gnucash/report/report-system/html-acct-table.scm
@@ -616,7 +616,6 @@
)
;; the following function was adapted from html-utilities.scm
- ;;
;; helper to calculate the balances for all required accounts
(define (calculate-balances accts start-date end-date get-balance-fn)
@@ -673,19 +672,18 @@
(define (traverse-accounts! accts acct-depth logi-depth new-balances)
(define (use-acct? acct)
- ;; BUG? when depth-limit is not integer but boolean?
- (and (or (eq? limit-behavior 'flatten)
+ (and (or (eq? limit-behavior 'flatten)
(< logi-depth depth-limit))
- (member acct accounts)))
-
- ;; helper function to return a cached balance from a list of
+ (member acct accounts)))
+
+ ;; helper function to return a cached balance from a list of
;; ( acct . balance ) cells
(define (get-balance acct-balances acct)
- (let ((this-collector (gnc:make-commodity-collector))
+ (let ((this-collector (gnc:make-commodity-collector))
(acct-coll (hash-ref acct-balances (gncAccountGetGUID acct)
(gnc:make-commodity-collector))))
- (this-collector 'merge acct-coll #f)
- this-collector))
+ (this-collector 'merge acct-coll #f)
+ this-collector))
;; helper function that returns a cached balance from a list of
;; ( acct . balance) cells for the given account *and* its
@@ -696,217 +694,151 @@
(lambda (acct)
(this-collector 'merge (get-balance acct-balances acct) #f))
(gnc:accounts-and-all-descendants (list account)))
- this-collector))
-
- (let ((disp-depth (if (integer? depth-limit)
- (min (- depth-limit 1) logi-depth)
- logi-depth))
- (row-added? #f))
-
- (for-each
- (lambda (acct)
- (let* ((subaccts (gnc-account-get-children-sorted acct))
- ;; assign output parameters
- (account acct)
- (account-name (xaccAccountGetName acct))
- (account-code (xaccAccountGetCode acct))
- (account-path (gnc-account-get-full-name acct))
- (account-anchor (gnc:html-account-anchor acct))
- (account-parent (gnc-account-get-parent acct))
- (account-children subaccts)
- (account-depth acct-depth)
- (logical-depth logi-depth)
- (account-commodity (xaccAccountGetCommodity acct))
- (account-type (xaccAccountGetType acct))
- ;; N.B.: xaccAccountGetTypeStr really should be
- ;; called gnc:account-type-get-string
- (account-type-string (xaccAccountGetTypeStr
- (xaccAccountGetType acct)))
- (account-guid (gncAccountGetGUID acct))
- (account-description (xaccAccountGetDescription acct))
- (account-notes (xaccAccountGetNotes acct))
- ;; These next two are commodity-collectors.
- (account-bal (get-balance
- new-balances acct))
- (recursive-bal (get-balance-sub
- new-balances acct))
- ;; These next two are of type <gnc:monetary>, right?
- (report-comm-account-bal
- (gnc:sum-collector-commodity
- account-bal report-commodity exchange-fn))
- (report-comm-recursive-bal
- (gnc:sum-collector-commodity
- recursive-bal report-commodity exchange-fn))
- (grp-env
- (append env
- (list
- (list 'initial-indent indent)
- (list 'account account)
- (list 'account-name account-name)
- (list 'account-code account-code)
- (list 'account-type account-type)
- (list 'account-type-string account-type-string)
- (list 'account-guid account-guid)
- (list 'account-description account-description)
- (list 'account-notes account-notes)
- (list 'account-path account-path)
- (list 'account-parent account-parent)
- (list 'account-children account-children)
- (list 'account-depth account-depth)
- (list 'logical-depth logical-depth)
- (list 'account-commodity account-commodity)
- (list 'account-anchor account-anchor)
- (list 'account-bal account-bal)
- (list 'recursive-bal recursive-bal)
- (list 'report-comm-account-bal
- report-comm-account-bal)
- (list 'report-comm-recursive-bal
- report-comm-recursive-bal)
- (list 'report-commodity report-commodity)
- (list 'exchange-fn exchange-fn)
- )))
- (row-env #f)
- (label (case label-mode
- ((anchor) account-anchor)
- ((name) (gnc:make-html-text account-name))))
- (row #f)
- (children-displayed? #f)
- )
+ this-collector))
+
+ (let lp ((accounts (if less-p (sort accts less-p) accts))
+ (row-added? #f)
+ (disp-depth (if (integer? depth-limit)
+ (min (1- depth-limit) logi-depth)
+ logi-depth)))
+
+ (cond
+
+ ((null? accounts) row-added?)
+
+ (else
+ (let* ((acct (car accounts))
+ (subaccts (gnc-account-get-children-sorted acct))
+
+ ;; These next two are commodity-collectors.
+ (account-bal (get-balance new-balances acct))
+ (recursive-bal (get-balance-sub new-balances acct))
+
+ ;; These next two are of type <gnc:monetary>
+ (report-comm-account-bal
+ (gnc:sum-collector-commodity
+ account-bal report-commodity exchange-fn))
+ (report-comm-recursive-bal
+ (gnc:sum-collector-commodity
+ recursive-bal report-commodity exchange-fn))
+
+ (grp-env
+ (cons*
+ (list 'initial-indent indent)
+ (list 'account acct)
+ (list 'account-name (xaccAccountGetName acct))
+ (list 'account-code (xaccAccountGetCode acct))
+ (list 'account-type (xaccAccountGetType acct))
+ (list 'account-type-string (xaccAccountGetTypeStr
+ (xaccAccountGetType acct)))
+ (list 'account-guid (gncAccountGetGUID acct))
+ (list 'account-description (xaccAccountGetDescription acct))
+ (list 'account-notes (xaccAccountGetNotes acct))
+ (list 'account-path (gnc-account-get-full-name acct))
+ (list 'account-parent (gnc-account-get-parent acct))
+ (list 'account-children subaccts)
+ (list 'account-depth acct-depth)
+ (list 'logical-depth logi-depth)
+ (list 'account-commodity (xaccAccountGetCommodity acct))
+ (list 'account-anchor (gnc:html-account-anchor acct))
+ (list 'account-bal account-bal)
+ (list 'recursive-bal recursive-bal)
+ (list 'report-comm-account-bal report-comm-account-bal)
+ (list 'report-comm-recursive-bal report-comm-recursive-bal)
+ (list 'report-commodity report-commodity)
+ (list 'exchange-fn exchange-fn)
+ env))
+ (label (case label-mode
+ ((anchor) (gnc:html-account-anchor acct))
+ ((name) (gnc:make-html-text (xaccAccountGetName acct)))))
+ (row #f)
+ (children-displayed? #f))
+
+ (set! acct-depth-reached (max acct-depth-reached acct-depth))
+ (set! logi-depth-reached (max logi-depth-reached logi-depth))
+ (set! disp-depth-reached (max disp-depth-reached disp-depth))
- (set! acct-depth-reached (max acct-depth-reached acct-depth))
- (set! logi-depth-reached (max logi-depth-reached logi-depth))
- (set! disp-depth-reached (max disp-depth-reached disp-depth))
-
- (or (not (use-acct? acct))
- ;; ok, so we'll consider parent accounts with zero
- ;; recursive-bal to be zero balance leaf accounts
- (and (gnc-commodity-collector-allzero? recursive-bal)
- (or (not report-budget)
- (gnc-numeric-zero-p
- (gnc:budget-account-get-rolledup-net
- report-budget account #f #f)))
- (equal? zero-mode 'omit-leaf-acct))
- (begin
- (set! row-env
- (append grp-env
- (list
- (list 'account-label label)
- (list 'row-type 'account-row)
- (list 'display-depth disp-depth)
- (list 'indented-depth
- (+ disp-depth indent))
- )
- ))
- (set! row (add-row row-env))
- )
- )
- ;; Recurse:
- ;; Dive into an account even if it isn't selected!
- ;; why? because some subaccts may be selected.
- (set! children-displayed?
- (traverse-accounts! subaccts
- (+ acct-depth 1)
- (if (use-acct? acct)
- (+ logi-depth 1)
- logi-depth)
- new-balances))
-
- ;; record whether any children were displayed
- (if row (append-to-row row (list (list 'children-displayed? children-displayed?))))
-
- ;; after the return from recursion: subtotals
- (or (not (use-acct? acct))
- (not subtotal-mode)
- ;; ditto that remark concerning zero recursive-bal...
- (and (gnc-commodity-collector-allzero? recursive-bal)
- (equal? zero-mode 'omit-leaf-acct))
- ;; ignore use-acct for subtotals...?
- ;; (not (use-acct? acct))
- (not children-displayed?)
- (let* ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
- (apply gnc:html-text-append! lbl-txt
- (gnc:html-text-body label))
- (if (equal? subtotal-mode 'canonically-tabbed)
- (set! disp-depth (+ disp-depth 1))
- (set! disp-depth-reached
- (max disp-depth-reached disp-depth))
- )
- (set! row-env
- (append grp-env
- (list
- (list 'account-label lbl-txt)
- (list 'row-type 'subtotal-row)
- (list 'display-depth disp-depth)
- (list 'indented-depth
- (+ disp-depth indent))
- )
- ))
- (add-row row-env)
- )
- )
- (if (or row-added? children-displayed? row) (set! row-added? #t))
- )) ;; end of (lambda (acct) ...)
- ;; lambda is applied to each item in the (sorted) account list
- (if less-p
- (sort accts less-p)
- accts)
- ) ;; end of for-each
- row-added?
- )
- ) ;; end of definition of traverse-accounts!
+ (unless (or (not (use-acct? acct))
+ ;; ok, so we'll consider parent accounts with zero
+ ;; recursive-bal to be zero balance leaf accounts
+ (and (gnc-commodity-collector-allzero? recursive-bal)
+ (eq? zero-mode 'omit-leaf-acct)
+ (or (not report-budget)
+ (zero? (gnc:budget-account-get-rolledup-net
+ report-budget acct #f #f)))))
+ (set! row
+ (add-row
+ (cons* (list 'account-label label)
+ (list 'row-type 'account-row)
+ (list 'display-depth disp-depth)
+ (list 'indented-depth (+ disp-depth indent))
+ grp-env))))
+
+ ;; Recurse:
+ ;; Dive into an account even if it isn't selected!
+ ;; why? because some subaccts may be selected.
+ (set! children-displayed?
+ (traverse-accounts! subaccts
+ (1+ acct-depth)
+ (if (use-acct? acct)
+ (1+ logi-depth)
+ logi-depth)
+ new-balances))
+
+ ;; record whether any children were displayed
+ (when row
+ (append-to-row
+ row (list (list 'children-displayed? children-displayed?))))
+
+ ;; after the return from recursion: subtotals
+ (unless (or (not (use-acct? acct))
+ (not subtotal-mode)
+ (not children-displayed?)
+ (and (gnc-commodity-collector-allzero? recursive-bal)
+ (eq? zero-mode 'omit-leaf-acct)))
+ (let ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
+ (apply gnc:html-text-append! lbl-txt (gnc:html-text-body label))
+ (if (eq? subtotal-mode 'canonically-tabbed)
+ (set! disp-depth (+ disp-depth 1))
+ (set! disp-depth-reached (max disp-depth-reached disp-depth)))
+ (add-row
+ (cons* (list 'account-label lbl-txt)
+ (list 'row-type 'subtotal-row)
+ (list 'display-depth disp-depth)
+ (list 'indented-depth (+ disp-depth indent))
+ grp-env))))
+
+ (lp (cdr accounts)
+ (or row-added? children-displayed? row)
+ disp-depth))))))
;; do it
- (traverse-accounts! toplvl-accts 0 0
- (calculate-balances accounts start-date end-date get-balance-fn))
-
+ (traverse-accounts!
+ toplvl-accts 0 0
+ (calculate-balances accounts start-date end-date get-balance-fn))
+
;; now set the account-colspan entries
- ;; he he... (let ((x 0)) (while (< x 5) (display x) (set! x (+ x 1))))
- ;; now I know how to loop in scheme... yay!
- (let ((row 0)
- (rows (gnc:html-acct-table-num-rows acct-table)))
- (while (< row rows)
- (let* ((orig-env
- (gnc:html-acct-table-get-row-env acct-table row))
- (display-depth (get-val orig-env 'display-depth))
- (depth-limit (get-val orig-env 'display-tree-depth))
- (indent (get-val orig-env 'initial-indent))
- (indented-depth (get-val orig-env 'indented-depth))
- (subtotal-mode
- (get-val orig-env 'parent-account-subtotal-mode))
- (label-cols (+ disp-depth-reached 1))
- (logical-cols (if depth-limit
- (min
- (+ logi-depth-reached 1)
- ;; BUG? when depth-limit is not integer?
- depth-limit)
- (+ logi-depth-reached 1)))
- (colspan (- label-cols display-depth))
- ;; these parameters *should* always, by now, be set...
- (new-env
- (append
- orig-env
- (list
- (list 'account-colspan colspan)
- (list 'label-cols label-cols)
- (list 'logical-cols logical-cols)
- (list 'account-cols
- (+ indent
- (max label-cols
- (if depth-limit depth-limit 0)
- )
- )
- )
- )
- ))
- )
- (gnc:html-acct-table-set-row-env! acct-table row new-env)
- (set! row (+ row 1))))
- )
-
- ;; done
-
- )
- )
+ (let lp ((row 0)
+ (rows (gnc:html-acct-table-num-rows acct-table)))
+ (when (< row rows)
+ (let* ((orig-env (gnc:html-acct-table-get-row-env acct-table row))
+ (display-depth (get-val orig-env 'display-depth))
+ (depth-limit (get-val orig-env 'display-tree-depth))
+ (indent (get-val orig-env 'initial-indent))
+ (indented-depth (get-val orig-env 'indented-depth))
+ (subtotal-mode (get-val orig-env 'parent-account-subtotal-mode))
+ (label-cols (+ disp-depth-reached 1))
+ ;; these parameters *should* always, by now, be set...
+ (new-env
+ (cons*
+ (list 'account-colspan (- label-cols display-depth))
+ (list 'label-cols label-cols)
+ (list 'account-cols (+ indent (max label-cols (or depth-limit 0))))
+ (list 'logical-cols (min (+ logi-depth-reached)
+ (or depth-limit +inf.0)))
+ orig-env)))
+ (gnc:html-acct-table-set-row-env! acct-table row new-env)
+ (lp (1+ row) rows))))))
(define (gnc:html-acct-table-num-rows acct-table)
(gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table)))
commit ab20071d828c6541cebb233954cd748b32b1f2ba
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Dec 2 08:26:01 2019 +0800
[report-utilities] strify hash-table to Hash(kvp-list)
Hash tables are strified to "Hash()" "Hash(key=value,...)"
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 75b5afb06..459609e9b 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1259,6 +1259,18 @@ flawed. see report-utilities.scm. please update reports.")
(gnc-lot-get-notes lot)
(gnc-lot-get-balance lot)
(gnc-lot-count-splits lot)))
+ (define (record->str rec)
+ (let ((rtd (record-type-descriptor rec)))
+ (define (fld->str fld)
+ (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) rec))))
+ (format #f "Rec:~a{~a}"
+ (record-type-name rtd)
+ (string-join (map fld->str (record-type-fields rtd)) ", "))))
+ (define (hash-table->str hash)
+ (string-append
+ "Hash(" (string-join
+ (hash-map->list (lambda (k v) (format #f "~a=~a" k v)) hash) ",")
+ ")"))
(define (try proc)
;; Try proc with d as a parameter, catching exceptions to return
;; #f to the (or) evaluator below.
@@ -1294,13 +1306,8 @@ flawed. see report-utilities.scm. please update reports.")
(try owner->str)
(try invoice->str)
(try lot->str)
- (and (record? d)
- (let ((rtd (record-type-descriptor d)))
- (define (fld->str fld)
- (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) d))))
- (format #f "Rec:~a{~a}"
- (record-type-name rtd)
- (string-join (map fld->str (record-type-fields rtd)) ", "))))
+ (try hash-table->str)
+ (try record->str)
(object->string d)))
(define (pair->num pair)
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index b0f12da76..13921d47c 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -152,6 +152,16 @@
(test-equal "gnc:strify <val-coll 10>"
"coll<10>"
(gnc:strify coll)))
+
+ (let ((ht (make-hash-table)))
+ (test-equal "gnc:strify Hash()"
+ "Hash()"
+ (gnc:strify ht))
+ (hash-set! ht 'one "uno")
+ (test-equal "gnc:strify Hash(one=uno)"
+ "Hash(one=uno)"
+ (gnc:strify ht)))
+
(test-end "debugging tools"))
(define (test-commodity-collector)
commit 2333b6db271ad50bf5a3c5825990647b73077913
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 1 23:10:22 2019 +0800
[reports] avoid "<br/>" literal: use gnc:multiline-to-html-text
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index e0ab202cd..1f05883df 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -179,17 +179,6 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (string-expand string character replace-string)
- (with-output-to-string
- (lambda ()
- (string-for-each
- (lambda (c)
- (display
- (if (char=? c character)
- replace-string
- c)))
- string))))
-
(define (query owner account-list start-date end-date)
(let* ((q (qof-query-create-for-splits))
(guid (and owner
@@ -232,8 +221,7 @@
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
(if name (gnc:html-table-append-row! table (list name)))
- (if addy (gnc:html-table-append-row!
- table (list (string-expand addy #\newline "<br/>"))))
+ (if addy (gnc:html-table-append-row! table (gnc:multiline-to-html-text addy)))
(gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format)))
(let ((table-outer (gnc:make-html-table)))
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index 0beef5c12..84bf7eedb 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -178,15 +178,7 @@
keylist))
(define (multiline-to-html-text str)
- ;; simple function - splits string containing #\newline into
- ;; substrings, and convert to a gnc:make-html-text construct which
- ;; adds gnc:html-markup-br after each substring.
- (let loop ((list-of-substrings (string-split str #\newline))
- (result '()))
- (if (null? list-of-substrings)
- (apply gnc:make-html-text (if (null? result) '() (reverse (cdr result))))
- (loop (cdr list-of-substrings)
- (cons* (gnc:html-markup-br) (car list-of-substrings) result)))))
+ (gnc:multiline-to-html-text str))
(define (options-generator variant)
diff --git a/gnucash/report/business-reports/job-report.scm b/gnucash/report/business-reports/job-report.scm
index 60954b02d..c8fc66cfd 100644
--- a/gnucash/report/business-reports/job-report.scm
+++ b/gnucash/report/business-reports/job-report.scm
@@ -416,24 +416,6 @@
(options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE
(_ "Expense Report") #t))
-(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)))
-
(define (setup-query q owner account end-date)
(let* ((guid (gncOwnerReturnGUID owner)))
@@ -464,13 +446,15 @@
'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/>")))
+ (list (gnc:multiline-to-html-text
+ (gnc:owner-get-name-and-address-dep owner))))
+
(gnc:html-table-append-row!
- table
- (list "<br/>"))
+ table (gnc:make-html-text (gnc:html-markup-br)))
+
(gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
@@ -507,10 +491,10 @@
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
- (gnc:html-table-append-row! table (list (if name name "")))
- (gnc:html-table-append-row! table (list (string-expand
- (if addy addy "")
- #\newline "<br/>")))
+ (gnc:html-table-append-row! table (list (or name "")))
+
+ (gnc:html-table-append-row! table (list (gnc:multiline-to-html-text (or addy ""))))
+
(gnc:html-table-append-row!
table (list (gnc-print-time64 (current-time) date-format)))
table))
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 6c956d5df..dbec87511 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -627,24 +627,6 @@
(define (employee-options-generator)
(options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE #t))
-(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)))
-
(define (setup-query q owner account end-date)
(let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
@@ -675,16 +657,17 @@
'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/>")))
+ table (gnc:multiline-to-html-text (gnc:owner-get-name-and-address-dep owner)))
+
(gnc:html-table-append-row!
- table
- (list "<br/>"))
+ table (gnc:make-html-text (gnc:html-markup-br)))
+
(gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
+
table))
(define (make-date-row! table label date)
@@ -718,12 +701,14 @@
'attribute (list "cellspacing" 0)
'attribute (list "cellpadding" 0))
- (gnc:html-table-append-row! table (list (if name name "")))
- (gnc:html-table-append-row! table (list (string-expand
- (if addy addy "")
- #\newline "<br/>")))
+ (gnc:html-table-append-row! table (list (or name "")))
+
+ (gnc:html-table-append-row!
+ table (list (gnc:multiline-to-html-text (or addy ""))))
+
(gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format)))
+
table))
(define (make-break! document)
commit 3ee434edf6658fde0d79bceb0516e7789b6cd230
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 1 22:17:37 2019 +0800
[new-aging] use gnc:html-markup-ol
diff --git a/gnucash/report/business-reports/new-aging.scm b/gnucash/report/business-reports/new-aging.scm
index cd5362a99..5f0f8ba5a 100644
--- a/gnucash/report/business-reports/new-aging.scm
+++ b/gnucash/report/business-reports/new-aging.scm
@@ -225,10 +225,6 @@ exist but have no suitable transactions."))
((if (eq? sort-order 'increasing) string<? string>?)
(gncOwnerGetName a) (gncOwnerGetName b)))
- (define (html-markup-ol lst)
- (apply gnc:html-markup "ol"
- (map (lambda (elt) (gnc:html-markup "li" elt)) lst)))
-
;; set default title
(gnc:html-document-set-title! document report-title)
@@ -340,7 +336,7 @@ exist but have no suitable transactions."))
document
(gnc:make-html-text
(_ "Please note some transactions were not processed")
- (html-markup-ol
+ (gnc:html-markup-ol
(map
(lambda (invalid-split)
(gnc:html-markup-anchor
commit 4aa17ef65bb0bd1cec3be632fc8af54769169431
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 1 22:17:19 2019 +0800
[html-text][API] gnc:html-markup-ol, gnc:multiline-to-html-text
* (gnc:html-markup-ol lst)
creates an ordered list
* gnc:multiline-to-html-text: creates html-text with <br/> elements
"line1\nline2\nline3" ->
(gnc:make-html-text "line1" (gnc:html-markup-br)
"line2" (gnc:html-markup-br)
"line3")
diff --git a/gnucash/report/report-system/html-text.scm b/gnucash/report/report-system/html-text.scm
index fd1f29ade..d34e2154b 100644
--- a/gnucash/report/report-system/html-text.scm
+++ b/gnucash/report/report-system/html-text.scm
@@ -182,6 +182,9 @@
(gnc:html-markup "li" obj))
items)))
+(define (gnc:html-markup-ol lst)
+ (apply gnc:html-markup "ol"
+ (map (lambda (elt) (gnc:html-markup "li" elt)) lst)))
(define (gnc:html-markup-anchor href . rest)
(apply gnc:html-markup/attr
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index a351038b0..cd0e32526 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -666,6 +666,7 @@
(export gnc:html-markup-h3)
(export gnc:html-markup-br)
(export gnc:html-markup-hr)
+(export gnc:html-markup-ol)
(export gnc:html-markup-ul)
(export gnc:html-markup-anchor)
(export gnc:html-markup-img)
@@ -744,6 +745,7 @@
(export gnc:get-assoc-account-balances)
(export gnc:select-assoc-account-balance)
(export gnc:get-assoc-account-balances-total)
+(export gnc:multiline-to-html-text)
(export make-file-url)
(export gnc:strify)
(export gnc:pk)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index f2cfaad44..75b5afb06 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1109,6 +1109,16 @@ flawed. see report-utilities.scm. please update reports.")
account-balances)
total))
+(define (gnc:multiline-to-html-text str)
+ ;; simple function - splits string containing #\newline into
+ ;; substrings, and convert to a gnc:make-html-text construct which
+ ;; adds gnc:html-markup-br after each substring.
+ (let loop ((list-of-substrings (string-split str #\newline))
+ (result '()))
+ (if (null? list-of-substrings)
+ (apply gnc:make-html-text (if (null? result) '() (reverse (cdr result))))
+ (loop (cdr list-of-substrings)
+ (cons* (gnc:html-markup-br) (car list-of-substrings) result)))))
;; ***************************************************************************
;; Business Functions
commit a52d60f48e738ee4c91bfa03887dea1014f104fa
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 1 22:30:45 2019 +0800
[business-reports] compact gnc:owner-report-text
diff --git a/gnucash/report/business-reports/business-reports.scm b/gnucash/report/business-reports/business-reports.scm
index 7c50821a9..a9bb791ec 100644
--- a/gnucash/report/business-reports/business-reports.scm
+++ b/gnucash/report/business-reports/business-reports.scm
@@ -71,29 +71,17 @@
(define (gnc:owner-report-text owner acc)
(let* ((end-owner (gncOwnerGetEndOwner owner))
- (type (gncOwnerGetType end-owner))
- (ref #f))
-
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER)
- (set! ref "owner=c:"))
-
- ((eqv? type GNC-OWNER-VENDOR)
- (set! ref "owner=v:"))
-
- ((eqv? type GNC-OWNER-EMPLOYEE)
- (set! ref "owner=e:"))
-
- (else (set! ref "unknown-type=")))
-
- (if ref
- (begin
- (set! ref (string-append ref (gncOwnerReturnGUID end-owner)))
- (if (not (null? acc))
- (set! ref (string-append ref "&acct="
- (gncAccountGetGUID acc))))
- (gnc-build-url URL-TYPE-OWNERREPORT ref ""))
- ref)))
+ (type (gncOwnerGetType end-owner)))
+ (gnc-build-url
+ URL-TYPE-OWNERREPORT
+ (string-append
+ (cond ((eqv? type GNC-OWNER-CUSTOMER) "owner=c:")
+ ((eqv? type GNC-OWNER-VENDOR) "owner=v:")
+ ((eqv? type GNC-OWNER-EMPLOYEE) "owner=e:")
+ (else "unknown-type="))
+ (gncOwnerReturnGUID end-owner)
+ (if (null? acc) "" (string-append "&acct=" (gncAccountGetGUID acc))))
+ "")))
;; Creates a new report instance for the given invoice. The given
;; report-template-id must refer to an existing report template, which
commit df1f033f4156c3a3b068591350c0156f74711868
Author: Geert Janssens <geert at kobaltwit.be>
Date: Sat Nov 30 13:20:08 2019 +0100
bindings-python - drop references to gnucash-env
We no longer ship a gnucash-env script, directly use python(3) instead
diff --git a/bindings/python/example_scripts/account_analysis.py b/bindings/python/example_scripts/account_analysis.py
index fe51e8d7b..135d2e60e 100644
--- a/bindings/python/example_scripts/account_analysis.py
+++ b/bindings/python/example_scripts/account_analysis.py
@@ -38,7 +38,7 @@ import csv
from gnucash import Session, GncNumeric, Split
# Invoke this script like the following example
-# $ gnucash-env python account_analysis.py gnucash_file.gnucash \
+# $ python3 account_analysis.py gnucash_file.gnucash \
# 2010 1 monthly 12 \
# debits-show credits-show Assets 'Test Account'
#
@@ -156,9 +156,9 @@ def main():
print('usage: account_analysis.py {book url} {start year} {start month, numeric} {period type: monthly, quarterly, or yearly} {number of periods to show, from start year and month} {whether to show debits: debits-show for true, all other values false} {whether to show credits: credits-show for true, all other values false} {space separated account path, as many nested levels as desired} ')
print('examples:\n')
print("The following example analyzes 12 months of 'Assets:Test Account' from /home/username/test.gnucash, starting in January of 2010, and shows both credits and debits")
- print("gnucash-env python account_analysis.py '/home/username/test.gnucash' 2010 1 monthly 12 debits-show credits-show Assets 'Test Account'\n")
+ print("python3 account_analysis.py '/home/username/test.gnucash' 2010 1 monthly 12 debits-show credits-show Assets 'Test Account'\n")
print("The following example analyzes 2 quarters of 'Liabilities:First Level:Second Level' from /home/username/test.gnucash, starting March 2011, and shows credits but not debits")
- print("gnucash-env python account_analysis.py '/home/username/test.gnucash' 2011 3 quarterly 2 debits-noshow credits-show Liabilities 'First Level' 'Second Level")
+ print("python3 account_analysis.py '/home/username/test.gnucash' 2011 3 quarterly 2 debits-noshow credits-show Liabilities 'First Level' 'Second Level")
return
try:
diff --git a/bindings/python/example_scripts/new_book_with_opening_balances.py b/bindings/python/example_scripts/new_book_with_opening_balances.py
index 7c7ee4c45..df2d29ae7 100644
--- a/bindings/python/example_scripts/new_book_with_opening_balances.py
+++ b/bindings/python/example_scripts/new_book_with_opening_balances.py
@@ -51,11 +51,11 @@ from datetime import date
# mutual, and trading, you'll have to put the opening balance in yourself
#
# Invocation examples:
-# gnucash-env python new_book_with_opening_balances.py \
+# python3 new_book_with_opening_balances.py \
# '/home/mark/test.gnucash'
# 'sqlite3:///home/mark/new_test.gnucash'
#
-# gnucash-env python new_book_with_opening_balances.py \
+# python3 new_book_with_opening_balances.py \
# '/home/mark/test.gnucash' \
# 'xml:///crypthome/mark/parit-financial-system/new_test.gnucash'
#
@@ -293,8 +293,8 @@ def main():
print('not enough parameters')
print('usage: new_book_with_opening_balances.py {source_book_url} {destination_book_url}')
print('examples:')
- print("gnucash-env python new_book_with_opening_balances.py '/home/username/test.gnucash' 'sqlite3:///home/username/new_test.gnucash'")
- print("gnucash-env python new_book_with_opening_balances.py '/home/username/test.gnucash' 'xml:///crypthome/username/finances/new_test.gnucash'")
+ print("python3 new_book_with_opening_balances.py '/home/username/test.gnucash' 'sqlite3:///home/username/new_test.gnucash'")
+ print("python3 new_book_with_opening_balances.py '/home/username/test.gnucash' 'xml:///crypthome/username/finances/new_test.gnucash'")
return
#have everything in a try block to unable us to release our hold on stuff to the extent possible
diff --git a/bindings/python/example_scripts/priceDB_test.py b/bindings/python/example_scripts/priceDB_test.py
index 8ec671500..a1ce64784 100644
--- a/bindings/python/example_scripts/priceDB_test.py
+++ b/bindings/python/example_scripts/priceDB_test.py
@@ -5,8 +5,9 @@
# before running this.
# Adding to a calling bash script would be better
# Although calling it from here would be even better!
-# OR: export PYTHONPATH=$HOME/progs/lib/python2.6/site-packages
-# Then: gnucash-env ipython
+# OR: export PYTHONPATH=<path-to-gnucash-inst-dir>/lib/python3.7/site-packages:$PYTHONPATH
+# You may have to adjust the above path to your local system (lib->lib64, python3.7->...)
+# Then: ipython3
# The account file is not saved but always use a disposable copy.
# Change, FILE, CURRENCY and STOCK to those defined in your test account.
diff --git a/bindings/python/example_scripts/price_database_example.py b/bindings/python/example_scripts/price_database_example.py
index 49c5d28d9..2df02b5eb 100755
--- a/bindings/python/example_scripts/price_database_example.py
+++ b/bindings/python/example_scripts/price_database_example.py
@@ -5,8 +5,9 @@
# before running this.
# Adding to a calling bash script would be better
# Although calling it from here would be even better!
-# OR: export PYTHONPATH=$HOME/progs/lib/python2.6/site-packages
-# Then: gnucash-env ipython
+# OR: export PYTHONPATH=<path-to-gnucash-inst-dir>/lib/python3.7/site-packages:$PYTHONPATH
+# You may have to adjust the above path to your local system (lib->lib64, python3.7->...)
+# Then: ipython3
# The account file is not saved but always use a disposable copy.
# Thanks for contributions by Christoph Holtermann and Mark Jenkins
diff --git a/bindings/python/example_scripts/simple_business_create.py b/bindings/python/example_scripts/simple_business_create.py
index 22c5f87dc..bb00846df 100644
--- a/bindings/python/example_scripts/simple_business_create.py
+++ b/bindings/python/example_scripts/simple_business_create.py
@@ -24,7 +24,7 @@
# Creates a new book file (or *overwrites* an existing one) that has elements
# in it for business use -- intended as a demonstration program.
# Syntax:
-# gnucash-env python simple_business_create.py \
+# python3 simple_business_create.py \
# sqlite3:///home/blah/blah.gnucash
#
# Specifically, this sets up a simple tree, creates a customer, job,
@@ -65,7 +65,7 @@ if len(argv) < 2:
print('not enough parameters')
print('usage: simple_business_create.py {new_book_url}')
print('example:')
- print("gnucash-env python simple_business_create.py sqlite3:///home/blah/blah.gnucash")
+ print("python3 simple_business_create.py sqlite3:///home/blah/blah.gnucash")
exit()
diff --git a/bindings/python/example_scripts/simple_invoice_insert.py b/bindings/python/example_scripts/simple_invoice_insert.py
index 63633d72c..eef4c03ba 100644
--- a/bindings/python/example_scripts/simple_invoice_insert.py
+++ b/bindings/python/example_scripts/simple_invoice_insert.py
@@ -30,7 +30,7 @@
# this to become an invoice importer for your own books
#
# Syntax:
-# gnucash-env python simple_invoice_insert.py \
+# python3 simple_invoice_insert.py \
# /home/blah/blah.gnucash
# dda2ec8e3e63c7715097f852851d6b22 1001 'The Goods' 201.43
#
diff --git a/bindings/python/example_scripts/test_imbalance_transaction.py b/bindings/python/example_scripts/test_imbalance_transaction.py
index aa5eef0d4..a119bb730 100644
--- a/bindings/python/example_scripts/test_imbalance_transaction.py
+++ b/bindings/python/example_scripts/test_imbalance_transaction.py
@@ -45,7 +45,7 @@ if len(argv) < 2:
print('not enough parameters')
print('usage: test_imbalance_transaction.py {book_url}')
print('examples:')
- print("gnucash-env python test_imbalance_transaction.py '/home/username/test.gnucash'")
+ print("python3 test_imbalance_transaction.py '/home/username/test.gnucash'")
exit()
commit 0b11a073f0d2f14ea54dbec50ca18ca7d28b4d5f
Merge: c21bb66d6 34c14b44a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Nov 30 16:34:48 2019 +0800
Merge branch 'maint' of git://github.com/andrey-legayev/gnucash into maint
commit c21bb66d689972042c95694801f9932e8b982a97
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Nov 28 22:42:31 2019 +0800
[balsheet-pnl] refactor common account-balance-list adder
* use fold, more efficient, removes the need for intermediate list
(map cdr (filter filter-fn accounts-balances)): filter will create 1
intermediate list, which is passed as an argument to map which
creates the final list. using fold will remove the need for
intermediate list.
* list->vector for O(1) access
diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm
index 566c659e4..ac616febc 100644
--- a/gnucash/report/standard-reports/balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/balsheet-pnl.scm
@@ -909,6 +909,15 @@ also show overall period profit & loss."))
(maxindent (1+ (apply max (cons 0 (map gnc-account-get-current-depth
accounts))))))
+ (define (sum-balances-of-accounts alist accts adder)
+ (let ((balances
+ (fold (lambda (a b) (if (member (car a) accts) (cons (cdr a) b) b))
+ '() alist)))
+ (list->vector
+ (if (null? balances)
+ (map (const (adder)) report-dates)
+ (apply map adder balances)))))
+
(gnc:html-document-set-title!
doc (with-output-to-string
(lambda ()
@@ -952,33 +961,19 @@ also show overall period profit & loss."))
(split (vector-ref date-splits col-idx)))
(gnc:split-anchor-text split))))
- ;; a list of collectors whereby collector is the sum of
+ ;; a vector of collectors whereby collector is the sum of
;; asset and liabilities at report dates
(asset-liability-balances
- (let ((asset-liab-balances
- (map cdr (filter
- (lambda (acc-balances)
- (member (car acc-balances) asset-liability))
- accounts-balances))))
- (if (null? asset-liab-balances)
- (map (const (gnc:make-commodity-collector)) report-dates)
- (apply map gnc:monetaries-add asset-liab-balances))))
-
- ;; a list of collectors whereby collector is the sum of
+ (sum-balances-of-accounts
+ accounts-balances asset-liability gnc:monetaries-add))
+
+ ;; a vector of collectors whereby collector is the sum of
;; incomes and expenses at report dates
(income-expense-balances
- (let ((inc-exp-balances
- (map cdr
- (filter
- (lambda (acc-balances)
- (member (car acc-balances) income-expense))
- accounts-balances))))
- (if (null? inc-exp-balances)
- (map (const (gnc:make-commodity-collector)) report-dates)
- (map gnc:commodity-collector-get-negated
- (apply map gnc:monetaries-add inc-exp-balances)))))
-
- ;; an (cons account list-of-collectors) whereby each
+ (sum-balances-of-accounts
+ accounts-balances income-expense gnc:monetaries-add))
+
+ ;; an alist of (cons account list-of-collectors) whereby each
;; collector is the split-value-balances at report
;; dates. split-value-balance determined by transaction currency.
(accounts-value-balances
@@ -988,18 +983,12 @@ also show overall period profit & loss."))
(map col-datum-get-split-value-balance cols-data))))
accounts))
- ;; a list of collectors whereby each collector is the sum
+ ;; a vector of collectors whereby each collector is the sum
;; of asset and liability split-value-balances at report
;; dates
(asset-liability-value-balances
- (let ((asset-liab-value-balances
- (map cdr (filter
- (lambda (acc-balances)
- (member (car acc-balances) asset-liability))
- accounts-value-balances))))
- (if (null? asset-liab-value-balances)
- (map (const (gnc:make-commodity-collector)) report-dates)
- (apply map gnc:collector+ asset-liab-value-balances))))
+ (sum-balances-of-accounts
+ accounts-value-balances asset-liability gnc:collector+))
;; converts monetaries to common currency
(monetaries->exchanged
@@ -1024,9 +1013,9 @@ also show overall period profit & loss."))
((pricedb-latest) (current-time))
(else (list-ref report-dates col-idx))))
(asset-liability-balance
- (list-ref asset-liability-balances col-idx))
+ (vector-ref asset-liability-balances col-idx))
(asset-liability-basis
- (list-ref asset-liability-value-balances col-idx))
+ (vector-ref asset-liability-value-balances col-idx))
(unrealized (gnc:collector- asset-liability-basis
asset-liability-balance)))
(monetaries->exchanged
@@ -1041,7 +1030,7 @@ also show overall period profit & loss."))
((pricedb-latest) (current-time))
(else (list-ref report-dates col-idx))))
(income-expense-balance
- (list-ref income-expense-balances col-idx)))
+ (vector-ref income-expense-balances col-idx)))
(if (and common-currency
(every has-price?
(gnc:accounts-get-commodities income-expense #f)))
commit def0caa011c32fcb77d40d28527a4d6d174bc22c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Nov 28 12:29:47 2019 +0800
[balsheet-pnl] use and-let*, reindent
diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm
index f483120f5..566c659e4 100644
--- a/gnucash/report/standard-reports/balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/balsheet-pnl.scm
@@ -1019,18 +1019,18 @@ also show overall period profit & loss."))
;; converted to report currency.
(unrealized-gain-fn
(lambda (col-idx)
- (and common-currency
- (let* ((date (case price-source
- ((pricedb-latest) (current-time))
- (else (list-ref report-dates col-idx))))
- (asset-liability-balance
- (list-ref asset-liability-balances col-idx))
- (asset-liability-basis
- (list-ref asset-liability-value-balances col-idx))
- (unrealized (gnc:collector- asset-liability-basis
- asset-liability-balance)))
- (monetaries->exchanged
- unrealized common-currency price-source date)))))
+ (and-let* (common-currency
+ (date (case price-source
+ ((pricedb-latest) (current-time))
+ (else (list-ref report-dates col-idx))))
+ (asset-liability-balance
+ (list-ref asset-liability-balances col-idx))
+ (asset-liability-basis
+ (list-ref asset-liability-value-balances col-idx))
+ (unrealized (gnc:collector- asset-liability-basis
+ asset-liability-balance)))
+ (monetaries->exchanged
+ unrealized common-currency price-source date))))
;; the retained earnings calculator retrieves the
;; income-and-expense report-date balance, and converts
@@ -1052,26 +1052,30 @@ also show overall period profit & loss."))
gnc:monetary-neg
(income-expense-balance 'format gnc:make-gnc-monetary #f))))))
- (chart (and include-chart? incr
- (gnc:make-report-anchor
- networth-barchart-uuid report-obj
- (list (list "General" "Start Date" (cons 'absolute startdate))
- (list "General" "End Date" (cons 'absolute enddate))
- (list "General" "Report's currency"
- (or common-currency book-main-currency))
- (list "General" "Step Size" incr)
- (list "General" "Price Source"
- (or price-source 'pricedb-nearest))
- (list "Accounts" "Accounts" asset-liability)))))
- (get-col-header-fn (lambda (accounts col-idx)
- (let* ((date (list-ref report-dates col-idx))
- (header (qof-print-date date))
- (cell (gnc:make-html-table-cell/markup
- "total-label-cell" header)))
- (gnc:html-table-cell-set-style!
- cell "total-label-cell"
- 'attribute '("style" "text-align:right"))
- cell)))
+ (chart (and-let* (include-chart?
+ incr
+ (curr (or common-currency book-main-currency))
+ (price (or price-source 'pricedb-nearest)))
+ (gnc:make-report-anchor
+ networth-barchart-uuid report-obj
+ (list (list "General" "Start Date" (cons 'absolute startdate))
+ (list "General" "End Date" (cons 'absolute enddate))
+ (list "General" "Report's currency" curr)
+ (list "General" "Step Size" incr)
+ (list "General" "Price Source" price)
+ (list "Accounts" "Accounts" asset-liability)))))
+
+ (get-col-header-fn
+ (lambda (accounts col-idx)
+ (let* ((date (list-ref report-dates col-idx))
+ (header (qof-print-date date))
+ (cell (gnc:make-html-table-cell/markup
+ "total-label-cell" header)))
+ (gnc:html-table-cell-set-style!
+ cell "total-label-cell"
+ 'attribute '("style" "text-align:right"))
+ cell)))
+
(add-to-table (lambda* (table title accounts #:key
(get-col-header-fn #f)
(show-accounts? #t)
@@ -1170,6 +1174,7 @@ also show overall period profit & loss."))
(cons (car balancelist) (last balancelist))
(cons (list-ref balancelist idx)
(list-ref balancelist (1+ idx))))))
+
(closing-entries (let ((query (qof-query-create-for-splits)))
(qof-query-set-book query (gnc-get-current-book))
(xaccQueryAddAccountMatch
@@ -1183,6 +1188,7 @@ also show overall period profit & loss."))
(let ((splits (qof-query-run query)))
(qof-query-destroy query)
splits)))
+
;; this function will query the above closing-entries for
;; splits within the date range, and produce the total
;; amount for these closing entries
@@ -1198,52 +1204,49 @@ also show overall period profit & loss."))
(gnc:make-gnc-monetary
(xaccAccountGetCommodity account)
(apply + (map xaccSplitGetAmount account-closing-splits))))))
+
(get-cell-monetary-fn
(lambda (account col-idx)
- (let ((account-balance-list (assoc account accounts-balances)))
- (and account-balance-list
- (let ((monetarypair (col-idx->monetarypair
- (cdr account-balance-list)
- col-idx)))
- (monetary-less
- (cdr monetarypair)
- (car monetarypair)
- (closing-adjustment account col-idx)))))))
-
- (get-cell-anchor-fn (lambda (account col-idx)
- (define datepair (col-idx->datepair col-idx))
- (gnc:make-report-anchor
- trep-uuid report-obj
- (list
- (list "General" "Start Date"
- (cons 'absolute (car datepair)))
- (list "General" "End Date"
- (cons 'absolute (cdr datepair)))
- (list "General" "Show original currency amount"
- (and common-currency #t))
- (list "General" "Common Currency"
- common-currency)
- (list "General" "Report's currency"
- (or common-currency book-main-currency))
- (list "Display" "Amount" 'double)
- (list "Accounts" "Accounts"
- (if (pair? account)
- account
- (list account)))))))
-
- (chart (and include-chart?
- (gnc:make-report-anchor
- pnl-barchart-uuid report-obj
- (list (list "General" "Start Date"
- (cons 'absolute startdate))
- (list "General" "End Date"
- (cons 'absolute enddate))
- (list "General" "Report's currency"
- (or common-currency book-main-currency))
- (list "General" "Step Size" (or incr 'MonthDelta))
- (list "General" "Price Source"
- (or price-source 'pricedb-nearest))
- (list "Accounts" "Accounts" income-expense)))))
+ (let* ((balances (assoc-ref accounts-balances account))
+ (monetarypair (col-idx->monetarypair balances col-idx)))
+ (monetary-less
+ (cdr monetarypair)
+ (car monetarypair)
+ (closing-adjustment account col-idx)))))
+
+ (get-cell-anchor-fn
+ (lambda (account col-idx)
+ (let ((datepair (col-idx->datepair col-idx))
+ (show-orig? (and common-currency #t))
+ (curr (or common-currency book-main-currency))
+ (delta (or incr 'MonthDelta))
+ (price (or price-source 'pricedb-nearest))
+ (accts (if (pair? account) account (list account))))
+ (gnc:make-report-anchor
+ trep-uuid report-obj
+ (list
+ (list "General" "Start Date" (cons 'absolute (car datepair)))
+ (list "General" "End Date" (cons 'absolute (cdr datepair)))
+ (list "General" "Show original currency amount" show-orig?)
+ (list "General" "Common Currency" common-currency)
+ (list "General" "Report's currency" curr)
+ (list "Display" "Amount" 'double)
+ (list "Accounts" "Accounts" accts))))))
+
+ (chart
+ (and-let* (include-chart?
+ (curr (or common-currency book-main-currency))
+ (delta (or incr 'MonthDelta))
+ (price (or price-source 'pricedb-nearest)))
+ (gnc:make-report-anchor
+ pnl-barchart-uuid report-obj
+ (list (list "General" "Start Date" (cons 'absolute startdate))
+ (list "General" "End Date" (cons 'absolute enddate))
+ (list "General" "Report's currency" curr)
+ (list "General" "Step Size" delta)
+ (list "General" "Price Source" price)
+ (list "Accounts" "Accounts" income-expense)))))
+
(get-col-header-fn
(lambda (accounts col-idx)
(let* ((datepair (col-idx->datepair col-idx))
@@ -1258,6 +1261,7 @@ also show overall period profit & loss."))
cell "total-label-cell"
'attribute '("style" "text-align:right"))
cell)))
+
(add-to-table (lambda* (table title accounts #:key
(get-col-header-fn #f)
(show-accounts? #t)
commit e97b78df80251ef21eb268575ae80e08a0fd151e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Nov 28 22:41:47 2019 +0800
[balsheet-pnl] fix: single-date balsheet missed printing date
diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm
index 36804aabb..f483120f5 100644
--- a/gnucash/report/standard-reports/balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/balsheet-pnl.scm
@@ -917,7 +917,7 @@ also show overall period profit & loss."))
(if (or incr (eq? report-type 'pnl))
(format #t (_ "~a to ~a")
(qof-print-date startdate) (qof-print-date enddate))
- (qof-print-date enddate)))))
+ (display (qof-print-date enddate))))))
(if (eq? (get-option gnc:pagename-general optname-options-summary) 'always)
(gnc:html-document-add-object!
commit 54c4575f27a6b6033aac147ee542b2fc6943cc3a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Nov 28 12:17:34 2019 +0800
[balsheet-pnl] fix: hide Equity sections when not needed
* If currencies are not converted, Unrealized Gains are
meaningless. Hide them.
* If there are no income/expense accounts, retained earnings will be
nil. Remove row.
diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm
index d8a48d471..36804aabb 100644
--- a/gnucash/report/standard-reports/balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/balsheet-pnl.scm
@@ -1125,11 +1125,14 @@ also show overall period profit & loss."))
(add-to-table
multicol-table-right (_ "Equity")
(append equity-accounts
- (list
- (vector (_ "Unrealized Gains")
- unrealized-gain-fn)
- (vector (_ "Retained Earnings")
- retained-earnings-fn)))
+ (if common-currency
+ (list (vector (_ "Unrealized Gains")
+ unrealized-gain-fn))
+ '())
+ (if (null? income-expense)
+ '()
+ (list (vector (_ "Retained Earnings")
+ retained-earnings-fn))))
#:negate-amounts? #t)
(if (and common-currency show-rates?)
diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
index 9fa490a88..98e272c35 100644
--- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
@@ -497,7 +497,7 @@
"Root.Asset.House" "Total For Asset" "Liability" "Root.Liability"
"Root.Liability.Bank2" "Root.Liability.Bank2.CreditCard"
"Root.Liability.Bank2.Loan" "Total For Liability" "Equity" "Root.Equity"
- "Unrealized Gains" "Retained Earnings" "Total For Equity")
+ "Retained Earnings" "Total For Equity")
(sxml->table-row-col sxml 1 #f 1))
(test-equal "default balances"
'("#200.00" "$106,709.00" "30 FUNDS" "#200.00" "$106,709.00" "30 FUNDS"
commit 34c14b44a9f98035206465ab3543d43bc06ddd3d
Author: Andrey Legayev <andrey at ven.com>
Date: Fri Nov 29 18:32:50 2019 +0200
Remove not needed semicolons in Python bindings
diff --git a/bindings/python/example_scripts/rest-api/gnucash_simple.py b/bindings/python/example_scripts/rest-api/gnucash_simple.py
index 1bc56de02..2aa234f95 100644
--- a/bindings/python/example_scripts/rest-api/gnucash_simple.py
+++ b/bindings/python/example_scripts/rest-api/gnucash_simple.py
@@ -34,14 +34,14 @@ def addressToDict(address):
return None
else:
simple_address = {}
- simple_address['name'] = address.GetName();
- simple_address['line_1'] = address.GetAddr1();
- simple_address['line_2'] = address.GetAddr2();
- simple_address['line_3'] = address.GetAddr3();
- simple_address['line_4'] = address.GetAddr4();
- simple_address['phone'] = address.GetPhone();
- simple_address['fax'] = address.GetFax();
- simple_address['email'] = address.GetEmail();
+ simple_address['name'] = address.GetName()
+ simple_address['line_1'] = address.GetAddr1()
+ simple_address['line_2'] = address.GetAddr2()
+ simple_address['line_3'] = address.GetAddr3()
+ simple_address['line_4'] = address.GetAddr4()
+ simple_address['phone'] = address.GetPhone()
+ simple_address['fax'] = address.GetFax()
+ simple_address['email'] = address.GetEmail()
return simple_address
diff --git a/bindings/python/gnucash_core.py b/bindings/python/gnucash_core.py
index 9b1416f9d..c7a7901e4 100644
--- a/bindings/python/gnucash_core.py
+++ b/bindings/python/gnucash_core.py
@@ -619,7 +619,7 @@ methods_return_instance(GncLot, gnclot_dict)
# Transaction
Transaction.add_methods_with_prefix('xaccTrans')
-Transaction.add_method('gncTransGetGUID', 'GetGUID');
+Transaction.add_method('gncTransGetGUID', 'GetGUID')
Transaction.add_method('xaccTransGetDescription', 'GetDescription')
Transaction.add_method('xaccTransDestroy', 'Destroy')
@@ -648,7 +648,7 @@ Transaction.decorate_functions(
# Split
Split.add_methods_with_prefix('xaccSplit')
-Split.add_method('gncSplitGetGUID', 'GetGUID');
+Split.add_method('gncSplitGetGUID', 'GetGUID')
Split.add_method('xaccSplitDestroy', 'Destroy')
split_dict = {
@@ -677,7 +677,7 @@ Split.parent = property( Split.GetParent, Split.SetParent )
# Account
Account.add_methods_with_prefix('xaccAccount')
Account.add_methods_with_prefix('gnc_account_')
-Account.add_method('gncAccountGetGUID', 'GetGUID');
+Account.add_method('gncAccountGetGUID', 'GetGUID')
Account.add_method('xaccAccountGetPlaceholder', 'GetPlaceholder')
account_dict = {
commit 7853f5a24a4ed6e5cf32fdf6e5eba217a1e312cd
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Nov 28 09:17:59 2019 -0800
Ignore trailing noise on imported transaction account numbers.
AQBanking6 uses a separate method for retrieving account numbers
for account info and transactions, where the transactions method can
have additional characters, most often the ISO4217 currency code. That
results in match failures when importing.
As a work-around, compare only the length of the account-info-generated
online id when comparing it to the transaction-generated one.
Note that this is only a partial solution: At least one German bank
also appends characters to the transaction-generated bank id and that
will still cause the match to fail.
diff --git a/gnucash/import-export/import-account-matcher.c b/gnucash/import-export/import-account-matcher.c
index 0837150d4..7cbbcd7bb 100644
--- a/gnucash/import-export/import-account-matcher.c
+++ b/gnucash/import-export/import-account-matcher.c
@@ -86,7 +86,8 @@ static gpointer test_acct_online_id_match(Account *acct, gpointer param_online_i
const gchar * current_online_id = gnc_import_get_acc_online_id(acct);
if ( (current_online_id != NULL
&& param_online_id != NULL )
- && strcmp( current_online_id, param_online_id ) == 0 )
+ && strncmp( current_online_id, param_online_id,
+ strlen( current_online_id ) ) == 0 )
{
return (gpointer *) acct;
}
commit 1af8e272c7603cd08bad11a2f9374e234710783c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Nov 26 21:33:33 2019 +0800
[balsheet-pnl] unrealized-gain calculator is now much faster.
Previous code would call gnc:account-get-comm-value-at-date for each
report-date; this function generates qof-query, retrieves account
splits, scans them to accumulate split->transaction->currency and
split->value into a commodity collector.
This commit will hook into the existing gnc:account-accumulate
function, accumulating the same split->transaction->currency and
split->value into a collector.
Note we must make a copy of the accumulator at each report-date
via (gnc:collector+ val-coll) otherwise the same val-coll will be
mutated through subsequent splits.
For a multicolumn balsheet, for every account with N old splits, and
reporting on M report dates, it would run in O(N*M) time. This
algorithm will hook into existing accumulator, i.e. I think O(1).
The majority speed-up however comes from avoiding M qof-queries per
report.
diff --git a/gnucash/report/standard-reports/balsheet-pnl.scm b/gnucash/report/standard-reports/balsheet-pnl.scm
index de0d44e49..d8a48d471 100644
--- a/gnucash/report/standard-reports/balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/balsheet-pnl.scm
@@ -38,10 +38,11 @@
;; the column-data record. the gnc:account-accumulate-at-dates will
;; create a record for each report-date with split-data as follows:
(define-record-type :col-datum
- (make-datum last-split split-balance)
+ (make-datum last-split split-balance split-value-balance)
col-datum?
(last-split col-datum-get-last-split)
- (split-balance col-datum-get-split-balance))
+ (split-balance col-datum-get-split-balance)
+ (split-value-balance col-datum-get-split-value-balance))
(define FOOTER-TEXT
(gnc:make-html-text
@@ -785,14 +786,20 @@ also show overall period profit & loss."))
(map
(lambda (acc)
(let* ((comm (xaccAccountGetCommodity acc))
+ (val-coll (gnc:make-commodity-collector))
(amt->monetary (lambda (amt) (gnc:make-gnc-monetary comm amt))))
(cons acc
(gnc:account-accumulate-at-dates
acc report-dates
- #:nosplit->elt (make-datum #f (amt->monetary 0))
+ #:nosplit->elt (make-datum #f (amt->monetary 0)
+ (gnc:make-commodity-collector))
#:split->elt
(lambda (s)
- (make-datum s (amt->monetary (xaccSplitGetBalance s))))))))
+ (val-coll 'add
+ (xaccTransGetCurrency (xaccSplitGetParent s))
+ (xaccSplitGetValue s))
+ (make-datum s (amt->monetary (xaccSplitGetBalance s))
+ (gnc:collector+ val-coll)))))))
accounts))
;; an alist of (cons account account-balances) whereby
@@ -945,6 +952,8 @@ also show overall period profit & loss."))
(split (vector-ref date-splits col-idx)))
(gnc:split-anchor-text split))))
+ ;; a list of collectors whereby collector is the sum of
+ ;; asset and liabilities at report dates
(asset-liability-balances
(let ((asset-liab-balances
(map cdr (filter
@@ -955,6 +964,8 @@ also show overall period profit & loss."))
(map (const (gnc:make-commodity-collector)) report-dates)
(apply map gnc:monetaries-add asset-liab-balances))))
+ ;; a list of collectors whereby collector is the sum of
+ ;; incomes and expenses at report dates
(income-expense-balances
(let ((inc-exp-balances
(map cdr
@@ -967,6 +978,30 @@ also show overall period profit & loss."))
(map gnc:commodity-collector-get-negated
(apply map gnc:monetaries-add inc-exp-balances)))))
+ ;; an (cons account list-of-collectors) whereby each
+ ;; collector is the split-value-balances at report
+ ;; dates. split-value-balance determined by transaction currency.
+ (accounts-value-balances
+ (map
+ (lambda (acc)
+ (cons acc (let ((cols-data (assoc-ref accounts-cols-data acc)))
+ (map col-datum-get-split-value-balance cols-data))))
+ accounts))
+
+ ;; a list of collectors whereby each collector is the sum
+ ;; of asset and liability split-value-balances at report
+ ;; dates
+ (asset-liability-value-balances
+ (let ((asset-liab-value-balances
+ (map cdr (filter
+ (lambda (acc-balances)
+ (member (car acc-balances) asset-liability))
+ accounts-value-balances))))
+ (if (null? asset-liab-value-balances)
+ (map (const (gnc:make-commodity-collector)) report-dates)
+ (apply map gnc:collector+ asset-liab-value-balances))))
+
+ ;; converts monetaries to common currency
(monetaries->exchanged
(lambda (monetaries target-currency price-source date)
(let ((exchange-fn (gnc:case-exchange-fn
@@ -978,6 +1013,10 @@ also show overall period profit & loss."))
(exchange-fn mon target-currency))
(monetaries 'format gnc:make-gnc-monetary #f)))))))
+ ;; the unrealized gain calculator retrieves the
+ ;; asset-and-liability report-date balance and
+ ;; value-balance, and calculates the difference,
+ ;; converted to report currency.
(unrealized-gain-fn
(lambda (col-idx)
(and common-currency
@@ -987,14 +1026,15 @@ also show overall period profit & loss."))
(asset-liability-balance
(list-ref asset-liability-balances col-idx))
(asset-liability-basis
- (gnc:accounts-get-comm-total-assets
- asset-liability
- (lambda (acc)
- (gnc:account-get-comm-value-at-date acc date #f))))
+ (list-ref asset-liability-value-balances col-idx))
(unrealized (gnc:collector- asset-liability-basis
asset-liability-balance)))
(monetaries->exchanged
unrealized common-currency price-source date)))))
+
+ ;; the retained earnings calculator retrieves the
+ ;; income-and-expense report-date balance, and converts
+ ;; to report currency.
(retained-earnings-fn
(lambda (col-idx)
(let* ((date (case price-source
commit ff298b365f83346e68638abf530d022e8367c459
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Nov 26 18:18:14 2019 +0800
[test-balsheet-pnl] add multicol-balsheet and multicol-pnl tests
This commit adds tests for multicolumn balance-sheet and
income-statement. It mainly tests:
* multiple periods
* unrealized gains calculators
* amounts/balances are predictable
diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
index 1ffdf1e6a..9fa490a88 100644
--- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
@@ -3,6 +3,8 @@
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report standard-reports balance-sheet))
(use-modules (gnucash report standard-reports income-statement))
+(use-modules (gnucash report standard-reports balsheet-pnl))
+(use-modules (gnucash report standard-reports transaction))
(use-modules (gnucash report stylesheets))
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
@@ -15,6 +17,8 @@
(define balance-sheet-uuid "c4173ac99b2b448289bf4d11c731af13")
(define pnl-uuid "0b81a3bdfd504aff849ec2e8630524bc")
+(define multicol-balsheet-uuid "065d5d5a77ba11e8b31e83ada73c5eea")
+(define multicol-pnl-uuid "0e94fd0277ba11e8825d43e27232c9d4")
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
@@ -26,6 +30,8 @@
(create-test-data)
(balance-sheet-tests)
(pnl-tests)
+ (multicol-balsheet-tests)
+ (multicol-pnl-tests)
(test-end "balsheet and profit&loss"))
(define (options->sxml uuid options test-title)
@@ -465,3 +471,113 @@
;;make-multilevel
(set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
(set-option! pnl-options "Display" "Parent account subtotals" 't)))
+
+(define (multicol-balsheet-tests)
+ (define (default-testing-options)
+ (let ((options (gnc:make-report-options multicol-balsheet-uuid)))
+ (set-option! options "General" "Start Date"
+ (cons 'absolute (gnc-dmy2time64 1 1 1970)))
+ (set-option! options "General" "End Date"
+ (cons 'absolute (gnc-dmy2time64 1 1 1972)))
+ (set-option! options "General" "Enable dual columns" #f)
+ (set-option! options "General" "Disable amount indenting" #t)
+ (set-option! options "Display" "Account full name instead of indenting" #t)
+ (set-option! options "Accounts" "Levels of Subaccounts" 'all)
+ (set-option! options "Commodities" "Show Exchange Rates" #t)
+ options))
+ (display "\n\n multicol-balsheet tests\n\n")
+ (let* ((multi-bs-options (default-testing-options))
+ (sxml (options->sxml multicol-balsheet-uuid multi-bs-options
+ "multicol-balsheet-default")))
+ (test-equal "default row headers"
+ '("Asset" "Root" "Root.Asset" "Root.Asset.Bank1" "Root.Asset.Bank1.Bonds"
+ "Root.Asset.Bank1.Current" "Root.Asset.Bank1.Empty" "Root.Asset.Bank1.Savings"
+ "Root.Asset.Broker" "Root.Asset.Broker" "Root.Asset.Broker.Funds"
+ "Root.Asset.ForeignBank" "Root.Asset.ForeignBank.ForeignSavings"
+ "Root.Asset.House" "Total For Asset" "Liability" "Root.Liability"
+ "Root.Liability.Bank2" "Root.Liability.Bank2.CreditCard"
+ "Root.Liability.Bank2.Loan" "Total For Liability" "Equity" "Root.Equity"
+ "Unrealized Gains" "Retained Earnings" "Total For Equity")
+ (sxml->table-row-col sxml 1 #f 1))
+ (test-equal "default balances"
+ '("#200.00" "$106,709.00" "30 FUNDS" "#200.00" "$106,709.00" "30 FUNDS"
+ "$4,709.00" "$2,000.00" "$2,609.00" "$0.00" "$100.00" "$2,000.00"
+ "30 FUNDS" "$2,000.00" "30 FUNDS" "#200.00" "#200.00" "$100,000.00"
+ "30 FUNDS" "#200.00" "$106,709.00" "$9,500.00" "$9,500.00" "$500.00"
+ "$9,000.00" "$9,500.00" "$103,600.00" "$0.00" "#0.00" "$103,600.00"
+ "#0.00")
+ (sxml->table-row-col sxml 1 #f 2))
+
+ ;; the following tests many parts of multicolumn balance sheet:
+ ;; multiple-dates balances, unrealized-gain calculator, pricelists
+ (set-option! multi-bs-options "General" "Period duration" 'YearDelta)
+ (set-option! multi-bs-options "Commodities" "Common Currency" #t)
+ (set-option! multi-bs-options "Commodities" "Report's currency" USD)
+ (let ((sxml (options->sxml multicol-balsheet-uuid multi-bs-options
+ "multicol-balsheet-halfyear")))
+ (test-equal "bal-1/1/70"
+ '("01/01/70" "$113,100.00" "$113,100.00" "$8,970.00" "$2,000.00" "$6,870.00"
+ "$0.00" "$100.00" "$4,000.00" "$2,000.00" "$2,000.00" "10 FUNDS " "$130.00"
+ "$130.00" "#100.00 " "$100,000.00" "$113,100.00" "$9,500.00" "$9,500.00"
+ "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$0.00" "$0.00"
+ "$103,600.00" "1 FUNDS $200.00" "#1.00 $1.30")
+ (sxml->table-row-col sxml 1 #f 2))
+ (test-equal "bal-1/1/71"
+ '("01/01/71" "$116,009.00" "$116,009.00" "$4,709.00" "$2,000.00" "$2,609.00"
+ "$0.00" "$100.00" "$11,000.00" "$2,000.00" "$9,000.00" "30 FUNDS " "$300.00"
+ "$300.00" "#200.00 " "$100,000.00" "$116,009.00" "$9,500.00" "$9,500.00"
+ "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$2,909.00" "$0.00"
+ "$106,509.00" "1 FUNDS $300.00" "#1.00 $1.50")
+ (sxml->table-row-col sxml 1 #f 3))
+ (test-equal "bal-1/1/72"
+ '("01/01/72" "$117,529.00" "$117,529.00" "$4,709.00" "$2,000.00" "$2,609.00"
+ "$0.00" "$100.00" "$12,500.00" "$2,000.00" "$10,500.00" "30 FUNDS " "$320.00"
+ "$320.00" "#200.00 " "$100,000.00" "$117,529.00" "$9,500.00" "$9,500.00"
+ "$500.00" "$9,000.00" "$9,500.00" "$103,600.00" "$4,429.00" "$0.00"
+ "$108,029.00" "1 FUNDS $350.00" "#1.00 $1.60")
+ (sxml->table-row-col sxml 1 #f 4)))))
+
+(define (multicol-pnl-tests)
+ (define (default-testing-options)
+ (let ((options (gnc:make-report-options multicol-pnl-uuid)))
+ (set-option! options "General" "Start Date"
+ (cons 'absolute (gnc-dmy2time64 1 1 1980)))
+ (set-option! options "General" "End Date"
+ (cons 'absolute (gnc-dmy2time64 31 3 1980)))
+ (set-option! options "General" "Enable dual columns" #f)
+ (set-option! options "General" "Disable amount indenting" #t)
+ (set-option! options "Display" "Account full name instead of indenting" #t)
+ (set-option! options "Accounts" "Levels of Subaccounts" 'all)
+ (set-option! options "Commodities" "Show Exchange Rates" #t)
+ options))
+ (display "\n\n multicol-pnl tests\n\n")
+ (let* ((multi-bs-options (default-testing-options))
+ (sxml (options->sxml multicol-pnl-uuid multi-bs-options
+ "multicol-pnl-default")))
+ (test-equal "default row headers"
+ '("Income" "Root.Income" "Root.Income" "Root.Income.Income-GBP"
+ "Total For Income")
+ (sxml->table-row-col sxml 1 #f 1))
+ (test-equal "default pnl"
+ '("$250.00" "#600.00" "$250.00" "#600.00" "$250.00" "#600.00")
+ (sxml->table-row-col sxml 1 #f 2))
+
+ ;; the following tests many parts of multicolumn pnl:
+ ;; multiple-dates pnl
+ (set-option! multi-bs-options "General" "Period duration" 'MonthDelta)
+ (set-option! multi-bs-options "Commodities" "Common Currency" #t)
+ (set-option! multi-bs-options "Commodities" "Report's currency" USD)
+ (let ((sxml (options->sxml multicol-pnl-uuid multi-bs-options
+ "multicol-pnl-halfyear")))
+ (test-equal "pnl-1/80"
+ '("01/01/80" " to 01/31/80" "$1,100.00" "$250.00" "$850.00" "#500.00 "
+ "$1,100.00" "#1.00 $1.70")
+ (sxml->table-row-col sxml 1 #f 2))
+ (test-equal "pnl-2/80"
+ '("02/01/80" " to 02/29/80" "$170.00" "$0.00" "$170.00" "#100.00 "
+ "$170.00" "#1.00 $1.70")
+ (sxml->table-row-col sxml 1 #f 3))
+ (test-equal "pnl-3/80"
+ '("03/01/80" " to 03/31/80" "$0.00" "$0.00" "$0.00" "#0.00 "
+ "$0.00" "#1.00 $1.70")
+ (sxml->table-row-col sxml 1 #f 4)))))
commit 88644451ef29089c139a3ca643d3e5fbda04f4b6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Nov 26 18:11:15 2019 +0800
[test-balsheet-pnl] separate balance-sheet and pnl tests
This is in preparation for balsheet-pnl tests. Note all tests use same
data -- there's no (teardown).
diff --git a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
index 8fed4fac5..1ffdf1e6a 100644
--- a/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
+++ b/gnucash/report/standard-reports/test/test-balsheet-pnl.scm
@@ -23,7 +23,9 @@
(test-runner-factory gnc:test-runner)
(test-begin "balsheet and profit&loss")
(null-test)
- (balsheet-pnl-tests)
+ (create-test-data)
+ (balance-sheet-tests)
+ (pnl-tests)
(test-end "balsheet and profit&loss"))
(define (options->sxml uuid options test-title)
@@ -80,7 +82,7 @@
(let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
(test-assert "null-test" (options->sxml balance-sheet-uuid balance-sheet-options "null-test"))))
-(define (balsheet-pnl-tests)
+(define (create-test-data)
;; This function will perform implementation testing on the transaction report.
(let* ((env (create-test-env))
(account-alist (env-create-account-structure-alist env structure))
@@ -95,23 +97,7 @@
(bank2creditcard (cdr (assoc "CreditCard" account-alist)))
(equity (cdr (assoc "Equity" account-alist)))
(income (cdr (assoc "Income" account-alist)))
- (income-GBP (cdr (assoc "Income-GBP" account-alist)))
- (YEAR (gnc:time64-get-year (gnc:get-today))))
-
- (define (default-balsheet-testing-options)
- (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
- (set-option! balance-sheet-options "General" "Balance Sheet Date" (cons 'absolute (gnc-dmy2time64 1 1 1971)))
- (set-option! balance-sheet-options "Accounts" "Levels of Subaccounts" 'all)
- (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t)
- balance-sheet-options))
-
- (define (default-pnl-testing-options)
- (let ((pnl-options (gnc:make-report-options pnl-uuid)))
- (set-option! pnl-options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1980)))
- (set-option! pnl-options "General" "End Date" (cons 'absolute (gnc-dmy2time64 1 1 1981)))
- (set-option! pnl-options "Accounts" "Levels of Subaccounts" 'all)
- (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
- pnl-options))
+ (income-GBP (cdr (assoc "Income-GBP" account-alist))))
;; $100 in Savings account
(env-transfer env 01 01 1970 equity bank1savings 100)
@@ -169,300 +155,313 @@
;; a couple INCOME transactions, a decade later
(env-transfer env 01 01 1980 income bank1current 250)
(env-transfer env 01 01 1980 income-GBP foreignsavings 500)
- (env-transfer-foreign env 01 02 1980 income-GBP bank1current 100 170 #:description "earn 100GBP into $170")
+ (env-transfer-foreign env 01 02 1980 income-GBP bank1current 100 170 #:description "earn 100GBP into $170")))
- ;; Finally we can begin testing balsheet
- (display "\n\n balsheet tests\n\n")
- (let* ((balance-sheet-options (default-balsheet-testing-options))
- (sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-default")))
- (test-equal "total assets = $116,009"
- (list "$116,009.00")
- (sxml->table-row-col sxml 1 15 6))
- (test-equal "total liabilities = $9,500.00"
- (list "$9,500.00")
- (sxml->table-row-col sxml 1 23 6))
- (test-equal "total equity = $106,509.00"
- (list "$106,509.00")
- (sxml->table-row-col sxml 1 28 6))
-
- (set-option! balance-sheet-options "Commodities" "Price Source" 'weighted-average)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-weighted-average")))
- (test-equal "weighted average assets = $114,071.66"
- (list "$114,071.66")
- (sxml->table-row-col sxml 1 15 6)))
-
- (set-option! balance-sheet-options "Commodities" "Price Source" 'average-cost)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-average-cost")))
- (test-equal "average-cost assets = $113,100"
- (list "$113,100.00")
- (sxml->table-row-col sxml 1 15 6)))
-
- (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-nearest)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-nearest")))
- (test-equal "pricedb-nearest assets = $116,009"
- (list "$116,009.00")
- (sxml->table-row-col sxml 1 15 6)))
-
- (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-latest)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-latest")))
- (test-equal "pricedb-latest assets = $122,049"
- (list "$122,049.00")
- (sxml->table-row-col sxml 1 15 6)))
-
- ;; set multilevel subtotal style
- ;; verifies amount in EVERY line of the report.
- (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
- (set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-multilevel")))
- (test-equal "multilevel. root = $0.00"
- (list "$0.00")
- (sxml->table-row-col sxml 1 3 6))
- (test-equal "multilevel. assets = $0.00"
- (list "$0.00")
- (sxml->table-row-col sxml 1 4 5))
- (test-equal "multilevel. bank1 = $0.00"
- (list "$0.00")
- (sxml->table-row-col sxml 1 5 4))
- (test-equal "multilevel. bonds = $2,000.00"
- (list "$2,000.00")
- (sxml->table-row-col sxml 1 6 3))
- (test-equal "multilevel. current = $2609.00"
- (list "$2,609.00")
- (sxml->table-row-col sxml 1 7 3))
- (test-equal "multilevel. empty = $0.00"
- (list "$0.00")
- (sxml->table-row-col sxml 1 8 3))
- (test-equal "multilevel. savings = $100.00"
- (list "$100.00")
- (sxml->table-row-col sxml 1 9 3))
- (test-equal "multilevel. total bank1 = $4709"
- (list "$4,709.00")
- (sxml->table-row-col sxml 1 10 4))
- (test-equal "multilevel. broker = $2,000.00"
- (list "$2,000.00")
- (sxml->table-row-col sxml 1 11 4))
- (test-equal "multilevel. funds = $15,000.00"
- (list "30 FUNDS" "$15,000.00" "$15,000.00")
- (sxml->table-row-col sxml 1 12 3))
- (test-equal "multilevel. total broker = $17,000.00"
- (list "$17,000.00")
- (sxml->table-row-col sxml 1 13 4))
- (test-equal "multilevel. foreign = $0.00"
- (list "$0.00")
- (sxml->table-row-col sxml 1 14 4))
- (test-equal "multilevel. foreignsavings = #200.00 = $340"
- (list "#200.00" "$340.00" "$340.00")
- (sxml->table-row-col sxml 1 15 3))
- (test-equal "multilevel. total foreign = $340"
- (list "$340.00")
- (sxml->table-row-col sxml 1 16 4))
- (test-equal "multilevel. house = $100,000"
- (list "$100,000.00")
- (sxml->table-row-col sxml 1 17 4))
- (test-equal "multilevel. total asset = $122,049"
- (list "$122,049.00")
- (sxml->table-row-col sxml 1 18 5))
- (test-equal "multilevel. total root = $122,049"
- (list "$122,049.00")
- (sxml->table-row-col sxml 1 19 6))
- (test-equal "multilevel. total assets = $122,049"
- (list "$122,049.00")
- (sxml->table-row-col sxml 1 20 6)))
-
- ;; set recursive-subtotal subtotal style
- (set-option! balance-sheet-options "Display" "Parent account balances" 'recursive-bal)
- (set-option! balance-sheet-options "Display" "Parent account subtotals" 'f)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-recursive")))
- (test-equal "recursive. root = $760+15000+104600"
- (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
- (sxml->table-row-col sxml 1 3 6))
- (test-equal "recursive. assets = $760+15000+104600"
- (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
- (sxml->table-row-col sxml 1 4 5))
- (test-equal "recursive. bank1 = $4,709.00"
- (list "$4,709.00")
- (sxml->table-row-col sxml 1 5 4))
- (test-equal "recursive. bonds = $2,000.00"
- (list "$2,000.00")
- (sxml->table-row-col sxml 1 6 3))
- (test-equal "recursive. current = $2609.00"
- (list "$2,609.00")
- (sxml->table-row-col sxml 1 7 3))
- (test-equal "recursive. empty = $0.00"
- (list "$0.00")
- (sxml->table-row-col sxml 1 8 3))
- (test-equal "recursive. savings = $100.00"
- (list "$100.00")
- (sxml->table-row-col sxml 1 9 3))
- (test-equal "recursive. broker = $15000+2000.00"
- (list "30 FUNDS" "$15,000.00" "$2,000.00" "$2,000.00")
- (sxml->table-row-col sxml 1 10 4))
- (test-equal "recursive. funds = $15,000.00"
- (list "30 FUNDS" "$15,000.00" "$15,000.00")
- (sxml->table-row-col sxml 1 11 3))
- (test-equal "recursive. foreign = $340.00"
- (list "#200.00" "$340.00")
- (sxml->table-row-col sxml 1 12 4))
- (test-equal "recursive. foreignsavings = #200.00 = $340"
- (list "#200.00" "$340.00" "$340.00")
- (sxml->table-row-col sxml 1 13 3))
- (test-equal "recursive. house = $100,000"
- (list "$100,000.00")
- (sxml->table-row-col sxml 1 14 4))
- (test-equal "recursive. total assets = $122,049.00"
- (list "$122,049.00")
- (sxml->table-row-col sxml 1 15 6)))
-
- (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #f)
- (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #f)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-disable show-fcur show-rates")))
- (test-equal "show-fcur disabled"
- (list "$122,049.00")
- (sxml->table-row-col sxml 1 3 6))
- (test-equal "show-rates disabled"
- '()
- (sxml->table-row-col sxml 2 #f #f)))
-
- (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #t)
+(define (balance-sheet-tests)
+ (define (default-balsheet-testing-options)
+ (let ((balance-sheet-options (gnc:make-report-options balance-sheet-uuid)))
+ (set-option! balance-sheet-options "General" "Balance Sheet Date" (cons 'absolute (gnc-dmy2time64 1 1 1971)))
+ (set-option! balance-sheet-options "Accounts" "Levels of Subaccounts" 'all)
(set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-enable show-fcur show-rates")))
- (test-equal "show-fcur enabled"
- (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
- (sxml->table-row-col sxml 1 3 6))
- (test-equal "show-rates enabled"
- (list "1 FUNDS" "$500.00" "#1.00" "$1.70")
- (sxml->table-row-col sxml 2 #f #f)))
-
- ;;make-multilevel
- (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
- (set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
-
- (set-option! balance-sheet-options "Display" "Omit zero balance figures" #t)
- (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #f)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#f omit-zb-bals=#t")))
- (test-equal "omit-zb-bals=#t"
- '()
- (sxml->table-row-col sxml 1 3 5))
- (test-equal "incl-zb-accts=#f"
- '("Savings" "$100.00") ;i.e.skips "Empty" account with $0.00
- (sxml->table-row-col sxml 1 8 #f)))
-
- (set-option! balance-sheet-options "Display" "Omit zero balance figures" #f)
- (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #t)
- (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#t omit-zb-bals=#f")))
- (test-equal "omit-zb-bals=#f"
- (list "$0.00")
- (sxml->table-row-col sxml 1 3 6))
- (test-equal "incl-zb-accts=#t"
- '("Empty" "$0.00")
- (sxml->table-row-col sxml 1 8 #f)))
- )
-
- (display "\n\n pnl tests\n\n")
- (let* ((pnl-options (default-pnl-testing-options))
- (sxml (options->sxml pnl-uuid pnl-options "pnl-default")))
- (test-equal "total revenue = $1,270.00"
+ balance-sheet-options))
+ (display "\n\n balsheet tests\n\n")
+ (let* ((balance-sheet-options (default-balsheet-testing-options))
+ (sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-default")))
+
+ (test-equal "total assets = $116,009"
+ (list "$116,009.00")
+ (sxml->table-row-col sxml 1 15 6))
+ (test-equal "total liabilities = $9,500.00"
+ (list "$9,500.00")
+ (sxml->table-row-col sxml 1 23 6))
+ (test-equal "total equity = $106,509.00"
+ (list "$106,509.00")
+ (sxml->table-row-col sxml 1 28 6))
+
+ (set-option! balance-sheet-options "Commodities" "Price Source" 'weighted-average)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-weighted-average")))
+ (test-equal "weighted average assets = $114,071.66"
+ (list "$114,071.66")
+ (sxml->table-row-col sxml 1 15 6)))
+
+ (set-option! balance-sheet-options "Commodities" "Price Source" 'average-cost)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-average-cost")))
+ (test-equal "average-cost assets = $113,100"
+ (list "$113,100.00")
+ (sxml->table-row-col sxml 1 15 6)))
+
+ (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-nearest)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-nearest")))
+ (test-equal "pricedb-nearest assets = $116,009"
+ (list "$116,009.00")
+ (sxml->table-row-col sxml 1 15 6)))
+
+ (set-option! balance-sheet-options "Commodities" "Price Source" 'pricedb-latest)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-pricedb-latest")))
+ (test-equal "pricedb-latest assets = $122,049"
+ (list "$122,049.00")
+ (sxml->table-row-col sxml 1 15 6)))
+
+ ;; set multilevel subtotal style
+ ;; verifies amount in EVERY line of the report.
+ (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
+ (set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-multilevel")))
+ (test-equal "multilevel. root = $0.00"
+ (list "$0.00")
+ (sxml->table-row-col sxml 1 3 6))
+ (test-equal "multilevel. assets = $0.00"
+ (list "$0.00")
+ (sxml->table-row-col sxml 1 4 5))
+ (test-equal "multilevel. bank1 = $0.00"
+ (list "$0.00")
+ (sxml->table-row-col sxml 1 5 4))
+ (test-equal "multilevel. bonds = $2,000.00"
+ (list "$2,000.00")
+ (sxml->table-row-col sxml 1 6 3))
+ (test-equal "multilevel. current = $2609.00"
+ (list "$2,609.00")
+ (sxml->table-row-col sxml 1 7 3))
+ (test-equal "multilevel. empty = $0.00"
+ (list "$0.00")
+ (sxml->table-row-col sxml 1 8 3))
+ (test-equal "multilevel. savings = $100.00"
+ (list "$100.00")
+ (sxml->table-row-col sxml 1 9 3))
+ (test-equal "multilevel. total bank1 = $4709"
+ (list "$4,709.00")
+ (sxml->table-row-col sxml 1 10 4))
+ (test-equal "multilevel. broker = $2,000.00"
+ (list "$2,000.00")
+ (sxml->table-row-col sxml 1 11 4))
+ (test-equal "multilevel. funds = $15,000.00"
+ (list "30 FUNDS" "$15,000.00" "$15,000.00")
+ (sxml->table-row-col sxml 1 12 3))
+ (test-equal "multilevel. total broker = $17,000.00"
+ (list "$17,000.00")
+ (sxml->table-row-col sxml 1 13 4))
+ (test-equal "multilevel. foreign = $0.00"
+ (list "$0.00")
+ (sxml->table-row-col sxml 1 14 4))
+ (test-equal "multilevel. foreignsavings = #200.00 = $340"
+ (list "#200.00" "$340.00" "$340.00")
+ (sxml->table-row-col sxml 1 15 3))
+ (test-equal "multilevel. total foreign = $340"
+ (list "$340.00")
+ (sxml->table-row-col sxml 1 16 4))
+ (test-equal "multilevel. house = $100,000"
+ (list "$100,000.00")
+ (sxml->table-row-col sxml 1 17 4))
+ (test-equal "multilevel. total asset = $122,049"
+ (list "$122,049.00")
+ (sxml->table-row-col sxml 1 18 5))
+ (test-equal "multilevel. total root = $122,049"
+ (list "$122,049.00")
+ (sxml->table-row-col sxml 1 19 6))
+ (test-equal "multilevel. total assets = $122,049"
+ (list "$122,049.00")
+ (sxml->table-row-col sxml 1 20 6)))
+
+ ;; set recursive-subtotal subtotal style
+ (set-option! balance-sheet-options "Display" "Parent account balances" 'recursive-bal)
+ (set-option! balance-sheet-options "Display" "Parent account subtotals" 'f)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-recursive")))
+ (test-equal "recursive. root = $760+15000+104600"
+ (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
+ (sxml->table-row-col sxml 1 3 6))
+ (test-equal "recursive. assets = $760+15000+104600"
+ (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
+ (sxml->table-row-col sxml 1 4 5))
+ (test-equal "recursive. bank1 = $4,709.00"
+ (list "$4,709.00")
+ (sxml->table-row-col sxml 1 5 4))
+ (test-equal "recursive. bonds = $2,000.00"
+ (list "$2,000.00")
+ (sxml->table-row-col sxml 1 6 3))
+ (test-equal "recursive. current = $2609.00"
+ (list "$2,609.00")
+ (sxml->table-row-col sxml 1 7 3))
+ (test-equal "recursive. empty = $0.00"
+ (list "$0.00")
+ (sxml->table-row-col sxml 1 8 3))
+ (test-equal "recursive. savings = $100.00"
+ (list "$100.00")
+ (sxml->table-row-col sxml 1 9 3))
+ (test-equal "recursive. broker = $15000+2000.00"
+ (list "30 FUNDS" "$15,000.00" "$2,000.00" "$2,000.00")
+ (sxml->table-row-col sxml 1 10 4))
+ (test-equal "recursive. funds = $15,000.00"
+ (list "30 FUNDS" "$15,000.00" "$15,000.00")
+ (sxml->table-row-col sxml 1 11 3))
+ (test-equal "recursive. foreign = $340.00"
+ (list "#200.00" "$340.00")
+ (sxml->table-row-col sxml 1 12 4))
+ (test-equal "recursive. foreignsavings = #200.00 = $340"
+ (list "#200.00" "$340.00" "$340.00")
+ (sxml->table-row-col sxml 1 13 3))
+ (test-equal "recursive. house = $100,000"
+ (list "$100,000.00")
+ (sxml->table-row-col sxml 1 14 4))
+ (test-equal "recursive. total assets = $122,049.00"
+ (list "$122,049.00")
+ (sxml->table-row-col sxml 1 15 6)))
+
+ (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #f)
+ (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #f)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-disable show-fcur show-rates")))
+ (test-equal "show-fcur disabled"
+ (list "$122,049.00")
+ (sxml->table-row-col sxml 1 3 6))
+ (test-equal "show-rates disabled"
+ '()
+ (sxml->table-row-col sxml 2 #f #f)))
+
+ (set-option! balance-sheet-options "Commodities" "Show Foreign Currencies" #t)
+ (set-option! balance-sheet-options "Commodities" "Show Exchange Rates" #t)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-enable show-fcur show-rates")))
+ (test-equal "show-fcur enabled"
+ (list "#200.00" "$340.00" "30 FUNDS" "$15,000.00" "$106,709.00" "$106,709.00")
+ (sxml->table-row-col sxml 1 3 6))
+ (test-equal "show-rates enabled"
+ (list "1 FUNDS" "$500.00" "#1.00" "$1.70")
+ (sxml->table-row-col sxml 2 #f #f)))
+
+ ;;make-multilevel
+ (set-option! balance-sheet-options "Display" "Parent account balances" 'immediate-bal)
+ (set-option! balance-sheet-options "Display" "Parent account subtotals" 't)
+
+ (set-option! balance-sheet-options "Display" "Omit zero balance figures" #t)
+ (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #f)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#f omit-zb-bals=#t")))
+ (test-equal "omit-zb-bals=#t"
+ '()
+ (sxml->table-row-col sxml 1 3 5))
+ (test-equal "incl-zb-accts=#f"
+ '("Savings" "$100.00") ;i.e.skips "Empty" account with $0.00
+ (sxml->table-row-col sxml 1 8 #f)))
+
+ (set-option! balance-sheet-options "Display" "Omit zero balance figures" #f)
+ (set-option! balance-sheet-options "Display" "Include accounts with zero total balances" #t)
+ (let ((sxml (options->sxml balance-sheet-uuid balance-sheet-options "balsheet-incl-zb-accts=#t omit-zb-bals=#f")))
+ (test-equal "omit-zb-bals=#f"
+ (list "$0.00")
+ (sxml->table-row-col sxml 1 3 6))
+ (test-equal "incl-zb-accts=#t"
+ '("Empty" "$0.00")
+ (sxml->table-row-col sxml 1 8 #f)))))
+
+(define (pnl-tests)
+ (define (default-pnl-testing-options)
+ (let ((pnl-options (gnc:make-report-options pnl-uuid)))
+ (set-option! pnl-options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 1 1 1980)))
+ (set-option! pnl-options "General" "End Date" (cons 'absolute (gnc-dmy2time64 1 1 1981)))
+ (set-option! pnl-options "Accounts" "Levels of Subaccounts" 'all)
+ (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
+ pnl-options))
+ (display "\n\n pnl tests\n\n")
+ (let* ((pnl-options (default-pnl-testing-options))
+ (sxml (options->sxml pnl-uuid pnl-options "pnl-default")))
+ (test-equal "total revenue = $1,270.00"
+ (list "$1,270.00")
+ ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ sxml))
+ (test-equal "total expenses = $0.00"
+ (list "$0.00")
+ ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
+ sxml))
+
+ (set-option! pnl-options "Commodities" "Price Source" 'weighted-average)
+ (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average")))
+ (test-equal "weighted average revenue = $1160.36"
+ (list "$1,160.36")
+ ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ sxml)))
+
+ (set-option! pnl-options "Commodities" "Price Source" 'average-cost)
+ (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost")))
+ (test-equal "average-cost revenue = $976"
+ (list "$976.00")
+ ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ sxml)))
+
+ (set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest)
+ (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest")))
+ (test-equal "pricedb-nearest revenue = $1270"
+ (list "$1,270.00")
+ ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ sxml)))
+
+ (set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest)
+ (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest")))
+ (test-equal "pricedb-latest revenue = $1270"
(list "$1,270.00")
((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ sxml)))
+
+ ;; set multilevel subtotal style
+ ;; verifies amount in EVERY line of the report.
+ (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
+ (set-option! pnl-options "Display" "Parent account subtotals" 't)
+ (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel")))
+ (test-equal "multilevel. income = -$250.00"
+ (list "-$250.00")
+ ((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*))
+ sxml))
+ (test-equal "multilevel. income-GBP = -#600"
+ (list "-#600.00" "-$1,020.00")
+ ((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*))
+ sxml))
+ (test-equal "multilevel. total income = -$1,270.00"
+ (list "-$1,270.00")
+ ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ sxml))
+ (test-equal "multilevel. total revenue = $1,270.00"
+ (list "$1,270.00")
+ ((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*))
sxml))
- (test-equal "total expenses = $0.00"
+ (test-equal "multilevel. expenses = $0.00"
(list "$0.00")
((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
sxml))
-
- (set-option! pnl-options "Commodities" "Price Source" 'weighted-average)
- (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average")))
- (test-equal "weighted average revenue = $1160.36"
- (list "$1,160.36")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
- sxml)))
-
- (set-option! pnl-options "Commodities" "Price Source" 'average-cost)
- (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost")))
- (test-equal "average-cost revenue = $976"
- (list "$976.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
- sxml)))
-
- (set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest)
- (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest")))
- (test-equal "pricedb-nearest revenue = $1270"
- (list "$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
- sxml)))
-
- (set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest)
- (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest")))
- (test-equal "pricedb-latest revenue = $1270"
- (list "$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
- sxml)))
-
- ;; set multilevel subtotal style
- ;; verifies amount in EVERY line of the report.
- (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
- (set-option! pnl-options "Display" "Parent account subtotals" 't)
- (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel")))
- (test-equal "multilevel. income = -$250.00"
- (list "-$250.00")
- ((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*))
- sxml))
- (test-equal "multilevel. income-GBP = -#600"
- (list "-#600.00" "-$1,020.00")
- ((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*))
- sxml))
- (test-equal "multilevel. total income = -$1,270.00"
- (list "-$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
- sxml))
- (test-equal "multilevel. total revenue = $1,270.00"
- (list "$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*))
- sxml))
- (test-equal "multilevel. expenses = $0.00"
- (list "$0.00")
- ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
- sxml))
- (test-equal "multilevel. net-income = $1,270"
- (list "$1,270.00")
- ((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*))
- sxml)))
-
- ;; set recursive-subtotal subtotal style
- (set-option! pnl-options "Display" "Parent account balances" 'recursive-bal)
- (set-option! pnl-options "Display" "Parent account subtotals" 'f)
- (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive")))
- (test-equal "recursive. income = $1020+250"
- (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
- (sxml->table-row-col sxml 1 3 6))
- (test-equal "recursive. income-gbp = $1020"
- (list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00")
- (sxml->table-row-col sxml 1 4 5))
- (test-equal "recursive. total revenue = $1270"
- (list "$1,270.00" "$1,270.00")
- (sxml->table-row-col sxml 1 5 6)))
-
- (set-option! pnl-options "Commodities" "Show Foreign Currencies" #f)
- (set-option! pnl-options "Commodities" "Show Exchange Rates" #f)
- (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates")))
- (test-equal "show-fcur disabled"
- (list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00")
- (sxml->table-row-col sxml 1 3 6))
- (test-equal "show-rates disabled"
- '()
- (sxml->table-row-col sxml 2 #f #f)))
-
- (set-option! pnl-options "Commodities" "Show Foreign Currencies" #t)
- (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
- (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates")))
- (test-equal "show-fcur enabled"
- (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
- (sxml->table-row-col sxml 1 3 6))
- (test-equal "show-rates enabled"
- (list "#1.00" "$1.70")
- (sxml->table-row-col sxml 2 #f #f)))
-
- ;;make-multilevel
- (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
- (set-option! pnl-options "Display" "Parent account subtotals" 't)
- )))
+ (test-equal "multilevel. net-income = $1,270"
+ (list "$1,270.00")
+ ((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*))
+ sxml)))
+
+ ;; set recursive-subtotal subtotal style
+ (set-option! pnl-options "Display" "Parent account balances" 'recursive-bal)
+ (set-option! pnl-options "Display" "Parent account subtotals" 'f)
+ (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive")))
+ (test-equal "recursive. income = $1020+250"
+ (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
+ (sxml->table-row-col sxml 1 3 6))
+ (test-equal "recursive. income-gbp = $1020"
+ (list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00")
+ (sxml->table-row-col sxml 1 4 5))
+ (test-equal "recursive. total revenue = $1270"
+ (list "$1,270.00" "$1,270.00")
+ (sxml->table-row-col sxml 1 5 6)))
+
+ (set-option! pnl-options "Commodities" "Show Foreign Currencies" #f)
+ (set-option! pnl-options "Commodities" "Show Exchange Rates" #f)
+ (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates")))
+ (test-equal "show-fcur disabled"
+ (list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00")
+ (sxml->table-row-col sxml 1 3 6))
+ (test-equal "show-rates disabled"
+ '()
+ (sxml->table-row-col sxml 2 #f #f)))
+
+ (set-option! pnl-options "Commodities" "Show Foreign Currencies" #t)
+ (set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
+ (let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates")))
+ (test-equal "show-fcur enabled"
+ (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
+ (sxml->table-row-col sxml 1 3 6))
+ (test-equal "show-rates enabled"
+ (list "#1.00" "$1.70")
+ (sxml->table-row-col sxml 2 #f #f)))
+
+ ;;make-multilevel
+ (set-option! pnl-options "Display" "Parent account balances" 'immediate-bal)
+ (set-option! pnl-options "Display" "Parent account subtotals" 't)))
commit 119fdc368b41d0a1207e9d281deddcfe08e52d59
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Nov 25 22:52:36 2019 +0800
[report-utilities] can strify records
srfi-9 records can contain complex objects eg lists/vectors also
gnc:monetary or gnc:html-table objects. previously gnc:strify would
use the default printer; this commit modifies so that they are
prettified.
example output; a :col-datum record from balsheet-pnl. the record's
split-balance contains a $0 monetary object.
Rec::col-datum{last-split=#f, split-balance=[$0.00]}
this last pretty-printer must be the last one before object->string,
because we want previous printers which may be records too
eg. monetary->str etc to use their own printer.
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index 3422fdeaa..f2cfaad44 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1284,6 +1284,13 @@ flawed. see report-utilities.scm. please update reports.")
(try owner->str)
(try invoice->str)
(try lot->str)
+ (and (record? d)
+ (let ((rtd (record-type-descriptor d)))
+ (define (fld->str fld)
+ (format #f "~a=~a" fld (gnc:strify ((record-accessor rtd fld) d))))
+ (format #f "Rec:~a{~a}"
+ (record-type-name rtd)
+ (string-join (map fld->str (record-type-fields rtd)) ", "))))
(object->string d)))
(define (pair->num pair)
Summary of changes:
.../python/example_scripts/account_analysis.py | 6 +-
.../new_book_with_opening_balances.py | 8 +-
bindings/python/example_scripts/priceDB_test.py | 5 +-
.../example_scripts/price_database_example.py | 5 +-
.../example_scripts/rest-api/gnucash_simple.py | 16 +-
.../example_scripts/simple_business_create.py | 4 +-
.../example_scripts/simple_invoice_insert.py | 2 +-
.../example_scripts/test_imbalance_transaction.py | 2 +-
bindings/python/gnucash_core.py | 6 +-
gnucash/import-export/import-account-matcher.c | 3 +-
gnucash/report/html-acct-table.scm | 365 +++++-----
gnucash/report/html-text.scm | 3 +
gnucash/report/html-utilities.scm | 34 +-
gnucash/report/report-utilities.scm | 24 +
gnucash/report/report.scm | 2 +
gnucash/report/reports/standard/balsheet-pnl.scm | 252 ++++---
gnucash/report/reports/standard/budget.scm | 5 +-
.../report/reports/standard/customer-summary.scm | 15 +-
gnucash/report/reports/standard/invoice.scm | 10 +-
gnucash/report/reports/standard/job-report.scm | 36 +-
gnucash/report/reports/standard/new-aging.scm | 6 +-
gnucash/report/reports/standard/owner-report.scm | 39 +-
.../reports/standard/test/test-balsheet-pnl.scm | 731 ++++++++++++---------
gnucash/report/test/test-report-utilities.scm | 10 +
24 files changed, 821 insertions(+), 768 deletions(-)
More information about the gnucash-changes
mailing list