gnucash unstable: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Tue Jan 23 16:29:34 EST 2018
Updated via https://github.com/Gnucash/gnucash/commit/f256b3bd (commit)
via https://github.com/Gnucash/gnucash/commit/a8cc2d2c (commit)
via https://github.com/Gnucash/gnucash/commit/45f61a34 (commit)
via https://github.com/Gnucash/gnucash/commit/890a24a3 (commit)
from https://github.com/Gnucash/gnucash/commit/ca22d553 (commit)
commit f256b3bd238a5bda4a01b1bd8c895fb0880acf41
Author: John Ralls <jralls at ceridwen.us>
Date: Tue Jan 23 13:26:35 2018 -0800
Use Gtk3's GdkModifierIntent masks.
These replace certain GdkModifierType masks for better cross-platform
behavior, especially on MacOS.
diff --git a/gnucash/gnome-utils/dialog-utils.c b/gnucash/gnome-utils/dialog-utils.c
index 73c0ca0..f6db0e0 100644
--- a/gnucash/gnome-utils/dialog-utils.c
+++ b/gnucash/gnome-utils/dialog-utils.c
@@ -415,7 +415,7 @@ gnc_handle_date_accelerator (GdkEventKey *event,
* prevents weird behavior of the menu accelerators (i.e. work in
* some widgets but not others.)
*/
- if (event->state & (GDK_CONTROL_MASK | GDK_MOD1_MASK))
+ if (event->state & (GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK))
return FALSE;
/* Now check for the remaining keystrokes. */
diff --git a/gnucash/gnome-utils/gnc-amount-edit.c b/gnucash/gnome-utils/gnc-amount-edit.c
index 373bd59..d4b24ed 100644
--- a/gnucash/gnome-utils/gnc-amount-edit.c
+++ b/gnucash/gnome-utils/gnc-amount-edit.c
@@ -183,7 +183,7 @@ gnc_amount_edit_key_press(GtkWidget *widget, GdkEventKey *event)
case GDK_KEY_Return:
if (gae->evaluate_on_enter)
break;
- if (event->state & (GDK_CONTROL_MASK | GDK_MOD1_MASK | GDK_SHIFT_MASK))
+ if (event->state & (GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK))
break;
return result;
case GDK_KEY_KP_Enter:
diff --git a/gnucash/register/register-gnome/formulacell-gnome.c b/gnucash/register/register-gnome/formulacell-gnome.c
index 76ca2e7..74691f3 100644
--- a/gnucash/register/register-gnome/formulacell-gnome.c
+++ b/gnucash/register/register-gnome/formulacell-gnome.c
@@ -80,7 +80,7 @@ gnc_formula_cell_direct_update( BasicCell *bcell,
{
case GDK_KEY_Return:
if (!(event->state &
- (GDK_CONTROL_MASK | GDK_MOD1_MASK | GDK_SHIFT_MASK)))
+ (GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK)))
is_return = TRUE;
/* FALL THROUGH */
diff --git a/gnucash/register/register-gnome/gnucash-sheet.c b/gnucash/register/register-gnome/gnucash-sheet.c
index 68c5924..3dca2cf 100644
--- a/gnucash/register/register-gnome/gnucash-sheet.c
+++ b/gnucash/register/register-gnome/gnucash-sheet.c
@@ -1568,7 +1568,7 @@ gnucash_sheet_clipboard_event (GnucashSheet *sheet, GdkEventKey *event)
{
case GDK_KEY_C:
case GDK_KEY_c:
- if (event->state & GDK_CONTROL_MASK)
+ if (event->state & GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR)
{
gnc_item_edit_copy_clipboard(item_edit);
handled = TRUE;
@@ -1576,7 +1576,7 @@ gnucash_sheet_clipboard_event (GnucashSheet *sheet, GdkEventKey *event)
break;
case GDK_KEY_X:
case GDK_KEY_x:
- if (event->state & GDK_CONTROL_MASK)
+ if (event->state & GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR)
{
gnc_item_edit_cut_clipboard(item_edit);
handled = TRUE;
@@ -1584,7 +1584,7 @@ gnucash_sheet_clipboard_event (GnucashSheet *sheet, GdkEventKey *event)
break;
case GDK_KEY_V:
case GDK_KEY_v:
- if (event->state & GDK_CONTROL_MASK)
+ if (event->state & GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR)
{
gnc_item_edit_paste_clipboard (item_edit);
handled = TRUE;
@@ -1596,7 +1596,7 @@ gnucash_sheet_clipboard_event (GnucashSheet *sheet, GdkEventKey *event)
gnc_item_edit_paste_clipboard (item_edit);
handled = TRUE;
}
- else if (event->state & GDK_CONTROL_MASK)
+ else if (event->state & GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR)
{
gnc_item_edit_copy_clipboard(item_edit);
handled = TRUE;
@@ -1706,8 +1706,7 @@ gnucash_sheet_key_press_event_internal (GtkWidget *widget, GdkEventKey *event)
/* Don't process any keystrokes where a modifier key (Alt,
* Meta, etc.) is being held down. This should't include
* MOD2, aka NUM LOCK. */
- if (event->state & (GDK_MOD1_MASK | GDK_MOD3_MASK |
- GDK_MOD4_MASK | GDK_MOD5_MASK))
+ if (event->state & (GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK))
pass_on = TRUE;
/* Calculate tentative physical values */
@@ -1772,7 +1771,7 @@ gnucash_sheet_key_press_event_internal (GtkWidget *widget, GdkEventKey *event)
case GDK_KEY_Down:
case GDK_KEY_Menu:
if (event->keyval == GDK_KEY_Menu ||
- (event->state & GDK_CONTROL_MASK))
+ (event->state & GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR))
{
GncItemEdit *item_edit;
diff --git a/gnucash/register/register-gnome/pricecell-gnome.c b/gnucash/register/register-gnome/pricecell-gnome.c
index 114e582..f0c22f8 100644
--- a/gnucash/register/register-gnome/pricecell-gnome.c
+++ b/gnucash/register/register-gnome/pricecell-gnome.c
@@ -69,7 +69,7 @@ gnc_price_cell_direct_update (BasicCell *bcell,
{
case GDK_KEY_Return:
if (!(event->state &
- (GDK_CONTROL_MASK | GDK_MOD1_MASK | GDK_SHIFT_MASK)))
+ (GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK)))
is_return = TRUE;
/* fall through */
commit a8cc2d2c99c426fc603283c6fab9bc2964f70133
Merge: ca22d55 45f61a3
Author: John Ralls <jralls at ceridwen.us>
Date: Sun Jan 21 17:49:22 2018 -0800
Merge branch 'maint' into unstable
diff --cc gnucash/report/business-reports/taxinvoice.scm
index 07dd1bc,0000000..500af9d
mode 100644,000000..100644
--- a/gnucash/report/business-reports/taxinvoice.scm
+++ b/gnucash/report/business-reports/taxinvoice.scm
@@@ -1,366 -1,0 +1,366 @@@
+
+;; $Author: chris $ $Date: 2009/07/29 09:31:44 $ $Revision: 1.33 $
+;; Modified by Dmitry Smirnov <onlyjob at member.fsf.org> 16 Feb 2012
+;;
+;; 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, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;; 02111-1307 USA
+
+; If you want to adapt this report privately:
+; - copy the report to your .gnucash directory
+; - specify a different module name below (eg mytaxinvoice)
+; - refer to it from .gnucash/config.user
+; (see http://wiki.gnucash.org/wiki/Custom_Reports )
+(define-module (gnucash report taxinvoice))
+
+(use-modules (ice-9 local-eval)) ; for the-environment
+(use-modules (gnucash main))
+(use-modules (gnucash gnc-module))
+(use-modules (gnucash gettext))
+(gnc:module-load "gnucash/report/report-system" 0)
+(gnc:module-load "gnucash/html" 0)
+(gnc:module-load "gnucash/engine" 0)
+
+(use-modules (gnucash report standard-reports))
+(use-modules (gnucash report business-reports))
+
+(use-modules (gnucash report eguile-utilities))
+(use-modules (gnucash report eguile-html-utilities))
+(use-modules (gnucash report eguile-gnc))
+
+(use-modules (srfi srfi-13)) ; for extra string functions
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Report-specific routines
+
+(define (taxrate taxable taxtable curr)
+ ;; Display the tax rate applicable to an invoice line.
+ ;; This may be e.g. "15%" or "£5.00" or "15% + £5.00" or "n/a"
+ ;; depending on how complicated the tax table is.
+ ;; (When called from within the eguile template, anything
+ ;; (display)ed becomes part of the HTML string.)
+ (if (or (not taxable) (eq? taxtable '()))
+ (display " ")
+ (let* ((amttot (gnc:make-commodity-collector))
+ (pctot (gnc:make-number-collector))
+ (entries (gncTaxTableGetEntries taxtable))
+ (amt? #f) ; becomes #t if any entries are amounts
+ (pc? #f)) ; becomes #t if any entries are percentages
+ (for entry in entries do
+ (let ((tttype (gncTaxTableEntryGetType entry))
+ (ttamt (gncTaxTableEntryGetAmount entry)))
+ (if (equal? tttype GNC-AMT-TYPE-VALUE)
+ (begin
+ (set! amt? #t)
+ (amttot 'add curr ttamt))
+ (begin
+ (set! pc? #t)
+ (pctot 'add ttamt)))))
+ (if pc? (begin (display (fmtnumeric (pctot 'total #f))) (display "%")))
+ (if (and amt? pc?) (display " + ")) ; both - this seems unlikely in practice
+ (if amt?
+ (display-comm-coll-total amttot #f))
+ (if (and (not amt?) (not pc?)) (display (_ "n/a")))))) ; neither
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Define all the options
+
+; option pages
+(define headingpage (N_ "Headings 1"))
+(define headingpage2 (N_ "Headings 2"))
+(define notespage (N_ "Notes"))
+;(define filespage (N_ "Files"))
+(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-report-currency (N_ "Report Currency"))
+(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"))
+
+; Choose only customer invoices
+; (This doesn't work very nicely -- all invoices and bills
+; are offered for selection, but if a non-customer invoice
+; is selected, the user is dumped back to viewing the
+; previous invoice (or none) with no error message)
+(define (customers-only invoice)
+ (let* ((owner (gncInvoiceGetOwner invoice))
+ (endowner (gncOwnerGetEndOwner owner))
+ (ownertype (gncOwnerGetType endowner)))
+ ;(gnc:debug "ownertype is ")(gnc:debug ownertype)
+ (if (eqv? ownertype GNC-OWNER-CUSTOMER)
+ (list #t invoice)
+ (list #f invoice))))
+
+(define (options-generator)
+ ;; Options
+ (define report-options (gnc:new-options))
+ (define (add-option new-option)
+ (gnc:register-option report-options new-option))
+
+ (add-option
+ (gnc:make-invoice-option ; defined in gnucash/scm/business-options.scm
+ gnc:pagename-general gnc:optname-invoice-number
+ "a" "" (lambda () '())
+ #f)) ;customers-only)) ;-- see above
+
+ (add-option
+ (gnc:make-currency-option
+ gnc:pagename-general optname-report-currency
+ "b" "" (gnc-default-report-currency)))
+
+ ;; Elements page options
+(add-option (gnc:make-simple-boolean-option elementspage optname-col-date "a" (N_ "Display the date?") #t))
+(add-option (gnc:make-simple-boolean-option elementspage optname-col-taxrate "b" (N_ "Display the Tax Rate?") #t))
+(add-option (gnc:make-simple-boolean-option elementspage optname-col-units "c" (N_ "Display the Units?") #t))
+(add-option (gnc:make-simple-boolean-option elementspage optname-row-contact "d" (N_ "Display the contact?") #t))
+(add-option (gnc:make-simple-boolean-option elementspage optname-row-address "e" (N_ "Display the address?") #t))
+(add-option (gnc:make-simple-boolean-option elementspage optname-row-invoice-number "f" (N_ "Display the Invoice Number?") #t))
+(add-option (gnc:make-simple-boolean-option elementspage optname-row-company-name "g" (N_ "Display the Company Name?") #t))
+(add-option (gnc:make-simple-boolean-option elementspage optname-invnum-next-to-title "h" (N_ "Invoice Number next to title?") #f))
+(add-option (gnc:make-simple-boolean-option elementspage optname-jobname-show "i" (N_ "Display Job name?") #t))
+(add-option (gnc:make-simple-boolean-option elementspage optname-jobnumber-show "j" (N_ "Invoice Job number?") #f))
+(add-option (gnc:make-simple-boolean-option elementspage optname-netprice "k" (N_ "Show net price?") #f))
+
+ ;; Display options
+ (add-option (gnc:make-string-option 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"))
+ (add-option (gnc:make-string-option 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"))
+ (add-option (gnc:make-font-option
+ displaypage optname-heading-font "c"
+ (N_ "Font to use for the main heading.") "Sans Bold 18"))
+ (add-option (gnc:make-font-option
+ displaypage optname-text-font "d"
+ (N_ "Font to use for everything else.") "Sans 10"))
+ (add-option (gnc:make-pixmap-option
+ displaypage optname-logofile "e"
+ (N_ "Name of a file containing a logo to be used on the report.")
+ ""))
+ (add-option (gnc:make-string-option
+ 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.") ""))
+(add-option (gnc:make-simple-boolean-option displaypage optname-border-collapse "g" (N_ "Border-collapse?") #f))
+(add-option (gnc:make-string-option displaypage optname-border-color-th "h" (N_ "CSS color.") "black"))
+(add-option (gnc:make-string-option displaypage optname-border-color-td "i" (N_ "CSS color.") "black"))
+
+ ;; Heading options
+ (add-option (gnc:make-string-option
+ ; page / name / orderkey / tooltip / default
+ headingpage optname-report-title "a" "" (_ "Invoice")))
+ (add-option (gnc:make-string-option
+ headingpage optname-units "b" "" (_ "Units")))
+ (add-option (gnc:make-string-option
+ headingpage optname-qty "c" "" (_ "Qty")))
+ (add-option (gnc:make-string-option
+ headingpage optname-unit-price "d" "" (_ "Unit Price")))
+ (add-option (gnc:make-string-option
+ headingpage optname-disc-rate "e" "" (_ "Discount Rate")))
+ (add-option (gnc:make-string-option
+ headingpage optname-disc-amount "f" "" (_ "Discount Amount")))
+ (add-option (gnc:make-string-option
+ headingpage optname-net-price "g" "" (_ "Net Price")))
+ (add-option (gnc:make-string-option
+ headingpage optname-tax-rate "h" "" (_ "Tax Rate")))
+ (add-option (gnc:make-string-option
+ headingpage optname-tax-amount "i" "" (_ "Tax Amount")))
+ (add-option (gnc:make-string-option
+ headingpage optname-total-price "j" "" (_ "Total Price")))
+ (add-option (gnc:make-string-option
+ headingpage2 optname-subtotal "a" "" (_ "Sub-total")))
+ (add-option (gnc:make-string-option
+ headingpage2 optname-amount-due "b" "" (_ "Amount Due")))
+ (add-option (gnc:make-string-option
+ headingpage2 optname-payment-recd "c" ""
+ (_ "Payment received, thank you.")))
+ (add-option (gnc:make-string-option headingpage2 optname-invoice-number-text
- "d" "" (N_ "Invoice number: ")))
++ "d" "" (_ "Invoice number: ")))
+ (add-option (gnc:make-string-option headingpage2 optname-to-text
- "e" "" (N_ "To: ")))
++ "e" "" (_ "To: ")))
+ (add-option (gnc:make-string-option headingpage2 optname-ref-text
- "f" "" (N_ "Your ref: ")))
++ "f" "" (_ "Your ref: ")))
+ (add-option (gnc:make-string-option headingpage2 optname-jobnumber-text
- "g" "" (N_ "Job number: ")))
++ "g" "" (_ "Job number: ")))
+ (add-option (gnc:make-string-option headingpage2 optname-jobname-text
- "h" "" (N_ "Job name: ")))
++ "h" "" (_ "Job name: ")))
+
+ (add-option (gnc:make-text-option
+ notespage optname-extra-notes "a"
+ (_ "Notes added at end of invoice -- may contain HTML markup.")
+ (_ "Thank you for your patronage!")))
+ ;(N_ "(Development version -- don't rely on the numbers on this report without double-checking them.<br>Change the 'Extra Notes' option to get rid of this message)")))
+
+ (add-option (gnc:make-text-option notespage optname-extra-css "b"
+ (N_ "Embedded CSS.") "h1.coyname { text-align: left; }"))
+ (gnc:options-set-default-section
+ report-options gnc:pagename-general)
+
+ report-options)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Create the report
+
+(define (report-renderer report-obj)
+ ;; Create and return the report as either an HTML string
+ ;; or an <html-document>
+ (define (opt-value section name)
+ ; wrapper for option routines
+ (define (get-opt section name)
+ (gnc:lookup-option (gnc:report-options report-obj) section name))
+ (gnc:option-value (get-opt section name)))
+
+ ; Get all the options
+ (let* ((document (gnc:make-html-document))
+ (opt-invoice (opt-value gnc:pagename-general gnc:optname-invoice-number))
+ (opt-template-file (find-file
+ (opt-value displaypage optname-template-file)))
+ (opt-css-file (find-file
+ (opt-value displaypage optname-css-file)))
+ (opt-heading-font (font-name-to-style-info
+ (opt-value displaypage optname-heading-font)))
+ (opt-text-font (font-name-to-style-info
+ (opt-value displaypage optname-text-font)))
+ (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))
+ (opt-row-contact (opt-value elementspage optname-row-contact))
+ (opt-row-address (opt-value elementspage optname-row-address))
+ (opt-row-invoice-number (opt-value elementspage optname-row-invoice-number))
+ (opt-row-company-name (opt-value elementspage optname-row-company-name))
+ (opt-invnum-next-to-title (opt-value elementspage optname-invnum-next-to-title))
+ (opt-jobname-show (opt-value elementspage optname-jobname-show))
+ (opt-jobnumber-show (opt-value elementspage optname-jobnumber-show))
+ (opt-netprice (opt-value elementspage optname-netprice))
+ (opt-report-currency (opt-value gnc:pagename-general optname-report-currency))
+ (opt-css-border-collapse (if (opt-value displaypage optname-border-collapse) "border-collapse:collapse;"))
+ (opt-css-border-color-th (opt-value displaypage optname-border-color-th))
+ (opt-css-border-color-td (opt-value displaypage optname-border-color-td))
+ (opt-report-title (opt-value headingpage optname-report-title))
+ (opt-units-heading (opt-value headingpage optname-units))
+ (opt-qty-heading (opt-value headingpage optname-qty))
+ (opt-unit-price-heading (opt-value headingpage optname-unit-price))
+ (opt-disc-rate-heading (opt-value headingpage optname-disc-rate))
+ (opt-disc-amount-heading (opt-value headingpage optname-disc-amount))
+ (opt-net-price-heading (opt-value headingpage optname-net-price))
+ (opt-tax-rate-heading (opt-value headingpage optname-tax-rate))
+ (opt-tax-amount-heading (opt-value headingpage optname-tax-amount))
+ (opt-total-price-heading (opt-value headingpage optname-total-price))
+ (opt-subtotal-heading (opt-value headingpage2 optname-subtotal))
+ (opt-amount-due-heading (opt-value headingpage2 optname-amount-due))
+ (opt-payment-recd-heading (opt-value headingpage2 optname-payment-recd))
+ (opt-invoice-number-text (opt-value headingpage2 optname-invoice-number-text))
+ (opt-to-text (opt-value headingpage2 optname-to-text))
+ (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))
+ (css? #t) ;(and (defined? 'gnc-html-engine-supports-css) (gnc-html-engine-supports-css)))
+ (html #f))
+
+ (set! html (eguile-file-to-string
+ opt-template-file
+ (the-environment)))
+
+ (gnc:debug "taxinvoice.scm: css? is " css?)
+ (gnc:debug "taxinvoice.scm: defined is " (defined? 'gnc-html-engine-supports-css))
+ (gnc:debug "taxinvoice.scm - generated html:") (gnc:debug html)
+
+ (if css? ; return report as document or html, depending on version
+ html
+ (let ((document (gnc:make-html-document)))
+ (gnc:html-document-add-object! document html)
+ document))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Define the report
+
+(gnc:define-report
+ 'version 1
+ 'name (N_ "Tax Invoice")
+ 'report-guid "0769e242be474010b4acf264a5512e6e"
+ 'menu-name (N_ "Tax Invoice")
+ 'menu-tip (N_ "Display a customer invoice with tax columns (using eguile template)")
+ 'menu-path (list gnc:menuname-business-reports)
+ 'options-generator options-generator
+ 'renderer report-renderer)
+
+(define (au-tax-options-generator)
+ (define (set-opt options page name value)
+ (let ((option (gnc:lookup-option options page name)))
+ (gnc:option-set-value option value)))
+
+ (let ((options (options-generator)))
+ (set-opt options headingpage optname-report-title (_ "Tax Invoice"))
+ ;(gnc:warn "title: " (gnc:option-value title-op))
+ (set-opt options headingpage optname-unit-price (_ "Unit"))
+ ;(gnc:warn "unitprice: " (gnc:option-value unit-price-op))
+ (set-opt options headingpage optname-tax-rate (_ "GST Rate"))
+ (set-opt options headingpage optname-tax-amount (_ "GST Amount"))
+ (set-opt options headingpage2 optname-amount-due (_ "Amount Due (inc GST)"))
+ (set-opt options headingpage2 optname-invoice-number-text (_ "Invoice #: "))
+ (set-opt options headingpage2 optname-ref-text (_ "Reference: "))
+ (set-opt options headingpage2 optname-jobname-text (_ "Engagement: "))
+ (set-opt options notespage optname-extra-css "h1.coyname { text-align: right; margin-bottom: 0px ; font-size: 200%; } h2.invoice { text-align: left; margin-bottom: 0px ; font-size: 500%; }")
+ options))
+
+(gnc:define-report
+ 'version 1
+ 'name (N_ "Australian Tax Invoice")
+ 'report-guid "3dbbc2584da64e7a8674355bc3fbfe3d"
+ 'menu-name (N_ "Australian Tax Invoice")
+ 'menu-tip (N_ "Display an Australian customer invoice with tax columns (using eguile template)")
+ 'menu-path (list gnc:menuname-business-reports)
+ 'options-generator au-tax-options-generator
+ 'renderer report-renderer)
diff --cc gnucash/report/report-system/commodity-utilities.scm
index 8d3b3cf,0000000..737fcea
mode 100644,000000..100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@@ -1,1019 -1,0 +1,988 @@@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; commodity-utilities.scm: Functions for handling different commodities.
+;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
+;; Boston, MA 02110-1301, USA gnu at gnu.org
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define (gnc-commodity-collector-contains-commodity? collector commodity)
+ (let ((ret #f))
+ (gnc-commodity-collector-map
+ collector
+ (lambda (comm amt)
+ (set! ret (or ret (gnc-commodity-equiv comm commodity)))))
+ ret
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions to get splits with interesting data from accounts.
+
+
+;; Returns a list of all splits in the 'currency-accounts' up to
+;; 'end-date' which have two different commodities involved, one of
+;; which is equivalent to 'commodity' (the latter constraint only if
+;; 'commodity' != #f ).
+(define (gnc:get-match-commodity-splits
+ currency-accounts end-date commodity)
+ (let ((query (qof-query-create-for-splits))
+ (splits #f))
+
+ (qof-query-set-book query (gnc-get-current-book))
+ (gnc:query-set-match-non-voids-only! query (gnc-get-current-book))
+ (xaccQueryAddAccountMatch query
+ currency-accounts
+ QOF-GUID-MATCH-ANY QOF-QUERY-AND)
+ (xaccQueryAddDateMatchTT
+ query #f end-date #t end-date QOF-QUERY-AND)
+
+ ;; Get the query result, i.e. all splits in currency
+ ;; accounts.
+ (set! splits (filter
+ ;; Filter such that we get only those splits
+ ;; which have two *different* commodities
+ ;; involved.
+ (lambda (s) (let ((trans-comm
+ (xaccTransGetCurrency
+ (xaccSplitGetParent s)))
+ (acc-comm
+ (xaccAccountGetCommodity
+ (xaccSplitGetAccount s)))
+ (acc-type
+ (xaccAccountGetType
+ (xaccSplitGetAccount s)))
+ (split-amt
+ (xaccSplitGetAmount s))
+ )
+ (and
+ ;; Same commodities, so no price:
+ (not (gnc-commodity-equiv
+ trans-comm acc-comm))
+ (or
+ ;; No commodity, bad split
+ (not commodity)
+ ;; Not a price that interests us
+ (gnc-commodity-equiv commodity trans-comm)
+ (gnc-commodity-equiv commodity acc-comm))
+ ;; No amount, so no price:
+ (not (gnc-numeric-zero-p split-amt))
+ ;; no trading accounts so we don't count twice
+ (not (eq? acc-type ACCT-TYPE-TRADING))
+ )))
+ (qof-query-run query)))
+ (qof-query-destroy query)
+ splits))
+
+;; Returns a sorted list of all splits in the 'currency-accounts' up
+;; to 'end-date' which have the 'commodity' and one other commodity
+;; involved. The splits are sorted by date.
+(define (gnc:get-match-commodity-splits-sorted currency-accounts
+ end-date
+ commodity)
+ (sort (gnc:get-match-commodity-splits currency-accounts
+ end-date commodity)
+ (lambda (a b)
+ (< (xaccTransGetDate (xaccSplitGetParent a))
+ (xaccTransGetDate (xaccSplitGetParent b))))))
+
+
+;; Returns a list of all splits in the currency-accounts up to
+;; end-date which have two *different* commodities involved.
+(define (gnc:get-all-commodity-splits currency-accounts end-date)
+ (gnc:get-match-commodity-splits currency-accounts end-date #f))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions to create some list of prices from data in transactions.
+
+
+;; Helper for warnings below.
+(define (gnc-commodity-numeric->string commodity numeric)
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary commodity numeric)))
+
+;; Helper for exchange below
+(define (gnc:exchange-by-euro-numeric
+ foreign-commodity foreign-numeric domestic date)
+ (gnc:exchange-by-euro
+ (gnc:make-gnc-monetary foreign-commodity foreign-numeric)
+ domestic date))
+
+;; Returns true if the given pricealist element is a non-zero price.
+(define (gnc:price-is-not-zero? elem)
+ (not (gnc-numeric-zero-p (second elem))))
+
+;; Create a list of all prices of 'price-commodity' measured in the
+;; currency 'report-currency'. The prices are taken from all splits in
+;; 'currency-accounts' up until the date 'end-date'. Returns a list
+;; of lists. Each listelement looks like the list (time price), where
+;; 'time' is the time64 when the <gnc:numeric*> 'price' was valid.
+(define (gnc:get-commodity-totalavg-prices
+ currency-accounts end-date price-commodity report-currency)
+ (let ((total-foreign (gnc-numeric-zero))
+ (total-domestic (gnc-numeric-zero)))
+ (filter
+ gnc:price-is-not-zero?
+ (map-in-order
+ (lambda (a)
+ (let* ((transaction-comm (xaccTransGetCurrency
+ (xaccSplitGetParent a)))
+ (account-comm (xaccAccountGetCommodity
+ (xaccSplitGetAccount a)))
+ (share-amount (gnc-numeric-abs
+ (xaccSplitGetAmount a)))
+ (value-amount (gnc-numeric-abs
+ (xaccSplitGetValue a)))
+ (transaction-date (xaccTransGetDate
+ (xaccSplitGetParent a)))
+ (foreignlist
+ (if (gnc-commodity-equiv transaction-comm
+ price-commodity)
+ (list account-comm
+ share-amount value-amount)
+ (list transaction-comm
+ value-amount share-amount))))
+
+ ;;(warn "gnc:get-commodity-totalavg-prices: value "
+ ;; (gnc-commodity-numeric->string
+ ;;(first foreignlist) (second foreignlist))
+ ;; " bought shares "
+ ;; (gnc-commodity-numeric->string
+ ;;price-commodity (third foreignlist)))
+
+ ;; Try EURO exchange if necessary
+ (if (not (gnc-commodity-equiv (first foreignlist)
+ report-currency))
+ (let ((exchanged (gnc:exchange-by-euro-numeric
+ (first foreignlist) (second foreignlist)
+ report-currency transaction-date)))
+ (if exchanged
+ (set! foreignlist
+ (list report-currency
+ (gnc:gnc-monetary-amount exchanged)
+ (third foreignlist))))))
+
+ (list
+ transaction-date
+ (if (not (gnc-commodity-equiv (first foreignlist)
+ report-currency))
+ (begin
+ (warn "gnc:get-commodity-totalavg-prices: "
+ "Sorry, currency exchange not yet implemented:"
+ (gnc-commodity-numeric->string
+ (first foreignlist) (second foreignlist))
+ " (buying "
+ (gnc-commodity-numeric->string
+ price-commodity (third foreignlist))
+ ") =? "
+ (gnc-commodity-numeric->string
+ report-currency (gnc-numeric-zero)))
+ (gnc-numeric-zero))
+ (begin
+ (set! total-foreign (gnc-numeric-add total-foreign
+ (third foreignlist)
+ GNC-DENOM-AUTO
+ GNC-DENOM-LCD))
+ (set! total-domestic (gnc-numeric-add total-domestic
+ (second foreignlist)
+ GNC-DENOM-AUTO
+ GNC-DENOM-LCD))
+ (gnc-numeric-div
+ total-domestic
+ total-foreign
+ GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))))
+ ;; Get all the interesting splits, and sort them according to the
+ ;; date.
+ (gnc:get-match-commodity-splits-sorted
+ currency-accounts
+ end-date price-commodity)))))
+
+;; Create a list of prices for all commodities in 'commodity-list',
+;; i.e. the same thing as in get-commodity-totalavg-prices but
+;; extended to a commodity-list. Returns an alist. Each pair consists
+;; of the foreign-currency and the appropriate list from
+;; gnc:get-commodity-totalavg-prices, see there.
+(define (gnc:get-commoditylist-totalavg-prices
+ commodity-list report-currency end-date
+ start-percent delta-percent)
+ (let ((currency-accounts
+ ;;(filter gnc:account-has-shares?
+ ;; -- use all accounts, not only share accounts, since gnucash-1.7
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
+ (work-to-do (length commodity-list))
+ (work-done 0))
+ (map
+ (lambda (c)
+ (begin
+ (set! work-done (+ 1 work-done))
+ (if start-percent
+ (gnc:report-percent-done
+ (+ start-percent (* delta-percent (/ work-done work-to-do)))))
+ (cons c
+ (gnc:get-commodity-totalavg-prices
+ currency-accounts end-date c report-currency))))
+ commodity-list)))
+
+;; Get the instantaneous prices for the 'price-commodity', measured in
+;; amounts of the 'report-currency'. The prices are taken from all
+;; splits in 'currency-accounts' up until the date
+;; 'end-date'. Returns a list of lists. Each listelement looks like
+;; the list (time price), where 'time' is the time64 when the
+;; <gnc:numeric*> 'price' was valid.
+(define (gnc:get-commodity-inst-prices
+ currency-accounts end-date price-commodity report-currency)
+ ;; go through all splits; convert all splits into a price.
+ (filter
+ gnc:price-is-not-zero?
+ (map-in-order
+ (lambda (a)
+ (let* ((transaction-comm (xaccTransGetCurrency
+ (xaccSplitGetParent a)))
+ (account-comm (xaccAccountGetCommodity
+ (xaccSplitGetAccount a)))
+ (share-amount (gnc-numeric-abs
+ (xaccSplitGetAmount a)))
+ (value-amount (gnc-numeric-abs
+ (xaccSplitGetValue a)))
+ (transaction-date (xaccTransGetDate
+ (xaccSplitGetParent a)))
+ (foreignlist
+ (if (gnc-commodity-equiv transaction-comm price-commodity)
+ (list account-comm
+ share-amount value-amount)
+ (list transaction-comm
+ value-amount share-amount))))
+
+ ;;(warn "get-commodity-inst-prices: value "
+ ;; (gnc-commodity-numeric->string
+ ;; (first foreignlist) (second foreignlist))
+ ;; " bought shares "
+ ;;(gnc-commodity-numeric->string
+ ;; price-commodity (third foreignlist)))
+
+ ;; Try EURO exchange if necessary
+ (if (not (gnc-commodity-equiv (first foreignlist)
+ report-currency))
+ (let ((exchanged (gnc:exchange-by-euro-numeric
+ (first foreignlist) (second foreignlist)
+ report-currency transaction-date)))
+ (if exchanged
+ (set! foreignlist
+ (list report-currency
+ (gnc:gnc-monetary-amount exchanged)
+ (third foreignlist))))))
+
+ (list
+ transaction-date
+ (if (not (gnc-commodity-equiv (first foreignlist)
+ report-currency))
+ (begin
+ (warn "get-commodity-inst-prices: "
+ "Sorry, currency exchange not yet implemented:"
+ (gnc-commodity-numeric->string
+ (first foreignlist) (second foreignlist))
+ " (buying "
+ (gnc-commodity-numeric->string
+ price-commodity (third foreignlist))
+ ") =? "
+ (gnc-commodity-numeric->string
+ report-currency (gnc-numeric-zero)))
+ (gnc-numeric-zero))
+ (gnc-numeric-div
+ (second foreignlist)
+ (third foreignlist)
+ GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))))
+ ;; Get all the interesting splits, sorted by date.
+ (gnc:get-match-commodity-splits-sorted
+ currency-accounts
+ end-date price-commodity))))
+
+;; Get the instantaneous prices for all commodities in
+;; 'commodity-list', i.e. the same thing as get-commodity-inst-prices
+;; but extended to a commodity-list. Returns an alist. Each pair
+;; consists of the foreign-currency and the appropriate list from
+;; gnc:get-commodity-inst-prices, see there.
+(define (gnc:get-commoditylist-inst-prices
+ commodity-list report-currency end-date
+ start-percent delta-percent)
+ (let ((currency-accounts
+ ;;(filter gnc:account-has-shares?
+ ;; -- use all accounts, not only share accounts, since gnucash-1.7
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
+ (work-to-do (length commodity-list))
+ (work-done 0))
+ (map
+ (lambda (c)
+ (begin
+ (set! work-done (+ 1 work-done))
+ (if start-percent
+ (gnc:report-percent-done
+ (+ start-percent (* delta-percent (/ work-done work-to-do)))))
+ (cons c
+ (gnc:get-commodity-inst-prices
+ currency-accounts end-date c report-currency))))
+ commodity-list)))
+
+
+;; Find the price in 'pricelist' that's nearest to 'date'. The
+;; pricelist comes from
+;; e.g. gnc:get-commodity-totalavg-prices. Returns a <gnc-numeric> or,
+;; if pricelist was empty, #f.
+(define (gnc:pricelist-price-find-nearest
+ pricelist date)
+ (let* ((later (find (lambda (p)
+ (< date (first p)))
+ pricelist))
+ (earlierlist (take-while
+ (lambda (p)
+ (>= date (first p)))
+ pricelist))
+ (earlier (and (not (null? earlierlist))
+ (last earlierlist))))
+ ;; (if earlier
+ ;; (warn "earlier"
+ ;; (qof-print-date (first earlier))
+ ;; (gnc-numeric-to-double (second earlier))))
+ ;; (if later
+ ;; (warn "later"
+ ;; (qof-print-date (first later))
+ ;; (gnc-numeric-to-double (second later))))
+
+ (if (and earlier later)
+ (if (< (abs (- (first earlier) date))
+ (abs (- (first later) date)))
+ (second earlier)
+ (second later))
+ (or
+ (and earlier (second earlier))
+ (and later (second later))))))
+
+
+;; Find the price of the 'commodity' in the 'pricealist' that is
+;; nearest to the 'date'.
+(define (gnc:pricealist-lookup-nearest-in-time
+ pricealist commodity date)
+ (let ((plist (assoc-ref pricealist commodity)))
+ (if (and plist (not (null? plist)))
+ (let ((price
+ (gnc:pricelist-price-find-nearest
+ plist date)))
+ (if price
+ price
+ (gnc-numeric-zero)))
+ (gnc-numeric-zero))))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions to get one price at a given time (i.e. not time-variant).
+
+
+;; Go through all toplevel non-'report-commodity' balances in
+;; 'sumlist' and add them to 'report-commodity', if possible. This
+;; function takes a sumlist (described in gnc:get-exchange-totals) and
+;; returns an alist similar to one value of the sumlist's alist,
+;; e.g. (cadr (assoc report-commodity sumlist))). This resulting alist
+;; can immediately be plugged into gnc:make-exchange-alist.
+(define (gnc:resolve-unknown-comm sumlist report-commodity)
+ ;; reportlist contains all known transactions with the
+ ;; report-commodity, and now the transactions with unknown
+ ;; currencies should be added to that list (with an appropriate
+ ;; exchange rate).
+ (let ((reportlist (cadr (assoc report-commodity sumlist))))
+
+ ;; Helper function to calculate (a*b)/c and create the new pair of
+ ;; numeric-collectors, where [abc] are numeric-collectors. See the
+ ;; real variable names below.
+ (define (make-newrate unknown-coll un->known-coll known-pair)
+ (let ((a (gnc:make-number-collector))
+ (b (gnc:make-number-collector)))
+ (a 'add (unknown-coll 'total #f))
+ (b 'add
+ ;; round to (at least) 8 significant digits
+ (gnc-numeric-div
+ (gnc-numeric-mul
+ (un->known-coll 'total #f)
+ ((cdadr known-pair) 'total #f)
+ GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 9) GNC-RND-ROUND))
+ ((caadr known-pair) 'total #f)
+ GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))
+ ;; in other words: (/ (* (caadr un->known-coll) (cdadr
+ ;; known-pair)) (caadr known-pair) ))
+ (cons a b)))
+
+ ;; Go through sumlist.
+ (for-each
+ (lambda (otherlist)
+ (if (not (gnc-commodity-equiv (car otherlist) report-commodity))
+ (for-each
+ (lambda (pair)
+ ;; Check whether by any accident the report-commodity
+ ;; appears here.
+ (if
+ (not (gnc-commodity-equiv (car pair) report-commodity))
+ ;; pair-{a,b}: Try to find either the currency of
+ ;; otherlist or of pair in reportlist.
+ (let ((pair-a
+ (or
+ ;; Find the otherlist's currency in reportlist
+ (assoc (car otherlist) reportlist)
+ ;; Or try whether that's an Euro currency.
+ (let
+ ((euro-monetary
+ (gnc:exchange-by-euro (gnc:make-gnc-monetary
+ (car otherlist)
+ ((cdadr pair) 'total #f))
+ report-commodity #f)))
+ ;; If this is an Euro currency, create the
+ ;; pair of appropriately exchanged amounts.
+ (if euro-monetary
+ (let ((a (gnc:make-number-collector)))
+ (a 'add
+ (gnc:gnc-monetary-amount euro-monetary))
+ (list report-commodity
+ (cons (cdadr pair) a)))
+ #f))))
+ ;; Find the pair's currency in reportlist. FIXME:
+ ;; Also try the Euro here.
+ (pair-b (assoc (car pair) reportlist))
+ (rate (gnc-numeric-zero)))
+ (if (and (not pair-a) (not pair-b))
+ ;; If neither the currency of otherlist nor of
+ ;; pair was found in reportlist then we can't
+ ;; resolve the exchange rate to this currency.
+ (warn "gnc:resolve-unknown-comm:"
+ "can't calculate rate for "
+ (gnc-commodity-value->string
+ (list (car pair) ((caadr pair) 'total #f)))
+ " = "
+ (gnc-commodity-value->string
+ (list (car otherlist) ((cdadr pair) 'total #f)))
+ " to "
+ (gnc-commodity-value->string
+ (list report-commodity (gnc-numeric-zero))))
+ (if (and pair-a pair-b)
+ ;; If both currencies are found then something
+ ;; went wrong inside
+ ;; gnc:get-exchange-totals. FIXME: Find a
+ ;; better thing to do in this case.
+ (warn "gnc:resolve-unknown-comm:"
+ "Oops - exchange rate ambiguity error: "
+ (gnc-commodity-value->string
+ (list (car pair) ((caadr pair) 'total #f)))
+ " = "
+ (gnc-commodity-value->string
+ (list (car otherlist)
+ ((cdadr pair) 'total #f))))
+ (let
+ ;; Usual case: one of pair-{a,b} was found
+ ;; in reportlist, i.e. this transaction
+ ;; can be resolved to report-commodity.
+ ((newrate
+ (if (not pair-a)
+ (list (car otherlist)
+ (make-newrate (cdadr pair)
+ (caadr pair) pair-b))
+ (list (car pair)
+ (make-newrate (caadr pair)
+ (cdadr pair) pair-a)))))
+ ;; (warn "created new rate: "
+ ;; (gnc-commodity-value->string (list (car
+ ;; newrate) ((caadr newrate) 'total #f))) "
+ ;; = " (gnc-commodity-value->string (list
+ ;; report-commodity ((cdadr newrate) 'total
+ ;; #f))))
+ (set! reportlist (cons newrate reportlist))))))
+ ;; The report-currency showed up on the wrong side, so it was a
+ ;; "sell" for that commodity. We ignore those for cost reports
+ ;; and they're already aggregated for non-cost reports.
+ ))
+ (cadr otherlist))))
+ sumlist)
+
+ ;; Return the reportlist.
+ reportlist))
+;; Some thoughts: In the (and (not pair-a) (not pair-b)) case above we
+;; will have unresolvable transaction exchange rates. But there might
+;; be cases where we will be able to resolve this, but only after one
+;; or more runs of gnc:resolve-unknown-comm. Maybe we could transform
+;; this functions to use some kind of recursiveness.
+
- (define (create-commodity-list inner-comm outer-comm share-amount value-amount)
- (let ((foreignlist (list inner-comm
- (cons (gnc:make-number-collector)
- (gnc:make-number-collector))))
- (comm-list #f))
- ((caadr foreignlist) 'add share-amount)
- ((cdadr foreignlist) 'add value-amount)
- (set! comm-list (list outer-comm (list foreignlist)))
- (gnc:debug "New Outer entry " (gnc-commodity-get-mnemonic outer-comm)
- (gnc-commodity-get-mnemonic inner-comm) share-amount
- value-amount)
- comm-list))
-
- (define (create-foreign-list comm-list inner-comm outer-comm
++(define (create-commodity-list inner-comm outer-comm value-amount share-amount)
++ (let ((pair (list inner-comm
++ (cons (gnc:make-numeric-collector)
++ (gnc:make-numeric-collector)))))
++ ((caadr pair) 'add value-amount)
++ ((cdadr pair) 'add share-amount)
++ (set comm-list (list outer-comm (list pair)))))
++
++(define (create-foreign-list comm-list transaction-comm account-comm
+ share-amount value-amount)
+ (let ((foreign-list
- (if (gnc-commodity-equiv inner-comm (car comm-list))
- (list outer-comm share-amount value-amount)
- (list inner-comm value-amount share-amount))))
- (gnc:debug "Add value " (gnc-commodity-get-mnemonic (car comm-list))
- (gnc-commodity-get-mnemonic (car foreign-list))
- (cadr foreign-list) (cddr foreign-list))
++ (if (gnc-commodity-equiv transaction-comm (car comm-list))
++ (list account-comm share-amount value-amount)
++ (list transaction-comm value-amount share-amount))))
++ foreign-list))
++
++(define (create-foreign-cost-list comm-list transaction-comm account-comm
++ share-amount value-amount)
++ (let ((foreign-list
++ (if (gnc-commodity-equiv transaction-comm (car comm-list))
++ (list account-comm share-amount value-amount)
++ (list transaction-comm (gnc-numeric-neg value-amount)
++ (gnc-numeric-neg share-amount)))))
+ foreign-list))
+
+(define (create-commodity-pair foreignlist comm-list sumlist)
+ (let ((pair (assoc (car foreignlist) (cadr comm-list))))
+ ;; no pair already, create one
+ (if (not pair)
- (begin
- (set! pair (list (car foreignlist)
- (cons (gnc:make-number-collector)
- (gnc:make-number-collector))))
- (gnc:debug "New commodity "
- (gnc-commodity-get-mnemonic (car foreignlist)))))
++ (set! pair (list (car foreignlist)
++ (cons (gnc:make-numeric-collector)
++ (gnc:make-numeric-collector)))))
+ pair))
+
- ;; gnc:get-exchange-totals returns a sumlist, which is a multilevel alist. Each
- ;; element has a commodity as key, and another alist as a value. The
- ;; value-alist's elements consist of a commodity as a key, and a pair of two
- ;; value-collectors as value, e.g. with only one (the report-) commodity DEM in
- ;; the outer alist: ( {DEM ( [USD (400 . 1000)] [FRF (300 . 100)] ) } ) where
- ;; DEM,USD,FRF are <gnc:commodity> and the numbers are a numeric-collector which
- ;; in turn store a <gnc:numeric>. In the example, USD 400 were bought for an
- ;; amount of DEM 1000, FRF 300 were bought for DEM 100. The reason for the outer
- ;; alist is that there might be commodity transactions which do not involve the
- ;; report-commodity, but which can still be calculated after *all* transactions
- ;; are processed.
- ;;
-
++;; sumlist: a multilevel alist. Each element has a commodity as key, and another
++;; alist as a value. The value-alist's elements consist of a commodity as a key,
++;; and a pair of two value-collectors as value, e.g. with only one (the report-)
++;; commodity DEM in the outer alist: ( {DEM ( [USD (400 . 1000)] [FRF (300
++;; . 100)] ) } ) where DEM,USD,FRF are <gnc:commodity> and the numbers are a
++;; numeric-collector which in turn store a <gnc:numeric>. In the example, USD
++;; 400 were bought for an amount of DEM 1000, FRF 300 were bought for DEM
++;; 100. The reason for the outer alist is that there might be commodity
++;; transactions which do not involve the report-commodity, but which can still
++;; be calculated after *all* transactions are processed. Calculate the weighted
++;; average exchange rate between all commodities and the
++;; 'report-commodity'. Uses all currency transactions up until the
++;; 'end-date'. Returns an alist, see sumlist.
+(define (gnc:get-exchange-totals report-commodity end-date cost)
- ;; Finds all splits in the book whose commodity is different from the parent
- ;; transaction's commodity and creates a sumlist of the amount and value for
- ;; each commodity pair. If 'cost' is true then the totals represent the costs of
- ;; buying one commodity with the other; if it's false then the trades in both
- ;; directions are agregated. A side effect of the distinction is that changing
- ;; the report currency will change the resulting exchange rate if 'cost' is true
- ;; but not if it is false.
+ (let ((curr-accounts
+ ;;(filter gnc:account-has-shares? ))
+ ;; -- use all accounts, not only share accounts, since gnucash-1.7
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
+ (sumlist (list (list report-commodity '()))))
- (gnc:debug "Begin Report " (gnc-commodity-get-mnemonic report-commodity)
- " cost " cost)
++
+ (if (not (null? curr-accounts))
+ ;; Go through all splits and add up all value-amounts
+ ;; and share-amounts
+ (for-each
+ (lambda (a)
+ (let* ((transaction-comm (xaccTransGetCurrency
+ (xaccSplitGetParent a)))
+ (account-comm (xaccAccountGetCommodity
+ (xaccSplitGetAccount a)))
- (share-amount (xaccSplitGetAmount a))
- (value-amount (xaccSplitGetValue a))
- ;; If the share-value is negative then the transaction
- ;; purchased something in the transaction currency; otherwise
- ;; the purchase is in the account currency.
- (outer-comm (if (gnc-numeric-negative-p share-amount)
- account-comm transaction-comm))
- (inner-comm (if (gnc-numeric-negative-p share-amount)
- transaction-comm account-comm))
- (tmp (assoc outer-comm sumlist))
- ;; If cost isn't true then we want one entry for both in
- ;; sumlist.
- (comm-list (if (and (not tmp) (not cost))
- (assoc inner-comm sumlist)
++ (share-amount (if cost
++ (xaccSplitGetAmount a)
++ (gnc-numeric-abs (xaccSplitGetAmount a))))
++ (value-amount (if cost
++ (xaccSplitGetValue a)
++ (gnc-numeric-abs (xaccSplitGetValue a))))
++ (tmp (assoc transaction-comm sumlist))
++ (comm-list (if (not tmp)
++ (assoc account-comm sumlist)
+ tmp)))
- ;; We need to reverse and negate the values if they were negative
- ;; because we already reversed the commodities they applied to.
- (gnc:debug "Transaction commodity "
- (gnc-commodity-get-mnemonic transaction-comm)
- " Account commodity "
- (gnc-commodity-get-mnemonic account-comm)
- " Outer Commodity "
- (gnc-commodity-get-mnemonic outer-comm)
- " Inner Commodity "
- (gnc-commodity-get-mnemonic inner-comm)
- " Amount " share-amount " Value " value-amount)
- (if (gnc-numeric-negative-p share-amount)
- ;;(if cost ;; swap as well as negate
- ;;(let* ((tmp-amount share-amount))
- ;;(set! share-amount (gnc-numeric-neg value-amount))
- ;;(set! value-amount (gnc-numeric-neg tmp-amount)))
- (begin ;; we just want to make sure they're positive
- (set! share-amount (gnc-numeric-abs share-amount))
- (set! value-amount (gnc-numeric-abs value-amount));;)
- ))
+ ;; entry exists already in comm-list?
+ (if (not comm-list)
+ ;; no, create sub-alist from scratch
+ (begin
+ (set! comm-list (create-commodity-list
- inner-comm outer-comm
++ account-comm transaction-comm
+ share-amount value-amount))
+ (set! sumlist (cons comm-list sumlist)))
+
- ;;yes, add the second commodity if it's not already stored
- (let* ((foreignlist (create-foreign-list comm-list outer-comm
- inner-comm share-amount value-amount))
++ ;;yes, check for second commodity
++ (let* ((foreignlist (if cost
++ (create-foreign-cost-list
++ comm-list transaction-comm account-comm
++ share-amount value-amount)
++ (create-foreign-list
++ comm-list transaction-comm account-comm
++ share-amount value-amount)))
+ (pair (create-commodity-pair foreignlist comm-list
+ sumlist)))
+ (set! comm-list (list (car comm-list)
+ (cons pair (cadr comm-list))))
+ (set! sumlist (cons comm-list
+ (alist-delete (car comm-list) sumlist)))
+ ((caadr pair) 'add (cadr foreignlist))
+ ((cdadr pair) 'add (caddr foreignlist))))))
+
+ (gnc:get-all-commodity-splits curr-accounts end-date)))
- (gnc:debug "End Report\n")
- ;; Finally resolve any indirect conversions.
++
+ (gnc:resolve-unknown-comm sumlist report-commodity)))
+
+(define (gnc:make-exchange-alist report-commodity end-date cost)
+ ;; This returns the alist with the actual exchange rates, i.e. the
+ ;; total balances from get-exchange-totals are divided by each
+ ;; other.
+ (map
+ (lambda (e)
+ (list (car e)
+ (gnc-numeric-abs
+ (gnc-numeric-div ((cdadr e) 'total #f)
+ ((caadr e) 'total #f)
+ GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))
+ (gnc:get-exchange-totals report-commodity end-date cost)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Actual functions for exchanging amounts.
+
+
+;; Exchange EURO currencies to each other, or returns #f if one of
+;; them is not an EURO currency at the given time. The function takes
+;; the <gnc-monetary> 'foreign' amount, the <gnc:commodity*>
+;; 'domestic' commodity, and a <gnc:time-pair> 'date'. It exchanges
+;; the amount into the domestic currency. If the 'date' is #f, it
+;; doesn't check for it. Returns a <gnc-monetary>, or #f if at least
+;; one of the currencies is not in the EURO.
+(define (gnc:exchange-by-euro foreign domestic date)
+ (and (gnc-is-euro-currency domestic)
+ (gnc-is-euro-currency (gnc:gnc-monetary-commodity foreign))
+ ;; FIXME: implement the date check.
+ (gnc:make-gnc-monetary
+ domestic
+ (gnc-convert-from-euro
+ domestic
+ (gnc-convert-to-euro (gnc:gnc-monetary-commodity foreign)
+ (gnc:gnc-monetary-amount foreign))))))
+
+
+;; A trivial exchange function - if the "foreign" monetary amount
+;; and the domestic currency are the same, return the foreign
+;; amount unchanged, otherwise return 0
+
+;; WARNING: many uses of exchange functions assume that the function
+;; will return a valid <gnc:monetary>. However, this function returns
+;; #f if the commodities don't match. Therefore, if you use this
+;; function in a mixed commodity context, stuff will probably crash.
+(define (gnc:exchange-if-same foreign domestic)
+ (if (gnc-commodity-equiv (gnc:gnc-monetary-commodity foreign) domestic)
+ foreign
+ #f))
+
+;; This one returns the ready-to-use function for calculation of the
+;; exchange rates. The returned function takes a <gnc-monetary> and
+;; the <gnc:commodity*> domestic-commodity, exchanges the amount into
+;; the domestic currency and returns a <gnc-monetary>.
+(define (gnc:make-exchange-function exchange-alist)
+ (let ((exchangelist exchange-alist))
+ (lambda (foreign domestic)
+ (gnc:debug "foreign: " (gnc:monetary->string foreign))
+ (gnc:debug "domestic: " (gnc-commodity-get-printname domestic))
+ (if foreign
+ (or (gnc:exchange-by-euro foreign domestic #f)
+ (gnc:exchange-if-same foreign domestic)
+ (gnc:make-gnc-monetary
+ domestic
+ (let ((pair (assoc (gnc:gnc-monetary-commodity foreign)
+ exchangelist))
+ (foreign-amount (gnc:gnc-monetary-amount foreign)))
+ (if (or (not pair)
+ (gnc-numeric-zero-p foreign-amount))
+ (gnc-numeric-zero)
+ (gnc-numeric-mul foreign-amount
+ (cadr pair)
+ (gnc-commodity-get-fraction domestic)
+ GNC-RND-ROUND)))))
+ #f))))
+
+;; Helper for the gnc:exchange-by-pricalist* below. Exchange the
+;; <gnc:monetary> 'foreign' into the <gnc:commodity*> 'domestic' by
+;; the <gnc:numeric> 'price-value'. Returns a <gnc:monetary>.
+(define (gnc:exchange-by-pricevalue-helper
+ foreign domestic price-value)
+ (if (gnc:gnc-monetary? foreign)
+ (gnc:make-gnc-monetary
+ domestic
+ (if price-value
+ (gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
+ price-value
+ (gnc-commodity-get-fraction domestic)
+ GNC-RND-ROUND)
+ (begin
+ (warn "gnc:exchange-by-pricevalue-helper: No price found for "
+ (gnc:monetary->string foreign) " into "
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
+ (gnc-numeric-zero))))
+ #f))
+
+;; Helper for gnc:exchange-by-pricedb-* below. 'price' gets tested for
+;; #f here, and gets unref'd here too. Exchange the <gnc:monetary>
+;; 'foreign' into the <gnc:commodity*> 'domestic' by the <gnc:Price>
+;; 'price'. Returns a <gnc:monetary>.
+(define (gnc:exchange-by-pricedb-helper
+ foreign domestic price)
+ (if (gnc:gnc-monetary? foreign)
+ (gnc:make-gnc-monetary
+ domestic
+ (if price
+ (let ((result
+ (gnc-numeric-mul (gnc:gnc-monetary-amount foreign)
+ (gnc-price-get-value price)
+ (gnc-commodity-get-fraction domestic)
+ GNC-RND-ROUND)))
+ (gnc-price-unref price)
+ result)
+ (begin
+ (warn "gnc:exchange-by-pricedb-helper: No price found for "
+ (gnc:monetary->string foreign) " into "
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary domestic (gnc-numeric-zero))))
+ (gnc-numeric-zero))))
+ #f))
+
+;; This is another ready-to-use function for calculation of exchange
+;; rates. (Note that this is already the function itself. It doesn't
+;; return a function as opposed to make-exchange-function.) It takes
+;; the <gnc-monetary> 'foreign' amount and the <gnc:commodity*>
+;; 'domestic' commodity. It exchanges the amount into the domestic
+;; currency, using the latest price from the pricedb. The function
+;; returns a <gnc-monetary>.
+(define (gnc:exchange-by-pricedb-latest
+ foreign domestic)
+ (if (and (record? foreign) (gnc:gnc-monetary? foreign))
+ (or (gnc:exchange-by-euro foreign domestic #f)
+ (gnc:exchange-if-same foreign domestic)
+ (gnc:make-gnc-monetary
+ domestic
+ (gnc-pricedb-convert-balance-latest-price
+ (gnc-pricedb-get-db (gnc-get-current-book))
+ (gnc:gnc-monetary-amount foreign)
+ (gnc:gnc-monetary-commodity foreign)
+ domestic)))
+ #f))
+
+;; Yet another ready-to-use function for calculation of exchange
+;; rates. (Note that this is already the function itself. It doesn't
+;; return a function as opposed to make-exchange-function.) It takes
+;; the <gnc-monetary> 'foreign' amount, the <gnc:commodity*>
+;; 'domestic' commodity *and* a <gnc:time-pair> 'date'. It exchanges
+;; the amount into the domestic currency, using a price from the
+;; pricedb according to the given date. The function returns a
+;; <gnc-monetary>.
+(define (gnc:exchange-by-pricedb-nearest
+ foreign domestic date)
+ (if (and (record? foreign) (gnc:gnc-monetary? foreign)
+ date)
+ (or (gnc:exchange-by-euro foreign domestic date)
+ (gnc:exchange-if-same foreign domestic)
+ (gnc:make-gnc-monetary
+ domestic
+ (gnc-pricedb-convert-balance-nearest-price
+ (gnc-pricedb-get-db (gnc-get-current-book))
+ (gnc:gnc-monetary-amount foreign)
+ (gnc:gnc-monetary-commodity foreign)
+ domestic (time64CanonicalDayTime date))))
+ #f))
+
+;; Exchange by the nearest price from pricelist. This function takes
+;; the <gnc-monetary> 'foreign' amount, the <gnc:commodity*>
+;; 'domestic' commodity, a <gnc:time-pair> 'date' and the
+;; 'pricelist'. It exchanges the amount into the domestic currency,
+;; using the price nearest to 'data' found in the pricelist. The
+;; function returns a <gnc-monetary>.
+(define (gnc:exchange-by-pricealist-nearest
+ pricealist foreign domestic date)
+ (begin
+ (gnc:debug "foreign " (gnc:monetary->string foreign))
+ (gnc:debug "domestic " (gnc-commodity-get-printname domestic))
+ (gnc:debug "pricealist " pricealist)
+
+ (if (and (record? foreign) (gnc:gnc-monetary? foreign)
+ date)
+ (or (gnc:exchange-by-euro foreign domestic date)
+ (gnc:exchange-if-same foreign domestic)
+ (if (not (null? pricealist))
+ (gnc:exchange-by-pricevalue-helper
+ foreign domestic
+ (gnc:pricealist-lookup-nearest-in-time
+ pricealist (gnc:gnc-monetary-commodity foreign) date))
+ #f))
+ #f)))
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Choosing exchange functions made easy -- get the right function by
+;; the value of a multichoice option.
+
+
+;; Return a ready-to-use function. Which one to use is determined by
+;; the value of 'source-option', whose possible values are set in
+;; gnc:options-add-price-source!.
+(define (gnc:case-exchange-fn
+ source-option report-currency to-date)
+ (case source-option
+ ((average-cost) (gnc:make-exchange-function
+ (gnc:make-exchange-alist
+ report-currency to-date #t)))
+ ((weighted-average) (gnc:make-exchange-function
+ (gnc:make-exchange-alist
+ report-currency to-date #f)))
+ ((pricedb-latest) gnc:exchange-by-pricedb-latest)
+ ((pricedb-nearest) (lambda (foreign domestic)
+ (gnc:exchange-by-pricedb-nearest
+ foreign domestic to-date)))
+ (else
+ (begin
+ ;; FIX-ME
+ ;; this is a hack to prevent report crashing if a report
+ ;; implements source-options that aren't fully implemented. We
+ ;; return a reasonably sane fallback function: nearest.
+ ;;
+ ;; known to be missing: pricedb-latest-before
+ (gnc:warn "gnc:case-exchange-fn: bad price-source value: "
+ source-option " using pricedb-nearest.")
+ (lambda (foreign domestic)
+ (gnc:exchange-by-pricedb-nearest
+ foreign domestic to-date))))))
+
+;; Return a ready-to-use function. Which one to use is determined by
+;; the value of 'source-option', whose possible values are set in
+;; gnc:options-add-price-source!.
+;;
+;; <int> start-percent, delta-percent: Fill in the [start:start+delta]
+;; section of the progress bar while running this function.
+;;
+(define (gnc:case-exchange-time-fn
+ source-option report-currency commodity-list to-date
+ start-percent delta-percent)
+ (case source-option
+ ;; Make this the same as gnc:case-exchange-fn
+ ((average-cost) (let* ((exchange-fn (gnc:make-exchange-function
+ (gnc:make-exchange-alist
+ report-currency to-date #t))))
+ (lambda (foreign domestic date)
+ (exchange-fn foreign domestic))))
+ ((weighted-average) (let ((pricealist
+ (gnc:get-commoditylist-totalavg-prices
+ commodity-list report-currency to-date
+ start-percent delta-percent)))
+ (lambda (foreign domestic date)
+ (gnc:exchange-by-pricealist-nearest
+ pricealist foreign domestic date))))
+ ((actual-transactions) (let ((pricealist
+ (gnc:get-commoditylist-inst-prices
+ commodity-list report-currency to-date)))
+ (lambda (foreign domestic date)
+ (gnc:exchange-by-pricealist-nearest
+ pricealist foreign domestic date))))
+ ((pricedb-latest) (lambda (foreign domestic date)
+ (gnc:exchange-by-pricedb-latest foreign domestic)))
+ ((pricedb-nearest) gnc:exchange-by-pricedb-nearest)
+ (else
+ (begin
+ (gnc:warn "gnc:case-exchange-time-fn: bad price-source value: "
+ source-option ". Using pricedb-nearest.")
+ ;; FIX-ME another hack to prevent report crashing when an
+ ;; unimplemented source-option comes through
+ gnc:exchange-by-pricedb-nearest))))
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions using the exchange-fn's above to get from a
+;; commodity-collector to one value.
+
+
+;; Adds all different commodities in the commodity-collector <foreign>
+;; by using the exchange rates of <exchange-fn> to calculate the
+;; exchange rates to the commodity <domestic>.
+;;
+;; CAS: Previously, the exchange-fn was not optional -- we would crash
+;; if it was invalid. I've changed this so that when exchange-fn is
+;; #f, #f is returned. Since #f is already returned when foreign is
+;; #f, and since any previous dependance on some behavior for the case
+;; where exchange-fn was #f would've crashed, I think this change is
+;; safe.
+;;
+;; Returns a <gnc-monetary> with the domestic commodity and its
+;; corresponding balance. If the foreign balance is #f, it returns #f.
+(define (gnc:sum-collector-commodity foreign domestic exchange-fn)
+ (cond ((and foreign exchange-fn)
+ (let ((balance (gnc:make-commodity-collector)))
+ (foreign
+ 'format
+ (lambda (curr val)
+ (if (gnc-commodity-equiv domestic curr)
+ (balance 'add domestic val)
+ (balance 'add domestic
+ (gnc:gnc-monetary-amount
+ ;; BUG?: this bombs if the exchange-fn
+ ;; returns #f instead of an actual
+ ;; <gnc:monetary>. Better to just return #f.
+ (exchange-fn (gnc:make-gnc-monetary curr val)
+ domestic)))))
+ #f)
+ (balance 'getmonetary domestic #f)))
+ (else #f)))
+
+;; As above, but adds only the commodities of other stocks and
+;; mutual-funds. Returns a commodity-collector, (not a <gnc:monetary>)
+;; which (still) may have several different commodities in it -- if
+;; there have been different *currencies*, not only stocks.
+(define (gnc:sum-collector-stocks foreign domestic exchange-fn)
+ (if foreign
+ (let ((balance (gnc:make-commodity-collector)))
+ (foreign
+ 'format
+ (lambda (curr val)
+ (if (gnc-commodity-equiv domestic curr)
+ (balance 'add domestic val)
+ (if (gnc-commodity-is-currency curr)
+ (balance 'add curr val)
+ (balance 'add domestic
+ (gnc:gnc-monetary-amount
+ (exchange-fn (gnc:make-gnc-monetary curr val)
+ domestic))))))
+ #f)
+ balance)
+ #f))
+
+;; Returns the number of commodities in a commodity-collector.
+;; (If this were implemented as a record, I would be able to
+;; just (length ...) the alist, but....)
+(define (gnc-commodity-collector-commodity-count collector)
+ (let ((commodities 0))
+ (gnc-commodity-collector-map
+ collector
+ (lambda (comm amt)
+ (set! commodities (+ commodities 1))))
+ commodities
+ ))
+
+(define (gnc:uniform-commodity? amt report-commodity)
+ ;; function to see if the commodity-collector amt
+ ;; contains any foreign commodities
+ (let ((elts (gnc-commodity-collector-commodity-count amt)))
+ (or (equal? elts 0)
+ (and (equal? elts 1)
+ (gnc-commodity-collector-contains-commodity?
+ amt report-commodity)))))
commit 45f61a34a4ff4ec09f51915e3c56726923673b97
Author: John Ralls <jralls at ceridwen.us>
Date: Sun Jan 21 17:09:59 2018 -0800
Revert "Calculate rates only for buy transactions in the report commodity
This reverts commit 98697a1e23c48737e472eba6314c3d05e6e689ee.
See the extensive discuession in Bug 775368, including references and
especially
https://lists.gnucash.org/pipermail/gnucash-devel/2008-July/023297.html
98697a1 was made without sufficient understanding of the history and
intent of the code.
diff --git a/src/report/report-system/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm
index d14afab..ceca9c8 100644
--- a/src/report/report-system/commodity-utilities.scm
+++ b/src/report/report-system/commodity-utilities.scm
@@ -515,10 +515,17 @@
;; report-commodity ((cdadr newrate) 'total
;; #f))))
(set! reportlist (cons newrate reportlist))))))
- ;; The report-currency showed up on the wrong side, so it was a
- ;; "sell" for that commodity. We ignore those for cost reports
- ;; and they're already aggregated for non-cost reports.
- ))
+ ;; Huh, the report-currency showed up on the wrong side
+ ;; -- we will just add it to the reportlist on the
+ ;; right side.
+ (let ((newrate (list (car otherlist)
+ (cons (cdadr pair) (caadr pair)))))
+ ;; (warn "created new rate: "
+ ;; (gnc-commodity-value->string (list (car newrate)
+ ;; ((caadr newrate) 'total #f))) " = "
+ ;; (gnc-commodity-value->string (list
+ ;; report-commodity ((cdadr newrate) 'total #f))))
+ (set! reportlist (cons newrate reportlist)))))
(cadr otherlist))))
sumlist)
@@ -530,70 +537,60 @@
;; or more runs of gnc:resolve-unknown-comm. Maybe we could transform
;; this functions to use some kind of recursiveness.
-(define (create-commodity-list inner-comm outer-comm share-amount value-amount)
- (let ((foreignlist (list inner-comm
+(define (create-commodity-list inner-comm outer-comm value-amount share-amount)
+ (let ((pair (list inner-comm
(cons (gnc:make-numeric-collector)
- (gnc:make-numeric-collector))))
- (comm-list #f))
- ((caadr foreignlist) 'add share-amount)
- ((cdadr foreignlist) 'add value-amount)
- (set! comm-list (list outer-comm (list foreignlist)))
- (gnc:debug "New Outer entry " (gnc-commodity-get-mnemonic outer-comm)
- (gnc-commodity-get-mnemonic inner-comm) share-amount
- value-amount)
- comm-list))
-
-(define (create-foreign-list comm-list inner-comm outer-comm
+ (gnc:make-numeric-collector)))))
+ ((caadr pair) 'add value-amount)
+ ((cdadr pair) 'add share-amount)
+ (set comm-list (list outer-comm (list pair)))))
+
+(define (create-foreign-list comm-list transaction-comm account-comm
share-amount value-amount)
(let ((foreign-list
- (if (gnc-commodity-equiv inner-comm (car comm-list))
- (list outer-comm share-amount value-amount)
- (list inner-comm value-amount share-amount))))
- (gnc:debug "Add value " (gnc-commodity-get-mnemonic (car comm-list))
- (gnc-commodity-get-mnemonic (car foreign-list))
- (cadr foreign-list) (cddr foreign-list))
+ (if (gnc-commodity-equiv transaction-comm (car comm-list))
+ (list account-comm share-amount value-amount)
+ (list transaction-comm value-amount share-amount))))
+ foreign-list))
+
+(define (create-foreign-cost-list comm-list transaction-comm account-comm
+ share-amount value-amount)
+ (let ((foreign-list
+ (if (gnc-commodity-equiv transaction-comm (car comm-list))
+ (list account-comm share-amount value-amount)
+ (list transaction-comm (gnc-numeric-neg value-amount)
+ (gnc-numeric-neg share-amount)))))
foreign-list))
(define (create-commodity-pair foreignlist comm-list sumlist)
(let ((pair (assoc (car foreignlist) (cadr comm-list))))
;; no pair already, create one
(if (not pair)
- (begin
- (set! pair (list (car foreignlist)
+ (set! pair (list (car foreignlist)
(cons (gnc:make-numeric-collector)
- (gnc:make-numeric-collector))))
- (gnc:debug "New commodity "
- (gnc-commodity-get-mnemonic (car foreignlist)))))
+ (gnc:make-numeric-collector)))))
pair))
-;; gnc:get-exchange-totals returns a sumlist, which is a multilevel alist. Each
-;; element has a commodity as key, and another alist as a value. The
-;; value-alist's elements consist of a commodity as a key, and a pair of two
-;; value-collectors as value, e.g. with only one (the report-) commodity DEM in
-;; the outer alist: ( {DEM ( [USD (400 . 1000)] [FRF (300 . 100)] ) } ) where
-;; DEM,USD,FRF are <gnc:commodity> and the numbers are a numeric-collector which
-;; in turn store a <gnc:numeric>. In the example, USD 400 were bought for an
-;; amount of DEM 1000, FRF 300 were bought for DEM 100. The reason for the outer
-;; alist is that there might be commodity transactions which do not involve the
-;; report-commodity, but which can still be calculated after *all* transactions
-;; are processed.
-;;
-
+;; sumlist: a multilevel alist. Each element has a commodity as key, and another
+;; alist as a value. The value-alist's elements consist of a commodity as a key,
+;; and a pair of two value-collectors as value, e.g. with only one (the report-)
+;; commodity DEM in the outer alist: ( {DEM ( [USD (400 . 1000)] [FRF (300
+;; . 100)] ) } ) where DEM,USD,FRF are <gnc:commodity> and the numbers are a
+;; numeric-collector which in turn store a <gnc:numeric>. In the example, USD
+;; 400 were bought for an amount of DEM 1000, FRF 300 were bought for DEM
+;; 100. The reason for the outer alist is that there might be commodity
+;; transactions which do not involve the report-commodity, but which can still
+;; be calculated after *all* transactions are processed. Calculate the weighted
+;; average exchange rate between all commodities and the
+;; 'report-commodity'. Uses all currency transactions up until the
+;; 'end-date'. Returns an alist, see sumlist.
(define (gnc:get-exchange-totals report-commodity end-date cost)
-;; Finds all splits in the book whose commodity is different from the parent
-;; transaction's commodity and creates a sumlist of the amount and value for
-;; each commodity pair. If 'cost' is true then the totals represent the costs of
-;; buying one commodity with the other; if it's false then the trades in both
-;; directions are agregated. A side effect of the distinction is that changing
-;; the report currency will change the resulting exchange rate if 'cost' is true
-;; but not if it is false.
(let ((curr-accounts
;;(filter gnc:account-has-shares? ))
;; -- use all accounts, not only share accounts, since gnucash-1.7
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
(sumlist (list (list report-commodity '()))))
- (gnc:debug "Begin Report " (gnc-commodity-get-mnemonic report-commodity)
- " cost " cost)
+
(if (not (null? curr-accounts))
;; Go through all splits and add up all value-amounts
;; and share-amounts
@@ -603,53 +600,33 @@
(xaccSplitGetParent a)))
(account-comm (xaccAccountGetCommodity
(xaccSplitGetAccount a)))
- (share-amount (xaccSplitGetAmount a))
- (value-amount (xaccSplitGetValue a))
- ;; If the share-value is negative then the transaction
- ;; purchased something in the transaction currency; otherwise
- ;; the purchase is in the account currency.
- (outer-comm (if (gnc-numeric-negative-p share-amount)
- account-comm transaction-comm))
- (inner-comm (if (gnc-numeric-negative-p share-amount)
- transaction-comm account-comm))
- (tmp (assoc outer-comm sumlist))
- ;; If cost isn't true then we want one entry for both in
- ;; sumlist.
- (comm-list (if (and (not tmp) (not cost))
- (assoc inner-comm sumlist)
+ (share-amount (if cost
+ (xaccSplitGetAmount a)
+ (gnc-numeric-abs (xaccSplitGetAmount a))))
+ (value-amount (if cost
+ (xaccSplitGetValue a)
+ (gnc-numeric-abs (xaccSplitGetValue a))))
+ (tmp (assoc transaction-comm sumlist))
+ (comm-list (if (not tmp)
+ (assoc account-comm sumlist)
tmp)))
- ;; We need to reverse and negate the values if they were negative
- ;; because we already reversed the commodities they applied to.
- (gnc:debug "Transaction commodity "
- (gnc-commodity-get-mnemonic transaction-comm)
- " Account commodity "
- (gnc-commodity-get-mnemonic account-comm)
- " Outer Commodity "
- (gnc-commodity-get-mnemonic outer-comm)
- " Inner Commodity "
- (gnc-commodity-get-mnemonic inner-comm)
- " Amount " share-amount " Value " value-amount)
- (if (gnc-numeric-negative-p share-amount)
- ;;(if cost ;; swap as well as negate
- ;;(let* ((tmp-amount share-amount))
- ;;(set! share-amount (gnc-numeric-neg value-amount))
- ;;(set! value-amount (gnc-numeric-neg tmp-amount)))
- (begin ;; we just want to make sure they're positive
- (set! share-amount (gnc-numeric-abs share-amount))
- (set! value-amount (gnc-numeric-abs value-amount));;)
- ))
;; entry exists already in comm-list?
(if (not comm-list)
;; no, create sub-alist from scratch
(begin
(set! comm-list (create-commodity-list
- inner-comm outer-comm
+ account-comm transaction-comm
share-amount value-amount))
(set! sumlist (cons comm-list sumlist)))
- ;;yes, add the second commodity if it's not already stored
- (let* ((foreignlist (create-foreign-list comm-list outer-comm
- inner-comm share-amount value-amount))
+ ;;yes, check for second commodity
+ (let* ((foreignlist (if cost
+ (create-foreign-cost-list
+ comm-list transaction-comm account-comm
+ share-amount value-amount)
+ (create-foreign-list
+ comm-list transaction-comm account-comm
+ share-amount value-amount)))
(pair (create-commodity-pair foreignlist comm-list
sumlist)))
(set! comm-list (list (car comm-list)
@@ -660,8 +637,7 @@
((cdadr pair) 'add (caddr foreignlist))))))
(gnc:get-all-commodity-splits curr-accounts end-date)))
- (gnc:debug "End Report\n")
- ;; Finally resolve any indirect conversions.
+
(gnc:resolve-unknown-comm sumlist report-commodity)))
(define (gnc:make-exchange-alist report-commodity end-date cost)
commit 890a24a38f820f4836faf576b877fb8f0393c787
Author: fell <frank.h.ellenberger at gmail.com>
Date: Fri Jan 19 02:45:21 2018 +0100
Fix missing translations in taxinvoice.scm
Thanks to Paul de Vries for reporting
diff --git a/src/report/business-reports/taxinvoice.scm b/src/report/business-reports/taxinvoice.scm
index 16a925e..904c8b1 100644
--- a/src/report/business-reports/taxinvoice.scm
+++ b/src/report/business-reports/taxinvoice.scm
@@ -230,15 +230,15 @@
headingpage2 optname-payment-recd "c" ""
(_ "Payment received, thank you")))
(add-option (gnc:make-string-option headingpage2 optname-invoice-number-text
- "d" "" (N_ "Invoice number: ")))
+ "d" "" (_ "Invoice number: ")))
(add-option (gnc:make-string-option headingpage2 optname-to-text
- "e" "" (N_ "To: ")))
+ "e" "" (_ "To: ")))
(add-option (gnc:make-string-option headingpage2 optname-ref-text
- "f" "" (N_ "Your ref: ")))
+ "f" "" (_ "Your ref: ")))
(add-option (gnc:make-string-option headingpage2 optname-jobnumber-text
- "g" "" (N_ "Job number: ")))
+ "g" "" (_ "Job number: ")))
(add-option (gnc:make-string-option headingpage2 optname-jobname-text
- "h" "" (N_ "Job name: ")))
+ "h" "" (_ "Job name: ")))
(add-option (gnc:make-text-option
notespage optname-extra-notes "a"
Summary of changes:
gnucash/gnome-utils/dialog-utils.c | 2 +-
gnucash/gnome-utils/gnc-amount-edit.c | 2 +-
.../register/register-gnome/formulacell-gnome.c | 2 +-
gnucash/register/register-gnome/gnucash-sheet.c | 13 +-
gnucash/register/register-gnome/pricecell-gnome.c | 2 +-
gnucash/report/business-reports/taxinvoice.scm | 10 +-
.../report/report-system/commodity-utilities.scm | 145 ++++++++-------------
7 files changed, 72 insertions(+), 104 deletions(-)
More information about the gnucash-changes
mailing list