IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'unstable-tr-fix' of https://github.com/christopherlam/gnucash into unstable

Browse Source
This commit is contained in:
Geert Janssens 2018-04-14 18:59:26 +02:00
commit a39ba1672a
3 changed files with 83 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gnucash/report/report-system/html-fonts.scm
View File

@ -68,7 +68,7 @@
)))) ))))
(set! font-family font-name) (set! font-family font-name)
(set! result (string-append (set! result (string-append
"font-family: " font-family "; " "font-family: " font-family ", Sans-Serif; "
"font-size: " font-size "pt; " "font-size: " font-size "pt; "
(if font-style (string-append "font-style: " font-style "; ") "") (if font-style (string-append "font-style: " font-style "; ") "")
(if font-weight (string-append "font-weight: " font-weight "; ") ""))) (if font-weight (string-append "font-weight: " font-weight "; ") "")))

9
gnucash/report/standard-reports/income-gst-statement.scm
View File

@ -43,14 +43,15 @@
authorities. From <i>Edit report options</i> above, choose your Business Income and Business Expense accounts. authorities. From <i>Edit report options</i> above, choose your Business Income and Business Expense accounts.
Each transaction may contain, in addition to the accounts payable/receivable or bank 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.") a split to a tax account, e.g. Income:Sales -$1000, Liability:GST on Sales -$100, Asset:Bank $1100.")
"<br><br>" "<br/><br/>"
(_ "These tax accounts can either be populated using the standard register, or from Business Invoices and Bills (_ "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.") which will require Business > Sales Tax Tables to be set up correctly. Please see the documentation.")
"<br><br>" "<br/><br/>"
(_ "From the Report Options, you will need to select the accounts which will \ (_ "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 \ 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 \ 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.")
"<br/><br/>"))
(define (income-gst-statement-renderer rpt) (define (income-gst-statement-renderer rpt)
(trep-renderer rpt (trep-renderer rpt
@ -216,7 +217,7 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.")
(lambda (a) "")))) (lambda (a) ""))))
(if (opt-val gnc:pagename-display (N_ "Individual tax columns")) (if (opt-val gnc:pagename-display (N_ "Individual tax columns"))
(map (lambda (acc) (vector (xaccAccountGetName acc) (map (lambda (acc) (vector (xaccAccountGetName acc)
(account-adder acc) (account-adder-neg acc)
#t #t #f #t #t #f
(lambda (a) ""))) (lambda (a) "")))
accounts-tax-collected) accounts-tax-collected)

174
gnucash/report/standard-reports/transaction.scm
View File

@ -321,6 +321,10 @@ in the Options panel."))
(cons 'tip (_ "Show both (and include void transactions in totals).")))))) (cons 'tip (_ "Show both (and include void transactions in totals)."))))))
(define reconcile-status-list (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 (list
(cons 'all (cons 'all
(list (list
@ -332,19 +336,19 @@ in the Options panel."))
(list (list
(cons 'text (_ "Unreconciled")) (cons 'text (_ "Unreconciled"))
(cons 'tip (_ "Unreconciled only")) (cons 'tip (_ "Unreconciled only"))
(cons 'filter-types (list #\n)))) (cons 'filter-types CLEARED-NO)))
(cons 'cleared (cons 'cleared
(list (list
(cons 'text (_ "Cleared")) (cons 'text (_ "Cleared"))
(cons 'tip (_ "Cleared only")) (cons 'tip (_ "Cleared only"))
(cons 'filter-types (list #\c)))) (cons 'filter-types CLEARED-CLEARED)))
(cons 'reconciled (cons 'reconciled
(list (list
(cons 'text (_ "Reconciled")) (cons 'text (_ "Reconciled"))
(cons 'tip (_ "Reconciled only")) (cons 'tip (_ "Reconciled only"))
(cons 'filter-types (list #\y)))))) (cons 'filter-types CLEARED-RECONCILED)))))
(define ascending-list (define ascending-list
@ -1290,52 +1294,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)))) (addto! row-contents (gnc:make-html-table-cell/size/markup 1 (+ right-indent width-left-columns) "total-label-cell" string))))
(define (add-columns commodity) (define (add-columns commodity)
(let ((start-dual-column? #f) (let loop ((merging? #f)
(dual-subtotal #f)) (last-column #f)
(for-each (lambda (column merge-entry) (columns columns)
(let* ((mon (retrieve-commodity column commodity)) (merge-list merge-list))
(column-amount (and mon (gnc:gnc-monetary-amount mon))) (if (not (null? columns))
(merge? merge-entry)) (let* ((mon (retrieve-commodity (car columns) commodity))
(if merge? (this-column (and mon (gnc:gnc-monetary-amount mon))))
;; We're merging. If a subtotal exists, store (if (car merge-list)
;; it in dual-subtotal. Do NOT add column to row. ;; We're merging. If a subtotal exists, send to next loop iteration.
(begin (loop #t
(set! dual-subtotal column-amount) this-column
(set! start-dual-column? #t)) (cdr columns)
(if start-dual-column? (cdr merge-list))
(begin (begin
;; We've completed merging. Add the negated (if merging?
;; column amount and add the columns to row. ;; We're completing merge. Display debit-credit in correct column.
(if column-amount (let* ((sum (and (or last-column this-column)
(set! dual-subtotal (- (or last-column 0) (or this-column 0))))
(- (or dual-subtotal 0) column-amount))) (sum-table-cell (and sum (gnc:make-html-table-cell/markup
(cond ((not dual-subtotal) "total-number-cell"
(addto! row-contents "") (gnc:make-gnc-monetary
(addto! row-contents "")) commodity (abs sum)))))
((positive? dual-subtotal) (debit-col (and sum (positive? sum) sum-table-cell))
(addto! row-contents (credit-col (and sum (not (positive? sum)) sum-table-cell)))
(gnc:make-html-table-cell/markup (addto! row-contents (or debit-col ""))
"total-number-cell" (addto! row-contents (or credit-col "")))
(gnc:make-gnc-monetary ;; Default; not merging nor completed merge. Display monetary amount
commodity (addto! row-contents (gnc:make-html-table-cell/markup "total-number-cell" mon)))
dual-subtotal))) (loop #f
(addto! row-contents "")) #f
(else (cdr columns)
(addto! row-contents "") (cdr merge-list))))))))
(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)))
;; we only wish to add the first column into the grid. ;; we only wish to add the first column into the grid.
(if (pair? columns) (if (pair? columns)
@ -1678,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 (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 (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. grid) ;never have duplicate data in the trep.
(define (grid->html grid list-of-rows list-of-cols) (define (grid->html-table grid list-of-rows list-of-cols)
(define (cell->html cell) (define (make-table-cell row col)
(if (pair? cell) (let ((cell (grid-get grid row col)))
(string-append "<td class=\"number-cell\">" (if (pair? cell)
(string-join (map gnc:monetary->string (gnc:make-html-table-cell/markup "number-cell" (car (vector-ref (car cell) 2)))
(vector-ref (car cell) 2)) "")))
"<br/>\n") (define (make-row row)
"</td>\n") (append
"<td></td>\n")) (list (if (eq? row 'row-total) (_ "Grand Total") (cdr row)))
(define (row->html row list-of-cols) (map (lambda (col) (make-table-cell row col))
(string-append "<tr><td>" list-of-cols)
(if (eq? row 'row-total) (list (make-table-cell row 'col-total))))
(_ "Grand Total") (let ((table (gnc:make-html-table)))
(cdr row)) (gnc:html-table-set-caption! table optname-grid)
"</td>\n" (gnc:html-table-set-col-headers! table (append (list "") (map cdr list-of-cols) (list (_ "Total"))))
(string-join (map (gnc:html-table-set-style! table "th"
(lambda (col) (cell->html (grid-get grid row col))) 'attribute (list "class" "column-heading-right"))
list-of-cols) "") (for-each
(cell->html (grid-get grid row 'col-total)) (lambda (row)
"</tr>\n")) (gnc:html-table-append-row! table (make-row row)))
(string-append "<table class=\"summary-table\"><caption>" list-of-rows)
optname-grid (if (memq 'row-total (grid-rows grid))
"</caption><thead><tr>" (gnc:html-table-append-row! table (make-row 'row-total)))
"<th></th>\n" table))
(string-join (map (lambda (col)
(string-append "<th class=\"column-heading-right\">"
(cdr col)
"</th>\n")) list-of-cols) "")
"<th class=\"column-heading-right\">"
(_ "Total")
"</th>\n</tr>\n</thead><tbody>"
(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)
"")
"</tbody></table>\n"))
;; ;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;
;; Here comes the renderer function for this report. ;; Here comes the renderer function for this report.
@ -1757,11 +1732,13 @@ tags within description, notes or memo. ")
(let* ((document (gnc:make-html-document)) (let* ((document (gnc:make-html-document))
(account-matcher (opt-val pagename-filter optname-account-matcher)) (account-matcher (opt-val pagename-filter optname-account-matcher))
(account-matcher-regexp (and (opt-val pagename-filter optname-account-matcher-regex) (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_0 (opt-val gnc:pagename-accounts optname-accounts))
(c_account_1 (filter (c_account_1 (filter
(lambda (acc) (lambda (acc)
(if account-matcher-regexp (if (regexp? account-matcher-regexp)
(regexp-exec account-matcher-regexp (gnc-account-get-full-name acc)) (regexp-exec account-matcher-regexp (gnc-account-get-full-name acc))
(string-contains (gnc-account-get-full-name acc) account-matcher))) (string-contains (gnc-account-get-full-name acc) account-matcher)))
c_account_0)) c_account_0))
@ -1775,7 +1752,9 @@ tags within description, notes or memo. ")
(opt-val gnc:pagename-general optname-enddate)))) (opt-val gnc:pagename-general optname-enddate))))
(transaction-matcher (opt-val pagename-filter optname-transaction-matcher)) (transaction-matcher (opt-val pagename-filter optname-transaction-matcher))
(transaction-matcher-regexp (and (opt-val pagename-filter optname-transaction-matcher-regex) (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 (reconcile-status-filter (keylist-get-info reconcile-status-list
(opt-val pagename-filter optname-reconcile-status) (opt-val pagename-filter optname-reconcile-status)
'filter-types)) 'filter-types))
@ -1848,7 +1827,9 @@ tags within description, notes or memo. ")
(generic-less? X Y 'date 'none #t)) (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 ;; error condition: no accounts specified or obtained after filtering
(begin (begin
@ -1879,6 +1860,8 @@ tags within description, notes or memo. ")
((non-void-only) (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))) ((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))) ((void-only) (gnc:query-set-match-voids-only! query (gnc-get-current-book)))
(else #f)) (else #f))
(if reconcile-status-filter
(xaccQueryAddClearedMatch query reconcile-status-filter QOF-QUERY-AND))
(if (not custom-sort?) (if (not custom-sort?)
(begin (begin
(qof-query-set-sort-order query (qof-query-set-sort-order query
@ -1906,7 +1889,6 @@ tags within description, notes or memo. ")
;; - include/exclude splits to/from selected accounts ;; - include/exclude splits to/from selected accounts
;; - substring/regex matcher for Transaction Description/Notes/Memo ;; - substring/regex matcher for Transaction Description/Notes/Memo
;; - custom-split-filter, a split->bool function for derived reports ;; - custom-split-filter, a split->bool function for derived reports
;; - by reconcile status
(set! splits (filter (set! splits (filter
(lambda (split) (lambda (split)
(let* ((trans (xaccSplitGetParent split)) (let* ((trans (xaccSplitGetParent split))
@ -1924,9 +1906,7 @@ tags within description, notes or memo. ")
(match? (xaccSplitGetMemo split))) (match? (xaccSplitGetMemo split)))
(or (not custom-split-filter) ; #f = ignore custom-split-filter (or (not custom-split-filter) ; #f = ignore custom-split-filter
(custom-split-filter split)) (custom-split-filter split))
(or (not reconcile-status-filter) ; #f = ignore reconcile-status-filter )))
(memv (xaccSplitGetReconcile split)
reconcile-status-filter)))))
splits)) splits))
(if (null? splits) (if (null? splits)
@ -1967,7 +1947,7 @@ tags within description, notes or memo. ")
(list-of-rows (stable-sort! (delete 'row-total (grid-rows grid)) generic<?)) (list-of-rows (stable-sort! (delete 'row-total (grid-rows grid)) generic<?))
(list-of-cols (stable-sort! (delete 'col-total (grid-cols grid)) generic<?))) (list-of-cols (stable-sort! (delete 'col-total (grid-cols grid)) generic<?)))
(gnc:html-document-add-object! (gnc:html-document-add-object!
document (grid->html grid list-of-rows list-of-cols)))) document (grid->html-table grid list-of-rows list-of-cols))))
(if (eq? infobox-display 'always) (if (eq? infobox-display 'always)
(gnc:html-document-add-object! (gnc:html-document-add-object!