gnucash maint: Multiple changes pushed
Geert Janssens
gjanssens at code.gnucash.org
Sat May 12 08:08:24 EDT 2018
Updated via https://github.com/Gnucash/gnucash/commit/61fe6478 (commit)
via https://github.com/Gnucash/gnucash/commit/7f91cb82 (commit)
via https://github.com/Gnucash/gnucash/commit/388a4906 (commit)
via https://github.com/Gnucash/gnucash/commit/5e1c8e91 (commit)
via https://github.com/Gnucash/gnucash/commit/9eedea71 (commit)
via https://github.com/Gnucash/gnucash/commit/66fcaa4f (commit)
via https://github.com/Gnucash/gnucash/commit/bb551af9 (commit)
via https://github.com/Gnucash/gnucash/commit/4e851026 (commit)
via https://github.com/Gnucash/gnucash/commit/4c55141d (commit)
via https://github.com/Gnucash/gnucash/commit/ded88b01 (commit)
via https://github.com/Gnucash/gnucash/commit/1df7fb40 (commit)
via https://github.com/Gnucash/gnucash/commit/d4cb87fe (commit)
via https://github.com/Gnucash/gnucash/commit/23410ca4 (commit)
via https://github.com/Gnucash/gnucash/commit/97ab1b19 (commit)
via https://github.com/Gnucash/gnucash/commit/13f31e06 (commit)
via https://github.com/Gnucash/gnucash/commit/5e0fc04f (commit)
via https://github.com/Gnucash/gnucash/commit/8ddee964 (commit)
via https://github.com/Gnucash/gnucash/commit/c6032ac6 (commit)
via https://github.com/Gnucash/gnucash/commit/dda6730c (commit)
via https://github.com/Gnucash/gnucash/commit/4a27285e (commit)
via https://github.com/Gnucash/gnucash/commit/44a568bc (commit)
via https://github.com/Gnucash/gnucash/commit/fd028716 (commit)
via https://github.com/Gnucash/gnucash/commit/d68ccc33 (commit)
via https://github.com/Gnucash/gnucash/commit/ac510d13 (commit)
via https://github.com/Gnucash/gnucash/commit/4b9ec663 (commit)
via https://github.com/Gnucash/gnucash/commit/f82e5a5b (commit)
via https://github.com/Gnucash/gnucash/commit/f89f00f5 (commit)
via https://github.com/Gnucash/gnucash/commit/4a7bc0b5 (commit)
via https://github.com/Gnucash/gnucash/commit/2102c55b (commit)
via https://github.com/Gnucash/gnucash/commit/b95fa5ba (commit)
via https://github.com/Gnucash/gnucash/commit/6210b80f (commit)
via https://github.com/Gnucash/gnucash/commit/6e78fa1d (commit)
from https://github.com/Gnucash/gnucash/commit/fc963f87 (commit)
commit 61fe647828e806667659ed63f64be9e16b3b31ed
Author: Geert Janssens <geert at kobaltwit.be>
Date: Sat May 12 14:07:26 2018 +0200
Use lowercase for account type descriptions
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 26c3529..966246c 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -576,7 +576,7 @@ tags within description, notes or memo. ")
pagename-filter optname-closing-transactions
"l" (_ "By default most users should not include closing \
transactions in a transaction report. Closing transactions are \
-transfers from INCOME and EXPENSE accounts to equity, and must usually \
+transfers from income and expense accounts to equity, and must usually \
be excluded from periodic reporting.")
'exclude-closing
(keylist->vectorlist show-closing-list)))
diff --git a/po/POTFILES.in b/po/POTFILES.in
index d5cfd96..24e50aa 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -461,7 +461,6 @@ gnucash/report/report-system/html-style-sheet.scm
gnucash/report/report-system/html-table.scm
gnucash/report/report-system/html-text.scm
gnucash/report/report-system/html-utilities.scm
-gnucash/report/report-system/list-extras.scm
gnucash/report/report-system/options-utilities.scm
gnucash/report/report-system/report-collectors.scm
gnucash/report/report-system/report.scm
commit 7f91cb82d7ef07177085b714ffa53dc5233fbb8f
Merge: fc963f8 388a490
Author: Geert Janssens <geert at kobaltwit.be>
Date: Sat May 12 14:07:59 2018 +0200
Merge branch 'scheme-progress' of https://github.com/christopherlam/gnucash into maint
commit 388a4906b05740b507582b8eda9b264d8a357bfa
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri May 11 16:39:00 2018 +0800
gnc:options->sxml allow alphanumeric in test filename
diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm
index 02bde41..b8a74c2 100644
--- a/gnucash/report/report-system/test/test-extras.scm
+++ b/gnucash/report/report-system/test/test-extras.scm
@@ -104,7 +104,8 @@
(renderer (gnc:report-template-renderer template))
(document (renderer report))
(sanitize-char (lambda (c)
- (if (char-alphabetic? c) c #\-)))
+ (if (or (char-alphabetic? c)
+ (char-numeric? c)) c #\-)))
(fileprefix (string-map sanitize-char prefix))
(filename (string-map sanitize-char test-title)))
(gnc:html-document-set-style-sheet! document (gnc:report-stylesheet report))
commit 5e1c8e91321ad07ffc6c2e45823315d44773434c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu May 10 22:52:43 2018 +0800
business-reports/*.scm: close tags to make valid XHTML
This will be important for testing.
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index c8bc60b..b0384be 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -580,10 +580,10 @@
(gnc:html-table-append-row!
table
(list
- (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br>")))
+ (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
(gnc:html-table-append-row!
table
- (list "<br>"))
+ (list "<br/>"))
(gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
@@ -625,7 +625,7 @@
(gnc:html-table-append-row! table (list (if name name "")))
(gnc:html-table-append-row! table (list (string-expand
(if addy addy "")
- #\newline "<br>")))
+ #\newline "<br/>")))
(gnc:html-table-append-row! table (list
(strftime
date-format
diff --git a/gnucash/report/business-reports/easy-invoice.scm b/gnucash/report/business-reports/easy-invoice.scm
index 6a80711..985b6eb 100644
--- a/gnucash/report/business-reports/easy-invoice.scm
+++ b/gnucash/report/business-reports/easy-invoice.scm
@@ -564,10 +564,10 @@
(gnc:html-table-append-row!
table
(list
- (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br>")))
+ (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
(gnc:html-table-append-row!
table
- (list "<br>"))
+ (list "<br/>"))
(for-each
(lambda (order)
(let* ((reference (gncOrderGetReference order)))
@@ -780,7 +780,7 @@
(gnc:make-html-text
(string-append
(_ "Billing ID") ": "
- (string-expand billing-id #\newline "<br>"))))
+ (string-expand billing-id #\newline "<br/>"))))
(make-break! document)))))
(if (opt-val "Display" "Billing Terms")
@@ -792,7 +792,7 @@
(gnc:make-html-text
(string-append
(_ "Terms") ": "
- (string-expand terms #\newline "<br>")))))))
+ (string-expand terms #\newline "<br/>")))))))
(make-break! document)
@@ -814,14 +814,14 @@
(gnc:html-document-add-object!
document
(gnc:make-html-text
- (string-expand notes #\newline "<br>"))))
+ (string-expand notes #\newline "<br/>"))))
(make-break! document)
(make-break! document)))
(gnc:html-document-add-object!
document
(gnc:make-html-text
- (string-expand (opt-val "Text" "Extra Notes") #\newline "<br>")
+ (string-expand (opt-val "Text" "Extra Notes") #\newline "<br/>")
))
; close the framing table
diff --git a/gnucash/report/business-reports/fancy-invoice.scm b/gnucash/report/business-reports/fancy-invoice.scm
index a7c7809..77c2b4e 100644
--- a/gnucash/report/business-reports/fancy-invoice.scm
+++ b/gnucash/report/business-reports/fancy-invoice.scm
@@ -622,7 +622,7 @@
(gnc:html-table-cell-set-style!
name-cell "td"
'font-size "+2")
- (gnc:html-table-append-row! table (list name-cell "" "")) ;;Bert: had a newline and a "<br>"
+ (gnc:html-table-append-row! table (list name-cell "" "")) ;;Bert: had a newline and a "<br/>"
(gnc:html-table-append-row!
table
(list
@@ -927,7 +927,7 @@
(gnc:html-document-add-object!
document
(gnc:make-html-text
- (string-expand notes #\newline "<br>")))))
+ (string-expand notes #\newline "<br/>")))))
(make-break! document)
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index 447d9d1..3434c95 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -541,10 +541,10 @@
(gnc:html-table-append-row!
table
(list
- (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br>")))
+ (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
(gnc:html-table-append-row!
table
- (list "<br>"))
+ (list "<br/>"))
(for-each
(lambda (order)
(let* ((reference (gncOrderGetReference order)))
@@ -595,7 +595,7 @@
(gnc:html-table-append-row! table (list (if name name "")))
(gnc:html-table-append-row! table (list (string-expand
(if addy addy "")
- #\newline "<br>")))
+ #\newline "<br/>")))
(gnc:html-table-append-row! table (list
(strftime
date-format
@@ -718,7 +718,7 @@
(gnc:make-html-text
(string-append
(_ "Reference") ": "
- (string-expand billing-id #\newline "<br>"))))
+ (string-expand billing-id #\newline "<br/>"))))
(make-break! document)))))
(if (opt-val "Display" "Billing Terms")
@@ -731,7 +731,7 @@
(gnc:make-html-text
(string-append
(_ "Terms") ": "
- (string-expand terms #\newline "<br>"))))
+ (string-expand terms #\newline "<br/>"))))
(make-break! document))
)))
@@ -746,14 +746,14 @@
(gnc:make-html-text
(string-append
(_ "Job number") ": "
- (string-expand jobnumber #\newline "<br>"))))
+ (string-expand jobnumber #\newline "<br/>"))))
(make-break! document)
(gnc:html-document-add-object!
document
(gnc:make-html-text
(string-append
(_ "Job name") ": "
- (string-expand jobname #\newline "<br>"))))
+ (string-expand jobname #\newline "<br/>"))))
(make-break! document)
(make-break! document)
)))
@@ -768,7 +768,7 @@
(gnc:html-document-add-object!
document
(gnc:make-html-text
- (string-expand notes #\newline "<br>")))))
+ (string-expand notes #\newline "<br/>")))))
(make-break! document)
@@ -776,7 +776,7 @@
document
(gnc:make-html-text
(gnc:html-markup-br)
- (string-expand (opt-val "Display" "Extra Notes") #\newline "<br>")
+ (string-expand (opt-val "Display" "Extra Notes") #\newline "<br/>")
(gnc:html-markup-br))))
; else
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 20d8e28..787c998 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -678,10 +678,10 @@
(gnc:html-table-append-row!
table
(list
- (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br>")))
+ (string-expand (gnc:owner-get-name-and-address-dep owner) #\newline "<br/>")))
(gnc:html-table-append-row!
table
- (list "<br>"))
+ (list "<br/>"))
(gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
@@ -721,7 +721,7 @@
(gnc:html-table-append-row! table (list (if name name "")))
(gnc:html-table-append-row! table (list (string-expand
(if addy addy "")
- #\newline "<br>")))
+ #\newline "<br/>")))
(gnc:html-table-append-row! table (list
(strftime
date-format
diff --git a/gnucash/report/business-reports/receipt.scm b/gnucash/report/business-reports/receipt.scm
index a782783..6ee7250 100644
--- a/gnucash/report/business-reports/receipt.scm
+++ b/gnucash/report/business-reports/receipt.scm
@@ -191,7 +191,7 @@
notespage optname-extra-notes "a"
(N_ "Notes added at end of invoice -- may contain HTML markup")
""))
- ;(N_ "(Development version -- don't rely on the numbers on this report without double-checking them.<br>Change the 'Extra Notes' option to get rid of this message)")))
+ ;(N_ "(Development version -- don't rely on the numbers on this report without double-checking them.<br/>Change the 'Extra Notes' option to get rid of this message)")))
(gnc:options-set-default-section
report-options generalpage)
diff --git a/gnucash/report/business-reports/taxinvoice.scm b/gnucash/report/business-reports/taxinvoice.scm
index d6919c7..054b18f 100644
--- a/gnucash/report/business-reports/taxinvoice.scm
+++ b/gnucash/report/business-reports/taxinvoice.scm
@@ -237,7 +237,7 @@
notespage optname-extra-notes "a"
(_ "Notes added at end of invoice -- may contain HTML markup.")
(_ "Thank you for your patronage!")))
- ;(N_ "(Development version -- don't rely on the numbers on this report without double-checking them.<br>Change the 'Extra Notes' option to get rid of this message)")))
+ ;(N_ "(Development version -- don't rely on the numbers on this report without double-checking them.<br/>Change the 'Extra Notes' option to get rid of this message)")))
(add-option (gnc:make-text-option notespage optname-extra-css "b"
(N_ "Embedded CSS.") "h1.coyname { text-align: left; }"))
commit 9eedea71ea1871fdc8d926fe2376b1105291b06a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed May 9 20:30:34 2018 +0800
test-GSTR: implementation testing for GST Report
diff --git a/gnucash/report/standard-reports/test/CMakeLists.txt b/gnucash/report/standard-reports/test/CMakeLists.txt
index 1db6daf..f994b17 100644
--- a/gnucash/report/standard-reports/test/CMakeLists.txt
+++ b/gnucash/report/standard-reports/test/CMakeLists.txt
@@ -8,6 +8,7 @@ set(scm_test_standard_reports_SOURCES
set(scm_test_with_srfi64_SOURCES
test-transaction.scm
+ test-income-gst.scm
)
set(scm_test_report_SUPPORT
diff --git a/gnucash/report/standard-reports/test/test-income-gst.scm b/gnucash/report/standard-reports/test/test-income-gst.scm
new file mode 100644
index 0000000..a11bbf8
--- /dev/null
+++ b/gnucash/report/standard-reports/test/test-income-gst.scm
@@ -0,0 +1,213 @@
+(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 income-gst-statement))
+(use-modules (gnucash report stylesheets))
+(use-modules (gnucash report report-system))
+(use-modules (gnucash report report-system test test-extras))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (sxml simple))
+(use-modules (sxml xpath))
+
+
+;; This is implementation testing for Income & GST report. This
+;; delegates to the Transaction Report, therefore, only the
+;; GSTR-specific options will be individually tested. Foreign-currency
+;; conversions will NOT be tested, because they require pricedb entries.
+
+;; see transaction.scm for explanatory notes and hints.
+
+;; copied from income-gst-statement.scm
+(define rpt-uuid "5bf27f249a0d11e7abc4cec278b6b50a")
+
+;; Explicitly set locale to make the report output predictable
+(setlocale LC_ALL "C")
+
+(define (run-test)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "income-gst-statement.scm")
+ (null-test)
+ (gstr-tests)
+ (test-end "income-gst-statement.scm"))
+
+(define (options->sxml options test-title)
+ (gnc:options->sxml rpt-uuid options "test-gstr" test-title))
+
+(define (set-option! options section name value)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-set-value option value)
+ (test-assert (format #f "wrong-option ~a ~a" section name) #f))))
+
+(define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET))
+ (list "GST"
+ (list "GST on Purchases")
+ (list "GST on Sales" (list (cons 'type ACCT-TYPE-LIABILITY)))
+ (list "Reduced GST on Sales" (list (cons 'type ACCT-TYPE-LIABILITY))))
+ (list "Asset"
+ (list "Bank")
+ (list "A/Receivable" (list (cons 'type ACCT-TYPE-RECEIVABLE))))
+ (list "Liability" (list (cons 'type ACCT-TYPE-PAYABLE))
+ (list "CreditCard")
+ (list "A/Payable"))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
+ (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
+ ))
+
+(define (null-test)
+ ;; This null-test tests for the presence of report.
+ (let ((options (gnc:make-report-options rpt-uuid)))
+ (test-assert "null-test" (options->sxml options "null-test"))))
+
+(define (gstr-tests)
+ ;; This function will perform implementation testing on the transaction report.
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (bank (cdr (assoc "Bank" account-alist)))
+ (income (cdr (assoc "Income" account-alist)))
+ (expense (cdr (assoc "Expenses" account-alist)))
+ (creditcard (cdr (assoc "CreditCard" account-alist)))
+ (payable (cdr (assoc "A/Payable" account-alist)))
+ (receivable (cdr (assoc "A/Receivable" account-alist)))
+ (gst-sales (cdr (assoc "GST on Sales" account-alist)))
+ (reduced-gst-sales (cdr (assoc "Reduced GST on Sales" account-alist)))
+ (gst-purch (cdr (assoc "GST on Purchases" account-alist)))
+ (YEAR (gnc:time64-get-year (gnc:get-today))))
+
+ (define (default-testing-options)
+ ;; To ease testing of transaction report, we will set default
+ ;; options for generating reports. We will elable extra columns
+ ;; for Exporting, disable generation of informational text, and
+ ;; disable indenting. These options will be tested separately as
+ ;; the first test group. By default, we'll select the modern dates.
+ (let ((options (gnc:make-report-options rpt-uuid)))
+ (set-option! options "Accounts" "Accounts" (list income expense payable receivable))
+ (set-option! options "Accounts" "Tax Accounts" (list gst-sales
+ reduced-gst-sales
+ gst-purch))
+ (set-option! options "General" "Add options summary" 'always)
+ (set-option! options "General" "Table for Exporting" #t)
+ (set-option! options "General" "Start Date" (cons 'relative 'start-cal-year))
+ (set-option! options "General" "End Date" (cons 'relative 'end-cal-year))
+ options))
+
+ (define* (create-txn DD MM YY DESC list-of-splits #:optional txn-type)
+ (let ((txn (xaccMallocTransaction (gnc-get-current-book))))
+ (xaccTransBeginEdit txn)
+ (xaccTransSetDescription txn DESC)
+ (xaccTransSetCurrency txn (gnc-default-report-currency))
+ (xaccTransSetDate txn DD MM YY)
+ (for-each
+ (lambda (tfr)
+ (let ((split (xaccMallocSplit (gnc-get-current-book))))
+ (xaccSplitSetParent split txn)
+ (xaccSplitSetAccount split (cdr tfr))
+ (xaccSplitSetValue split (car tfr))
+ (xaccSplitSetAmount split (car tfr))))
+ list-of-splits)
+ (if txn-type
+ (xaccTransSetTxnType txn txn-type))
+ (xaccTransCommitEdit txn)
+ txn))
+
+ ;; This will make all accounts use default currency (I think depends on locale)
+ (for-each
+ (lambda(pair)
+ (xaccAccountSetCommodity (cdr pair) (gnc-default-report-currency)))
+ account-alist)
+
+ (create-txn 1 1 YEAR "invoice charge $100, no GST"
+ (list (cons -100 income)
+ (cons 100 receivable))
+ TXN-TYPE-INVOICE)
+
+ (create-txn 2 1 YEAR "invoice charge $200+$20GST"
+ (list (cons -200 income)
+ (cons -20 gst-sales)
+ (cons 220 receivable))
+ TXN-TYPE-INVOICE)
+
+ (create-txn 3 1 YEAR "receive $320 for invoices from bank"
+ (list (cons -320 receivable)
+ (cons 320 bank))
+ TXN-TYPE-PAYMENT)
+
+ (create-txn 4 1 YEAR "cash sales $300+$15GST5%"
+ (list (cons -300 income)
+ (cons -15 reduced-gst-sales)
+ (cons 315 bank)))
+
+ (create-txn 5 1 YEAR "cash spend $50, no GST"
+ (list (cons -50 bank)
+ (cons 50 expense)))
+
+ (create-txn 6 1 YEAR "purchase on credit $80+$8GST"
+ (list (cons -88 payable)
+ (cons 80 expense)
+ (cons 8 gst-purch))
+ TXN-TYPE-INVOICE)
+
+ (create-txn 7 1 YEAR "hybrid paycheck. earn $400+$20, less $110+$10"
+ (list (cons 310 bank)
+ (cons -400 income)
+ (cons -20 reduced-gst-sales)
+ (cons 100 expense)
+ (cons 10 gst-purch)))
+
+ (create-txn 8 1 YEAR "pay bill from 6-january for $88 using creditcard"
+ (list (cons 88 payable)
+ (cons -88 creditcard))
+ TXN-TYPE-PAYMENT)
+
+ (create-txn 2 2 YEAR "link"
+ (list (cons -77 income)
+ (cons 77 income))
+ TXN-TYPE-LINK)
+
+ (create-txn 3 2 YEAR "payment"
+ (list (cons -22 income)
+ (cons 22 income))
+ TXN-TYPE-PAYMENT)
+
+ (xaccTransSetIsClosingTxn
+ (create-txn 3 2 YEAR "closing"
+ (list (cons -33 income)
+ (cons 33 income)))
+ #t)
+
+ ;; Finally we can begin testing
+ (test-begin "display options")
+
+ (let ((options (default-testing-options)))
+ (set-option! options "Display" "Num" #f)
+ (set-option! options "Display" "Memo" #f)
+ (set-option! options "Display" "Account Name" #f)
+ (set-option! options "Sorting" "Primary Subtotal" 'date)
+ (set-option! options "Sorting" "Secondary Subtotal" 'account-name)
+ (let ((sxml (options->sxml options "initial setup")))
+ (test-equal "totals are as expected"
+ '("Grand Total" " " " " "$1,055.00" "$1,000.00" "$55.00" "$248.00" "$230.00" "$18.00")
+ (sxml->table-row-col sxml 1 -1 #f))
+
+ (test-equal "tax on sales as expected"
+ '(" " "\n" "$20.00" "$20.00" " " " " "\n" "$20.00" "$20.00" "\n" "$15.00" "$15.00" "$55.00")
+ (sxml->table-row-col sxml 1 #f 6))
+
+ (test-equal "tax on purchases as expected"
+ '(" " " " " " " " "\n" "$8.00" "\n" "$10.00" "$18.00" " " " " "$18.00")
+ (sxml->table-row-col sxml 1 #f 9)))
+
+ (set-option! options "Display" "Individual tax columns" #t)
+ (set-option! options "Display" "Individual expense columns" #t)
+ (set-option! options "Display" "Individual income columns" #t)
+ (set-option! options "Display" "Remittance amount" #t)
+ (set-option! options "Display" "Net Income" #t)
+ (set-option! options "Display" "Tax payable" #t)
+ (let ((sxml (options->sxml options "display options enabled")))
+ (test-equal "all display columns enabled"
+ '("Grand Total" " " " " "$1,055.00" "$1,000.00" "$20.00" "$35.00" "$248.00" "$230.00" "$18.00" "$807.00" "$770.00" "$37.00")
+ (sxml->table-row-col sxml 1 -1 #f))))
+
+ (test-end "display options")))
commit 66fcaa4f91566a5737cfeb3afa8dbb4b3ee5bf47
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed May 9 20:36:40 2018 +0800
test-extras.scm: centralize (sxml->table-row-col)
This is used in conjunction with (gnc:options->sxml) to extract
html table cells.
From SXML tree, retrieve, from a <table>, the th/tr/td cells as a list
of string.
diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm
index aef5a94..02bde41 100644
--- a/gnucash/report/report-system/test/test-extras.scm
+++ b/gnucash/report/report-system/test/test-extras.scm
@@ -23,6 +23,7 @@
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system))
(use-modules (sxml simple))
+(use-modules (sxml xpath))
(export pattern-streamer)
@@ -120,3 +121,19 @@
(format #t "*** XML error. see render output at ~a\n~a"
filename (gnc:html-render-options-changed options #t))
(throw k args))))))
+
+(export sxml->table-row-col)
+(define (sxml->table-row-col sxml tbl row col)
+ ;; sxml - sxml input tree
+ ;; tbl - table number (e.g. 2 = second table in tree)
+ ;; row - row number (negative counts from bottom) or #f (all rows)
+ ;; or zero (retrieves <th> headers)
+ ;; col - col number (negative counts from right) or all cols
+ ;;
+ ;; output: list-of-string
+ (let* ((tbl-path `(table ,tbl))
+ (row-path (if (and row (not (zero? row))) `(tr ,row) 'tr))
+ (col-tag (if (and row (zero? row)) 'th 'td))
+ (col-path (if col `(,col-tag ,col) col-tag))
+ (xpath `(// ,tbl-path // ,row-path // ,col-path // *text*)))
+ ((sxpath xpath) sxml)))
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index 7a88e59..df83c84 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -94,29 +94,7 @@
(gnc:options->sxml trep-uuid options "test-trep" test-title))
(define (get-row-col sxml row col)
- ;; sxml, row & col (numbers or #f) -> list-of-string
- ;;
- ;; from an SXML table tree with tr/th/td elements, retrieve row/col
- ;; if row = 0 retrieve <tr><th> elements
- ;; if row = #f retrieve whole <td> col, excludes <th> cols
- ;; if col = #f retrieve whole <tr> row
- ;; if both = #f retrieve all text elements
- ;;
- ;; NOTE: This will retrieve cells from the first table in the tree.
- ;; If there are multiple tables, I recommend that the tree is first
- ;; pruned to the desired table via e.g. '(// (table 2)) then sent as
- ;; argument to this function.
- (let ((xpath (cond
- ((not (or row col)) '(// (table 1) // tr // *text*))
- ((not row) `(// (table 1) // tr // (td ,col) // *text*))
- ((and (equal? row 0) (not col)) '(// (table 1) // tr // th // *text*))
- ((not col) `(// (table 1) // (tr ,row) // td // *text*))
- ((equal? row 0) `(// (table 1) // tr // (th ,col) // *text*))
- (else `(// (table 1) // (tr ,row) // (td ,col) // *text*)))))
- ((sxpath xpath) sxml)))
-;;
-;; END CANDIDATES
-;;
+ (sxml->table-row-col sxml 1 row col))
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))
commit bb551af9482b786088086ba2eabf1ada3cd778a7
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 8 23:52:24 2018 +0800
collectors.scm: rewrite binary-search-lt to be clearer
diff --git a/gnucash/report/report-system/collectors.scm b/gnucash/report/report-system/collectors.scm
index 28b9ee7..5470d93 100644
--- a/gnucash/report/report-system/collectors.scm
+++ b/gnucash/report/report-system/collectors.scm
@@ -333,15 +333,15 @@
;; Binary search. Returns highest index with content less than or
;; equal to the supplied value.
-(define (binary-search-lt <= value vector)
- (define (search low high)
- (let* ((midpoint (+ low (ceiling (/ (- high low) 2))))
- (midvalue (vector-ref vector midpoint)))
- (if (= low high)
- (if (<= midvalue value)
- low #f)
- (if (<= midvalue value)
- (search midpoint high)
- (search low (- midpoint 1))))))
- (if (= 0 (vector-length vector)) #f
- (search 0 (- (vector-length vector) 1))))
+(define (binary-search-lt <= val vec)
+ (and (not (zero? (vector-length vec)))
+ (let loop ((low 0)
+ (high (1- (vector-length vec))))
+ (let* ((midpoint (ceiling (/ (+ low high) 2)))
+ (midvalue (vector-ref vec midpoint)))
+ (if (= low high)
+ (and (<= midvalue val)
+ low)
+ (if (<= midvalue val)
+ (loop midpoint high)
+ (loop low (1- midpoint))))))))
commit 4e85102682909c68cbf8612aa0df0fd7d65c9603
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 8 23:47:46 2018 +0800
report-system/cmakelists: fix scm_test_report_system_SOURCES
These tests were disabled by mistake in cbd87647806ca3700d2ead8a6623b758a07ba2a7
diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt
index efd6607..52ab315 100644
--- a/gnucash/report/report-system/test/CMakeLists.txt
+++ b/gnucash/report/report-system/test/CMakeLists.txt
@@ -13,7 +13,7 @@ set(scm_test_report_system_SOURCES
test-load-report-system-module.scm
test-collectors.scm
test-report-utilities.scm
-# test-test-extras.scm ;;FIXME why is this not run
+ test-test-extras.scm
)
set (scm_test_report_system_with_srfi64_SOURCES
@@ -30,7 +30,7 @@ set(GUILE_DEPENDS
scm-scm
scm-report-system-3
)
-gnc_add_scheme_tests(${scm_test_report_system_SOURCES})
+gnc_add_scheme_tests("${scm_test_report_system_SOURCES}")
if (HAVE_SRFI64)
gnc_add_scheme_tests ("${scm_test_report_system_with_srfi64_SOURCES}")
commit 4c55141d963452a2381a5bd5b3d4fe31bde2cd2c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 8 23:05:59 2018 +0800
html-utilities.scm: simplify
diff --git a/gnucash/report/report-system/html-utilities.scm b/gnucash/report/report-system/html-utilities.scm
index a701ff2..f67a9a5 100644
--- a/gnucash/report/report-system/html-utilities.scm
+++ b/gnucash/report/report-system/html-utilities.scm
@@ -27,9 +27,7 @@
;; 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)))
+ (make-list n #f))
(define (gnc:register-guid type guid)
(gnc-build-url URL-TYPE-REGISTER (string-append type guid) ""))
@@ -816,8 +814,8 @@
(gnc:html-markup-p
(gnc:html-markup-anchor
(gnc-build-url URL-TYPE-OPTIONS
- (string-append "report-id=" (format #f "~a" report-id))
- "")
+ (format #f "report-id=~a" report-id)
+ "")
(_ "Edit report options")))))
(define* (gnc:html-render-options-changed options #:optional plaintext?)
commit ded88b01dd4e9a80000eca2736a81e66567dc260
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 8 23:03:46 2018 +0800
list-extras.scm: trim useless utility functions
These functions are either better defined in R5RS (list-min-max),
unused (function-compose), or being defined in the .scm using
them (list-leaves).
diff --git a/gnucash/report/report-system/CMakeLists.txt b/gnucash/report/report-system/CMakeLists.txt
index a9116b3..d1887b4 100644
--- a/gnucash/report/report-system/CMakeLists.txt
+++ b/gnucash/report/report-system/CMakeLists.txt
@@ -52,7 +52,6 @@ set (report_system_SCHEME
set (report_system_SCHEME_2a
collectors.scm
- list-extras.scm
)
set (report_system_SCHEME_2b
diff --git a/gnucash/report/report-system/list-extras.scm b/gnucash/report/report-system/list-extras.scm
deleted file mode 100644
index 3c35445..0000000
--- a/gnucash/report/report-system/list-extras.scm
+++ /dev/null
@@ -1,47 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash report report-system list-extras))
-(use-modules (srfi srfi-1))
-
-(export list-min-max)
-(export list-leaves)
-(export function-compose)
-
-(define (list-min-max list ordered?)
- (define (helper list min max)
- (if (null? list) (cons min max)
- (let ((elt (car list)))
- (helper (cdr list)
- (if (ordered? elt min) elt min)
- (if (ordered? elt max) max elt)))))
- (helper (cdr list) (car list) (car list)))
-
-(define (list-leaves list)
- (if (not (pair? list))
- (cons list '())
- (fold (lambda (next acc)
- (append (list-leaves next)
- acc))
- '()
- list)))
-
-(define (function-compose f1 f2)
- (lambda a
- (f1 (apply f2 a))))
diff --git a/gnucash/report/report-system/report-collectors.scm b/gnucash/report/report-system/report-collectors.scm
index 523c8a7..1e0b3a6 100644
--- a/gnucash/report/report-system/report-collectors.scm
+++ b/gnucash/report/report-system/report-collectors.scm
@@ -30,7 +30,6 @@
(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
(use-modules (gnucash report report-system collectors))
-(use-modules (gnucash report report-system list-extras))
(export account-destination-alist)
(export category-by-account-report)
@@ -150,13 +149,13 @@
(splits-up-to (map car account-alist) min-date max-date)))
(define (category-report-dates-intervals dates)
- (let* ((min-date (car (list-min-max (map first dates) <)))
- (max-date (cdr (list-min-max (map second dates) <))))
+ (let* ((min-date (apply min (map first dates)))
+ (max-date (apply max (map second dates))))
(list min-date max-date dates)))
(define (category-report-dates-accumulate dates)
(let* ((min-date #f)
- (max-date (cdr (list-min-max dates <)))
+ (max-date (apply max dates))
(datepairs (reverse! (cdr (fold (lambda (next acc)
(let ((prev (car acc))
(pairs-so-far (cdr acc)))
diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt
index 67137bf..efd6607 100644
--- a/gnucash/report/report-system/test/CMakeLists.txt
+++ b/gnucash/report/report-system/test/CMakeLists.txt
@@ -12,7 +12,6 @@ gnc_add_test_with_guile(test-link-module-report-system test-link-module.c
set(scm_test_report_system_SOURCES
test-load-report-system-module.scm
test-collectors.scm
- test-list-extras.scm
test-report-utilities.scm
# test-test-extras.scm ;;FIXME why is this not run
)
diff --git a/gnucash/report/report-system/test/test-list-extras.scm b/gnucash/report/report-system/test/test-list-extras.scm
deleted file mode 100644
index 46f04b5..0000000
--- a/gnucash/report/report-system/test/test-list-extras.scm
+++ /dev/null
@@ -1,42 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(debug-set! stack 50000)
-(use-modules (gnucash gnc-module))
-(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-(use-modules (gnucash report report-system list-extras))
-(use-modules (gnucash engine test test-extras))
-
-(define (run-test)
- (test test-list-min-max))
-
-(define (test-list-min-max)
- (and (equal? (cons 1 1) (list-min-max (list 1) <))
- (equal? (cons 1 2) (list-min-max (list 1 2) <))
- (equal? (cons 1 2) (list-min-max (list 2 1) <))
- (equal? (cons 1 2) (list-min-max (list 1 1 2) <))
- (equal? (cons 1 2) (list-min-max (list 1 2 1) <))
- (equal? (cons 1 2) (list-min-max (list 1 2 2) <))
- (equal? (cons 1 2) (list-min-max (list 2 1 1) <))
- (equal? (cons 1 2) (list-min-max (list 2 2 1) <))
- (equal? (cons 1 3) (list-min-max (list 1 1 3) <))
- (equal? (cons 1 3) (list-min-max (list 1 2 3) <))
- (equal? (cons 1 3) (list-min-max (list 1 3 2) <))
- (equal? (cons 1 3) (list-min-max (list 2 3 1) <))
- (equal? (cons 1 3) (list-min-max (list 3 2 1) <))))
commit 1df7fb4048e8484fae4305d185e39a57305455ef
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 8 22:41:12 2018 +0800
html-text.scm: schemify
diff --git a/gnucash/report/report-system/html-text.scm b/gnucash/report/report-system/html-text.scm
index ec903fa..b68ed2c 100644
--- a/gnucash/report/report-system/html-text.scm
+++ b/gnucash/report/report-system/html-text.scm
@@ -190,7 +190,7 @@
(define (gnc:html-markup-anchor href . rest)
(apply gnc:html-markup/attr
"a"
- (string-append "href=\"" href "\"")
+ (format #f "href=~s" href)
rest))
(define (gnc:html-markup-img src . rest)
@@ -198,15 +198,11 @@
"img"
(with-output-to-string
(lambda ()
- (display "src=\"") (display src) (display"\"")
- (display " ")
(for-each
(lambda (kvp)
- (display (car kvp))
- (display "=\"")
- (display (cadr kvp))
- (display "\" "))
- rest)))))
+ (format #f "~a=~s " (car kvp) (cadr kvp)))
+ (cons (list 'src src)
+ rest))))))
(define (gnc:html-text-render p doc)
(let* ((retval '())
commit d4cb87fe3d923cc6490168a27f91a24b65a02553
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun May 6 17:26:28 2018 +0800
business-report/test: create test directory
These tests will all be SRFI-64 based.
diff --git a/gnucash/report/business-reports/CMakeLists.txt b/gnucash/report/business-reports/CMakeLists.txt
index ee02ff4..9217934 100644
--- a/gnucash/report/business-reports/CMakeLists.txt
+++ b/gnucash/report/business-reports/CMakeLists.txt
@@ -1,3 +1,4 @@
+add_subdirectory (test)
set (business_reports_SCHEME
aging.scm
diff --git a/gnucash/report/business-reports/test/CMakeLists.txt b/gnucash/report/business-reports/test/CMakeLists.txt
new file mode 100644
index 0000000..9c62903
--- /dev/null
+++ b/gnucash/report/business-reports/test/CMakeLists.txt
@@ -0,0 +1,31 @@
+
+set(scm_test_business_reports_with_srfi64_SOURCES
+)
+
+set(GUILE_DEPENDS
+ scm-gnc-module
+ scm-app-utils
+ scm-engine
+ scm-test-engine
+ scm-gettext
+ scm-scm
+ scm-test-report-system
+ scm-report-stylesheets
+ )
+
+if (HAVE_SRFI64)
+ gnc_add_scheme_tests("${scm_test_business_reports_with_srfi64_SOURCES}")
+endif (HAVE_SRFI64)
+
+gnc_add_scheme_targets(scm-test-business-reports
+ "${scm_test_business_reports_SOURCES}"
+ gnucash/report/business-reports/test
+ "scm-test-business-support"
+ FALSE
+)
+
+add_dependencies(check scm-test-business-reports)
+
+set_dist_list(test_business_reports_DIST CMakeLists.txt
+ ${scm_test_business_reports_with_srfi64_SOURCES}
+ )
commit 23410ca429aead77deeb271416bd461598f3bfdf
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun May 6 23:39:45 2018 +0800
html-table.scm: centralize (gnc:html-table-set-last-row-style!)
This html-table modifier seems common enough to centralize into
html-table.scm.
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 376bc0a..c8bc60b 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -97,13 +97,6 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (set-last-row-style! table tag . rest)
- (let ((arg-list
- (cons table
- (cons (- (gnc:html-table-num-rows table) 1)
- (cons tag rest)))))
- (apply gnc:html-table-set-row-style! arg-list)))
-
(define (date-col columns-used)
(vector-ref columns-used 0))
(define (num-col columns-used)
@@ -591,7 +584,7 @@
(gnc:html-table-append-row!
table
(list "<br>"))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
@@ -609,7 +602,7 @@
table "table"
'attribute (list "border" 0)
'attribute (list "cellpadding" 0))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
diff --git a/gnucash/report/business-reports/easy-invoice.scm b/gnucash/report/business-reports/easy-invoice.scm
index eb294b0..6a80711 100644
--- a/gnucash/report/business-reports/easy-invoice.scm
+++ b/gnucash/report/business-reports/easy-invoice.scm
@@ -39,13 +39,6 @@
(use-modules (gnucash report standard-reports))
(use-modules (gnucash report business-reports))
-(define (set-last-row-style! table tag . rest)
- (let ((arg-list
- (cons table
- (cons (- (gnc:html-table-num-rows table) 1)
- (cons tag rest)))))
- (apply gnc:html-table-set-row-style! arg-list)))
-
(define (date-col columns-used)
(vector-ref columns-used 0))
(define (description-col columns-used)
@@ -585,7 +578,7 @@
;; This string is supposed to be an abbrev. for "Reference"?
(string-append (_ "REF") ": " reference))))))
orders)
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
@@ -605,7 +598,7 @@
table "table"
'attribute (list "border" 0)
'attribute (list "cellpadding" 0))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
diff --git a/gnucash/report/business-reports/fancy-invoice.scm b/gnucash/report/business-reports/fancy-invoice.scm
index ddb2794..a7c7809 100644
--- a/gnucash/report/business-reports/fancy-invoice.scm
+++ b/gnucash/report/business-reports/fancy-invoice.scm
@@ -57,13 +57,6 @@
(use-modules (gnucash report standard-reports))
(use-modules (gnucash report business-reports))
-(define (set-last-row-style! table tag . rest)
- (let ((arg-list
- (cons table
- (cons (- (gnc:html-table-num-rows table) 1)
- (cons tag rest)))))
- (apply gnc:html-table-set-row-style! arg-list)))
-
(define (date-col columns-used)
(vector-ref columns-used 0))
(define (description-col columns-used)
@@ -646,7 +639,7 @@
(list
(string-append (_ "REF") ": " reference))))))
orders)
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
@@ -671,7 +664,7 @@
table "table"
'attribute (list "border" 0)
'attribute (list "cellpadding" 0))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index 6b6b22c..447d9d1 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -33,13 +33,6 @@
(use-modules (gnucash report standard-reports))
(use-modules (gnucash report business-reports))
-(define (set-last-row-style! table tag . rest)
- (let ((arg-list
- (cons table
- (cons (- (gnc:html-table-num-rows table) 1)
- (cons tag rest)))))
- (apply gnc:html-table-set-row-style! arg-list)))
-
(define (date-col columns-used)
(vector-ref columns-used 0))
(define (description-col columns-used)
@@ -561,7 +554,7 @@
(list
(string-append (_ "REF") ": " reference))))))
orders)
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
@@ -582,7 +575,7 @@
table "table"
'attribute (list "border" 0)
'attribute (list "cellpadding" 0))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
diff --git a/gnucash/report/business-reports/job-report.scm b/gnucash/report/business-reports/job-report.scm
index 8eb55ac..40b2bbf 100644
--- a/gnucash/report/business-reports/job-report.scm
+++ b/gnucash/report/business-reports/job-report.scm
@@ -46,13 +46,6 @@
(define desc-header (N_ "Description"))
(define amount-header (N_ "Amount"))
-(define (set-last-row-style! table tag . rest)
- (let ((arg-list
- (cons table
- (cons (- (gnc:html-table-num-rows table) 1)
- (cons tag rest)))))
- (apply gnc:html-table-set-row-style! arg-list)))
-
(define (date-col columns-used)
(vector-ref columns-used 0))
(define (date-due-col columns-used)
@@ -479,7 +472,7 @@
(gnc:html-table-append-row!
table
(list "<br/>"))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
@@ -497,7 +490,7 @@
table "table"
'attribute (list "border" 0)
'attribute (list "cellpadding" 0))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 89f48cd..20d8e28 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -117,13 +117,6 @@
(else
(_ "Vendor"))))
-(define (set-last-row-style! table tag . rest)
- (let ((arg-list
- (cons table
- (cons (- (gnc:html-table-num-rows table) 1)
- (cons tag rest)))))
- (apply gnc:html-table-set-row-style! arg-list)))
-
(define (date-col columns-used)
(vector-ref columns-used 0))
(define (date-due-col columns-used)
@@ -689,7 +682,7 @@
(gnc:html-table-append-row!
table
(list "<br>"))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
@@ -707,7 +700,7 @@
table "table"
'attribute (list "border" 0)
'attribute (list "cellpadding" 0))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
diff --git a/gnucash/report/report-system/html-table.scm b/gnucash/report/report-system/html-table.scm
index e33e6d6..405e4ad 100644
--- a/gnucash/report/report-system/html-table.scm
+++ b/gnucash/report/report-system/html-table.scm
@@ -756,3 +756,10 @@
(push (gnc:html-document-markup-end doc "table"))
(gnc:html-document-pop-style doc)
retval))
+
+(define (gnc:html-table-set-last-row-style! table tag . rest)
+ (let ((arg-list
+ (cons table
+ (cons (1- (gnc:html-table-num-rows table))
+ (cons tag rest)))))
+ (apply gnc:html-table-set-row-style! arg-list)))
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 1ea0a3f..3ed2b71 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -601,6 +601,7 @@
(export gnc:html-table-set-col-headers-style!)
(export gnc:html-table-row-headers-style)
(export gnc:html-table-set-row-headers-style!)
+(export gnc:html-table-set-last-row-style!)
(export gnc:html-table-set-style!)
(export gnc:html-table-set-col-style!)
(export gnc:html-table-set-row-style!)
diff --git a/gnucash/report/standard-reports/register.scm b/gnucash/report/standard-reports/register.scm
index 063b408..08195b3 100644
--- a/gnucash/report/standard-reports/register.scm
+++ b/gnucash/report/standard-reports/register.scm
@@ -29,13 +29,6 @@
(gnc:module-load "gnucash/report/report-system" 0)
-(define (set-last-row-style! table tag . rest)
- (let ((arg-list
- (cons table
- (cons (- (gnc:html-table-num-rows table) 1)
- (cons tag rest)))))
- (apply gnc:html-table-set-row-style! arg-list)))
-
(define (date-col columns-used)
(vector-ref columns-used 0))
(define (num-col columns-used)
@@ -790,7 +783,7 @@
(list
(string-append (_ "Client") ": ")
(string-expand address #\newline "<br>")))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
@@ -810,7 +803,7 @@
(string-expand (qof-print-date (current-time))
#\space " "))
(make-client-table address)))
- (set-last-row-style!
+ (gnc:html-table-set-last-row-style!
table "td"
'attribute (list "valign" "top"))
table))
commit 97ab1b19fe081e06fe59d994294ae34e70291f75
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat May 5 23:07:52 2018 +0800
test-date-utilities.scm: to SRFI64
Clearer syntax helped find flawed test - while set-tm:mday directly
accepts 1-31, set-tm:mon accepts 0-11 to represent 1-12, therefore
must minus 1. set-tm:year accepts 92 to represent 1992, therefore must
minus 1900.
diff --git a/libgnucash/app-utils/test/CMakeLists.txt b/libgnucash/app-utils/test/CMakeLists.txt
index 2fed2b9..8995b45 100644
--- a/libgnucash/app-utils/test/CMakeLists.txt
+++ b/libgnucash/app-utils/test/CMakeLists.txt
@@ -43,6 +43,9 @@ set(GUILE_DEPENDS
set(test_app_utils_scheme_SOURCES
test-c-interface.scm
test-load-app-utils-module.scm
+)
+
+set (test_app_utils_scheme_SRFI64_SOURCES
test-date-utilities.scm
)
@@ -61,6 +64,11 @@ gnc_add_scheme_targets(scm-test-c-interface
)
gnc_add_scheme_tests("${test_app_utils_scheme_SOURCES}")
+
+if (HAVE_SRFI64)
+ gnc_add_scheme_tests("${test_app_utils_scheme_SRFI64_SOURCES}")
+endif ()
+
# Doesn't work yet:
gnc_add_test_with_guile(test-app-utils "${test_app_utils_SOURCES}" APP_UTILS_TEST_INCLUDE_DIRS APP_UTILS_TEST_LIBS)
diff --git a/libgnucash/app-utils/test/test-date-utilities.scm b/libgnucash/app-utils/test/test-date-utilities.scm
index 1dc30e1..51eb981 100644
--- a/libgnucash/app-utils/test/test-date-utilities.scm
+++ b/libgnucash/app-utils/test/test-date-utilities.scm
@@ -1,10 +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 (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
(define (run-test)
- (and (test test-weeknum-calculator)
- (test test-date-get-quarter-string)))
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-date-utilities.scm")
+ (test-weeknum-calculator)
+ (test-date-get-quarter-string)
+ (test-end "test-date-utilities.scm"))
(define (create-datevec l)
(let ((now (gnc-localtime (current-time))))
@@ -12,8 +17,8 @@
(set-tm:min now (list-ref l 4))
(set-tm:hour now (list-ref l 3))
(set-tm:mday now (list-ref l 2))
- (set-tm:mon now (list-ref l 1))
- (set-tm:year now (list-ref l 0))
+ (set-tm:mon now (1- (list-ref l 1)))
+ (set-tm:year now (- (list-ref l 0) 1900))
(set-tm:isdst now -1)
now))
@@ -28,28 +33,39 @@
(gnc:date-to-week (create-time64 d2)))))
(define (test-weeknum-calculator)
- (and (weeknums-equal? (cons '(1970 1 1 0 0 0)
- '(1970 1 1 23 59 59)))
- (weeknums-equal? (cons '(1969 12 31 0 0 0)
- '(1969 12 31 23 59 59)))
- (weeknums-equal? (cons '(1969 12 31 0 0 0)
- '(1970 1 1 0 0 1)))
- (weeknums-equal? (cons '(2001 1 1 0 0 0)
- '(2001 1 1 23 59 59)))
- (not (weeknums-equal? (cons '(1970 1 1 0 0 0)
- '(1970 1 10 0 0 1))))
- (not (weeknums-equal? (cons '(1969 12 28 0 0 1)
- '(1970 1 5 0 0 1))))
- ))
+ (test-assert "weeknums 1/1/70early = 1/1/70late"
+ (weeknums-equal? (cons '(1970 1 1 0 0 0)
+ '(1970 1 1 23 59 59))))
+
+ (test-assert "weeknums 31/12/69early = 31/12/69late"
+ (weeknums-equal? (cons '(1969 12 31 0 0 0)
+ '(1969 12 31 23 59 59))))
+
+ (test-assert "weeknums 31/12/69 = 1/1/70"
+ (weeknums-equal? (cons '(1969 12 31 0 0 0)
+ '(1970 1 1 0 0 1))))
+
+ (test-assert "weeknums 1/1/01early = 01/01/01 late"
+ (weeknums-equal? (cons '(2001 1 1 0 0 0)
+ '(2001 1 1 23 59 59))))
+
+ (test-assert "weeknums 1/1/70 != 10/1/70"
+ (not (weeknums-equal? (cons '(1970 1 1 0 0 0)
+ '(1970 1 10 0 0 1)))))
+
+ (test-assert "weeknum 28/12/69 != 5/1/70"
+ (not (weeknums-equal? (cons '(1969 12 28 0 0 1)
+ '(1970 1 5 0 0 1))))))
(define (test-date-get-quarter-string)
- (and (or (string=? "Q1" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23))))
- (begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (creaete-datevec '(2001 2 14 11 42 23))))
- #f))
- (or (string=? "Q2" (gnc:date-get-quarter-string (create-datevec '(2013 4 23 18 11 49))))
- (begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23))))
- #f))
- (or (string=? "Q3" (gnc:date-get-quarter-string (create-datevec '(1997 9 11 08 14 21))))
- (begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23)))))
- #f)))
-
+ (test-equal "14/02/2001 = Q1"
+ "Q1"
+ (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23))))
+
+ (test-equal "23/04/2013 = Q2"
+ "Q2"
+ (gnc:date-get-quarter-string (create-datevec '(2013 4 23 18 11 49))))
+
+ (test-equal "11/09/1997 = Q3"
+ "Q3"
+ (gnc:date-get-quarter-string (create-datevec '(1997 9 11 08 14 21)))))
commit 13f31e0691a60af2c1b1e70152060bb76bec92b6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon May 7 19:04:22 2018 +0800
test-extras.scm: (logging-and) is obsolete
Use the much nicer SRFI-64 forms instead.
diff --git a/gnucash/report/report-system/test/test-test-extras.scm b/gnucash/report/report-system/test/test-test-extras.scm
index f551748..676d130 100644
--- a/gnucash/report/report-system/test/test-test-extras.scm
+++ b/gnucash/report/report-system/test/test-test-extras.scm
@@ -24,10 +24,7 @@
(use-modules (ice-9 streams))
(define (run-test)
- (and (logging-and #t)
- (logging-and)
- (not (logging-and #t #f))
- (test-pattern-streamer)
+ (and (test-pattern-streamer)
(test-create-account-structure)))
(define (test-pattern-streamer)
diff --git a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
index 156f48f..248468a 100644
--- a/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
+++ b/gnucash/report/standard-reports/test/test-cashflow-barchart.scm
@@ -39,9 +39,9 @@
(setlocale LC_ALL "C")
(define (run-test)
- (logging-and (test-in-txn)
- (test-out-txn)
- (test-null-txn)))
+ (and (test-in-txn)
+ (test-out-txn)
+ (test-null-txn)))
(define (set-option report page tag value)
diff --git a/gnucash/report/standard-reports/test/test-generic-net-barchart.scm b/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
index c4a4bc2..d8585bb 100644
--- a/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
+++ b/gnucash/report/standard-reports/test/test-generic-net-barchart.scm
@@ -40,15 +40,15 @@
(define constructor (record-constructor <report>))
(define (run-net-asset-income-test asset-report-uuid income-report-uuid)
- (logging-and (two-txn-test asset-report-uuid)
- (two-txn-test-2 asset-report-uuid)
- (two-txn-test-income income-report-uuid)
+ (and (two-txn-test asset-report-uuid)
+ (two-txn-test-2 asset-report-uuid)
+ (two-txn-test-income income-report-uuid)
- (null-test asset-report-uuid)
- (null-test income-report-uuid)
- (single-txn-test asset-report-uuid)
- (closing-test income-report-uuid)
- #t))
+ (null-test asset-report-uuid)
+ (null-test income-report-uuid)
+ (single-txn-test asset-report-uuid)
+ (closing-test income-report-uuid)
+ #t))
;; Just prove that the report exists.
(define (null-test uuid)
diff --git a/gnucash/report/standard-reports/test/test-generic-net-linechart.scm b/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
index 4b12934..a59197a 100644
--- a/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
+++ b/gnucash/report/standard-reports/test/test-generic-net-linechart.scm
@@ -40,13 +40,11 @@
(define constructor (record-constructor <report>))
(define (run-net-asset-test asset-report-uuid)
- (logging-and (two-txn-test asset-report-uuid)
- (two-txn-test-2 asset-report-uuid)
+ (and (two-txn-test asset-report-uuid)
+ (two-txn-test-2 asset-report-uuid)
- (null-test asset-report-uuid)
- (single-txn-test asset-report-uuid)
-
- #t))
+ (null-test asset-report-uuid)
+ (single-txn-test asset-report-uuid)))
;; Just prove that the report exists.
(define (null-test uuid)
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index 9309e56..32712a6 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -27,7 +27,6 @@
(use-modules (sw_app_utils))
(use-modules (sw_engine))
-(export logging-and)
(export test)
(export with-account)
@@ -55,15 +54,6 @@
;; Random test related syntax and the like
;;
-;; logging-and is mostly for debugging tests
-(define-macro (logging-and . args)
- (cons 'and (map (lambda (arg)
- (list 'begin
- (list 'format #t "Test: ~a\n" (list 'quote arg))
- arg))
- args)))
-
-;; ..and 'test' gives nicer output
(define (test the-test)
(format #t "(Running ~a " the-test)
(let ((result (the-test)))
diff --git a/libgnucash/engine/test/test-test-extras.scm b/libgnucash/engine/test/test-test-extras.scm
index e735dae..cc70e6f 100644
--- a/libgnucash/engine/test/test-test-extras.scm
+++ b/libgnucash/engine/test/test-test-extras.scm
@@ -26,10 +26,7 @@
(use-modules (sw_engine))
(define (run-test)
- (and (logging-and #t)
- (logging-and)
- (not (logging-and #t #f))
- (test-create-account-structure)))
+ (test-create-account-structure))
(define (test-create-account-structure)
(let ((env (create-test-env)))
commit 5e0fc04f7ba8df4ed28823cc9248b5dae7c66f4c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun May 6 22:58:38 2018 +0800
test-extras.scm: remove dead code
These functions are never used through code.
diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm
index 7184d84..aef5a94 100644
--- a/gnucash/report/report-system/test/test-extras.scm
+++ b/gnucash/report/report-system/test/test-extras.scm
@@ -26,19 +26,12 @@
(export pattern-streamer)
-(export create-option-set)
-(export option-set-setter)
-(export option-set-getter)
-
(export tbl-column-count)
(export tbl-row-count)
(export tbl-ref)
(export tbl-ref->number)
(export gnc:options->sxml)
-;;
-;; Random report test related syntax and the like
-;;
;;
;; Table parsing
@@ -91,71 +84,6 @@
(define (tbl-ref->number tbl row-index column-index)
(string->number (car (tbl-ref tbl row-index column-index))))
-;;
-;; Test sinks
-;;
-
-(define (make-test-sink) (list 'sink 0 '()))
-
-(define (test-sink-count sink)
- (second sink))
-
-(define (test-sink-count! sink value)
- (set-car! (cdr sink) value))
-
-(define (test-sink-messages sink)
- (third sink))
-
-(define (test-sink-messages! sink messages)
- (set-car! (cdr (cdr sink)) messages))
-
-(define (test-sink-check sink message flag)
- (test-sink-count! sink (+ (test-sink-count sink) 1))
- (if flag #t
- (test-sink-messages! sink (cons message (test-sink-messages sink)))))
-
-(define (test-sink-report sink)
- (format #t "Completed ~a tests ~a\n"
- (test-sink-count sink)
- (if (null? (test-sink-messages sink)) "PASS" "FAIL"))
- (if (null? (test-sink-messages sink)) #t
- (begin (for-each (lambda (delayed-message)
- (delayed-format-render #t delayed-message))
- (test-sink-messages sink))
- #f)))
-
-(define (delayed-format . x) x)
-
-(define (delayed-format-render stream msg)
- (apply format stream msg))
-
-;;
-;; options
-;;
-
-
-(define (create-option-set)
- (make-hash-table) )
-
-(define (option-set-setter option-set)
- (lambda (category name value)
- (hash-set! option-set (list category name) value)))
-
-(define (option-set-getter option-set)
- (lambda (category name)
- (hash-ref option-set (list category name))))
-
-;;
-;;
-;;
-
-(define (report-show-options stream expense-options)
- (gnc:options-for-each (lambda (option)
- (format stream "Option: ~a.~a Value ~a\n"
- (gnc:option-section option)
- (gnc:option-name option)
- (gnc:option-value option)))
- expense-options))
(define (gnc:options->sxml uuid options prefix test-title)
;; uuid - str to locate report uuid
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index 1d76b19..9309e56 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -29,13 +29,6 @@
(export logging-and)
(export test)
-(export make-test-sink)
-(export env-test-sink)
-(export test-sink-report)
-(export test-sink-check)
-
-(export delayed-format)
-(export delayed-format-render)
(export with-account)
(export with-transaction)
@@ -112,8 +105,7 @@
(define (create-test-env)
(list (cons 'random (seed->random-state (random 1000)))
- (cons 'counter (make-counter))
- (cons 'sink (make-test-sink))))
+ (cons 'counter (make-counter))))
(define (env-random-amount env n)
(/ (env-random env n) 1))
@@ -130,9 +122,6 @@
(define (env-select-price-source env)
'pricedb-nearest)
-(define (env-test-sink env)
- (assoc-ref env 'sink))
-
(define (env-any-date env) (gnc:get-today))
(define (env-create-transaction env date credit debit aaa)
@@ -324,69 +313,5 @@
(list "Other")
(list "Expenses"
(list (cons 'type ACCT-TYPE-EXPENSE))))))
-;;
-;; Test sinks
-;;
-
-(define (make-test-sink) (list 'sink 0 '()))
-
-(define (test-sink-count sink)
- (second sink))
-
-(define (test-sink-count! sink value)
- (set-car! (cdr sink) value))
-
-(define (test-sink-messages sink)
- (third sink))
-
-(define (test-sink-messages! sink messages)
- (set-car! (cdr (cdr sink)) messages))
-
-(define (test-sink-check sink message flag)
- (test-sink-count! sink (+ (test-sink-count sink) 1))
- (if flag #t
- (test-sink-messages! sink (cons message (test-sink-messages sink)))))
-
-(define (test-sink-report sink)
- (format #t "Completed ~a tests ~a\n"
- (test-sink-count sink)
- (if (null? (test-sink-messages sink)) "PASS" "FAIL"))
- (if (null? (test-sink-messages sink)) #t
- (begin (for-each (lambda (delayed-message)
- (delayed-format-render #t delayed-message))
- (test-sink-messages sink))
- #f)))
-
-(define (delayed-format . x) x)
-
-(define (delayed-format-render stream msg)
- (apply format stream msg))
-
-;;
-;; options
-;;
-
-
-(define (create-option-set)
- (make-hash-table) )
-
-(define (option-set-setter option-set)
- (lambda (category name value)
- (hash-set! option-set (list category name) value)))
-
-(define (option-set-getter option-set)
- (lambda (category name)
- (hash-ref option-set (list category name))))
-
-;;
-;;
-;;
-(define (report-show-options stream expense-options)
- (gnc:options-for-each (lambda (option)
- (format stream "Option: ~a.~a Value ~a\n"
- (gnc:option-section option)
- (gnc:option-name option)
- (gnc:option-value option)))
- expense-options))
commit 8ddee96463795fd89ad6ca8359c1a64911feb361
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun May 6 20:44:36 2018 +0800
test-extras.scm: centralize (gnc:options->sxml)
I think this is useful enough to be upgraded.
diff --git a/gnucash/report/report-system/test/test-extras.scm b/gnucash/report/report-system/test/test-extras.scm
index a150f38..7184d84 100644
--- a/gnucash/report/report-system/test/test-extras.scm
+++ b/gnucash/report/report-system/test/test-extras.scm
@@ -21,6 +21,8 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash report report-system))
+(use-modules (sxml simple))
(export pattern-streamer)
@@ -33,6 +35,7 @@
(export tbl-ref)
(export tbl-ref->number)
+(export gnc:options->sxml)
;;
;; Random report test related syntax and the like
;;
@@ -154,3 +157,38 @@
(gnc:option-value option)))
expense-options))
+(define (gnc:options->sxml uuid options prefix test-title)
+ ;; uuid - str to locate report uuid
+ ;; options object -> sxml tree
+ ;; prefix - str describing tests e.g. "test-trep"
+ ;; test-title: str describing each unit test e.g. "test disable filter"
+ ;;
+ ;; This function abstracts the report renderer. It also catches XML
+ ;; parsing errors, dumping the options changed.
+ ;;
+ ;; It also dumps the render into /tmp/XX-YY.html where XX is the
+ ;; test prefix and YY is the test title.
+
+ (let* ((template (gnc:find-report-template uuid))
+ (constructor (record-constructor <report>))
+ (report (constructor uuid "bar" options #t #t #f #f ""))
+ (renderer (gnc:report-template-renderer template))
+ (document (renderer report))
+ (sanitize-char (lambda (c)
+ (if (char-alphabetic? c) c #\-)))
+ (fileprefix (string-map sanitize-char prefix))
+ (filename (string-map sanitize-char test-title)))
+ (gnc:html-document-set-style-sheet! document (gnc:report-stylesheet report))
+ (if test-title
+ (gnc:html-document-set-title! document test-title))
+ (let* ((filename (format #f "/tmp/~a-~a.html" fileprefix filename))
+ (render (gnc:html-document-render document)))
+ (with-output-to-file filename
+ (lambda ()
+ (display render)))
+ (catch 'parser-error
+ (lambda () (xml->sxml render))
+ (lambda (k . args)
+ (format #t "*** XML error. see render output at ~a\n~a"
+ filename (gnc:html-render-options-changed options #t))
+ (throw k args))))))
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index 1dfa2fd..7a88e59 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -91,24 +91,7 @@
;; It also catches XML parsing errors, dumping the options changed.
;;
;; It also dumps the render into /tmp/test-trep-XX.html where XX is the test title
- (let* ((template (gnc:find-report-template trep-uuid))
- (report (constructor trep-uuid "bar" options #t #t #f #f ""))
- (renderer (gnc:report-template-renderer template))
- (document (renderer report))
- (filename (string-map (lambda (c) (if (char-alphabetic? c) c #\-)) test-title)))
- (gnc:html-document-set-style-sheet! document (gnc:report-stylesheet report))
- (if test-title
- (gnc:html-document-set-title! document test-title))
- (let* ((filename (format #f "/tmp/test-trep-~a.html" filename))
- (render (gnc:html-document-render document))
- (outfile (open-file filename "w")))
- (display render outfile)
- (close-output-port outfile)
- (catch 'parser-error
- (lambda () (xml->sxml render))
- (lambda (k . args)
- (test-assert k #f) ; XML parse error doesn't cause a crash but logs as a failure
- (format #t "see render output at ~a\n~a" filename (gnc:html-render-options-changed options #t)))))))
+ (gnc:options->sxml trep-uuid options "test-trep" test-title))
(define (get-row-col sxml row col)
;; sxml, row & col (numbers or #f) -> list-of-string
@@ -135,8 +118,6 @@
;; END CANDIDATES
;;
-(define constructor (record-constructor <report>))
-
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))
(if option
commit c6032ac6ed52f44b112dee4c5cf0ed9d261a437e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun May 6 20:43:32 2018 +0800
srfi64-extras.scm: centralize (gnc:test-runner)
This is good enough to be used widely.
diff --git a/gnucash/report/report-system/test/test-html-utilities-srfi64.scm b/gnucash/report/report-system/test/test-html-utilities-srfi64.scm
index 5c46793..ef712c7 100644
--- a/gnucash/report/report-system/test/test-html-utilities-srfi64.scm
+++ b/gnucash/report/report-system/test/test-html-utilities-srfi64.scm
@@ -6,37 +6,11 @@
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report report-system))
+(use-modules (gnucash engine test srfi64-extras))
(use-modules (srfi srfi-64))
-(define (test-runner)
- (let ((runner (test-runner-null))
- (num-passed 0)
- (num-failed 0))
- (test-runner-on-test-end! runner
- (lambda (runner)
- (format #t "[~a] line:~a, test: ~a\n"
- (test-result-ref runner 'result-kind)
- (test-result-ref runner 'source-line)
- (test-runner-test-name runner))
- (case (test-result-kind runner)
- ((pass xpass) (set! num-passed (1+ num-passed)))
- ((fail xfail)
- (if (test-result-ref runner 'expected-value)
- (format #t "~a\n -> expected: ~s\n -> obtained: ~s\n"
- (string-join (test-runner-group-path runner) "/")
- (test-result-ref runner 'expected-value)
- (test-result-ref runner 'actual-value)))
- (set! num-failed (1+ num-failed)))
- (else #t))))
- (test-runner-on-final! runner
- (lambda (runner)
- (format #t "Source:~a\npass = ~a, fail = ~a\n"
- (test-result-ref runner 'source-file) num-passed num-failed)
- (zero? num-failed)))
- runner))
-
(define (run-test)
- (test-runner-factory test-runner)
+ (test-runner-factory gnc:test-runner)
(test-begin "test-html-utilities-srfi64.scm")
(test-gnc:html-string-sanitize)
(test-end "test-html-utilities-srfi64.scm"))
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index 29e8e48..1dfa2fd 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -6,6 +6,7 @@
(use-modules (gnucash report report-system))
(use-modules (gnucash report report-system test test-extras))
(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
(use-modules (sxml simple))
(use-modules (sxml xpath))
(use-modules (system vm coverage))
@@ -42,33 +43,6 @@
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
-(define (test-runner)
- (let ((runner (test-runner-null))
- (num-passed 0)
- (num-failed 0))
- (test-runner-on-test-end! runner
- (lambda (runner)
- (format #t "[~a] line:~a, test: ~a\n"
- (test-result-ref runner 'result-kind)
- (test-result-ref runner 'source-line)
- (test-runner-test-name runner))
- (case (test-result-kind runner)
- ((pass xpass) (set! num-passed (1+ num-passed)))
- ((fail xfail)
- (if (test-result-ref runner 'expected-value)
- (format #t "~a\n -> expected: ~s\n -> obtained: ~s\n"
- (string-join (test-runner-group-path runner) "/")
- (test-result-ref runner 'expected-value)
- (test-result-ref runner 'actual-value)))
- (set! num-failed (1+ num-failed)))
- (else #t))))
- (test-runner-on-final! runner
- (lambda (runner)
- (format #t "Source:~a\npass = ~a, fail = ~a\n"
- (test-result-ref runner 'source-file) num-passed num-failed)
- (zero? num-failed)))
- runner))
-
(define (run-test)
(if #f
(coverage-test)
@@ -86,7 +60,7 @@
(close port)))))
(define (run-test-proper)
- (test-runner-factory test-runner)
+ (test-runner-factory gnc:test-runner)
(test-begin "transaction.scm")
(null-test)
(trep-tests)
diff --git a/libgnucash/engine/test/CMakeLists.txt b/libgnucash/engine/test/CMakeLists.txt
index 587c0eb..7d698f5 100644
--- a/libgnucash/engine/test/CMakeLists.txt
+++ b/libgnucash/engine/test/CMakeLists.txt
@@ -233,6 +233,20 @@ gnc_add_scheme_targets(scm-test-engine-extras
FALSE
)
+if (HAVE_SRFI64)
+ gnc_add_scheme_targets (scm-srfi64-extras
+ "srfi64-extras.scm"
+ "gnucash/engine/test/"
+ "${GUILE_DEPENDS}"
+ FALSE
+ )
+
+ set(srfi64_extras_SCHEME_DIST
+ srfi64-extras.scm
+ )
+
+endif (HAVE_SRFI64)
+
gnc_add_scheme_targets(scm-test-engine
"${engine_test_SCHEME}"
""
@@ -311,4 +325,5 @@ set(test_engine_EXTRA_DIST
)
set_dist_list(test_engine_DIST CMakeLists.txt
+ ${srfi64_extras_SCHEME_DIST}
${test_engine_SOURCES_DIST} ${test_engine_SCHEME_DIST} ${test_engine_EXTRA_DIST})
diff --git a/libgnucash/engine/test/srfi64-extras.scm b/libgnucash/engine/test/srfi64-extras.scm
new file mode 100644
index 0000000..81329b2
--- /dev/null
+++ b/libgnucash/engine/test/srfi64-extras.scm
@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-module (gnucash engine test srfi64-extras))
+(use-modules (srfi srfi-64))
+
+(export gnc:test-runner)
+(define (gnc:test-runner)
+ (let ((runner (test-runner-null))
+ (num-passed 0)
+ (num-failed 0))
+ (test-runner-on-test-end! runner
+ (lambda (runner)
+ (format #t "[~a] line:~a, test: ~a\n"
+ (test-result-ref runner 'result-kind)
+ (test-result-ref runner 'source-line)
+ (test-runner-test-name runner))
+ (case (test-result-kind runner)
+ ((pass xpass) (set! num-passed (1+ num-passed)))
+ ((fail xfail)
+ (if (test-result-ref runner 'expected-value)
+ (format #t "~a\n -> expected: ~s\n -> obtained: ~s\n"
+ (string-join (test-runner-group-path runner) "/")
+ (test-result-ref runner 'expected-value)
+ (test-result-ref runner 'actual-value)))
+ (set! num-failed (1+ num-failed)))
+ (else #t))))
+ (test-runner-on-final! runner
+ (lambda (runner)
+ (format #t "Source:~a\npass = ~a, fail = ~a\n"
+ (test-result-ref runner 'source-file) num-passed num-failed)
+ (zero? num-failed)))
+ runner))
commit dda6730c44b82df6881baa083d78a87da4a916c6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu May 3 08:52:59 2018 +0800
utilities.scm: centralize and modernize addto!
(define-macro) is discouraged in most scheme forms. Change
to (define-syntax), and centralize common macro to utilities.scm
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 34ca9d5..376bc0a 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -97,9 +97,6 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
-
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
diff --git a/gnucash/report/business-reports/easy-invoice.scm b/gnucash/report/business-reports/easy-invoice.scm
index 439e592..eb294b0 100644
--- a/gnucash/report/business-reports/easy-invoice.scm
+++ b/gnucash/report/business-reports/easy-invoice.scm
@@ -33,14 +33,12 @@
(use-modules (srfi srfi-1))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
+(use-modules (gnucash utilities))
(gnc:module-load "gnucash/report/report-system" 0)
(use-modules (gnucash report standard-reports))
(use-modules (gnucash report business-reports))
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
-
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
diff --git a/gnucash/report/business-reports/fancy-invoice.scm b/gnucash/report/business-reports/fancy-invoice.scm
index 64c36c2..ddb2794 100644
--- a/gnucash/report/business-reports/fancy-invoice.scm
+++ b/gnucash/report/business-reports/fancy-invoice.scm
@@ -51,14 +51,12 @@
(use-modules (srfi srfi-1))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
+(use-modules (gnucash utilities))
(gnc:module-load "gnucash/report/report-system" 0)
(use-modules (gnucash report standard-reports))
(use-modules (gnucash report business-reports))
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
-
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index 7129849..6b6b22c 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -27,14 +27,12 @@
(use-modules (srfi srfi-1))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
+(use-modules (gnucash utilities))
(gnc:module-load "gnucash/report/report-system" 0)
(use-modules (gnucash report standard-reports))
(use-modules (gnucash report business-reports))
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
-
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
diff --git a/gnucash/report/business-reports/job-report.scm b/gnucash/report/business-reports/job-report.scm
index b377f94..8eb55ac 100644
--- a/gnucash/report/business-reports/job-report.scm
+++ b/gnucash/report/business-reports/job-report.scm
@@ -46,9 +46,6 @@
(define desc-header (N_ "Description"))
(define amount-header (N_ "Amount"))
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
-
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 39010d5..89f48cd 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -117,9 +117,6 @@
(else
(_ "Vendor"))))
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
-
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
diff --git a/gnucash/report/report-system/html-utilities.scm b/gnucash/report/report-system/html-utilities.scm
index 6fbe9ce..a701ff2 100644
--- a/gnucash/report/report-system/html-utilities.scm
+++ b/gnucash/report/report-system/html-utilities.scm
@@ -22,6 +22,8 @@
;; 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)
@@ -854,7 +856,7 @@
(disp value))))
(if (not (or (equal? default-value value)
(char=? (string-ref section 0) #\_)))
- (set! render-list (cons retval render-list)))))
+ (addto! render-list retval))))
(gnc:options-for-each add-option-if-changed options)
(if plaintext?
(string-append
diff --git a/gnucash/report/standard-reports/register.scm b/gnucash/report/standard-reports/register.scm
index 029e9ac..063b408 100644
--- a/gnucash/report/standard-reports/register.scm
+++ b/gnucash/report/standard-reports/register.scm
@@ -29,9 +29,6 @@
(gnc:module-load "gnucash/report/report-system" 0)
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
-
(define (set-last-row-style! table tag . rest)
(let ((arg-list
(cons table
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 016b3e1..26c3529 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -40,7 +40,7 @@
(define-module (gnucash report standard-reports transaction))
-(use-modules (gnucash utilities))
+(use-modules (gnucash utilities))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-11))
(use-modules (srfi srfi-13))
@@ -50,9 +50,6 @@
(gnc:module-load "gnucash/report/report-system" 0)
-(define-macro (addto! alist element)
- `(set! ,alist (cons ,element ,alist)))
-
;; Define the strings here to avoid typos and make changes easier.
(define reportname (N_ "Transaction Report"))
diff --git a/libgnucash/scm/utilities.scm b/libgnucash/scm/utilities.scm
index 4a75c02..f34fbd9 100644
--- a/libgnucash/scm/utilities.scm
+++ b/libgnucash/scm/utilities.scm
@@ -42,6 +42,7 @@
(export gnc:error)
(export gnc:msg)
(export gnc:debug)
+(export addto!)
;; Do this stuff very early -- but other than that, don't add any
;; executable code until the end of the file if you can help it.
@@ -71,6 +72,10 @@
(define (gnc:debug . items)
(gnc-scm-log-debug (strify items)))
+(define-syntax addto!
+ (syntax-rules ()
+ ((addto! alist element)
+ (set! alist (cons element alist)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:substring-replace
commit 4a27285edd956b37f54eb2f9c94b144f5b48edb7
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Apr 29 07:32:20 2018 +0800
html-utilities.scm: new home (gnc:html-render-options-changed)
We want to sanitize render-options-changed, therefore it must return
an html-object. Unfortunately this is not accessible to
app-utils/options.scm. If we move this function to
report-system/html-utilities.scm, it can access html-objects.
Also rename it to gnc:html-render-options-changed
diff --git a/gnucash/report/report-system/html-utilities.scm b/gnucash/report/report-system/html-utilities.scm
index 637cfe0..6fbe9ce 100644
--- a/gnucash/report/report-system/html-utilities.scm
+++ b/gnucash/report/report-system/html-utilities.scm
@@ -818,6 +818,65 @@
"")
(_ "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) #\_)))
+ (set! render-list (cons retval render-list)))))
+ (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)
@@ -877,3 +936,5 @@
((#\>) ">")
(else c))))
str))))
+
+
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index d305d54..1ea0a3f 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -112,6 +112,7 @@
(export gnc:html-build-acct-table)
(export gnc:first-html-build-acct-table)
(export gnc:html-make-exchangerates)
+(export gnc:html-render-options-changed)
(export gnc:html-make-generic-warning)
(export gnc:html-make-no-account-warning)
(export gnc:html-make-generic-budget-warning)
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index 9ea0d5e..29e8e48 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -134,7 +134,7 @@
(lambda () (xml->sxml render))
(lambda (k . args)
(test-assert k #f) ; XML parse error doesn't cause a crash but logs as a failure
- (format #t "see render output at ~a\n~a" filename (gnc:render-options-changed options #t)))))))
+ (format #t "see render output at ~a\n~a" filename (gnc:html-render-options-changed options #t)))))))
(define (get-row-col sxml row col)
;; sxml, row & col (numbers or #f) -> list-of-string
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index fc99b40..016b3e1 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1880,7 +1880,7 @@ be excluded from periodic reporting.")
(if (memq infobox-display '(always no-match))
(gnc:html-document-add-object!
document
- (gnc:render-options-changed options))))
+ (gnc:html-render-options-changed options))))
(begin
@@ -1956,7 +1956,7 @@ be excluded from periodic reporting.")
(if (memq infobox-display '(always no-match))
(gnc:html-document-add-object!
document
- (gnc:render-options-changed options))))
+ (gnc:html-render-options-changed options))))
(let-values (((table grid) (make-split-table splits options custom-calculated-cells)))
@@ -1985,7 +1985,7 @@ be excluded from periodic reporting.")
(if (eq? infobox-display 'always)
(gnc:html-document-add-object!
document
- (gnc:render-options-changed options)))
+ (gnc:html-render-options-changed options)))
(gnc:html-document-add-object! document table)))))
diff --git a/libgnucash/app-utils/app-utils.scm b/libgnucash/app-utils/app-utils.scm
index a3d838a..e462d69 100644
--- a/libgnucash/app-utils/app-utils.scm
+++ b/libgnucash/app-utils/app-utils.scm
@@ -101,7 +101,6 @@
(export gnc:make-radiobutton-option)
(export gnc:make-radiobutton-callback-option)
(export gnc:make-list-option)
-(export gnc:render-options-changed)
(export gnc:options-make-end-date!)
(export gnc:options-make-date-interval!)
(export gnc:option-make-internal!)
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index fd82e21..f460f95 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -2001,64 +2001,6 @@
(gnc:option-value src-option)))))
src-options)))
-(define* (gnc:render-options-changed options #:optional plaintext?)
- ;;
- ;; options -> string
- ;;
- ;; this function will generate an string of options that were changed by the user.
- ;; by default, it produces an html string.
- ;; the optional plaintext? = #t will ensure the output is suitable for console output
- ;; omitting all html elements, and is expected to be used for unit tests only.
- ;;
- (let ((row-contents '()))
- (define (disp d)
- ;; this function will intelligently display the option value. the option-value is subject to various tests
- ;; the or clause below will test for boolean, null, list, and pairs. each will trigger a custom function
- ;; returning a string. the pair option is handled differently because its car will define the data type
- ;; for its cdr which is either a symbol, time64 number, percent or pixels. if the option does not satisfy
- ;; any of the above, the function attempts to pass it as a parameter to gnc-commodity-get-mnemonic, or
- ;; xaccAccountGetName, or gnc-budget-get-name; success leads to application of these functions, failure
- ;; then leads to a generic stringify function which will handle symbol/string/other types.
- (define (try thunk arg)
- ;; this helper function will attempt to run thunk with arg as a parameter. we will catch any
- ;; 'wrong-type-arg exception, and return the #f value to the or evaluator below.
- (catch 'wrong-type-arg
- (lambda () (thunk arg))
- (lambda (k . args) #f)))
- (or (and (boolean? d) (if d (_ "Enabled") (_ "Disabled")))
- (and (null? d) "null")
- (and (list? d) (string-join (map disp d) ", "))
- (and (pair? d) (string-append
- (disp (car d)) " . "
- (case (car d)
- ((relative) (symbol->string (cdr d)))
- ((absolute) (qof-print-date (cdr d)))
- ((pixels percent) (number->string (cdr d)))
- (else (format #f "unknown car of pair, cannot determine format for ~A" (cdr d))))))
- (try gnc-commodity-get-mnemonic d)
- (try xaccAccountGetName d)
- (try gnc-budget-get-name d)
- (format #f "~A" d)))
- (define (disp-option-if-changed option)
- ;; this function is called by gnc:options-for-each on each option, and will test whether default value
- ;; has been changed and the option is not hidden, and display it using (disp val) as above.
- (let* ((section (gnc:option-section option))
- (name (gnc:option-name option))
- (default-value (gnc:option-default-value option))
- (value (gnc:option-value option))
- (return-string (string-append (if plaintext? "" "<b>")
- section " / " name
- (if plaintext? "" "</b>")
- ": "
- (disp value))))
- (if (not (or (equal? default-value value)
- (char=? (string-ref section 0) #\_)))
- (set! row-contents (cons return-string row-contents)))))
- (gnc:options-for-each disp-option-if-changed options)
- (string-append (string-join (reverse row-contents)
- (if plaintext? "\n" "<br />\n"))
- (if plaintext? "\n\n" "<br />\n<br />\n"))))
-
(define (gnc:send-options db_handle options)
(gnc:options-for-each
(lambda (option)
commit 44a568bc457022a4bea7c8b55d304e80a11aa6ba
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Apr 29 18:36:49 2018 +0800
GSTR: sanitize string
Instead of returning raw html string, return an html-object.
diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm
index 82d6bb7..6aa289a 100644
--- a/gnucash/report/standard-reports/income-gst-statement.scm
+++ b/gnucash/report/standard-reports/income-gst-statement.scm
@@ -35,24 +35,27 @@
(use-modules (gnucash report standard-reports transaction))
;; Define the strings here to avoid typos and make changes easier.
-(define reportname (N_ "Income & GST Statement"))
+(define reportname (N_ "Income and GST Statement"))
(define pagename-sorting (N_ "Sorting"))
(define pagename-filter (N_ "Filter"))
(define TAX-SETUP-DESC
- (string-append
+ (gnc:make-html-text
(_ "This report is useful to calculate periodic business tax payable/receivable from
- authorities. From <i>Edit report options</i> above, choose your Business Income and Business Expense accounts.
+ authorities. From 'Edit report options' above, choose your Business Income and Business Expense accounts.
Each transaction may contain, in addition to the accounts payable/receivable or bank accounts,
a split to a tax account, e.g. Income:Sales -$1000, Liability:GST on Sales -$100, Asset:Bank $1100.")
- "<br/><br/>"
+ (gnc:html-markup-br)
+ (gnc:html-markup-br)
(_ "These tax accounts can either be populated using the standard register, or from Business Invoices and Bills
- which will require Business > Sales Tax Tables to be set up correctly. Please see the documentation.")
- "<br/><br/>"
+ which will require Tax Tables to be set up correctly. Please see the documentation.")
+ (gnc:html-markup-br)
+ (gnc:html-markup-br)
(_ "From the Report Options, you will need to select the accounts which will \
hold the GST/VAT taxes collected or paid. These accounts must contain splits which document the \
monies which are wholly sent or claimed from tax authorities during periodic GST/VAT returns. These \
accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
- "<br/><br/>"))
+ (gnc:html-markup-br)
+ (gnc:html-markup-br)))
(define (income-gst-statement-renderer rpt)
(trep-renderer rpt
commit fd02871678a79653880e9a6dca7892edd0bf569a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu May 3 17:19:36 2018 +0800
TR: sanitize string
This will change the HTML slightly, so, requires an update to the test
suite.
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index b359f2e..9ea0d5e 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -797,10 +797,10 @@
(set-option! options "Sorting" "Show Account Description" #t)
(let* ((sxml (options->sxml options "sorting=date")))
(test-equal "expense acc friendly headers"
- '("\n" "Expenses" "Expense" "Rebate")
+ '("\n" "Expenses" "\n" "Expense" "\n" "Rebate")
(get-row-col sxml 47 #f))
(test-equal "income acc friendly headers"
- '("\n" "Income" "Charge" "Income")
+ '("\n" "Income" "\n" "Charge" "\n" "Income")
(get-row-col sxml 69 #f)))
(set-option! options "Accounts" "Accounts" (list bank))
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 9a2e522..fc99b40 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1300,11 +1300,10 @@ be excluded from periodic reporting.")
1 (+ right-indent width-left-columns) data)))
(for-each (lambda (cell)
(addto! row-contents
- (gnc:make-html-table-cell
- "<b>"
- ((vector-ref cell 5)
- ((keylist-get-info sortkey-list sortkey 'renderer-fn) split))
- "</b>")))
+ (gnc:make-html-text
+ (gnc:html-markup-b
+ ((vector-ref cell 5)
+ ((keylist-get-info sortkey-list sortkey 'renderer-fn) split))))))
calculated-cells))
(addto! row-contents (gnc:make-html-table-cell/size
1 (+ right-indent width-left-columns width-right-columns) data)))
commit d68ccc330628d56178d2dd0d83bde8d084663ba6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu May 3 21:59:22 2018 +0800
TR: rename some variable names to be more descriptive
The previous names were remnants of old transaction.scm and were not
exactly consistent. Use more descriptive names.
The only user-visible change is elimination of <br/> in the
common-currency account header, because this will be sanitized. The
table col-headers cannot unfortunately accept a (gnc:make-html-text)
object therefore we cannot add <br/> at all. I vote to display
e.g. "Debit (USD)" instead.
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index 6b27989..b359f2e 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -354,7 +354,7 @@
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'monthly)
(let ((sxml (options->sxml options "test basic column headers, and original currency")))
(test-equal "default headers, indented, includes common-currency"
- '(" " " " "Date" "Num" "Description" "Memo/Notes" "Account" "Amount" "USD" "Amount")
+ '(" " " " "Date" "Num" "Description" "Memo/Notes" "Account" "Amount (USD)" "Amount")
(get-row-col sxml 0 #f))
(test-equal "grand total present, no blank cells, and is $2,280 in both common-currency and original-currency"
'("Grand Total" "$2,280.00" "$2,280.00")
@@ -614,7 +614,7 @@
(let* ((sxml (options->sxml options "single column, with original currency headers")))
(test-equal "single amount column, with original currency headers"
(list "Date" "Num" "Description" "Memo/Notes" "Account"
- "Amount" "USD" "Amount")
+ "Amount (USD)" "Amount")
(get-row-col sxml 0 #f)))
(set-option! options "Display" "Amount" 'double)
@@ -631,7 +631,7 @@
;; output here too.
(test-equal "dual amount headers"
(list "Date" "Num" "Description" "Memo/Notes" "Account" "Transfer from/to"
- "Debit" "USD" "Credit" "USD" "Debit" "Credit")
+ "Debit (USD)" "Credit (USD)" "Debit" "Credit")
(get-row-col sxml 0 #f))
(test-equal "Account Name and Code displayed"
(list "01-GBP Root.Asset.GBP Bank")
@@ -693,7 +693,7 @@
(let* ((sxml (options->sxml options "dual columns")))
(test-equal "dual amount column, with original currency headers"
(list "Date" "Num" "Description" "Memo/Notes" "Account"
- "Debit" "USD" "Credit" "USD" "Debit" "Credit")
+ "Debit (USD)" "Credit (USD)" "Debit" "Credit")
(get-row-col sxml 0 #f))
(test-equal "dual amount column, grand totals available"
(list "Grand Total" " " " " " " " " "$2,280.00" "$2,280.00")
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 00bcf6d..9a2e522 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1156,48 +1156,42 @@ be excluded from periodic reporting.")
(define default-calculated-cells
(letrec
- ((damount (lambda (s) (if (gnc:split-voided? s)
- (xaccSplitVoidFormerAmount s)
- (xaccSplitGetAmount s))))
- (trans-date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
- (currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
- (report-currency (lambda (s) (if (column-uses? 'common-currency)
- (opt-val gnc:pagename-general optname-currency)
- (currency s))))
+ ((split-amount (lambda (s) (if (gnc:split-voided? s)
+ (xaccSplitVoidFormerAmount s)
+ (xaccSplitGetAmount s))))
+ (split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s))))
+ (row-currency (lambda (s) (if (column-uses? 'common-currency)
+ (opt-val gnc:pagename-general optname-currency)
+ (split-currency s))))
(friendly-debit (lambda (a) (gnc:get-debit-string (xaccAccountGetType a))))
(friendly-credit (lambda (a) (gnc:get-credit-string (xaccAccountGetType a))))
(header-commodity (lambda (str)
(string-append
str
(if (column-uses? 'common-currency)
- (string-append
- "<br />"
- (gnc-commodity-get-mnemonic
- (opt-val gnc:pagename-general optname-currency)))
+ (format #f " (~a)"
+ (gnc-commodity-get-mnemonic
+ (opt-val gnc:pagename-general optname-currency)))
""))))
- (convert (lambda (s num)
- (gnc:exchange-by-pricedb-nearest
- (gnc:make-gnc-monetary (currency s) num)
- (report-currency s)
- ;; Use midday as the transaction time so it matches a price
- ;; on the same day. Otherwise it uses midnight which will
- ;; likely match a price on the previous day
- (time64CanonicalDayTime (trans-date s)))))
- (split-value (lambda (s) (convert s (damount s)))) ; used for correct debit/credit
- (amount (lambda (s) (split-value s)))
- (debit-amount (lambda (s) (and (positive? (gnc:gnc-monetary-amount (split-value s)))
- (split-value s))))
- (credit-amount (lambda (s) (if (positive? (gnc:gnc-monetary-amount (split-value s)))
- #f
- (gnc:monetary-neg (split-value s)))))
- (original-amount (lambda (s) (gnc:make-gnc-monetary (currency s) (damount s))))
- (original-debit-amount (lambda (s) (if (positive? (damount s))
- (original-amount s)
- #f)))
- (original-credit-amount (lambda (s) (if (positive? (damount s))
- #f
- (gnc:monetary-neg (original-amount s)))))
- (running-balance (lambda (s) (gnc:make-gnc-monetary (currency s) (xaccSplitGetBalance s)))))
+ ;; For conversion to row-currency. Use midday as the
+ ;; transaction time so it matches a price on the same day.
+ ;; Otherwise it uses midnight which will likely match a
+ ;; price on the previous day
+ (converted-amount (lambda (s) (gnc:exchange-by-pricedb-nearest
+ (gnc:make-gnc-monetary (split-currency s) (split-amount s))
+ (row-currency s)
+ (time64CanonicalDayTime
+ (xaccTransGetDate (xaccSplitGetParent s))))))
+ (converted-debit-amount (lambda (s) (and (positive? (split-amount s))
+ (converted-amount s))))
+ (converted-credit-amount (lambda (s) (and (not (positive? (split-amount s)))
+ (gnc:monetary-neg (converted-amount s)))))
+ (original-amount (lambda (s) (gnc:make-gnc-monetary (split-currency s) (split-amount s))))
+ (original-debit-amount (lambda (s) (and (positive? (split-amount s))
+ (original-amount s))))
+ (original-credit-amount (lambda (s) (and (not (positive? (split-amount s)))
+ (gnc:monetary-neg (original-amount s)))))
+ (running-balance (lambda (s) (gnc:make-gnc-monetary (split-currency s) (xaccSplitGetBalance s)))))
(append
;; each column will be a vector
;; (vector heading
@@ -1207,17 +1201,19 @@ be excluded from periodic reporting.")
;; start-dual-column? ;; #t for the debit side of a dual column (i.e. debit/credit)
;; ;; which means the next column must be the credit side
;; friendly-heading-fn ;; (friendly-heading-fn account) to retrieve friendly name for account debit/credit
+
(if (column-uses? 'amount-single)
(list (vector (header-commodity (_ "Amount"))
- amount #t #t #f
+ converted-amount #t #t #f
(lambda (a) "")))
'())
+
(if (column-uses? 'amount-double)
(list (vector (header-commodity (_ "Debit"))
- debit-amount #f #t #t
+ converted-debit-amount #f #t #t
friendly-debit)
(vector (header-commodity (_ "Credit"))
- credit-amount #f #t #f
+ converted-credit-amount #f #t #f
friendly-credit))
'())
commit ac510d13be9e7522c5762378b79d3cf0422aeac1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jan 19 15:22:48 2018 +0800
TR: (ENH) add Closing-status filter, enable it by default
This commit will add a filter to include/exclude closing
transactions. In conventional reports, they are usually disruptive to
the regular periodic reporting and the default ensures they are not
included.
This commit also changes income-gst-report.scm to use the closing
filter just created, and disable its UI.
diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm
index 2cd7b7e..82d6bb7 100644
--- a/gnucash/report/standard-reports/income-gst-statement.scm
+++ b/gnucash/report/standard-reports/income-gst-statement.scm
@@ -37,6 +37,7 @@
;; Define the strings here to avoid typos and make changes easier.
(define reportname (N_ "Income & GST Statement"))
(define pagename-sorting (N_ "Sorting"))
+(define pagename-filter (N_ "Filter"))
(define TAX-SETUP-DESC
(string-append
(_ "This report is useful to calculate periodic business tax payable/receivable from
@@ -63,10 +64,9 @@ accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY fo
;; split -> bool
;;
;; additional split filter - returns #t if split must be included
- ;; we need to exclude Closing, Link and Payment transactions
- (let ((trans (xaccSplitGetParent split)))
- (and (member (xaccTransGetTxnType trans) (list TXN-TYPE-NONE TXN-TYPE-INVOICE))
- (not (xaccTransGetIsClosingTxn trans)))))
+ ;; we need to exclude Link and Payment transactions
+ (memv (xaccTransGetTxnType (xaccSplitGetParent split))
+ (list TXN-TYPE-NONE TXN-TYPE-INVOICE)))
(define (gst-statement-options-generator)
@@ -115,6 +115,9 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
(gnc:option-make-internal! options gnc:pagename-accounts "Filter Type")
(gnc:option-make-internal! options gnc:pagename-accounts "Filter By...")
(gnc:option-make-internal! options gnc:pagename-general "Show original currency amount")
+ ;; Disallow closing transactions
+ (gnc:option-set-value (gnc:lookup-option options pagename-filter "Closing transactions") 'exclude-closing)
+ (gnc:option-make-internal! options pagename-filter "Closing transactions")
;; Disable display options not being used anymore
(gnc:option-make-internal! options gnc:pagename-display "Shares")
(gnc:option-make-internal! options gnc:pagename-display "Price")
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index 35800f4..6b27989 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -184,6 +184,7 @@
(list "Income" (list (cons 'type ACCT-TYPE-INCOME)))
(list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE)))
(list "Liabilities" (list (cons 'type ACCT-TYPE-LIABILITY)))
+ (list "Equity" (list (cons 'type ACCT-TYPE-EQUITY)))
))
(define (null-test)
@@ -202,6 +203,7 @@
(income (cdr (assoc "Income" account-alist)))
(expense (cdr (assoc "Expenses" account-alist)))
(liability (cdr (assoc "Liabilities" account-alist)))
+ (equity (cdr (assoc "Equity" account-alist)))
(YEAR (gnc:time64-get-year (gnc:get-today)))
(foreign1 (gnc-commodity-table-lookup
(gnc-commodity-table-get-table (gnc-account-get-book bank))
@@ -288,6 +290,10 @@
(xaccTransSetNotes txn "multisplit")
(xaccTransCommitEdit txn))
+ ;; A single closing transaction
+ (let ((closing-txn (env-transfer env 31 12 1999 expense equity 111 #:description "Closing")))
+ (xaccTransSetIsClosingTxn closing-txn #t))
+
;; A couple of transactions which involve foreign currency
;; conversions. We'll set the currencies to GBP and USD.
(env-transfer-foreign env 15 01 2000 gbp-bank usd-bank 10 14 #:description "GBP 10 to USD 14")
@@ -464,7 +470,31 @@
(let ((sxml (options->sxml options "both void and non-void")))
(test-equal "filter void-transactions only, sum = $11.00"
'("$11.00")
- (get-row-col sxml -1 -1))))
+ (get-row-col sxml -1 -1)))
+
+ ;; Test Closing-Txn Filters
+ (set! options (default-testing-options))
+ (set-option! options "Accounts" "Accounts" (list expense))
+ (set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 1911)))
+ (set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 12 2012)))
+ (set-option! options "Filter" "Closing transactions" 'exclude-closing)
+ (let ((sxml (options->sxml options "filter closing - exclude closing txns ")))
+ (test-equal "filter exclude closing. bal = $111"
+ '("$111.00")
+ (get-row-col sxml -1 -1)))
+
+ (set-option! options "Filter" "Closing transactions" 'closing-only)
+ (let ((sxml (options->sxml options "filter closing - include closing only")))
+ (test-equal "filter closing only. bal = -$111"
+ '("-$111.00")
+ (get-row-col sxml -1 -1)))
+
+ (set-option! options "Filter" "Closing transactions" 'include-both)
+ (let ((sxml (options->sxml options "filter closing - include both")))
+ (test-equal "filter include both. bal = $0"
+ '("$0.00")
+ (get-row-col sxml -1 -1)))
+ )
(test-end "accounts selectors and filtering")
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 7178ddf..00bcf6d 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -17,6 +17,7 @@
;; - add support for indenting for better grouping
;; - add defaults suitable for a reconciliation report
;; - add subtotal summary grid
+;; - by default, exclude closing transactions from the report
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -98,6 +99,7 @@
(define optname-transaction-matcher-regex (N_ "Use regular expressions for transaction filter"))
(define optname-reconcile-status (N_ "Reconcile Status"))
(define optname-void-transactions (N_ "Void Transactions"))
+(define optname-closing-transactions (N_ "Closing transactions"))
;;Styles
(define def:grand-total-style "grand-total")
@@ -325,6 +327,23 @@ in the Options panel."))
(cons 'text (_ "Both"))
(cons 'tip (_ "Show both (and include void transactions in totals)."))))))
+(define show-closing-list
+ (list
+ (cons 'exclude-closing (list
+ (cons 'text (_ "Exclude closing transactions"))
+ (cons 'tip (_ "Exclude closing transactions from report."))
+ (cons 'closing-match #f)))
+
+ (cons 'include-both (list
+ (cons 'text (_ "Show both closing and regular transactions"))
+ (cons 'tip (_ "Show both (and include closing transactions in totals)."))
+ (cons 'closing-match 'both)))
+
+ (cons 'closing-only (list
+ (cons 'text (_ "Show closing transactions only"))
+ (cons 'tip (_ "Show only closing transactions."))
+ (cons 'closing-match #t)))))
+
(define reconcile-status-list
;; 'filter-types must be either #f (i.e. disable reconcile filter)
;; or a value defined as defined in Query.c
@@ -555,6 +574,16 @@ tags within description, notes or memo. ")
'non-void-only
(keylist->vectorlist show-void-list)))
+ (gnc:register-trep-option
+ (gnc:make-multichoice-option
+ pagename-filter optname-closing-transactions
+ "l" (_ "By default most users should not include closing \
+transactions in a transaction report. Closing transactions are \
+transfers from INCOME and EXPENSE accounts to equity, and must usually \
+be excluded from periodic reporting.")
+ 'exclude-closing
+ (keylist->vectorlist show-closing-list)))
+
;; Accounts options
;; account to do report on
@@ -1787,6 +1816,9 @@ tags within description, notes or memo. ")
(secondary-order (opt-val pagename-sorting optname-sec-sortorder))
(secondary-date-subtotal (opt-val pagename-sorting optname-sec-date-subtotal))
(void-status (opt-val pagename-filter optname-void-transactions))
+ (closing-match (keylist-get-info show-closing-list
+ (opt-val pagename-filter optname-closing-transactions)
+ 'closing-match))
(splits '())
(custom-sort? (or (and (member primary-key DATE-SORTING-TYPES) ; this will remain
(not (eq? primary-date-subtotal 'none))) ; until qof-query
@@ -1866,6 +1898,8 @@ tags within description, notes or memo. ")
(else #f))
(if reconcile-status-filter
(xaccQueryAddClearedMatch query reconcile-status-filter QOF-QUERY-AND))
+ (if (boolean? closing-match)
+ (xaccQueryAddClosingTransMatch query closing-match QOF-QUERY-AND))
(if (not custom-sort?)
(begin
(qof-query-set-sort-order query
commit 4b9ec663f7a050a2cfea23729ab5fca6c20dcdcf
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu May 3 13:46:09 2018 +0800
TR: (ENH) do not add headers if hiding transaction data
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 1aeedf8..7178ddf 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -1111,10 +1111,11 @@ tags within description, notes or memo. ")
"number-cell"
(gnc:make-gnc-monetary currency price-decimal)))))))))
- (if (and (null? left-cols-list)
- (or (opt-val gnc:pagename-display "Totals")
- (primary-get-info 'renderer-fn)
- (secondary-get-info 'renderer-fn)))
+ (if (or (column-uses? 'subtotals-only)
+ (and (null? left-cols-list)
+ (or (opt-val gnc:pagename-display "Totals")
+ (primary-get-info 'renderer-fn)
+ (secondary-get-info 'renderer-fn))))
(list (vector "" (lambda (s t) #f)))
left-cols-list)))
commit f82e5a5b4b2d7f110af8041dad4a4af7ebbde368
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 1 21:07:07 2018 +0800
TR: (ENH) enable subtotal/grouping for Split Memo
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 638c592..1aeedf8 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -220,10 +220,10 @@ in the Options panel."))
(cons 'renderer-fn #f)))
(cons 'memo (list (cons 'sortkey (list SPLIT-MEMO))
- (cons 'split-sortvalue #f)
+ (cons 'split-sortvalue (lambda (s) (xaccSplitGetMemo s)))
(cons 'text (_ "Memo"))
(cons 'tip (_ "Sort by memo."))
- (cons 'renderer-fn #f)))
+ (cons 'renderer-fn (lambda (s) (xaccSplitGetMemo s)))))
(cons 'notes (list (cons 'sortkey #f)
(cons 'split-sortvalue (lambda (s) (xaccTransGetNotes (xaccSplitGetParent s))))
commit f89f00f59d375bd313426b45ec34cdd944b685a6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 1 21:05:55 2018 +0800
TR: (ENH) enable subtotal/grouping for Transaction Description
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index c5b8867..638c592 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -194,10 +194,10 @@ in the Options panel."))
(cons 'renderer-fn #f)))
(cons 'description (list (cons 'sortkey (list SPLIT-TRANS TRANS-DESCRIPTION))
- (cons 'split-sortvalue #f)
+ (cons 'split-sortvalue (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s))))
(cons 'text (_ "Description"))
(cons 'tip (_ "Sort by description."))
- (cons 'renderer-fn #f)))
+ (cons 'renderer-fn (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s))))))
(if (and (gnc-current-session-exist)
(qof-book-use-split-action-for-num-field (gnc-get-current-book)))
commit 4a7bc0b53d434cd72f4ed58ae687a16f8bfc0046
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 1 21:06:54 2018 +0800
TR: (ENH) enable subtotal/grouping for Transaction Notes
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index c0b3518..35800f4 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -725,6 +725,12 @@
'("Expenses" "Expenses" "Income" "Income" "Liabilities")
(get-row-col sxml #f 6)))
+ (set-option! options "Sorting" "Primary Key" 'notes)
+ (let* ((sxml (options->sxml options "sorting=trans-notes")))
+ (test-equal "sort by transaction notes"
+ '("memo-3" "memo-2" "memo-1" "notes3")
+ (get-row-col sxml #f 4)))
+
(set-option! options "Sorting" "Primary Key" 'amount)
(let* ((sxml (options->sxml options "sorting=amount")))
(test-equal "sort by amount"
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index a1c01be..c5b8867 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -225,6 +225,12 @@ in the Options panel."))
(cons 'tip (_ "Sort by memo."))
(cons 'renderer-fn #f)))
+ (cons 'notes (list (cons 'sortkey #f)
+ (cons 'split-sortvalue (lambda (s) (xaccTransGetNotes (xaccSplitGetParent s))))
+ (cons 'text (_ "Notes"))
+ (cons 'tip (_ "Sort by transaction notes."))
+ (cons 'renderer-fn (lambda (s) (xaccTransGetNotes (xaccSplitGetParent s))))))
+
(cons 'none (list (cons 'sortkey '())
(cons 'split-sortvalue #f)
(cons 'text (_ "None"))
commit 2102c55bb7ad5216537c553c0d6189033322a8e1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 1 23:44:50 2018 +0800
TR: (centralize) centralize custom-sorter split comparators
This commit will modify the custom sorter to reuse 'split-sortvalue
comparators. The original purpose of these functions was to *compare*
splits *during* table generation to determine whether a subtotal group
was changed. These functions can be easily reused by the custom sorter
to *sort* splits *before* table generation.
Also modify the sortkey renderer logic to catch all non-date,
non-account sortkeys into the generic string renderer.
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 8fd2c3d..a1c01be 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -145,13 +145,13 @@ in the Options panel."))
(cons 'renderer-fn (lambda (a) (xaccSplitGetAccount a)))))
(cons 'date (list (cons 'sortkey (list SPLIT-TRANS TRANS-DATE-POSTED))
- (cons 'split-sortvalue #f)
+ (cons 'split-sortvalue (lambda (s) (xaccTransGetDate (xaccSplitGetParent s))))
(cons 'text (_ "Date"))
(cons 'tip (_ "Sort by date."))
(cons 'renderer-fn #f)))
(cons 'reconciled-date (list (cons 'sortkey (list SPLIT-DATE-RECONCILED))
- (cons 'split-sortvalue #f)
+ (cons 'split-sortvalue (lambda (s) (xaccSplitGetDateReconciled s)))
(cons 'text (_ "Reconciled Date"))
(cons 'tip (_ "Sort by the Reconciled Date."))
(cons 'renderer-fn #f)))
@@ -188,7 +188,7 @@ in the Options panel."))
(cons 'renderer-fn (lambda (a) (xaccSplitGetAccount (xaccSplitGetOtherSplit a))))))
(cons 'amount (list (cons 'sortkey (list SPLIT-VALUE))
- (cons 'split-sortvalue #f)
+ (cons 'split-sortvalue (lambda (a) (gnc-numeric-to-scm (xaccSplitGetValue a))))
(cons 'text (_ "Amount"))
(cons 'tip (_ "Sort by amount."))
(cons 'renderer-fn #f)))
@@ -202,19 +202,19 @@ in the Options panel."))
(if (and (gnc-current-session-exist)
(qof-book-use-split-action-for-num-field (gnc-get-current-book)))
(cons 'number (list (cons 'sortkey (list SPLIT-ACTION))
- (cons 'split-sortvalue #f)
+ (cons 'split-sortvalue (lambda (a) (xaccSplitGetAction a)))
(cons 'text (_ "Number/Action"))
(cons 'tip (_ "Sort by check number/action."))
(cons 'renderer-fn #f)))
(cons 'number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
- (cons 'split-sortvalue #f)
+ (cons 'split-sortvalue (lambda (a) (xaccTransGetNum (xaccSplitGetParent a))))
(cons 'text (_ "Number"))
(cons 'tip (_ "Sort by check/transaction number."))
(cons 'renderer-fn #f))))
(cons 't-number (list (cons 'sortkey (list SPLIT-TRANS TRANS-NUM))
- (cons 'split-sortvalue #f)
+ (cons 'split-sortvalue (lambda (a) (xaccTransGetNum (xaccSplitGetParent a))))
(cons 'text (_ "Transaction Number"))
(cons 'tip (_ "Sort by transaction number."))
(cons 'renderer-fn #f)))
@@ -251,36 +251,42 @@ in the Options panel."))
(list
(cons 'none (list
(cons 'split-sortvalue #f)
+ (cons 'date-sortvalue #f)
(cons 'text (_ "None"))
(cons 'tip (_ "None."))
(cons 'renderer-fn #f)))
(cons 'daily (list
(cons 'split-sortvalue (lambda (s) (time64-day (split->time64 s))))
+ (cons 'date-sortvalue time64-day)
(cons 'text (_ "Daily"))
(cons 'tip (_ "Daily."))
(cons 'renderer-fn (lambda (s) (time64->daily-string (split->time64 s))))))
(cons 'weekly (list
(cons 'split-sortvalue (lambda (s) (time64-week (split->time64 s))))
+ (cons 'date-sortvalue time64-week)
(cons 'text (_ "Weekly"))
(cons 'tip (_ "Weekly."))
(cons 'renderer-fn (lambda (s) (gnc:date-get-week-year-string (gnc-localtime (split->time64 s)))))))
(cons 'monthly (list
(cons 'split-sortvalue (lambda (s) (time64-month (split->time64 s))))
+ (cons 'date-sortvalue time64-month)
(cons 'text (_ "Monthly"))
(cons 'tip (_ "Monthly."))
(cons 'renderer-fn (lambda (s) (gnc:date-get-month-year-string (gnc-localtime (split->time64 s)))))))
(cons 'quarterly (list
(cons 'split-sortvalue (lambda (s) (time64-quarter (split->time64 s))))
+ (cons 'date-sortvalue time64-quarter)
(cons 'text (_ "Quarterly"))
(cons 'tip (_ "Quarterly."))
(cons 'renderer-fn (lambda (s) (gnc:date-get-quarter-year-string (gnc-localtime (split->time64 s)))))))
(cons 'yearly (list
(cons 'split-sortvalue (lambda (s) (time64-year (split->time64 s))))
+ (cons 'date-sortvalue time64-year)
(cons 'text (_ "Yearly"))
(cons 'tip (_ "Yearly."))
(cons 'renderer-fn (lambda (s) (gnc:date-get-year-string (gnc-localtime (split->time64 s)))))))))
@@ -1424,7 +1430,7 @@ tags within description, notes or memo. ")
(render-date date-subtotal-key split))
((member sortkey ACCOUNT-SORTING-TYPES)
(render-account sortkey split anchor?))
- ((eq? sortkey 'reconciled-status)
+ (else
(render-generic sortkey split)))))
(define (render-grand-total)
@@ -1784,41 +1790,25 @@ tags within description, notes or memo. ")
(infobox-display (opt-val gnc:pagename-general optname-infobox-display))
(query (qof-query-create-for-splits)))
- (define (generic-less? X Y key date-subtotal ascend?)
- (define comparator-function
- (if (member key DATE-SORTING-TYPES)
- (let ((date (lambda (s)
- (case key
- ((date) (xaccTransGetDate (xaccSplitGetParent s)))
- ((reconciled-date) (xaccSplitGetDateReconciled s))))))
- (case date-subtotal
- ((yearly) (lambda (s) (time64-year (date s))))
- ((monthly) (lambda (s) (time64-month (date s))))
- ((quarterly) (lambda (s) (time64-quarter (date s))))
- ((weekly) (lambda (s) (time64-week (date s))))
- ((daily) (lambda (s) (time64-day (date s))))
- ((none) (lambda (s) (date s)))))
- (case key
- ((account-name) (lambda (s) (gnc-account-get-full-name (xaccSplitGetAccount s))))
- ((account-code) (lambda (s) (xaccAccountGetCode (xaccSplitGetAccount s))))
- ((corresponding-acc-name) (lambda (s) (xaccSplitGetCorrAccountFullName s)))
- ((corresponding-acc-code) (lambda (s) (xaccSplitGetCorrAccountCode s)))
- ((reconciled-status) (lambda (s) (length (memq (xaccSplitGetReconcile s)
- '(#\n #\c #\y #\f #\v)))))
- ((amount) (lambda (s) (gnc-numeric-to-scm (xaccSplitGetValue s))))
- ((description) (lambda (s) (xaccTransGetDescription (xaccSplitGetParent s))))
- ((number) (lambda (s)
- (if BOOK-SPLIT-ACTION
- (xaccSplitGetAction s)
- (xaccTransGetNum (xaccSplitGetParent s)))))
- ((t-number) (lambda (s) (xaccTransGetNum (xaccSplitGetParent s))))
- ((register-order) (lambda (s) #f))
- ((memo) (lambda (s) (xaccSplitGetMemo s)))
- ((none) (lambda (s) #f)))))
- (cond
- ((string? (comparator-function X)) ((if ascend? string<? string>?) (comparator-function X) (comparator-function Y)))
- ((comparator-function X) ((if ascend? < >) (comparator-function X) (comparator-function Y)))
- (else #f)))
+ (define (generic-less? split-X split-Y sortkey date-subtotal-key ascend?)
+ ;; compare splits X and Y, whereby
+ ;; sortkey and date-subtotal-key specify the options used
+ ;; ascend? specifies whether ascending or descending
+ (let* ((comparator-function
+ (if (memq sortkey DATE-SORTING-TYPES)
+ (let ((date (keylist-get-info sortkey-list sortkey 'split-sortvalue))
+ (date-comparator (keylist-get-info date-subtotal-list date-subtotal-key 'date-sortvalue)))
+ (lambda (s)
+ (and date-comparator
+ (date-comparator (date s)))))
+ (or (keylist-get-info sortkey-list sortkey 'split-sortvalue)
+ (lambda (s) #f))))
+ (value-of-X (comparator-function split-X))
+ (value-of-Y (comparator-function split-Y))
+ (op (if (string? value-of-X)
+ (if ascend? string<? string>?)
+ (if ascend? < >))))
+ (and value-of-X (op value-of-X value-of-Y))))
(define (primary-comparator? X Y)
(generic-less? X Y primary-key
@@ -1834,7 +1824,6 @@ tags within description, notes or memo. ")
(define (date-comparator? X Y)
(generic-less? X Y 'date 'none #t))
-
(if (or (or (null? c_account_1) (and-map not c_account_1))
(eq? account-matcher-regexp 'invalid-regex)
(eq? transaction-matcher-regexp 'invalid-regex))
commit b95fa5ba8cd6a8cdd4416504f52a36529fa4ce05
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 1 20:41:38 2018 +0800
TR: (simplify) dynamically check CUSTOM-SORTING?
Instead of a list needing manual adjustments, this function will check
if sortkey requires custom sorter, depending on sortkey capabilities.
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 9420dc2..8fd2c3d 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -116,8 +116,6 @@ in the Options panel."))
(define ACCOUNT-SORTING-TYPES (list 'account-name 'corresponding-acc-name
'account-code 'corresponding-acc-code))
-(define CUSTOM-SORTING (list 'reconciled-status))
-
(define SORTKEY-INFORMAL-HEADERS (list 'account-name 'account-code))
(define sortkey-list
@@ -398,6 +396,16 @@ Credit Card, and Income accounts."))
;; it checks whether a renderer-fn is defined.
(keylist-get-info sortkey-list sortkey 'renderer-fn))
+(define (CUSTOM-SORTING? sortkey)
+ ;; sortkey -> bool
+ ;;
+ ;; this returns which sortkeys which *must* use the custom sorter.
+ ;; it filters whereby a split-sortvalue is defined (i.e. the splits
+ ;; can be compared according to their 'sortvalue) but the QofQuery
+ ;; sortkey is not defined (i.e. their 'sortkey is #f).
+ (and (keylist-get-info sortkey-list sortkey 'split-sortvalue)
+ (not (keylist-get-info sortkey-list sortkey 'sortkey))))
+
;;
;; Set defaults for reconcilation report
;;
@@ -1771,8 +1779,8 @@ tags within description, notes or memo. ")
(not (eq? primary-date-subtotal 'none))) ; until qof-query
(and (member secondary-key DATE-SORTING-TYPES) ; is upgraded
(not (eq? secondary-date-subtotal 'none)))
- (or (member primary-key CUSTOM-SORTING)
- (member secondary-key CUSTOM-SORTING))))
+ (or (CUSTOM-SORTING? primary-key)
+ (CUSTOM-SORTING? secondary-key))))
(infobox-display (opt-val gnc:pagename-general optname-infobox-display))
(query (qof-query-create-for-splits)))
commit 6210b80fd0b94d9504cef688a3769d638539393d
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue May 1 19:08:56 2018 +0800
TR: (simplify) dynamically check SUBTOTAL-ENABLED?
This function checks whether the sortkey can be grouped. Instead of
manually creating list, test it dynamically.
Sortkeys whose 'renderer-fn is defined can be grouped.
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 6dbb894..9420dc2 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -113,14 +113,9 @@ in the Options panel."))
(define DATE-SORTING-TYPES (list 'date 'reconciled-date))
-;; The option-values of the sorting key multichoice option, for
-;; which a subtotal should be enabled.
-(define SUBTOTAL-ENABLED (list 'account-name 'corresponding-acc-name
- 'account-code 'corresponding-acc-code
- 'reconciled-status))
-
(define ACCOUNT-SORTING-TYPES (list 'account-name 'corresponding-acc-name
'account-code 'corresponding-acc-code))
+
(define CUSTOM-SORTING (list 'reconciled-status))
(define SORTKEY-INFORMAL-HEADERS (list 'account-name 'account-code))
@@ -386,7 +381,6 @@ Credit Card, and Income accounts."))
ACCT-TYPE-EQUITY ACCT-TYPE-CREDIT
ACCT-TYPE-INCOME))))))
-
(define (keylist-get-info keylist key info)
(cdr (assq info (cdr (assq key keylist)))))
@@ -399,6 +393,10 @@ Credit Card, and Income accounts."))
(keylist-get-info keylist (car item) 'tip)))
keylist))
+(define (SUBTOTAL-ENABLED? sortkey)
+ ;; this returns whether sortkey *can* be subtotalled/grouped.
+ ;; it checks whether a renderer-fn is defined.
+ (keylist-get-info sortkey-list sortkey 'renderer-fn))
;;
;; Set defaults for reconcilation report
@@ -585,10 +583,10 @@ tags within description, notes or memo. ")
(define (apply-selectable-by-name-sorting-options)
(let* ((prime-sortkey-enabled (not (eq? prime-sortkey 'none)))
- (prime-sortkey-subtotal-enabled (member prime-sortkey SUBTOTAL-ENABLED))
+ (prime-sortkey-subtotal-enabled (SUBTOTAL-ENABLED? prime-sortkey))
(prime-date-sortingtype-enabled (member prime-sortkey DATE-SORTING-TYPES))
(sec-sortkey-enabled (not (eq? sec-sortkey 'none)))
- (sec-sortkey-subtotal-enabled (member sec-sortkey SUBTOTAL-ENABLED))
+ (sec-sortkey-subtotal-enabled (SUBTOTAL-ENABLED? sec-sortkey))
(sec-date-sortingtype-enabled (member sec-sortkey DATE-SORTING-TYPES)))
(gnc-option-db-set-option-selectable-by-name
@@ -962,17 +960,17 @@ tags within description, notes or memo. ")
(let ((sortkey (opt-val pagename-sorting optname-prime-sortkey)))
(if (member sortkey DATE-SORTING-TYPES)
(keylist-get-info date-subtotal-list (opt-val pagename-sorting optname-prime-date-subtotal) info)
- (and (member sortkey SUBTOTAL-ENABLED)
- (and (opt-val pagename-sorting optname-prime-subtotal)
- (keylist-get-info sortkey-list sortkey info))))))
+ (and (SUBTOTAL-ENABLED? sortkey)
+ (opt-val pagename-sorting optname-prime-subtotal)
+ (keylist-get-info sortkey-list sortkey info)))))
(define (secondary-get-info info)
(let ((sortkey (opt-val pagename-sorting optname-sec-sortkey)))
(if (member sortkey DATE-SORTING-TYPES)
(keylist-get-info date-subtotal-list (opt-val pagename-sorting optname-sec-date-subtotal) info)
- (and (member sortkey SUBTOTAL-ENABLED)
- (and (opt-val pagename-sorting optname-sec-subtotal)
- (keylist-get-info sortkey-list sortkey info))))))
+ (and (SUBTOTAL-ENABLED? sortkey)
+ (opt-val pagename-sorting optname-sec-subtotal)
+ (keylist-get-info sortkey-list sortkey info)))))
(let* ((work-to-do (length splits))
(work-done 0)
commit 6e78fa1d99936244fd74772fc3a329fd8120168c
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed May 2 22:54:31 2018 +0800
test-TR: change report out filenames
This will allow easier addition of tests.
Also fix (use-modules) usage. VM is only needed for coverage reporting.
diff --git a/gnucash/report/standard-reports/test/test-transaction.scm b/gnucash/report/standard-reports/test/test-transaction.scm
index 7297851..c0b3518 100644
--- a/gnucash/report/standard-reports/test/test-transaction.scm
+++ b/gnucash/report/standard-reports/test/test-transaction.scm
@@ -8,8 +8,8 @@
(use-modules (srfi srfi-64))
(use-modules (sxml simple))
(use-modules (sxml xpath))
-(use-modules (system vm coverage)
- (system vm vm))
+(use-modules (system vm coverage))
+(use-modules (system vm vm))
;; Guide to the test-transaction.scm
@@ -24,7 +24,7 @@
;; which sets the SRFI-64 test runner, and initiates the proper test suite
;; in (null-test) and (trep-tests). Please note the tests will all call
;; (options->sxml) which in turn generates the transaction report, and
-;; dumps the output at /tmp/out-XX.html for review.
+;; dumps the output at /tmp/test-trep-*.html for review.
;; For coverage analysis, please amend (run-test) (if #f ...) to (if
;; #t ...) and this will run (coverage-test) instead, which will
@@ -110,27 +110,22 @@
(memv c '(#\- #\.))))
str)))
-(define counter
- (let ((count 0))
- (lambda ()
- (set! count (1+ count))
- count)))
-
(define (options->sxml options test-title)
;; options object -> sxml tree
;;
;; This function abstracts the whole transaction report renderer.
;; It also catches XML parsing errors, dumping the options changed.
;;
- ;; It also dumps the render into /tmp/out-N.html where N is a counter
+ ;; It also dumps the render into /tmp/test-trep-XX.html where XX is the test title
(let* ((template (gnc:find-report-template trep-uuid))
(report (constructor trep-uuid "bar" options #t #t #f #f ""))
(renderer (gnc:report-template-renderer template))
- (document (renderer report)))
+ (document (renderer report))
+ (filename (string-map (lambda (c) (if (char-alphabetic? c) c #\-)) test-title)))
(gnc:html-document-set-style-sheet! document (gnc:report-stylesheet report))
(if test-title
(gnc:html-document-set-title! document test-title))
- (let* ((filename (format #f "/tmp/out-~a.html" (counter)))
+ (let* ((filename (format #f "/tmp/test-trep-~a.html" filename))
(render (gnc:html-document-render document))
(outfile (open-file filename "w")))
(display render outfile)
@@ -194,7 +189,7 @@
(define (null-test)
;; This null-test tests for the presence of report.
(let ((options (gnc:make-report-options trep-uuid)))
- (test-assert "null-test" (options->sxml options "null-test")))) ;out-1.html
+ (test-assert "null-test" (options->sxml options "null-test"))))
(define (trep-tests)
;; This function will perform implementation testing on the transaction report.
@@ -325,7 +320,7 @@
(test-begin "general options")
(let* ((options (default-testing-options))
- (sxml (options->sxml options "general options")) ;out-2.html
+ (sxml (options->sxml options "general options"))
(default-headers '("Date" "Num" "Description" "Memo/Notes" "Account" "Amount")))
(test-equal "default headers"
default-headers
@@ -351,7 +346,7 @@
(set-option! options "Sorting" "Primary Subtotal" #t)
(set-option! options "Sorting" "Secondary Key" 'date)
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'monthly)
- (let ((sxml (options->sxml options "test basic column headers, and original currency"))) ;out-3.html
+ (let ((sxml (options->sxml options "test basic column headers, and original currency")))
(test-equal "default headers, indented, includes common-currency"
'(" " " " "Date" "Num" "Description" "Memo/Notes" "Account" "Amount" "USD" "Amount")
(get-row-col sxml 0 #f))
@@ -377,19 +372,19 @@
;; Filter Account Name Filters
(set-option! options "Filter" "Account Name Filter" "Expenses")
- (let ((sxml (options->sxml options "accounts filter expenses"))) ;out-4.html
+ (let ((sxml (options->sxml options "accounts filter expenses")))
(test-equal "account name filter to 'expenses', sum = $31.00"
'("$31.00")
(get-row-col sxml -1 -1)))
(set-option! options "Filter" "Account Name Filter" "Expen.es")
- (let ((sxml (options->sxml options "accounts filter expen.es"))) ;out-5.html
+ (let ((sxml (options->sxml options "accounts filter expen.es")))
(test-equal "account name filter to 'expen.es', blank report"
'()
(get-row-col sxml #f #f)))
(set-option! options "Filter" "Use regular expressions for account name filter" #t)
- (let ((sxml (options->sxml options "accounts filter expen.es regex"))) ;out-6.html
+ (let ((sxml (options->sxml options "accounts filter expen.es regex")))
(test-equal "account name filter to 'expen.es' and switch on regex filter, sum = $31.00"
'("$31.00")
(get-row-col sxml -1 -1)))
@@ -399,19 +394,19 @@
(set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 1969)))
(set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 12 1970)))
(set-option! options "Filter" "Transaction Filter" "desc-3")
- (let ((sxml (options->sxml options "transaction filter to ponies"))) ;out-7.html
+ (let ((sxml (options->sxml options "transaction filter to ponies")))
(test-equal "transaction filter in bank to 'desc-3', sum = $29.00"
'("$29.00")
(get-row-col sxml -1 -1)))
(set-option! options "Filter" "Transaction Filter" "not.s?")
- (let ((sxml (options->sxml options "transaction filter not.s?"))) ;out-8.html
+ (let ((sxml (options->sxml options "transaction filter not.s?")))
(test-equal "transaction filter in bank to 'not.s?', blank report"
'()
(get-row-col sxml #f #f)))
(set-option! options "Filter" "Use regular expressions for transaction filter" #t)
- (let ((sxml (options->sxml options "transaction filter not.s? regex"))) ;out-9.html
+ (let ((sxml (options->sxml options "transaction filter not.s? regex")))
(test-equal "transaction filter in bank to 'not.s?' and switch regex, sum = -$23.00"
'("-$23.00")
(get-row-col sxml -1 -1)))
@@ -421,19 +416,19 @@
(set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 1969)))
(set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 12 1970)))
(set-option! options "Filter" "Reconcile Status" 'unreconciled)
- (let ((sxml (options->sxml options "unreconciled"))) ;out-10.html
+ (let ((sxml (options->sxml options "unreconciled")))
(test-equal "filter unreconciled only, sum = -$20.00"
'("-$20.00")
(get-row-col sxml -1 -1)))
(set-option! options "Filter" "Reconcile Status" 'cleared)
- (let ((sxml (options->sxml options "cleared"))) ;out-11.html
+ (let ((sxml (options->sxml options "cleared")))
(test-equal "filter cleared only, sum = $29.00"
'("$29.00")
(get-row-col sxml -1 -1)))
(set-option! options "Filter" "Reconcile Status" 'reconciled)
- (let ((sxml (options->sxml options "reconciled"))) ;out-12.html
+ (let ((sxml (options->sxml options "reconciled")))
(test-equal "filter reconciled only, sum = -$8.00"
'("-$8.00")
(get-row-col sxml -1 -1)))
@@ -444,13 +439,13 @@
(set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 12 1970)))
(set-option! options "Accounts" "Filter By..." (list income))
(set-option! options "Accounts" "Filter Type" 'include)
- (let ((sxml (options->sxml options "including bank-income accts only"))) ;out-13.html
+ (let ((sxml (options->sxml options "including bank-income accts only")))
(test-equal "filter includes bank-income, sum = -$29.00"
'("$29.00")
(get-row-col sxml -1 -1)))
(set-option! options "Accounts" "Filter Type" 'exclude)
- (let ((sxml (options->sxml options "bank exclude bank-income accts"))) ;out-14.html
+ (let ((sxml (options->sxml options "bank exclude bank-income accts")))
(test-equal "filter excludes bank-income, sum = -$28.00"
'("-$28.00")
(get-row-col sxml -1 -1)))
@@ -460,13 +455,13 @@
(set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 1969)))
(set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 12 1970)))
(set-option! options "Filter" "Void Transactions" 'void-only)
- (let ((sxml (options->sxml options "void only"))) ;out-15.html
+ (let ((sxml (options->sxml options "void only")))
(test-equal "filter void-transactions only, sum = -$10.00"
'("$10.00")
(get-row-col sxml -1 -1)))
(set-option! options "Filter" "Void Transactions" 'both)
- (let ((sxml (options->sxml options "both void and non-void"))) ;out-16.html
+ (let ((sxml (options->sxml options "both void and non-void")))
(test-equal "filter void-transactions only, sum = $11.00"
'("$11.00")
(get-row-col sxml -1 -1))))
@@ -483,7 +478,7 @@
(list "Date" "Reconciled Date" "Num" "Description" "Memo" "Notes"
"Account Name" "Other Account Name" "Shares" "Price" "Running Balance"
"Totals"))
- (let ((sxml (options->sxml options "all columns off"))) ;out-17.html
+ (let ((sxml (options->sxml options "all columns off")))
(test-assert "all display columns off, except amount and subtotals are enabled, there should be 2 columns"
(= (length ((sxpath '(// (table 1) // (tr 1) // th)) sxml))
(length ((sxpath '(// (table 1) // (tr 4) // td)) sxml))
@@ -494,7 +489,7 @@
(set-option! options "Sorting" "Primary Subtotal for Date Key" 'none)
(set-option! options "Sorting" "Secondary Subtotal" #f)
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'none)
- (let ((sxml (options->sxml options "only amounts"))) ;out-18.html
+ (let ((sxml (options->sxml options "only amounts")))
(test-assert "all display columns off, and no subtotals, but amount enabled, there should be 1 column"
(= (length ((sxpath '(// (table 1) // (tr 1) // th)) sxml))
(length ((sxpath '(// (table 1) // (tr 4) // td)) sxml))
@@ -502,7 +497,7 @@
1)))
(set-option! options "Display" "Amount" 'none)
- (let ((sxml (options->sxml options "no columns"))) ;out-19.html
+ (let ((sxml (options->sxml options "no columns")))
(test-assert "all display columns off, without amount nor subtotals, there should be 0 column"
(= (length ((sxpath '(// (table 1) // (tr 1) // th)) sxml))
(length ((sxpath '(// (table 1) // (tr 4) // td)) sxml))
@@ -513,7 +508,7 @@
(set-option! options "Sorting" "Primary Subtotal for Date Key" 'weekly)
(set-option! options "Sorting" "Secondary Subtotal" #t)
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'weekly)
- (let ((sxml (options->sxml options "subtotals only"))) ;out-20.html
+ (let ((sxml (options->sxml options "subtotals only")))
(test-assert "all display columns including amount are disabled, but subtotals are enabled, there should be 1 column"
(= (length ((sxpath '(// (table 1) // (tr 1) // th)) sxml))
(length ((sxpath '(// (table 1) // (tr -1) // td)) sxml))
@@ -531,7 +526,7 @@
(list "Date" "Reconciled Date" "Num" "Description" "Memo" "Notes"
"Account Name" "Other Account Name" "Shares" "Price" "Running Balance"
"Totals" "Use Full Other Account Name" "Use Full Account Name"))
- (let* ((sxml (options->sxml options "all columns on"))) ;out-21.html
+ (let* ((sxml (options->sxml options "all columns on")))
(test-equal "all display columns on, displays correct columns"
(list "Date" "Reconciled Date" "Num" "Description" "Memo/Notes" "Account"
"Transfer from/to" "Shares" "Price" "Amount" "Running Balance")
@@ -560,7 +555,7 @@
(set-option! options "Sorting" "Primary Subtotal for Date Key" 'none)
(set-option! options "Sorting" "Secondary Subtotal" #f)
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'none)
- (let* ((sxml (options->sxml options "multiline"))) ;out-22.html
+ (let* ((sxml (options->sxml options "multiline")))
(test-assert "multi line transaction with 1st split have same memo"
(apply string=? (get-row-col sxml #f 4)))
@@ -573,7 +568,7 @@
;; Remove expense multisplit, transaction is not shown
(set-option! options "Accounts" "Filter By..." (list expense))
(set-option! options "Accounts" "Filter Type" 'exclude)
- (let* ((sxml (options->sxml options "multiline, filtered out"))) ;out-23.html
+ (let* ((sxml (options->sxml options "multiline, filtered out")))
(test-equal "multi-line has been excluded"
'()
(get-row-col sxml #f #f)))
@@ -586,7 +581,7 @@
(set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 12 2000)))
(set-option! options "General" "Common Currency" #t)
(set-option! options "General" "Show original currency amount" #t)
- (let* ((sxml (options->sxml options "single column, with original currency headers"))) ;out-24.html
+ (let* ((sxml (options->sxml options "single column, with original currency headers")))
(test-equal "single amount column, with original currency headers"
(list "Date" "Num" "Description" "Memo/Notes" "Account"
"Amount" "USD" "Amount")
@@ -597,7 +592,7 @@
(set-option! options "Display" "Account Code" #t)
(set-option! options "Display" "Other Account Name" #t)
(set-option! options "Display" "Other Account Code" #t)
- (let* ((sxml (options->sxml options "dual column"))) ;out-25.html
+ (let* ((sxml (options->sxml options "dual column")))
;; Note. It's difficult to test converted monetary
;; amounts. Although I've set transfers from USD/GBP, the
;; transfers do not update the pricedb automatically,
@@ -638,21 +633,21 @@
(set-option! options "Sorting" "Primary Subtotal" #f)
(set-option! options "Sorting" "Secondary Key" 'description)
(set-option! options "Sorting" "Secondary Subtotal" #f)
- (let* ((sxml (options->sxml options "sign-reversal is none, correct signs of amounts?"))) ;out-26.html
+ (let* ((sxml (options->sxml options "sign-reversal is none, correct signs of amounts?")))
(test-equal "sign-reversal is none, correct signs of amounts"
'(#f #t #t #f #f #t #t #t #t #f #f #f #f #t)
(map (lambda (s) (not (string-contains s "-")))
((sxpath '(// (table 1) // tr // (td -1) // a // *text*)) sxml))))
(set-option! options "Display" "Sign Reverses" 'income-expense)
- (let* ((sxml (options->sxml options "sign-reversal is income-expense, correct signs of amounts?"))) ;out-27.html
+ (let* ((sxml (options->sxml options "sign-reversal is income-expense, correct signs of amounts?")))
(test-equal "sign-reversal is income-expense, correct signs of amounts"
'(#f #t #t #f #f #f #f #f #f #t #t #f #f #t)
(map (lambda (s) (not (string-contains s "-")))
((sxpath '(// (table 1) // tr // (td -1) // a // *text*)) sxml))))
(set-option! options "Display" "Sign Reverses" 'credit-accounts)
- (let* ((sxml (options->sxml options "sign-reversal is credit-accounts, correct signs of amounts?"))) ;out-28.html
+ (let* ((sxml (options->sxml options "sign-reversal is credit-accounts, correct signs of amounts?")))
(test-equal "sign-reversal is credit-accounts, correct signs of amounts"
'(#f #t #t #f #f #t #t #t #t #t #t #t #t #f)
(map (lambda (s) (not (string-contains s "-")))
@@ -665,7 +660,7 @@
(set-option! options "General" "Show original currency amount" #t)
(set-option! options "Sorting" "Primary Key" 'date)
(set-option! options "Sorting" "Primary Subtotal for Date Key" 'none)
- (let* ((sxml (options->sxml options "dual columns"))) ;out-29.html
+ (let* ((sxml (options->sxml options "dual columns")))
(test-equal "dual amount column, with original currency headers"
(list "Date" "Num" "Description" "Memo/Notes" "Account"
"Debit" "USD" "Credit" "USD" "Debit" "Credit")
@@ -696,42 +691,42 @@
(set-option! options "Sorting" "Secondary Subtotal" #f)
(set-option! options "Sorting" "Primary Key" 'date)
- (let* ((sxml (options->sxml options "sorting=date"))) ;out-30.html
+ (let* ((sxml (options->sxml options "sorting=date")))
(test-equal "dates are sorted"
'("12/31/69" "12/31/69" "01/01/70" "02/01/70" "02/10/70")
(get-row-col sxml #f 1)))
(set-option! options "Sorting" "Primary Key" 'number)
- (let* ((sxml (options->sxml options "sorting=number"))) ;out-31.html
+ (let* ((sxml (options->sxml options "sorting=number")))
(test-equal "sort by number"
'("trn1" "trn2" "trn3" "trn4" "trn7")
(get-row-col sxml #f 2)))
(set-option! options "Sorting" "Primary Key" 'reconciled-status)
- (let* ((sxml (options->sxml options "sorting=reconciled-status"))) ;out-32.html
+ (let* ((sxml (options->sxml options "sorting=reconciled-status")))
(test-equal "sort by reconciled status"
'("desc-2" "desc-7" "desc-3" "desc-1" "desc-4")
(get-row-col sxml #f 3)))
(set-option! options "Sorting" "Primary Key" 'memo)
- (let* ((sxml (options->sxml options "sorting=memo"))) ;out-33.html
+ (let* ((sxml (options->sxml options "sorting=memo")))
(test-equal "sort by memo"
'("notes3" "memo-1" "memo-2" "memo-3")
(get-row-col sxml #f 4)))
(set-option! options "Sorting" "Primary Key" 'account-name)
- (let* ((sxml (options->sxml options "sorting=account-name"))) ;out-34.html
+ (let* ((sxml (options->sxml options "sorting=account-name")))
(test-assert "account names are sorted"
(sorted? (get-row-col sxml #f 5) string<?)))
(set-option! options "Sorting" "Primary Key" 'corresponding-acc-name)
- (let* ((sxml (options->sxml options "sorting=corresponding-acc-name"))) ;out-35.html
+ (let* ((sxml (options->sxml options "sorting=corresponding-acc-name")))
(test-equal "sort by corresponding-acc-name"
'("Expenses" "Expenses" "Income" "Income" "Liabilities")
(get-row-col sxml #f 6)))
(set-option! options "Sorting" "Primary Key" 'amount)
- (let* ((sxml (options->sxml options "sorting=amount"))) ;out-36.html
+ (let* ((sxml (options->sxml options "sorting=amount")))
(test-equal "sort by amount"
'("-$15.00" "-$8.00" "-$5.00" "$10.00" "$29.00")
((sxpath '(// (table 1) // tr // (td -1) // a // *text*)) sxml)))
@@ -746,7 +741,7 @@
(set-option! options "Display" "Totals" #t)
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'quarterly)
(set-option! options "Sorting" "Show subtotals only (hide transactional data)" #t)
- (let* ((sxml (options->sxml options "sorting=account-name, date-quarterly, subtotals only"))) ;out-37.html
+ (let* ((sxml (options->sxml options "sorting=account-name, date-quarterly, subtotals only")))
(test-equal "sorting=account-name, date-quarterly, subtotals only"
'("$570.00" "$570.00" "$570.00" "$570.00" "$2,280.00" "$2,280.00")
(get-row-col sxml #f -1)))
@@ -764,7 +759,7 @@
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'quarterly)
(set-option! options "Sorting" "Show Informal Debit/Credit Headers" #t)
(set-option! options "Sorting" "Show Account Description" #t)
- (let* ((sxml (options->sxml options "sorting=date"))) ;out-38.html
+ (let* ((sxml (options->sxml options "sorting=date")))
(test-equal "expense acc friendly headers"
'("\n" "Expenses" "Expense" "Rebate")
(get-row-col sxml 47 #f))
@@ -775,19 +770,19 @@
(set-option! options "Accounts" "Accounts" (list bank))
(set-option! options "Display" "Totals" #f)
(set-option! options "Sorting" "Show subtotals only (hide transactional data)" #t)
- (let* ((sxml (options->sxml options "sorting=date quarterly"))) ;out-39.html
+ (let* ((sxml (options->sxml options "sorting=date quarterly")))
(test-equal "quarterly subtotals are correct"
'("$570.00" "$570.00" "$570.00" "$570.00")
(get-row-col sxml #f 4)))
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'monthly)
- (let* ((sxml (options->sxml options "sorting=date monthly"))) ;out-40.html
+ (let* ((sxml (options->sxml options "sorting=date monthly")))
(test-equal "monthly subtotals are correct"
'("$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00")
(get-row-col sxml #f 4)))
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'yearly)
- (let* ((sxml (options->sxml options "sorting=date yearly"))) ;out-41.html
+ (let* ((sxml (options->sxml options "sorting=date yearly")))
(test-equal "yearly subtotals are correct"
'("$2,280.00")
(get-row-col sxml #f 4)))
@@ -797,14 +792,14 @@
(set-option! options "Sorting" "Show subtotals only (hide transactional data)" #f)
(set-option! options "Filter" "Void Transactions" 'both)
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'daily)
- (let* ((sxml (options->sxml options "sorting=date"))) ;out-42.html
+ (let* ((sxml (options->sxml options "sorting=date")))
(test-equal "daily subtotals are correct"
'("$39.00")
(get-row-col sxml 5 4)))
(set-option! options "Sorting" "Show subtotals only (hide transactional data)" #t)
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'weekly)
- (let* ((sxml (options->sxml options "sorting=date weekly"))) ;out-43.html
+ (let* ((sxml (options->sxml options "sorting=date weekly")))
(test-equal "weekly subtotals are correct (1)"
'("$34.00" "$89.00")
(get-row-col sxml #f 4))
@@ -825,7 +820,7 @@
(set-option! options "Sorting" "Primary Subtotal" #t)
(set-option! options "Sorting" "Secondary Key" 'date)
(set-option! options "Sorting" "Secondary Subtotal for Date Key" 'monthly)
- (let ((sxml (options->sxml options "subtotal table"))) ;out-44.html
+ (let ((sxml (options->sxml options "subtotal table")))
(test-equal "summary bank-row is correct"
(list "Bank" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00"
"$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$190.00" "$2,280.00")
@@ -845,7 +840,7 @@
(set-option! options "General" "Start Date" (cons 'absolute (gnc-dmy2time64 01 01 1969)))
(set-option! options "General" "End Date" (cons 'absolute (gnc-dmy2time64 31 12 1970)))
- (let ((sxml (options->sxml options "sparse subtotal table"))) ;out-45.html
+ (let ((sxml (options->sxml options "sparse subtotal table")))
(test-equal "sparse summary-table - row 1"
(list "Bank" "$29.00" "-$5.00" "-$23.00" "$1.00")
(get-row-col sxml 1 #f))
Summary of changes:
gnucash/report/business-reports/CMakeLists.txt | 1 +
.../report/business-reports/customer-summary.scm | 20 +-
gnucash/report/business-reports/easy-invoice.scm | 27 +--
gnucash/report/business-reports/fancy-invoice.scm | 19 +-
gnucash/report/business-reports/invoice.scm | 33 +--
gnucash/report/business-reports/job-report.scm | 14 +-
gnucash/report/business-reports/owner-report.scm | 20 +-
gnucash/report/business-reports/receipt.scm | 2 +-
gnucash/report/business-reports/taxinvoice.scm | 2 +-
.../report/business-reports/test/CMakeLists.txt | 31 +++
gnucash/report/report-system/CMakeLists.txt | 1 -
gnucash/report/report-system/collectors.scm | 24 +-
gnucash/report/report-system/html-table.scm | 7 +
gnucash/report/report-system/html-text.scm | 12 +-
gnucash/report/report-system/html-utilities.scm | 71 +++++-
gnucash/report/report-system/list-extras.scm | 47 ----
gnucash/report/report-system/report-collectors.scm | 7 +-
gnucash/report/report-system/report-system.scm | 2 +
gnucash/report/report-system/test/CMakeLists.txt | 5 +-
gnucash/report/report-system/test/test-extras.scm | 128 +++++-----
.../test/test-html-utilities-srfi64.scm | 30 +--
.../report/report-system/test/test-list-extras.scm | 42 ----
.../report/report-system/test/test-test-extras.scm | 5 +-
.../standard-reports/income-gst-statement.scm | 28 ++-
gnucash/report/standard-reports/register.scm | 14 +-
.../report/standard-reports/test/CMakeLists.txt | 1 +
.../test/test-cashflow-barchart.scm | 6 +-
.../test/test-generic-net-barchart.scm | 16 +-
.../test/test-generic-net-linechart.scm | 10 +-
.../standard-reports/test/test-income-gst.scm | 213 +++++++++++++++++
.../standard-reports/test/test-transaction.scm | 228 ++++++++----------
gnucash/report/standard-reports/transaction.scm | 266 ++++++++++++---------
libgnucash/app-utils/app-utils.scm | 1 -
libgnucash/app-utils/options.scm | 58 -----
libgnucash/app-utils/test/CMakeLists.txt | 8 +
libgnucash/app-utils/test/test-date-utilities.scm | 70 +++---
libgnucash/engine/test/CMakeLists.txt | 15 ++
libgnucash/engine/test/srfi64-extras.scm | 49 ++++
libgnucash/engine/test/test-extras.scm | 87 +------
libgnucash/engine/test/test-test-extras.scm | 5 +-
libgnucash/scm/utilities.scm | 5 +
po/POTFILES.in | 1 -
42 files changed, 840 insertions(+), 791 deletions(-)
create mode 100644 gnucash/report/business-reports/test/CMakeLists.txt
delete mode 100644 gnucash/report/report-system/list-extras.scm
delete mode 100644 gnucash/report/report-system/test/test-list-extras.scm
create mode 100644 gnucash/report/standard-reports/test/test-income-gst.scm
create mode 100644 libgnucash/engine/test/srfi64-extras.scm
More information about the gnucash-changes
mailing list