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

Merge branch 'big-prices'

Browse Source
This commit is contained in:
John Ralls 2015-10-29 15:37:18 -07:00
commit f82717496a
26 changed files with 2570 additions and 1205 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/app-utils/gnc-sx-instance-model.c
View File

@ -1122,9 +1122,6 @@ create_each_transaction_helper(Transaction *template_txn, void *user_data)
price = gnc_pricedb_lookup_latest(price_db, first_cmdty, split_cmdty); price = gnc_pricedb_lookup_latest(price_db, first_cmdty, split_cmdty);
if (price == NULL) if (price == NULL)
{ {
price = gnc_pricedb_lookup_latest(price_db, split_cmdty, first_cmdty);
if (price == NULL)
{
GString *err = g_string_new(""); GString *err = g_string_new("");
g_string_printf(err, "could not find pricedb entry for commodity-pair (%s, %s).", g_string_printf(err, "could not find pricedb entry for commodity-pair (%s, %s).",
gnc_commodity_get_mnemonic(first_cmdty), gnc_commodity_get_mnemonic(first_cmdty),
@ -1135,7 +1132,9 @@ create_each_transaction_helper(Transaction *template_txn, void *user_data)
} }
else else
{ {
exchange = gnc_numeric_invert(gnc_price_get_value(price)); if (gnc_commodity_equiv(first_cmdty,
gnc_price_get_commodity(price)))
exchange = gnc_numeric_invert(gnc_price_get_value(price));
exchange = gnc_numeric_convert(exchange, 1000, exchange = gnc_numeric_convert(exchange, 1000,
GNC_HOW_RND_ROUND_HALF_UP); GNC_HOW_RND_ROUND_HALF_UP);
} }

9
src/app-utils/gnc-ui-balances.c
View File

@ -185,6 +185,8 @@ gnc_ui_account_get_balance_as_of_date (Account *account,
time64 date, time64 date,
gboolean include_children) gboolean include_children)
{ {
QofBook *book = gnc_account_get_book (account);
GNCPriceDB *pdb = gnc_pricedb_get_db (book);
gnc_numeric balance; gnc_numeric balance;
gnc_commodity *currency; gnc_commodity *currency;
@ -209,8 +211,10 @@ gnc_ui_account_get_balance_as_of_date (Account *account,
child = node->data; child = node->data;
child_currency = xaccAccountGetCommodity (child); child_currency = xaccAccountGetCommodity (child);
child_balance = xaccAccountGetBalanceAsOfDate (child, date); child_balance = xaccAccountGetBalanceAsOfDate (child, date);
child_balance = xaccAccountConvertBalanceToCurrency (child, child_balance =
child_balance, child_currency, currency); gnc_pricedb_convert_balance_latest_price (pdb, child_balance,
child_currency,
currency);
balance = gnc_numeric_add_fixed (balance, child_balance); balance = gnc_numeric_add_fixed (balance, child_balance);
} }
@ -316,4 +320,3 @@ gnc_ui_owner_get_print_report_balance (GncOwner *owner,
print_info = gnc_commodity_print_info (report_commodity, TRUE); print_info = gnc_commodity_print_info (report_commodity, TRUE);
return g_strdup (xaccPrintAmount (balance, print_info)); return g_strdup (xaccPrintAmount (balance, print_info));
} }

2
src/backend/sql/gnc-price-sql.c
View File

@ -203,7 +203,7 @@ write_price( GNCPrice* p, gpointer data )
g_return_val_if_fail( p != NULL, FALSE ); g_return_val_if_fail( p != NULL, FALSE );
g_return_val_if_fail( data != NULL, FALSE ); g_return_val_if_fail( data != NULL, FALSE );
if ( s->is_ok && gnc_price_get_source(p) != PRICE_SOURCE_INVOICE) if ( s->is_ok && gnc_price_get_source(p) != PRICE_SOURCE_TEMP)
{ {
s->is_ok = save_price( s->be, QOF_INSTANCE(p) ); s->is_ok = save_price( s->be, QOF_INSTANCE(p) );
} }

2
src/business/business-gnome/dialog-invoice.c
View File

@ -898,7 +898,7 @@ gnc_invoice_post(InvoiceWindow *iw, struct post_invoice_params *post_params)
gnc_price_set_commodity (convprice, account_currency); gnc_price_set_commodity (convprice, account_currency);
gnc_price_set_currency (convprice, gncInvoiceGetCurrency (invoice)); gnc_price_set_currency (convprice, gncInvoiceGetCurrency (invoice));
gnc_price_set_time (convprice, postdate); gnc_price_set_time (convprice, postdate);
gnc_price_set_source (convprice, PRICE_SOURCE_INVOICE); gnc_price_set_source (convprice, PRICE_SOURCE_TEMP);
gnc_price_set_typestr (convprice, PRICE_TYPE_LAST); gnc_price_set_typestr (convprice, PRICE_TYPE_LAST);
gnc_price_set_value (convprice, exch_rate); gnc_price_set_value (convprice, exch_rate);
gncInvoiceAddPrice(invoice, convprice); gncInvoiceAddPrice(invoice, convprice);

2
src/engine/engine.i
View File

@ -382,7 +382,7 @@ KvpValue* qof_book_get_option (QofBook *book, GSList *key_path);
SET_ENUM("PRICE-SOURCE-XFER-DLG-VAL"); SET_ENUM("PRICE-SOURCE-XFER-DLG-VAL");
SET_ENUM("PRICE-SOURCE-SPLIT-REG"); SET_ENUM("PRICE-SOURCE-SPLIT-REG");
SET_ENUM("PRICE-SOURCE-STOCK-SPLIT"); SET_ENUM("PRICE-SOURCE-STOCK-SPLIT");
SET_ENUM("PRICE-SOURCE-INVOICE"); SET_ENUM("PRICE-SOURCE-TEMP");
SET_ENUM("PRICE-SOURCE-INVALID"); SET_ENUM("PRICE-SOURCE-INVALID");
#undef SET_ENUM #undef SET_ENUM

1
src/engine/gnc-pricedb-p.h
View File

@ -81,6 +81,7 @@ typedef enum
typedef struct gnc_price_lookup_helper_s typedef struct gnc_price_lookup_helper_s
{ {
GList **return_list; GList **return_list;
gnc_commodity *key;
Timespec time; Timespec time;
} GNCPriceLookupHelper; } GNCPriceLookupHelper;

852
src/engine/gnc-pricedb.c
View File

File diff suppressed because it is too large Load Diff

287
src/engine/gnc-pricedb.h
View File

@ -169,7 +169,8 @@ typedef enum
PRICE_SOURCE_SPLIT_REG, // "user:split-register" PRICE_SOURCE_SPLIT_REG, // "user:split-register"
PRICE_SOURCE_STOCK_SPLIT, // "user:stock-split" PRICE_SOURCE_STOCK_SPLIT, // "user:stock-split"
PRICE_SOURCE_INVOICE, // "user:invoice-post" PRICE_SOURCE_INVOICE, // "user:invoice-post"
PRICE_SOURCE_INVALID, PRICE_SOURCE_TEMP, // "temporary"
PRICE_SOURCE_INVALID, // "invalid"
} PriceSource; } PriceSource;
#define PRICE_TYPE_LAST "last" #define PRICE_TYPE_LAST "last"
@ -188,6 +189,17 @@ GNCPrice *gnc_price_create(QofBook *book);
content-wise duplicate of the given price, p. The returned clone content-wise duplicate of the given price, p. The returned clone
will have a reference count of 1. */ will have a reference count of 1. */
GNCPrice *gnc_price_clone(GNCPrice* p, QofBook *book); GNCPrice *gnc_price_clone(GNCPrice* p, QofBook *book);
/** Return a newly-allocated price that's the inverse of the given price, p.
*
* Inverse means that the commodity and currency are swapped and the value is
* the numeric inverse of the original's. The source is set to PRICE_SOURCE_TEMP
* to prevent it being saved in the pricedb.
* @param p The price to invert
* @return a new price, with a ref-count of 1. Don't forget to unref it!
*/
GNCPrice *gnc_price_invert(GNCPrice *p);
/** @} */ /** @} */
/* ------------------ */ /* ------------------ */
@ -310,142 +322,281 @@ gboolean gnc_price_list_equal(PriceList *prices1, PriceList *prices2);
/** Data type */ /** Data type */
typedef struct gnc_price_db_s GNCPriceDB; typedef struct gnc_price_db_s GNCPriceDB;
/** return the pricedb associated with the book */ /** @brief Return the pricedb associated with the book
/*@ dependent @*/ * @param book The QofBook holding the pricedb
* @return The GNCPriceDB associated with the book.
*/
GNCPriceDB * gnc_pricedb_get_db(QofBook *book); GNCPriceDB * gnc_pricedb_get_db(QofBook *book);
/** @brief Return the pricedb via the Book's collection.
* @param col The QofCollection holding the pricedb
* @return The GNCPriceDB in the QofCollection
*/
GNCPriceDB * gnc_collection_get_pricedb(QofCollection *col); GNCPriceDB * gnc_collection_get_pricedb(QofCollection *col);
/** gnc_pricedb_destroy - destroy the given pricedb and unref all of /** @brief Destroy the given pricedb and unref all of the prices it contains.
the prices it contains. This may not deallocate all of those *
prices. Other code may still be holding references to them. */ * This may not deallocate all of those prices. Other code may still be holding
* references to them.
* @param db The pricedb to destroy.
*/
void gnc_pricedb_destroy(GNCPriceDB *db); void gnc_pricedb_destroy(GNCPriceDB *db);
/** Used for editing the pricedb en-mass */ /** @brief Begin an edit. */
void gnc_pricedb_begin_edit (GNCPriceDB *); void gnc_pricedb_begin_edit (GNCPriceDB *);
/** @brief Commit an edit. */
void gnc_pricedb_commit_edit (GNCPriceDB *); void gnc_pricedb_commit_edit (GNCPriceDB *);
/** Indicate whether or not the database is in the middle of a bulk /** @brief Set flag to indicate whether duplication checks should be performed.
* update. Setting this flag will disable checks for duplicate *
* entries. */ * Normally used at load time to speed up loading the pricedb.
* @param db The pricedb
* @param bulk_update TRUE to disable duplication checks, FALSE to enable them.
*/
void gnc_pricedb_set_bulk_update(GNCPriceDB *db, gboolean bulk_update); void gnc_pricedb_set_bulk_update(GNCPriceDB *db, gboolean bulk_update);
/** gnc_pricedb_add_price - add a price to the pricedb, you may drop /** @brief Add a price to the pricedb.
your reference to the price (i.e. call unref) after this *
succeeds, whenever you're finished with the price. */ * You may drop your reference to the price (i.e. call unref) after this
* succeeds, whenever you're finished with the price.
* @param db The pricedb
* @param p The GNCPrice to add.
* @return TRUE if the price was added, FALSE otherwise.
*/
gboolean gnc_pricedb_add_price(GNCPriceDB *db, GNCPrice *p); gboolean gnc_pricedb_add_price(GNCPriceDB *db, GNCPrice *p);
/** gnc_pricedb_remove_price - removes the given price, p, from the /** @brief Remove a price from the pricedb and unref the price.
pricedb. Returns TRUE if successful, FALSE otherwise. */ * @param db The Pricedb
* @param p The price to remove.
*/
gboolean gnc_pricedb_remove_price(GNCPriceDB *db, GNCPrice *p); gboolean gnc_pricedb_remove_price(GNCPriceDB *db, GNCPrice *p);
/** @brief Remove and unref prices older than a certain time.
* @param db The pricedb
* @param cutoff The time before which prices should be deleted.
* @param delete_user Whether user-created (i.e. not Finance::Quote) prices
* should be deleted.
* @param delete_last Whether a price should be deleted if it's the only
* remaining price for its commodity.
*/
gboolean gnc_pricedb_remove_old_prices(GNCPriceDB *db, Timespec cutoff, gboolean gnc_pricedb_remove_old_prices(GNCPriceDB *db, Timespec cutoff,
const gboolean delete_user, gboolean delete_last); const gboolean delete_user,
gboolean delete_last);
/** gnc_pricedb_lookup_latest - find the most recent price for the /** @brief Find the most recent price between the two commodities.
given commodity in the given currency. Returns NULL on *
failure. */ * The returned GNCPrice may be in either direction so check to ensure that its
* value is correctly applied.
* @param db The pricedb
* @param commodity The first commodity
* @param currency The second commodity
* @return A GNCPrice or NULL if no price exists.
*/
GNCPrice * gnc_pricedb_lookup_latest(GNCPriceDB *db, GNCPrice * gnc_pricedb_lookup_latest(GNCPriceDB *db,
const gnc_commodity *commodity, const gnc_commodity *commodity,
const gnc_commodity *currency); const gnc_commodity *currency);
/** gnc_pricedb_lookup_latest_any_currency - find the most recent prices /** @brief Find the most recent price between a commodity and all other
for the given commodity in any available currency. Prices will be * commodities
returned as a GNCPrice list (see above). */ *
* The returned GNCPrices may be in either direction so check to ensure that
* their values are correctly applied.
* @param db The pricedb
* @param commodity The commodity for which to obtain prices
* @return A PriceList of prices found, or NULL if none found.
*/
PriceList * gnc_pricedb_lookup_latest_any_currency(GNCPriceDB *db, PriceList * gnc_pricedb_lookup_latest_any_currency(GNCPriceDB *db,
const gnc_commodity *commodity); const gnc_commodity *commodity);
/** gnc_pricedb_has_prices - return an indication of whether or not /** @brief Report wether the pricedb contains prices for one commodity in
there are any prices for a given commodity in the given currency. * another.
Returns TRUE if there are prices, FALSE otherwise. */ *
* Does *not* check the reverse direction.
* @param db The pricedb to check
* @param commodity The commodity to check for the existence of prices
* @param currency The commodity in which prices are sought. If NULL reports all
* commodities.
* @return TRUE if matching prices are found, FALSE otherwise.
*/
gboolean gnc_pricedb_has_prices(GNCPriceDB *db, gboolean gnc_pricedb_has_prices(GNCPriceDB *db,
const gnc_commodity *commodity, const gnc_commodity *commodity,
const gnc_commodity *currency); const gnc_commodity *currency);
/** gnc_pricedb_get_prices - return all the prices for a given /** @brief Return all the prices for a given commodity in another.
commodity in the given currency. Returns NULL on failure. The *
result is a GNCPrice list (see above). */ * Does *not* retrieve reverse prices, i.e. prices of the second commodity in
* the first.
* @param db The pricedb from which to retrieve prices.
* @param commodity The commodity for which prices should be retrieved.
* @param currency The commodity in which prices should be quoted. If NULL, all
* prices in any commodity are included.
* @return A PriceList of matching prices or NULL if none were found.
*/
PriceList * gnc_pricedb_get_prices(GNCPriceDB *db, PriceList * gnc_pricedb_get_prices(GNCPriceDB *db,
const gnc_commodity *commodity, const gnc_commodity *commodity,
const gnc_commodity *currency); const gnc_commodity *currency);
/** gnc_pricedb_lookup_at_time - return all prices that match the given /** @brief Find the price between two commodities at a timespec.
commodity, currency, and timespec. Prices will be returned as a *
GNCPrice list (see above). */ * The returned GNCPrice may be in either direction so check to ensure that its
PriceList * gnc_pricedb_lookup_at_time(GNCPriceDB *db, * value is correctly applied.
* @param db The pricedb
* @param commodity The first commodity
* @param currency The second commodity
* @param t The timespec at which to retrieve the price.
* @return A GNCPrice or NULL if none matches.
*/
/* NOT USED */
GNCPrice * gnc_pricedb_lookup_at_time(GNCPriceDB *db,
const gnc_commodity *commodity, const gnc_commodity *commodity,
const gnc_commodity *currency, const gnc_commodity *currency,
Timespec t); Timespec t);
/** gnc_pricedb_lookup_day - return the price that matchex the given /** @brief Return the price between the two commodities on the indicated
commodity, currency, and timespec which is on the same day. * day. Note that the notion of day might be distorted by changes in timezone.
If no prices are on that day, returns a null value. */ *
* The returned GNCPrice may be in either direction so check to ensure that its
* value is correctly applied.
* @param db The pricedb
* @param commodity The first commodity
* @param currency The second commodity
* @param t A time. The price returned will be in the same day as this time
* according to the local timezone.
* @return A GNCPrice or NULL on failure.
*/
GNCPrice * gnc_pricedb_lookup_day(GNCPriceDB *db, GNCPrice * gnc_pricedb_lookup_day(GNCPriceDB *db,
const gnc_commodity *commodity, const gnc_commodity *commodity,
const gnc_commodity *currency, const gnc_commodity *currency,
Timespec t); Timespec t);
/** gnc_pricedb_lookup_nearest_in_time - return the price for the given /** @brief Return the price between the two commoditiesz nearest to the given
commodity in the given currency nearest to the given time t. */ * time.
*
* The returned GNCPrice may be in either direction so check to ensure that its
* value is correctly applied.
* @param db The pricedb
* @param c The first commodity
* @param currency The second commodity
* @param t The time nearest to which the returned price should be.
* @return A GNCPrice or NULL if no prices exist between the two commodities.
*/
GNCPrice * gnc_pricedb_lookup_nearest_in_time(GNCPriceDB *db, GNCPrice * gnc_pricedb_lookup_nearest_in_time(GNCPriceDB *db,
const gnc_commodity *c, const gnc_commodity *c,
const gnc_commodity *currency, const gnc_commodity *currency,
Timespec t); Timespec t);
/** gnc_pricedb_lookup_nearest_in_time_any_currency - return all prices that /** @brief Return the price nearest in time to that given between the given
match the given commodity and timespec in any available currency. Prices * commodity and every other.
will be returned as a GNCPrice list (see above). */ *
* The returned GNCPrices may be in either direction so check to ensure that
* their values are correctly applied.
*
* @param db, The pricedb
* @param c, The commodity for which prices should be obtained.
* @param t, The time nearest to which the prices should be obtained.
* @return A PriceList of prices for each commodity pair found or NULL if none
* are.
*/
PriceList * gnc_pricedb_lookup_nearest_in_time_any_currency(GNCPriceDB *db, PriceList * gnc_pricedb_lookup_nearest_in_time_any_currency(GNCPriceDB *db,
const gnc_commodity *c, const gnc_commodity *c,
Timespec t); Timespec t);
/** gnc_pricedb_lookup_latest_before - return the latest price for the given commodity
in the given currency up to and including time t. */ /** @brief Return the latest price between the given commodities before the
* given time.
*
* The returned GNCPrice may be in either direction so check to ensure that its
* value is correctly applied.
* @param db The pricedb
* @param c The first commodity
* @param currency The second commodity
* @param t The time before which to find the price
* @return A GNCPrice or NULL if no prices are found before t.
*/
/* NOT USED, but see bug 743753 */
GNCPrice * gnc_pricedb_lookup_latest_before(GNCPriceDB *db, GNCPrice * gnc_pricedb_lookup_latest_before(GNCPriceDB *db,
gnc_commodity *c, gnc_commodity *c,
gnc_commodity *currency, gnc_commodity *currency,
Timespec t); Timespec t);
/** gnc_pricedb_lookup_latest_before_any_currency - return recent prices that /** @brief Return the latest price between the given commodity and any other
match the given commodity up to and including time t in any available currency. Prices * before the given time.
will be returned as a GNCPrice list (see above). */ *
* The returned GNCPrice may be in either direction so check to ensure that its
* value is correctly applied.
* @param db The pricedb
* @param c The commodity
* @param t The time before which to find prices
* @return A PriceList of prices for each commodity found or NULL if none are.
*/
/* NOT USED, but see bug 743753 */
PriceList * gnc_pricedb_lookup_latest_before_any_currency(GNCPriceDB *db, PriceList * gnc_pricedb_lookup_latest_before_any_currency(GNCPriceDB *db,
gnc_commodity *c, const gnc_commodity *c,
Timespec t); Timespec t);
/** gnc_pricedb_convert_balance_latest_price - Convert a balance /** @brief Convert a balance from one currency to another using the most recent
from one currency to another. */ * price between the two.
* @param pdb The pricedb
* @param balance The balance to be converted
* @param balance_currency The commodity in which the balance is currently
* expressed
* @param new_currency The commodity to which the balance should be converted
* @return A new balance or gnc_numeric_zero if no price is available.
*/
gnc_numeric gnc_numeric
gnc_pricedb_convert_balance_latest_price(GNCPriceDB *pdb, gnc_pricedb_convert_balance_latest_price(GNCPriceDB *pdb,
gnc_numeric balance, gnc_numeric balance,
const gnc_commodity *balance_currency, const gnc_commodity *balance_currency,
const gnc_commodity *new_currency); const gnc_commodity *new_currency);
/** gnc_pricedb_convert_balance_nearest_price - Convert a balance /** @brief Convert a balance from one currency to another using the price
from one currency to another. */ * nearest to the given time.
* @param pdb The pricedb
* @param balance The balance to be converted
* @param balance_currency The commodity in which the balance is currently
* expressed
* @param new_currency The commodity to which the balance should be converted
* @param t The time nearest to which price should be used.
* @return A new balance or gnc_numeric_zero if no price is available.
*/
gnc_numeric gnc_numeric
gnc_pricedb_convert_balance_nearest_price(GNCPriceDB *pdb, gnc_pricedb_convert_balance_nearest_price(GNCPriceDB *pdb,
gnc_numeric balance, gnc_numeric balance,
const gnc_commodity *balance_currency, const gnc_commodity *balance_currency,
const gnc_commodity *new_currency, const gnc_commodity *new_currency,
Timespec t); Timespec t);
/** gnc_pricedb_foreach_price - call f once for each price in db, until typedef gboolean (*GncPriceForeachFunc)(GNCPrice *p, gpointer user_data);
and unless f returns FALSE. If stable_order is not FALSE, make
sure the ordering of the traversal is stable (i.e. the same order /** @brief Call a GncPriceForeachFunction once for each price in db, until the
every time given the same db contents -- stable traversals may be * function returns FALSE.
less efficient). */ *
* If stable_order is not FALSE, make sure the ordering of the traversal is
* stable (i.e. the same order every time given the same db contents -- stable
* traversals may be less efficient).
* @param db The pricedb
* @param f The function to call
* @param user_data A data to pass to each invocation of f
* @param stable_order Ensure that the traversal is performed in the same order
* each time.
* @return TRUE if all calls to f succeeded (unstable) or if the order of
* processing was the same as the previous invocation (stable), FALSE otherwise.
*/
gboolean gnc_pricedb_foreach_price(GNCPriceDB *db, gboolean gnc_pricedb_foreach_price(GNCPriceDB *db,
gboolean (*f)(GNCPrice *p, GncPriceForeachFunc f,
gpointer user_data),
gpointer user_data, gpointer user_data,
gboolean stable_order); gboolean stable_order);
/* The following two convenience functions are used to test the xml backend */ /* The following two convenience functions are used to test the xml backend */
/** gnc_pricedb_get_num_prices - return the number of prices /** @brief Return the number of prices in the database.
in the database. */ *
* For XML Backend Testing
*/
guint gnc_pricedb_get_num_prices(GNCPriceDB *db); guint gnc_pricedb_get_num_prices(GNCPriceDB *db);
/** gnc_pricedb_equal - test equality of two pricedbs */
/** @brief Test equality of two pricedbs
*
* For XML Backend Testing */
gboolean gnc_pricedb_equal (GNCPriceDB *db1, GNCPriceDB *db2); gboolean gnc_pricedb_equal (GNCPriceDB *db1, GNCPriceDB *db2);
/** @name Internal/Debugging /** @name Internal/Debugging

1
src/engine/test/Makefile.am
View File

@ -114,6 +114,7 @@ test_engine_SOURCES = \
utest-Entry.c \ utest-Entry.c \
utest-Invoice.c \ utest-Invoice.c \
test-engine-kvp-properties.c \ test-engine-kvp-properties.c \
utest-gnc-pricedb.c \
dummy.cpp dummy.cpp
test_engine_LDADD = \ test_engine_LDADD = \

2
src/engine/test/test-engine-kvp-properties.c
View File

@ -129,7 +129,7 @@ teardown (Fixture *fixture, gconstpointer pData)
*/ */
QofBook *book = qof_instance_get_book (QOF_INSTANCE (fixture->acct)); QofBook *book = qof_instance_get_book (QOF_INSTANCE (fixture->acct));
test_destroy (fixture->acct); test_destroy (fixture->acct);
test_destroy (book); qof_book_destroy (book);
} }
static void static void

