diff --git a/gnucash/report/reports/standard/account-piecharts.scm b/gnucash/report/reports/standard/account-piecharts.scm index a16e30aef3..439c6333e3 100644 --- a/gnucash/report/reports/standard/account-piecharts.scm +++ b/gnucash/report/reports/standard/account-piecharts.scm @@ -1,19 +1,19 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; account-piecharts.scm: shows piechart of accounts -;; -;; By Robert Merkel (rgmerk@mira.net) +;; +;; By Robert Merkel (rgmerk@mira.net) ;; and Christian Stimming ;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; @@ -43,13 +43,13 @@ ;; The menu statusbar tips. (define menutip-income (N_ "Shows a piechart with the Income per given time interval")) -(define menutip-expense +(define menutip-expense (N_ "Shows a piechart with the Expenses per given time interval")) -(define menutip-assets +(define menutip-assets (N_ "Shows a piechart with the Assets balance at a given time")) (define menutip-securities (N_ "Shows a piechart with distribution of assets over securities")) -(define menutip-liabilities +(define menutip-liabilities (N_ "Shows a piechart with the Liabilities \ balance at a given time")) @@ -298,14 +298,14 @@ balance at a given time")) (gnc:report-starting reportname) ;; Get all options - (let ((to-date (gnc:time64-end-day-time + (let ((to-date (gnc:time64-end-day-time (gnc:date-option-absolute-time (get-option gnc:pagename-general optname-to-date)))) (from-date (if do-intervals? - (gnc:time64-start-day-time - (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-from-date))) + (gnc:time64-start-day-time + (gnc:date-option-absolute-time + (get-option gnc:pagename-general + optname-from-date))) '())) (accounts (get-option gnc:pagename-accounts optname-accounts)) (account-levels @@ -313,11 +313,11 @@ balance at a given time")) (get-option gnc:pagename-accounts optname-levels) 'all)) (report-currency (get-option gnc:pagename-general - optname-report-currency)) + optname-report-currency)) (price-source (get-option gnc:pagename-general optname-price-source)) - (report-title (get-option gnc:pagename-general - gnc:optname-reportname)) + (report-title (get-option gnc:pagename-general + gnc:optname-reportname)) (averaging-selection (if do-intervals? (get-option gnc:pagename-general optname-averaging) @@ -327,14 +327,14 @@ balance at a given time")) (show-total? (get-option gnc:pagename-display optname-show-total)) (show-percent? (get-option gnc:pagename-display optname-show-percent)) (max-slices (inexact->exact - (get-option gnc:pagename-display optname-slices))) + (get-option gnc:pagename-display optname-slices))) (height (get-option gnc:pagename-display optname-plot-height)) (width (get-option gnc:pagename-display optname-plot-width)) - (sort-method (get-option gnc:pagename-display optname-sort-method)) + (sort-method (get-option gnc:pagename-display optname-sort-method)) (document (gnc:make-html-document)) (chart (gnc:make-html-chart)) - (topl-accounts (gnc:filter-accountlist-type + (topl-accounts (gnc:filter-accountlist-type account-types (gnc-account-get-children-sorted (gnc-get-current-root-account))))) @@ -343,7 +343,7 @@ balance at a given time")) ;; selection option. (define (show-acct? a) (member a accounts)) - + ;; Calculates the net balance (profit or loss) of an account ;; over the selected reporting period. If subaccts? == #t, all ;; subaccount's balances are included as well. Returns a @@ -356,7 +356,7 @@ balance at a given time")) account to-date subaccts?))) ;; Define more helper variables. - (let* ((exchange-fn (gnc:case-exchange-fn + (let* ((exchange-fn (gnc:case-exchange-fn price-source report-currency to-date)) (tree-depth (if (equal? account-levels 'all) (gnc:get-current-account-tree-depth) @@ -410,7 +410,7 @@ balance at a given time")) (collector->amount (profit-fn a subaccts?))) (define (count-accounts current-depth accts) - (if (< current-depth tree-depth) + (if (< current-depth tree-depth) (let iter ((sum 0) (remaining accts)) (if (null? remaining) @@ -420,11 +420,11 @@ balance at a given time")) (subaccts (count-accounts (1+ current-depth) (gnc-account-get-children cur)))) (iter (+ sum (1+ subaccts)) tail)))) - (length (filter show-acct? accts)))) + (length (filter show-acct? accts)))) ;; Get base data to be plotted. (define work-to-do (lambda () (count-accounts 1 topl-accounts))) - + (define base-data (lambda () (get-data account-balance show-acct? work-to-do tree-depth 0 1 topl-accounts))) @@ -434,15 +434,15 @@ balance at a given time")) (if reverse-balance? (cons (- (car pair)) (cdr pair)) pair)) - combined)) + combined)) ;; Now do the work here. (if (not (null? accounts)) (begin (set! combined - (sort (filter (lambda (pair) (not (>= 0.0 (car pair)))) - (fix-signs (cdr (base-data)))) + (sort (filter (lambda (pair) (not (>= 0.0 (car pair)))) + (fix-signs (cdr (base-data)))) (sort-comparator sort-method show-fullname?))) ;; if too many slices, condense them to an 'other' slice @@ -468,8 +468,8 @@ balance at a given time")) (set! id (gnc:make-report report-guid options)) ;; set the URL. (set! other-anchor (gnc:report-anchor-text id)))))) - - (if + + (if (not (null? combined)) (let ((urls (and depth-based? (map @@ -562,13 +562,13 @@ balance at a given time")) (gnc:html-document-add-object! document - (gnc:html-make-empty-data-warning - report-title (gnc:report-id report-obj))))) + (gnc:html-make-empty-data-warning + report-title (gnc:report-id report-obj))))) (gnc:html-document-add-object! document - (gnc:html-make-no-account-warning - report-title (gnc:report-id report-obj)))) + (gnc:html-make-no-account-warning + report-title (gnc:report-id report-obj)))) (gnc:report-finished) document))) diff --git a/gnucash/report/reports/standard/advanced-portfolio.scm b/gnucash/report/reports/standard/advanced-portfolio.scm index 4d5d0767d7..7421dcddda 100644 --- a/gnucash/report/reports/standard/advanced-portfolio.scm +++ b/gnucash/report/reports/standard/advanced-portfolio.scm @@ -28,7 +28,7 @@ (define-module (gnucash reports standard advanced-portfolio)) (use-modules (gnucash engine)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash core-utils)) (use-modules (gnucash app-utils)) (use-modules (gnucash report)) @@ -97,19 +97,19 @@ by preventing negative stock balances.
") (vector 'ignore-brokerage (N_ "Omit from report")))) (gnc-register-simple-boolean-option options - gnc:pagename-display optname-show-symbol "a" - (N_ "Display the ticker symbols.") - #t) + gnc:pagename-display optname-show-symbol "a" + (N_ "Display the ticker symbols.") + #t) (gnc-register-simple-boolean-option options - gnc:pagename-display optname-show-listing "b" - (N_ "Display exchange listings.") - #t) + gnc:pagename-display optname-show-listing "b" + (N_ "Display exchange listings.") + #t) (gnc-register-simple-boolean-option options - gnc:pagename-display optname-show-shares "c" - (N_ "Display numbers of shares in accounts.") - #t) + gnc:pagename-display optname-show-shares "c" + (N_ "Display numbers of shares in accounts.") + #t) (gnc-register-number-range-option options gnc:pagename-display optname-shares-digits @@ -117,9 +117,9 @@ by preventing negative stock balances.
") 0 9 1) (gnc-register-simple-boolean-option options - gnc:pagename-display optname-show-price "e" - (N_ "Display share prices.") - #t) + gnc:pagename-display optname-show-price "e" + (N_ "Display share prices.") + #t) ;; Account tab (gnc-register-account-list-limited-option options @@ -169,30 +169,30 @@ by preventing negative stock balances.
") ;; sum up the contents of the b-list built by basis-builder below (define (sum-basis b-list currency-frac) (if (not (eqv? b-list '())) - (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND) - (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND) - (gnc-numeric-zero) - ) + (gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND) + (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND) + (gnc-numeric-zero) + ) ) ;; sum up the total number of units in the b-list built by basis-builder below (define (units-basis b-list) (if (not (eqv? b-list '())) - (gnc-numeric-add (caar b-list) (units-basis (cdr b-list)) - units-denom GNC-RND-ROUND) - (gnc-numeric-zero) - ) + (gnc-numeric-add (caar b-list) (units-basis (cdr b-list)) + units-denom GNC-RND-ROUND) + (gnc-numeric-zero) + ) ) ;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs ;; I need to get a brain and use (map) for this. (define (apply-basis-ratio b-list units-ratio value-ratio) (if (not (eqv? b-list '())) - (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND) - (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND)) - (apply-basis-ratio (cdr b-list) units-ratio value-ratio)) - '() - ) + (cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND) + (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND)) + (apply-basis-ratio (cdr b-list) units-ratio value-ratio)) + '() + ) ) ;; this builds a list for basis calculation and handles average, fifo and lifo methods @@ -209,34 +209,34 @@ by preventing negative stock balances.
") ;; we have value and positive units, add units to basis ((and (not (gnc-numeric-zero-p b-value)) - (gnc-numeric-positive-p b-units)) + (gnc-numeric-positive-p b-units)) (case b-method - ((average-basis) - (if (not (eqv? b-list '())) - (list (cons (gnc-numeric-add b-units - (caar b-list) units-denom GNC-RND-ROUND) - (gnc-numeric-div - (gnc-numeric-add b-value - (gnc-numeric-mul (caar b-list) - (cdar b-list) - GNC-DENOM-AUTO GNC-DENOM-REDUCE) - GNC-DENOM-AUTO GNC-DENOM-REDUCE) - (let ((denom (gnc-numeric-add b-units + ((average-basis) + (if (not (eqv? b-list '())) + (list (cons (gnc-numeric-add b-units + (caar b-list) units-denom GNC-RND-ROUND) + (gnc-numeric-div + (gnc-numeric-add b-value + (gnc-numeric-mul (caar b-list) + (cdar b-list) + GNC-DENOM-AUTO GNC-DENOM-REDUCE) + GNC-DENOM-AUTO GNC-DENOM-REDUCE) + (let ((denom (gnc-numeric-add b-units (caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE))) (if (zero? denom) (throw 'div/0 (format #f "buying ~0,4f share units" b-units)) denom)) - price-denom GNC-RND-ROUND))) - (append b-list + price-denom GNC-RND-ROUND))) + (append b-list (list (cons b-units (gnc-numeric-div b-value b-units price-denom GNC-RND-ROUND)))))) - (else (append b-list + (else (append b-list (list (cons b-units (gnc-numeric-div b-value b-units price-denom GNC-RND-ROUND))))))) ;; we have value and negative units, remove units from basis ((and (not (gnc-numeric-zero-p b-value)) - (gnc-numeric-negative-p b-units)) + (gnc-numeric-negative-p b-units)) (if (not (eqv? b-list '())) (case b-method ((fifo-basis) @@ -278,38 +278,38 @@ by preventing negative stock balances.
") ;; no value, just units, this is a split/merge... ((and (gnc-numeric-zero-p b-value) - (not (gnc-numeric-zero-p b-units))) - (let* ((current-units (units-basis b-list)) + (not (gnc-numeric-zero-p b-units))) + (let* ((current-units (units-basis b-list)) ;; If current-units is zero then so should be everything else. - (units-ratio (if (zero? current-units) (gnc-numeric-zero) + (units-ratio (if (zero? current-units) (gnc-numeric-zero) (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE) current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE))) ;; If the units ratio is zero the stock is worthless and the value should be zero too - (value-ratio (if (gnc-numeric-zero-p units-ratio) - (gnc-numeric-zero) + (value-ratio (if (gnc-numeric-zero-p units-ratio) + (gnc-numeric-zero) (gnc-numeric-div 1/1 units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE)))) - (gnc:debug "blist is " b-list " current units is " - (gnc-numeric-to-string current-units) - " value ratio is " (gnc-numeric-to-string value-ratio) - " units ratio is " (gnc-numeric-to-string units-ratio)) - (apply-basis-ratio b-list units-ratio value-ratio) - )) + (gnc:debug "blist is " b-list " current units is " + (gnc-numeric-to-string current-units) + " value ratio is " (gnc-numeric-to-string value-ratio) + " units ratio is " (gnc-numeric-to-string units-ratio)) + (apply-basis-ratio b-list units-ratio value-ratio) + )) - ;; If there are no units, just a value, then its a spin-off, - ;; calculate a ratio for the values, but leave the units alone - ;; with a ratio of 1 + ;; If there are no units, just a value, then its a spin-off, + ;; calculate a ratio for the values, but leave the units alone + ;; with a ratio of 1 ((and (gnc-numeric-zero-p b-units) - (not (gnc-numeric-zero-p b-value))) + (not (gnc-numeric-zero-p b-value))) (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO)) (value-ratio (if (zero? current-value) (throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value)) (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE) current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)))) - (gnc:debug "this is a spinoff") - (gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio)) - (apply-basis-ratio b-list 1/1 value-ratio)) + (gnc:debug "this is a spinoff") + (gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio)) + (apply-basis-ratio b-list 1/1 value-ratio)) ) ;; when all else fails, just send the b-list back @@ -358,23 +358,23 @@ by preventing negative stock balances.
") (define (table-add-stock-rows table accounts to-date currency price-fn exchange-fn price-source - include-empty show-symbol show-listing show-shares show-price + include-empty show-symbol show-listing show-shares show-price basis-method prefer-pricelist handle-brokerage-fees total-basis total-value total-moneyin total-moneyout total-income total-gain total-ugain total-brokerage) (let ((share-print-info - (gnc-share-print-info-places - (inexact->exact (get-option gnc:pagename-display - optname-shares-digits))))) + (gnc-share-print-info-places + (inexact->exact (get-option gnc:pagename-display + optname-shares-digits))))) (define (table-add-stock-rows-internal accounts odd-row?) (if (null? accounts) total-value (let* ((row-style (if odd-row? "normal-row" "alternate-row")) (current (car accounts)) (rest (cdr accounts)) - ;; commodity is the actual stock/thing we are looking at + ;; commodity is the actual stock/thing we are looking at (commodity (xaccAccountGetCommodity current)) (ticker-symbol (gnc-commodity-get-mnemonic commodity)) (listing (gnc-commodity-get-namespace commodity)) @@ -390,23 +390,23 @@ by preventing negative stock balances.
") (gaincoll (gnc:make-commodity-collector)) - ;; the price of the commodity at the time of the report + ;; the price of the commodity at the time of the report (price (price-fn commodity currency to-date)) - ;; the value of the commodity, expressed in terms of - ;; the report's currency. + ;; the value of the commodity, expressed in terms of + ;; the report's currency. (value (gnc:make-gnc-monetary currency (gnc-numeric-zero))) ;; Set later (currency-frac (gnc-commodity-get-fraction currency)) - (pricing-txn #f) - (use-txn #f) - (basis-list '()) - ;; setup an alist for the splits we've already seen. - (seen_trans '()) - ;; Account used to hold remainders from income reinvestments and - ;; running total of amount moved there - (drp-holding-account #f) - (drp-holding-amount (gnc-numeric-zero)) - ) + (pricing-txn #f) + (use-txn #f) + (basis-list '()) + ;; setup an alist for the splits we've already seen. + (seen_trans '()) + ;; Account used to hold remainders from income reinvestments and + ;; running total of amount moved there + (drp-holding-account #f) + (drp-holding-amount (gnc-numeric-zero)) + ) (define (my-exchange-fn fromunits tocurrency) (if (and (gnc-commodity-equiv currency tocurrency) @@ -495,40 +495,40 @@ by preventing negative stock balances.
") " from " (gnc:monetary->string (gnc:make-gnc-monetary commodity units))) - (for-each - ;; we're looking at each split we find in the account. these splits - ;; could refer to the same transaction, so we have to examine each - ;; split, determine what kind of split it is and then act accordingly. - (lambda (split) - (set! work-done (+ 1 work-done)) - (gnc:report-percent-done (* 100 (/ work-done work-to-do))) + (for-each + ;; we're looking at each split we find in the account. these splits + ;; could refer to the same transaction, so we have to examine each + ;; split, determine what kind of split it is and then act accordingly. + (lambda (split) + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (* 100 (/ work-done work-to-do))) - (let* ((parent (xaccSplitGetParent split)) - (txn-date (xaccTransGetDate parent)) - (commod-currency (xaccTransGetCurrency parent)) - (commod-currency-frac (gnc-commodity-get-fraction commod-currency))) + (let* ((parent (xaccSplitGetParent split)) + (txn-date (xaccTransGetDate parent)) + (commod-currency (xaccTransGetCurrency parent)) + (commod-currency-frac (gnc-commodity-get-fraction commod-currency))) - (if (and (<= txn-date to-date) - (not (assoc-ref seen_trans (gncTransGetGUID parent)))) - (let ((trans-income (gnc-numeric-zero)) - (trans-brokerage (gnc-numeric-zero)) - (trans-shares (gnc-numeric-zero)) - (shares-bought (gnc-numeric-zero)) - (trans-sold (gnc-numeric-zero)) - (trans-bought (gnc-numeric-zero)) - (trans-spinoff (gnc-numeric-zero)) - (trans-drp-residual (gnc-numeric-zero)) - (trans-drp-account #f)) + (if (and (<= txn-date to-date) + (not (assoc-ref seen_trans (gncTransGetGUID parent)))) + (let ((trans-income (gnc-numeric-zero)) + (trans-brokerage (gnc-numeric-zero)) + (trans-shares (gnc-numeric-zero)) + (shares-bought (gnc-numeric-zero)) + (trans-sold (gnc-numeric-zero)) + (trans-bought (gnc-numeric-zero)) + (trans-spinoff (gnc-numeric-zero)) + (trans-drp-residual (gnc-numeric-zero)) + (trans-drp-account #f)) - (gnc:debug "Transaction " (xaccTransGetDescription parent)) - ;; Add this transaction to the list of processed transactions so we don't - ;; do it again if there is another split in it for this account - (set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans)) + (gnc:debug "Transaction " (xaccTransGetDescription parent)) + ;; Add this transaction to the list of processed transactions so we don't + ;; do it again if there is another split in it for this account + (set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans)) - ;; Go through all the splits in the transaction to get an overall idea of - ;; what it does in terms of income, money in or out, shares bought or sold, etc. - (for-each - (lambda (s) + ;; Go through all the splits in the transaction to get an overall idea of + ;; what it does in terms of income, money in or out, shares bought or sold, etc. + (for-each + (lambda (s) (let ((split-units (xaccSplitGetAmount s)) (split-value (xaccSplitGetValue s))) @@ -587,32 +587,32 @@ by preventing negative stock balances.
") (set! trans-drp-residual (gnc-numeric-add trans-drp-residual split-value commod-currency-frac GNC-RND-ROUND)) (set! trans-drp-account 'none)))))) - )) - (xaccTransGetSplitList parent) - ) + )) + (xaccTransGetSplitList parent) + ) - (gnc:debug "Income: " (gnc-numeric-to-string trans-income) - " Brokerage: " (gnc-numeric-to-string trans-brokerage) - " Shares traded: " (gnc-numeric-to-string trans-shares) - " Shares bought: " (gnc-numeric-to-string shares-bought)) - (gnc:debug " Value sold: " (gnc-numeric-to-string trans-sold) - " Value purchased: " (gnc-numeric-to-string trans-bought) - " Spinoff value " (gnc-numeric-to-string trans-spinoff) - " Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual)) + (gnc:debug "Income: " (gnc-numeric-to-string trans-income) + " Brokerage: " (gnc-numeric-to-string trans-brokerage) + " Shares traded: " (gnc-numeric-to-string trans-shares) + " Shares bought: " (gnc-numeric-to-string shares-bought)) + (gnc:debug " Value sold: " (gnc-numeric-to-string trans-sold) + " Value purchased: " (gnc-numeric-to-string trans-bought) + " Spinoff value " (gnc-numeric-to-string trans-spinoff) + " Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual)) - ;; We need to calculate several things for this transaction: - ;; 1. Total income: this is already in trans-income - ;; 2. Change in basis: calculated by loop below that looks at every - ;; that acquires or disposes of shares - ;; 3. Realized gain: also calculated below while calculating basis - ;; 4. Money in to the account: this is the value of shares bought - ;; except those purchased with reinvested income - ;; 5. Money out: the money received by disposing of shares. This - ;; is in trans-sold plus trans-spinoff - ;; 6. Brokerage fees: this is in trans-brokerage + ;; We need to calculate several things for this transaction: + ;; 1. Total income: this is already in trans-income + ;; 2. Change in basis: calculated by loop below that looks at every + ;; that acquires or disposes of shares + ;; 3. Realized gain: also calculated below while calculating basis + ;; 4. Money in to the account: this is the value of shares bought + ;; except those purchased with reinvested income + ;; 5. Money out: the money received by disposing of shares. This + ;; is in trans-sold plus trans-spinoff + ;; 6. Brokerage fees: this is in trans-brokerage - ;; Income - (dividendcoll 'add commod-currency trans-income) + ;; Income + (dividendcoll 'add commod-currency trans-income) ;; Brokerage fees. May be either ignored or part of basis, but that ;; will be dealt with elsewhere. @@ -677,8 +677,8 @@ by preventing negative stock balances.
") (moneyoutcoll 'add commod-currency trans-spinoff) ;; Look at splits again to handle changes in basis and realized gains - (for-each - (lambda (s) + (for-each + (lambda (s) (let ;; get the split's units and value ((split-units (xaccSplitGetAmount s)) @@ -693,30 +693,30 @@ by preventing negative stock balances.
") (same-account? current (xaccSplitGetAccount s))) ;; Split into subject account with non-zero amount. This is a purchase ;; or a sale, adjust the basis - (let* ((split-value-currency (gnc:gnc-monetary-amount - (my-exchange-fn (gnc:make-gnc-monetary - commod-currency split-value) currency))) - (orig-basis (sum-basis basis-list currency-frac)) - ;; proportion of the fees attributable to this split - (fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares - GNC-DENOM-AUTO GNC-DENOM-REDUCE)) - ;; Fees for this split in report currency - (fees-currency (gnc:gnc-monetary-amount (my-exchange-fn - (gnc:make-gnc-monetary commod-currency - (gnc-numeric-mul fee-ratio trans-brokerage - commod-currency-frac GNC-RND-ROUND)) - currency))) - (split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis) - ;; Include brokerage fees in basis - (gnc-numeric-add split-value-currency fees-currency - currency-frac GNC-RND-ROUND) - split-value-currency))) + (let* ((split-value-currency (gnc:gnc-monetary-amount + (my-exchange-fn (gnc:make-gnc-monetary + commod-currency split-value) currency))) + (orig-basis (sum-basis basis-list currency-frac)) + ;; proportion of the fees attributable to this split + (fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares + GNC-DENOM-AUTO GNC-DENOM-REDUCE)) + ;; Fees for this split in report currency + (fees-currency (gnc:gnc-monetary-amount (my-exchange-fn + (gnc:make-gnc-monetary commod-currency + (gnc-numeric-mul fee-ratio trans-brokerage + commod-currency-frac GNC-RND-ROUND)) + currency))) + (split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis) + ;; Include brokerage fees in basis + (gnc-numeric-add split-value-currency fees-currency + currency-frac GNC-RND-ROUND) + split-value-currency))) (gnc:debug "going in to basis list " basis-list " " (gnc-numeric-to-string split-units) " " (gnc-numeric-to-string split-value-with-fees)) - ;; adjust the basis - (set! basis-list (basis-builder basis-list split-units split-value-with-fees - basis-method currency-frac)) + ;; adjust the basis + (set! basis-list (basis-builder basis-list split-units split-value-with-fees + basis-method currency-frac)) (gnc:debug "coming out of basis list " basis-list) ;; If it's a sale or the stock is worthless, calculate the gain @@ -752,110 +752,110 @@ by preventing negative stock balances.
") currency-frac)) (gnc:debug "after spin-off basis list " basis-list)) ) - )) - (xaccTransGetSplitList parent) - ) - ) - ) - ) - ) - (xaccAccountGetSplitList current) - ) + )) + (xaccTransGetSplitList parent) + ) + ) + ) + ) + ) + (xaccAccountGetSplitList current) + ) - ;; Look for income and expense transactions that don't have a split in the - ;; the account we're processing. We do this as follow - ;; 1. Make sure the parent account is a currency-valued asset or bank account - ;; 2. If so go through all the splits in that account - ;; 3. If a split is part of a two split transaction where the other split is - ;; to an income or expense account and the leaf name of that account is the - ;; same as the leaf name of the account we're processing, add it to the - ;; income or expense accumulator - ;; - ;; In other words with an account structure like - ;; - ;; Assets (type ASSET) - ;; Broker (type ASSET) - ;; Widget Stock (type STOCK) - ;; Income (type INCOME) - ;; Dividends (type INCOME) - ;; Widget Stock (type INCOME) - ;; - ;; If you are producing a report on "Assets:Broker:Widget Stock" a - ;; transaction that debits the Assets:Broker account and credits the - ;; "Income:Dividends:Widget Stock" account will count as income in - ;; the report even though it doesn't have a split in the account - ;; being reported on. + ;; Look for income and expense transactions that don't have a split in the + ;; the account we're processing. We do this as follow + ;; 1. Make sure the parent account is a currency-valued asset or bank account + ;; 2. If so go through all the splits in that account + ;; 3. If a split is part of a two split transaction where the other split is + ;; to an income or expense account and the leaf name of that account is the + ;; same as the leaf name of the account we're processing, add it to the + ;; income or expense accumulator + ;; + ;; In other words with an account structure like + ;; + ;; Assets (type ASSET) + ;; Broker (type ASSET) + ;; Widget Stock (type STOCK) + ;; Income (type INCOME) + ;; Dividends (type INCOME) + ;; Widget Stock (type INCOME) + ;; + ;; If you are producing a report on "Assets:Broker:Widget Stock" a + ;; transaction that debits the Assets:Broker account and credits the + ;; "Income:Dividends:Widget Stock" account will count as income in + ;; the report even though it doesn't have a split in the account + ;; being reported on. - (let ((parent-account (gnc-account-get-parent current)) - (account-name (xaccAccountGetName current))) - (if (and (not (null? parent-account)) - (member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK)) - (gnc-commodity-is-currency (xaccAccountGetCommodity parent-account))) - (for-each - (lambda (split) - (let* ((other-split (xaccSplitGetOtherSplit split)) - ;; This is safe because xaccSplitGetAccount returns null for a null split - (other-acct (xaccSplitGetAccount other-split)) - (parent (xaccSplitGetParent split)) - (txn-date (xaccTransGetDate parent))) - (if (and (not (null? other-acct)) - (<= txn-date to-date) - (string=? (xaccAccountGetName other-acct) account-name) - (gnc-commodity-is-currency (xaccAccountGetCommodity other-acct))) - ;; This is a two split transaction where the other split is to an - ;; account with the same name as the current account. If it's an - ;; income or expense account accumulate the value of the transaction - (let ((val (xaccSplitGetValue split)) - (curr (xaccAccountGetCommodity other-acct))) + (let ((parent-account (gnc-account-get-parent current)) + (account-name (xaccAccountGetName current))) + (if (and (not (null? parent-account)) + (member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK)) + (gnc-commodity-is-currency (xaccAccountGetCommodity parent-account))) + (for-each + (lambda (split) + (let* ((other-split (xaccSplitGetOtherSplit split)) + ;; This is safe because xaccSplitGetAccount returns null for a null split + (other-acct (xaccSplitGetAccount other-split)) + (parent (xaccSplitGetParent split)) + (txn-date (xaccTransGetDate parent))) + (if (and (not (null? other-acct)) + (<= txn-date to-date) + (string=? (xaccAccountGetName other-acct) account-name) + (gnc-commodity-is-currency (xaccAccountGetCommodity other-acct))) + ;; This is a two split transaction where the other split is to an + ;; account with the same name as the current account. If it's an + ;; income or expense account accumulate the value of the transaction + (let ((val (xaccSplitGetValue split)) + (curr (xaccAccountGetCommodity other-acct))) (cond ((split-account-type? other-split ACCT-TYPE-INCOME) - (gnc:debug "More income " (gnc-numeric-to-string val)) - (dividendcoll 'add curr val)) + (gnc:debug "More income " (gnc-numeric-to-string val)) + (dividendcoll 'add curr val)) ((split-account-type? other-split ACCT-TYPE-EXPENSE) (gnc:debug "More expense " (gnc-numeric-to-string (gnc-numeric-neg val))) (brokeragecoll 'add curr (gnc-numeric-neg val))) - ) - ) - ) - ) - ) - (xaccAccountGetSplitList parent-account) - ) - ) - ) + ) + ) + ) + ) + ) + (xaccAccountGetSplitList parent-account) + ) + ) + ) - (gnc:debug "pricing txn is " pricing-txn) - (gnc:debug "use txn is " use-txn) - (gnc:debug "prefer-pricelist is " prefer-pricelist) - (gnc:debug "price is " price) + (gnc:debug "pricing txn is " pricing-txn) + (gnc:debug "use txn is " use-txn) + (gnc:debug "prefer-pricelist is " prefer-pricelist) + (gnc:debug "price is " price) - (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list - currency-frac))) - (gnc:debug "but the actual basis list is " basis-list) + (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list + currency-frac))) + (gnc:debug "but the actual basis list is " basis-list) (if (eq? handle-brokerage-fees 'include-in-gain) - (gaincoll 'minusmerge brokeragecoll #f)) + (gaincoll 'minusmerge brokeragecoll #f)) - (if (or include-empty (not (gnc-numeric-zero-p units))) - (let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my-exchange-fn)) - (moneyout (gnc:sum-collector-commodity moneyoutcoll currency my-exchange-fn)) + (if (or include-empty (not (gnc-numeric-zero-p units))) + (let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my-exchange-fn)) + (moneyout (gnc:sum-collector-commodity moneyoutcoll currency my-exchange-fn)) (brokerage (gnc:sum-collector-commodity brokeragecoll currency my-exchange-fn)) - (income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn)) - ;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well.. - (gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn)) - (ugain (gnc:make-gnc-monetary currency - (gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency)) - (sum-basis basis-list (gnc-commodity-get-fraction currency)) - currency-frac GNC-RND-ROUND))) - (bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain) - (gnc:gnc-monetary-amount ugain) - currency-frac GNC-RND-ROUND))) - (totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount bothgain) - (gnc:gnc-monetary-amount income) - currency-frac GNC-RND-ROUND))) + (income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn)) + ;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well.. + (gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn)) + (ugain (gnc:make-gnc-monetary currency + (gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency)) + (sum-basis basis-list (gnc-commodity-get-fraction currency)) + currency-frac GNC-RND-ROUND))) + (bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain) + (gnc:gnc-monetary-amount ugain) + currency-frac GNC-RND-ROUND))) + (totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount bothgain) + (gnc:gnc-monetary-amount income) + currency-frac GNC-RND-ROUND))) - (activecols (list (gnc:html-account-anchor current))) - ) + (activecols (list (gnc:html-account-anchor current))) + ) ;; If we're using the txn, warn the user (if use-txn @@ -864,80 +864,80 @@ by preventing negative stock balances.
") (set! warn-no-price #t) )) - (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value)) - (total-moneyin 'merge moneyincoll #f) - (total-moneyout 'merge moneyoutcoll #f) + (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value)) + (total-moneyin 'merge moneyincoll #f) + (total-moneyout 'merge moneyoutcoll #f) (total-brokerage 'merge brokeragecoll #f) - (total-income 'merge dividendcoll #f) - (total-gain 'merge gaincoll #f) - (total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain)) - (total-basis 'add currency (sum-basis basis-list currency-frac)) + (total-income 'merge dividendcoll #f) + (total-gain 'merge gaincoll #f) + (total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain)) + (total-basis 'add currency (sum-basis basis-list currency-frac)) - ;; build a list for the row based on user selections - (if show-symbol (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol)))) - (if show-listing (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" listing)))) - (if show-shares (append! activecols (list (gnc:make-html-table-header-cell/markup - "number-cell" (xaccPrintAmount units share-print-info))))) - (if show-price (append! activecols (list (gnc:make-html-table-header-cell/markup - "number-cell" - (if use-txn - (if pricing-txn + ;; build a list for the row based on user selections + (if show-symbol (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol)))) + (if show-listing (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" listing)))) + (if show-shares (append! activecols (list (gnc:make-html-table-header-cell/markup + "number-cell" (xaccPrintAmount units share-print-info))))) + (if show-price (append! activecols (list (gnc:make-html-table-header-cell/markup + "number-cell" + (if use-txn + (if pricing-txn (gnc:html-transaction-anchor pricing-txn price) price) - (gnc:html-price-anchor - price (gnc:default-price-renderer + (gnc:html-price-anchor + price (gnc:default-price-renderer (gnc-price-get-currency price) (gnc-price-get-value price)))))))) - (append! activecols (list (if use-txn (if pricing-txn "*" "**") " ") - (gnc:make-html-table-header-cell/markup - "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list - currency-frac))) - (gnc:make-html-table-header-cell/markup "number-cell" value) - (gnc:make-html-table-header-cell/markup "number-cell" moneyin) - (gnc:make-html-table-header-cell/markup "number-cell" moneyout) - (gnc:make-html-table-header-cell/markup "number-cell" gain) - (gnc:make-html-table-header-cell/markup "number-cell" ugain) - (gnc:make-html-table-header-cell/markup "number-cell" bothgain) - (gnc:make-html-table-header-cell/markup "number-cell" - (let* ((moneyinvalue (gnc-numeric-to-double - (gnc:gnc-monetary-amount moneyin))) - (bothgainvalue (gnc-numeric-to-double - (gnc:gnc-monetary-amount bothgain))) + (append! activecols (list (if use-txn (if pricing-txn "*" "**") " ") + (gnc:make-html-table-header-cell/markup + "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list + currency-frac))) + (gnc:make-html-table-header-cell/markup "number-cell" value) + (gnc:make-html-table-header-cell/markup "number-cell" moneyin) + (gnc:make-html-table-header-cell/markup "number-cell" moneyout) + (gnc:make-html-table-header-cell/markup "number-cell" gain) + (gnc:make-html-table-header-cell/markup "number-cell" ugain) + (gnc:make-html-table-header-cell/markup "number-cell" bothgain) + (gnc:make-html-table-header-cell/markup "number-cell" + (let* ((moneyinvalue (gnc-numeric-to-double + (gnc:gnc-monetary-amount moneyin))) + (bothgainvalue (gnc-numeric-to-double + (gnc:gnc-monetary-amount bothgain))) ) - (if (= 0.0 moneyinvalue) - "" - (format #f "~,2f%" (* 100 (/ bothgainvalue moneyinvalue))))) - ) - (gnc:make-html-table-header-cell/markup "number-cell" income))) - (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) - (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage)))) - (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn) - (gnc:make-html-table-header-cell/markup "number-cell" - (let* ((moneyinvalue (gnc-numeric-to-double - (gnc:gnc-monetary-amount moneyin))) - (totalreturnvalue (gnc-numeric-to-double - (gnc:gnc-monetary-amount totalreturn))) + (if (= 0.0 moneyinvalue) + "" + (format #f "~,2f%" (* 100 (/ bothgainvalue moneyinvalue))))) + ) + (gnc:make-html-table-header-cell/markup "number-cell" income))) + (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) + (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage)))) + (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn) + (gnc:make-html-table-header-cell/markup "number-cell" + (let* ((moneyinvalue (gnc-numeric-to-double + (gnc:gnc-monetary-amount moneyin))) + (totalreturnvalue (gnc-numeric-to-double + (gnc:gnc-monetary-amount totalreturn))) ) - (if (= 0.0 moneyinvalue) - "" - (format #f "~,2f%" (* 100 (/ totalreturnvalue moneyinvalue)))))) - ) - ) + (if (= 0.0 moneyinvalue) + "" + (format #f "~,2f%" (* 100 (/ totalreturnvalue moneyinvalue)))))) + ) + ) - (gnc:html-table-append-row/markup! - table - row-style - activecols) + (gnc:html-table-append-row/markup! + table + row-style + activecols) (if (and (not use-txn) price) (gnc-price-unref price)) - (table-add-stock-rows-internal rest (not odd-row?)) - ) - (begin - (if (and (not use-txn) price) (gnc-price-unref price)) - (table-add-stock-rows-internal rest odd-row?) - ) + (table-add-stock-rows-internal rest (not odd-row?)) + ) + (begin + (if (and (not use-txn) price) (gnc-price-unref price)) + (table-add-stock-rows-internal rest odd-row?) + ) ) - ))) + ))) (set! work-to-do (gnc:accounts-count-splits accounts)) (table-add-stock-rows-internal accounts #t))) @@ -959,30 +959,30 @@ by preventing negative stock balances.
") gnc:optname-reportname)) (include-empty (get-option gnc:pagename-accounts optname-zero-shares)) - (show-symbol (get-option gnc:pagename-display - optname-show-symbol)) - (show-listing (get-option gnc:pagename-display - optname-show-listing)) - (show-shares (get-option gnc:pagename-display - optname-show-shares)) - (show-price (get-option gnc:pagename-display - optname-show-price)) - (basis-method (get-option gnc:pagename-general - optname-basis-method)) - (prefer-pricelist (get-option gnc:pagename-general - optname-prefer-pricelist)) - (handle-brokerage-fees (get-option gnc:pagename-general - optname-brokerage-fees)) + (show-symbol (get-option gnc:pagename-display + optname-show-symbol)) + (show-listing (get-option gnc:pagename-display + optname-show-listing)) + (show-shares (get-option gnc:pagename-display + optname-show-shares)) + (show-price (get-option gnc:pagename-display + optname-show-price)) + (basis-method (get-option gnc:pagename-general + optname-basis-method)) + (prefer-pricelist (get-option gnc:pagename-general + optname-prefer-pricelist)) + (handle-brokerage-fees (get-option gnc:pagename-general + optname-brokerage-fees)) - (total-basis (gnc:make-commodity-collector)) + (total-basis (gnc:make-commodity-collector)) (total-value (gnc:make-commodity-collector)) (total-moneyin (gnc:make-commodity-collector)) (total-moneyout (gnc:make-commodity-collector)) (total-income (gnc:make-commodity-collector)) (total-gain (gnc:make-commodity-collector)) ;; realized gain - (total-ugain (gnc:make-commodity-collector)) ;; unrealized gain + (total-ugain (gnc:make-commodity-collector)) ;; unrealized gain (total-brokerage (gnc:make-commodity-collector)) - ;;document will be the HTML document that we return. + ;;document will be the HTML document that we return. (table (gnc:make-html-table)) (document (gnc:make-html-document))) @@ -1004,61 +1004,61 @@ by preventing negative stock balances.
") ((pricedb-before) (lambda (foreign domestic date) (find-price (gnc-pricedb-lookup-nearest-before-any-currency-t64 - pricedb foreign (time64CanonicalDayTime date)) + pricedb foreign (time64CanonicalDayTime date)) domestic))) ((pricedb-nearest) (lambda (foreign domestic date) (find-price (gnc-pricedb-lookup-nearest-in-time-any-currency-t64 - pricedb foreign (time64CanonicalDayTime date)) domestic))))) - (headercols (list (G_ "Account"))) - (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (G_ "Total")))) - (sum-total-moneyin (gnc-numeric-zero)) - (sum-total-income (gnc-numeric-zero)) - (sum-total-both-gains (gnc-numeric-zero)) - (sum-total-gain (gnc-numeric-zero)) - (sum-total-ugain (gnc-numeric-zero)) - (sum-total-brokerage (gnc-numeric-zero)) - (sum-total-totalreturn (gnc-numeric-zero))) ;;end of let + pricedb foreign (time64CanonicalDayTime date)) domestic))))) + (headercols (list (G_ "Account"))) + (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (G_ "Total")))) + (sum-total-moneyin (gnc-numeric-zero)) + (sum-total-income (gnc-numeric-zero)) + (sum-total-both-gains (gnc-numeric-zero)) + (sum-total-gain (gnc-numeric-zero)) + (sum-total-ugain (gnc-numeric-zero)) + (sum-total-brokerage (gnc-numeric-zero)) + (sum-total-totalreturn (gnc-numeric-zero))) ;;end of let - ;;begin building lists for which columns to display + ;;begin building lists for which columns to display (if show-symbol - (begin (append! headercols (list (G_ "Symbol"))) - (append! totalscols (list " ")))) + (begin (append! headercols (list (G_ "Symbol"))) + (append! totalscols (list " ")))) - (if show-listing - (begin (append! headercols (list (G_ "Listing"))) - (append! totalscols (list " ")))) + (if show-listing + (begin (append! headercols (list (G_ "Listing"))) + (append! totalscols (list " ")))) - (if show-shares - (begin (append! headercols (list (G_ "Shares"))) - (append! totalscols (list " ")))) + (if show-shares + (begin (append! headercols (list (G_ "Shares"))) + (append! totalscols (list " ")))) - (if show-price - (begin (append! headercols (list (G_ "Price"))) - (append! totalscols (list " ")))) + (if show-price + (begin (append! headercols (list (G_ "Price"))) + (append! totalscols (list " ")))) - (append! headercols (list " " - (G_ "Basis") - (G_ "Value") - (G_ "Money In") - (G_ "Money Out") - (G_ "Realized Gain") - (G_ "Unrealized Gain") - (G_ "Total Gain") - (G_ "Rate of Gain") - (G_ "Income"))) + (append! headercols (list " " + (G_ "Basis") + (G_ "Value") + (G_ "Money In") + (G_ "Money Out") + (G_ "Realized Gain") + (G_ "Unrealized Gain") + (G_ "Total Gain") + (G_ "Rate of Gain") + (G_ "Income"))) - (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) - (append! headercols (list (G_ "Brokerage Fees")))) + (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) + (append! headercols (list (G_ "Brokerage Fees")))) - (append! headercols (list (G_ "Total Return") - (G_ "Rate of Return"))) + (append! headercols (list (G_ "Total Return") + (G_ "Rate of Return"))) (append! totalscols (list " ")) (gnc:html-table-set-col-headers! table - headercols) + headercols) (catch 'div/0 (lambda () @@ -1073,17 +1073,17 @@ by preventing negative stock balances.
") document (format #f OVERFLOW-ERROR reason)))) - (set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin currency exchange-fn)) - (set! sum-total-income (gnc:sum-collector-commodity total-income currency exchange-fn)) - (set! sum-total-gain (gnc:sum-collector-commodity total-gain currency exchange-fn)) - (set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency exchange-fn)) - (set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain) - (gnc:gnc-monetary-amount sum-total-ugain) - (gnc-commodity-get-fraction currency) GNC-RND-ROUND))) - (set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage currency exchange-fn)) - (set! sum-total-totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-both-gains) - (gnc:gnc-monetary-amount sum-total-income) - (gnc-commodity-get-fraction currency) GNC-RND-ROUND))) + (set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin currency exchange-fn)) + (set! sum-total-income (gnc:sum-collector-commodity total-income currency exchange-fn)) + (set! sum-total-gain (gnc:sum-collector-commodity total-gain currency exchange-fn)) + (set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency exchange-fn)) + (set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-gain) + (gnc:gnc-monetary-amount sum-total-ugain) + (gnc-commodity-get-fraction currency) GNC-RND-ROUND))) + (set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage currency exchange-fn)) + (set! sum-total-totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount sum-total-both-gains) + (gnc:gnc-monetary-amount sum-total-income) + (gnc-commodity-get-fraction currency) GNC-RND-ROUND))) (gnc:html-table-append-row/markup! table @@ -1092,52 +1092,52 @@ by preventing negative stock balances.
") (gnc:make-html-table-cell/size 1 17 (gnc:make-html-text (gnc:html-markup-hr))))) - ;; finish building the totals columns, now that totals are complete - (append! totalscols (list - (gnc:make-html-table-cell/markup - "total-number-cell" (gnc:sum-collector-commodity total-basis currency exchange-fn)) - (gnc:make-html-table-cell/markup - "total-number-cell" (gnc:sum-collector-commodity total-value currency exchange-fn)) - (gnc:make-html-table-cell/markup - "total-number-cell" sum-total-moneyin) - (gnc:make-html-table-cell/markup - "total-number-cell" (gnc:sum-collector-commodity total-moneyout currency exchange-fn)) - (gnc:make-html-table-cell/markup - "total-number-cell" sum-total-gain) - (gnc:make-html-table-cell/markup - "total-number-cell" sum-total-ugain) - (gnc:make-html-table-cell/markup - "total-number-cell" sum-total-both-gains) - (gnc:make-html-table-cell/markup - "total-number-cell" - (let* ((totalinvalue (gnc-numeric-to-double - (gnc:gnc-monetary-amount sum-total-moneyin))) - (totalgainvalue (gnc-numeric-to-double - (gnc:gnc-monetary-amount sum-total-both-gains))) - ) - (if (= 0.0 totalinvalue) - "" - (format #f "~,2f%" (* 100 (/ totalgainvalue totalinvalue)))))) - (gnc:make-html-table-cell/markup - "total-number-cell" sum-total-income))) - (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) - (append! totalscols (list - (gnc:make-html-table-cell/markup + ;; finish building the totals columns, now that totals are complete + (append! totalscols (list + (gnc:make-html-table-cell/markup + "total-number-cell" (gnc:sum-collector-commodity total-basis currency exchange-fn)) + (gnc:make-html-table-cell/markup + "total-number-cell" (gnc:sum-collector-commodity total-value currency exchange-fn)) + (gnc:make-html-table-cell/markup + "total-number-cell" sum-total-moneyin) + (gnc:make-html-table-cell/markup + "total-number-cell" (gnc:sum-collector-commodity total-moneyout currency exchange-fn)) + (gnc:make-html-table-cell/markup + "total-number-cell" sum-total-gain) + (gnc:make-html-table-cell/markup + "total-number-cell" sum-total-ugain) + (gnc:make-html-table-cell/markup + "total-number-cell" sum-total-both-gains) + (gnc:make-html-table-cell/markup + "total-number-cell" + (let* ((totalinvalue (gnc-numeric-to-double + (gnc:gnc-monetary-amount sum-total-moneyin))) + (totalgainvalue (gnc-numeric-to-double + (gnc:gnc-monetary-amount sum-total-both-gains))) + ) + (if (= 0.0 totalinvalue) + "" + (format #f "~,2f%" (* 100 (/ totalgainvalue totalinvalue)))))) + (gnc:make-html-table-cell/markup + "total-number-cell" sum-total-income))) + (if (not (eq? handle-brokerage-fees 'ignore-brokerage)) + (append! totalscols (list + (gnc:make-html-table-cell/markup "total-number-cell" sum-total-brokerage)))) - (append! totalscols (list - (gnc:make-html-table-cell/markup + (append! totalscols (list + (gnc:make-html-table-cell/markup "total-number-cell" sum-total-totalreturn) - (gnc:make-html-table-cell/markup - "total-number-cell" - (let* ((totalinvalue (gnc-numeric-to-double - (gnc:gnc-monetary-amount sum-total-moneyin))) - (totalreturnvalue (gnc-numeric-to-double - (gnc:gnc-monetary-amount sum-total-totalreturn))) - ) - (if (= 0.0 totalinvalue) - "" - (format #f "~,2f%" (* 100 (/ totalreturnvalue totalinvalue)))))) - )) + (gnc:make-html-table-cell/markup + "total-number-cell" + (let* ((totalinvalue (gnc-numeric-to-double + (gnc:gnc-monetary-amount sum-total-moneyin))) + (totalreturnvalue (gnc-numeric-to-double + (gnc:gnc-monetary-amount sum-total-totalreturn))) + ) + (if (= 0.0 totalinvalue) + "" + (format #f "~,2f%" (* 100 (/ totalreturnvalue totalinvalue)))))) + )) (gnc:html-table-append-row/markup! @@ -1150,8 +1150,8 @@ by preventing negative stock balances.
") (if warn-price-dirty (gnc:html-document-append-objects! document (list (gnc:make-html-text (G_ "* this commodity data was built using transaction pricing instead of the price list.")) - (gnc:make-html-text (gnc:html-markup-br)) - (gnc:make-html-text (G_ "If you are in a multi-currency situation, the exchanges may not be correct."))))) + (gnc:make-html-text (gnc:html-markup-br)) + (gnc:make-html-text (G_ "If you are in a multi-currency situation, the exchanges may not be correct."))))) (if warn-no-price (gnc:html-document-append-objects! document @@ -1159,11 +1159,11 @@ by preventing negative stock balances.
") (gnc:make-html-text (G_ "** this commodity has no price and a price of 1 has been used."))))) ) - ;if no accounts selected. + ;if no accounts selected. (gnc:html-document-add-object! document - (gnc:html-make-no-account-warning - report-title (gnc:report-id report-obj)))) + (gnc:html-make-no-account-warning + report-title (gnc:report-id report-obj)))) (gnc:report-finished) document))) diff --git a/gnucash/report/reports/standard/balance-sheet.scm b/gnucash/report/reports/standard/balance-sheet.scm index c528b870ab..9eb531da2a 100644 --- a/gnucash/report/reports/standard/balance-sheet.scm +++ b/gnucash/report/reports/standard/balance-sheet.scm @@ -168,7 +168,7 @@ ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE ACCT-TYPE-TRADING) - (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) + (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) (gnc:options-add-account-levels! options gnc:pagename-accounts optname-depth-limit "b" opthelp-depth-limit 3) diff --git a/gnucash/report/reports/standard/budget-balance-sheet.scm b/gnucash/report/reports/standard/budget-balance-sheet.scm index 3440e272b4..b215874267 100644 --- a/gnucash/report/reports/standard/budget-balance-sheet.scm +++ b/gnucash/report/reports/standard/budget-balance-sheet.scm @@ -9,16 +9,16 @@ ;; David Montenegro ;; Christian Stimming ;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; @@ -115,7 +115,7 @@ (gnc-register-string-option options gnc:pagename-general optname-report-title "a" opthelp-report-title (G_ reportname)) - + (gnc-register-simple-boolean-option options gnc:pagename-general optname-report-form "c" opthelp-report-form #t) @@ -123,7 +123,7 @@ (gnc-register-budget-option options gnc:pagename-general optname-budget "d" opthelp-budget (gnc-budget-get-default (gnc-get-current-book))) - + ;; accounts to work on (gnc-register-account-list-option options gnc:pagename-accounts optname-accounts @@ -135,7 +135,7 @@ ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE) - (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) + (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) (gnc:options-add-account-levels! options gnc:pagename-accounts optname-depth-limit @@ -143,23 +143,23 @@ (gnc-register-simple-boolean-option options gnc:pagename-accounts optname-bottom-behavior "c" opthelp-bottom-behavior #f) - + ;; all about currencies (gnc:options-add-currency! options pagename-commodities - optname-report-commodity "a") - (gnc:options-add-price-source! + optname-report-commodity "a") + (gnc:options-add-price-source! options pagename-commodities optname-price-source "b" 'pricedb-nearest) (gnc-register-simple-boolean-option options - pagename-commodities optname-show-foreign + pagename-commodities optname-show-foreign "c" opthelp-show-foreign #t) - + (gnc-register-simple-boolean-option options pagename-commodities optname-show-rates "d" opthelp-show-rates #f) - + ;; what to show for zero-balance accounts (gnc-register-simple-boolean-option options gnc:pagename-display optname-show-zb-accts @@ -180,21 +180,21 @@ (gnc-register-simple-boolean-option options gnc:pagename-display optname-use-rules "e" opthelp-use-rules #f) - + (gnc-register-simple-boolean-option options gnc:pagename-display optname-label-assets "f" opthelp-label-assets #t) (gnc-register-simple-boolean-option options gnc:pagename-display optname-total-assets "g" opthelp-total-assets #t) - + (gnc-register-simple-boolean-option options gnc:pagename-display optname-label-liabilities "h" opthelp-label-liabilities #t) (gnc-register-simple-boolean-option options gnc:pagename-display optname-total-liabilities "i" opthelp-total-liabilities #t) - + (gnc-register-simple-boolean-option options gnc:pagename-display optname-label-equity "j" opthelp-label-equity #t) @@ -205,10 +205,10 @@ (gnc-register-simple-boolean-option options gnc:pagename-display optname-new-existing "l" opthelp-new-existing #t) - + ;; Set the accounts page as default option tab (gnc:options-set-default-section options gnc:pagename-accounts) - + options)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -249,22 +249,22 @@ (and initial budget (gnc:collector+ initial budget)))) (gnc:report-starting reportname) - + ;; get all option's values (let* ( - (report-title (get-option gnc:pagename-general optname-report-title)) - (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) "")) + (report-title (get-option gnc:pagename-general optname-report-title)) + (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) "")) (budget (get-option gnc:pagename-general optname-budget)) (budget-valid? (and budget (not (null? budget)))) (date-t64 (if budget-valid? (gnc:budget-get-start-date budget) #f)) (report-form? (get-option gnc:pagename-general optname-report-form)) (accounts (get-option gnc:pagename-accounts - optname-accounts)) - (depth-limit (get-option gnc:pagename-accounts - optname-depth-limit)) - (bottom-behavior (get-option gnc:pagename-accounts - optname-bottom-behavior)) + optname-accounts)) + (depth-limit (get-option gnc:pagename-accounts + optname-depth-limit)) + (bottom-behavior (get-option gnc:pagename-accounts + optname-bottom-behavior)) (report-commodity (get-option pagename-commodities optname-report-commodity)) (price-source (get-option pagename-commodities @@ -276,32 +276,32 @@ (parent-balance-mode (get-option gnc:pagename-display optname-parent-balance-mode)) (parent-total-mode - (assq-ref '((t . #t) (f . #f)) - (get-option gnc:pagename-display - optname-parent-total-mode))) + (assq-ref '((t . #t) (f . #f)) + (get-option gnc:pagename-display + optname-parent-total-mode))) (show-zb-accts? (get-option gnc:pagename-display - optname-show-zb-accts)) + optname-show-zb-accts)) (omit-zb-bals? (get-option gnc:pagename-display - optname-omit-zb-bals)) + optname-omit-zb-bals)) (label-assets? (get-option gnc:pagename-display - optname-label-assets)) + optname-label-assets)) (total-assets? (get-option gnc:pagename-display - optname-total-assets)) + optname-total-assets)) (label-liabilities? (get-option gnc:pagename-display - optname-label-liabilities)) + optname-label-liabilities)) (total-liabilities? (get-option gnc:pagename-display - optname-total-liabilities)) + optname-total-liabilities)) (label-equity? (get-option gnc:pagename-display - optname-label-equity)) + optname-label-equity)) (total-equity? (get-option gnc:pagename-display - optname-total-equity)) + optname-total-equity)) (new-existing? (get-option gnc:pagename-display optname-new-existing)) (use-links? (get-option gnc:pagename-display - optname-account-links)) + optname-account-links)) (use-rules? (get-option gnc:pagename-display - optname-use-rules)) - + optname-use-rules)) + ;; decompose the account list (split-up-accounts (gnc:decompose-accountlist accounts)) (asset-accounts (assoc-ref split-up-accounts ACCT-TYPE-ASSET)) @@ -309,34 +309,34 @@ (income-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME)) (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)) (equity-accounts (assoc-ref split-up-accounts ACCT-TYPE-EQUITY)) - + (doc (gnc:make-html-document)) - ;; this can occasionally put extra (blank) columns in our - ;; table (when there is one account at the maximum depth and - ;; it has at least one of its ancestors deselected), but this - ;; is the only simple way to ensure that all three tables - ;; (asset, liability, equity) have the same width. + ;; this can occasionally put extra (blank) columns in our + ;; table (when there is one account at the maximum depth and + ;; it has at least one of its ancestors deselected), but this + ;; is the only simple way to ensure that all three tables + ;; (asset, liability, equity) have the same width. (tree-depth (if (equal? depth-limit 'all) - (gnc:get-current-account-tree-depth) - depth-limit)) + (gnc:get-current-account-tree-depth) + depth-limit)) ;; exchange rates calculation parameters - (exchange-fn - (gnc:case-exchange-fn price-source report-commodity date-t64)) + (exchange-fn + (gnc:case-exchange-fn price-source report-commodity date-t64)) (price-fn (gnc:case-price-fn price-source report-commodity date-t64))) - + (define (add-subtotal-line table pos-label neg-label signed-balance) (let* ((neg? (and signed-balance neg-label - (negative? - (gnc:gnc-monetary-amount - (gnc:sum-collector-commodity - signed-balance report-commodity exchange-fn))))) - (label (if neg? (or neg-label pos-label) pos-label)) - (balance (if neg? (gnc:collector- signed-balance) signed-balance))) - (gnc:html-table-add-labeled-amount-line! + (negative? + (gnc:gnc-monetary-amount + (gnc:sum-collector-commodity + signed-balance report-commodity exchange-fn))))) + (label (if neg? (or neg-label pos-label) pos-label)) + (balance (if neg? (gnc:collector- signed-balance) signed-balance))) + (gnc:html-table-add-labeled-amount-line! table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell" - (gnc:sum-collector-commodity balance report-commodity exchange-fn) + (gnc:sum-collector-commodity balance report-commodity exchange-fn) (1- (* tree-depth 2)) 1 "total-number-cell"))) ;; Wrapper around gnc:html-table-append-ruler! since we call it so @@ -348,10 +348,10 @@ (cond ((null? accounts) ;; No accounts selected. - (gnc:html-document-add-object! - doc - (gnc:html-make-no-account-warning - reportname (gnc:report-id report-obj)))) + (gnc:html-document-add-object! + doc + (gnc:html-make-no-account-warning + reportname (gnc:report-id report-obj)))) ((not budget-valid?) ;; No budget selected. (gnc:html-document-add-object! @@ -390,24 +390,24 @@ (retained-earnings #f) (liability-plus-equity #f) - - (table-env #f) ;; parameters for :make- - (params #f) ;; and -add-account- + + (table-env #f) ;; parameters for :make- + (params #f) ;; and -add-account- (asset-table #f) ;; gnc:html-acct-table (liability-table #f) ;; gnc:html-acct-table (equity-table #f) ;; gnc:html-acct-table ;; Create the account tables below where their ;; percentage time can be tracked. - (left-table (gnc:make-html-table)) ;; gnc:html-table - (right-table (if report-form? left-table - (gnc:make-html-table))) + (left-table (gnc:make-html-table)) ;; gnc:html-table + (right-table (if report-form? left-table + (gnc:make-html-table))) (budget-name (gnc-budget-get-name budget)) - ) - + ) - (gnc:report-percent-done 4) + + (gnc:report-percent-done 4) ;; Get asset account balances (positive). @@ -432,7 +432,7 @@ account))) - (gnc:report-percent-done 6) + (gnc:report-percent-done 6) ;; Get liability account balances (negative). @@ -457,7 +457,7 @@ account))) - (gnc:report-percent-done 8) + (gnc:report-percent-done 8) ;; Get equity account balances (negative). @@ -497,11 +497,11 @@ (set! new-liabilities (gnc:commodity-collector-get-negated liability-repayments)) - ;; Total liabilities. - (set! liability-balance + ;; Total liabilities. + (set! liability-balance (gnc:collector+ existing-liabilities new-liabilities)) - (gnc:report-percent-done 12) + (gnc:report-percent-done 12) ;; Total existing retained earnings. ;; existing retained earnings = initial income - initial expenses @@ -511,7 +511,7 @@ (gnc:budget-accountlist-get-initial-balance budget income-accounts) (gnc:budget-accountlist-get-initial-balance budget expense-accounts)))) - (gnc:report-percent-done 14) + (gnc:report-percent-done 14) ;; Total new retained earnings. (set! new-retained-earnings @@ -523,7 +523,7 @@ (set! retained-earnings (gnc:collector+ existing-retained-earnings new-retained-earnings)) - (gnc:report-percent-done 16) + (gnc:report-percent-done 16) ;; Total existing assets. (set! existing-assets @@ -544,10 +544,10 @@ liability-repayments)) ;; Total assets. - (set! asset-balance + (set! asset-balance (gnc:collector+ existing-assets allocated-assets unallocated-assets)) - (gnc:report-percent-done 18) + (gnc:report-percent-done 18) ;; Calculate unrealized gains. (let* ((get-total-value-fn @@ -566,7 +566,7 @@ (gnc:collector- existing-assets asset-basis) (gnc:collector- existing-liabilities liability-basis)))) - (gnc:report-percent-done 22) + (gnc:report-percent-done 22) ;; Total existing equity; negative. (set! existing-equity @@ -582,47 +582,47 @@ new-retained-earnings)) ;; Total equity. - (set! equity-balance + (set! equity-balance (gnc:collector+ existing-equity new-equity)) ;; Total liability + equity. - (set! liability-plus-equity + (set! liability-plus-equity (gnc:collector+ liability-balance equity-balance)) - (gnc:report-percent-done 30) - - (gnc:html-document-set-title! + (gnc:report-percent-done 30) + + (gnc:html-document-set-title! doc (string-append company-name " " report-title " " budget-name)) - (set! table-env - (list - (list 'start-date #f) - (list 'end-date #f) - (list 'display-tree-depth tree-depth) - (list 'depth-limit-behavior (if bottom-behavior - 'flatten - 'summarize)) - (list 'report-commodity report-commodity) - (list 'exchange-fn exchange-fn) - (list 'parent-account-subtotal-mode parent-total-mode) - (list 'zero-balance-mode (if show-zb-accts? - 'show-leaf-acct - 'omit-leaf-acct)) - (list 'account-label-mode (if use-links? - 'anchor - 'name)) - ) - ) - (set! params - (list - (list 'parent-account-balance-mode parent-balance-mode) - (list 'zero-balance-display-mode (if omit-zb-bals? - 'omit-balance - 'show-balance)) - (list 'multicommodity-mode (if show-fcur? 'table #f)) - (list 'rule-mode use-rules?) - ) - ) + (set! table-env + (list + (list 'start-date #f) + (list 'end-date #f) + (list 'display-tree-depth tree-depth) + (list 'depth-limit-behavior (if bottom-behavior + 'flatten + 'summarize)) + (list 'report-commodity report-commodity) + (list 'exchange-fn exchange-fn) + (list 'parent-account-subtotal-mode parent-total-mode) + (list 'zero-balance-mode (if show-zb-accts? + 'show-leaf-acct + 'omit-leaf-acct)) + (list 'account-label-mode (if use-links? + 'anchor + 'name)) + ) + ) + (set! params + (list + (list 'parent-account-balance-mode parent-balance-mode) + (list 'zero-balance-display-mode (if omit-zb-bals? + 'omit-balance + 'show-balance)) + (list 'multicommodity-mode (if show-fcur? 'table #f)) + (list 'rule-mode use-rules?) + ) + ) (let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60)))) (gnc:html-table-append-row! left-table space) @@ -630,13 +630,13 @@ (gnc:html-table-append-row! right-table space))) (gnc:report-percent-done 80) - (if label-assets? (add-subtotal-line left-table (G_ "Assets") #f #f)) - (set! asset-table + (if label-assets? (add-subtotal-line left-table (G_ "Assets") #f #f)) + (set! asset-table (gnc:make-html-acct-table/env/accts (append table-env (list (list 'get-balance-fn asset-get-balance-fn))) asset-accounts)) - (gnc:html-table-add-account-balances left-table asset-table params) + (gnc:html-table-add-account-balances left-table asset-table params) (if total-assets? (begin (if new-existing? @@ -652,23 +652,23 @@ (add-subtotal-line left-table (G_ "Total Assets") #f asset-balance))) - - (if report-form? - (add-rule left-table)) - (if report-form? - (add-rule left-table)) - - (gnc:report-percent-done 85) - (if label-liabilities? - (add-subtotal-line right-table (G_ "Liabilities") #f #f)) + + (if report-form? + (add-rule left-table)) + (if report-form? + (add-rule left-table)) + + (gnc:report-percent-done 85) + (if label-liabilities? + (add-subtotal-line right-table (G_ "Liabilities") #f #f)) (set! liability-table (gnc:make-html-acct-table/env/accts (append table-env (list (list 'get-balance-fn liability-get-balance-fn))) liability-accounts)) - (gnc:html-table-add-account-balances - right-table liability-table params) - (if total-liabilities? + (gnc:html-table-add-account-balances + right-table liability-table params) + (if total-liabilities? (begin (if new-existing? (begin @@ -681,22 +681,22 @@ (add-subtotal-line right-table (G_ "New Liabilities") #f new-liabilities))) - (add-subtotal-line + (add-subtotal-line right-table (G_ "Total Liabilities") #f liability-balance))) - - (add-rule right-table) - - (gnc:report-percent-done 88) - (if label-equity? - (add-subtotal-line - right-table (G_ "Equity") #f #f)) - (set! equity-table - (gnc:make-html-acct-table/env/accts + + (add-rule right-table) + + (gnc:report-percent-done 88) + (if label-equity? + (add-subtotal-line + right-table (G_ "Equity") #f #f)) + (set! equity-table + (gnc:make-html-acct-table/env/accts (append table-env (list (list 'get-balance-fn equity-get-balance-fn))) equity-accounts)) - (gnc:html-table-add-account-balances - right-table equity-table params) + (gnc:html-table-add-account-balances + right-table equity-table params) ;; we omit retianed earnings from the balance report, if zero, since ;; they are not present on normal balance sheets @@ -729,7 +729,7 @@ unrealized-gain)) - (if total-equity? + (if total-equity? (begin (if new-existing? (begin @@ -739,52 +739,52 @@ (add-subtotal-line right-table (G_ "New Equity") #f new-equity))) - (add-subtotal-line + (add-subtotal-line right-table (G_ "Total Equity") #f equity-balance))) - - (add-rule right-table) - + + (add-rule right-table) + (add-subtotal-line right-table (gnc:html-string-sanitize (G_ "Total Liabilities & Equity")) #f liability-plus-equity) - - (gnc:html-document-add-object! - doc - (if report-form? - left-table - (let* ((build-table (gnc:make-html-table)) - ) - (gnc:html-table-append-row! - build-table - (list - (gnc:make-html-table-cell left-table) - (gnc:make-html-table-cell right-table) - ) - ) - (gnc:html-table-set-style! - build-table "td" - 'attribute '("align" "left") - 'attribute '("valign" "top")) - build-table - ) - ) - ) - + + (gnc:html-document-add-object! + doc + (if report-form? + left-table + (let* ((build-table (gnc:make-html-table)) + ) + (gnc:html-table-append-row! + build-table + (list + (gnc:make-html-table-cell left-table) + (gnc:make-html-table-cell right-table) + ) + ) + (gnc:html-table-set-style! + build-table "td" + 'attribute '("align" "left") + 'attribute '("valign" "top")) + build-table + ) + ) + ) + ;; add currency information if requested - (gnc:report-percent-done 90) + (gnc:report-percent-done 90) (if show-rates? - (gnc:html-document-add-object! + (gnc:html-document-add-object! doc ;;(gnc:html-markup-p) (gnc:html-make-rates-table report-commodity price-fn accounts))) - (gnc:report-percent-done 100))))) - + (gnc:report-percent-done 100))))) + (gnc:report-finished) - + doc)) -(gnc:define-report +(gnc:define-report 'version 1 'name reportname 'report-guid "ecc35ea9dbfa4e20ba389fc85d59cb69" diff --git a/gnucash/report/reports/standard/budget-income-statement.scm b/gnucash/report/reports/standard/budget-income-statement.scm index 87fb10e1d6..4f7ec01f30 100644 --- a/gnucash/report/reports/standard/budget-income-statement.scm +++ b/gnucash/report/reports/standard/budget-income-statement.scm @@ -1,32 +1,32 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; budget-income-statement.scm: income statement (a.k.a. Profit & Loss) -;; +;; ;; Copyright (c) the following: ;; ;; Forest Bond ;; David Montenegro ;; ;; * BUGS: -;; +;; ;; Line & column alignments may still not conform with ;; textbook accounting practice (they're close though!). -;; +;; ;; Progress bar functionality is currently mostly broken. -;; +;; ;; The variables in this code could use more consistent naming. -;; +;; ;; See also all the "FIXME"s in the code. -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; @@ -164,7 +164,7 @@ ;; defined globally somewhere so we could reference it here. However, it ;; only appears to be defined currently in src/gnome/glade/budget.glade. 1 1 60 1) - + (gnc-register-number-range-option options gnc:pagename-general optname-budget-period-end "f" opthelp-budget-period-end @@ -172,16 +172,16 @@ ;; defined globally somewhere so we could reference it here. However, it ;; only appears to be defined currently in src/gnome/glade/budget.glade. 1 1 60 1) - + ;; accounts to work on (gnc-register-account-list-option options gnc:pagename-accounts optname-accounts "a" opthelp-accounts (gnc:filter-accountlist-type - ;; select, by default, only income and expense accounts - (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE) - (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) + ;; select, by default, only income and expense accounts + (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE) + (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) (gnc:options-add-account-levels! options gnc:pagename-accounts optname-depth-limit @@ -189,24 +189,24 @@ (gnc-register-simple-boolean-option options gnc:pagename-accounts optname-bottom-behavior "c" opthelp-bottom-behavior #f) - + ;; all about currencies (gnc:options-add-currency! options pagename-commodities optname-report-commodity "a") - - (gnc:options-add-price-source! + + (gnc:options-add-price-source! options pagename-commodities optname-price-source "b" 'pricedb-nearest) - + (gnc-register-simple-boolean-option options - pagename-commodities optname-show-foreign + pagename-commodities optname-show-foreign "c" opthelp-show-foreign #t) - + (gnc-register-simple-boolean-option options pagename-commodities optname-show-rates "d" opthelp-show-rates #f) - + ;; what to show for zero-balance accounts (gnc-register-simple-boolean-option options gnc:pagename-display optname-show-zb-accts @@ -227,14 +227,14 @@ (gnc-register-simple-boolean-option options gnc:pagename-display optname-use-rules "e" opthelp-use-rules #f) - + (gnc-register-simple-boolean-option options gnc:pagename-display optname-label-revenue "f" opthelp-label-revenue #t) (gnc-register-simple-boolean-option options gnc:pagename-display optname-total-revenue "g" opthelp-total-revenue #t) - + (gnc-register-simple-boolean-option options gnc:pagename-display optname-label-expense "h" opthelp-label-expense #t) @@ -249,10 +249,10 @@ (gnc-register-simple-boolean-option options gnc:pagename-display optname-standard-order "k" opthelp-standard-order #t) - + ;; Set the accounts page as default option tab (gnc:options-set-default-section options gnc:pagename-accounts) - + options)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -264,7 +264,7 @@ (define (get-option pagename optname) (gnc-optiondb-lookup-value (gnc:report-options report-obj) pagename optname)) - + (define (get-assoc-account-balances-budget budget accountlist period-start period-end get-balance-fn) (gnc:get-assoc-account-balances @@ -276,11 +276,11 @@ (if (gnc-reverse-balance account) (gnc:collector- bal) bal))) (gnc:report-starting reportname) - + ;; get all option's values (let* ( - (report-title (get-option gnc:pagename-general optname-report-title)) - (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) "")) + (report-title (get-option gnc:pagename-general optname-report-title)) + (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) "")) (budget (get-option gnc:pagename-general optname-budget)) (budget-valid? (and budget (not (null? budget)))) (use-budget-period-range? @@ -308,11 +308,11 @@ (if use-budget-period-range? period-start 0)) #f)) (accounts (get-option gnc:pagename-accounts - optname-accounts)) - (depth-limit (get-option gnc:pagename-accounts - optname-depth-limit)) - (bottom-behavior (get-option gnc:pagename-accounts - optname-bottom-behavior)) + optname-accounts)) + (depth-limit (get-option gnc:pagename-accounts + optname-depth-limit)) + (bottom-behavior (get-option gnc:pagename-accounts + optname-bottom-behavior)) (report-commodity (get-option pagename-commodities optname-report-commodity)) (price-source (get-option pagename-commodities @@ -324,62 +324,62 @@ (parent-balance-mode (get-option gnc:pagename-display optname-parent-balance-mode)) (parent-total-mode - (assq-ref '((t . #t) (f . #f)) - (get-option gnc:pagename-display - optname-parent-total-mode))) + (assq-ref '((t . #t) (f . #f)) + (get-option gnc:pagename-display + optname-parent-total-mode))) (show-zb-accts? (get-option gnc:pagename-display - optname-show-zb-accts)) + optname-show-zb-accts)) (omit-zb-bals? (get-option gnc:pagename-display - optname-omit-zb-bals)) + optname-omit-zb-bals)) (label-revenue? (get-option gnc:pagename-display - optname-label-revenue)) + optname-label-revenue)) (total-revenue? (get-option gnc:pagename-display - optname-total-revenue)) + optname-total-revenue)) (label-expense? (get-option gnc:pagename-display - optname-label-expense)) + optname-label-expense)) (total-expense? (get-option gnc:pagename-display - optname-total-expense)) + optname-total-expense)) (use-links? (get-option gnc:pagename-display - optname-account-links)) + optname-account-links)) (use-rules? (get-option gnc:pagename-display - optname-use-rules)) - (two-column? (get-option gnc:pagename-display - optname-two-column)) - (standard-order? (get-option gnc:pagename-display - optname-standard-order)) - + optname-use-rules)) + (two-column? (get-option gnc:pagename-display + optname-two-column)) + (standard-order? (get-option gnc:pagename-display + optname-standard-order)) + ;; decompose the account list (split-up-accounts (gnc:decompose-accountlist accounts)) - (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME)) - (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)) - + (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME)) + (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)) + (doc (gnc:make-html-document)) - ;; this can occasionally put extra (blank) columns in our - ;; table (when there is one account at the maximum depth and - ;; it has at least one of its ancestors deselected), but this - ;; is the only simple way to ensure that both tables - ;; (revenue, expense) have the same width. + ;; this can occasionally put extra (blank) columns in our + ;; table (when there is one account at the maximum depth and + ;; it has at least one of its ancestors deselected), but this + ;; is the only simple way to ensure that both tables + ;; (revenue, expense) have the same width. (tree-depth (if (equal? depth-limit 'all) - (gnc:get-current-account-tree-depth) - depth-limit)) + (gnc:get-current-account-tree-depth) + depth-limit)) ;; exchange rates calculation parameters - (exchange-fn - (gnc:case-exchange-fn price-source report-commodity date-t64)) + (exchange-fn + (gnc:case-exchange-fn price-source report-commodity date-t64)) (price-fn (gnc:case-price-fn price-source report-commodity date-t64))) - + (define (add-subtotal-line table pos-label neg-label signed-balance) (let* ((neg? (and signed-balance neg-label - (negative? - (gnc:gnc-monetary-amount - (gnc:sum-collector-commodity - signed-balance report-commodity exchange-fn))))) - (label (if neg? (or neg-label pos-label) pos-label)) - (balance (if neg? (gnc:collector- signed-balance) signed-balance))) - (gnc:html-table-add-labeled-amount-line! - table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell" - (gnc:sum-collector-commodity balance report-commodity exchange-fn) - (1- (* tree-depth 2)) 1 "total-number-cell"))) + (negative? + (gnc:gnc-monetary-amount + (gnc:sum-collector-commodity + signed-balance report-commodity exchange-fn))))) + (label (if neg? (or neg-label pos-label) pos-label)) + (balance (if neg? (gnc:collector- signed-balance) signed-balance))) + (gnc:html-table-add-labeled-amount-line! + table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell" + (gnc:sum-collector-commodity balance report-commodity exchange-fn) + (1- (* tree-depth 2)) 1 "total-number-cell"))) (cond ((null? accounts) @@ -569,9 +569,9 @@ (gnc:html-document-add-object! doc (gnc:html-make-rates-table report-commodity price-fn accounts))) (gnc:report-percent-done 100)))) - + (gnc:report-finished) - + doc)) (define is-reportname (N_ "Budget Income Statement")) @@ -588,7 +588,7 @@ (budget-income-statement-renderer-internal report-obj is-reportname)) -(gnc:define-report +(gnc:define-report 'version 1 'name is-reportname 'report-guid "583c313fcc484efc974c4c844404f454" @@ -599,7 +599,7 @@ ;; Also make a "Profit & Loss" report, even if it's the exact same one, ;; just relabeled. -(gnc:define-report +(gnc:define-report 'version 1 'name pnl-reportname 'report-guid "e5fa5ce805e840ecbeca4dba3fa4ead9" diff --git a/gnucash/report/reports/standard/equity-statement.scm b/gnucash/report/reports/standard/equity-statement.scm index e30c652282..2d5354db92 100644 --- a/gnucash/report/reports/standard/equity-statement.scm +++ b/gnucash/report/reports/standard/equity-statement.scm @@ -1,41 +1,41 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; equity-statement.scm: statement of owner's equity (net worth) -;; +;; ;; By David Montenegro 2004.06.23 -;; +;; ;; * Based on balance-sheet.scm by Robert Merkel -;; +;; ;; * BUGS: -;; +;; ;; The multicurrency support has NOT been tested and IS ALPHA. I ;; really don't if I used the correct exchange functions. Search ;; code for regexp "*exchange-fn". -;; +;; ;; I have also made the educated assumption that a decrease ;; in the value of a liability or equity also represents an ;; unrealized loss. I *think* that is right, but am not sure. -;; +;; ;; This code makes the assumption that you want your equity ;; statement to no more than daily resolution. -;; +;; ;; The Accounts option panel needs a way to select (and select by ;; default) capital and draw accounts. There really should be a ;; contra account type or attribute.... -;; +;; ;; The variables in this code could use more consistent naming. -;; +;; ;; See also any "FIXME"s in the code. ;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; @@ -96,22 +96,22 @@ ;; options generator (define (equity-statement-options-generator) (let* ((options (gnc-new-optiondb))) - + (gnc-register-string-option options (N_ "General") optname-report-title "a" opthelp-report-title (G_ reportname)) - + ;; date at which to report balance (gnc:options-add-date-interval! - options gnc:pagename-general + options gnc:pagename-general optname-start-date optname-end-date "c") - + ;; accounts to work on (gnc-register-account-list-option options gnc:pagename-accounts optname-accounts "a" opthelp-accounts - (gnc:filter-accountlist-type + (gnc:filter-accountlist-type (list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CREDIT ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY @@ -119,31 +119,31 @@ ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE ACCT-TYPE-TRADING) (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) - + ;; all about currencies (gnc:options-add-currency! options pagename-commodities optname-report-commodity "a") - - (gnc:options-add-price-source! + + (gnc:options-add-price-source! options pagename-commodities optname-price-source "b" 'pricedb-nearest) - + (gnc-register-simple-boolean-option options - pagename-commodities optname-show-foreign + pagename-commodities optname-show-foreign "c" opthelp-show-foreign #t) - + (gnc-register-simple-boolean-option options pagename-commodities optname-show-rates "d" opthelp-show-rates #f) - + ;; some detailed formatting options (gnc-register-simple-boolean-option options gnc:pagename-display optname-use-rules "f" opthelp-use-rules #f) - + ;; closing entry match criteria - ;; + ;; ;; N.B.: transactions really should have a field where we can put ;; transaction types like "Adjusting/Closing/Correcting Entries" (gnc-register-string-option options @@ -155,10 +155,10 @@ (gnc-register-simple-boolean-option options pagename-entries optname-closing-regexp "c" opthelp-closing-regexp #f) - + ;; Set the accounts page as default option tab (gnc:options-set-default-section options gnc:pagename-accounts) - + options)) (define (account-get-total-flow direction target-account-list from-date to-date) @@ -190,30 +190,30 @@ (define (get-option pagename optname) (gnc-optiondb-lookup-value (gnc:report-options report-obj) pagename optname)) - + (gnc:report-starting reportname) - + ;; get all option's values (let* ( - (report-title (get-option gnc:pagename-general optname-report-title)) - (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) "")) - ;; this code makes the assumption that you want your equity - ;; statement to no more than daily resolution + (report-title (get-option gnc:pagename-general optname-report-title)) + (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) "")) + ;; this code makes the assumption that you want your equity + ;; statement to no more than daily resolution (start-date-printable (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-start-date))) + (get-option gnc:pagename-general + optname-start-date))) (start-date (gnc:time64-end-day-time - (gnc:time64-previous-day start-date-printable))) - (end-date (gnc:time64-end-day-time - (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-end-date)))) + (gnc:time64-previous-day start-date-printable))) + (end-date (gnc:time64-end-day-time + (gnc:date-option-absolute-time + (get-option gnc:pagename-general + optname-end-date)))) ;;(end-date-printable (gnc:date-option-absolute-time ;; (get-option gnc:pagename-general ;; optname-end-date))) - ;; why dont we use this? why use any -printable at all? + ;; why dont we use this? why use any -printable at all? (accounts (get-option gnc:pagename-accounts - optname-accounts)) + optname-accounts)) (report-commodity (get-option pagename-commodities optname-report-commodity)) (price-source (get-option pagename-commodities @@ -221,14 +221,14 @@ (show-rates? (get-option pagename-commodities optname-show-rates)) (use-rules? (get-option gnc:pagename-display - optname-use-rules)) - (closing-str (get-option pagename-entries - optname-closing-pattern)) - (closing-cased (get-option pagename-entries - optname-closing-casing)) - (closing-regexp (get-option pagename-entries - optname-closing-regexp)) - + optname-use-rules)) + (closing-str (get-option pagename-entries + optname-closing-pattern)) + (closing-cased (get-option pagename-entries + optname-closing-casing)) + (closing-regexp (get-option pagename-entries + optname-closing-regexp)) + ;; decompose the account list (split-up-accounts (gnc:decompose-accountlist accounts)) (asset-accounts @@ -242,28 +242,28 @@ (equity-accounts (assoc-ref split-up-accounts ACCT-TYPE-EQUITY)) - (closing-pattern - (list (list 'str closing-str) - (list 'cased closing-cased) - (list 'regexp closing-regexp) - (list 'positive #f) - (list 'closing #t))) + (closing-pattern + (list (list 'str closing-str) + (list 'cased closing-cased) + (list 'regexp closing-regexp) + (list 'positive #f) + (list 'closing #t))) (doc (gnc:make-html-document)) ;; exchange rates calculation parameters - (start-exchange-fn - (gnc:case-exchange-fn - price-source report-commodity start-date)) - (end-exchange-fn - (gnc:case-exchange-fn - price-source report-commodity end-date)) + (start-exchange-fn + (gnc:case-exchange-fn + price-source report-commodity start-date)) + (end-exchange-fn + (gnc:case-exchange-fn + price-source report-commodity end-date)) (start-price-fn (gnc:case-price-fn price-source report-commodity start-date)) (end-price-fn (gnc:case-price-fn price-source report-commodity end-date))) (define (unrealized-gains-at-date book-balance exchange-fn date) (define cost-fn - (gnc:case-exchange-fn 'average-cost report-commodity date)) + (gnc:case-exchange-fn 'average-cost report-commodity date)) (gnc:monetaries-add (gnc:sum-collector-commodity book-balance report-commodity exchange-fn) (gnc:monetary-neg @@ -275,23 +275,23 @@ (define (get-end-balance-fn account) (gnc:account-get-comm-balance-at-date account end-date #f)) - (gnc:html-document-set-title! + (gnc:html-document-set-title! doc (gnc:format (G_ "${company-name} ${report-title} For Period Covering ${start} to ${end}") 'company-name company-name 'report-title report-title 'start (qof-print-date start-date-printable) 'end (qof-print-date end-date))) - + (if (null? accounts) - + ;; error condition: no accounts specified is this *really* - ;; necessary?? i'd be fine with an all-zero income statement - ;; that would, technically, be correct.... - (gnc:html-document-add-object! - doc - (gnc:html-make-no-account-warning - reportname (gnc:report-id report-obj))) - + ;; necessary?? i'd be fine with an all-zero income statement + ;; that would, technically, be correct.... + (gnc:html-document-add-object! + doc + (gnc:html-make-no-account-warning + reportname (gnc:report-id report-obj))) + ;; Get all the balances for each account group. (let* ((start-asset-balance (gnc:accounts-get-comm-total-assets @@ -311,11 +311,11 @@ (neg-pre-start-retained-earnings (gnc:accountlist-get-comm-balance-at-date-with-closing - income-expense-accounts start-date)) + income-expense-accounts start-date)) (neg-pre-end-retained-earnings (gnc:accountlist-get-comm-balance-at-date-with-closing - income-expense-accounts end-date)) + income-expense-accounts end-date)) (income-expense-closing (gnc:account-get-trans-type-balance-interval-with-closing @@ -324,7 +324,7 @@ (net-income (gnc:collector- income-expense-closing - (gnc:accountlist-get-comm-balance-interval-with-closing + (gnc:accountlist-get-comm-balance-interval-with-closing income-expense-accounts start-date end-date))) (neg-start-equity-balance @@ -337,9 +337,9 @@ (start-book-balance (gnc:collector+ start-asset-balance - neg-start-liability-balance - neg-start-equity-balance - neg-pre-start-retained-earnings)) + neg-start-liability-balance + neg-start-equity-balance + neg-pre-start-retained-earnings)) (end-book-balance (gnc:collector+ end-asset-balance @@ -347,18 +347,18 @@ neg-end-equity-balance neg-pre-end-retained-earnings)) - (start-unrealized-gains + (start-unrealized-gains (unrealized-gains-at-date start-book-balance - start-exchange-fn - start-date)) + start-exchange-fn + start-date)) - (net-unrealized-gains + (net-unrealized-gains (gnc:collector- (unrealized-gains-at-date end-book-balance end-exchange-fn end-date) start-unrealized-gains)) - (equity-closing + (equity-closing (gnc:account-get-trans-type-balance-interval-with-closing equity-accounts closing-pattern start-date end-date)) @@ -366,16 +366,16 @@ (gnc:collector- neg-end-equity-balance equity-closing)) - (net-investment + (net-investment (gnc:collector- neg-start-equity-balance neg-pre-closing-equity)) ;; calculate investments & draws... - ;; do a transaction query and classify the splits by dr/cr. - ;; assume that positive shares on an equity account are debits - ;; withdrawals = investments - (investments - withdrawals) - ;; investments = withdrawals + (investments - withdrawals) - (withdrawals + ;; do a transaction query and classify the splits by dr/cr. + ;; assume that positive shares on an equity account are debits + ;; withdrawals = investments - (investments - withdrawals) + ;; investments = withdrawals + (investments - withdrawals) + (withdrawals (account-get-total-flow 'in equity-accounts start-date end-date)) (investments @@ -387,37 +387,37 @@ net-unrealized-gains (gnc:collector- withdrawals))) - (start-total-equity + (start-total-equity (gnc:collector- start-unrealized-gains neg-start-equity-balance neg-pre-start-retained-earnings)) - (end-total-equity + (end-total-equity (gnc:collector+ start-total-equity capital-increase)) - ;; Create the account table below where its - ;; percentage time can be tracked. - (build-table (gnc:make-html-table)) ;; gnc:html-table - (period-for (string-append " " (G_ "for Period")))) + ;; Create the account table below where its + ;; percentage time can be tracked. + (build-table (gnc:make-html-table)) ;; gnc:html-table + (period-for (string-append " " (G_ "for Period")))) - ;; a helper to add a line to our report - (define (add-report-line + ;; a helper to add a line to our report + (define (add-report-line table pos-label neg-label amount col - exchange-fn rule? row-style) - (let* ((neg? (and amount neg-label - (negative? - (gnc:gnc-monetary-amount - (gnc:sum-collector-commodity - amount report-commodity exchange-fn))))) - (label (if neg? (or neg-label pos-label) pos-label)) - (pos-bal (if neg? (gnc:collector- amount) amount))) - (gnc:html-table-add-labeled-amount-line! + exchange-fn rule? row-style) + (let* ((neg? (and amount neg-label + (negative? + (gnc:gnc-monetary-amount + (gnc:sum-collector-commodity + amount report-commodity exchange-fn))))) + (label (if neg? (or neg-label pos-label) pos-label)) + (pos-bal (if neg? (gnc:collector- amount) amount))) + (gnc:html-table-add-labeled-amount-line! table 3 row-style rule? label 0 1 "text-cell" - (gnc:sum-collector-commodity pos-bal report-commodity exchange-fn) + (gnc:sum-collector-commodity pos-bal report-commodity exchange-fn) (1+ col) 1 "number-cell"))) - (gnc:report-percent-done 30) + (gnc:report-percent-done 30) (gnc:html-table-append-row! build-table (make-list 2 (gnc:make-html-table-cell/min-width 60))) @@ -467,38 +467,38 @@ 1 end-exchange-fn #f "primary-subheading") (gnc:html-document-add-object! doc build-table) - + ;; add currency information if requested - (gnc:report-percent-done 90) + (gnc:report-percent-done 90) (when show-rates? - (let* ((curr-tbl (gnc:make-html-table)) - (headers (list - (qof-print-date start-date-printable) - (qof-print-date end-date))) - (then (gnc:html-make-rates-table - report-commodity start-price-fn accounts)) - (now (gnc:html-make-rates-table + (let* ((curr-tbl (gnc:make-html-table)) + (headers (list + (qof-print-date start-date-printable) + (qof-print-date end-date))) + (then (gnc:html-make-rates-table + report-commodity start-price-fn accounts)) + (now (gnc:html-make-rates-table report-commodity end-price-fn accounts))) - (gnc:html-table-set-col-headers! curr-tbl headers) - (gnc:html-table-set-style! - curr-tbl "table" 'attribute '("border" "1")) - (gnc:html-table-set-style! - then "table" 'attribute '("border" "0")) - (gnc:html-table-set-style! - now "table" 'attribute '("border" "0")) - (gnc:html-table-append-ruler! build-table 3) - (gnc:html-table-append-row! curr-tbl (list then now)) - (gnc:html-document-add-object! doc curr-tbl))) - - (gnc:report-percent-done 100))) - + (gnc:html-table-set-col-headers! curr-tbl headers) + (gnc:html-table-set-style! + curr-tbl "table" 'attribute '("border" "1")) + (gnc:html-table-set-style! + then "table" 'attribute '("border" "0")) + (gnc:html-table-set-style! + now "table" 'attribute '("border" "0")) + (gnc:html-table-append-ruler! build-table 3) + (gnc:html-table-append-row! curr-tbl (list then now)) + (gnc:html-document-add-object! doc curr-tbl))) + + (gnc:report-percent-done 100))) + (gnc:report-finished) - + doc ) ) -(gnc:define-report +(gnc:define-report 'version 1 'name reportname 'report-guid "c2a996c8970f43448654ca84f17dda24" diff --git a/gnucash/report/reports/standard/income-statement.scm b/gnucash/report/reports/standard/income-statement.scm index e93abe4c23..08db21b96d 100644 --- a/gnucash/report/reports/standard/income-statement.scm +++ b/gnucash/report/reports/standard/income-statement.scm @@ -1,33 +1,33 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; income-statement.scm: income statement (a.k.a. Profit & Loss) -;; +;; ;; By David Montenegro ;; 2004.07.13 - 2004.07.14 ;; ;; * BUGS: -;; +;; ;; This code makes the assumption that you want your income ;; statement to no more than daily resolution. -;; +;; ;; Line & column alignments may still not conform with ;; textbook accounting practice (they're close though!). -;; +;; ;; Progress bar functionality is currently mostly broken. -;; +;; ;; The variables in this code could use more consistent naming. -;; +;; ;; See also all the "FIXME"s in the code. -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; @@ -135,21 +135,21 @@ (gnc-register-string-option options gnc:pagename-general optname-report-title "a" opthelp-report-title (G_ reportname)) - + ;; period over which to report income (gnc:options-add-date-interval! - options gnc:pagename-general + options gnc:pagename-general optname-start-date optname-end-date "c") - + ;; accounts to work on (gnc-register-account-list-option options gnc:pagename-accounts optname-accounts "a" opthelp-accounts - (gnc:filter-accountlist-type - ;; select, by default, only income and expense accounts - (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE) - (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) + (gnc:filter-accountlist-type + ;; select, by default, only income and expense accounts + (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE) + (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) (gnc:options-add-account-levels! options gnc:pagename-accounts optname-depth-limit @@ -157,20 +157,20 @@ (gnc-register-simple-boolean-option options gnc:pagename-accounts optname-bottom-behavior "c" opthelp-bottom-behavior #f) - + ;; all about currencies (gnc:options-add-currency! options pagename-commodities optname-report-commodity "a") - - (gnc:options-add-price-source! + + (gnc:options-add-price-source! options pagename-commodities optname-price-source "b" 'pricedb-nearest) (gnc-register-simple-boolean-option options - pagename-commodities optname-show-foreign + pagename-commodities optname-show-foreign "c" opthelp-show-foreign #t) - + (gnc-register-simple-boolean-option options pagename-commodities optname-show-rates "d" opthelp-show-rates #f) @@ -195,21 +195,21 @@ (gnc-register-simple-boolean-option options gnc:pagename-display optname-use-rules "f" opthelp-use-rules #f) - + (gnc-register-simple-boolean-option options gnc:pagename-display optname-label-revenue "g" opthelp-label-revenue #t) (gnc-register-simple-boolean-option options gnc:pagename-display optname-total-revenue "h" opthelp-total-revenue #t) - + (gnc-register-simple-boolean-option options gnc:pagename-display optname-label-trading "h1" opthelp-label-trading #t) (gnc-register-simple-boolean-option options gnc:pagename-display optname-total-trading "h2" opthelp-total-trading #t) - + (gnc-register-simple-boolean-option options gnc:pagename-display optname-label-expense "i" opthelp-label-expense #t) @@ -224,9 +224,9 @@ (gnc-register-simple-boolean-option options gnc:pagename-display optname-standard-order "l" opthelp-standard-order #t) - + ;; closing entry match criteria - ;; + ;; ;; N.B.: transactions really should have a field where we can put ;; transaction types like "Adjusting/Closing/Correcting Entries" (gnc-register-string-option options @@ -238,10 +238,10 @@ (gnc-register-simple-boolean-option options pagename-entries optname-closing-regexp "c" opthelp-closing-regexp #f) - + ;; Set the accounts page as default option tab (gnc:options-set-default-section options gnc:pagename-accounts) - + options)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -255,28 +255,28 @@ (gnc:report-options report-obj) pagename optname)) (gnc:report-starting reportname) - + ;; get all option's values (let* ( - (report-title (get-option gnc:pagename-general optname-report-title)) - (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) "")) + (report-title (get-option gnc:pagename-general optname-report-title)) + (company-name (or (gnc:company-info (gnc-get-current-book) gnc:*company-name*) "")) (start-date-printable (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-start-date))) + (get-option gnc:pagename-general + optname-start-date))) (start-date (gnc:time64-start-day-time - (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-start-date)))) + (gnc:date-option-absolute-time + (get-option gnc:pagename-general + optname-start-date)))) (end-date (gnc:time64-end-day-time - (gnc:date-option-absolute-time - (get-option gnc:pagename-general - optname-end-date)))) + (gnc:date-option-absolute-time + (get-option gnc:pagename-general + optname-end-date)))) (accounts (get-option gnc:pagename-accounts - optname-accounts)) - (depth-limit (get-option gnc:pagename-accounts - optname-depth-limit)) - (bottom-behavior (get-option gnc:pagename-accounts - optname-bottom-behavior)) + optname-accounts)) + (depth-limit (get-option gnc:pagename-accounts + optname-depth-limit)) + (bottom-behavior (get-option gnc:pagename-accounts + optname-bottom-behavior)) (report-commodity (get-option pagename-commodities optname-report-commodity)) (price-source (get-option pagename-commodities @@ -288,63 +288,63 @@ (parent-balance-mode (get-option gnc:pagename-display optname-parent-balance-mode)) (parent-total-mode - (assq-ref '((t . #t) (f . #f)) - (get-option gnc:pagename-display - optname-parent-total-mode))) + (assq-ref '((t . #t) (f . #f)) + (get-option gnc:pagename-display + optname-parent-total-mode))) (show-zb-accts? (get-option gnc:pagename-display - optname-show-zb-accts)) + optname-show-zb-accts)) (omit-zb-bals? (get-option gnc:pagename-display - optname-omit-zb-bals)) + optname-omit-zb-bals)) (label-revenue? (get-option gnc:pagename-display - optname-label-revenue)) + optname-label-revenue)) (total-revenue? (get-option gnc:pagename-display - optname-total-revenue)) + optname-total-revenue)) (label-trading? (get-option gnc:pagename-display - optname-label-trading)) + optname-label-trading)) (total-trading? (get-option gnc:pagename-display - optname-total-trading)) + optname-total-trading)) (label-expense? (get-option gnc:pagename-display - optname-label-expense)) + optname-label-expense)) (total-expense? (get-option gnc:pagename-display - optname-total-expense)) + optname-total-expense)) (use-links? (get-option gnc:pagename-display - optname-account-links)) + optname-account-links)) (use-rules? (get-option gnc:pagename-display - optname-use-rules)) - (closing-str (get-option pagename-entries - optname-closing-pattern)) - (closing-cased (get-option pagename-entries - optname-closing-casing)) - (closing-regexp (get-option pagename-entries - optname-closing-regexp)) - (two-column? (get-option gnc:pagename-display - optname-two-column)) - (standard-order? (get-option gnc:pagename-display - optname-standard-order)) - (closing-pattern - (list (list 'str closing-str) - (list 'cased closing-cased) - (list 'regexp closing-regexp) - (list 'closing #t))) + optname-use-rules)) + (closing-str (get-option pagename-entries + optname-closing-pattern)) + (closing-cased (get-option pagename-entries + optname-closing-casing)) + (closing-regexp (get-option pagename-entries + optname-closing-regexp)) + (two-column? (get-option gnc:pagename-display + optname-two-column)) + (standard-order? (get-option gnc:pagename-display + optname-standard-order)) + (closing-pattern + (list (list 'str closing-str) + (list 'cased closing-cased) + (list 'regexp closing-regexp) + (list 'closing #t))) ;; decompose the account list (split-up-accounts (gnc:decompose-accountlist accounts)) - (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME)) - (trading-accounts (assoc-ref split-up-accounts ACCT-TYPE-TRADING)) - (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)) - + (revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME)) + (trading-accounts (assoc-ref split-up-accounts ACCT-TYPE-TRADING)) + (expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)) + (doc (gnc:make-html-document)) - ;; this can occasionally put extra (blank) columns in our - ;; table (when there is one account at the maximum depth and - ;; it has at least one of its ancestors deselected), but this - ;; is the only simple way to ensure that both tables - ;; (revenue, expense) have the same width. + ;; this can occasionally put extra (blank) columns in our + ;; table (when there is one account at the maximum depth and + ;; it has at least one of its ancestors deselected), but this + ;; is the only simple way to ensure that both tables + ;; (revenue, expense) have the same width. (tree-depth (if (equal? depth-limit 'all) - (gnc:get-current-account-tree-depth) - depth-limit)) + (gnc:get-current-account-tree-depth) + depth-limit)) ;; exchange rates calculation parameters - (exchange-fn - (gnc:case-exchange-fn price-source report-commodity end-date)) + (exchange-fn + (gnc:case-exchange-fn price-source report-commodity end-date)) (price-fn (gnc:case-price-fn price-source report-commodity end-date))) ;; Wrapper to call gnc:html-table-add-labeled-amount-line! @@ -563,7 +563,7 @@ (income-statement-renderer-internal report-obj pnl-reportname)) -(gnc:define-report +(gnc:define-report 'version 1 'name is-reportname 'report-guid "0b81a3bdfd504aff849ec2e8630524bc" @@ -573,7 +573,7 @@ ;; Also make a "Profit & Loss" report, even if it's the exact same one, ;; just relabeled. -(gnc:define-report +(gnc:define-report 'version 1 'name pnl-reportname 'report-guid "8758ba23984c40dea5527f5f0ca2779e" diff --git a/gnucash/report/reports/standard/portfolio.scm b/gnucash/report/reports/standard/portfolio.scm index 09ac1287a8..19432a30f0 100644 --- a/gnucash/report/reports/standard/portfolio.scm +++ b/gnucash/report/reports/standard/portfolio.scm @@ -95,9 +95,9 @@ exchange-fn price-fn include-empty collector) (let ((share-print-info - (gnc-share-print-info-places - (inexact->exact (get-option gnc:pagename-general - optname-shares-digits))))) + (gnc-share-print-info-places + (inexact->exact (get-option gnc:pagename-general + optname-shares-digits))))) (define (table-add-stock-rows-internal accounts odd-row?) (if (null? accounts) collector @@ -123,30 +123,30 @@ (value (exchange-fn (gnc:make-gnc-monetary commodity units) currency))) - (set! work-done (+ 1 work-done)) - (gnc:report-percent-done (* 100 (/ work-done work-to-do))) - (if (or include-empty (not (gnc-numeric-zero-p units))) - (begin (collector 'add currency (gnc:gnc-monetary-amount value)) - (gnc:html-table-append-row/markup! - table - row-style - (list (gnc:html-account-anchor current) - (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol) - (gnc:make-html-table-header-cell/markup "text-cell" listing) - (gnc:make-html-table-header-cell/markup - "number-cell" - (xaccPrintAmount units share-print-info)) - (gnc:make-html-table-header-cell/markup - "number-cell" + (set! work-done (+ 1 work-done)) + (gnc:report-percent-done (* 100 (/ work-done work-to-do))) + (if (or include-empty (not (gnc-numeric-zero-p units))) + (begin (collector 'add currency (gnc:gnc-monetary-amount value)) + (gnc:html-table-append-row/markup! + table + row-style + (list (gnc:html-account-anchor current) + (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol) + (gnc:make-html-table-header-cell/markup "text-cell" listing) + (gnc:make-html-table-header-cell/markup + "number-cell" + (xaccPrintAmount units share-print-info)) + (gnc:make-html-table-header-cell/markup + "number-cell" (gnc:html-price-anchor price price-monetary)) - (gnc:make-html-table-header-cell/markup - "number-cell" value))) - ;;(display (format #f "Shares: ~6d " (gnc-numeric-to-double units))) - ;;(display units) (newline) - (if price (gnc-price-unref price)) - (table-add-stock-rows-internal rest (not odd-row?))) - (begin (if price (gnc-price-unref price)) - (table-add-stock-rows-internal rest odd-row?)))))) + (gnc:make-html-table-header-cell/markup + "number-cell" value))) + ;;(display (format #f "Shares: ~6d " (gnc-numeric-to-double units))) + ;;(display units) (newline) + (if price (gnc-price-unref price)) + (table-add-stock-rows-internal rest (not odd-row?))) + (begin (if price (gnc-price-unref price)) + (table-add-stock-rows-internal rest odd-row?)))))) (set! work-to-do (length accounts)) (table-add-stock-rows-internal accounts #t))) @@ -185,7 +185,7 @@ (gnc-accounts-and-all-descendants accounts) currency)) (pricedb (gnc-pricedb-get-db (gnc-get-current-book))) - (exchange-fn (gnc:case-exchange-fn price-source currency to-date)) + (exchange-fn (gnc:case-exchange-fn price-source currency to-date)) (price-fn (case price-source ((weighted-average average-cost) @@ -277,8 +277,8 @@ ;if no accounts selected. (gnc:html-document-add-object! document - (gnc:html-make-no-account-warning - report-title (gnc:report-id report-obj)))) + (gnc:html-make-no-account-warning + report-title (gnc:report-id report-obj)))) (gnc:report-finished) document))) diff --git a/gnucash/report/reports/standard/price-scatter.scm b/gnucash/report/reports/standard/price-scatter.scm index 1aef71ea26..4c14c69e6b 100644 --- a/gnucash/report/reports/standard/price-scatter.scm +++ b/gnucash/report/reports/standard/price-scatter.scm @@ -154,7 +154,7 @@ (currency-accounts (filter gnc:account-has-shares? (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))) - (invert (get-option pagename-price optname-invert)) + (invert (get-option pagename-price optname-invert)) (amount-commodity (if invert price-commodity report-currency)) (base-commodity (if invert report-currency price-commodity)) (int-label (car (assq-ref intervals interval))) diff --git a/gnucash/report/reports/standard/taxinvoice.scm b/gnucash/report/reports/standard/taxinvoice.scm index b74ab513df..0991f9bbc0 100644 --- a/gnucash/report/reports/standard/taxinvoice.scm +++ b/gnucash/report/reports/standard/taxinvoice.scm @@ -1,4 +1,3 @@ - ;; $Author: chris $ $Date: 2009/07/29 09:31:44 $ $Revision: 1.33 $ ;; Modified by Dmitry Smirnov 16 Feb 2012 ;; @@ -69,48 +68,48 @@ (define headingpage2 (N_ "Headings 2")) (define notespage (N_ "Notes")) (define displaypage (N_ "Display")) -(define elementspage (N_ "Elements")) -; option names -(define optname-col-date (N_ "column: Date")) -(define optname-col-taxrate (N_ "column: Tax Rate")) -(define optname-col-units (N_ "column: Units")) -(define optname-row-address (N_ "row: Address")) -(define optname-row-contact (N_ "row: Contact")) -(define optname-row-invoice-number (N_ "row: Invoice Number")) -(define optname-row-company-name (N_ "row: Company Name")) -(define optname-invoice-number-text (N_ "Invoice number text")) -(define optname-to-text (N_ "To text")) -(define optname-ref-text (N_ "Ref text")) -(define optname-jobname-text (N_ "Job Name text")) -(define optname-jobnumber-text (N_ "Job Number text")) -(define optname-jobname-show (N_ "Show Job name")) -(define optname-jobnumber-show (N_ "Show Job number")) -(define optname-netprice (N_ "Show net price")) -(define optname-invnum-next-to-title (N_ "Invoice number next to title")) -(define optname-border-collapse (N_ "table-border-collapse")) -(define optname-border-color-th (N_ "table-header-border-color")) -(define optname-border-color-td (N_ "table-cell-border-color")) -(define optname-extra-css (N_ "Embedded CSS")) -(define optname-report-title (N_ "Report Title")) -(define optname-template-file (N_ "Template file")) -(define optname-css-file (N_ "CSS stylesheet file")) -(define optname-heading-font (N_ "Heading font")) -(define optname-text-font (N_ "Text font")) -(define optname-logofile (N_ "Logo filename")) -(define optname-logo-width (N_ "Logo width")) -(define optname-units (N_ "Units")) -(define optname-qty (N_ "Qty")) -(define optname-unit-price (N_ "Unit Price")) -(define optname-disc-rate (N_ "Discount Rate")) -(define optname-disc-amount (N_ "Discount Amount")) -(define optname-net-price (N_ "Net Price")) -(define optname-tax-rate (N_ "Tax Rate")) -(define optname-tax-amount (N_ "Tax Amount")) -(define optname-total-price (N_ "Total Price")) -(define optname-subtotal (N_ "Sub-total")) -(define optname-amount-due (N_ "Amount Due")) -(define optname-payment-recd (N_ "Payment received text")) -(define optname-extra-notes (N_ "Extra Notes")) +(define elementspage (N_ "Elements")) +; option names +(define optname-col-date (N_ "column: Date")) +(define optname-col-taxrate (N_ "column: Tax Rate")) +(define optname-col-units (N_ "column: Units")) +(define optname-row-address (N_ "row: Address")) +(define optname-row-contact (N_ "row: Contact")) +(define optname-row-invoice-number (N_ "row: Invoice Number")) +(define optname-row-company-name (N_ "row: Company Name")) +(define optname-invoice-number-text (N_ "Invoice number text")) +(define optname-to-text (N_ "To text")) +(define optname-ref-text (N_ "Ref text")) +(define optname-jobname-text (N_ "Job Name text")) +(define optname-jobnumber-text (N_ "Job Number text")) +(define optname-jobname-show (N_ "Show Job name")) +(define optname-jobnumber-show (N_ "Show Job number")) +(define optname-netprice (N_ "Show net price")) +(define optname-invnum-next-to-title (N_ "Invoice number next to title")) +(define optname-border-collapse (N_ "table-border-collapse")) +(define optname-border-color-th (N_ "table-header-border-color")) +(define optname-border-color-td (N_ "table-cell-border-color")) +(define optname-extra-css (N_ "Embedded CSS")) +(define optname-report-title (N_ "Report Title")) +(define optname-template-file (N_ "Template file")) +(define optname-css-file (N_ "CSS stylesheet file")) +(define optname-heading-font (N_ "Heading font")) +(define optname-text-font (N_ "Text font")) +(define optname-logofile (N_ "Logo filename")) +(define optname-logo-width (N_ "Logo width")) +(define optname-units (N_ "Units")) +(define optname-qty (N_ "Qty")) +(define optname-unit-price (N_ "Unit Price")) +(define optname-disc-rate (N_ "Discount Rate")) +(define optname-disc-amount (N_ "Discount Amount")) +(define optname-net-price (N_ "Net Price")) +(define optname-tax-rate (N_ "Tax Rate")) +(define optname-tax-amount (N_ "Tax Amount")) +(define optname-total-price (N_ "Total Price")) +(define optname-subtotal (N_ "Sub-total")) +(define optname-amount-due (N_ "Amount Due")) +(define optname-payment-recd (N_ "Payment received text")) +(define optname-extra-notes (N_ "Extra Notes")) (define (options-generator) ;; Options @@ -122,55 +121,55 @@ ;; Elements page options (gnc-register-simple-boolean-option options - elementspage optname-col-date "a" (N_ "Display the date?") #t) + elementspage optname-col-date "a" (N_ "Display the date?") #t) (gnc-register-simple-boolean-option options - elementspage optname-col-taxrate "b" (N_ "Display the Tax Rate?") #t) + elementspage optname-col-taxrate "b" (N_ "Display the Tax Rate?") #t) (gnc-register-simple-boolean-option options - elementspage optname-col-units "c" (N_ "Display the Units?") #t) + elementspage optname-col-units "c" (N_ "Display the Units?") #t) (gnc-register-simple-boolean-option options - elementspage optname-row-contact "d" (N_ "Display the contact?") #t) + elementspage optname-row-contact "d" (N_ "Display the contact?") #t) (gnc-register-simple-boolean-option options - elementspage optname-row-address "e" (N_ "Display the address?") #t) + elementspage optname-row-address "e" (N_ "Display the address?") #t) (gnc-register-simple-boolean-option options - elementspage optname-row-invoice-number "f" (N_ "Display the Invoice Number?") #t) + elementspage optname-row-invoice-number "f" (N_ "Display the Invoice Number?") #t) (gnc-register-simple-boolean-option options - elementspage optname-row-company-name "g" (N_ "Display the Company Name?") #t) + elementspage optname-row-company-name "g" (N_ "Display the Company Name?") #t) (gnc-register-simple-boolean-option options - elementspage optname-invnum-next-to-title "h" (N_ "Invoice Number next to title?") #f) + elementspage optname-invnum-next-to-title "h" (N_ "Invoice Number next to title?") #f) (gnc-register-simple-boolean-option options - elementspage optname-jobname-show "i" (N_ "Display Job name?") #t) + elementspage optname-jobname-show "i" (N_ "Display Job name?") #t) (gnc-register-simple-boolean-option options - elementspage optname-jobnumber-show "j" (N_ "Invoice Job number?") #f) + elementspage optname-jobnumber-show "j" (N_ "Invoice Job number?") #f) (gnc-register-simple-boolean-option options - elementspage optname-netprice "k" (N_ "Show net price?") #f) + elementspage optname-netprice "k" (N_ "Show net price?") #f) ;; Display options (gnc-register-string-option options - displaypage optname-template-file "a" + displaypage optname-template-file "a" (N_ "The file name of the eguile template part of this report. This file should either be in your .gnucash directory, or else in its proper place within the GnuCash installation directories.") "taxinvoice.eguile.scm") (gnc-register-string-option options - displaypage optname-css-file "b" - (N_ "The file name of the CSS stylesheet to use with this report. This file should either be in your .gnucash directory, or else in its proper place within the GnuCash installation directories.") + displaypage optname-css-file "b" + (N_ "The file name of the CSS stylesheet to use with this report. This file should either be in your .gnucash directory, or else in its proper place within the GnuCash installation directories.") "taxinvoice.css") (gnc-register-font-option options - displaypage optname-heading-font "c" + displaypage optname-heading-font "c" (N_ "Font to use for the main heading.") "Sans Bold 18") (gnc-register-font-option options - displaypage optname-text-font "d" + displaypage optname-text-font "d" (N_ "Font to use for everything else.") "Sans 10") (gnc-register-pixmap-option options - displaypage optname-logofile "e" - (N_ "Name of a file containing a logo to be used on the report.") + displaypage optname-logofile "e" + (N_ "Name of a file containing a logo to be used on the report.") "") (gnc-register-string-option options displaypage optname-logo-width "f" (N_ "Width of the logo in CSS format, e.g. 10% or 32px. Leave blank to display the logo at its natural width. The height of the logo will be scaled accordingly.") "") (gnc-register-simple-boolean-option options - displaypage optname-border-collapse "g" (N_ "Border-collapse?") #f) + displaypage optname-border-collapse "g" (N_ "Border-collapse?") #f) (gnc-register-string-option options - displaypage optname-border-color-th "h" (N_ "CSS color.") "black") + displaypage optname-border-color-th "h" (N_ "CSS color.") "black") (gnc-register-string-option options - displaypage optname-border-color-td "i" (N_ "CSS color.") "black") + displaypage optname-border-color-td "i" (N_ "CSS color.") "black") ;; Heading options (gnc-register-string-option options @@ -199,32 +198,32 @@ (gnc-register-string-option options headingpage2 optname-amount-due "b" "" (G_ "Amount Due")) (gnc-register-string-option options - headingpage2 optname-payment-recd "c" "" + headingpage2 optname-payment-recd "c" "" (G_ "Payment received, thank you!")) (gnc-register-string-option options - headingpage2 optname-invoice-number-text + headingpage2 optname-invoice-number-text "d" "" (G_ "Invoice number:")) (gnc-register-string-option options - headingpage2 optname-to-text + headingpage2 optname-to-text "e" "" (G_ "To:")) (gnc-register-string-option options - headingpage2 optname-ref-text + headingpage2 optname-ref-text "f" "" (G_ "Your ref:")) (gnc-register-string-option options - headingpage2 optname-jobnumber-text + headingpage2 optname-jobnumber-text "g" "" (G_ "Job number:")) (gnc-register-string-option options - headingpage2 optname-jobname-text + headingpage2 optname-jobname-text "h" "" (G_ "Job name:")) (gnc-register-text-option options notespage optname-extra-notes "a" - (G_ "Notes added at end of invoice -- may contain HTML markup.") + (G_ "Notes added at end of invoice -- may contain HTML markup.") (G_ "Thank you for your patronage!")) (gnc-register-text-option options notespage optname-extra-css "b" - (N_ "Embedded CSS.") "h1.coyname { text-align: left; }") + (N_ "Embedded CSS.") "h1.coyname { text-align: left; }") (gnc:options-set-default-section options gnc:pagename-general) options)) @@ -233,7 +232,7 @@ ;;; Create the report (define (report-renderer report-obj) - ;; Create and return the report as either an HTML string + ;; Create and return the report as either an HTML string ;; or an (define (opt-value section name) (gnc-optiondb-lookup-value (gnc:report-options report-obj) section name)) @@ -249,8 +248,8 @@ (opt-value displaypage optname-heading-font))) (opt-text-font (font-name-to-style-info-eguile (opt-value displaypage optname-text-font))) - (opt-logofile (opt-value displaypage optname-logofile)) - (opt-logo-width (opt-value displaypage optname-logo-width)) + (opt-logofile (opt-value displaypage optname-logofile)) + (opt-logo-width (opt-value displaypage optname-logo-width)) (opt-col-date (opt-value elementspage optname-col-date)) (opt-col-taxrate (opt-value elementspage optname-col-taxrate)) (opt-col-units (opt-value elementspage optname-col-units)) @@ -284,8 +283,8 @@ (opt-ref-text (opt-value headingpage2 optname-ref-text)) (opt-jobnumber-text (opt-value headingpage2 optname-jobnumber-text)) (opt-jobname-text (opt-value headingpage2 optname-jobname-text)) - (opt-extra-css (opt-value notespage optname-extra-css)) - (opt-extra-notes (opt-value notespage optname-extra-notes)) + (opt-extra-css (opt-value notespage optname-extra-css)) + (opt-extra-notes (opt-value notespage optname-extra-notes)) (html (eguile-file-to-string opt-template-file (the-environment)))) diff --git a/gnucash/report/reports/standard/test/test-cash-flow.scm b/gnucash/report/reports/standard/test/test-cash-flow.scm index bae6e5528c..7588af6bbb 100644 --- a/gnucash/report/reports/standard/test/test-cash-flow.scm +++ b/gnucash/report/reports/standard/test/test-cash-flow.scm @@ -13,10 +13,10 @@ (define structure (list "Root" (list (cons 'type ACCT-TYPE-ASSET)) - (list "Asset" - (list "Bank") - (list "Wallet")) - (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE))))) + (list "Asset" + (list "Bank") + (list "Wallet")) + (list "Expenses" (list (cons 'type ACCT-TYPE-EXPENSE))))) (define (NDayDelta t64 n) (let* ((day-secs (* 60 60 24 n)) ; n days in seconds is n times 60 sec/min * 60 min/h * 24 h/day @@ -29,118 +29,118 @@ (define (test-one-tx-in-cash-flow) (let* ((env (create-test-env)) - (account-alist (env-create-account-structure-alist env structure)) - (bank-account (cdr (assoc "Bank" account-alist))) - (wallet-account (cdr (assoc "Wallet" account-alist))) - (expense-account (cdr (assoc "Expenses" account-alist))) - (today (gnc-localtime (current-time))) + (account-alist (env-create-account-structure-alist env structure)) + (bank-account (cdr (assoc "Bank" account-alist))) + (wallet-account (cdr (assoc "Wallet" account-alist))) + (expense-account (cdr (assoc "Expenses" account-alist))) + (today (gnc-localtime (current-time))) (to-date-t64 (gnc-dmy2time64-end (tm:mday today) (+ 1 (tm:mon today)) (+ 1900 (tm:year today)))) (from-date-t64 (NDayDelta to-date-t64 1)) - (report-currency (gnc-default-report-currency)) - ) + (report-currency (gnc-default-report-currency)) + ) (env-create-transaction env to-date-t64 bank-account expense-account 100/1) (let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list bank-account)) - (cons 'to-date-t64 to-date-t64) - (cons 'from-date-t64 from-date-t64) - (cons 'report-currency report-currency) - (cons 'include-trading-accounts #f) - (cons 'to-report-currency to-report-currency))))) + (cons 'to-date-t64 to-date-t64) + (cons 'from-date-t64 from-date-t64) + (cons 'report-currency report-currency) + (cons 'include-trading-accounts #f) + (cons 'to-report-currency to-report-currency))))) (let* ((money-in-collector (cdr (assq 'money-in-collector result))) - (money-out-collector (cdr (assq 'money-out-collector result))) - (money-in-alist (cdr (assq 'money-in-alist result))) - (money-out-alist (cdr (assq 'money-out-alist result))) - (expense-acc-in-collector (cadr (assoc expense-account money-in-alist)))) - (and (or (null? money-out-alist) + (money-out-collector (cdr (assq 'money-out-collector result))) + (money-in-alist (cdr (assq 'money-in-alist result))) + (money-out-alist (cdr (assq 'money-out-alist result))) + (expense-acc-in-collector (cadr (assoc expense-account money-in-alist)))) + (and (or (null? money-out-alist) (begin (format #t "The money-out-alist is not null.~%") #f)) - (or (equal? 10000/100 - (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector - report-currency exchange-fn))) + (or (equal? 10000/100 + (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector + report-currency exchange-fn))) (begin (format #t "Failed expense-acc-in-collector ~a expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector - report-currency exchange-fn))) #f)) - (or (equal? 10000/100 - (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector - report-currency exchange-fn))) + report-currency exchange-fn))) #f)) + (or (equal? 10000/100 + (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector + report-currency exchange-fn))) (begin (format #t "Failed money-in-collector ~a expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector - report-currency exchange-fn))) #f)) - (or (equal? 0/1 - (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector - report-currency exchange-fn))) + report-currency exchange-fn))) #f)) + (or (equal? 0/1 + (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector + report-currency exchange-fn))) (begin (format #t "Failed sum-collector-commodity ~a expected 100.00~%" (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector report-currency exchange-fn))) #f)) (begin (format #t "test-one-tx-in-cash-flow success~%") #t) - ))))) + ))))) (define (test-one-tx-skip-cash-flow) (let* ((env (create-test-env)) - (account-alist (env-create-account-structure-alist env structure)) - (bank-account (cdr (assoc "Bank" account-alist))) - (wallet-account (cdr (assoc "Wallet" account-alist))) - (expense-account (cdr (assoc "Expenses" account-alist))) - (today (gnc-localtime (current-time))) + (account-alist (env-create-account-structure-alist env structure)) + (bank-account (cdr (assoc "Bank" account-alist))) + (wallet-account (cdr (assoc "Wallet" account-alist))) + (expense-account (cdr (assoc "Expenses" account-alist))) + (today (gnc-localtime (current-time))) (to-date-t64 (gnc-dmy2time64-end (tm:mday today) (+ 1 (tm:mon today)) (+ 1900 (tm:year today)))) (from-date-t64 (NDayDelta to-date-t64 1)) - (report-currency (gnc-default-report-currency)) - ) + (report-currency (gnc-default-report-currency)) + ) (env-create-transaction env to-date-t64 bank-account wallet-account 100/1) (let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list wallet-account bank-account)) - (cons 'to-date-t64 to-date-t64) - (cons 'from-date-t64 from-date-t64) - (cons 'report-currency report-currency) - (cons 'include-trading-accounts #f) - (cons 'to-report-currency to-report-currency))))) + (cons 'to-date-t64 to-date-t64) + (cons 'from-date-t64 from-date-t64) + (cons 'report-currency report-currency) + (cons 'include-trading-accounts #f) + (cons 'to-report-currency to-report-currency))))) (let* ((money-in-collector (cdr (assq 'money-in-collector result))) - (money-out-collector (cdr (assq 'money-out-collector result))) - (money-in-alist (cdr (assq 'money-in-alist result))) - (money-out-alist (cdr (assq 'money-out-alist result)))) - (and (null? money-in-alist) - (null? money-out-alist) - (equal? 0/1 - (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector - report-currency exchange-fn))) - (equal? 0/1 - (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector - report-currency exchange-fn))) + (money-out-collector (cdr (assq 'money-out-collector result))) + (money-in-alist (cdr (assq 'money-in-alist result))) + (money-out-alist (cdr (assq 'money-out-alist result)))) + (and (null? money-in-alist) + (null? money-out-alist) + (equal? 0/1 + (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector + report-currency exchange-fn))) + (equal? 0/1 + (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector + report-currency exchange-fn))) (begin (format #t "test-one-tx-skip-cash-flow success~%") #t) ))))) (define (test-both-way-cash-flow) (let* ((env (create-test-env)) - (account-alist (env-create-account-structure-alist env structure)) - (bank-account (cdr (assoc "Bank" account-alist))) - (wallet-account (cdr (assoc "Wallet" account-alist))) - (expense-account (cdr (assoc "Expenses" account-alist))) - (today (gnc-localtime (current-time))) + (account-alist (env-create-account-structure-alist env structure)) + (bank-account (cdr (assoc "Bank" account-alist))) + (wallet-account (cdr (assoc "Wallet" account-alist))) + (expense-account (cdr (assoc "Expenses" account-alist))) + (today (gnc-localtime (current-time))) (to-date-t64 (gnc-dmy2time64-end (tm:mday today) (+ 1 (tm:mon today)) (+ 1900 (tm:year today)))) (from-date-t64 (NDayDelta to-date-t64 1)) - (report-currency (gnc-default-report-currency)) - ) + (report-currency (gnc-default-report-currency)) + ) (env-create-transaction env to-date-t64 bank-account expense-account 100/1) (env-create-transaction env to-date-t64 expense-account bank-account 50/1) (let ((result (cash-flow-calc-money-in-out (list (cons 'accounts (list wallet-account bank-account)) - (cons 'to-date-t64 to-date-t64) - (cons 'from-date-t64 from-date-t64) - (cons 'report-currency report-currency) - (cons 'include-trading-accounts #f) - (cons 'to-report-currency to-report-currency))))) + (cons 'to-date-t64 to-date-t64) + (cons 'from-date-t64 from-date-t64) + (cons 'report-currency report-currency) + (cons 'include-trading-accounts #f) + (cons 'to-report-currency to-report-currency))))) (let* ((money-in-collector (cdr (assq 'money-in-collector result))) - (money-out-collector (cdr (assq 'money-out-collector result))) - (money-in-alist (cdr (assq 'money-in-alist result))) - (money-out-alist (cdr (assq 'money-out-alist result))) - (expense-acc-in-collector (cadr (assoc expense-account money-in-alist))) - (expense-acc-out-collector (cadr (assoc expense-account money-out-alist))) - (expenses-in-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector - report-currency - exchange-fn))) - (expenses-out-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-out-collector - report-currency - exchange-fn)))) - (and (equal? 10000/100 expenses-in-total) - (equal? 5000/100 expenses-out-total) - (equal? 10000/100 - (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector - report-currency exchange-fn))) - (equal? 5000/100 - (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector - report-currency exchange-fn))) + (money-out-collector (cdr (assq 'money-out-collector result))) + (money-in-alist (cdr (assq 'money-in-alist result))) + (money-out-alist (cdr (assq 'money-out-alist result))) + (expense-acc-in-collector (cadr (assoc expense-account money-in-alist))) + (expense-acc-out-collector (cadr (assoc expense-account money-out-alist))) + (expenses-in-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-in-collector + report-currency + exchange-fn))) + (expenses-out-total (gnc:gnc-monetary-amount (gnc:sum-collector-commodity expense-acc-out-collector + report-currency + exchange-fn)))) + (and (equal? 10000/100 expenses-in-total) + (equal? 5000/100 expenses-out-total) + (equal? 10000/100 + (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-in-collector + report-currency exchange-fn))) + (equal? 5000/100 + (gnc:gnc-monetary-amount (gnc:sum-collector-commodity money-out-collector + report-currency exchange-fn))) (begin (format #t "test-both-way-cash-flow success~%") #t) ))))) diff --git a/gnucash/report/reports/standard/view-column.scm b/gnucash/report/reports/standard/view-column.scm index 757a83727b..f8ed02b493 100644 --- a/gnucash/report/reports/standard/view-column.scm +++ b/gnucash/report/reports/standard/view-column.scm @@ -1,17 +1,17 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; view-column.scm : simple multi-column table view. +;; view-column.scm : simple multi-column table view. ;; Copyright 2001 Bill Gribble -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, contact: ;; @@ -29,7 +29,7 @@ (define-module (gnucash reports standard view-column)) (use-modules (gnucash engine)) (use-modules (ice-9 match)) -(use-modules (gnucash utilities)) +(use-modules (gnucash utilities)) (use-modules (gnucash core-utils)) (use-modules (gnucash app-utils)) (use-modules (gnucash report)) @@ -40,25 +40,25 @@ ;; the report-list is edited by a special add-on page for the ;; options editor. (gnc-register-report-placement-option options "__general" "report-list") - + (gnc-register-number-range-option options (N_ "General") (N_ "Number of columns") "a" (N_ "Number of columns before wrapping to a new row.") 1 0 20 1) - + options)) (define (render-view report) (let* ((view-doc (gnc:make-html-document)) - (options (gnc:report-options report)) - (reports (gnc-optiondb-lookup-value options "__general" "report-list")) - (table-width - (gnc-optiondb-lookup-value options (N_ "General") (N_ "Number of columns"))) - (column-allocs (make-hash-table 11)) - (column-tab (gnc:make-html-table)) - (current-row '()) - (current-width 0) - (current-row-num 0)) + (options (gnc:report-options report)) + (reports (gnc-optiondb-lookup-value options "__general" "report-list")) + (table-width + (gnc-optiondb-lookup-value options (N_ "General") (N_ "Number of columns"))) + (column-allocs (make-hash-table 11)) + (column-tab (gnc:make-html-table)) + (current-row '()) + (current-width 0) + (current-row-num 0)) ;; we really would rather do something smart here with the ;; report's cached text if possible. For the moment, we'll have @@ -73,18 +73,18 @@ ;; actually used in a row; items with non-1 rowspans will take ;; up cells in the row without actually being in the row. (let* ((subreport (gnc-report-find (car report-info))) - (colspan (cadr report-info)) - (rowspan (caddr report-info)) - (toplevel-cell (gnc:make-html-table-cell/size rowspan colspan)) - (report-table (gnc:make-html-table)) - (contents-cell (gnc:make-html-table-cell))) + (colspan (cadr report-info)) + (rowspan (caddr report-info)) + (toplevel-cell (gnc:make-html-table-cell/size rowspan colspan)) + (report-table (gnc:make-html-table)) + (contents-cell (gnc:make-html-table-cell))) - ;; set the report's style properly ... this way it will - ;; also get marked as dirty when the stylesheet is edited. - (gnc:report-set-stylesheet! - subreport (gnc:report-stylesheet report)) - - ;; render the report body ... capture error if report crashes. + ;; set the report's style properly ... this way it will + ;; also get marked as dirty when the stylesheet is edited. + (gnc:report-set-stylesheet! + subreport (gnc:report-stylesheet report)) + + ;; render the report body ... capture error if report crashes. (gnc:html-table-cell-append-objects! contents-cell (match (gnc:apply-with-error-handling @@ -96,80 +96,80 @@ (G_ "An error occurred while running the report.") (gnc:html-markup "pre" captured-error))))) - ;; increment the alloc number for each occupied row - (let loop ((row current-row-num)) - (let ((allocation (hash-ref column-allocs row 0))) - (hash-set! column-allocs row (+ colspan allocation)) - (if (< (+ 1 (- row current-row-num)) rowspan) - (loop (+ 1 row))))) - - (gnc:html-table-cell-set-style! - toplevel-cell "td" - 'attribute (list "valign" "top") - 'inheritable? #f) - - ;; put the report in the contents-cell - (gnc:html-table-append-row! report-table (list contents-cell)) - - ;; and a parameter editor link - (gnc:html-table-append-row! - report-table - (list (gnc:make-html-text - (gnc:html-markup-anchor - (gnc-build-url - URL-TYPE-OPTIONS - (format #f "report-id=~a" (car report-info)) - "") - (G_ "Edit Options")) - " " - (gnc:html-markup-anchor - (gnc-build-url - URL-TYPE-REPORT - (format #f "id=~a" (car report-info)) - "") - (G_ "Single Report"))))) + ;; increment the alloc number for each occupied row + (let loop ((row current-row-num)) + (let ((allocation (hash-ref column-allocs row 0))) + (hash-set! column-allocs row (+ colspan allocation)) + (if (< (+ 1 (- row current-row-num)) rowspan) + (loop (+ 1 row))))) - ;; add the report-table to the toplevel-cell - (gnc:html-table-cell-append-objects! - toplevel-cell report-table) - - (set! current-row (append current-row (list toplevel-cell))) - (set! current-width (+ current-width colspan)) - (if (>= current-width table-width) - (begin - (gnc:html-table-append-row! column-tab current-row) - ;; cells above with non-1 rowspan can force 'pre-allocation' - ;; of space on this row - (set! current-row-num (+ 1 current-row-num)) - (set! current-width (hash-ref column-allocs current-row-num)) - (if (not current-width) (set! current-width 0)) - (set! current-row '()))))) + (gnc:html-table-cell-set-style! + toplevel-cell "td" + 'attribute (list "valign" "top") + 'inheritable? #f) + + ;; put the report in the contents-cell + (gnc:html-table-append-row! report-table (list contents-cell)) + + ;; and a parameter editor link + (gnc:html-table-append-row! + report-table + (list (gnc:make-html-text + (gnc:html-markup-anchor + (gnc-build-url + URL-TYPE-OPTIONS + (format #f "report-id=~a" (car report-info)) + "") + (G_ "Edit Options")) + " " + (gnc:html-markup-anchor + (gnc-build-url + URL-TYPE-REPORT + (format #f "id=~a" (car report-info)) + "") + (G_ "Single Report"))))) + + ;; add the report-table to the toplevel-cell + (gnc:html-table-cell-append-objects! + toplevel-cell report-table) + + (set! current-row (append current-row (list toplevel-cell))) + (set! current-width (+ current-width colspan)) + (if (>= current-width table-width) + (begin + (gnc:html-table-append-row! column-tab current-row) + ;; cells above with non-1 rowspan can force 'pre-allocation' + ;; of space on this row + (set! current-row-num (+ 1 current-row-num)) + (set! current-width (hash-ref column-allocs current-row-num)) + (if (not current-width) (set! current-width 0)) + (set! current-row '()))))) reports) - + (if (not (null? current-row)) - (gnc:html-table-append-row! column-tab current-row)) - + (gnc:html-table-append-row! column-tab current-row)) + ;; make sure the table is nice and big - (gnc:html-table-set-style! + (gnc:html-table-set-style! column-tab "table" 'attribute (list "width" "100%")) - + (gnc:html-document-add-object! view-doc column-tab) ;; and we're done. view-doc)) (define (options-changed-cb report) (let* ((options (gnc:report-options report)) - (reports - (gnc-optiondb-lookup-value options "__general" "report-list"))) - (for-each + (reports + (gnc-optiondb-lookup-value options "__general" "report-list"))) + (for-each (lambda (child) (gnc:report-set-dirty?! (gnc-report-find (car child)) #t)) reports))) (define (cleanup-options report) (let* ((options (gnc:report-options report)) - (report-opt (gnc-lookup-option options "__general" "report-list"))) + (report-opt (gnc-lookup-option options "__general" "report-list"))) (let loop ((reports (GncOption-get-value report-opt)) (new-reports '())) (match reports (() (GncOption-set-value report-opt (reverse new-reports))) @@ -177,7 +177,7 @@ (loop rest (cons (list child rowspan colspan #f) new-reports))))))) ;; define the view now. -(gnc:define-report +(gnc:define-report 'version 1 'name (N_ "Multicolumn View") 'report-guid "d8ba4a2e89e8479ca9f6eccdeb164588" @@ -185,5 +185,5 @@ 'menu-path (list gnc:menuname-multicolumn) 'renderer render-view 'options-generator make-options - 'options-cleanup-cb cleanup-options + 'options-cleanup-cb cleanup-options 'options-changed-cb options-changed-cb)