From 73ffcaa81e645d574e2b4c7b0429bd3b7e0e885f Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 31 Mar 2018 11:16:47 +0800 Subject: [PATCH 1/7] TR: refactor add-subtotal-row This commit refactors add-subtotal-row to use a named let. This avoids set! calls, and is more idiomatic scheme. --- .../report/standard-reports/transaction.scm | 78 ++++++++----------- 1 file changed, 32 insertions(+), 46 deletions(-) diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm index 1feee34d04..03e2478a4c 100644 --- a/gnucash/report/standard-reports/transaction.scm +++ b/gnucash/report/standard-reports/transaction.scm @@ -1290,52 +1290,38 @@ tags within description, notes or memo. ") (addto! row-contents (gnc:make-html-table-cell/size/markup 1 (+ right-indent width-left-columns) "total-label-cell" string)))) (define (add-columns commodity) - (let ((start-dual-column? #f) - (dual-subtotal #f)) - (for-each (lambda (column merge-entry) - (let* ((mon (retrieve-commodity column commodity)) - (column-amount (and mon (gnc:gnc-monetary-amount mon))) - (merge? merge-entry)) - (if merge? - ;; We're merging. If a subtotal exists, store - ;; it in dual-subtotal. Do NOT add column to row. - (begin - (set! dual-subtotal column-amount) - (set! start-dual-column? #t)) - (if start-dual-column? - (begin - ;; We've completed merging. Add the negated - ;; column amount and add the columns to row. - (if column-amount - (set! dual-subtotal - (- (or dual-subtotal 0) column-amount))) - (cond ((not dual-subtotal) - (addto! row-contents "") - (addto! row-contents "")) - ((positive? dual-subtotal) - (addto! row-contents - (gnc:make-html-table-cell/markup - "total-number-cell" - (gnc:make-gnc-monetary - commodity - dual-subtotal))) - (addto! row-contents "")) - (else - (addto! row-contents "") - (addto! row-contents - (gnc:make-html-table-cell/markup - "total-number-cell" - (gnc:make-gnc-monetary - commodity - (- dual-subtotal)))))) - (set! start-dual-column? #f) - (set! dual-subtotal #f)) - ;; Default; not merging/completed merge. Just - ;; display monetary amount - (addto! row-contents - (gnc:make-html-table-cell/markup "total-number-cell" mon)))))) - columns - merge-list))) + (let loop ((merging? #f) + (last-column #f) + (columns columns) + (merge-list merge-list)) + (if (not (null? columns)) + (let* ((mon (retrieve-commodity (car columns) commodity)) + (this-column (and mon (gnc:gnc-monetary-amount mon)))) + (if (car merge-list) + ;; We're merging. If a subtotal exists, send to next loop iteration. + (loop #t + this-column + (cdr columns) + (cdr merge-list)) + (begin + (if merging? + ;; We're completing merge. Display debit-credit in correct column. + (let* ((sum (and (or last-column this-column) + (- (or last-column 0) (or this-column 0)))) + (sum-table-cell (and sum (gnc:make-html-table-cell/markup + "total-number-cell" + (gnc:make-gnc-monetary + commodity (abs sum))))) + (debit-col (and sum (positive? sum) sum-table-cell)) + (credit-col (and sum (not (positive? sum)) sum-table-cell))) + (addto! row-contents (or debit-col "")) + (addto! row-contents (or credit-col ""))) + ;; Default; not merging nor completed merge. Display monetary amount + (addto! row-contents (gnc:make-html-table-cell/markup "total-number-cell" mon))) + (loop #f + #f + (cdr columns) + (cdr merge-list)))))))) ;; we only wish to add the first column into the grid. (if (pair? columns) From d273a3304e0ab88e258f6904cce6cfa0380cb383 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 3 Mar 2018 23:01:33 +0800 Subject: [PATCH 2/7] TR: convert Reconcile Status Filter to QofQuery I presume QofQuery based in C is faster than scheme filtering. No saved-reports incompatibility is expected. --- gnucash/report/standard-reports/transaction.scm | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm index 03e2478a4c..c773cc197d 100644 --- a/gnucash/report/standard-reports/transaction.scm +++ b/gnucash/report/standard-reports/transaction.scm @@ -321,6 +321,10 @@ in the Options panel.")) (cons 'tip (_ "Show both (and include void transactions in totals).")))))) (define reconcile-status-list + ;; 'filter-types must be either #f (i.e. disable reconcile filter) + ;; or a value defined as defined in Query.c + ;; e.g. CLEARED-NO for unreconciled + ;; (logior CLEARED-NO CLEARED-CLEARED) for unreconciled & cleared (list (cons 'all (list @@ -332,19 +336,19 @@ in the Options panel.")) (list (cons 'text (_ "Unreconciled")) (cons 'tip (_ "Unreconciled only")) - (cons 'filter-types (list #\n)))) + (cons 'filter-types CLEARED-NO))) (cons 'cleared (list (cons 'text (_ "Cleared")) (cons 'tip (_ "Cleared only")) - (cons 'filter-types (list #\c)))) + (cons 'filter-types CLEARED-CLEARED))) (cons 'reconciled (list (cons 'text (_ "Reconciled")) (cons 'tip (_ "Reconciled only")) - (cons 'filter-types (list #\y)))))) + (cons 'filter-types CLEARED-RECONCILED))))) (define ascending-list @@ -1865,6 +1869,8 @@ tags within description, notes or memo. ") ((non-void-only) (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))) ((void-only) (gnc:query-set-match-voids-only! query (gnc-get-current-book))) (else #f)) + (if reconcile-status-filter + (xaccQueryAddClearedMatch query reconcile-status-filter QOF-QUERY-AND)) (if (not custom-sort?) (begin (qof-query-set-sort-order query @@ -1892,7 +1898,6 @@ tags within description, notes or memo. ") ;; - include/exclude splits to/from selected accounts ;; - substring/regex matcher for Transaction Description/Notes/Memo ;; - custom-split-filter, a split->bool function for derived reports - ;; - by reconcile status (set! splits (filter (lambda (split) (let* ((trans (xaccSplitGetParent split)) @@ -1910,9 +1915,7 @@ tags within description, notes or memo. ") (match? (xaccSplitGetMemo split))) (or (not custom-split-filter) ; #f = ignore custom-split-filter (custom-split-filter split)) - (or (not reconcile-status-filter) ; #f = ignore reconcile-status-filter - (memv (xaccSplitGetReconcile split) - reconcile-status-filter))))) + ))) splits)) (if (null? splits) From 2d9021ca424706e0a317c276f94efa20a32d335a Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 11 Apr 2018 07:01:57 +0800 Subject: [PATCH 3/7] TR: catch invalid regex This commit prevents report crashing when either Account or Transaction Matcher strings are invalid POSIX regular expressions and called with make-regexp. --- gnucash/report/standard-reports/transaction.scm | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm index c773cc197d..4f3a6807d6 100644 --- a/gnucash/report/standard-reports/transaction.scm +++ b/gnucash/report/standard-reports/transaction.scm @@ -1747,11 +1747,13 @@ tags within description, notes or memo. ") (let* ((document (gnc:make-html-document)) (account-matcher (opt-val pagename-filter optname-account-matcher)) (account-matcher-regexp (and (opt-val pagename-filter optname-account-matcher-regex) - (make-regexp account-matcher))) + (catch 'regular-expression-syntax + (lambda () (make-regexp account-matcher)) + (const 'invalid-regex)))) (c_account_0 (opt-val gnc:pagename-accounts optname-accounts)) (c_account_1 (filter (lambda (acc) - (if account-matcher-regexp + (if (regexp? account-matcher-regexp) (regexp-exec account-matcher-regexp (gnc-account-get-full-name acc)) (string-contains (gnc-account-get-full-name acc) account-matcher))) c_account_0)) @@ -1765,7 +1767,9 @@ tags within description, notes or memo. ") (opt-val gnc:pagename-general optname-enddate)))) (transaction-matcher (opt-val pagename-filter optname-transaction-matcher)) (transaction-matcher-regexp (and (opt-val pagename-filter optname-transaction-matcher-regex) - (make-regexp transaction-matcher))) + (catch 'regular-expression-syntax + (lambda () (make-regexp transaction-matcher)) + (const 'invalid-regex)))) (reconcile-status-filter (keylist-get-info reconcile-status-list (opt-val pagename-filter optname-reconcile-status) 'filter-types)) @@ -1838,7 +1842,9 @@ tags within description, notes or memo. ") (generic-less? X Y 'date 'none #t)) - (if (or (null? c_account_1) (and-map not c_account_1)) + (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)) ;; error condition: no accounts specified or obtained after filtering (begin From 4acc5a23f5e4e04ac3815a8d1b6465cd37b72152 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 13 Apr 2018 21:28:25 +0800 Subject: [PATCH 4/7] TR: instead of hand-crafting html-string, use html-table API Using html-table API seems more robust than hand-crafting HTML. --- .../report/standard-reports/transaction.scm | 65 +++++++------------ 1 file changed, 25 insertions(+), 40 deletions(-) diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm index 4f3a6807d6..cb2dbc3a85 100644 --- a/gnucash/report/standard-reports/transaction.scm +++ b/gnucash/report/standard-reports/transaction.scm @@ -1668,45 +1668,30 @@ tags within description, notes or memo. ") (set! grid (grid-del grid row col)) ;we simply delete old data stored at row/col and (set! grid (cons (vector row col data) grid)) ;add again. this is fine because the grid should grid) ;never have duplicate data in the trep. -(define (grid->html grid list-of-rows list-of-cols) - (define (cell->html cell) - (if (pair? cell) - (string-append "" - (string-join (map gnc:monetary->string - (vector-ref (car cell) 2)) - "
\n") - "\n") - "\n")) - (define (row->html row list-of-cols) - (string-append "" - (if (eq? row 'row-total) - (_ "Grand Total") - (cdr row)) - "\n" - (string-join (map - (lambda (col) (cell->html (grid-get grid row col))) - list-of-cols) "") - (cell->html (grid-get grid row 'col-total)) - "\n")) - (string-append "" - "\n" - (string-join (map (lambda (col) - (string-append "\n")) list-of-cols) "") - "\n\n" - (string-join (map (lambda (row) - (row->html row list-of-cols)) - list-of-rows) "") - (if (memq 'row-total (grid-rows grid)) - (row->html 'row-total list-of-cols) - "") - "
" - optname-grid - "
" - (cdr col) - "" - (_ "Total") - "
\n")) - +(define (grid->html-table grid list-of-rows list-of-cols) + (define (make-table-cell row col) + (let ((cell (grid-get grid row col))) + (if (pair? cell) + (gnc:make-html-table-cell/markup "number-cell" (car (vector-ref (car cell) 2))) + ""))) + (define (make-row row) + (append + (list (if (eq? row 'row-total) (_ "Grand Total") (cdr row))) + (map (lambda (col) (make-table-cell row col)) + list-of-cols) + (list (make-table-cell row 'col-total)))) + (let ((table (gnc:make-html-table))) + (gnc:html-table-set-caption! table optname-grid) + (gnc:html-table-set-col-headers! table (append (list "") (map cdr list-of-cols) (list (_ "Total")))) + (gnc:html-table-set-style! table "th" + 'attribute (list "class" "column-heading-right")) + (for-each + (lambda (row) + (gnc:html-table-append-row! table (make-row row))) + list-of-rows) + (if (memq 'row-total (grid-rows grid)) + (gnc:html-table-append-row! table (make-row 'row-total))) + table)) ;; ;;;;;;;;;;;;;;;;;;;; ;; Here comes the renderer function for this report. @@ -1962,7 +1947,7 @@ tags within description, notes or memo. ") (list-of-rows (stable-sort! (delete 'row-total (grid-rows grid)) generichtml grid list-of-rows list-of-cols)))) + document (grid->html-table grid list-of-rows list-of-cols)))) (if (eq? infobox-display 'always) (gnc:html-document-add-object! From b02e4a7c148d84b3ab702d81fb86ff9170f134bb Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 14 Apr 2018 22:00:12 +0800 Subject: [PATCH 5/7] GSTR: bugfix individual tax on sales should be negated The GST-on-sales relates to income, therefore should be negated. --- gnucash/report/standard-reports/income-gst-statement.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm index 8143dd3c20..ed61412701 100644 --- a/gnucash/report/standard-reports/income-gst-statement.scm +++ b/gnucash/report/standard-reports/income-gst-statement.scm @@ -216,7 +216,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.") (lambda (a) "")))) (if (opt-val gnc:pagename-display (N_ "Individual tax columns")) (map (lambda (acc) (vector (xaccAccountGetName acc) - (account-adder acc) + (account-adder-neg acc) #t #t #f (lambda (a) ""))) accounts-tax-collected) From 1ee2c08306af8b480b5a706854c4557139400c76 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 14 Apr 2018 22:13:21 +0800 Subject: [PATCH 6/7] GSTR: close br tag; add empty lines to empty-report-message This will be useful for unit testing, and for displaying gnc:render-options-changed. --- gnucash/report/standard-reports/income-gst-statement.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm index ed61412701..2cd7b7e27a 100644 --- a/gnucash/report/standard-reports/income-gst-statement.scm +++ b/gnucash/report/standard-reports/income-gst-statement.scm @@ -43,14 +43,15 @@ 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.") - "

" + "

" (_ "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.") - "

" + "

" (_ "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."))) +accounts must be of type ASSET for taxes paid on expenses, and type LIABILITY for taxes collected on sales.") + "

")) (define (income-gst-statement-renderer rpt) (trep-renderer rpt From 8db114658be024fa894fbca4fb1f71d1b2a6975c Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 14 Apr 2018 22:43:19 +0800 Subject: [PATCH 7/7] html-font: add default font family Windows ships with GTK2 in which the default font styles are named "Sans" "Sans Bold" "Sans Normal" etc. There is no "Sans" font in Windows; I vote to add a default "Sans-Serif" font-family which is valid CSS. This ensures exported reports are shown as intended. --- gnucash/report/report-system/html-fonts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnucash/report/report-system/html-fonts.scm b/gnucash/report/report-system/html-fonts.scm index 8ad15bd8dc..fee9af93fa 100644 --- a/gnucash/report/report-system/html-fonts.scm +++ b/gnucash/report/report-system/html-fonts.scm @@ -68,7 +68,7 @@ )))) (set! font-family font-name) (set! result (string-append - "font-family: " font-family "; " + "font-family: " font-family ", Sans-Serif; " "font-size: " font-size "pt; " (if font-style (string-append "font-style: " font-style "; ") "") (if font-weight (string-append "font-weight: " font-weight "; ") "")))