2
src/engine/test/test-engine.c
View File

@ -33,6 +33,7 @@ extern void test_suite_gncInvoice();
extern void test_suite_transaction(); extern void test_suite_transaction();
extern void test_suite_split(); extern void test_suite_split();
extern void test_suite_engine_kvp_properties (void); extern void test_suite_engine_kvp_properties (void);
extern void test_suite_gnc_pricedb();
int int
main (int argc, main (int argc,
@ -53,6 +54,7 @@ main (int argc,
test_suite_transaction(); test_suite_transaction();
test_suite_split(); test_suite_split();
test_suite_engine_kvp_properties (); test_suite_engine_kvp_properties ();
test_suite_gnc_pricedb();
return g_test_run( ); return g_test_run( );
} }

1408
src/engine/test/utest-gnc-pricedb.c Normal file
View File

File diff suppressed because it is too large Load Diff

44
src/gnome-utils/dialog-transfer.c
View File

@ -263,34 +263,18 @@ lookup_price(PriceReq *pr, PriceDate pd)
case SAME_DAY: case SAME_DAY:
prc = gnc_pricedb_lookup_day (pr->pricedb, pr->from, prc = gnc_pricedb_lookup_day (pr->pricedb, pr->from,
pr->to, pr->ts); pr->to, pr->ts);
if (!prc) break;
{
prc = gnc_pricedb_lookup_day (pr->pricedb, pr->to,
pr->from, pr->ts);
pr->reverse = TRUE;
}
break;
case NEAREST: case NEAREST:
prc = gnc_pricedb_lookup_nearest_in_time (pr->pricedb, pr->from, prc = gnc_pricedb_lookup_nearest_in_time (pr->pricedb, pr->from,
pr->to, pr->ts); pr->to, pr->ts);
if (!prc) break;
{
prc = gnc_pricedb_lookup_nearest_in_time (pr->pricedb, pr->to,
pr->from, pr->ts);
pr->reverse = TRUE;
}
break;
case LATEST: case LATEST:
prc = gnc_pricedb_lookup_latest (pr->pricedb, pr->from, pr->to); prc = gnc_pricedb_lookup_latest (pr->pricedb, pr->from, pr->to);
if (!prc)
{
prc = gnc_pricedb_lookup_latest (pr->pricedb, pr->to, pr->from);
pr->reverse = TRUE;
}
break; break;
} }
if (pr->reverse) if (gnc_commodity_equiv(gnc_price_get_currency(prc), pr->from))
{ {
pr->reverse = TRUE;
PINFO("Found reverse price: 1 %s = %f %s", PINFO("Found reverse price: 1 %s = %f %s",
gnc_commodity_get_mnemonic(pr->to), gnc_commodity_get_mnemonic(pr->to),
gnc_numeric_to_double(gnc_price_get_value(prc)), gnc_numeric_to_double(gnc_price_get_value(prc)),
@ -1567,20 +1551,6 @@ create_transaction(XferDialog *xferData, Timespec *ts,
xferData->transaction_cb(trans, xferData->transaction_user_data); xferData->transaction_cb(trans, xferData->transaction_user_data);
} }
static void
swap_amount (gnc_commodity **from, gnc_commodity **to, gnc_numeric *value,
gnc_numeric *from_amt, gnc_numeric *to_amt)
{
gnc_commodity *tmp = *from;
gnc_numeric *tmp_amt = from_amt;
*from = *to;
*to = tmp;
from_amt = to_amt;
to_amt = tmp_amt;
*value = gnc_numeric_invert (*value);
*value = round_price(*from, *to, *value);
}
static gnc_numeric static gnc_numeric
swap_commodities(gnc_commodity **from, gnc_commodity **to, gnc_numeric value) swap_commodities(gnc_commodity **from, gnc_commodity **to, gnc_numeric value)
{ {
@ -1609,12 +1579,6 @@ create_price(XferDialog *xferData, Timespec ts)
return; return;
value = gnc_amount_edit_get_amount(GNC_AMOUNT_EDIT(xferData->price_edit)); value = gnc_amount_edit_get_amount(GNC_AMOUNT_EDIT(xferData->price_edit));
/* Try to be consistent about how quotes are installed. */
if (from == gnc_default_currency() ||
((to != gnc_default_currency()) &&
(strcmp (gnc_commodity_get_mnemonic(from),
gnc_commodity_get_mnemonic(to)) < 0)))
swap_amount (&from, &to, &value, &from_amt, &to_amt);
/* Normally we want to store currency rates such that the rate > 1 and commodity /* Normally we want to store currency rates such that the rate > 1 and commodity
* prices in terms of a currency regardless of value. However, if we already * prices in terms of a currency regardless of value. However, if we already

32
src/gnome-utils/gnc-tree-util-split-reg.c
View File

@ -90,38 +90,16 @@ static gnc_numeric
gtu_sr_get_rate_from_db (gnc_commodity *from, gnc_commodity *to) gtu_sr_get_rate_from_db (gnc_commodity *from, gnc_commodity *to)
{ {
GNCPrice *prc; GNCPrice *prc;
gnc_numeric rate_split;
gboolean have_rate = FALSE;
QofBook *book = gnc_get_current_book (); QofBook *book = gnc_get_current_book ();
/* Do we have a rate allready */
prc = gnc_pricedb_lookup_latest (gnc_pricedb_get_db (book), from, to); prc = gnc_pricedb_lookup_latest (gnc_pricedb_get_db (book), from, to);
if (prc)
{
rate_split = gnc_price_get_value (prc);
gnc_price_unref (prc);
have_rate = TRUE;
}
/* Lets try reversing the commodities */ if (!prc)
if (!have_rate) return gnc_numeric_create (100, 100);
{
prc = gnc_pricedb_lookup_latest (gnc_pricedb_get_db (book), to, from);
if (prc)
{
rate_split = gnc_numeric_div (gnc_numeric_create (100, 100), gnc_price_get_value (prc),
GNC_DENOM_AUTO, GNC_HOW_DENOM_REDUCE);
gnc_price_unref (prc); if (gnc_commodity_equiv(from, gnc_price_get_currency(prc)))
have_rate = TRUE; return gnc_numeric_invert(gnc_price_get_value(prc));
} return gnc_price_get_value(prc);
}
/* No rate, set to 1/1 */
if (!have_rate)
rate_split = gnc_numeric_create (100, 100);
return rate_split;
} }

42
src/gnome-utils/window-main-summarybar.c
View File

@ -148,20 +148,23 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
for (node = children; node; node = g_list_next(node)) for (node = children; node; node = g_list_next(node))
{ {
Account *account = node->data; Account *account = node->data;
QofBook *book = gnc_account_get_book (account);
GNCPriceDB *pricedb = gnc_pricedb_get_db (book);
gnc_commodity *to_curr = options.default_currency;
account_type = xaccAccountGetType(account); account_type = xaccAccountGetType(account);
account_currency = xaccAccountGetCommodity(account); account_currency = xaccAccountGetCommodity(account);
if (options.grand_total) if (options.grand_total)
grand_total_accum = gnc_ui_get_currency_accumulator(currency_list, grand_total_accum = gnc_ui_get_currency_accumulator(currency_list,
options.default_currency, to_curr,
TOTAL_GRAND_TOTAL); TOTAL_GRAND_TOTAL);
if (!gnc_commodity_is_currency(account_currency)) if (!gnc_commodity_is_currency(account_currency))
{ {
non_currency = TRUE; non_currency = TRUE;
non_curr_accum = gnc_ui_get_currency_accumulator(currency_list, non_curr_accum = gnc_ui_get_currency_accumulator(currency_list,
options.default_currency, to_curr,
TOTAL_NON_CURR_TOTAL); TOTAL_NON_CURR_TOTAL);
} }
@ -186,9 +189,10 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
end_amount = xaccAccountGetBalanceAsOfDate(account, options.end_date); end_amount = xaccAccountGetBalanceAsOfDate(account, options.end_date);
timespecFromTime64(&end_timespec, options.end_date); timespecFromTime64(&end_timespec, options.end_date);
end_amount_default_currency = end_amount_default_currency =
xaccAccountConvertBalanceToCurrencyAsOfDate gnc_pricedb_convert_balance_nearest_price (pricedb, end_amount,
(account, end_amount, account_currency, options.default_currency, account_currency,
timespecToTime64(timespecCanonicalDayTime(end_timespec))); to_curr,
end_timespec);
if (!non_currency || options.non_currency) if (!non_currency || options.non_currency)
{ {
@ -202,7 +206,7 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
{ {
non_curr_accum->assets = non_curr_accum->assets =
gnc_numeric_add (non_curr_accum->assets, end_amount_default_currency, gnc_numeric_add (non_curr_accum->assets, end_amount_default_currency,
gnc_commodity_get_fraction (options.default_currency), gnc_commodity_get_fraction (to_curr),
GNC_HOW_RND_ROUND_HALF_UP); GNC_HOW_RND_ROUND_HALF_UP);
} }
@ -210,7 +214,7 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
{ {
grand_total_accum->assets = grand_total_accum->assets =
gnc_numeric_add (grand_total_accum->assets, end_amount_default_currency, gnc_numeric_add (grand_total_accum->assets, end_amount_default_currency,
gnc_commodity_get_fraction (options.default_currency), gnc_commodity_get_fraction (to_curr),
GNC_HOW_RND_ROUND_HALF_UP); GNC_HOW_RND_ROUND_HALF_UP);
} }
@ -221,15 +225,18 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
start_amount = xaccAccountGetBalanceAsOfDate(account, options.start_date); start_amount = xaccAccountGetBalanceAsOfDate(account, options.start_date);
timespecFromTime64(&start_timespec, options.start_date); timespecFromTime64(&start_timespec, options.start_date);
start_amount_default_currency = start_amount_default_currency =
xaccAccountConvertBalanceToCurrencyAsOfDate gnc_pricedb_convert_balance_nearest_price (pricedb,
(account, start_amount, account_currency, options.default_currency, start_amount,
timespecToTime64(timespecCanonicalDayTime(start_timespec))); account_currency,
to_curr,
start_timespec);
end_amount = xaccAccountGetBalanceAsOfDate(account, options.end_date); end_amount = xaccAccountGetBalanceAsOfDate(account, options.end_date);
timespecFromTime64(&end_timespec, options.end_date); timespecFromTime64(&end_timespec, options.end_date);
end_amount_default_currency = end_amount_default_currency =
xaccAccountConvertBalanceToCurrencyAsOfDate gnc_pricedb_convert_balance_nearest_price (pricedb, end_amount,
(account, end_amount, account_currency, options.default_currency, account_currency,
timespecToTime64(timespecCanonicalDayTime(end_timespec))); to_curr,
end_timespec);
if (!non_currency || options.non_currency) if (!non_currency || options.non_currency)
{ {
@ -247,11 +254,11 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
{ {
non_curr_accum->profits = non_curr_accum->profits =
gnc_numeric_add (non_curr_accum->profits, start_amount_default_currency, gnc_numeric_add (non_curr_accum->profits, start_amount_default_currency,
gnc_commodity_get_fraction (options.default_currency), gnc_commodity_get_fraction (to_curr),
GNC_HOW_RND_ROUND_HALF_UP); GNC_HOW_RND_ROUND_HALF_UP);
non_curr_accum->profits = non_curr_accum->profits =
gnc_numeric_sub (non_curr_accum->profits, end_amount_default_currency, gnc_numeric_sub (non_curr_accum->profits, end_amount_default_currency,
gnc_commodity_get_fraction (options.default_currency), gnc_commodity_get_fraction (to_curr),
GNC_HOW_RND_ROUND_HALF_UP); GNC_HOW_RND_ROUND_HALF_UP);
} }
@ -260,12 +267,12 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
grand_total_accum->profits = grand_total_accum->profits =
gnc_numeric_add (grand_total_accum->profits, gnc_numeric_add (grand_total_accum->profits,
start_amount_default_currency, start_amount_default_currency,
gnc_commodity_get_fraction (options.default_currency), gnc_commodity_get_fraction (to_curr),
GNC_HOW_RND_ROUND_HALF_UP); GNC_HOW_RND_ROUND_HALF_UP);
grand_total_accum->profits = grand_total_accum->profits =
gnc_numeric_sub (grand_total_accum->profits, gnc_numeric_sub (grand_total_accum->profits,
end_amount_default_currency, end_amount_default_currency,
gnc_commodity_get_fraction (options.default_currency), gnc_commodity_get_fraction (to_curr),
GNC_HOW_RND_ROUND_HALF_UP); GNC_HOW_RND_ROUND_HALF_UP);
} }
@ -568,4 +575,3 @@ gnc_main_window_summary_new (void)
return retval->hbox; return retval->hbox;
} }

5
src/gnome/assistant-stock-split.c
View File

@ -231,7 +231,10 @@ refresh_details_page (StockSplitInfo *info)
if (prices) if (prices)
{ {
/* Use the first existing price */ /* Use the first existing price */
currency = gnc_price_get_currency(prices->data); if (gnc_commodity_equiv (commodity, gnc_price_get_currency(prices->data)))
currency = gnc_price_get_commodity(prices->data);
else
currency = gnc_price_get_currency(prices->data);
} }
else else
{ {

6
src/gnome/dialog-price-editor.c
View File

@ -347,7 +347,11 @@ pedit_commodity_changed_cb (GtkComboBox *cbwe, gpointer data)
(pedit_dialog->price_db, commodity); (pedit_dialog->price_db, commodity);
if (price_list) if (price_list)
{ {
currency = gnc_price_get_currency((GNCPrice *)price_list->data); GNCPrice * price = (GNCPrice*)price_list->data;
if (gnc_commodity_equiv(commodity, gnc_price_get_currency(price)))
currency = gnc_price_get_commodity((GNCPrice *)price);
else
currency = gnc_price_get_currency((GNCPrice *)price);
if (currency) if (currency)
gnc_currency_edit_set_currency gnc_currency_edit_set_currency

150
src/gnome/gnc-split-reg.c
View File

@ -495,49 +495,6 @@ gsr_update_summary_label( GtkWidget *label,
gtk_label_set_text( GTK_LABEL(label), string ); gtk_label_set_text( GTK_LABEL(label), string );
} }
static GNCPrice *
account_latest_price (Account *account)
{
QofBook *book;
GNCPriceDB *pdb;
gnc_commodity *commodity;
gnc_commodity *currency;
if (!account) return NULL;
commodity = xaccAccountGetCommodity (account);
currency = gnc_default_currency ();
book = gnc_account_get_book (account);
pdb = gnc_pricedb_get_db (book);
return gnc_pricedb_lookup_latest (pdb, commodity, currency);
}
static GNCPrice *
account_latest_price_any_currency (Account *account)
{
QofBook *book;
GNCPriceDB *pdb;
gnc_commodity *commodity;
GList *price_list;
GNCPrice *result;
if (!account) return NULL;
commodity = xaccAccountGetCommodity (account);
book = gnc_account_get_book (account);
pdb = gnc_pricedb_get_db (book);
price_list = gnc_pricedb_lookup_latest_any_currency (pdb, commodity);
if (!price_list) return NULL;
result = gnc_price_clone((GNCPrice *)(price_list->data), book);
gnc_price_list_destroy(price_list);
return result;
}
static static
void void
gsr_redraw_all_cb (GnucashRegister *g_reg, gpointer data) gsr_redraw_all_cb (GnucashRegister *g_reg, gpointer data)
@ -546,7 +503,6 @@ gsr_redraw_all_cb (GnucashRegister *g_reg, gpointer data)
gnc_commodity * commodity; gnc_commodity * commodity;
GNCPrintAmountInfo print_info; GNCPrintAmountInfo print_info;
gnc_numeric amount; gnc_numeric amount;
char string[256];
Account *leader; Account *leader;
gboolean reverse; gboolean reverse;
gboolean euro; gboolean euro;
@ -583,18 +539,18 @@ gsr_redraw_all_cb (GnucashRegister *g_reg, gpointer data)
gsr_update_summary_label( gsr->projectedminimum_label, gsr_update_summary_label( gsr->projectedminimum_label,
xaccAccountGetProjectedMinimumBalance, xaccAccountGetProjectedMinimumBalance,
leader, print_info, commodity, reverse, euro ); leader, print_info, commodity, reverse, euro );
if (gsr->shares_label == NULL && gsr->value_label == NULL)
return;
amount = xaccAccountGetBalance( leader );
if (reverse)
amount = gnc_numeric_neg( amount );
/* Print the summary share amount */ /* Print the summary share amount */
if (gsr->shares_label != NULL) if (gsr->shares_label != NULL)
{ {
char string[256];
print_info = gnc_account_print_info( leader, TRUE ); print_info = gnc_account_print_info( leader, TRUE );
amount = xaccAccountGetBalance( leader );
if (reverse)
amount = gnc_numeric_neg( amount );
xaccSPrintAmount( string, amount, print_info ); xaccSPrintAmount( string, amount, print_info );
gnc_set_label_color( gsr->shares_label, amount ); gnc_set_label_color( gsr->shares_label, amount );
gtk_label_set_text( GTK_LABEL(gsr->shares_label), string ); gtk_label_set_text( GTK_LABEL(gsr->shares_label), string );
} }
@ -602,86 +558,18 @@ gsr_redraw_all_cb (GnucashRegister *g_reg, gpointer data)
/* Print the summary share value */ /* Print the summary share value */
if (gsr->value_label != NULL) if (gsr->value_label != NULL)
{ {
GNCPrice *price; char string[256];
QofBook *book = gnc_account_get_book (leader);
GNCPriceDB *pricedb = gnc_pricedb_get_db (book);
gnc_commodity *currency = gnc_default_currency ();
gnc_numeric currency_value =
gnc_pricedb_convert_balance_latest_price(pricedb, amount,
commodity, currency);
print_info = gnc_commodity_print_info (currency, TRUE);
xaccSPrintAmount (string, amount, print_info);
gnc_set_label_color (gsr->value_label, amount);
gtk_label_set_text (GTK_LABEL (gsr->value_label), string);
amount = xaccAccountGetBalance (leader);
if (reverse) amount = gnc_numeric_neg (amount);
price = account_latest_price (leader);
if (!price)
{
/* If the balance is zero, then print zero. */
if (gnc_numeric_equal(amount, gnc_numeric_zero()))
{
gnc_commodity *currency = gnc_default_currency ();
print_info = gnc_commodity_print_info (currency, TRUE);
amount = gnc_numeric_zero ();
xaccSPrintAmount (string, amount, print_info);
gnc_set_label_color (gsr->value_label, amount);
gtk_label_set_text (GTK_LABEL (gsr->value_label), string);
}
else
{
/* else try to do a double-price-conversion :-( */
price = account_latest_price_any_currency (leader);
if (!price)
{
gnc_set_label_color (gsr->value_label, gnc_numeric_zero ());
gtk_label_set_text (GTK_LABEL (gsr->value_label),
_("<No information>"));
}
else
{
gnc_commodity *currency = gnc_price_get_currency (price);
gnc_commodity *default_currency = gnc_default_currency ();
gnc_numeric currency_amount;
gnc_numeric default_currency_amount;
print_info = gnc_commodity_print_info (currency, TRUE);
currency_amount =
xaccAccountConvertBalanceToCurrency(leader, amount,
commodity, currency);
xaccSPrintAmount (string, currency_amount, print_info);
default_currency_amount =
xaccAccountConvertBalanceToCurrency(leader, amount,
commodity,
default_currency);
if (!gnc_numeric_zero_p(default_currency_amount))
{
strcat( string, " / " );
print_info = gnc_commodity_print_info (default_currency, TRUE);
xaccSPrintAmount( string + strlen( string ), default_currency_amount,
print_info);
}
gnc_set_label_color (gsr->value_label, amount);
gtk_label_set_text (GTK_LABEL (gsr->value_label), string);
gnc_price_unref (price);
}
}
}
else
{
gnc_commodity *currency = gnc_price_get_currency (price);
print_info = gnc_commodity_print_info (currency, TRUE);
amount = gnc_numeric_mul (amount, gnc_price_get_value (price),
gnc_commodity_get_fraction (currency),
GNC_HOW_RND_ROUND_HALF_UP);
xaccSPrintAmount (string, amount, print_info);
gnc_set_label_color (gsr->value_label, amount);
gtk_label_set_text (GTK_LABEL (gsr->value_label), string);
gnc_price_unref (price);
}
} }
} }
@ -1883,7 +1771,7 @@ gnc_split_reg_sort_notes_cb(GtkWidget *w, gpointer data)
} }
void void
gnc_split_reg_set_sort_reversed(GNCSplitReg *gsr, gboolean rev) gnc_split_reg_set_sort_reversed(GNCSplitReg *gsr, gboolean rev)
{ {
Query *query = gnc_ledger_display_get_query( gsr->ledger ); Query *query = gnc_ledger_display_get_query( gsr->ledger );

149
src/gnome/gnc-split-reg2.c
View File

@ -242,7 +242,7 @@ gsr2_create_table (GNCSplitReg2 *gsr)
const GncGUID * guid; const GncGUID * guid;
Account * account; Account * account;
const gchar *sort_string; const gchar *sort_string;
account = gnc_ledger_display2_leader (gsr->ledger); account = gnc_ledger_display2_leader (gsr->ledger);
guid = xaccAccountGetGUID (account); guid = xaccAccountGetGUID (account);
@ -495,49 +495,6 @@ gsr2_update_summary_label (GtkWidget *label,
gtk_label_set_text( GTK_LABEL(label), string ); gtk_label_set_text( GTK_LABEL(label), string );
} }
static GNCPrice *
account_latest_price (Account *account)
{
QofBook *book;
GNCPriceDB *pdb;
gnc_commodity *commodity;
gnc_commodity *currency;
if (!account) return NULL;
commodity = xaccAccountGetCommodity (account);
currency = gnc_default_currency ();
book = gnc_account_get_book (account);
pdb = gnc_pricedb_get_db (book);
return gnc_pricedb_lookup_latest (pdb, commodity, currency);
}
static GNCPrice *
account_latest_price_any_currency (Account *account)
{
QofBook *book;
GNCPriceDB *pdb;
gnc_commodity *commodity;
GList *price_list;
GNCPrice *result;
if (!account) return NULL;
commodity = xaccAccountGetCommodity (account);
book = gnc_account_get_book (account);
pdb = gnc_pricedb_get_db (book);
price_list = gnc_pricedb_lookup_latest_any_currency (pdb, commodity);
if (!price_list) return NULL;
result = gnc_price_clone ((GNCPrice *)(price_list->data), book);
gnc_price_list_destroy (price_list);
return result;
}
static static
void void
gsr2_redraw_all_cb (GncTreeViewSplitReg *view, gpointer user_data) gsr2_redraw_all_cb (GncTreeViewSplitReg *view, gpointer user_data)
@ -546,7 +503,6 @@ gsr2_redraw_all_cb (GncTreeViewSplitReg *view, gpointer user_data)
gnc_commodity * commodity; gnc_commodity * commodity;
GNCPrintAmountInfo print_info; GNCPrintAmountInfo print_info;
gnc_numeric amount; gnc_numeric amount;
char string[256];
Account *leader; Account *leader;
gboolean reverse; gboolean reverse;
gboolean euro; gboolean euro;
@ -584,17 +540,12 @@ gsr2_redraw_all_cb (GncTreeViewSplitReg *view, gpointer user_data)
xaccAccountGetProjectedMinimumBalance, xaccAccountGetProjectedMinimumBalance,
leader, print_info, commodity, reverse, euro ); leader, print_info, commodity, reverse, euro );
/* Print the summary share amount */ /* Print the summary share amount */
if (gsr->shares_label != NULL) if (gsr->shares_label != NULL)
{ {
char string[256];
print_info = gnc_account_print_info( leader, TRUE ); print_info = gnc_account_print_info( leader, TRUE );
amount = xaccAccountGetBalance( leader );
if (reverse)
amount = gnc_numeric_neg( amount );
xaccSPrintAmount( string, amount, print_info ); xaccSPrintAmount( string, amount, print_info );
gnc_set_label_color( gsr->shares_label, amount ); gnc_set_label_color( gsr->shares_label, amount );
gtk_label_set_text( GTK_LABEL(gsr->shares_label), string ); gtk_label_set_text( GTK_LABEL(gsr->shares_label), string );
} }
@ -602,89 +553,23 @@ gsr2_redraw_all_cb (GncTreeViewSplitReg *view, gpointer user_data)
/* Print the summary share value */ /* Print the summary share value */
if (gsr->value_label != NULL) if (gsr->value_label != NULL)
{ {
GNCPrice *price; char string[256];
QofBook *book = gnc_account_get_book (leader);
GNCPriceDB *pricedb = gnc_pricedb_get_db (book);
gnc_commodity *commodity = xaccAccountGetCommodity (leader);
gnc_commodity *currency = gnc_default_currency ();
gnc_numeric currency_value =
gnc_pricedb_convert_balance_latest_price(pricedb, amount,
commodity, currency);
print_info = gnc_commodity_print_info (currency, TRUE);
xaccSPrintAmount (string, amount, print_info);
gnc_set_label_color (gsr->value_label, amount);
gtk_label_set_text (GTK_LABEL (gsr->value_label), string);
amount = xaccAccountGetBalance (leader);
if (reverse) amount = gnc_numeric_neg (amount);
price = account_latest_price (leader);
if (!price)
{
/* If the balance is zero, then print zero. */
if (gnc_numeric_equal(amount, gnc_numeric_zero()))
{
gnc_commodity *currency = gnc_default_currency ();
print_info = gnc_commodity_print_info (currency, TRUE);
amount = gnc_numeric_zero ();
xaccSPrintAmount (string, amount, print_info);
gnc_set_label_color (gsr->value_label, amount);
gtk_label_set_text (GTK_LABEL (gsr->value_label), string);
}
else
{
/* else try to do a double-price-conversion :-( */
price = account_latest_price_any_currency (leader);
if (!price)
{
gnc_set_label_color (gsr->value_label, gnc_numeric_zero ());
gtk_label_set_text (GTK_LABEL (gsr->value_label),
_("<No information>"));
}
else
{
gnc_commodity *currency = gnc_price_get_currency (price);
gnc_commodity *default_currency = gnc_default_currency ();
gnc_numeric currency_amount;
gnc_numeric default_currency_amount;
print_info = gnc_commodity_print_info (currency, TRUE);
currency_amount =
xaccAccountConvertBalanceToCurrency(leader, amount,
commodity, currency);
xaccSPrintAmount (string, currency_amount, print_info);
default_currency_amount =
xaccAccountConvertBalanceToCurrency(leader, amount,
commodity,
default_currency);
if (!gnc_numeric_zero_p(default_currency_amount))
{
strcat( string, " / " );
print_info = gnc_commodity_print_info (default_currency, TRUE);
xaccSPrintAmount( string + strlen( string ), default_currency_amount,
print_info);
}
gnc_set_label_color (gsr->value_label, amount);
gtk_label_set_text (GTK_LABEL (gsr->value_label), string);
gnc_price_unref (price);
}
}
}
else
{
gnc_commodity *currency = gnc_price_get_currency (price);
print_info = gnc_commodity_print_info (currency, TRUE);
amount = gnc_numeric_mul (amount, gnc_price_get_value (price),
gnc_commodity_get_fraction (currency),
GNC_HOW_RND_ROUND_HALF_UP);
xaccSPrintAmount (string, amount, print_info);
gnc_set_label_color (gsr->value_label, amount);
gtk_label_set_text (GTK_LABEL (gsr->value_label), string);
gnc_price_unref (price);
}
} }
} }
static void static void
gnc_split_reg2_ld_destroy (GNCLedgerDisplay2 *ledger) gnc_split_reg2_ld_destroy (GNCLedgerDisplay2 *ledger)
{ {
@ -774,7 +659,7 @@ gnc_split_reg2_sort_changed_cb (GtkTreeSortable *sortable, gpointer user_data)
Query *query; Query *query;
GNCSplitReg2 *gsr = user_data; GNCSplitReg2 *gsr = user_data;
GncTreeViewSplitReg *view; GncTreeViewSplitReg *view;
GncTreeModelSplitReg *model; GncTreeModelSplitReg *model;
GtkSortType type; GtkSortType type;
gint sortcol; gint sortcol;
gint sort_depth; gint sort_depth;

9
src/quotes/gnc-fq-dump
View File

@ -166,6 +166,15 @@ if ($exchange eq "currency") {
while ($#ARGV >= 0) { while ($#ARGV >= 0) {
my $to = shift; my $to = shift;
my $result = $q->currency($from, $to); my $result = $q->currency($from, $to);
unless (defined($result) && $result >= 1) {
my $inv_res = $q->currency($to, $from);
if (defined($inv_res)) {
my $tmp = $to;
$to = $from;
$from = $tmp;
$result = $inv_res;
}
}
if (defined($result)) { if (defined($result)) {
printf "1 $from = $result $to\n"; printf "1 $from = $result $to\n";
} else { } else {

13
src/quotes/gnc-fq-helper.in
View File

@ -350,6 +350,19 @@ while(<>) {
last unless $to_currency; last unless $to_currency;
my $price = $quoter->currency($from_currency, $to_currency); my $price = $quoter->currency($from_currency, $to_currency);
my $inv_price = undef;
#Sometimes price quotes are available in only one direction, and if the
#direction we asked for results in a quote < 1 we want the other direction
#if it's available to get more significant digits.
unless (defined($price) && $price > 1) {
$inv_price = $quoter->currency($to_currency, $from_currency);
if (defined($inv_price)) {
my $tmp = $to_currency;
$to_currency = $from_currency;
$from_currency = $tmp;
$price = $inv_price;
}
}
$quote_data{$from_currency, "success"} = defined($price); $quote_data{$from_currency, "success"} = defined($price);
$quote_data{$from_currency, "symbol"} = $from_currency; $quote_data{$from_currency, "symbol"} = $from_currency;

10
src/register/ledger-core/split-register.c
View File

@ -2067,15 +2067,9 @@ record_price (SplitRegister *reg, Account *account, gnc_numeric value,
return; return;
gnc_date_cell_get_date ((DateCell*)cell, &ts); gnc_date_cell_get_date ((DateCell*)cell, &ts);
price = gnc_pricedb_lookup_day (pricedb, comm, curr, ts); price = gnc_pricedb_lookup_day (pricedb, comm, curr, ts);
if (!price) if (gnc_commodity_equiv (comm, gnc_price_get_currency (price)))
{
price = gnc_pricedb_lookup_day (pricedb, curr, comm, ts);
if (price)
/* It might be better to raise an error here: We shouldn't be creating
* currency->commodity prices.
*/
swap = TRUE; swap = TRUE;
}
if (price) if (price)
{ {
price_value = gnc_price_get_value(price); price_value = gnc_price_get_value(price);

189
src/report/locale-specific/us/taxtxf.scm
View File

@ -1,5 +1,5 @@
;; -*-scheme-*- ;; -*-scheme-*-
;; by Richard -Gilligan- Uschold ;; by Richard -Gilligan- Uschold
;; ;;
;; updated by J. Alex Aycinena, July 2008, October 2009 ;; updated by J. Alex Aycinena, July 2008, October 2009
;; ;;
@ -46,7 +46,7 @@
;; Add support for Format 6 ;; Add support for Format 6
;; Use Form/Schedule line #'s to sort report. ;; Use Form/Schedule line #'s to sort report.
;; Update from "V037" to "V041" ;; Update from "V037" to "V041"
;; Add support for taxpayer types other than F1040 ;; Add support for taxpayer types other than F1040
;; ;;
;; September, 2010 Update: ;; September, 2010 Update:
;; ;;
@ -60,7 +60,7 @@
;; ;;
;; February, 2013 Update: ;; February, 2013 Update:
;; ;;
;; Fix beginning balance sign and signs for Transfer From/To amounts for ;; Fix beginning balance sign and signs for Transfer From/To amounts for
;; liability/equity accounts ;; liability/equity accounts
;; ;;
;; From prior version: ;; From prior version:
@ -142,7 +142,7 @@
;; returns a predicate that returns true only if a split is ;; returns a predicate that returns true only if a split is
;; between early-date and late-date ;; between early-date and late-date
(define (split-report-make-date-filter-predicate begin-date-tp end-date-tp) (define (split-report-make-date-filter-predicate begin-date-tp end-date-tp)
(lambda (split) (lambda (split)
(let ((tp (let ((tp
(gnc-transaction-get-date-posted (gnc-transaction-get-date-posted
(xaccSplitGetParent split)))) (xaccSplitGetParent split))))
@ -169,9 +169,9 @@
(define (gnc:register-tax-option new-option) (define (gnc:register-tax-option new-option)
(gnc:register-option options new-option)) (gnc:register-option options new-option))
;; date at which to report ;; date at which to report
(gnc:options-add-date-interval! (gnc:options-add-date-interval!
options gnc:pagename-general options gnc:pagename-general
(N_ "From") (N_ "To") "a") (N_ "From") (N_ "To") "a")
(gnc:register-tax-option (gnc:register-tax-option
@ -216,7 +216,7 @@
"d" (N_ "Select accounts.") "d" (N_ "Select accounts.")
(lambda () '()) (lambda () '())
#f #t)) #f #t))
(gnc:register-tax-option (gnc:register-tax-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-display (N_ "Suppress $0.00 values") gnc:pagename-display (N_ "Suppress $0.00 values")
@ -419,7 +419,7 @@
(define (render-header-row table heading-line-text) (define (render-header-row table heading-line-text)
(let ((heading (gnc:make-html-text))) (let ((heading (gnc:make-html-text)))
(gnc:html-text-append! heading (gnc:html-markup-b heading-line-text)) (gnc:html-text-append! heading (gnc:html-markup-b heading-line-text))
(let ((heading-cell (gnc:make-html-table-cell/markup (let ((heading-cell (gnc:make-html-table-cell/markup
"header-just-top" heading))) "header-just-top" heading)))
(gnc:html-table-cell-set-colspan! heading-cell 6) (gnc:html-table-cell-set-colspan! heading-cell 6)
@ -469,17 +469,17 @@
(let ((description (gnc:make-html-text)) (let ((description (gnc:make-html-text))
(total (gnc:make-html-text))) (total (gnc:make-html-text)))
(if (or tax_code? transaction-details?) (if (or tax_code? transaction-details?)
(gnc:html-text-append! description (gnc:html-markup-b (gnc:html-text-append! description (gnc:html-markup-b
(string-append "&nbsp; &nbsp; &nbsp; &nbsp;" (string-append "&nbsp; &nbsp; &nbsp; &nbsp;"
(if end-bal-text end-bal-text "Total For ")))) (if end-bal-text end-bal-text "Total For "))))
(if (not tax_code?) (if (not tax_code?)
(gnc:html-text-append! description (gnc:html-markup-b (gnc:html-text-append! description (gnc:html-markup-b
"&nbsp; &nbsp; &nbsp; &nbsp;")) "&nbsp; &nbsp; &nbsp; &nbsp;"))
) )
) )
(gnc:html-text-append! description (gnc:html-markup-b (gnc:html-text-append! description (gnc:html-markup-b
total-line-text)) total-line-text))
(gnc:html-text-append! description (gnc:html-markup-b (gnc:html-text-append! description (gnc:html-markup-b
" ")) " "))
(gnc:html-text-append! total (gnc:html-markup-b (gnc:html-text-append! total (gnc:html-markup-b
total-amount)) total-amount))
@ -490,12 +490,12 @@
(amount-table (gnc:make-html-table)) ;; to line up totals to details (amount-table (gnc:make-html-table)) ;; to line up totals to details
(cap-gains-detail-table (gnc:make-html-table)) (cap-gains-detail-table (gnc:make-html-table))
) )
(gnc:html-table-set-style! amount-table "table" (gnc:html-table-set-style! amount-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0") 'attribute (list "cellpadding" "0")
'attribute (list "width" "100%")) 'attribute (list "width" "100%"))
(gnc:html-table-set-style! cap-gains-detail-table "table" (gnc:html-table-set-style! cap-gains-detail-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0") 'attribute (list "cellpadding" "0")
@ -580,10 +580,10 @@
"Equity" "Equity"
"")))))) ""))))))
(category-key (get-acct-txf-info 'cat-key type code)) (category-key (get-acct-txf-info 'cat-key type code))
(value-name (cond (value-name (cond
((string=? tax-entity-type "F1040") ((string=? tax-entity-type "F1040")
(if (equal? "ReinvD" action) (if (equal? "ReinvD" action)
(string-append (string-append
(xaccPrintAmount (xaccPrintAmount
(gnc-numeric-neg account-value) print-info) (gnc-numeric-neg account-value) print-info)
" " txf-account-name) " " txf-account-name)
@ -634,7 +634,7 @@
;; sub-lines of line 5 starting with 1 for first reported payer ;; sub-lines of line 5 starting with 1 for first reported payer
;; these apply if pns is either 'current or 'parent', but not ;; these apply if pns is either 'current or 'parent', but not
;; otherwise ;; otherwise
"L" (number->string txf-l-count) crlf "L" (number->string txf-l-count) crlf
(if (= format 4) (if (= format 4)
(if x? (if x?
(list "P" sold-desc crlf "D" crlf "D" date-str crlf (list "P" sold-desc crlf "D" crlf "D" date-str crlf
@ -656,11 +656,11 @@
'())) ;; not detail '())) ;; not detail
(else '())) (else '()))
(if x? (if x?
(cond (cond
((string=? tax-entity-type "F1040") ((string=? tax-entity-type "F1040")
(list "X" x-date-str " " (list "X" x-date-str " "
(fill-clamp-sp txf-account-name 31) (fill-clamp-sp txf-account-name 31)
(fill-clamp-sp action 7) (fill-clamp-sp action 7)
(fill-clamp-sp value-name 82) (fill-clamp-sp value-name 82)
(fill-clamp category-key 15) crlf)) (fill-clamp category-key 15) crlf))
((or (string=? tax-entity-type "F1065") ((or (string=? tax-entity-type "F1065")
@ -724,12 +724,15 @@
(begin ;; do so (begin ;; do so
(set! missing-pricedb-entry? #f) (set! missing-pricedb-entry? #f)
(set! pricedb-lookup-price (set! pricedb-lookup-price
(gnc-pricedb-lookup-nearest-in-time (let ((price (gnc-pricedb-lookup-nearest-in-time
pricedb pricedb
account-commodity account-commodity
USD-currency USD-currency
(timespecCanonicalDayTime (timespecCanonicalDayTime
lookup-date))) lookup-date))))
(if (gnc-commodity-equiv account-commodity (gnc-price-get-currency price))
(set! price (gnc-price-invert price)))
price))
(set! pricedb-lookup-price-value (set! pricedb-lookup-price-value
(gnc-price-get-value (gnc-price-get-value
pricedb-lookup-price)) pricedb-lookup-price))
@ -784,7 +787,7 @@
) )
" " " "
converted-qty converted-qty
(if (if
(and (not (gnc-commodity-equiv account-commodity (and (not (gnc-commodity-equiv account-commodity
USD-currency)) USD-currency))
(not (gnc-commodity-equiv trans-currency (not (gnc-commodity-equiv trans-currency
@ -827,7 +830,7 @@
) )
"")) ""))
) )
) )
(list amount conversion-text pricedb-lookup-price conversion-text2) (list amount conversion-text pricedb-lookup-price conversion-text2)
) )
) )
@ -850,16 +853,16 @@
) )
(if (= 4 format) (if (= 4 format)
(begin (begin
(gnc:html-table-set-style! cap-gains-detail-table "table" (gnc:html-table-set-style! cap-gains-detail-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "3") 'attribute (list "cellpadding" "3")
'attribute (list "width" "100%")) 'attribute (list "width" "100%"))
(gnc:html-table-set-style! trans-sub-heading-table "table" (gnc:html-table-set-style! trans-sub-heading-table "table"
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0") 'attribute (list "cellpadding" "0")
'attribute (list "width" "100%")) 'attribute (list "width" "100%"))
(gnc:html-table-set-style! trans-sub-table "table" (gnc:html-table-set-style! trans-sub-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0") 'attribute (list "cellpadding" "0")
@ -957,18 +960,18 @@
(if (and (= 4 format) (gnc-numeric-negative-p (if (and (= 4 format) (gnc-numeric-negative-p
(xaccSplitGetAmount tran-split))) (xaccSplitGetAmount tran-split)))
(begin (begin
(if tax-mode? (if tax-mode?
(gnc:html-table-append-row! (gnc:html-table-append-row!
cap-gains-detail-table cap-gains-detail-table
(append (list (gnc:make-html-table-cell (append (list (gnc:make-html-table-cell
(string-append (string-append
(xaccPrintAmount (xaccPrintAmount
(gnc-numeric-neg (gnc-numeric-neg
(xaccSplitGetAmount (xaccSplitGetAmount
tran-split)) tran-split))
print-info) print-info)
" " " "
(gnc-commodity-get-mnemonic (gnc-commodity-get-mnemonic
split-acct-commodity)))) split-acct-commodity))))
(list (gnc:make-html-table-cell/markup (list (gnc:make-html-table-cell/markup
"text-cell-center" "text-cell-center"
@ -1000,13 +1003,13 @@
tax-code tax-code
copy copy
tax-entity-type tax-entity-type
(string-append (string-append
(xaccPrintAmount (xaccPrintAmount
(gnc-numeric-neg (gnc-numeric-neg
(xaccSplitGetAmount (xaccSplitGetAmount
tran-split)) print-info) tran-split)) print-info)
" " " "
(gnc-commodity-get-mnemonic (gnc-commodity-get-mnemonic
split-acct-commodity)) split-acct-commodity))
))) )))
) )
@ -1135,7 +1138,7 @@
tax-mode? show-TXF-data? USD-currency account-type tax-mode? show-TXF-data? USD-currency account-type
tax-code acct-full-name acct-beg-bal-collector tax-code acct-full-name acct-beg-bal-collector
acct-end-bal-collector copy tax-entity-type) acct-end-bal-collector copy tax-entity-type)
(let* (let*
((account-commodity (xaccAccountGetCommodity account)) ((account-commodity (xaccAccountGetCommodity account))
(format (get-acct-txf-info 'format account-type tax-code)) (format (get-acct-txf-info 'format account-type tax-code))
@ -1296,7 +1299,7 @@
) )
#f) #f)
(gnc:html-table-cell-set-colspan! beg-bal-cell 5) (gnc:html-table-cell-set-colspan! beg-bal-cell 5)
(gnc:html-table-set-style! amount-table "table" (gnc:html-table-set-style! amount-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0") 'attribute (list "cellpadding" "0")
@ -1343,12 +1346,12 @@
(if (and (> (length split-list) 0) (if (and (> (length split-list) 0)
(not (txf-beg-bal-only? tax-code))) (not (txf-beg-bal-only? tax-code)))
(set! output (set! output
(map (lambda (split) (map (lambda (split)
(let* ((parent (xaccSplitGetParent split)) (let* ((parent (xaccSplitGetParent split))
(trans-date (gnc-transaction-get-date-posted parent)) (trans-date (gnc-transaction-get-date-posted parent))
;; TurboTax 1999 and 2000 ignore dates after Dec 31 ;; TurboTax 1999 and 2000 ignore dates after Dec 31
(fudge-date (if splits-period (fudge-date (if splits-period
(if (and full-year? (if (and full-year?
(gnc:timepair-lt to-value trans-date)) (gnc:timepair-lt to-value trans-date))
to-value to-value
trans-date) trans-date)
@ -1379,7 +1382,7 @@
(eq? account-type ACCT-TYPE-LIABILITY) (eq? account-type ACCT-TYPE-LIABILITY)
(eq? account-type ACCT-TYPE-EQUITY)) (eq? account-type ACCT-TYPE-EQUITY))
(gnc-numeric-neg splt-amount) (gnc-numeric-neg splt-amount)
splt-amount)) splt-amount))
(curr-conv-note "") (curr-conv-note "")
(curr-conv-data (list splt-rpt-amount curr-conv-note #f "")) (curr-conv-data (list splt-rpt-amount curr-conv-note #f ""))
(curr-conv-data (if (and (gnc-commodity-equiv (curr-conv-data (if (and (gnc-commodity-equiv
@ -1437,7 +1440,7 @@
(eq? account-type ACCT-TYPE-LIABILITY) (eq? account-type ACCT-TYPE-LIABILITY)
(eq? account-type ACCT-TYPE-EQUITY)) (eq? account-type ACCT-TYPE-EQUITY))
(gnc-numeric-neg splt-amount) (gnc-numeric-neg splt-amount)
splt-amount)) splt-amount))
(acct-collector-as-dr 'add account-commodity splt-amount) (acct-collector-as-dr 'add account-commodity splt-amount)
(set! account-USD-total (gnc-numeric-add-fixed (set! account-USD-total (gnc-numeric-add-fixed
account-USD-total print-amnt)) account-USD-total print-amnt))
@ -1445,19 +1448,19 @@
;; transaction-multi-transfer-detail routine for TXF output and ;; transaction-multi-transfer-detail routine for TXF output and
;; to accumulate capital gains totals for account-, tax-code-, ;; to accumulate capital gains totals for account-, tax-code-,
;; and form-level totals even when not printing transaction ;; and form-level totals even when not printing transaction
;; details and/or Transfer To/From Accounts ;; details and/or Transfer To/From Accounts
(if (or (and transaction-details? tax-mode? (if (or (and transaction-details? tax-mode?
(null? other-account) split-details?) (null? other-account) split-details?)
(= 4 format) (= 4 format)
) )
(let ((cap-gain-data (let ((cap-gain-data
(process-transaction-multi-transfer-detail (process-transaction-multi-transfer-detail
split split
parent parent
USD-currency USD-currency
full-names? full-names?
trans-date trans-date
trans-currency trans-currency
account-type account-type
currency-conversion-date currency-conversion-date
to-value to-value
@ -1486,17 +1489,17 @@
)) ))
(if (and transaction-details? tax-mode?) (if (and transaction-details? tax-mode?)
(begin (begin
(gnc:html-table-set-style! date-table "table" (gnc:html-table-set-style! date-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")) 'attribute (list "cellpadding" "0"))
(gnc:html-table-append-row! (gnc:html-table-append-row!
date-table date-table
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"date-cell" "date-cell"
(strftime "%Y-%b-%d" (strftime "%Y-%b-%d"
(localtime (car trans-date))))) (localtime (car trans-date)))))
(gnc:html-table-set-style! num-table "table" (gnc:html-table-set-style! num-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")) 'attribute (list "cellpadding" "0"))
@ -1504,7 +1507,7 @@
num-table num-table
(gnc:make-html-table-cell (gnc-get-num-action (gnc:make-html-table-cell (gnc-get-num-action
parent split))) parent split)))
(gnc:html-table-set-style! desc-table "table" (gnc:html-table-set-style! desc-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")) 'attribute (list "cellpadding" "0"))
@ -1512,14 +1515,14 @@
desc-table desc-table
(gnc:make-html-table-cell (gnc:make-html-table-cell
(xaccTransGetDescription parent))) (xaccTransGetDescription parent)))
(gnc:html-table-set-style! notes-table "table" (gnc:html-table-set-style! notes-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0")) 'attribute (list "cellpadding" "0"))
(gnc:html-table-append-row! (gnc:html-table-append-row!
notes-table notes-table
(gnc:make-html-table-cell notes-act-memo)) (gnc:make-html-table-cell notes-act-memo))
(gnc:html-table-set-style! transfer-table "table" (gnc:html-table-set-style! transfer-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0") 'attribute (list "cellpadding" "0")
@ -1571,7 +1574,7 @@
) )
) )
) )
(gnc:html-table-set-style! amount-table "table" (gnc:html-table-set-style! amount-table "table"
'attribute (list "border" "0") 'attribute (list "border" "0")
'attribute (list "cellspacing" "0") 'attribute (list "cellspacing" "0")
'attribute (list "cellpadding" "0") 'attribute (list "cellpadding" "0")
@ -1744,7 +1747,7 @@
(define (get-option pagename optname) (define (get-option pagename optname)
(gnc:option-value (gnc:option-value
(gnc:lookup-option (gnc:lookup-option
(gnc:report-options report-obj) pagename optname))) (gnc:report-options report-obj) pagename optname)))
(define tax-entity-type (gnc-get-current-book-tax-type)) (define tax-entity-type (gnc-get-current-book-tax-type))
@ -1795,7 +1798,7 @@
#f #f
#t)) #t))
(let* ((form (if form form "")) ;; needed for "N000' (let* ((form (if form form "")) ;; needed for "N000'
(copy (number->string (copy (number->string
(xaccAccountGetTaxUSCopyNumber account))) (xaccAccountGetTaxUSCopyNumber account)))
(line (get-acct-txf-info 'line type tax-code-sym)) (line (get-acct-txf-info 'line type tax-code-sym))
(line (if line (line (if line
@ -1892,7 +1895,7 @@
"None" "None"
(list "Set as tax-related, no tax code assigned" (list "Set as tax-related, no tax code assigned"
account-name form account))) account-name form account)))
selected-accounts-sorted-by-form-line-acct) selected-accounts-sorted-by-form-line-acct)
(begin ;; not tax related - skip for report (begin ;; not tax related - skip for report
selected-accounts-sorted-by-form-line-acct) selected-accounts-sorted-by-form-line-acct)
) )
@ -1948,7 +1951,7 @@
(if prior-char-num? (if prior-char-num?
(begin (begin
(if (string=? string-part "") (if (string=? string-part "")
#f #f
(set! lst (append lst (list (set! lst (append lst (list
(string->number string-part))))) (string->number string-part)))))
(set! string-part (string char)) (set! string-part (string char))
@ -2040,14 +2043,14 @@
"USD")) "USD"))
(gnc:report-starting reportname) (gnc:report-starting reportname)
(let* ((from-value (gnc:date-option-absolute-time (let* ((from-value (gnc:date-option-absolute-time
(get-option gnc:pagename-general "From"))) (get-option gnc:pagename-general "From")))
(to-value (gnc:timepair-end-day-time (to-value (gnc:timepair-end-day-time
(gnc:date-option-absolute-time (gnc:date-option-absolute-time
(get-option gnc:pagename-general "To")))) (get-option gnc:pagename-general "To"))))
(alt-period (get-option gnc:pagename-general "Alternate Period")) (alt-period (get-option gnc:pagename-general "Alternate Period"))
(selected-style-sheet (get-option gnc:pagename-general "Stylesheet")) (selected-style-sheet (get-option gnc:pagename-general "Stylesheet"))
(suppress-0? (get-option gnc:pagename-display (suppress-0? (get-option gnc:pagename-display
"Suppress $0.00 values")) "Suppress $0.00 values"))
(full-names? (not (get-option gnc:pagename-display (full-names? (not (get-option gnc:pagename-display
"Do not print full account names"))) "Do not print full account names")))
@ -2063,13 +2066,13 @@
(gnc:report-options report-obj) (gnc:report-options report-obj)
gnc:pagename-display gnc:pagename-display
"Do not print Action:Memo data") "Do not print Action:Memo data")
(get-option gnc:pagename-display (get-option gnc:pagename-display
"Do not print Action:Memo data") "Do not print Action:Memo data")
(get-option gnc:pagename-display (get-option gnc:pagename-display
"Do not print T-Num:Memo data"))) "Do not print T-Num:Memo data")))
(shade-alternate-transactions? (if (gnc-html-engine-supports-css) (shade-alternate-transactions? (if (gnc-html-engine-supports-css)
#t #t
(get-option gnc:pagename-display (get-option gnc:pagename-display
"Shade alternate transactions"))) "Shade alternate transactions")))
(currency-conversion-date (get-option gnc:pagename-display (currency-conversion-date (get-option gnc:pagename-display
"Currency conversion date")) "Currency conversion date"))
@ -2079,7 +2082,7 @@
;; If no selected accounts, check all. ;; If no selected accounts, check all.
(selected-accounts (if (not (null? user-sel-accnts)) (selected-accounts (if (not (null? user-sel-accnts))
valid-user-sel-accnts valid-user-sel-accnts
(validate (reverse (validate (reverse
(gnc-account-get-children-sorted (gnc-account-get-children-sorted
(gnc-get-current-root-account)))))) (gnc-get-current-root-account))))))
@ -2090,13 +2093,13 @@
(from-date (gnc:timepair->date from-value)) (from-date (gnc:timepair->date from-value))
(from-value (gnc:timepair-start-day-time (from-value (gnc:timepair-start-day-time
(let ((bdtm from-date)) (let ((bdtm from-date))
(if (member alt-period (if (member alt-period
'(last-year 1st-last 2nd-last '(last-year 1st-last 2nd-last
3rd-last 4th-last)) 3rd-last 4th-last))
(set-tm:year bdtm (- (tm:year bdtm) 1))) (set-tm:year bdtm (- (tm:year bdtm) 1)))
(or (eq? alt-period 'from-to) (or (eq? alt-period 'from-to)
(set-tm:mday bdtm 1)) (set-tm:mday bdtm 1))
(if (< (gnc:date-get-year bdtm) (if (< (gnc:date-get-year bdtm)
tax-qtr-real-qtr-year) tax-qtr-real-qtr-year)
(case alt-period (case alt-period
((1st-est 1st-last last-year) ; Jan 1 ((1st-est 1st-last last-year) ; Jan 1
@ -2122,7 +2125,7 @@
(to-value (gnc:timepair-end-day-time (to-value (gnc:timepair-end-day-time
(let ((bdtm from-date)) (let ((bdtm from-date))
(if (member alt-period (if (member alt-period
'(last-year 1st-last 2nd-last '(last-year 1st-last 2nd-last
3rd-last 4th-last)) 3rd-last 4th-last))
(set-tm:year bdtm (- (tm:year bdtm) 1))) (set-tm:year bdtm (- (tm:year bdtm) 1)))
@ -2130,7 +2133,7 @@
;; The exact same code, in from-value, further above, ;; The exact same code, in from-value, further above,
;; only subtraces one! Go figure! ;; only subtraces one! Go figure!
;; So, we add one back below! ;; So, we add one back below!
(if (member alt-period (if (member alt-period
'(last-year 1st-last 2nd-last '(last-year 1st-last 2nd-last
3rd-last 4th-last)) 3rd-last 4th-last))
(set-tm:year bdtm (+ (tm:year bdtm) 1))) (set-tm:year bdtm (+ (tm:year bdtm) 1)))
@ -2159,7 +2162,7 @@
(set-tm:mon bdtm 8)) (set-tm:mon bdtm 8))
((4th-est 4th-last last-year) ; Dec 31 ((4th-est 4th-last last-year) ; Dec 31
(set-tm:mon bdtm 11)) (set-tm:mon bdtm 11))
(else (else
(set! bdtm (gnc:timepair->date to-value))))) (set! bdtm (gnc:timepair->date to-value)))))
(set-tm:isdst bdtm -1) (set-tm:isdst bdtm -1)
(cons (car (mktime bdtm)) 0)))) (cons (car (mktime bdtm)) 0))))
@ -2177,7 +2180,7 @@
(define (txf-special-splits-period account from-value to-value) (define (txf-special-splits-period account from-value to-value)
(if (and (xaccAccountGetTaxRelated account) (if (and (xaccAccountGetTaxRelated account)
(txf-special-date? (gnc:account-get-txf-code account))) (txf-special-date? (gnc:account-get-txf-code account)))
(let* (let*
((full-year? ((full-year?
(let ((bdto (localtime (car to-value))) (let ((bdto (localtime (car to-value)))
(bdfrom (localtime (car from-value)))) (bdfrom (localtime (car from-value))))
@ -2252,13 +2255,13 @@
(acct-beg-bal-collector (if (not (acct-beg-bal-collector (if (not
(or (eq? account-type ACCT-TYPE-INCOME) (or (eq? account-type ACCT-TYPE-INCOME)
(eq? account-type ACCT-TYPE-EXPENSE))) (eq? account-type ACCT-TYPE-EXPENSE)))
(gnc:account-get-comm-balance-at-date account (gnc:account-get-comm-balance-at-date account
(gnc:timepair-previous-day from-value) #f) (gnc:timepair-previous-day from-value) #f)
#f)) #f))
(acct-end-bal-collector (if (not (acct-end-bal-collector (if (not
(or (eq? account-type ACCT-TYPE-INCOME) (or (eq? account-type ACCT-TYPE-INCOME)
(eq? account-type ACCT-TYPE-EXPENSE))) (eq? account-type ACCT-TYPE-EXPENSE)))
(gnc:account-get-comm-balance-at-date account (gnc:account-get-comm-balance-at-date account
to-value #f) to-value #f)
#f)) #f))
(account-commodity (xaccAccountGetCommodity account)) (account-commodity (xaccAccountGetCommodity account))
@ -2395,8 +2398,8 @@
(let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value)))) (let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value))))
(to-date (strftime "%Y-%b-%d" (localtime (car to-value)))) (to-date (strftime "%Y-%b-%d" (localtime (car to-value))))
(today-date (strftime "D%m/%d/%Y" (today-date (strftime "D%m/%d/%Y"
(localtime (localtime
(car (timespecCanonicalDayTime (car (timespecCanonicalDayTime
(cons (current-time) 0)))))) (cons (current-time) 0))))))
(tax-year (strftime "%Y" (localtime (car from-value)))) (tax-year (strftime "%Y" (localtime (car from-value))))
@ -2496,7 +2499,7 @@
(xaccPrintAmount (xaccPrintAmount
tax-code-sub-item-USD-total tax-code-sub-item-USD-total
print-info)) print-info))
) )
;; print prior tax-code-sub-item ;; print prior tax-code-sub-item
;; total and reset accum ;; total and reset accum
(render-total-row (render-total-row
@ -2562,7 +2565,7 @@
) )
) )
;; process prior tax code break, if appropriate, before ;; process prior tax code break, if appropriate, before
;; processing current account ;; processing current account
(if (string=? prior-tax-code "") (if (string=? prior-tax-code "")
#t ;; do nothing #t ;; do nothing
(if tax-mode? (if tax-mode?
@ -2590,7 +2593,7 @@
(xaccPrintAmount (xaccPrintAmount
tax-code-cap-gain-basis-USD-total tax-code-cap-gain-basis-USD-total
print-info)) print-info))
) )
;; print prior tax-code total and ;; print prior tax-code total and
;; reset accum ;; reset accum
(render-total-row (render-total-row
@ -2711,7 +2714,7 @@
) )
) )
;; process prior form-schedule-line break, if appropriate, ;; process prior form-schedule-line break, if appropriate,
;; before processing current account ;; before processing current account
(if (string=? prior-form-sched-line "") (if (string=? prior-form-sched-line "")
(set! form-sched-line-USD-total (gnc-numeric-zero)) (set! form-sched-line-USD-total (gnc-numeric-zero))
(if tax-mode? (if tax-mode?
@ -2738,7 +2741,7 @@
(xaccPrintAmount (xaccPrintAmount
form-sched-line-cap-gain-sales-USD-total form-sched-line-cap-gain-sales-USD-total
print-info)) print-info))
) )
;; print prior form-schedule-line total ;; print prior form-schedule-line total
;; and reset accum ;; and reset accum
(render-total-row (render-total-row
@ -2835,7 +2838,7 @@
"" ""
(string-append "Line " (string-append "Line "
current-form-sched-line ": ")) current-form-sched-line ": "))
description " (" description " ("
(substring current-tax-code 1 (substring current-tax-code 1
(string-length current-tax-code)) (string-length current-tax-code))
(if show-TXF-data? (if show-TXF-data?
@ -2854,7 +2857,7 @@
"Y" "Y"
"N") "N")
", TXF Format " ", TXF Format "
(number->string (number->string
(get-acct-txf-info (get-acct-txf-info
'format 'format
type type
@ -2989,7 +2992,7 @@
)) ))
(if (not tax-mode?) ; Do Txf mode (if (not tax-mode?) ; Do Txf mode
(if tax-entity-type-valid? (if tax-entity-type-valid?
(if file-name ; cancel TXF if no file selected (if file-name ; cancel TXF if no file selected
(let ((port (catch #t ;;e.g., system-error (let ((port (catch #t ;;e.g., system-error
(lambda () (open-output-file file-name)) (lambda () (open-output-file file-name))
@ -3018,7 +3021,7 @@
today-date crlf today-date crlf
"^" crlf "^" crlf
output output
(if (or (if (or
(gnc-numeric-zero-p tax-code-USD-total) (gnc-numeric-zero-p tax-code-USD-total)
(not prior-account)) (not prior-account))
'() '()
@ -3050,7 +3053,7 @@
(if prior-account (if prior-account
(gnc:display-report-list-item output-txf port (gnc:display-report-list-item output-txf port
"taxtxf.scm - ") "taxtxf.scm - ")
#f) #f)
(close-output-port port) (close-output-port port)
#t #t
) ; end of let ) ; end of let
@ -3173,8 +3176,8 @@
(gnc:html-document-set-title! doc report-name) (gnc:html-document-set-title! doc report-name)
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc (gnc:make-html-text doc (gnc:make-html-text
(gnc:html-markup-p (gnc:html-markup-p
(gnc:html-markup (gnc:html-markup
"center" "center"
@ -3199,8 +3202,8 @@
(if (not (null? txf-invalid-alist)) (if (not (null? txf-invalid-alist))
(begin (begin
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc (gnc:make-html-text doc (gnc:make-html-text
(gnc:html-markup-p (gnc:html-markup-p
(gnc:html-markup/format (gnc:html-markup/format
"<BR>The following Account(s) have errors with their Income Tax code assignments (use 'Edit->Tax Report Options' to correct):")))) "<BR>The following Account(s) have errors with their Income Tax code assignments (use 'Edit->Tax Report Options' to correct):"))))
@ -3262,8 +3265,8 @@
) )
) )
txf-invalid-alist) txf-invalid-alist)
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc (gnc:make-html-text doc (gnc:make-html-text
(gnc:html-markup-p (gnc:html-markup-p
(gnc:html-markup/format (gnc:html-markup/format
" <BR> ")))) " <BR> "))))
@ -3272,7 +3275,7 @@
(gnc:html-document-add-object! doc table) (gnc:html-document-add-object! doc table)
(if tax-entity-type-valid? (if tax-entity-type-valid?
(map (lambda (form-line-acct) (handle-tax-code form-line-acct)) (map (lambda (form-line-acct) (handle-tax-code form-line-acct))
selected-accounts-sorted-by-form-line-acct)) selected-accounts-sorted-by-form-line-acct))
@ -3307,7 +3310,7 @@
(tax-code-sub-item-total-amount (tax-code-sub-item-total-amount
(xaccPrintAmount tax-code-sub-item-USD-total (xaccPrintAmount tax-code-sub-item-USD-total
print-info)) print-info))
) )
(render-total-row (render-total-row
table table
tax-code-sub-item-total-amount tax-code-sub-item-total-amount
@ -3360,7 +3363,7 @@
(xaccPrintAmount (xaccPrintAmount
tax-code-cap-gain-basis-USD-total tax-code-cap-gain-basis-USD-total
print-info)) print-info))
) )
(render-total-row table tax-code-total-amount (render-total-row table tax-code-total-amount
(string-append "Line (Code): " (string-append "Line (Code): "
saved-tax-code-text) saved-tax-code-text)
@ -3405,7 +3408,7 @@
(xaccPrintAmount (xaccPrintAmount
form-sched-line-cap-gain-basis-USD-total form-sched-line-cap-gain-basis-USD-total
print-info)) print-info))
) )
;; print prior form-schedule-line total; reset accum ;; print prior form-schedule-line total; reset accum
(render-total-row (render-total-row
table table
@ -3452,8 +3455,8 @@
"The Income Tax Report is only available for valid Income Tax Entity Types. Go to the Edit->Tax Report Options dialog to change your Income Tax Entity Type selection and set up tax-related accounts." "The Income Tax Report is only available for valid Income Tax Entity Types. Go to the Edit->Tax Report Options dialog to change your Income Tax Entity Type selection and set up tax-related accounts."
"No Tax Related accounts were found with your account selection. Change your selection or go to the Edit->Tax Report Options dialog to set up tax-related accounts.")))) "No Tax Related accounts were found with your account selection. Change your selection or go to the Edit->Tax Report Options dialog to set up tax-related accounts."))))
;; or print selected report options ;; or print selected report options
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc (gnc:make-html-text doc (gnc:make-html-text
(gnc:html-markup-p (gnc:html-markup-p
(gnc:html-markup/format (gnc:html-markup/format
(string-append (string-append

344
src/report/standard-reports/advanced-portfolio.scm
View File

@ -6,16 +6,16 @@
;; Heavily based on portfolio.scm ;; Heavily based on portfolio.scm
;; by Robert Merkel (rgmerk@mira.net) ;; by Robert Merkel (rgmerk@mira.net)
;; ;;
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of ;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version. ;; the License, or (at your option) any later version.
;; ;;
;; This program is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact: ;; along with this program; if not, contact:
;; ;;
@ -54,34 +54,34 @@
(define units-denom 100000000) (define units-denom 100000000)
(define (options-generator) (define (options-generator)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
;; This is just a helper function for making options. ;; This is just a helper function for making options.
;; See gnucash/src/scm/options.scm for details. ;; See gnucash/src/scm/options.scm for details.
(add-option (add-option
(lambda (new-option) (lambda (new-option)
(gnc:register-option options new-option)))) (gnc:register-option options new-option))))
;; General Tab ;; General Tab
;; date at which to report balance ;; date at which to report balance
(gnc:options-add-report-date! (gnc:options-add-report-date!
options gnc:pagename-general options gnc:pagename-general
(N_ "Date") "a") (N_ "Date") "a")
(gnc:options-add-currency! (gnc:options-add-currency!
options gnc:pagename-general (N_ "Report's currency") "c") options gnc:pagename-general (N_ "Report's currency") "c")
(add-option (add-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
gnc:pagename-general optname-price-source gnc:pagename-general optname-price-source
"d" (N_ "The source of price information.") 'pricedb-nearest "d" (N_ "The source of price information.") 'pricedb-nearest
(list (vector 'pricedb-latest (list (vector 'pricedb-latest
(N_ "Most recent") (N_ "Most recent")
(N_ "The most recent recorded price.")) (N_ "The most recent recorded price."))
(vector 'pricedb-nearest (vector 'pricedb-nearest
(N_ "Nearest in time") (N_ "Nearest in time")
(N_ "The price recorded nearest in time to the report date.")) (N_ "The price recorded nearest in time to the report date."))
))) )))
(add-option (add-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
gnc:pagename-general optname-basis-method gnc:pagename-general optname-basis-method
@ -99,7 +99,7 @@
(add-option (add-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-general optname-prefer-pricelist "f" gnc:pagename-general optname-prefer-pricelist "f"
(N_ "Prefer use of price editor pricing over transactions, where applicable.") (N_ "Prefer use of price editor pricing over transactions, where applicable.")
#t)) #t))
@ -117,7 +117,7 @@
(N_ "Ignore") (N_ "Ignore")
(N_ "Ignore brokerage fees entirely.")) (N_ "Ignore brokerage fees entirely."))
))) )))
(gnc:register-option (gnc:register-option
options options
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
@ -161,18 +161,18 @@
(lambda () (filter gnc:account-is-stock? (lambda () (filter gnc:account-is-stock?
(gnc-account-get-descendants-sorted (gnc-account-get-descendants-sorted
(gnc-get-current-root-account)))) (gnc-get-current-root-account))))
(lambda (accounts) (list #t (lambda (accounts) (list #t
(filter gnc:account-is-stock? accounts))) (filter gnc:account-is-stock? accounts)))
#t)) #t))
(gnc:register-option (gnc:register-option
options options
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-accounts optname-zero-shares "e" gnc:pagename-accounts optname-zero-shares "e"
(N_ "Include accounts that have a zero share balances.") (N_ "Include accounts that have a zero share balances.")
#f)) #f))
(gnc:options-set-default-section options gnc:pagename-general) (gnc:options-set-default-section options gnc:pagename-general)
options)) options))
;; This is the rendering function. It accepts a database of options ;; This is the rendering function. It accepts a database of options
@ -183,7 +183,7 @@
;; defined above. ;; defined above.
(define (advanced-portfolio-renderer report-obj) (define (advanced-portfolio-renderer report-obj)
(let ((work-done 0) (let ((work-done 0)
(work-to-do 0) (work-to-do 0)
(warn-no-price #f) (warn-no-price #f)
@ -192,10 +192,10 @@
;; These are some helper functions for looking up option values. ;; These are some helper functions for looking up option values.
(define (get-op section name) (define (get-op section name)
(gnc:lookup-option (gnc:report-options report-obj) section name)) (gnc:lookup-option (gnc:report-options report-obj) section name))
(define (get-option section name) (define (get-option section name)
(gnc:option-value (get-op section name))) (gnc:option-value (get-op section name)))
(define (split-account-type? split type) (define (split-account-type? split type)
(eq? type (xaccAccountGetType (xaccSplitGetAccount split)))) (eq? type (xaccAccountGetType (xaccSplitGetAccount split))))
@ -213,11 +213,11 @@
(gnc-numeric-zero) (gnc-numeric-zero)
) )
) )
;; sum up the total number of units in the b-list built by basis-builder below ;; sum up the total number of units in the b-list built by basis-builder below
(define (units-basis b-list) (define (units-basis b-list)
(if (not (eqv? b-list '())) (if (not (eqv? b-list '()))
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list)) (gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
units-denom GNC-RND-ROUND) units-denom GNC-RND-ROUND)
(gnc-numeric-zero) (gnc-numeric-zero)
) )
@ -231,42 +231,42 @@
(gnc-numeric-mul value-ratio (cdar b-list) price-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)) (apply-basis-ratio (cdr b-list) units-ratio value-ratio))
'() '()
) )
) )
;; this builds a list for basis calculation and handles average, fifo and lifo methods ;; this builds a list for basis calculation and handles average, fifo and lifo methods
;; the list is cons cells of (units-of-stock . price-per-unit)... average method produces only one ;; the list is cons cells of (units-of-stock . price-per-unit)... average method produces only one
;; cell that mutates to the new average. Need to add a date checker so that we allow for prices ;; cell that mutates to the new average. Need to add a date checker so that we allow for prices
;; coming in out of order, such as a transfer with a price adjusted to carryover the basis. ;; coming in out of order, such as a transfer with a price adjusted to carryover the basis.
(define (basis-builder b-list b-units b-value b-method currency-frac) (define (basis-builder b-list b-units b-value b-method currency-frac)
(gnc:debug "actually in basis-builder") (gnc:debug "actually in basis-builder")
(gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units) (gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units)
" b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method) " b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method)
;; if there is no b-value, then this is a split/merger and needs special handling ;; if there is no b-value, then this is a split/merger and needs special handling
(cond (cond
;; we have value and positive units, add units to basis ;; we have value and positive units, add units to basis
((and (not (gnc-numeric-zero-p b-value)) ((and (not (gnc-numeric-zero-p b-value))
(gnc-numeric-positive-p b-units)) (gnc-numeric-positive-p b-units))
(case b-method (case b-method
((average-basis) ((average-basis)
(if (not (eqv? b-list '())) (if (not (eqv? b-list '()))
(list (cons (gnc-numeric-add b-units (list (cons (gnc-numeric-add b-units
(caar b-list) units-denom GNC-RND-ROUND) (caar b-list) units-denom GNC-RND-ROUND)
(gnc-numeric-div (gnc-numeric-div
(gnc-numeric-add b-value (gnc-numeric-add b-value
(gnc-numeric-mul (caar b-list) (gnc-numeric-mul (caar b-list)
(cdar b-list) (cdar b-list)
GNC-DENOM-AUTO GNC-DENOM-REDUCE) GNC-DENOM-AUTO GNC-DENOM-REDUCE)
GNC-DENOM-AUTO GNC-DENOM-REDUCE) GNC-DENOM-AUTO GNC-DENOM-REDUCE)
(gnc-numeric-add b-units (gnc-numeric-add b-units
(caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE) (caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)
price-denom GNC-RND-ROUND))) price-denom GNC-RND-ROUND)))
(append b-list (append b-list
(list (cons b-units (gnc-numeric-div (list (cons b-units (gnc-numeric-div
b-value b-units price-denom GNC-RND-ROUND)))))) b-value b-units price-denom GNC-RND-ROUND))))))
(else (append b-list (else (append b-list
(list (cons b-units (gnc-numeric-div (list (cons b-units (gnc-numeric-div
b-value b-units price-denom GNC-RND-ROUND))))))) b-value b-units price-denom GNC-RND-ROUND)))))))
@ -275,7 +275,7 @@
(gnc-numeric-negative-p b-units)) (gnc-numeric-negative-p b-units))
(if (not (eqv? b-list '())) (if (not (eqv? b-list '()))
(case b-method (case b-method
((fifo-basis) ((fifo-basis)
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list)) (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
((-1) ((-1)
;; Sold less than the first lot, create a new first lot from the remainder ;; Sold less than the first lot, create a new first lot from the remainder
@ -284,12 +284,12 @@
((0) ((0)
;; Sold all of the first lot ;; Sold all of the first lot
(cdr b-list)) (cdr b-list))
((1) ((1)
;; Sold more than the first lot, delete it and recurse ;; Sold more than the first lot, delete it and recurse
(basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND) (basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)
b-value ;; Only the sign of b-value matters since the new b-units is negative b-value ;; Only the sign of b-value matters since the new b-units is negative
b-method currency-frac)))) b-method currency-frac))))
((filo-basis) ((filo-basis)
(let ((rev-b-list (reverse b-list))) (let ((rev-b-list (reverse b-list)))
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list)) (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))
((-1) ((-1)
@ -305,29 +305,29 @@
(basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND) (basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)
b-value b-method currency-frac) b-value b-method currency-frac)
)))) ))))
((average-basis) ((average-basis)
(list (cons (gnc-numeric-add (list (cons (gnc-numeric-add
(caar b-list) b-units units-denom GNC-RND-ROUND) (caar b-list) b-units units-denom GNC-RND-ROUND)
(cdar b-list))))) (cdar b-list)))))
'() '()
)) ))
;; no value, just units, this is a split/merge... ;; no value, just units, this is a split/merge...
((and (gnc-numeric-zero-p b-value) ((and (gnc-numeric-zero-p b-value)
(not (gnc-numeric-zero-p b-units))) (not (gnc-numeric-zero-p b-units)))
(let* ((current-units (units-basis b-list)) (let* ((current-units (units-basis b-list))
(units-ratio (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE) (units-ratio (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
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 ;; 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) (value-ratio (if (gnc-numeric-zero-p units-ratio)
(gnc-numeric-zero) (gnc-numeric-zero)
(gnc-numeric-div (gnc:make-gnc-numeric 1 1) units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE)))) (gnc-numeric-div (gnc:make-gnc-numeric 1 1) units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
(gnc:debug "blist is " b-list " current units is " (gnc:debug "blist is " b-list " current units is "
(gnc-numeric-to-string current-units) (gnc-numeric-to-string current-units)
" value ratio is " (gnc-numeric-to-string value-ratio) " value ratio is " (gnc-numeric-to-string value-ratio)
" units ratio is " (gnc-numeric-to-string units-ratio)) " units ratio is " (gnc-numeric-to-string units-ratio))
(apply-basis-ratio b-list units-ratio value-ratio) (apply-basis-ratio b-list units-ratio value-ratio)
)) ))
;; If there are no units, just a value, then its a spin-off, ;; If there are no units, just a value, then its a spin-off,
@ -336,9 +336,9 @@
((and (gnc-numeric-zero-p b-units) ((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)) (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
(value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE) (value-ratio (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))) current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
(gnc:debug "this is a spinoff") (gnc:debug "this is a spinoff")
(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio)) (gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
(apply-basis-ratio b-list (gnc:make-gnc-numeric 1 1) value-ratio)) (apply-basis-ratio b-list (gnc:make-gnc-numeric 1 1) value-ratio))
@ -359,20 +359,22 @@
(for-each (for-each
(lambda (p) (lambda (p)
(if (gnc-commodity-equiv currency (gnc-price-get-currency p)) (if (gnc-commodity-equiv currency (gnc-price-get-currency p))
(set! price p))) (set! price p))
(if (gnc-commodity-equiv currency (gnc-price-get-commodity p))
(set! price (gnc-price-invert p))))
price-list) price-list)
(gnc-price-ref price) (gnc-price-ref price)
(gnc-price-list-destroy price-list) (gnc-price-list-destroy price-list)
price))) price)))
;; Return true if either account is the parent of the other or they are siblings ;; Return true if either account is the parent of the other or they are siblings
(define (parent-or-sibling? a1 a2) (define (parent-or-sibling? a1 a2)
(let ((a2parent (gnc-account-get-parent a2)) (let ((a2parent (gnc-account-get-parent a2))
(a1parent (gnc-account-get-parent a1))) (a1parent (gnc-account-get-parent a1)))
(or (same-account? a2parent a1) (or (same-account? a2parent a1)
(same-account? a1parent a2) (same-account? a1parent a2)
(same-account? a1parent a2parent)))) (same-account? a1parent a2parent))))
;; Test whether the given split is the source of a spin off transaction ;; Test whether the given split is the source of a spin off transaction
;; This will be a no-units split with only one other split. ;; This will be a no-units split with only one other split.
;; xaccSplitGetOtherSplit only returns on a two-split txn. It's not a spinoff ;; xaccSplitGetOtherSplit only returns on a two-split txn. It's not a spinoff
@ -384,21 +386,21 @@
(not (null? other-split)) (not (null? other-split))
(not (split-account-type? other-split ACCT-TYPE-EXPENSE)) (not (split-account-type? other-split ACCT-TYPE-EXPENSE))
(not (split-account-type? other-split ACCT-TYPE-INCOME))))) (not (split-account-type? other-split ACCT-TYPE-INCOME)))))
(define (table-add-stock-rows table accounts to-date (define (table-add-stock-rows table accounts to-date
currency price-fn exchange-fn price-source 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 basis-method prefer-pricelist handle-brokerage-fees
total-basis total-value total-basis total-value
total-moneyin total-moneyout total-income total-gain total-moneyin total-moneyout total-income total-gain
total-ugain total-brokerage) total-ugain total-brokerage)
(let ((share-print-info (let ((share-print-info
(gnc-share-print-info-places (gnc-share-print-info-places
(inexact->exact (get-option gnc:pagename-display (inexact->exact (get-option gnc:pagename-display
optname-shares-digits))))) optname-shares-digits)))))
(define (table-add-stock-rows-internal accounts odd-row?) (define (table-add-stock-rows-internal accounts odd-row?)
(if (null? accounts) total-value (if (null? accounts) total-value
(let* ((row-style (if odd-row? "normal-row" "alternate-row")) (let* ((row-style (if odd-row? "normal-row" "alternate-row"))
@ -447,7 +449,7 @@
(exchange-fn (exchange-fn
;; This currency will usually be the same as tocurrency so the ;; This currency will usually be the same as tocurrency so the
;; call to exchange-fn below will do nothing ;; call to exchange-fn below will do nothing
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
(if use-txn (if use-txn
(gnc:gnc-monetary-commodity price) (gnc:gnc-monetary-commodity price)
(gnc-price-get-currency price)) (gnc-price-get-currency price))
@ -458,30 +460,30 @@
currency-frac GNC-RND-ROUND)) currency-frac GNC-RND-ROUND))
tocurrency) tocurrency)
(exchange-fn fromunits tocurrency))) (exchange-fn fromunits tocurrency)))
(gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: " (gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
(if price (if price
(gnc-commodity-value->string (gnc-commodity-value->string
(list (gnc-price-get-currency price) (gnc-price-get-value price))) (list (gnc-price-get-currency price) (gnc-price-get-value price)))
#f)) #f))
;; If we have a price that can't be converted to the report currency ;; If we have a price that can't be converted to the report currency
;; don't use it ;; don't use it
(if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount (if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount
(exchange-fn (exchange-fn
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
(gnc-price-get-currency price) (gnc-price-get-currency price)
(gnc:make-gnc-numeric 100 1)) (gnc:make-gnc-numeric 100 1))
currency)))) currency))))
(set! price #f)) (set! price #f))
;; If we are told to use a pricing transaction, or if we don't have a price ;; If we are told to use a pricing transaction, or if we don't have a price
;; from the price DB, find a good transaction to use. ;; from the price DB, find a good transaction to use.
(if (and (not use-txn) (if (and (not use-txn)
(or (not price) (not prefer-pricelist))) (or (not price) (not prefer-pricelist)))
(let ((split-list (reverse (gnc:get-match-commodity-splits-sorted (let ((split-list (reverse (gnc:get-match-commodity-splits-sorted
(list current) (list current)
(case price-source (case price-source
((pricedb-latest) (gnc:get-today)) ((pricedb-latest) (gnc:get-today))
((pricedb-nearest) to-date) ((pricedb-nearest) to-date)
(else (gnc:get-today))) ;; error, but don't crash (else (gnc:get-today))) ;; error, but don't crash
@ -494,7 +496,7 @@
(let* ((trans (xaccSplitGetParent split)) (let* ((trans (xaccSplitGetParent split))
(trans-currency (xaccTransGetCurrency trans)) (trans-currency (xaccTransGetCurrency trans))
(trans-price (exchange-fn (gnc:make-gnc-monetary (trans-price (exchange-fn (gnc:make-gnc-monetary
trans-currency trans-currency
(xaccSplitGetSharePrice split)) (xaccSplitGetSharePrice split))
currency))) currency)))
(if (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount trans-price))) (if (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount trans-price)))
@ -517,13 +519,13 @@
(set! use-txn #t) (set! use-txn #t)
(set! pricing-txn #f) (set! pricing-txn #f)
) )
) )
;; Now that we have a pricing transaction if needed, set the value of the asset ;; Now that we have a pricing transaction if needed, set the value of the asset
(set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency)) (set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))
(gnc:debug "Value " (gnc:monetary->string value) (gnc:debug "Value " (gnc:monetary->string value)
" from " (gnc-commodity-numeric->string commodity units)) " from " (gnc-commodity-numeric->string commodity units))
(for-each (for-each
;; we're looking at each split we find in the account. these splits ;; 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 ;; could refer to the same transaction, so we have to examine each
@ -531,12 +533,12 @@
(lambda (split) (lambda (split)
(set! work-done (+ 1 work-done)) (set! work-done (+ 1 work-done))
(gnc:report-percent-done (* 100 (/ work-done work-to-do))) (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
(let* ((parent (xaccSplitGetParent split)) (let* ((parent (xaccSplitGetParent split))
(txn-date (gnc-transaction-get-date-posted parent)) (txn-date (gnc-transaction-get-date-posted parent))
(commod-currency (xaccTransGetCurrency parent)) (commod-currency (xaccTransGetCurrency parent))
(commod-currency-frac (gnc-commodity-get-fraction commod-currency))) (commod-currency-frac (gnc-commodity-get-fraction commod-currency)))
(if (and (gnc:timepair-le txn-date to-date) (if (and (gnc:timepair-le txn-date to-date)
(not (assoc-ref seen_trans (gncTransGetGUID parent)))) (not (assoc-ref seen_trans (gncTransGetGUID parent))))
(let ((trans-income (gnc-numeric-zero)) (let ((trans-income (gnc-numeric-zero))
@ -553,30 +555,30 @@
;; Add this transaction to the list of processed transactions so we don't ;; 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 ;; do it again if there is another split in it for this account
(set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans)) (set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans))
;; Go through all the splits in the transaction to get an overall idea of ;; 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. ;; what it does in terms of income, money in or out, shares bought or sold, etc.
(for-each (for-each
(lambda (s) (lambda (s)
(let ((split-units (xaccSplitGetAmount s)) (let ((split-units (xaccSplitGetAmount s))
(split-value (xaccSplitGetValue s))) (split-value (xaccSplitGetValue s)))
(gnc:debug "Pass 1: split units " (gnc-numeric-to-string split-units) " split-value " (gnc:debug "Pass 1: split units " (gnc-numeric-to-string split-units) " split-value "
(gnc-numeric-to-string split-value) " commod-currency " (gnc-numeric-to-string split-value) " commod-currency "
(gnc-commodity-get-printname commod-currency)) (gnc-commodity-get-printname commod-currency))
(cond (cond
((split-account-type? s ACCT-TYPE-EXPENSE) ((split-account-type? s ACCT-TYPE-EXPENSE)
;; Brokerage expense unless a two split transaction with other split ;; Brokerage expense unless a two split transaction with other split
;; in the stock account in which case it's a stock donation to charity. ;; in the stock account in which case it's a stock donation to charity.
(if (not (same-account? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s)))) (if (not (same-account? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s))))
(set! trans-brokerage (set! trans-brokerage
(gnc-numeric-add trans-brokerage split-value commod-currency-frac GNC-RND-ROUND)))) (gnc-numeric-add trans-brokerage split-value commod-currency-frac GNC-RND-ROUND))))
((split-account-type? s ACCT-TYPE-INCOME) ((split-account-type? s ACCT-TYPE-INCOME)
(set! trans-income (gnc-numeric-sub trans-income split-value (set! trans-income (gnc-numeric-sub trans-income split-value
commod-currency-frac GNC-RND-ROUND))) commod-currency-frac GNC-RND-ROUND)))
((same-account? current (xaccSplitGetAccount s)) ((same-account? current (xaccSplitGetAccount s))
(set! trans-shares (gnc-numeric-add trans-shares (gnc-numeric-abs split-units) (set! trans-shares (gnc-numeric-add trans-shares (gnc-numeric-abs split-units)
units-denom GNC-RND-ROUND)) units-denom GNC-RND-ROUND))
@ -590,7 +592,7 @@
;; Gain/loss split (amount zero, value non-zero, and not spinoff). There will be ;; Gain/loss split (amount zero, value non-zero, and not spinoff). There will be
;; a corresponding income split that will incorrectly be added to trans-income ;; a corresponding income split that will incorrectly be added to trans-income
;; Fix that by subtracting it here ;; Fix that by subtracting it here
(set! trans-income (gnc-numeric-sub trans-income split-value (set! trans-income (gnc-numeric-sub trans-income split-value
commod-currency-frac GNC-RND-ROUND)))) commod-currency-frac GNC-RND-ROUND))))
;; Non-zero amount, add the value to the sale or purchase total. ;; Non-zero amount, add the value to the sale or purchase total.
(if (gnc-numeric-positive-p split-value) (if (gnc-numeric-positive-p split-value)
@ -601,9 +603,9 @@
(gnc-numeric-add shares-bought split-units units-denom GNC-RND-ROUND))) (gnc-numeric-add shares-bought split-units units-denom GNC-RND-ROUND)))
(set! trans-sold (set! trans-sold
(gnc-numeric-sub trans-sold split-value commod-currency-frac GNC-RND-ROUND))))) (gnc-numeric-sub trans-sold split-value commod-currency-frac GNC-RND-ROUND)))))
((split-account-type? s ACCT-TYPE-ASSET) ((split-account-type? s ACCT-TYPE-ASSET)
;; If all the asset accounts mentioned in the transaction are siblings of each other ;; If all the asset accounts mentioned in the transaction are siblings of each other
;; keep track of the money transfered to them if it is in the correct currency ;; keep track of the money transfered to them if it is in the correct currency
(if (not trans-drp-account) (if (not trans-drp-account)
(begin (begin
@ -619,7 +621,7 @@
)) ))
(xaccTransGetSplitList parent) (xaccTransGetSplitList parent)
) )
(gnc:debug "Income: " (gnc-numeric-to-string trans-income) (gnc:debug "Income: " (gnc-numeric-to-string trans-income)
" Brokerage: " (gnc-numeric-to-string trans-brokerage) " Brokerage: " (gnc-numeric-to-string trans-brokerage)
" Shares traded: " (gnc-numeric-to-string trans-shares) " Shares traded: " (gnc-numeric-to-string trans-shares)
@ -628,10 +630,10 @@
" Value purchased: " (gnc-numeric-to-string trans-bought) " Value purchased: " (gnc-numeric-to-string trans-bought)
" Spinoff value " (gnc-numeric-to-string trans-spinoff) " Spinoff value " (gnc-numeric-to-string trans-spinoff)
" Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual)) " Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual))
;; We need to calculate several things for this transaction: ;; We need to calculate several things for this transaction:
;; 1. Total income: this is already in trans-income ;; 1. Total income: this is already in trans-income
;; 2. Change in basis: calculated by loop below that looks at every ;; 2. Change in basis: calculated by loop below that looks at every
;; that acquires or disposes of shares ;; that acquires or disposes of shares
;; 3. Realized gain: also calculated below while calculating basis ;; 3. Realized gain: also calculated below while calculating basis
;; 4. Money in to the account: this is the value of shares bought ;; 4. Money in to the account: this is the value of shares bought
@ -639,22 +641,22 @@
;; 5. Money out: the money received by disposing of shares. This ;; 5. Money out: the money received by disposing of shares. This
;; is in trans-sold plus trans-spinoff ;; is in trans-sold plus trans-spinoff
;; 6. Brokerage fees: this is in trans-brokerage ;; 6. Brokerage fees: this is in trans-brokerage
;; Income ;; Income
(dividendcoll 'add commod-currency trans-income) (dividendcoll 'add commod-currency trans-income)
;; Brokerage fees. May be either ignored or part of basis, but that ;; Brokerage fees. May be either ignored or part of basis, but that
;; will be dealt with elsewhere. ;; will be dealt with elsewhere.
(brokeragecoll 'add commod-currency trans-brokerage) (brokeragecoll 'add commod-currency trans-brokerage)
;; Add brokerage fees to trans-bought if not ignoring them and there are any ;; Add brokerage fees to trans-bought if not ignoring them and there are any
(if (and (not (eq? handle-brokerage-fees 'ignore-brokerage)) (if (and (not (eq? handle-brokerage-fees 'ignore-brokerage))
(gnc-numeric-positive-p trans-brokerage) (gnc-numeric-positive-p trans-brokerage)
(gnc-numeric-positive-p trans-shares)) (gnc-numeric-positive-p trans-shares))
(let* ((fee-frac (gnc-numeric-div shares-bought trans-shares GNC-DENOM-AUTO GNC-DENOM-REDUCE)) (let* ((fee-frac (gnc-numeric-div shares-bought trans-shares GNC-DENOM-AUTO GNC-DENOM-REDUCE))
(fees (gnc-numeric-mul trans-brokerage fee-frac commod-currency-frac GNC-RND-ROUND))) (fees (gnc-numeric-mul trans-brokerage fee-frac commod-currency-frac GNC-RND-ROUND)))
(set! trans-bought (gnc-numeric-add trans-bought fees commod-currency-frac GNC-RND-ROUND)))) (set! trans-bought (gnc-numeric-add trans-bought fees commod-currency-frac GNC-RND-ROUND))))
;; Update the running total of the money in the DRP residual account. This is relevant ;; Update the running total of the money in the DRP residual account. This is relevant
;; if this is a reinvestment transaction (both income and purchase) and there seems to ;; if this is a reinvestment transaction (both income and purchase) and there seems to
;; asset accounts used to hold excess income. ;; asset accounts used to hold excess income.
@ -670,12 +672,12 @@
(parent-or-sibling? trans-drp-account drp-holding-account)) (parent-or-sibling? trans-drp-account drp-holding-account))
(set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-drp-residual (set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-drp-residual
commod-currency-frac GNC-RND-ROUND)) commod-currency-frac GNC-RND-ROUND))
(begin (begin
;; Wrong account (or no account), assume there isn't a DRP holding account ;; Wrong account (or no account), assume there isn't a DRP holding account
(set! drp-holding-account 'none) (set! drp-holding-account 'none)
(set trans-drp-residual (gnc-numeric-zero)) (set trans-drp-residual (gnc-numeric-zero))
(set! drp-holding-amount (gnc-numeric-zero)))))) (set! drp-holding-amount (gnc-numeric-zero))))))
;; Set trans-bought to the amount of money moved in to the account which was used to ;; Set trans-bought to the amount of money moved in to the account which was used to
;; purchase more shares. If this is not a DRP transaction then all money used to purchase ;; purchase more shares. If this is not a DRP transaction then all money used to purchase
;; shares is money in. ;; shares is money in.
@ -691,21 +693,21 @@
;; If the DRP holding account balance is negative, adjust it by the amount ;; If the DRP holding account balance is negative, adjust it by the amount
;; used in this transaction ;; used in this transaction
(if (and (gnc-numeric-negative-p drp-holding-amount) (if (and (gnc-numeric-negative-p drp-holding-amount)
(gnc-numeric-positive-p trans-bought)) (gnc-numeric-positive-p trans-bought))
(set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-bought (set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-bought
commod-currency-frac GNC-RND-ROUND))) commod-currency-frac GNC-RND-ROUND)))
;; Money in is never more than amount spent to purchase shares ;; Money in is never more than amount spent to purchase shares
(if (gnc-numeric-negative-p trans-bought) (if (gnc-numeric-negative-p trans-bought)
(set! trans-bought (gnc-numeric-zero))))) (set! trans-bought (gnc-numeric-zero)))))
(gnc:debug "Adjusted trans-bought " (gnc-numeric-to-string trans-bought) (gnc:debug "Adjusted trans-bought " (gnc-numeric-to-string trans-bought)
" DRP holding account " (gnc-numeric-to-string drp-holding-amount)) " DRP holding account " (gnc-numeric-to-string drp-holding-amount))
(moneyincoll 'add commod-currency trans-bought) (moneyincoll 'add commod-currency trans-bought)
(moneyoutcoll 'add commod-currency trans-sold) (moneyoutcoll 'add commod-currency trans-sold)
(moneyoutcoll 'add commod-currency trans-spinoff) (moneyoutcoll 'add commod-currency trans-spinoff)
;; Look at splits again to handle changes in basis and realized gains ;; Look at splits again to handle changes in basis and realized gains
(for-each (for-each
(lambda (s) (lambda (s)
(let (let
@ -713,30 +715,30 @@
((split-units (xaccSplitGetAmount s)) ((split-units (xaccSplitGetAmount s))
(split-value (xaccSplitGetValue s))) (split-value (xaccSplitGetValue s)))
(gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value " (gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value "
(gnc-numeric-to-string split-value) " commod-currency " (gnc-numeric-to-string split-value) " commod-currency "
(gnc-commodity-get-printname commod-currency)) (gnc-commodity-get-printname commod-currency))
(cond (cond
((and (not (gnc-numeric-zero-p split-units)) ((and (not (gnc-numeric-zero-p split-units))
(same-account? current (xaccSplitGetAccount s))) (same-account? current (xaccSplitGetAccount s)))
;; Split into subject account with non-zero amount. This is a purchase ;; Split into subject account with non-zero amount. This is a purchase
;; or a sale, adjust the basis ;; or a sale, adjust the basis
(let* ((split-value-currency (gnc:gnc-monetary-amount (let* ((split-value-currency (gnc:gnc-monetary-amount
(my-exchange-fn (gnc:make-gnc-monetary (my-exchange-fn (gnc:make-gnc-monetary
commod-currency split-value) currency))) commod-currency split-value) currency)))
(orig-basis (sum-basis basis-list currency-frac)) (orig-basis (sum-basis basis-list currency-frac))
;; proportion of the fees attributable to this split ;; proportion of the fees attributable to this split
(fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares (fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares
GNC-DENOM-AUTO GNC-DENOM-REDUCE)) GNC-DENOM-AUTO GNC-DENOM-REDUCE))
;; Fees for this split in report currency ;; Fees for this split in report currency
(fees-currency (gnc:gnc-monetary-amount (my-exchange-fn (fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
(gnc:make-gnc-monetary commod-currency (gnc:make-gnc-monetary commod-currency
(gnc-numeric-mul fee-ratio trans-brokerage (gnc-numeric-mul fee-ratio trans-brokerage
commod-currency-frac GNC-RND-ROUND)) commod-currency-frac GNC-RND-ROUND))
currency))) currency)))
(split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis) (split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
;; Include brokerage fees in basis ;; Include brokerage fees in basis
(gnc-numeric-add split-value-currency fees-currency (gnc-numeric-add split-value-currency fees-currency
currency-frac GNC-RND-ROUND) currency-frac GNC-RND-ROUND)
split-value-currency))) split-value-currency)))
@ -744,10 +746,10 @@
(gnc-numeric-to-string split-value-with-fees)) (gnc-numeric-to-string split-value-with-fees))
;; adjust the basis ;; adjust the basis
(set! basis-list (basis-builder basis-list split-units split-value-with-fees (set! basis-list (basis-builder basis-list split-units split-value-with-fees
basis-method currency-frac)) basis-method currency-frac))
(gnc:debug "coming out of basis list " basis-list) (gnc:debug "coming out of basis list " basis-list)
;; If it's a sale or the stock is worthless, calculate the gain ;; If it's a sale or the stock is worthless, calculate the gain
(if (not (gnc-numeric-positive-p split-value)) (if (not (gnc-numeric-positive-p split-value))
;; Split value is zero or negative. If it's zero it's either a stock split/merge ;; Split value is zero or negative. If it's zero it's either a stock split/merge
@ -756,7 +758,7 @@
(let ((new-basis (sum-basis basis-list currency-frac))) (let ((new-basis (sum-basis basis-list currency-frac)))
(if (or (gnc-numeric-zero-p new-basis) (if (or (gnc-numeric-zero-p new-basis)
(gnc-numeric-negative-p split-value)) (gnc-numeric-negative-p split-value))
;; Split value is negative or new basis is zero (stock is worthless), ;; Split value is negative or new basis is zero (stock is worthless),
;; Capital gain is money out minus change in basis ;; Capital gain is money out minus change in basis
(let ((gain (gnc-numeric-sub (gnc-numeric-abs split-value-with-fees) (let ((gain (gnc-numeric-sub (gnc-numeric-abs split-value-with-fees)
(gnc-numeric-sub orig-basis new-basis (gnc-numeric-sub orig-basis new-basis
@ -773,30 +775,30 @@
;; in an income or expense account. ;; in an income or expense account.
((spin-off? s current) ((spin-off? s current)
(gnc:debug "before spin-off basis list " basis-list) (gnc:debug "before spin-off basis list " basis-list)
(set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount (set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
(my-exchange-fn (gnc:make-gnc-monetary (my-exchange-fn (gnc:make-gnc-monetary
commod-currency split-value) commod-currency split-value)
currency)) currency))
basis-method basis-method
currency-frac)) currency-frac))
(gnc:debug "after spin-off basis list " basis-list)) (gnc:debug "after spin-off basis list " basis-list))
) )
)) ))
(xaccTransGetSplitList parent) (xaccTransGetSplitList parent)
) )
) )
) )
) )
) )
(xaccAccountGetSplitList current) (xaccAccountGetSplitList current)
) )
;; Look for income and expense transactions that don't have a split in the ;; Look for income and expense transactions that don't have a split in the
;; the account we're processing. We do this as follow ;; the account we're processing. We do this as follow
;; 1. Make sure the parent account is a currency-valued asset or bank account ;; 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 ;; 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 ;; 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 ;; 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 ;; same as the leaf name of the account we're processing, add it to the
;; income or expense accumulator ;; income or expense accumulator
;; ;;
@ -809,20 +811,20 @@
;; Dividends (type INCOME) ;; Dividends (type INCOME)
;; Widget Stock (type INCOME) ;; Widget Stock (type INCOME)
;; ;;
;; If you are producing a report on "Assets:Broker:Widget Stock" a ;; If you are producing a report on "Assets:Broker:Widget Stock" a
;; transaction that debits the Assets:Broker account and credits the ;; transaction that debits the Assets:Broker account and credits the
;; "Income:Dividends:Widget Stock" account will count as income in ;; "Income:Dividends:Widget Stock" account will count as income in
;; the report even though it doesn't have a split in the account ;; the report even though it doesn't have a split in the account
;; being reported on. ;; being reported on.
(let ((parent-account (gnc-account-get-parent current)) (let ((parent-account (gnc-account-get-parent current))
(account-name (xaccAccountGetName current))) (account-name (xaccAccountGetName current)))
(if (and (not (null? parent-account)) (if (and (not (null? parent-account))
(member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK)) (member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
(gnc-commodity-is-currency (xaccAccountGetCommodity parent-account))) (gnc-commodity-is-currency (xaccAccountGetCommodity parent-account)))
(for-each (for-each
(lambda (split) (lambda (split)
(let* ((other-split (xaccSplitGetOtherSplit split)) (let* ((other-split (xaccSplitGetOtherSplit split))
;; This is safe because xaccSplitGetAccount returns null for a null split ;; This is safe because xaccSplitGetAccount returns null for a null split
(other-acct (xaccSplitGetAccount other-split)) (other-acct (xaccSplitGetAccount other-split))
(parent (xaccSplitGetParent split)) (parent (xaccSplitGetParent split))
@ -831,7 +833,7 @@
(gnc:timepair-le txn-date to-date) (gnc:timepair-le txn-date to-date)
(string=? (xaccAccountGetName other-acct) account-name) (string=? (xaccAccountGetName other-acct) account-name)
(gnc-commodity-is-currency (xaccAccountGetCommodity other-acct))) (gnc-commodity-is-currency (xaccAccountGetCommodity other-acct)))
;; This is a two split transaction where the other split is to an ;; 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 ;; account with the same name as the current account. If it's an
;; income or expense account accumulate the value of the transaction ;; income or expense account accumulate the value of the transaction
(let ((val (xaccSplitGetValue split)) (let ((val (xaccSplitGetValue split))
@ -840,13 +842,13 @@
(gnc:debug "More income " (gnc-numeric-to-string val)) (gnc:debug "More income " (gnc-numeric-to-string val))
(dividendcoll 'add curr val)) (dividendcoll 'add curr val))
((split-account-type? other-split ACCT-TYPE-EXPENSE) ((split-account-type? other-split ACCT-TYPE-EXPENSE)
(gnc:debug "More expense " (gnc-numeric-to-string (gnc:debug "More expense " (gnc-numeric-to-string
(gnc-numeric-neg val))) (gnc-numeric-neg val)))
(brokeragecoll 'add curr (gnc-numeric-neg val))) (brokeragecoll 'add curr (gnc-numeric-neg val)))
) )
) )
) )
) )
) )
(xaccAccountGetSplitList parent-account) (xaccAccountGetSplitList parent-account)
) )
@ -858,7 +860,7 @@
(gnc:debug "prefer-pricelist is " prefer-pricelist) (gnc:debug "prefer-pricelist is " prefer-pricelist)
(gnc:debug "price is " price) (gnc:debug "price is " price)
(gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
currency-frac))) currency-frac)))
(gnc:debug "but the actual basis list is " basis-list) (gnc:debug "but the actual basis list is " basis-list)
@ -872,9 +874,9 @@
(income (gnc:sum-collector-commodity dividendcoll 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.. ;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well..
(gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn)) (gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn))
(ugain (gnc:make-gnc-monetary currency (ugain (gnc:make-gnc-monetary currency
(gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency)) (gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency))
(sum-basis basis-list (gnc-commodity-get-fraction currency)) (sum-basis basis-list (gnc-commodity-get-fraction currency))
currency-frac GNC-RND-ROUND))) currency-frac GNC-RND-ROUND)))
(bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain) (bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain)
(gnc:gnc-monetary-amount ugain) (gnc:gnc-monetary-amount ugain)
@ -916,7 +918,7 @@
price price
) )
price price
) )
(gnc:html-price-anchor (gnc:html-price-anchor
price price
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
@ -924,7 +926,7 @@
(gnc-price-get-value price))) (gnc-price-get-value price)))
))))) )))))
(append! activecols (list (if use-txn (if pricing-txn "*" "**") " ") (append! activecols (list (if use-txn (if pricing-txn "*" "**") " ")
(gnc:make-html-table-header-cell/markup (gnc:make-html-table-header-cell/markup
"number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list
currency-frac))) currency-frac)))
(gnc:make-html-table-header-cell/markup "number-cell" value) (gnc:make-html-table-header-cell/markup "number-cell" value)
@ -947,7 +949,7 @@
(if (not (eq? handle-brokerage-fees 'ignore-brokerage)) (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" brokerage))))
(append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn) (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn)
(gnc:make-html-table-header-cell/markup "number-cell" (gnc:make-html-table-header-cell/markup "number-cell"
(let* ((moneyinvalue (gnc-numeric-to-double (let* ((moneyinvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount moneyin))) (gnc:gnc-monetary-amount moneyin)))
(totalreturnvalue (gnc-numeric-to-double (totalreturnvalue (gnc-numeric-to-double
@ -958,12 +960,12 @@
(sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue moneyinvalue)))))) (sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue moneyinvalue))))))
) )
) )
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
row-style row-style
activecols) activecols)
(if (and (not use-txn) price) (gnc-price-unref price)) (if (and (not use-txn) price) (gnc-price-unref price))
(table-add-stock-rows-internal rest (not odd-row?)) (table-add-stock-rows-internal rest (not odd-row?))
) )
@ -976,7 +978,7 @@
(set! work-to-do (gnc:accounts-count-splits accounts)) (set! work-to-do (gnc:accounts-count-splits accounts))
(table-add-stock-rows-internal accounts #t))) (table-add-stock-rows-internal accounts #t)))
;; Tell the user that we're starting. ;; Tell the user that we're starting.
(gnc:report-starting reportname) (gnc:report-starting reportname)
@ -989,7 +991,7 @@
(currency (get-option gnc:pagename-general "Report's currency")) (currency (get-option gnc:pagename-general "Report's currency"))
(price-source (get-option gnc:pagename-general (price-source (get-option gnc:pagename-general
optname-price-source)) optname-price-source))
(report-title (get-option gnc:pagename-general (report-title (get-option gnc:pagename-general
gnc:optname-reportname)) gnc:optname-reportname))
(include-empty (get-option gnc:pagename-accounts (include-empty (get-option gnc:pagename-accounts
optname-zero-shares)) optname-zero-shares))
@ -1021,7 +1023,7 @@
(document (gnc:make-html-document))) (document (gnc:make-html-document)))
(gnc:html-document-set-title! (gnc:html-document-set-title!
document (string-append document (string-append
report-title report-title
(sprintf #f " %s" (gnc-print-date to-date)))) (sprintf #f " %s" (gnc-print-date to-date))))
@ -1031,12 +1033,12 @@
(pricedb (gnc-pricedb-get-db (gnc-get-current-book))) (pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
(price-fn (price-fn
(case price-source (case price-source
((pricedb-latest) ((pricedb-latest)
(lambda (foreign domestic date) (lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-latest-any-currency pricedb foreign) (find-price (gnc-pricedb-lookup-latest-any-currency pricedb foreign)
domestic))) domestic)))
((pricedb-nearest) ((pricedb-nearest)
(lambda (foreign domestic date) (lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-nearest-in-time-any-currency (find-price (gnc-pricedb-lookup-nearest-in-time-any-currency
pricedb foreign (timespecCanonicalDayTime date)) domestic))))) pricedb foreign (timespecCanonicalDayTime date)) domestic)))))
(headercols (list (_ "Account"))) (headercols (list (_ "Account")))
@ -1047,22 +1049,22 @@
(sum-total-gain (gnc-numeric-zero)) (sum-total-gain (gnc-numeric-zero))
(sum-total-ugain (gnc-numeric-zero)) (sum-total-ugain (gnc-numeric-zero))
(sum-total-brokerage (gnc-numeric-zero)) (sum-total-brokerage (gnc-numeric-zero))
(sum-total-totalreturn (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 (if show-symbol
(begin (append! headercols (list (_ "Symbol"))) (begin (append! headercols (list (_ "Symbol")))
(append! totalscols (list " ")))) (append! totalscols (list " "))))
(if show-listing (if show-listing
(begin (append! headercols (list (_ "Listing"))) (begin (append! headercols (list (_ "Listing")))
(append! totalscols (list " ")))) (append! totalscols (list " "))))
(if show-shares (if show-shares
(begin (append! headercols (list (_ "Shares"))) (begin (append! headercols (list (_ "Shares")))
(append! totalscols (list " ")))) (append! totalscols (list " "))))
(if show-price (if show-price
(begin (append! headercols (list (_ "Price"))) (begin (append! headercols (list (_ "Price")))
(append! totalscols (list " ")))) (append! totalscols (list " "))))
@ -1088,14 +1090,14 @@
(gnc:html-table-set-col-headers! (gnc:html-table-set-col-headers!
table table
headercols) headercols)
(table-add-stock-rows (table-add-stock-rows
table accounts to-date currency price-fn exchange-fn price-source table accounts to-date currency price-fn exchange-fn price-source
include-empty show-symbol show-listing show-shares show-price basis-method include-empty show-symbol show-listing show-shares show-price basis-method
prefer-pricelist handle-brokerage-fees prefer-pricelist handle-brokerage-fees
total-basis total-value total-moneyin total-moneyout total-basis total-value total-moneyin total-moneyout
total-income total-gain total-ugain total-brokerage) total-income total-gain total-ugain total-brokerage)
(set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin currency exchange-fn)) (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-income (gnc:sum-collector-commodity total-income currency exchange-fn))
@ -1152,17 +1154,17 @@
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"total-number-cell" sum-total-totalreturn) "total-number-cell" sum-total-totalreturn)
(gnc:make-html-table-cell/markup (gnc:make-html-table-cell/markup
"total-number-cell" "total-number-cell"
(let* ((totalinvalue (gnc-numeric-to-double (let* ((totalinvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount sum-total-moneyin))) (gnc:gnc-monetary-amount sum-total-moneyin)))
(totalreturnvalue (gnc-numeric-to-double (totalreturnvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount sum-total-totalreturn))) (gnc:gnc-monetary-amount sum-total-totalreturn)))
) )
(if (= 0.0 totalinvalue) (if (= 0.0 totalinvalue)
"" ""
(sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue totalinvalue)))))) (sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue totalinvalue))))))
)) ))
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
@ -1171,24 +1173,24 @@
) )
(gnc:html-document-add-object! document table) (gnc:html-document-add-object! document table)
(if warn-price-dirty (if warn-price-dirty
(gnc:html-document-append-objects! document (gnc:html-document-append-objects! document
(list (gnc:make-html-text (_ "* this commodity data was built using transaction pricing instead of the price list.")) (list (gnc:make-html-text (_ "* 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 (gnc:html-markup-br))
(gnc:make-html-text (_ "If you are in a multi-currency situation, the exchanges may not be correct."))))) (gnc:make-html-text (_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
(if warn-no-price (if warn-no-price
(gnc:html-document-append-objects! document (gnc:html-document-append-objects! document
(list (gnc:make-html-text (if warn-price-dirty (gnc:html-markup-br) "")) (list (gnc:make-html-text (if warn-price-dirty (gnc:html-markup-br) ""))
(gnc:make-html-text (_ "** this commodity has no price and a price of 1 has been used."))))) (gnc:make-html-text (_ "** 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! (gnc:html-document-add-object!
document document
(gnc:html-make-no-account-warning (gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj)))) report-title (gnc:report-id report-obj))))
(gnc:report-finished) (gnc:report-finished)
document))) document)))

112
src/report/standard-reports/portfolio.scm
View File

@ -2,16 +2,16 @@
;; portfolio.scm ;; portfolio.scm
;; by Robert Merkel (rgmerk@mira.net) ;; by Robert Merkel (rgmerk@mira.net)
;; ;;
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of ;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version. ;; the License, or (at your option) any later version.
;; ;;
;; This program is distributed in the hope that it will be useful, ;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact: ;; along with this program; if not, contact:
;; ;;
@ -39,23 +39,23 @@
(define optname-zero-shares (N_ "Include accounts with no shares")) (define optname-zero-shares (N_ "Include accounts with no shares"))
(define (options-generator) (define (options-generator)
(let* ((options (gnc:new-options)) (let* ((options (gnc:new-options))
;; This is just a helper function for making options. ;; This is just a helper function for making options.
;; See gnucash/src/scm/options.scm for details. ;; See gnucash/src/scm/options.scm for details.
(add-option (add-option
(lambda (new-option) (lambda (new-option)
(gnc:register-option options new-option)))) (gnc:register-option options new-option))))
;; General Tab ;; General Tab
;; date at which to report balance ;; date at which to report balance
(gnc:options-add-report-date! (gnc:options-add-report-date!
options gnc:pagename-general options gnc:pagename-general
(N_ "Date") "a") (N_ "Date") "a")
(gnc:options-add-currency! (gnc:options-add-currency!
options gnc:pagename-general (N_ "Report's currency") "c") options gnc:pagename-general (N_ "Report's currency") "c")
(gnc:options-add-price-source! (gnc:options-add-price-source!
options gnc:pagename-general options gnc:pagename-general
optname-price-source "d" 'pricedb-latest) optname-price-source "d" 'pricedb-latest)
@ -74,18 +74,18 @@
(lambda () (filter gnc:account-is-stock? (lambda () (filter gnc:account-is-stock?
(gnc-account-get-descendants-sorted (gnc-account-get-descendants-sorted
(gnc-get-current-root-account)))) (gnc-get-current-root-account))))
(lambda (accounts) (list #t (lambda (accounts) (list #t
(filter gnc:account-is-stock? accounts))) (filter gnc:account-is-stock? accounts)))
#t)) #t))
(gnc:register-option (gnc:register-option
options options
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
gnc:pagename-accounts optname-zero-shares "e" gnc:pagename-accounts optname-zero-shares "e"
(N_ "Include accounts that have a zero share balances.") (N_ "Include accounts that have a zero share balances.")
#f)) #f))
(gnc:options-set-default-section options gnc:pagename-general) (gnc:options-set-default-section options gnc:pagename-general)
options)) options))
;; This is the rendering function. It accepts a database of options ;; This is the rendering function. It accepts a database of options
@ -98,14 +98,14 @@
(let ((work-done 0) (let ((work-done 0)
(work-to-do 0)) (work-to-do 0))
;; These are some helper functions for looking up option values. ;; These are some helper functions for looking up option values.
(define (get-op section name) (define (get-op section name)
(gnc:lookup-option (gnc:report-options report-obj) section name)) (gnc:lookup-option (gnc:report-options report-obj) section name))
(define (get-option section name) (define (get-option section name)
(gnc:option-value (get-op section name))) (gnc:option-value (get-op section name)))
(define (table-add-stock-rows table accounts to-date currency (define (table-add-stock-rows table accounts to-date currency
exchange-fn price-fn include-empty collector) exchange-fn price-fn include-empty collector)
@ -149,7 +149,7 @@
(gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol) (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 "text-cell" listing)
(gnc:make-html-table-header-cell/markup (gnc:make-html-table-header-cell/markup
"number-cell" "number-cell"
(xaccPrintAmount units share-print-info)) (xaccPrintAmount units share-print-info))
(gnc:make-html-table-header-cell/markup (gnc:make-html-table-header-cell/markup
"number-cell" "number-cell"
@ -176,7 +176,7 @@
(get-option gnc:pagename-general "Date"))) (get-option gnc:pagename-general "Date")))
(accounts (get-option gnc:pagename-accounts "Accounts")) (accounts (get-option gnc:pagename-accounts "Accounts"))
(currency (get-option gnc:pagename-general "Report's currency")) (currency (get-option gnc:pagename-general "Report's currency"))
(report-title (get-option gnc:pagename-general (report-title (get-option gnc:pagename-general
gnc:optname-reportname)) gnc:optname-reportname))
(price-source (get-option gnc:pagename-general (price-source (get-option gnc:pagename-general
optname-price-source)) optname-price-source))
@ -189,55 +189,67 @@
(document (gnc:make-html-document))) (document (gnc:make-html-document)))
(gnc:html-document-set-title! (gnc:html-document-set-title!
document (string-append document (string-append
report-title report-title
(sprintf #f " %s" (gnc-print-date to-date)))) (sprintf #f " %s" (gnc-print-date to-date))))
;(gnc:debug "accounts" accounts) ;(gnc:debug "accounts" accounts)
(if (not (null? accounts)) (if (not (null? accounts))
(let* ((commodity-list (gnc:accounts-get-commodities (let* ((commodity-list (gnc:accounts-get-commodities
(append (append
(gnc:acccounts-get-all-subaccounts (gnc:acccounts-get-all-subaccounts
accounts) accounts) currency)) accounts) accounts) currency))
(pricedb (gnc-pricedb-get-db (gnc-get-current-book))) (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 (price-fn
(case price-source (case price-source
((weighted-average average-cost) ((weighted-average average-cost)
(lambda (foreign date) (lambda (foreign date)
(cons #f (gnc-numeric-div (cons #f (gnc-numeric-div
(gnc:gnc-monetary-amount (gnc:gnc-monetary-amount
(exchange-fn (gnc:make-gnc-monetary foreign (exchange-fn (gnc:make-gnc-monetary foreign
(gnc-numeric-create 10000 1)) (gnc-numeric-create 10000 1))
currency)) currency))
(gnc-numeric-create 10000 1) (gnc-numeric-create 10000 1)
GNC-DENOM-AUTO GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 5) GNC-RND-ROUND))))) (logior (GNC-DENOM-SIGFIGS 5) GNC-RND-ROUND)))))
((pricedb-latest) ((pricedb-latest)
(lambda (foreign date) (lambda (foreign date)
(let* ((price (let* ((price
(gnc-pricedb-lookup-latest-any-currency (gnc-pricedb-lookup-latest-any-currency
pricedb foreign)) pricedb foreign))
(fn (if (and price (> (length price) 0)) (fn (if (and price (> (length price) 0))
(let ((v (gnc-price-get-value (car price)))) (let* ((the_price
(if (gnc-commodity-equiv
foreign
(gnc-price-get-commodity (car price)))
(car price)
(gnc-price-invert (car price))))
(v (gnc-price-get-value the_price)))
(gnc-price-ref (car price)) (gnc-price-ref (car price))
(cons (car price) v)) (cons (car price) v))
(cons #f (gnc-numeric-zero))))) (cons #f (gnc-numeric-zero)))))
(if price (gnc-price-list-destroy price)) (if price (gnc-price-list-destroy price))
fn))) fn)))
((pricedb-nearest) ((pricedb-nearest)
(lambda (foreign date) (lambda (foreign date)
(let* ((price (let* ((price
(gnc-pricedb-lookup-nearest-in-time-any-currency (gnc-pricedb-lookup-nearest-in-time-any-currency
pricedb foreign (timespecCanonicalDayTime date))) pricedb foreign (timespecCanonicalDayTime date)))
(fn (if (and price (> (length price) 0)) (fn (if (and price (> (length price) 0))
(let ((v (gnc-price-get-value (car price)))) (let* ((the_price
(if (gnc-commodity-equiv
foreign
(gnc-price-get-commodity (car price)))
(car price)
(gnc-price-invert (car price))))
(v (gnc-price-get-value (car price))))
(gnc-price-ref (car price)) (gnc-price-ref (car price))
(cons (car price) v)) (cons (car price) v))
(cons #f (gnc-numeric-zero))))) (cons #f (gnc-numeric-zero)))))
(if price (gnc-price-list-destroy price)) (if price (gnc-price-list-destroy price))
fn)))))) fn))))))
(gnc:html-table-set-col-headers! (gnc:html-table-set-col-headers!
table table
(list (_ "Account") (list (_ "Account")
@ -246,22 +258,22 @@
(_ "Units") (_ "Units")
(_ "Price") (_ "Price")
(_ "Value"))) (_ "Value")))
(table-add-stock-rows (table-add-stock-rows
table accounts to-date currency table accounts to-date currency
exchange-fn price-fn include-empty collector) exchange-fn price-fn include-empty collector)
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
"grand-total" "grand-total"
(list (list
(gnc:make-html-table-cell/size (gnc:make-html-table-cell/size
1 6 (gnc:make-html-text (gnc:html-markup-hr))))) 1 6 (gnc:make-html-text (gnc:html-markup-hr)))))
(collector (collector
'format 'format
(lambda (currency amount) (lambda (currency amount)
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table table
"grand-total" "grand-total"
(list (gnc:make-html-table-cell/markup (list (gnc:make-html-table-cell/markup
@ -270,15 +282,15 @@
1 5 "total-number-cell" 1 5 "total-number-cell"
(gnc:make-gnc-monetary currency amount))))) (gnc:make-gnc-monetary currency amount)))))
#f) #f)
(gnc:html-document-add-object! document table)) (gnc:html-document-add-object! document table))
;if no accounts selected. ;if no accounts selected.
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:html-make-no-account-warning (gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj)))) report-title (gnc:report-id report-obj))))
(gnc:report-finished) (gnc:report-finished)
document))) document)))

95
src/scm/price-quotes.scm
View File

@ -1,17 +1,17 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; price-quotes.scm - manage sub-processes. ;;; price-quotes.scm - manage sub-processes.
;;; Copyright 2001 Rob Browning <rlb@cs.utexas.edu> ;;; Copyright 2001 Rob Browning <rlb@cs.utexas.edu>
;;; ;;;
;;; This program is free software; you can redistribute it and/or ;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as ;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 2 of ;;; published by the Free Software Foundation; either version 2 of
;;; the License, or (at your option) any later version. ;;; the License, or (at your option) any later version.
;;; ;;;
;;; This program is distributed in the hope that it will be useful, ;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details. ;;; GNU General Public License for more details.
;;; ;;;
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, contact: ;;; along with this program; if not, contact:
;;; ;;;
@ -35,7 +35,7 @@
(define (item-list->hash! lst hash (define (item-list->hash! lst hash
getkey getval getkey getval
hashref hashset hashref hashset
list-duplicates?) list-duplicates?)
;; Takes a list of the form (item item item item) and returns a hash ;; Takes a list of the form (item item item item) and returns a hash
;; formed by traversing the list, and getting the key and val from ;; formed by traversing the list, and getting the key and val from
@ -58,7 +58,7 @@
(if existing-val (if existing-val
(hashset hash key (cons val existing-val)) (hashset hash key (cons val existing-val))
(hashset hash key (list val)))))) (hashset hash key (list val))))))
(for-each handle-item lst) (for-each handle-item lst)
hash) hash)
@ -205,7 +205,7 @@
;; a list of the corresponding commodities. Also perform a bit of ;; a list of the corresponding commodities. Also perform a bit of
;; optimization, merging calls for symbols to the same ;; optimization, merging calls for symbols to the same
;; Finance::Quote method. ;; Finance::Quote method.
;; ;;
;; Returns a list of the info needed for a set of calls to ;; Returns a list of the info needed for a set of calls to
;; gnc-fq-helper. Each item will of the list will be of the ;; gnc-fq-helper. Each item will of the list will be of the
;; form: ;; form:
@ -223,7 +223,7 @@
(commodity-list #f) (commodity-list #f)
(currency-list (filter (currency-list (filter
(lambda (a) (not (gnc-commodity-equiv (cadr a) (caddr a)))) (lambda (a) (not (gnc-commodity-equiv (cadr a) (caddr a))))
(call-with-values (call-with-values
(lambda () (partition! (lambda () (partition!
(lambda (cmd) (lambda (cmd)
(not (string=? (car cmd) "currency"))) (not (string=? (car cmd) "currency")))
@ -257,7 +257,7 @@
;; ;;
;; ("yahoo" (commodity-1 currency-1 tz-1) ;; ("yahoo" (commodity-1 currency-1 tz-1)
;; (commodity-2 currency-2 tz-2) ...) ;; (commodity-2 currency-2 tz-2) ...)
;; ;;
;; ("yahoo" "IBM" "AMD" ...) ;; ("yahoo" "IBM" "AMD" ...)
;; ;;
@ -375,7 +375,15 @@
(saved-price #f) (saved-price #f)
(commodity-str (gnc-commodity-get-printname commodity)) (commodity-str (gnc-commodity-get-printname commodity))
) )
(if (equal? (gnc-commodity-get-printname currency) commodity-str)
(let* ((symbol (assq-ref quote-data 'symbol))
(other-curr
(and commodity-table
(string? symbol)
(gnc-commodity-table-lookup commodity-table "ISO4217"
(string-upcase symbol)))))
(set! commodity other-curr))
)
(or-map (lambda (price-sym) (or-map (lambda (price-sym)
(let ((p (assq-ref quote-data price-sym))) (let ((p (assq-ref quote-data price-sym)))
(if p (if p
@ -412,31 +420,36 @@
commodity currency commodity currency
gnc-time)) gnc-time))
(if (not (null? saved-price)) (if (not (null? saved-price))
(if (> (gnc-price-get-source saved-price) PRICE-SOURCE-FQ) (begin
(begin (if (gnc-commodity-equiv (gnc-price-get-currency saved-price)
(gnc-price-begin-edit saved-price) commodity)
(gnc-price-set-time saved-price gnc-time) (set! price (gnc-numeric-invert price)))
(gnc-price-set-source saved-price PRICE-SOURCE-FQ) (if (> (gnc-price-get-source saved-price) PRICE-SOURCE-FQ)
(gnc-price-set-typestr saved-price price-type) (begin
(gnc-price-set-value saved-price price) (gnc-price-begin-edit saved-price)
(gnc-price-commit-edit saved-price) (gnc-price-set-time saved-price gnc-time)
(gnc-price-set-source saved-price PRICE-SOURCE-FQ)
(gnc-price-set-typestr saved-price price-type)
(gnc-price-set-value saved-price price)
(gnc-price-commit-edit saved-price)
#f)
#f) #f)
#f) (let ((gnc-price (gnc-price-create book)))
(let ((gnc-price (gnc-price-create book))) (if (not gnc-price)
(if (not gnc-price) (string-append
(string-append currency-str ":" (gnc-commodity-get-mnemonic commodity))
currency-str ":" (gnc-commodity-get-mnemonic commodity)) (begin
(begin (gnc-price-begin-edit gnc-price)
(gnc-price-begin-edit gnc-price) (gnc-price-set-commodity gnc-price commodity)
(gnc-price-set-commodity gnc-price commodity) (gnc-price-set-currency gnc-price currency)
(gnc-price-set-currency gnc-price currency) (gnc-price-set-time gnc-price gnc-time)
(gnc-price-set-time gnc-price gnc-time) (gnc-price-set-source gnc-price PRICE-SOURCE-FQ)
(gnc-price-set-source gnc-price PRICE-SOURCE-FQ) (gnc-price-set-typestr gnc-price price-type)
(gnc-price-set-typestr gnc-price price-type) (gnc-price-set-value gnc-price price)
(gnc-price-set-value gnc-price price) (gnc-price-commit-edit gnc-price)
(gnc-price-commit-edit gnc-price) gnc-price)))))
gnc-price))))) ))
))) ))
(define (book-add-prices! book prices) (define (book-add-prices! book prices)
(let ((pricedb (gnc-pricedb-get-db book))) (let ((pricedb (gnc-pricedb-get-db book)))