From 276a7d24d2d0380cda24f5f0f7f159ea897101a5 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Fri, 12 Jan 2018 16:45:03 +1100 Subject: [PATCH] REWRITE income-gst-statement.scm This commit rewrites income-gst-statement.scm to be a derivation of transaction.scm, modifying the options database and passing custom arguments to the trep-renderer. This should hopefully reduce risk of errors. --- .../standard-reports/income-gst-statement.scm | 1926 ++--------------- .../report/standard-reports/transaction.scm | 53 +- libgnucash/app-utils/options.scm | 8 +- 3 files changed, 224 insertions(+), 1763 deletions(-) diff --git a/gnucash/report/standard-reports/income-gst-statement.scm b/gnucash/report/standard-reports/income-gst-statement.scm index 824750e401..54a4521d76 100644 --- a/gnucash/report/standard-reports/income-gst-statement.scm +++ b/gnucash/report/standard-reports/income-gst-statement.scm @@ -2,16 +2,9 @@ ;; Income-GST-Statement.scm : Produce report suitable for ;; annual income tax returns and periodic VAT/GST reporting. ;; -;; Original transaction.scm report by Robert Merkel -;; Contributions by Bryan Larsen -;; More contributions for new report generation code by Robert Merkel -;; More contributions by Christian Stimming -;; Modified to support the intersection of two account lists by -;; Michael T. Garrison Stuber -;; Modified account names display by Tomas Pospisek -;; with a lot of help from "warlord" -;; Heavily amended by Christopher Lam to add calculations -;; appropriate for GST/VAT, building on efforts by Doug Doughty. +;; Original Income and GST Report designed by Christopher Lam +;; Will reuse the Transaction Report with customised options +;; and calculated cells. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -36,1783 +29,214 @@ (use-modules (gnucash utilities)) (use-modules (srfi srfi-1)) -(use-modules (srfi srfi-13)) -(use-modules (ice-9 regex)) (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) -(use-modules (gnucash printf)) (gnc:module-load "gnucash/report/report-system" 0) - -(define-macro (addto! alist element) - `(set! ,alist (cons ,element ,alist))) +(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 pagename-sorting (N_ "Sorting")) -(define optname-prime-sortkey (N_ "Primary Key")) -(define optname-prime-subtotal (N_ "Primary Subtotal")) -(define optname-prime-sortorder (N_ "Primary Sort Order")) -(define optname-prime-date-subtotal (N_ "Primary Subtotal for Date Key")) -(define optname-full-account-name (N_ "Show Full Account Name")) -(define optname-show-account-code (N_ "Show Account Code")) -(define optname-sec-sortkey (N_ "Secondary Key")) -(define optname-sec-subtotal (N_ "Secondary Subtotal")) -(define optname-sec-sortorder (N_ "Secondary Sort Order")) -(define optname-sec-date-subtotal (N_ "Secondary Subtotal for Date Key")) -(define optname-void-transactions (N_ "Void Transactions")) -(define optname-table-export (N_ "Table for Exporting")) -(define optname-common-currency (N_ "Common Currency")) (define TAX-SETUP-DESC (N_ "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.")) -(define optname-currency (N_ "Report's currency")) -(define optname-account-matcher (N_ "Account Matcher")) -(define optname-account-matcher-regex (N_ "Account Matcher uses regular expressions for extended matching")) -(define optname-transaction-matcher (N_ "Transaction Matcher")) -(define optname-transaction-matcher-regex (N_ "Transaction Matcher uses regular expressions for extended matching")) -(define def:grand-total-style "grand-total") -(define def:normal-row-style "normal-row") -(define def:alternate-row-style "alternate-row") -(define def:primary-subtotal-style "primary-subheading") -(define def:secondary-subtotal-style "secondary-subheading") -;; The option-values of the sorting key multichoice option, for -;; which a subtotal should be enabled. -(define subtotal-enabled '(account-name - account-code - corresponding-acc-name - corresponding-acc-code)) -(define (split-account-full-name-same-p a b) - (= (xaccSplitCompareAccountFullNames a b) 0)) +(define (income-gst-statement-renderer rpt) + (trep-renderer rpt + #:custom-calculated-cells gst-calculated-cells + #:empty-report-message TAX-SETUP-DESC)) -(define (split-account-code-same-p a b) - (= (xaccSplitCompareAccountCodes a b) 0)) +(define (gst-statement-options-generator) + ;; Retrieve the list of options specified within the transaction report + (define options (trep-options-generator)) -(define (split-same-corr-account-full-name-p a b) - (= (xaccSplitCompareOtherAccountFullNames a b) 0)) - -(define (split-same-corr-account-code-p a b) - (= (xaccSplitCompareOtherAccountCodes a b) 0)) - -(define (time64-same-year tp-a tp-b) - (= (gnc:time64-get-year tp-a) - (gnc:time64-get-year tp-b))) - -(define (time64-same-quarter tp-a tp-b) - (and (time64-same-year tp-a tp-b) - (= (gnc:time64-get-quarter tp-a) - (gnc:time64-get-quarter tp-b)))) - -(define (time64-same-month tp-a tp-b) - (and (time64-same-year tp-a tp-b) - (= (gnc:time64-get-month tp-a) - (gnc:time64-get-month tp-b)))) - -(define (time64-same-week tp-a tp-b) - (and (time64-same-year tp-a tp-b) - (= (gnc:time64-get-week tp-a) - (gnc:time64-get-week tp-b)))) - -(define (split-same-week-p a b) - (let ((tp-a (xaccTransGetDate (xaccSplitGetParent a))) - (tp-b (xaccTransGetDate (xaccSplitGetParent b)))) - (time64-same-week tp-a tp-b))) - -(define (split-same-month-p a b) - (let ((tp-a (xaccTransGetDate (xaccSplitGetParent a))) - (tp-b (xaccTransGetDate (xaccSplitGetParent b)))) - (time64-same-month tp-a tp-b))) - -(define (split-same-quarter-p a b) - (let ((tp-a (xaccTransGetDate (xaccSplitGetParent a))) - (tp-b (xaccTransGetDate (xaccSplitGetParent b)))) - (time64-same-quarter tp-a tp-b))) - -(define (split-same-year-p a b) - (let ((tp-a (xaccTransGetDate (xaccSplitGetParent a))) - (tp-b (xaccTransGetDate (xaccSplitGetParent b)))) - (time64-same-year tp-a tp-b))) - -(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 (add-subheading-row data table width subheading-style) - (let ((heading-cell (gnc:make-html-table-cell data))) - (gnc:html-table-cell-set-colspan! heading-cell width) - (gnc:html-table-append-row/markup! - table - subheading-style - (list heading-cell)))) - -;; display an account name depending on the options the user has set -(define (account-namestring account show-account-code show-account-name show-account-full-name) - ;;# on multi-line splits we can get an empty ('()) account - (if (null? account) - (_ "Split Transaction") - (string-append - ;; display account code? - (if show-account-code - (string-append (xaccAccountGetCode account) " ") - "") - ;; display account name? - (if show-account-name - ;; display full account name? - (if show-account-full-name - (gnc-account-get-full-name account) - (xaccAccountGetName account)) - "")))) - -;; render an account subheading - column-vector determines what is displayed -(define (render-account-subheading - split table width subheading-style column-vector) - (let ((account (xaccSplitGetAccount split))) - (add-subheading-row (gnc:make-html-text - (gnc:html-markup-anchor - (gnc:account-anchor-text account) - (account-namestring account - (used-sort-account-code column-vector) - #t - (used-sort-account-full-name column-vector)))) - table width subheading-style))) - -(define (render-corresponding-account-subheading - split table width subheading-style column-vector) - (let ((account (xaccSplitGetAccount (xaccSplitGetOtherSplit split)))) - (add-subheading-row (gnc:make-html-text - (gnc:html-markup-anchor - (if (not (null? account)) - (gnc:account-anchor-text account) - "") - (account-namestring account - (used-sort-account-code column-vector) - #t - (used-sort-account-full-name column-vector)))) - table width subheading-style))) - -(define (render-week-subheading split table width subheading-style column-vector) - (add-subheading-row (gnc:date-get-week-year-string - (gnc-localtime - (xaccTransGetDate - (xaccSplitGetParent split)))) - table width subheading-style)) - -(define (render-month-subheading split table width subheading-style column-vector) - (add-subheading-row (gnc:date-get-month-year-string - (gnc-localtime - (xaccTransGetDate - (xaccSplitGetParent split)))) - table width subheading-style)) - -(define (render-quarter-subheading split table width subheading-style column-vector) - (add-subheading-row (gnc:date-get-quarter-year-string - (gnc-localtime - (xaccTransGetDate - (xaccSplitGetParent split)))) - table width subheading-style)) - -(define (render-year-subheading split table width subheading-style column-vector) - (add-subheading-row (gnc:date-get-year-string - (gnc-localtime - (xaccTransGetDate - (xaccSplitGetParent split)))) - table width subheading-style)) - - -(define (add-subtotal-row table width subtotal-string subtotal-collectors - subtotal-style export?) - (let* ((row-contents '()) - (columns (map (lambda (coll) (coll 'format gnc:make-gnc-monetary #f)) subtotal-collectors)) - (list-of-commodities (delete-duplicates (map gnc:gnc-monetary-commodity (apply append columns)) - gnc-commodity-equal))) - - (define (retrieve-commodity list-of-monetary commodity) - (if (null? list-of-monetary) - #f - (if (gnc-commodity-equal (gnc:gnc-monetary-commodity (car list-of-monetary)) commodity) - (car list-of-monetary) - (retrieve-commodity (cdr list-of-monetary) commodity)))) - - (define (add-first-column string) - (if export? - (begin - (addto! row-contents (gnc:make-html-table-cell/markup "total-label-cell" string)) - (for-each (lambda (cell) (addto! row-contents cell)) - (gnc:html-make-empty-cells (- width 1)))) - (addto! row-contents (gnc:make-html-table-cell/size/markup 1 width "total-label-cell" string)))) - - (define (add-columns commodity) - (for-each (lambda (column) - (addto! row-contents - (gnc:make-html-table-cell/markup - "total-number-cell" - (retrieve-commodity column commodity)))) - columns)) - - ;first row - (add-first-column subtotal-string) - (add-columns (if (pair? list-of-commodities) - (car list-of-commodities) - #f)) ;to account for empty-row subtotals - (gnc:html-table-append-row/markup! table subtotal-style (reverse row-contents)) - - ;subsequent rows - (if (pair? list-of-commodities) - (for-each (lambda (commodity) - (set! row-contents '()) - (add-first-column "") - (add-columns commodity) - (gnc:html-table-append-row/markup! table subtotal-style (reverse row-contents))) - (cdr list-of-commodities))))) - -(define (total-string str) (string-append (_ "Total For ") str)) - -(define (render-account-subtotal - table width split total-collector subtotal-style column-vector export?) - (add-subtotal-row table width - (total-string (account-namestring (xaccSplitGetAccount split) - (used-sort-account-code column-vector) - #t - (used-sort-account-full-name column-vector))) - total-collector subtotal-style export?)) - -(define (render-corresponding-account-subtotal - table width split total-collector subtotal-style column-vector export?) - (add-subtotal-row table width - (total-string (account-namestring (xaccSplitGetAccount - (xaccSplitGetOtherSplit split)) - (used-sort-account-code column-vector) - #t - (used-sort-account-full-name column-vector))) - total-collector subtotal-style export?)) - -(define (render-week-subtotal - table width split total-collector subtotal-style column-vector export?) - (let ((tm (gnc-localtime (xaccTransGetDate - (xaccSplitGetParent split))))) - (add-subtotal-row table width - (total-string (gnc:date-get-week-year-string tm)) - total-collector subtotal-style export?))) - -(define (render-month-subtotal - table width split total-collector subtotal-style column-vector export?) - (let ((tm (gnc-localtime (xaccTransGetDate - (xaccSplitGetParent split))))) - (add-subtotal-row table width - (total-string (gnc:date-get-month-year-string tm)) - total-collector subtotal-style export?))) - - -(define (render-quarter-subtotal - table width split total-collector subtotal-style column-vector export?) - (let ((tm (gnc-localtime (xaccTransGetDate - (xaccSplitGetParent split))))) - (add-subtotal-row table width - (total-string (gnc:date-get-quarter-year-string tm)) - total-collector subtotal-style export?))) - -(define (render-year-subtotal - table width split total-collector subtotal-style column-vector export?) - (let ((tm (gnc-localtime (xaccTransGetDate - (xaccSplitGetParent split))))) - (add-subtotal-row table width - (total-string (strftime "%Y" tm)) - total-collector subtotal-style export?))) - - -(define (render-grand-total - table width total-collector export?) - (add-subtotal-row table width - (_ "Grand Total") - total-collector def:grand-total-style export?)) - -(define account-types-to-reverse-assoc-list - (list (cons 'none '()) - (cons 'income-expense - (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)) - (cons 'credit-accounts - (list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE ACCT-TYPE-EQUITY - ACCT-TYPE-CREDIT ACCT-TYPE-INCOME)))) - -(define (used-date columns-used) - (vector-ref columns-used 0)) -(define (used-reconciled-date columns-used) - (vector-ref columns-used 1)) -(define (used-num columns-used) - (vector-ref columns-used 2)) -(define (used-description columns-used) - (vector-ref columns-used 3)) -(define (used-account-name columns-used) - (vector-ref columns-used 4)) -(define (used-other-account-name columns-used) - (vector-ref columns-used 5)) -(define (used-shares columns-used) - (vector-ref columns-used 6)) -(define (used-price columns-used) - (vector-ref columns-used 7)) -(define (used-amount-single columns-used) - (vector-ref columns-used 8)) -(define (used-amount-double-positive columns-used) - (vector-ref columns-used 9)) -(define (used-amount-double-negative columns-used) - (vector-ref columns-used 10)) -(define (used-account-full-name columns-used) - (vector-ref columns-used 12)) -(define (used-memo columns-used) - (vector-ref columns-used 13)) -(define (used-account-code columns-used) - (vector-ref columns-used 14)) -(define (used-other-account-code columns-used) - (vector-ref columns-used 15)) -(define (used-other-account-full-name columns-used) - (vector-ref columns-used 16)) -(define (used-sort-account-code columns-used) - (vector-ref columns-used 17)) -(define (used-sort-account-full-name columns-used) - (vector-ref columns-used 18)) -(define (used-notes columns-used) - (vector-ref columns-used 19)) - -(define columns-used-size 20) - -(define (num-columns-required columns-used) - (do ((i 0 (+ i 1)) - (col-req 0 col-req)) - ((>= i columns-used-size) col-req) - ; If column toggle is true, increase column count. But attention: - ; some toggles only change the meaning of another toggle. Don't count these modifier toggles - (if (and (not (= i 12)) ; Skip Account Full Name toggle - modifies Account Name column - (not (= i 16)) ; Skip Other Account Full Name toggle - modifies Other Account Name column - (not (= i 17)) ; Skip Sort Account Code - modifies Account Name subheading - (not (= i 18)) ; Skip Sort Account Full Name - modifies Account Name subheading - (not (= i 19)) ; Skip Note toggle - modifies Memo column - (vector-ref columns-used i)) - (set! col-req (+ col-req 1))) - ; Account Code and Account Name share one column so if both were ticked the - ; the check above would have set up one column too much. The check below - ; will compensate these again. - (if (or (and (= i 14) (vector-ref columns-used 14) (vector-ref columns-used 4)) ; Account Code and Name - (and (= i 15) (vector-ref columns-used 15) (vector-ref columns-used 5))) ; Other Account Code and Name - (set! col-req (- col-req 1))))) - -(define (build-column-used options) - (define (opt-val section name) - (gnc:option-value - (gnc:lookup-option options section name))) - (let ((column-list (make-vector columns-used-size #f))) - (if (opt-val gnc:pagename-display (N_ "Date")) - (vector-set! column-list 0 #t)) - (if (opt-val gnc:pagename-display (N_ "Reconciled Date")) - (vector-set! column-list 1 #t)) - (if (if (gnc:lookup-option options gnc:pagename-display (N_ "Num")) - (opt-val gnc:pagename-display (N_ "Num")) - (opt-val gnc:pagename-display (N_ "Num/Action"))) - (vector-set! column-list 2 #t)) - (if (opt-val gnc:pagename-display (N_ "Description")) - (vector-set! column-list 3 #t)) - (if (opt-val gnc:pagename-display (N_ "Account Name")) - (vector-set! column-list 4 #t)) - (if (opt-val gnc:pagename-display (N_ "Other Account Name")) - (vector-set! column-list 5 #t)) - ;(if (opt-val gnc:pagename-display (N_ "Shares")) - ; (vector-set! column-list 6 #t)) - ;(if (opt-val gnc:pagename-display (N_ "Price")) - ; (vector-set! column-list 7 #t)) - ;(let ((amount-setting (opt-val gnc:pagename-display (N_ "Amount")))) - ; (if (eq? amount-setting 'single) - ; (vector-set! column-list 8 #t)) - ; (if (eq? amount-setting 'double) - ; (begin (vector-set! column-list 9 #t) - ; (vector-set! column-list 10 #t)))) - - (if (opt-val gnc:pagename-display (N_ "Use Full Account Name")) - (vector-set! column-list 12 #t)) - (if (opt-val gnc:pagename-display (N_ "Memo")) - (vector-set! column-list 13 #t)) - (if (opt-val gnc:pagename-display (N_ "Account Code")) - (vector-set! column-list 14 #t)) - (if (opt-val gnc:pagename-display (N_ "Other Account Code")) - (vector-set! column-list 15 #t)) - (if (opt-val gnc:pagename-display (N_ "Use Full Other Account Name")) - (vector-set! column-list 16 #t)) - (if (opt-val pagename-sorting (N_ "Show Account Code")) - (vector-set! column-list 17 #t)) - (if (opt-val pagename-sorting (N_ "Show Full Account Name")) - (vector-set! column-list 18 #t)) - (if (opt-val gnc:pagename-display (N_ "Notes")) - (vector-set! column-list 19 #t)) - column-list)) - -(define (make-heading-list column-vector calculated-cells options) - (let ((heading-list '())) - (if (used-date column-vector) - (addto! heading-list (_ "Date"))) - (if (used-reconciled-date column-vector) - (addto! heading-list (_ "Reconciled Date"))) - (if (used-num column-vector) - (addto! heading-list (if (and (qof-book-use-split-action-for-num-field - (gnc-get-current-book)) - (if (gnc:lookup-option options - gnc:pagename-display - (N_ "Trans Number")) - (gnc:option-value - (gnc:lookup-option options - gnc:pagename-display - (N_ "Trans Number"))) - #f)) - (_ "Num/T-Num") - (_ "Num")))) - (if (used-description column-vector) - (addto! heading-list (_ "Description"))) - (if (used-memo column-vector) - (if (used-notes column-vector) - (addto! heading-list (string-append (_ "Memo") "/" (_ "Notes"))) - (addto! heading-list (_ "Memo")))) - (if (or (used-account-name column-vector) (used-account-code column-vector)) - (addto! heading-list (_ "Account"))) - (if (or (used-other-account-name column-vector) (used-other-account-code column-vector)) - (addto! heading-list (_ "Transfer from/to"))) - ;(if (used-shares column-vector) - ; (addto! heading-list (_ "Shares"))) - ;(if (used-price column-vector) - ; (addto! heading-list (_ "Price"))) - ;(if (used-amount-single column-vector) - ; (addto! heading-list (_ "Amount"))) - ;; FIXME: Proper labels: what? - (if (used-amount-double-positive column-vector) - (addto! heading-list (_ "Debit"))) - (if (used-amount-double-negative column-vector) - (addto! heading-list (_ "Credit"))) - - (for-each (lambda (cell) - (addto! heading-list - (gnc:make-html-table-cell/markup - "column-heading-right" - (vector-ref cell 0)))) - calculated-cells) - - (reverse heading-list))) - -(define (add-split-row table split column-vector cell-calculators options - row-style account-types-to-reverse transaction-row?) - (define (opt-val section name) - (gnc:option-value - (gnc:lookup-option options section name))) - - (let* ((row-contents '()) - (dummy (gnc:debug "split is originally" split)) - (parent (xaccSplitGetParent split)) - (account (xaccSplitGetAccount split)) - (account-type (xaccAccountGetType account)) - (currency (xaccTransGetCurrency parent)) - ;the following cannot be used, because we're using each split's tax currency - ;(if (not (null? account)) - ; (xaccAccountGetCommodity account) - ; (gnc-default-currency))) - (report-currency (if (opt-val gnc:pagename-general optname-common-currency) - (opt-val gnc:pagename-general optname-currency) - currency)) - (sign-reverses? (opt-val gnc:pagename-display (N_ "Sign Reverses"))) - (trans-date (xaccTransGetDate parent)) - (converted (lambda (num) - (gnc:exchange-by-pricedb-nearest - (gnc:make-gnc-monetary currency num) - report-currency - (timespecCanonicalDayTime trans-date))))) - - (define cells - (map (lambda (cell) - (let* ((calculator (vector-ref cell 1)) - (reverse-column? (vector-ref cell 2)) - (calculated (calculator split))) - (cond - ((and sign-reverses? reverse-column? calculated) (converted (gnc-numeric-neg calculated))) - (calculated (converted calculated)) - (else #f)))) - cell-calculators)) - - (if (used-date column-vector) - (addto! row-contents - (if transaction-row? - (gnc:make-html-table-cell/markup "date-cell" - (qof-print-date (xaccTransGetDate parent))) - " "))) - (if (used-reconciled-date column-vector) - (addto! row-contents - (gnc:make-html-table-cell/markup "date-cell" - (let ((date (xaccSplitGetDateReconciled split))) - (if (zero? date) - " " - (qof-print-date date)))))) - (if (used-num column-vector) - (addto! row-contents - (if transaction-row? - (if (qof-book-use-split-action-for-num-field - (gnc-get-current-book)) - (let* ((num (gnc-get-num-action parent split)) - (t-num (if (if (gnc:lookup-option options - gnc:pagename-display - (N_ "Trans Number")) - (opt-val gnc:pagename-display - (N_ "Trans Number")) - #f) - (gnc-get-num-action parent #f) - "")) - (num-string (if (equal? t-num "") - num - (string-append num "/" t-num)))) - (gnc:make-html-table-cell/markup "text-cell" - num-string)) - (gnc:make-html-table-cell/markup "text-cell" - (gnc-get-num-action parent split))) - " "))) - - (if (used-description column-vector) - (addto! row-contents - (if transaction-row? - (gnc:make-html-table-cell/markup "text-cell" - (xaccTransGetDescription parent)) - " "))) - - (if (used-memo column-vector) - (let ((memo (xaccSplitGetMemo split))) - (if (and (equal? memo "") (used-notes column-vector)) - (addto! row-contents (xaccTransGetNotes parent)) - (addto! row-contents memo)))) - - (if (or (used-account-name column-vector) (used-account-code column-vector)) - (addto! row-contents (account-namestring account - (used-account-code column-vector) - (used-account-name column-vector) - (used-account-full-name column-vector)))) - - (if (or (used-other-account-name column-vector) (used-other-account-code column-vector)) - (addto! row-contents (account-namestring (xaccSplitGetAccount - (xaccSplitGetOtherSplit split)) - (used-other-account-code column-vector) - (used-other-account-name column-vector) - (used-other-account-full-name column-vector)))) - - ;(if (used-shares column-vector) - ; (addto! row-contents (xaccSplitGetAmount split))) - ;(if (used-price column-vector) - ; (addto! - ; row-contents - ; (gnc:make-gnc-monetary (xaccTransGetCurrency parent) - ; (xaccSplitGetSharePrice split)))) - ;(if (used-amount-single column-vector) - ; (addto! row-contents - ; (gnc:make-html-table-cell/markup "number-cell" - ; (gnc:html-transaction-anchor parent split-value)))) - ;(if (used-amount-double-positive column-vector) - ; (if (gnc-numeric-positive-p (gnc:gnc-monetary-amount split-value)) - ; (addto! row-contents - ; (gnc:make-html-table-cell/markup "number-cell" - ; (gnc:html-transaction-anchor parent split-value))) - ; (addto! row-contents " "))) - ;(if (used-amount-double-negative column-vector) - ; (if (gnc-numeric-negative-p (gnc:gnc-monetary-amount split-value)) - ; (addto! row-contents - ; (gnc:make-html-table-cell/markup - ; "number-cell" (gnc:html-transaction-anchor parent (gnc:monetary-neg split-value)))) - ; (addto! row-contents " "))) - - (for-each (lambda (cell) - (if cell - (addto! row-contents - (gnc:make-html-table-cell/markup - "number-cell" - (gnc:html-transaction-anchor - parent - cell))) - (addto! row-contents (gnc:html-make-empty-cell)))) - cells) - - (gnc:html-table-append-row/markup! table row-style - (reverse row-contents)) - cells)) - -(define date-sorting-types (list 'date 'register-order)) - -(define (trep-options-generator) - (define gnc:*transaction-report-options* (gnc:new-options)) - (define (gnc:register-trep-option new-option) - (gnc:register-option gnc:*transaction-report-options* new-option)) - - ;; General options - - (gnc:options-add-date-interval! - gnc:*transaction-report-options* - gnc:pagename-general (N_ "Start Date") (N_ "End Date") "a") - - ;(gnc:register-trep-option - ; (gnc:make-multichoice-option - ; gnc:pagename-general (N_ "Style") - ; "d" (N_ "Report style.") - ; 'single - ; (list (vector 'multi-line - ; (N_ "Multi-Line") - ; (N_ "Display N lines.")) - ; (vector 'single - ; (N_ "Single") - ; (N_ "Display 1 line."))))) - - (gnc:register-trep-option - (gnc:make-complex-boolean-option - gnc:pagename-general optname-common-currency - "e" (N_ "Convert all transactions into a common currency.") #f - #f - (lambda (x) (gnc-option-db-set-option-selectable-by-name - gnc:*transaction-report-options* - gnc:pagename-general - optname-currency - x)))) - - (gnc:options-add-currency! - gnc:*transaction-report-options* gnc:pagename-general optname-currency "f") - - (gnc:register-trep-option - (gnc:make-simple-boolean-option - gnc:pagename-general optname-table-export - "g" (N_ "Formats the table suitable for cut & paste exporting with extra cells.") #f)) - - (gnc:register-trep-option - (gnc:make-string-option - gnc:pagename-general optname-transaction-matcher - "i1" (N_ "Match only transactions whose substring is matched e.g. '#gift' \ -will find all transactions with #gift in memo, description or notes. It can be left \ -blank, which will disable the matcher.") - "")) - - (gnc:register-trep-option - (gnc:make-simple-boolean-option - gnc:pagename-general optname-transaction-matcher-regex - "i2" - (N_ "By default the transaction matcher will search substring only. Set this to true to \ -enable full POSIX regular expressions capabilities. '#work|#family' will match both \ -tags within description, notes or memo. ") - #f)) - - ;; Accounts options - - ;; account to do report on - - (gnc:register-trep-option + ;; Delete Accounts selector and recreate with limited account types + (gnc:unregister-option options gnc:pagename-accounts (N_ "Accounts")) + (gnc:register-option + options (gnc:make-account-list-limited-option - gnc:pagename-accounts (N_ "Accounts") - "b1" (N_ "Report on these accounts.") - ;; select, by default, no accounts! Selecting all accounts will - ;; always imply an insanely long waiting time upon opening, and it - ;; is almost never useful. So we instead display the normal error - ;; message saying "Click here", and the user knows how to - ;; continue. - (lambda () - '()) - #f #t + gnc:pagename-accounts (N_ "Accounts") "b1" (N_ "Report on these accounts.") + (lambda () '()) #f #t (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE))) - (gnc:register-trep-option - (gnc:make-string-option - gnc:pagename-accounts optname-account-matcher - "b15" (N_ "Match only above accounts whose fullname is matched e.g. ':Travel' will match \ -Expenses:Travel:Holiday and Expenses:Business:Travel. It can be left blank, which will disable \ -the matcher.") - "")) - - (gnc:register-trep-option - (gnc:make-simple-boolean-option - gnc:pagename-accounts optname-account-matcher-regex - "b16" - (N_ "By default the account matcher will search substring only. Set this to true to enable full \ -POSIX regular expressions capabilities. 'Car|Flights' will match both Expenses:Car and Expenses:Flights. \ -Use a period (.) to match a single character e.g. '20../.' will match 'Travel 2017/1 London'. ") - #f)) - - (gnc:register-trep-option + (gnc:register-option + options (gnc:make-account-list-limited-option gnc:pagename-accounts (N_ "Tax Accounts") "b17" (N_ "Please find and select the accounts which will hold the tax 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.") - (lambda () - '()) - #f #t + (lambda () '()) #f #t (list ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY))) - (gnc:register-trep-option - (gnc:make-account-list-option - gnc:pagename-accounts (N_ "Filter By...") - "b2" (N_ "Filter on these accounts.") - (lambda () - ;; FIXME : gnc:get-current-accounts disappeared. - (let* ((current-accounts '()) - (root (gnc-get-current-root-account)) - (num-accounts (gnc-account-n-children root)) - (first-account (gnc-account-nth-child root 0))) - (cond ((not (null? current-accounts)) - (list (car current-accounts))) - ((> num-accounts 0) (list first-account)) - (else '())))) - #f #t)) - - (gnc:register-trep-option - (gnc:make-multichoice-option - gnc:pagename-accounts (N_ "Filter Type") - "c" (N_ "Filter account.") - 'none - (list (vector 'none - (N_ "None") - (N_ "Do not do any filtering.")) - (vector 'include - (N_ "Include Transactions to/from Filter Accounts") - (N_ "Include transactions to/from filter accounts only.")) - (vector 'exclude - (N_ "Exclude Transactions to/from Filter Accounts") - (N_ "Exclude transactions to/from all filter accounts.")) - ))) - - ;; - - (gnc:register-trep-option - (gnc:make-multichoice-option - gnc:pagename-accounts optname-void-transactions - "d" (N_ "How to handle void transactions.") - 'non-void-only - (list (vector - 'non-void-only - (N_ "Non-void only") - (N_ "Show only non-voided transactions.")) - (vector - 'void-only - (N_ "Void only") - (N_ "Show only voided transactions.")) - (vector - 'both - (N_ "Both") - (N_ "Show both (and include void transactions in totals)."))))) - - ;; Sorting options - - (let ((options gnc:*transaction-report-options*) - - (key-choice-list - (if (qof-book-use-split-action-for-num-field (gnc-get-current-book)) - (list (vector 'none - (N_ "None") - (N_ "Do not sort.")) - - (vector 'account-name - (N_ "Account Name") - (N_ "Sort & subtotal by account name.")) - - (vector 'account-code - (N_ "Account Code") - (N_ "Sort & subtotal by account code.")) - - (vector 'date - (N_ "Date") - (N_ "Sort by date.")) - - (vector 'reconciled-date - (N_ "Reconciled Date") - (N_ "Sort by the Reconciled Date.")) - - (vector 'register-order - (N_ "Register Order") - (N_ "Sort as in the register.")) - - (vector 'corresponding-acc-name - (N_ "Other Account Name") - (N_ "Sort by account transferred from/to's name.")) - - (vector 'corresponding-acc-code - (N_ "Other Account Code") - (N_ "Sort by account transferred from/to's code.")) - - (vector 'amount - (N_ "Amount") - (N_ "Sort by amount.")) - - (vector 'description - (N_ "Description") - (N_ "Sort by description.")) - - (vector 'number - (N_ "Number/Action") - (N_ "Sort by check number/action.")) - - (vector 't-number - (N_ "Transaction Number") - (N_ "Sort by transaction number.")) - - (vector 'memo - (N_ "Memo") - (N_ "Sort by memo."))) - (list (vector 'none - (N_ "None") - (N_ "Do not sort.")) - - (vector 'account-name - (N_ "Account Name") - (N_ "Sort & subtotal by account name.")) - - (vector 'account-code - (N_ "Account Code") - (N_ "Sort & subtotal by account code.")) - - (vector 'date - (N_ "Date") - (N_ "Sort by date.")) - - (vector 'reconciled-date - (N_ "Reconciled Date") - (N_ "Sort by the Reconciled Date.")) - - (vector 'register-order - (N_ "Register Order") - (N_ "Sort as in the register.")) - - (vector 'corresponding-acc-name - (N_ "Other Account Name") - (N_ "Sort by account transferred from/to's name.")) - - (vector 'corresponding-acc-code - (N_ "Other Account Code") - (N_ "Sort by account transferred from/to's code.")) - - (vector 'amount - (N_ "Amount") - (N_ "Sort by amount.")) - - (vector 'description - (N_ "Description") - (N_ "Sort by description.")) - - (vector 'number - (N_ "Number") - (N_ "Sort by check/transaction number.")) - - (vector 'memo - (N_ "Memo") - (N_ "Sort by memo."))))) - - (ascending-choice-list - (list - (vector 'ascend - (N_ "Ascending") - (N_ "Smallest to largest, earliest to latest.")) - (vector 'descend - (N_ "Descending") - (N_ "Largest to smallest, latest to earliest.")))) - - (subtotal-choice-list - (list - (vector 'none (N_ "None") (N_ "None.")) - (vector 'weekly (N_ "Weekly") (N_ "Weekly.")) - (vector 'monthly (N_ "Monthly") (N_ "Monthly.")) - (vector 'quarterly (N_ "Quarterly") (N_ "Quarterly.")) - (vector 'yearly (N_ "Yearly") (N_ "Yearly.")))) - - (prime-sortkey 'account-name) - (prime-sortkey-subtotal-true #t) - (sec-sortkey 'register-order) - (sec-sortkey-subtotal-true #f)) - - (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-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-date-sortingtype-enabled (member sec-sortkey date-sorting-types))) - - (gnc-option-db-set-option-selectable-by-name - options pagename-sorting optname-prime-subtotal - prime-sortkey-subtotal-enabled) - - (gnc-option-db-set-option-selectable-by-name - options pagename-sorting optname-prime-sortorder - prime-sortkey-enabled) - - (gnc-option-db-set-option-selectable-by-name - options pagename-sorting optname-sec-subtotal - sec-sortkey-subtotal-enabled) - - (gnc-option-db-set-option-selectable-by-name - options pagename-sorting optname-sec-sortorder - sec-sortkey-enabled) - - (gnc-option-db-set-option-selectable-by-name - options pagename-sorting optname-full-account-name - (or (and prime-sortkey-subtotal-enabled prime-sortkey-subtotal-true) - (and sec-sortkey-subtotal-enabled sec-sortkey-subtotal-true))) - - (gnc-option-db-set-option-selectable-by-name - options pagename-sorting optname-show-account-code - (or (and prime-sortkey-subtotal-enabled prime-sortkey-subtotal-true) - (and sec-sortkey-subtotal-enabled sec-sortkey-subtotal-true))) - - (gnc-option-db-set-option-selectable-by-name - options pagename-sorting optname-prime-date-subtotal - prime-date-sortingtype-enabled) - - (gnc-option-db-set-option-selectable-by-name - options pagename-sorting optname-sec-date-subtotal - sec-date-sortingtype-enabled))) - - ;; primary sorting criterion - (gnc:register-trep-option - (gnc:make-multichoice-callback-option - pagename-sorting optname-prime-sortkey - "a" (N_ "Sort by this criterion first.") - prime-sortkey - key-choice-list #f - (lambda (x) - (set! prime-sortkey x) - (apply-selectable-by-name-sorting-options)))) - - (gnc:register-trep-option - (gnc:make-simple-boolean-option - pagename-sorting optname-full-account-name - "j1" - (N_ "Show the full account name for subtotals and subtitles?") - #f)) - - (gnc:register-trep-option - (gnc:make-simple-boolean-option - pagename-sorting optname-show-account-code - "j2" - (N_ "Show the account code for subtotals and subtitles?") - #f)) - - (gnc:register-trep-option - (gnc:make-complex-boolean-option - pagename-sorting optname-prime-subtotal - "e5" - (N_ "Subtotal according to the primary key?") - prime-sortkey-subtotal-true #f - (lambda (x) - (set! prime-sortkey-subtotal-true x) - (apply-selectable-by-name-sorting-options)))) - - (gnc:register-trep-option - (gnc:make-multichoice-option - pagename-sorting optname-prime-date-subtotal - "e2" (N_ "Do a date subtotal.") - 'monthly - subtotal-choice-list)) - - (gnc:register-trep-option - (gnc:make-multichoice-option - pagename-sorting optname-prime-sortorder - "e" (N_ "Order of primary sorting.") - 'ascend - ascending-choice-list)) - - ;; Secondary sorting criterion - (gnc:register-trep-option - (gnc:make-multichoice-callback-option - pagename-sorting optname-sec-sortkey - "f" - (N_ "Sort by this criterion second.") - sec-sortkey - key-choice-list #f - (lambda (x) - (set! sec-sortkey x) - (apply-selectable-by-name-sorting-options)))) - - (gnc:register-trep-option - (gnc:make-complex-boolean-option - pagename-sorting optname-sec-subtotal - "i5" - (N_ "Subtotal according to the secondary key?") - sec-sortkey-subtotal-true #f - (lambda (x) - (set! sec-sortkey-subtotal-true x) - (apply-selectable-by-name-sorting-options)))) - - (gnc:register-trep-option - (gnc:make-multichoice-option - pagename-sorting optname-sec-date-subtotal - "i2" (N_ "Do a date subtotal.") - 'none - subtotal-choice-list)) - - (gnc:register-trep-option - (gnc:make-multichoice-option - pagename-sorting optname-sec-sortorder - "i" (N_ "Order of Secondary sorting.") - 'ascend - ascending-choice-list))) - - ;; Display options - (for-each (lambda (l) - (gnc:register-trep-option + (gnc:register-option + options (gnc:make-simple-boolean-option gnc:pagename-display (car l) (cadr l) (caddr l) (cadddr l)))) - ;; One list per option here with: option-name, sort-tag, - ;; help-string, default-value (list - (list (N_ "Date") "a" (N_ "Display the date?") #t) - (list (N_ "Reconciled Date") "a2" (N_ "Display the reconciled date?") #f) - (if (qof-book-use-split-action-for-num-field (gnc-get-current-book)) - (list (N_ "Num/Action") "b" (N_ "Display the check number?") #t) - (list (N_ "Num") "b" (N_ "Display the check number?") #t)) - (list (N_ "Description") "c" (N_ "Display the description?") #t) - (list (N_ "Notes") "d2" (N_ "Display the notes if the memo is unavailable?") #t) - ;; account name option appears here - (list (N_ "Use Full Account Name") "f" (N_ "Display the full account name?") #t) - (list (N_ "Account Code") "g" (N_ "Display the account code?") #f) - ;; other account name option appears here - (list (N_ "Use Full Other Account Name") "i" (N_ "Display the full account name?") #f) - (list (N_ "Other Account Code") "j" (N_ "Display the other account code?") #f) - ;(list (N_ "Shares") "k" (N_ "Display the number of shares?") #f) - ;(list (N_ "Price") "l" (N_ "Display the shares price?") #f) - ;; note the "Amount" multichoice option in between here - (list (N_ "Totals") "o" (N_ "Display the totals?") #t) (list (N_ "Individual income columns") "p" (N_ "Display individual income columns rather than their sum") #f) (list (N_ "Individual expense columns") "q" (N_ "Display individual expense columns rather than their sum") #f) (list (N_ "Individual tax columns") "r" (N_ "Display individual tax columns rather than their sum") #f) (list (N_ "Remittance amount") "s" (N_ "Display the remittance amount (total sales - total purchases)") #f) (list (N_ "Net Income") "t" (N_ "Display the net income (sales without tax - purchases without tax)") #f) - (list (N_ "Tax payable") "u" (N_ "Display the tax payable (tax on sales - tax on purchases)") #f) - (list (N_ "Sign Reverses") "z" (N_ "Reverse amount display for income-related columns.") #t) - )) + (list (N_ "Tax payable") "u" (N_ "Display the tax payable (tax on sales - tax on purchases)") #f))) - (if (qof-book-use-split-action-for-num-field (gnc-get-current-book)) - (gnc:register-trep-option - (gnc:make-simple-boolean-option - gnc:pagename-display (N_ "Trans Number") - "b2" (N_ "Display the trans number?") #f))) + ;; Enable secret option to delete transactions with >1 split + (gnc:option-set-value (gnc:lookup-option options "__trep" "unique-transactions") #t) + ;; Disable account filtering + (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") + ;; 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") + (gnc:option-make-internal! options gnc:pagename-display "Amount") + (gnc:option-make-internal! options gnc:pagename-display "Sign Reverses") + (gnc:option-make-internal! options gnc:pagename-display "Running Balance") + ;; No multilines allowed + (gnc:option-make-internal! options gnc:pagename-display "Detail Level") + (gnc:option-make-internal! options pagename-sorting "Show Informal Debit/Credit Headers") + options) - ;; Add an option to display the memo, and disable the notes option - ;; when memos are not included. - (gnc:register-trep-option - (gnc:make-complex-boolean-option - gnc:pagename-display (N_ "Memo") - "d" (N_ "Display the memo?") #t - #f - (lambda (x) (gnc-option-db-set-option-selectable-by-name - gnc:*transaction-report-options* - gnc:pagename-display - (N_ "Notes") - x)))) - - ;; Ditto for Account Name #t -> Use Full Account Name is selectable - (gnc:register-trep-option - (gnc:make-complex-boolean-option - gnc:pagename-display (N_ "Account Name") - "e" (N_ "Display the account name?") #t - #f - (lambda (x) (gnc-option-db-set-option-selectable-by-name - gnc:*transaction-report-options* - gnc:pagename-display - (N_ "Use Full Account Name") - x)))) - - ;; Ditto for Other Account Name #t -> Use Full Other Account Name is selectable - (gnc:register-trep-option - (gnc:make-complex-boolean-option - gnc:pagename-display (N_ "Other Account Name") - "h5" (N_ "Display the other account name? (if this is a split transaction, this parameter is guessed).") #f - #f - (lambda (x) (gnc-option-db-set-option-selectable-by-name - gnc:*transaction-report-options* - gnc:pagename-display - (N_ "Use Full Other Account Name") - x)))) - - ;(gnc:register-trep-option - ; (gnc:make-multichoice-option - ; gnc:pagename-display (N_ "Amount") - ; "m" (N_ "Display the amount?") - ; 'single - ; (list - ; (vector 'none (N_ "None") (N_ "No amount display.")) - ; (vector 'single (N_ "Single") (N_ "Single Column Display.")) - ; (vector 'double (N_ "Double") (N_ "Two Column Display.")) - ; ))) - - (gnc:options-set-default-section gnc:*transaction-report-options* - gnc:pagename-general) - - gnc:*transaction-report-options*) - - -(define (display-date-interval begin end) - (let ((begin-string (qof-print-date begin)) - (end-string (qof-print-date end))) - (sprintf #f (_ "From %s To %s") begin-string end-string))) - -(define (get-primary-subtotal-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Primary Subtotals/headings")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - -(define (get-secondary-subtotal-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Secondary Subtotals/headings")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - -(define (get-grand-total-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Grand Total")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - -(define (get-odd-row-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Split Odd")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - -(define (get-even-row-style options) - (let ((bgcolor (gnc:lookup-option options - (N_ "Colors") - (N_ "Split Even")))) - (list 'attribute (list "bgcolor" (gnc:color-option->html bgcolor))))) - - -;; ;;;;;;;;;;;;;;;;;;;; -;; Here comes the big function that builds the whole table. -(define (make-split-table splits options - accounts-tax-paid - accounts-tax-collected - accounts-sales - accounts-purchases - primary-subtotal-pred - secondary-subtotal-pred - primary-subheading-renderer - secondary-subheading-renderer - primary-subtotal-renderer - secondary-subtotal-renderer) - - (let ((work-to-do (length splits)) - (work-done 0) - (used-columns (build-column-used options))) - - (define calculated-cells - (letrec - ((myadd (lambda (X Y) (if X (if Y (gnc-numeric-add X Y GNC-DENOM-AUTO GNC-RND-ROUND) X) Y))) - (myneg (lambda (X) (if X (gnc-numeric-neg X) #f))) - (split-adder (lambda (split accountlist) - (let* ((transaction (xaccSplitGetParent split)) - (splits-in-transaction (xaccTransGetSplitList transaction)) - (split-get-value (lambda (s) - (if (xaccTransGetVoidStatus transaction) - (xaccSplitVoidFormerValue s) - (xaccSplitGetValue s)))) - (include-split? (lambda (s) (member (xaccSplitGetAccount s) accountlist))) - (filtered-splits (filter include-split? splits-in-transaction)) - (list-of-values (map split-get-value filtered-splits))) - (fold myadd #f list-of-values)))) - (tax-on-sales (lambda (s) (split-adder s accounts-tax-collected))) - (tax-on-purchases (lambda (s) (split-adder s accounts-tax-paid))) - (sales-without-tax (lambda (s) (split-adder s accounts-sales))) - (purchases-without-tax (lambda (s) (split-adder s accounts-purchases))) - (account-adder (lambda (acc) (lambda (s) (split-adder s (list acc))))) - (total-sales (lambda (s) (myadd (tax-on-sales s) (sales-without-tax s)))) - (total-purchases (lambda (s) (myadd (tax-on-purchases s) (purchases-without-tax s)))) - (bank-remittance (lambda (s) (myneg (myadd (total-sales s) (total-purchases s))))) - (net-income (lambda (s) (myneg (myadd (sales-without-tax s) (purchases-without-tax s))))) - (tax-payable (lambda (s) (myneg (myadd (tax-on-purchases s) (tax-on-sales s)))))) - (append - ; each column will be a vector - ; (vector heading calculator-function reverse-column?) - (list (vector "TOTAL SALES" total-sales #t)) - (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Individual income columns"))) - (map (lambda (acc) (vector (xaccAccountGetName acc) (account-adder acc) #t)) - accounts-sales) - (list (vector "Net Sales" sales-without-tax #t))) - (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Individual tax columns"))) - (map (lambda (acc) (vector (xaccAccountGetName acc) (account-adder acc) #t)) - accounts-tax-collected) - (list (vector "Tax on Sales" tax-on-sales #t))) - (list (vector "TOTAL PURCHASES" total-purchases #f)) - (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Individual expense columns"))) - (map (lambda (acc) (vector (xaccAccountGetName acc) (account-adder acc) #f)) - accounts-purchases) - (list (vector "Net Purchases" purchases-without-tax #f))) - (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Individual tax columns"))) - (map (lambda (acc) (vector (xaccAccountGetName acc) (account-adder acc) #f)) - accounts-tax-paid) - (list (vector "Tax on Purchases" tax-on-purchases #f))) - (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Remittance amount"))) - (list (vector "Remittance" bank-remittance #f)) - '()) - (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Net Income"))) - (list (vector "Net Income" net-income #f)) - '()) - (if (gnc:option-value (gnc:lookup-option options gnc:pagename-display (N_ "Tax payable"))) - (list (vector "Tax Payable" tax-payable #f)) - '())))) - - (define (transaction-report-export-p options) - (gnc:option-value - (gnc:lookup-option options gnc:pagename-general - optname-table-export))) - - (define (add-other-split-rows split table used-columns - row-style account-types-to-reverse) - (define (other-rows-driver split parent table used-columns i) - (let ((current (xaccTransGetSplit parent i))) - (cond ((null? current) #f) - ((equal? current split) - (other-rows-driver split parent table used-columns (+ i 1))) - (else (begin - (add-split-row table current used-columns calculated-cells options - row-style account-types-to-reverse #f) - (other-rows-driver split parent table used-columns - (+ i 1))))))) - - (other-rows-driver split (xaccSplitGetParent split) - table used-columns 0)) - - (define (do-rows-with-subtotals splits - table - used-columns - width - multi-rows? - odd-row? - export? - account-types-to-reverse - primary-subtotal-pred - secondary-subtotal-pred - primary-subheading-renderer - secondary-subheading-renderer - primary-subtotal-renderer - secondary-subtotal-renderer - primary-subtotal-collectors - secondary-subtotal-collectors - total-collectors) - - (gnc:report-percent-done (* 100 (/ work-done work-to-do))) - (set! work-done (+ 1 work-done)) - (if (null? splits) - (begin - (gnc:html-table-append-row/markup! - table - def:grand-total-style - (list - (gnc:make-html-table-cell/size - 1 width (gnc:make-html-text (gnc:html-markup-hr))))) - (if (gnc:option-value (gnc:lookup-option options "Display" "Totals")) - (render-grand-total table width total-collectors export?))) - - (let* ((current (car splits)) - (current-row-style (if multi-rows? def:normal-row-style - (if odd-row? def:normal-row-style - def:alternate-row-style))) - (rest (cdr splits)) - (next (if (null? rest) #f - (car rest))) - (split-values (add-split-row - table - current - used-columns - calculated-cells - options - current-row-style - account-types-to-reverse - #t))) - (if multi-rows? - (add-other-split-rows - current table used-columns def:alternate-row-style - account-types-to-reverse)) - - (map (lambda (collector value) - (if value - (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value)))) - primary-subtotal-collectors - split-values) - - (map (lambda (collector value) - (if value - (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value)))) - secondary-subtotal-collectors - split-values) - - (map (lambda (collector value) - (if value - (collector 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value)))) - total-collectors - split-values) - - (if (and primary-subtotal-pred - (or (not next) - (and next - (not (primary-subtotal-pred current next))))) - (begin - (if secondary-subtotal-pred - (begin - (secondary-subtotal-renderer - table width current - secondary-subtotal-collectors - def:secondary-subtotal-style used-columns export?) - (for-each (lambda (coll) (coll 'reset #f #f)) - secondary-subtotal-collectors))) - - (primary-subtotal-renderer table width current - primary-subtotal-collectors - def:primary-subtotal-style used-columns - export?) - - (for-each (lambda (coll) (coll 'reset #f #f)) - primary-subtotal-collectors) - - (if next - (begin - (primary-subheading-renderer - next table width def:primary-subtotal-style used-columns) - (if secondary-subtotal-pred - (secondary-subheading-renderer - next - table - width def:secondary-subtotal-style used-columns))))) - - (if (and secondary-subtotal-pred - (or (not next) - (and next - (not (secondary-subtotal-pred - current next))))) - (begin (secondary-subtotal-renderer - table width current - secondary-subtotal-collectors - def:secondary-subtotal-style used-columns export?) - (for-each (lambda (coll) (coll 'reset #f #f)) - secondary-subtotal-collectors) - (if next - (secondary-subheading-renderer - next table width - def:secondary-subtotal-style used-columns))))) - - (do-rows-with-subtotals rest - table - used-columns - width - multi-rows? - (not odd-row?) - export? - account-types-to-reverse - primary-subtotal-pred - secondary-subtotal-pred - primary-subheading-renderer - secondary-subheading-renderer - primary-subtotal-renderer - secondary-subtotal-renderer - primary-subtotal-collectors - secondary-subtotal-collectors - total-collectors)))) - - (let* ((table (gnc:make-html-table)) - (width (num-columns-required used-columns)) - (multi-rows? #f) ;disable. (transaction-report-multi-rows-p options)) - (export? (transaction-report-export-p options)) - (account-types-to-reverse '())) - - (gnc:html-table-set-col-headers! - table - (make-heading-list used-columns calculated-cells options)) - - (if (not (null? splits)) - (begin - (if primary-subheading-renderer - (primary-subheading-renderer - (car splits) table width def:primary-subtotal-style used-columns)) - (if secondary-subheading-renderer - (secondary-subheading-renderer - (car splits) table width def:secondary-subtotal-style used-columns)) - - (do-rows-with-subtotals splits table used-columns width - multi-rows? #t - export? - account-types-to-reverse - primary-subtotal-pred - secondary-subtotal-pred - primary-subheading-renderer - secondary-subheading-renderer - primary-subtotal-renderer - secondary-subtotal-renderer - (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells) - (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells) - (map (lambda (x) (gnc:make-commodity-collector)) calculated-cells)))) - table))) - -;; ;;;;;;;;;;;;;;;;;;;; -;; Here comes the renderer function for this report. -(define (trep-renderer report-obj) - (define options (gnc:report-options report-obj)) +(define (gst-calculated-cells options) (define (opt-val section name) - (gnc:option-value - (gnc:lookup-option options section name))) - (define comp-funcs-assoc-list - ;; Defines the different sorting keys, together with the - ;; subtotal functions. Each entry: (cons - ;; 'sorting-key-option-value (vector 'query-sorting-key - ;; subtotal-function subtotal-renderer)) - ;; (let* ((used-columns (build-column-used options))) ;; tpo: gives unbound variable options? - (let* ((used-columns (build-column-used (gnc:report-options report-obj)))) - (list (cons 'account-name (vector - (list SPLIT-ACCT-FULLNAME) - split-account-full-name-same-p - render-account-subheading - render-account-subtotal)) - (cons 'account-code (vector - (list SPLIT-ACCOUNT ACCOUNT-CODE-) - split-account-code-same-p - render-account-subheading - render-account-subtotal)) - (cons 'date (vector - (list SPLIT-TRANS TRANS-DATE-POSTED) - #f #f #f)) - (cons 'reconciled-date (vector - (list SPLIT-DATE-RECONCILED) - #f #f #f)) - (cons 'register-order (vector - (list QUERY-DEFAULT-SORT) - #f #f #f)) - (cons 'corresponding-acc-name - (vector - (list SPLIT-CORR-ACCT-NAME) - split-same-corr-account-full-name-p - render-corresponding-account-subheading - render-corresponding-account-subtotal)) - (cons 'corresponding-acc-code - (vector - (list SPLIT-CORR-ACCT-CODE) - split-same-corr-account-code-p - render-corresponding-account-subheading - render-corresponding-account-subtotal)) - (cons 'amount (vector (list SPLIT-VALUE) #f #f #f)) - (cons 'description (vector (list SPLIT-TRANS TRANS-DESCRIPTION) #f #f #f)) - (if (qof-book-use-split-action-for-num-field (gnc-get-current-book)) - (cons 'number (vector (list SPLIT-ACTION) #f #f #f)) - (cons 'number (vector (list SPLIT-TRANS TRANS-NUM) #f #f #f))) - (cons 't-number (vector (list SPLIT-TRANS TRANS-NUM) #f #f #f)) - (cons 'memo (vector (list SPLIT-MEMO) #f #f #f)) - (cons 'none (vector '() #f #f #f))))) - - (define date-comp-funcs-assoc-list - ;; Extra list for date option. Each entry: (cons - ;; 'date-subtotal-option-value (vector subtotal-function - ;; subtotal-renderer)) - (list - (cons 'none (vector #f #f #f)) - (cons 'weekly (vector split-same-week-p render-week-subheading - render-week-subtotal)) - (cons 'monthly (vector split-same-month-p render-month-subheading - render-month-subtotal)) - (cons 'quarterly (vector split-same-quarter-p render-quarter-subheading - render-quarter-subtotal)) - (cons 'yearly (vector split-same-year-p render-year-subheading - render-year-subtotal)))) - - (define (get-subtotalstuff-helper - name-sortkey name-subtotal name-date-subtotal - comp-index date-index) - ;; The value of the sorting-key multichoice option. - (let ((sortkey (opt-val pagename-sorting name-sortkey))) - (if (member sortkey date-sorting-types) - ;; If sorting by date, look up the value of the - ;; date-subtotalling multichoice option and return the - ;; corresponding funcs in the assoc-list. - (vector-ref - (cdr (assq (opt-val pagename-sorting name-date-subtotal) - date-comp-funcs-assoc-list)) - date-index) - ;; For everything else: 1. check whether sortkey has - ;; subtotalling enabled at all, 2. check whether the - ;; enable-subtotal boolean option is #t, 3. look up the - ;; appropriate funcs in the assoc-list. - (and (member sortkey subtotal-enabled) - (and (opt-val pagename-sorting name-subtotal) - (vector-ref - (cdr (assq sortkey comp-funcs-assoc-list)) - comp-index)))))) - - (define (get-query-sortkey sort-option-value) - (vector-ref - (cdr (assq sort-option-value comp-funcs-assoc-list)) - 0)) - - (define (get-subtotal-pred - name-sortkey name-subtotal name-date-subtotal) - (get-subtotalstuff-helper - name-sortkey name-subtotal name-date-subtotal - 1 0)) - - (define (get-subheading-renderer - name-sortkey name-subtotal name-date-subtotal) - (get-subtotalstuff-helper - name-sortkey name-subtotal name-date-subtotal - 2 1)) - - (define (get-subtotal-renderer - name-sortkey name-subtotal name-date-subtotal) - (get-subtotalstuff-helper - name-sortkey name-subtotal name-date-subtotal - 3 2)) - - ;;(define (get-other-account-names account-list) - ;; ( map (lambda (acct) (gnc-account-get-full-name acct)) account-list)) - - (define (splits-filter-unique-transactions splits) - (define (same-txn? s1 s2) - (define txn1 (xaccSplitGetParent s1)) - (define txn2 (xaccSplitGetParent s2)) - (xaccTransEqual txn1 txn2 #t #t #t #f)) - (delete-duplicates! splits same-txn?)) - - (define (is-filter-member split account-list) - (let* ((txn (xaccSplitGetParent split)) - (splitcount (xaccTransCountSplits txn)) - (other-account (xaccSplitGetAccount (xaccSplitGetOtherSplit split))) - (splits-equal? (lambda (s1 s2) (xaccSplitEqual s1 s2 #t #f #f))) - (other-splits (delete split (xaccTransGetSplitList txn) splits-equal?)) - (other-accounts (map xaccSplitGetAccount other-splits)) - (is-in-account-list? (lambda (acc) (member acc account-list)))) - (cond - ;; A 2-split transaction - test separately so it can be optimized - ;; to significantly reduce the number of splits to traverse - ;; in guile code - ((= splitcount 2) - (is-in-account-list? other-account)) - - ;; A multi-split transaction - run over all splits - ((> splitcount 2) - (or-map is-in-account-list? other-accounts)) - - ;; Single transaction splits - (else #f)))) - - (gnc:report-starting reportname) - - (let* ((document (gnc:make-html-document)) - (c_account_0 (opt-val gnc:pagename-accounts "Accounts")) - (account-matcher (opt-val gnc:pagename-accounts optname-account-matcher)) - (account-matcher-regexp (if (opt-val gnc:pagename-accounts optname-account-matcher-regex) - (make-regexp account-matcher) - #f)) - (c_account_1 (filter - (lambda (acc) - (if 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)) - (c_account_2 (opt-val gnc:pagename-accounts "Filter By...")) - (tax-accounts (opt-val gnc:pagename-accounts "Tax Accounts")) - (accounts-tax-collected (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-LIABILITY)) tax-accounts)) - (accounts-tax-paid (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-ASSET)) tax-accounts)) - (accounts-sales (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-INCOME)) c_account_1)) - (accounts-purchases (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-EXPENSE)) c_account_1)) - (filter-mode (opt-val gnc:pagename-accounts "Filter Type")) - (begindate (gnc:time64-start-day-time - (gnc:date-option-absolute-time - (opt-val gnc:pagename-general "Start Date")))) - (enddate (gnc:time64-end-day-time - (gnc:date-option-absolute-time - (opt-val gnc:pagename-general "End Date")))) - (transaction-matcher (opt-val gnc:pagename-general optname-transaction-matcher)) - (transaction-matcher-regexp (if (opt-val gnc:pagename-general optname-transaction-matcher-regex) - (make-regexp transaction-matcher) - #f)) - (report-title (opt-val - gnc:pagename-general - gnc:optname-reportname)) - (primary-key (opt-val pagename-sorting optname-prime-sortkey)) - (primary-order (opt-val pagename-sorting "Primary Sort Order")) - (secondary-key (opt-val pagename-sorting optname-sec-sortkey)) - (secondary-order (opt-val pagename-sorting "Secondary Sort Order")) - (void-status (opt-val gnc:pagename-accounts optname-void-transactions)) - (splits '()) - (query (qof-query-create-for-splits))) - - ;(gnc:warn "c1 is " c_account_1) - ;(gnc:warn "c2 is " c_account_2) - ;(gnc:warn "first c1 is " (xaccAccountGetName (car c_account_1))) - - (if (not (or (null? c_account_1) (and-map not c_account_1))) - (begin - (qof-query-set-book query (gnc-get-current-book)) - ;;(gnc:warn "query is:" query) - (xaccQueryAddAccountMatch query - c_account_1 - QOF-GUID-MATCH-ANY QOF-QUERY-AND) - (xaccQueryAddDateMatchTT - query #t begindate #t enddate QOF-QUERY-AND) - (qof-query-set-sort-order query - (get-query-sortkey primary-key) - (get-query-sortkey secondary-key) - '()) - - (qof-query-set-sort-increasing query - (eq? primary-order 'ascend) - (eq? secondary-order 'ascend) - #t) - - (case void-status - ((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)) - - (set! splits (qof-query-run query)) - - ;;(gnc:warn "Splits in trep-renderer:" splits) - - ; Combined Filter: - ; - include/exclude splits to/from selected accounts - ; - include only Invoices & Regular Transactions (i.e. remove Link & Payments) - ; - disallow Closing Transactions, and - ; - substring/regex matcher for Description/Notes/Memo - (set! splits (filter - (lambda (split) - (let* ((trans (xaccSplitGetParent split)) - (txn-type (xaccTransGetTxnType trans)) - (match? (lambda (str) - (if transaction-matcher-regexp - (regexp-exec transaction-matcher-regexp str) - (string-contains str transaction-matcher))))) - (and (if (eq? filter-mode 'include) (is-filter-member split c_account_2) #t) - (if (eq? filter-mode 'exclude) (not (is-filter-member split c_account_2)) #t) - (member txn-type (list TXN-TYPE-NONE TXN-TYPE-INVOICE)) - (not (xaccTransGetIsClosingTxn trans)) - (or (match? (xaccTransGetDescription trans)) - (match? (xaccTransGetNotes trans)) - (match? (xaccSplitGetMemo split)))))) - splits)) - - ; We have to remove duplicates because the report will *sum* amounts in a transaction - ; otherwise it will double count where transaction contains 2 splits in same account - (set! splits (splits-filter-unique-transactions splits)) - - (if (not (null? splits)) - (let ((table - (make-split-table - splits - options - accounts-tax-paid - accounts-tax-collected - accounts-sales - accounts-purchases - (get-subtotal-pred optname-prime-sortkey - optname-prime-subtotal - optname-prime-date-subtotal) - (get-subtotal-pred optname-sec-sortkey - optname-sec-subtotal - optname-sec-date-subtotal) - (get-subheading-renderer optname-prime-sortkey - optname-prime-subtotal - optname-prime-date-subtotal) - (get-subheading-renderer optname-sec-sortkey - optname-sec-subtotal - optname-sec-date-subtotal) - (get-subtotal-renderer optname-prime-sortkey - optname-prime-subtotal - optname-prime-date-subtotal) - (get-subtotal-renderer optname-sec-sortkey - optname-sec-subtotal - optname-sec-date-subtotal)))) - - (gnc:html-document-set-title! document - report-title) - (gnc:html-document-add-object! - document - (gnc:make-html-text - (gnc:html-markup-h3 - (display-date-interval begindate enddate)))) - - (gnc:html-document-add-object! - document - (gnc:make-html-text - (gnc:html-markup-p - "Input Tax accounts: " - (if (null? accounts-tax-paid) - (N_ "None") - (string-join (map gnc-account-get-full-name accounts-tax-paid) ", "))))) - - (gnc:html-document-add-object! - document - (gnc:make-html-text - (gnc:html-markup-p - "Output Tax accounts: " - (if (null? accounts-tax-collected) - (N_ "None") - (string-join (map gnc-account-get-full-name accounts-tax-collected) ", "))))) - - (if (null? (append accounts-tax-collected accounts-tax-paid)) - (gnc:html-document-add-object! - document - (gnc:make-html-text - (gnc:html-markup-p - "There are no input/output tax accounts set up. This is probably not what" - " you want. " - TAX-SETUP-DESC)))) - - (gnc:html-document-add-object! - document - table) - (qof-query-destroy query)) - ;; error condition: no splits found - (let ((p (gnc:make-html-text))) - (gnc:html-text-append! - p - (gnc:html-markup-h2 - (_ "No matching transactions found")) - (gnc:html-markup-p - (_ "No transactions were found that match the time interval and account selection specified in the Options panel."))) - (gnc:html-document-add-object! document p)))) - - ;; error condition: no accounts specified - - (if (null? c_account_0) - (begin - (gnc:html-document-add-object! - document - (gnc:html-make-no-account-warning - report-title (gnc:report-id report-obj))) - - (gnc:html-document-add-object! - document - (gnc:make-html-text - (gnc:html-markup-p - (_ - "This report is useful to calculate periodic business tax payable/receivable from - 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.")) - (gnc:html-markup-p - (_ - "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.")))) - - (gnc:html-document-add-object! - document - (gnc:make-html-text - (gnc:html-markup-p TAX-SETUP-DESC)))) - - (begin - (gnc:html-document-add-object! - document - (gnc:make-html-text - (gnc:html-markup-h2 - (N_ "No accounts were matched")) - (gnc:html-markup-p - (N_ "The account matcher specified in the report options did not match any accounts."))))))) - - (gnc:report-finished) - document)) + (let ((option (gnc:lookup-option options section name))) + (if option + (gnc:option-value option) + (gnc:error "gnc:lookup-option error: " section "/" name)))) + (letrec* + ((monetary+ (lambda (a b) + (if (and (gnc:gnc-monetary? a) (gnc:gnc-monetary? b)) + (let ((same-currency? (gnc-commodity-equal (gnc:gnc-monetary-commodity a) (gnc:gnc-monetary-commodity b))) + (amount (+ (gnc:gnc-monetary-amount a) (gnc:gnc-monetary-amount b)))) + (if same-currency? + (gnc:make-gnc-monetary (gnc:gnc-monetary-commodity a) amount) + (warn "incompatible currencies in monetary+: " a b))) + (warn "wrong arguments for monetary+: " a b)))) + (myadd (lambda (X Y) (if X (if Y (monetary+ X Y) X) Y))) ; custom adder which understands #f values + (myneg (lambda (X) (and X (gnc:monetary-neg X)))) ; custom monetary negator which understands #f + (accounts (opt-val gnc:pagename-accounts "Accounts")) + (tax-accounts (opt-val gnc:pagename-accounts "Tax Accounts")) + (accounts-tax-collected (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-LIABILITY)) tax-accounts)) + (accounts-tax-paid (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-ASSET)) tax-accounts)) + (accounts-sales (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-INCOME)) accounts)) + (accounts-purchases (filter (lambda (acc) (eq? (xaccAccountGetType acc) ACCT-TYPE-EXPENSE)) accounts)) + (common-currency (and (opt-val gnc:pagename-general (_ "Common Currency")) ; if a common currency was specified, + (opt-val gnc:pagename-general (_ "Report's currency")))) ; use it + (split-date (lambda (s) (xaccTransGetDate (xaccSplitGetParent s)))) + (split-currency (lambda (s) (xaccAccountGetCommodity (xaccSplitGetAccount s)))) + (split-adder (lambda (split accountlist) + (let* ((transaction (xaccSplitGetParent split)) + (splits-in-transaction (xaccTransGetSplitList transaction)) + (split-get-monetary (lambda (s) + (gnc:make-gnc-monetary + (split-currency s) + (if (xaccTransGetVoidStatus transaction) + (xaccSplitVoidFormerAmount s) + (xaccSplitGetAmount s))))) + (split-monetary-converted (lambda (s) + (gnc:exchange-by-pricedb-nearest + (split-get-monetary s) + (or common-currency + (split-currency split)) + (time64CanonicalDayTime + (split-date s))))) + (include-split? (lambda (s) (member (xaccSplitGetAccount s) accountlist))) + (filtered-splits (filter include-split? splits-in-transaction)) + (list-of-values (map split-monetary-converted filtered-splits))) + (fold myadd #f list-of-values)))) + (account-adder (lambda (acc) (lambda (s) (split-adder s (list acc))))) + (account-adder-neg (lambda (acc) (lambda (s) (myneg (split-adder s (list acc)))))) + ;; Calculate sales amounts + (sales-without-tax (lambda (s) (myneg (split-adder s accounts-sales)))) + (tax-on-sales (lambda (s) (myneg (split-adder s accounts-tax-collected)))) + (total-sales (lambda (s) (myadd (tax-on-sales s) (sales-without-tax s)))) + ;; Calculate purchase amounts + (purchases-without-tax (lambda (s) (split-adder s accounts-purchases))) + (tax-on-purchases (lambda (s) (split-adder s accounts-tax-paid))) + (total-purchases (lambda (s) (myadd (tax-on-purchases s) (purchases-without-tax s)))) + ;; Calculate derived amounts + (bank-remittance (lambda (s) (myadd (total-sales s) (myneg (total-purchases s))))) + (net-income (lambda (s) (myadd (sales-without-tax s) (myneg (purchases-without-tax s))))) + (tax-payable (lambda (s) (myadd (tax-on-sales s) (myneg (tax-on-purchases s)))))) + (append + ;; each column will be a vector + ;; (vector heading + ;; calculator-function ;; (calculator-function split) to obtain amount + ;; reverse-column? ;; to optionally reverse signs + ;; subtotal? ;; subtotal? to allow subtotals (ie irrelevant for running balance) + ;; start-dual-column? ;; #t for the left side of a dual column (i.e. debit/credit) + ;; friendly-heading-fn ;; retrieve friendly heading name for account debit/credit + (list (vector "TOTAL SALES" + total-sales + #t #t #f + (lambda (a) ""))) + (if (opt-val gnc:pagename-display (N_ "Individual income columns")) + (map (lambda (acc) (vector (xaccAccountGetName acc) + (account-adder-neg acc) + #t #t #f + (lambda (a) ""))) + accounts-sales) + (list (vector "Net Sales" + sales-without-tax + #t #t #f + (lambda (a) "")))) + (if (opt-val gnc:pagename-display (N_ "Individual tax columns")) + (map (lambda (acc) (vector (xaccAccountGetName acc) + (account-adder acc) + #t #t #f + (lambda (a) ""))) + accounts-tax-collected) + (list (vector "Tax on Sales" + tax-on-sales + #t #t #f + (lambda (a) "")))) + (list (vector "TOTAL PURCHASES" + total-purchases + #f #t #f + (lambda (a) ""))) + (if (opt-val gnc:pagename-display (N_ "Individual expense columns")) + (map (lambda (acc) (vector (xaccAccountGetName acc) + (account-adder acc) + #f #t #f + (lambda (a) ""))) + accounts-purchases) + (list (vector "Net Purchases" + purchases-without-tax + #f #t #f + (lambda (a) "")))) + (if (opt-val gnc:pagename-display (N_ "Individual tax columns")) + (map (lambda (acc) (vector (xaccAccountGetName acc) + (account-adder acc) + #f #t #f + (lambda (a) ""))) + accounts-tax-paid) + (list (vector "Tax on Purchases" + tax-on-purchases + #f #t #f + (lambda (a) "")))) + (if (opt-val gnc:pagename-display (N_ "Remittance amount")) + (list (vector "Remittance" + bank-remittance + #f #t #f + (lambda (a) ""))) + '()) + (if (opt-val gnc:pagename-display (N_ "Net Income")) + (list (vector "Net Income" + net-income + #f #t #f + (lambda (a) ""))) + '()) + (if (opt-val gnc:pagename-display (N_ "Tax payable")) + (list (vector "Tax Payable" + tax-payable + #f #t #f + (lambda (a) ""))) + '())))) ;; Define the report. (gnc:define-report @@ -1820,5 +244,5 @@ for taxes paid on expenses, and type LIABILITY for taxes collected on sales.") 'menu-path (list gnc:menuname-income-expense) 'name reportname 'report-guid "5bf27f249a0d11e7abc4cec278b6b50a" - 'options-generator trep-options-generator - 'renderer trep-renderer) + 'options-generator gst-statement-options-generator + 'renderer income-gst-statement-renderer) diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm index 86ccf8b24b..d3496dfea6 100644 --- a/gnucash/report/standard-reports/transaction.scm +++ b/gnucash/report/standard-reports/transaction.scm @@ -870,7 +870,10 @@ tags within description, notes or memo. ") gnc:pagename-display (N_ "Sign Reverses") "m1" (_ "Reverse amount display for certain account types.") 'global - (keylist->vectorlist sign-reverse-list)))) + (keylist->vectorlist sign-reverse-list))) + + (gnc:register-trep-option + (gnc:make-internal-option "__trep" "unique-transactions" #f))) (gnc:options-set-default-section options gnc:pagename-general) options) @@ -878,9 +881,13 @@ tags within description, notes or memo. ") ;; ;;;;;;;;;;;;;;;;;;;; ;; Here comes the big function that builds the whole table. -(define (make-split-table splits options) +(define (make-split-table splits options custom-calculated-cells) - (define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name))) + (define (opt-val section name) + (let ((option (gnc:lookup-option options section name))) + (if option + (gnc:option-value option) + (error (format #f "cannot find ~a ~a" section name))))) (define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book))) (define (build-columns-used) @@ -1059,7 +1066,7 @@ tags within description, notes or memo. ") ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (define calculated-cells + (define default-calculated-cells (letrec ((damount (lambda (s) (if (gnc:split-voided? s) (xaccSplitVoidFormerAmount s) @@ -1149,6 +1156,14 @@ tags within description, notes or memo. ") (lambda (a) ""))) '())))) + (define calculated-cells + ;; this part will check whether custom-calculated-cells were specified. this + ;; describes a custom function which consumes an options list, and generates + ;; a vectorlist similar to default-calculated-cells as above. + (if custom-calculated-cells + (custom-calculated-cells options) + default-calculated-cells)) + (define headings-left-columns (map (lambda (column) (vector-ref column 0)) @@ -1588,7 +1603,7 @@ tags within description, notes or memo. ") ;; Here comes the renderer function for this report. -(define (trep-renderer report-obj) +(define* (trep-renderer report-obj #:key custom-calculated-cells empty-report-message) (define options (gnc:report-options report-obj)) (define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name))) (define BOOK-SPLIT-ACTION (qof-book-use-split-action-for-num-field (gnc-get-current-book))) @@ -1710,9 +1725,17 @@ tags within description, notes or memo. ") ;; error condition: no accounts specified or obtained after filtering (begin - (gnc:html-document-add-object! - document - (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj))) + ;; error condition: no accounts specified + (begin + + (gnc:html-document-add-object! + document + (gnc:html-make-no-account-warning report-title (gnc:report-id report-obj))) + + (and empty-report-message + (gnc:html-document-add-object! + document + empty-report-message))) (if (member 'no-match infobox-display) (gnc:html-document-add-object! @@ -1738,7 +1761,10 @@ tags within description, notes or memo. ") (eq? primary-order 'ascend) (eq? secondary-order 'ascend) #t))) - (set! splits (qof-query-run query)) + + (if (opt-val "__trep" "unique-transactions") + (set! splits (xaccQueryGetSplitsUniqueTrans query)) + (set! splits (qof-query-run query))) (qof-query-destroy query) @@ -1786,7 +1812,7 @@ tags within description, notes or memo. ") document (gnc:render-options-changed options)))) - (let ((table (make-split-table splits options))) + (let ((table (make-split-table splits options custom-calculated-cells))) (gnc:html-document-set-title! document report-title) @@ -1810,6 +1836,11 @@ tags within description, notes or memo. ") document)) +(define trep-guid "2fe3b9833af044abb929a88d5a59620f") +(export trep-guid) +(export trep-renderer) +(export trep-options-generator) + ;; Define the report. (gnc:define-report 'version 1 @@ -1822,6 +1853,6 @@ tags within description, notes or memo. ") (gnc:define-report 'version 1 'name reportname - 'report-guid "2fe3b9833af044abb929a88d5a59620f" + 'report-guid trep-guid 'options-generator trep-options-generator 'renderer trep-renderer) diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm index 48d9bbd845..09c2cc1774 100644 --- a/libgnucash/app-utils/options.scm +++ b/libgnucash/app-utils/options.scm @@ -1721,7 +1721,13 @@ "Use Full Other Account Name?" (cons #f "Use Full Other Account Name") "Void Transactions?" (cons "Filter" "Void Transactions") "Void Transactions" (cons "Filter" "Void Transactions") - "Account Substring" (cons "Filter" "Account Matcher") + "Account Substring" (cons "Filter" "Account Name Filter") + "Account Matcher" (cons "Filter" "Account Name Filter") + "Transaction Matcher" (cons "Filter" "Transaction Filter") + "Account Matcher uses regular expressions for extended matching" + (cons "Filter" "Use regular expressions for account name filter") + "Transaction Matcher uses regular expressions for extended matching" + (cons "Filter" "Use regular expressions for transaction filter") )) (name-match (member name new-names-list)))