mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge branch 'big-prices'
This commit is contained in:
commit
f82717496a
@ -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);
|
||||
if (price == NULL)
|
||||
{
|
||||
price = gnc_pricedb_lookup_latest(price_db, split_cmdty, first_cmdty);
|
||||
if (price == NULL)
|
||||
{
|
||||
GString *err = g_string_new("");
|
||||
g_string_printf(err, "could not find pricedb entry for commodity-pair (%s, %s).",
|
||||
gnc_commodity_get_mnemonic(first_cmdty),
|
||||
@ -1135,7 +1132,9 @@ create_each_transaction_helper(Transaction *template_txn, void *user_data)
|
||||
}
|
||||
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,
|
||||
GNC_HOW_RND_ROUND_HALF_UP);
|
||||
}
|
||||
|
@ -185,6 +185,8 @@ gnc_ui_account_get_balance_as_of_date (Account *account,
|
||||
time64 date,
|
||||
gboolean include_children)
|
||||
{
|
||||
QofBook *book = gnc_account_get_book (account);
|
||||
GNCPriceDB *pdb = gnc_pricedb_get_db (book);
|
||||
gnc_numeric balance;
|
||||
gnc_commodity *currency;
|
||||
|
||||
@ -209,8 +211,10 @@ gnc_ui_account_get_balance_as_of_date (Account *account,
|
||||
child = node->data;
|
||||
child_currency = xaccAccountGetCommodity (child);
|
||||
child_balance = xaccAccountGetBalanceAsOfDate (child, date);
|
||||
child_balance = xaccAccountConvertBalanceToCurrency (child,
|
||||
child_balance, child_currency, currency);
|
||||
child_balance =
|
||||
gnc_pricedb_convert_balance_latest_price (pdb, child_balance,
|
||||
child_currency,
|
||||
currency);
|
||||
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);
|
||||
return g_strdup (xaccPrintAmount (balance, print_info));
|
||||
}
|
||||
|
||||
|
@ -203,7 +203,7 @@ write_price( GNCPrice* p, gpointer data )
|
||||
g_return_val_if_fail( p != 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) );
|
||||
}
|
||||
|
@ -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_currency (convprice, gncInvoiceGetCurrency (invoice));
|
||||
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_value (convprice, exch_rate);
|
||||
gncInvoiceAddPrice(invoice, convprice);
|
||||
|
@ -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-SPLIT-REG");
|
||||
SET_ENUM("PRICE-SOURCE-STOCK-SPLIT");
|
||||
SET_ENUM("PRICE-SOURCE-INVOICE");
|
||||
SET_ENUM("PRICE-SOURCE-TEMP");
|
||||
SET_ENUM("PRICE-SOURCE-INVALID");
|
||||
|
||||
#undef SET_ENUM
|
||||
|
@ -81,6 +81,7 @@ typedef enum
|
||||
typedef struct gnc_price_lookup_helper_s
|
||||
{
|
||||
GList **return_list;
|
||||
gnc_commodity *key;
|
||||
Timespec time;
|
||||
} GNCPriceLookupHelper;
|
||||
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -169,7 +169,8 @@ typedef enum
|
||||
PRICE_SOURCE_SPLIT_REG, // "user:split-register"
|
||||
PRICE_SOURCE_STOCK_SPLIT, // "user:stock-split"
|
||||
PRICE_SOURCE_INVOICE, // "user:invoice-post"
|
||||
PRICE_SOURCE_INVALID,
|
||||
PRICE_SOURCE_TEMP, // "temporary"
|
||||
PRICE_SOURCE_INVALID, // "invalid"
|
||||
} PriceSource;
|
||||
|
||||
#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
|
||||
will have a reference count of 1. */
|
||||
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 */
|
||||
typedef struct gnc_price_db_s GNCPriceDB;
|
||||
|
||||
/** return the pricedb associated with the book */
|
||||
/*@ dependent @*/
|
||||
/** @brief Return the pricedb associated with the book
|
||||
* @param book The QofBook holding the pricedb
|
||||
* @return The GNCPriceDB associated with the 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);
|
||||
|
||||
/** gnc_pricedb_destroy - destroy the given pricedb and unref all of
|
||||
the prices it contains. This may not deallocate all of those
|
||||
prices. Other code may still be holding references to them. */
|
||||
/** @brief Destroy the given pricedb and unref all of the prices it contains.
|
||||
*
|
||||
* 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);
|
||||
|
||||
/** Used for editing the pricedb en-mass */
|
||||
/** @brief Begin an edit. */
|
||||
void gnc_pricedb_begin_edit (GNCPriceDB *);
|
||||
/** @brief Commit an edit. */
|
||||
void gnc_pricedb_commit_edit (GNCPriceDB *);
|
||||
|
||||
/** Indicate whether or not the database is in the middle of a bulk
|
||||
* update. Setting this flag will disable checks for duplicate
|
||||
* entries. */
|
||||
/** @brief Set flag to indicate whether duplication checks should be performed.
|
||||
*
|
||||
* 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);
|
||||
|
||||
/** gnc_pricedb_add_price - add a price to the pricedb, you may drop
|
||||
your reference to the price (i.e. call unref) after this
|
||||
succeeds, whenever you're finished with the price. */
|
||||
/** @brief Add a price to the pricedb.
|
||||
*
|
||||
* 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);
|
||||
|
||||
/** gnc_pricedb_remove_price - removes the given price, p, from the
|
||||
pricedb. Returns TRUE if successful, FALSE otherwise. */
|
||||
/** @brief Remove a price from the pricedb and unref the price.
|
||||
* @param db The Pricedb
|
||||
* @param p The price to remove.
|
||||
*/
|
||||
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,
|
||||
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
|
||||
given commodity in the given currency. Returns NULL on
|
||||
failure. */
|
||||
/** @brief Find the most recent price between the two commodities.
|
||||
*
|
||||
* 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,
|
||||
const gnc_commodity *commodity,
|
||||
const gnc_commodity *currency);
|
||||
|
||||
/** gnc_pricedb_lookup_latest_any_currency - find the most recent prices
|
||||
for the given commodity in any available currency. Prices will be
|
||||
returned as a GNCPrice list (see above). */
|
||||
/** @brief Find the most recent price between a commodity and all other
|
||||
* commodities
|
||||
*
|
||||
* 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,
|
||||
const gnc_commodity *commodity);
|
||||
|
||||
/** gnc_pricedb_has_prices - return an indication of whether or not
|
||||
there are any prices for a given commodity in the given currency.
|
||||
Returns TRUE if there are prices, FALSE otherwise. */
|
||||
/** @brief Report wether the pricedb contains prices for one commodity in
|
||||
* another.
|
||||
*
|
||||
* 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,
|
||||
const gnc_commodity *commodity,
|
||||
const gnc_commodity *currency);
|
||||
|
||||
/** gnc_pricedb_get_prices - return all the prices for a given
|
||||
commodity in the given currency. Returns NULL on failure. The
|
||||
result is a GNCPrice list (see above). */
|
||||
/** @brief Return all the prices for a given commodity in another.
|
||||
*
|
||||
* 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,
|
||||
const gnc_commodity *commodity,
|
||||
const gnc_commodity *currency);
|
||||
|
||||
/** gnc_pricedb_lookup_at_time - return all prices that match the given
|
||||
commodity, currency, and timespec. Prices will be returned as a
|
||||
GNCPrice list (see above). */
|
||||
PriceList * gnc_pricedb_lookup_at_time(GNCPriceDB *db,
|
||||
/** @brief Find the price between two commodities at a timespec.
|
||||
*
|
||||
* 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 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 *currency,
|
||||
Timespec t);
|
||||
|
||||
/** gnc_pricedb_lookup_day - return the price that matchex the given
|
||||
commodity, currency, and timespec which is on the same day.
|
||||
If no prices are on that day, returns a null value. */
|
||||
/** @brief Return the price between the two commodities on the indicated
|
||||
* day. Note that the notion of day might be distorted by changes in timezone.
|
||||
*
|
||||
* 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,
|
||||
const gnc_commodity *commodity,
|
||||
const gnc_commodity *currency,
|
||||
Timespec t);
|
||||
|
||||
|
||||
/** gnc_pricedb_lookup_nearest_in_time - return the price for the given
|
||||
commodity in the given currency nearest to the given time t. */
|
||||
/** @brief Return the price between the two commoditiesz nearest to 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 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,
|
||||
const gnc_commodity *c,
|
||||
const gnc_commodity *currency,
|
||||
Timespec t);
|
||||
|
||||
/** gnc_pricedb_lookup_nearest_in_time_any_currency - return all prices that
|
||||
match the given commodity and timespec in any available currency. Prices
|
||||
will be returned as a GNCPrice list (see above). */
|
||||
/** @brief Return the price nearest in time to that given between the given
|
||||
* commodity and every other.
|
||||
*
|
||||
* 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,
|
||||
const gnc_commodity *c,
|
||||
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,
|
||||
gnc_commodity *c,
|
||||
gnc_commodity *currency,
|
||||
Timespec t);
|
||||
|
||||
/** gnc_pricedb_lookup_latest_before_any_currency - return recent prices that
|
||||
match the given commodity up to and including time t in any available currency. Prices
|
||||
will be returned as a GNCPrice list (see above). */
|
||||
/** @brief Return the latest price between the given commodity and any other
|
||||
* 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 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,
|
||||
gnc_commodity *c,
|
||||
Timespec t);
|
||||
const gnc_commodity *c,
|
||||
Timespec t);
|
||||
|
||||
|
||||
/** gnc_pricedb_convert_balance_latest_price - Convert a balance
|
||||
from one currency to another. */
|
||||
/** @brief Convert a balance from one currency to another using the most recent
|
||||
* 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_pricedb_convert_balance_latest_price(GNCPriceDB *pdb,
|
||||
gnc_numeric balance,
|
||||
const gnc_commodity *balance_currency,
|
||||
const gnc_commodity *new_currency);
|
||||
gnc_numeric balance,
|
||||
const gnc_commodity *balance_currency,
|
||||
const gnc_commodity *new_currency);
|
||||
|
||||
/** gnc_pricedb_convert_balance_nearest_price - Convert a balance
|
||||
from one currency to another. */
|
||||
/** @brief Convert a balance from one currency to another using the price
|
||||
* 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_pricedb_convert_balance_nearest_price(GNCPriceDB *pdb,
|
||||
gnc_numeric balance,
|
||||
const gnc_commodity *balance_currency,
|
||||
const gnc_commodity *new_currency,
|
||||
Timespec t);
|
||||
gnc_numeric balance,
|
||||
const gnc_commodity *balance_currency,
|
||||
const gnc_commodity *new_currency,
|
||||
Timespec t);
|
||||
|
||||
/** gnc_pricedb_foreach_price - call f once for each price in db, until
|
||||
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
|
||||
every time given the same db contents -- stable traversals may be
|
||||
less efficient). */
|
||||
typedef gboolean (*GncPriceForeachFunc)(GNCPrice *p, gpointer user_data);
|
||||
|
||||
/** @brief Call a GncPriceForeachFunction once for each price in db, until the
|
||||
* function returns FALSE.
|
||||
*
|
||||
* 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 (*f)(GNCPrice *p,
|
||||
gpointer user_data),
|
||||
GncPriceForeachFunc f,
|
||||
gpointer user_data,
|
||||
gboolean stable_order);
|
||||
|
||||
/* The following two convenience functions are used to test the xml backend */
|
||||
/** gnc_pricedb_get_num_prices - return the number of prices
|
||||
in the database. */
|
||||
/** @brief Return the number of prices in the database.
|
||||
*
|
||||
* For XML Backend Testing
|
||||
*/
|
||||
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);
|
||||
|
||||
/** @name Internal/Debugging
|
||||
|
@ -114,6 +114,7 @@ test_engine_SOURCES = \
|
||||
utest-Entry.c \
|
||||
utest-Invoice.c \
|
||||
test-engine-kvp-properties.c \
|
||||
utest-gnc-pricedb.c \
|
||||
dummy.cpp
|
||||
|
||||
test_engine_LDADD = \
|
||||
|
@ -129,7 +129,7 @@ teardown (Fixture *fixture, gconstpointer pData)
|
||||
*/
|
||||
QofBook *book = qof_instance_get_book (QOF_INSTANCE (fixture->acct));
|
||||
test_destroy (fixture->acct);
|
||||
test_destroy (book);
|
||||
qof_book_destroy (book);
|
||||
}
|
||||
|
||||
static void
|
||||
|
@ -33,6 +33,7 @@ extern void test_suite_gncInvoice();
|
||||
extern void test_suite_transaction();
|
||||
extern void test_suite_split();
|
||||
extern void test_suite_engine_kvp_properties (void);
|
||||
extern void test_suite_gnc_pricedb();
|
||||
|
||||
int
|
||||
main (int argc,
|
||||
@ -53,6 +54,7 @@ main (int argc,
|
||||
test_suite_transaction();
|
||||
test_suite_split();
|
||||
test_suite_engine_kvp_properties ();
|
||||
test_suite_gnc_pricedb();
|
||||
|
||||
return g_test_run( );
|
||||
}
|
||||
|
1408
src/engine/test/utest-gnc-pricedb.c
Normal file
1408
src/engine/test/utest-gnc-pricedb.c
Normal file
File diff suppressed because it is too large
Load Diff
@ -263,34 +263,18 @@ lookup_price(PriceReq *pr, PriceDate pd)
|
||||
case SAME_DAY:
|
||||
prc = gnc_pricedb_lookup_day (pr->pricedb, pr->from,
|
||||
pr->to, pr->ts);
|
||||
if (!prc)
|
||||
{
|
||||
prc = gnc_pricedb_lookup_day (pr->pricedb, pr->to,
|
||||
pr->from, pr->ts);
|
||||
pr->reverse = TRUE;
|
||||
}
|
||||
break;
|
||||
break;
|
||||
case NEAREST:
|
||||
prc = gnc_pricedb_lookup_nearest_in_time (pr->pricedb, pr->from,
|
||||
pr->to, pr->ts);
|
||||
if (!prc)
|
||||
{
|
||||
prc = gnc_pricedb_lookup_nearest_in_time (pr->pricedb, pr->to,
|
||||
pr->from, pr->ts);
|
||||
pr->reverse = TRUE;
|
||||
}
|
||||
break;
|
||||
break;
|
||||
case LATEST:
|
||||
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;
|
||||
}
|
||||
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",
|
||||
gnc_commodity_get_mnemonic(pr->to),
|
||||
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);
|
||||
}
|
||||
|
||||
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
|
||||
swap_commodities(gnc_commodity **from, gnc_commodity **to, gnc_numeric value)
|
||||
{
|
||||
@ -1609,12 +1579,6 @@ create_price(XferDialog *xferData, Timespec ts)
|
||||
return;
|
||||
|
||||
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
|
||||
* prices in terms of a currency regardless of value. However, if we already
|
||||
|
@ -90,38 +90,16 @@ static gnc_numeric
|
||||
gtu_sr_get_rate_from_db (gnc_commodity *from, gnc_commodity *to)
|
||||
{
|
||||
GNCPrice *prc;
|
||||
gnc_numeric rate_split;
|
||||
gboolean have_rate = FALSE;
|
||||
QofBook *book = gnc_get_current_book ();
|
||||
|
||||
/* Do we have a rate allready */
|
||||
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 (!have_rate)
|
||||
{
|
||||
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);
|
||||
if (!prc)
|
||||
return gnc_numeric_create (100, 100);
|
||||
|
||||
gnc_price_unref (prc);
|
||||
have_rate = TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
/* No rate, set to 1/1 */
|
||||
if (!have_rate)
|
||||
rate_split = gnc_numeric_create (100, 100);
|
||||
|
||||
return rate_split;
|
||||
if (gnc_commodity_equiv(from, gnc_price_get_currency(prc)))
|
||||
return gnc_numeric_invert(gnc_price_get_value(prc));
|
||||
return gnc_price_get_value(prc);
|
||||
}
|
||||
|
||||
|
||||
|
@ -148,20 +148,23 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
|
||||
for (node = children; node; node = g_list_next(node))
|
||||
{
|
||||
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_currency = xaccAccountGetCommodity(account);
|
||||
|
||||
if (options.grand_total)
|
||||
grand_total_accum = gnc_ui_get_currency_accumulator(currency_list,
|
||||
options.default_currency,
|
||||
to_curr,
|
||||
TOTAL_GRAND_TOTAL);
|
||||
|
||||
if (!gnc_commodity_is_currency(account_currency))
|
||||
{
|
||||
non_currency = TRUE;
|
||||
non_curr_accum = gnc_ui_get_currency_accumulator(currency_list,
|
||||
options.default_currency,
|
||||
to_curr,
|
||||
TOTAL_NON_CURR_TOTAL);
|
||||
}
|
||||
|
||||
@ -186,9 +189,10 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
|
||||
end_amount = xaccAccountGetBalanceAsOfDate(account, options.end_date);
|
||||
timespecFromTime64(&end_timespec, options.end_date);
|
||||
end_amount_default_currency =
|
||||
xaccAccountConvertBalanceToCurrencyAsOfDate
|
||||
(account, end_amount, account_currency, options.default_currency,
|
||||
timespecToTime64(timespecCanonicalDayTime(end_timespec)));
|
||||
gnc_pricedb_convert_balance_nearest_price (pricedb, end_amount,
|
||||
account_currency,
|
||||
to_curr,
|
||||
end_timespec);
|
||||
|
||||
if (!non_currency || options.non_currency)
|
||||
{
|
||||
@ -202,7 +206,7 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
|
||||
{
|
||||
non_curr_accum->assets =
|
||||
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);
|
||||
}
|
||||
|
||||
@ -210,7 +214,7 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
|
||||
{
|
||||
grand_total_accum->assets =
|
||||
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);
|
||||
}
|
||||
|
||||
@ -221,15 +225,18 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
|
||||
start_amount = xaccAccountGetBalanceAsOfDate(account, options.start_date);
|
||||
timespecFromTime64(&start_timespec, options.start_date);
|
||||
start_amount_default_currency =
|
||||
xaccAccountConvertBalanceToCurrencyAsOfDate
|
||||
(account, start_amount, account_currency, options.default_currency,
|
||||
timespecToTime64(timespecCanonicalDayTime(start_timespec)));
|
||||
gnc_pricedb_convert_balance_nearest_price (pricedb,
|
||||
start_amount,
|
||||
account_currency,
|
||||
to_curr,
|
||||
start_timespec);
|
||||
end_amount = xaccAccountGetBalanceAsOfDate(account, options.end_date);
|
||||
timespecFromTime64(&end_timespec, options.end_date);
|
||||
end_amount_default_currency =
|
||||
xaccAccountConvertBalanceToCurrencyAsOfDate
|
||||
(account, end_amount, account_currency, options.default_currency,
|
||||
timespecToTime64(timespecCanonicalDayTime(end_timespec)));
|
||||
gnc_pricedb_convert_balance_nearest_price (pricedb, end_amount,
|
||||
account_currency,
|
||||
to_curr,
|
||||
end_timespec);
|
||||
|
||||
if (!non_currency || options.non_currency)
|
||||
{
|
||||
@ -247,11 +254,11 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
|
||||
{
|
||||
non_curr_accum->profits =
|
||||
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);
|
||||
non_curr_accum->profits =
|
||||
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);
|
||||
}
|
||||
|
||||
@ -260,12 +267,12 @@ gnc_ui_accounts_recurse (Account *parent, GList **currency_list,
|
||||
grand_total_accum->profits =
|
||||
gnc_numeric_add (grand_total_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);
|
||||
grand_total_accum->profits =
|
||||
gnc_numeric_sub (grand_total_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);
|
||||
}
|
||||
|
||||
@ -568,4 +575,3 @@ gnc_main_window_summary_new (void)
|
||||
|
||||
return retval->hbox;
|
||||
}
|
||||
|
||||
|
@ -231,7 +231,10 @@ refresh_details_page (StockSplitInfo *info)
|
||||
if (prices)
|
||||
{
|
||||
/* 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
|
||||
{
|
||||
|
@ -347,7 +347,11 @@ pedit_commodity_changed_cb (GtkComboBox *cbwe, gpointer data)
|
||||
(pedit_dialog->price_db, commodity);
|
||||
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)
|
||||
gnc_currency_edit_set_currency
|
||||
|
@ -495,49 +495,6 @@ gsr_update_summary_label( GtkWidget *label,
|
||||
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
|
||||
void
|
||||
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;
|
||||
GNCPrintAmountInfo print_info;
|
||||
gnc_numeric amount;
|
||||
char string[256];
|
||||
Account *leader;
|
||||
gboolean reverse;
|
||||
gboolean euro;
|
||||
@ -583,18 +539,18 @@ gsr_redraw_all_cb (GnucashRegister *g_reg, gpointer data)
|
||||
gsr_update_summary_label( gsr->projectedminimum_label,
|
||||
xaccAccountGetProjectedMinimumBalance,
|
||||
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)
|
||||
{
|
||||
char string[256];
|
||||
print_info = gnc_account_print_info( leader, TRUE );
|
||||
|
||||
amount = xaccAccountGetBalance( leader );
|
||||
if (reverse)
|
||||
amount = gnc_numeric_neg( amount );
|
||||
|
||||
xaccSPrintAmount( string, amount, print_info );
|
||||
|
||||
gnc_set_label_color( gsr->shares_label, amount );
|
||||
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 */
|
||||
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)
|
||||
{
|
||||
Query *query = gnc_ledger_display_get_query( gsr->ledger );
|
||||
|
@ -242,7 +242,7 @@ gsr2_create_table (GNCSplitReg2 *gsr)
|
||||
const GncGUID * guid;
|
||||
Account * account;
|
||||
const gchar *sort_string;
|
||||
|
||||
|
||||
account = gnc_ledger_display2_leader (gsr->ledger);
|
||||
guid = xaccAccountGetGUID (account);
|
||||
|
||||
@ -495,49 +495,6 @@ gsr2_update_summary_label (GtkWidget *label,
|
||||
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
|
||||
void
|
||||
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;
|
||||
GNCPrintAmountInfo print_info;
|
||||
gnc_numeric amount;
|
||||
char string[256];
|
||||
Account *leader;
|
||||
gboolean reverse;
|
||||
gboolean euro;
|
||||
@ -584,17 +540,12 @@ gsr2_redraw_all_cb (GncTreeViewSplitReg *view, gpointer user_data)
|
||||
xaccAccountGetProjectedMinimumBalance,
|
||||
leader, print_info, commodity, reverse, euro );
|
||||
|
||||
/* Print the summary share amount */
|
||||
/* Print the summary share amount */
|
||||
if (gsr->shares_label != NULL)
|
||||
{
|
||||
char string[256];
|
||||
print_info = gnc_account_print_info( leader, TRUE );
|
||||
|
||||
amount = xaccAccountGetBalance( leader );
|
||||
if (reverse)
|
||||
amount = gnc_numeric_neg( amount );
|
||||
|
||||
xaccSPrintAmount( string, amount, print_info );
|
||||
|
||||
gnc_set_label_color( gsr->shares_label, amount );
|
||||
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 */
|
||||
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
|
||||
gnc_split_reg2_ld_destroy (GNCLedgerDisplay2 *ledger)
|
||||
{
|
||||
@ -774,7 +659,7 @@ gnc_split_reg2_sort_changed_cb (GtkTreeSortable *sortable, gpointer user_data)
|
||||
Query *query;
|
||||
GNCSplitReg2 *gsr = user_data;
|
||||
GncTreeViewSplitReg *view;
|
||||
GncTreeModelSplitReg *model;
|
||||
GncTreeModelSplitReg *model;
|
||||
GtkSortType type;
|
||||
gint sortcol;
|
||||
gint sort_depth;
|
||||
|
@ -166,6 +166,15 @@ if ($exchange eq "currency") {
|
||||
while ($#ARGV >= 0) {
|
||||
my $to = shift;
|
||||
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)) {
|
||||
printf "1 $from = $result $to\n";
|
||||
} else {
|
||||
|
@ -350,6 +350,19 @@ while(<>) {
|
||||
last unless $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, "symbol"} = $from_currency;
|
||||
|
@ -2067,15 +2067,9 @@ record_price (SplitRegister *reg, Account *account, gnc_numeric value,
|
||||
return;
|
||||
gnc_date_cell_get_date ((DateCell*)cell, &ts);
|
||||
price = gnc_pricedb_lookup_day (pricedb, comm, curr, ts);
|
||||
if (!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.
|
||||
*/
|
||||
if (gnc_commodity_equiv (comm, gnc_price_get_currency (price)))
|
||||
swap = TRUE;
|
||||
}
|
||||
|
||||
if (price)
|
||||
{
|
||||
price_value = gnc_price_get_value(price);
|
||||
|
@ -1,5 +1,5 @@
|
||||
;; -*-scheme-*-
|
||||
;; by Richard -Gilligan- Uschold
|
||||
;; by Richard -Gilligan- Uschold
|
||||
;;
|
||||
;; updated by J. Alex Aycinena, July 2008, October 2009
|
||||
;;
|
||||
@ -46,7 +46,7 @@
|
||||
;; Add support for Format 6
|
||||
;; Use Form/Schedule line #'s to sort report.
|
||||
;; Update from "V037" to "V041"
|
||||
;; Add support for taxpayer types other than F1040
|
||||
;; Add support for taxpayer types other than F1040
|
||||
;;
|
||||
;; September, 2010 Update:
|
||||
;;
|
||||
@ -60,7 +60,7 @@
|
||||
;;
|
||||
;; 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
|
||||
;;
|
||||
;; From prior version:
|
||||
@ -142,7 +142,7 @@
|
||||
;; returns a predicate that returns true only if a split is
|
||||
;; between early-date and late-date
|
||||
(define (split-report-make-date-filter-predicate begin-date-tp end-date-tp)
|
||||
(lambda (split)
|
||||
(lambda (split)
|
||||
(let ((tp
|
||||
(gnc-transaction-get-date-posted
|
||||
(xaccSplitGetParent split))))
|
||||
@ -169,9 +169,9 @@
|
||||
(define (gnc:register-tax-option new-option)
|
||||
(gnc:register-option options new-option))
|
||||
|
||||
;; date at which to report
|
||||
;; date at which to report
|
||||
(gnc:options-add-date-interval!
|
||||
options gnc:pagename-general
|
||||
options gnc:pagename-general
|
||||
(N_ "From") (N_ "To") "a")
|
||||
|
||||
(gnc:register-tax-option
|
||||
@ -216,7 +216,7 @@
|
||||
"d" (N_ "Select accounts.")
|
||||
(lambda () '())
|
||||
#f #t))
|
||||
|
||||
|
||||
(gnc:register-tax-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display (N_ "Suppress $0.00 values")
|
||||
@ -419,7 +419,7 @@
|
||||
|
||||
(define (render-header-row table heading-line-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
|
||||
"header-just-top" heading)))
|
||||
(gnc:html-table-cell-set-colspan! heading-cell 6)
|
||||
@ -469,17 +469,17 @@
|
||||
(let ((description (gnc:make-html-text))
|
||||
(total (gnc:make-html-text)))
|
||||
(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 " "
|
||||
(if end-bal-text end-bal-text "Total For "))))
|
||||
(if (not tax_code?)
|
||||
(gnc:html-text-append! description (gnc:html-markup-b
|
||||
(gnc:html-text-append! description (gnc:html-markup-b
|
||||
" "))
|
||||
)
|
||||
)
|
||||
(gnc:html-text-append! description (gnc:html-markup-b
|
||||
(gnc:html-text-append! description (gnc:html-markup-b
|
||||
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
|
||||
total-amount))
|
||||
@ -490,12 +490,12 @@
|
||||
(amount-table (gnc:make-html-table)) ;; to line up totals to details
|
||||
(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 "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0")
|
||||
'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 "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0")
|
||||
@ -580,10 +580,10 @@
|
||||
"Equity"
|
||||
""))))))
|
||||
(category-key (get-acct-txf-info 'cat-key type code))
|
||||
(value-name (cond
|
||||
(value-name (cond
|
||||
((string=? tax-entity-type "F1040")
|
||||
(if (equal? "ReinvD" action)
|
||||
(string-append
|
||||
(string-append
|
||||
(xaccPrintAmount
|
||||
(gnc-numeric-neg account-value) print-info)
|
||||
" " txf-account-name)
|
||||
@ -634,7 +634,7 @@
|
||||
;; sub-lines of line 5 starting with 1 for first reported payer
|
||||
;; these apply if pns is either 'current or 'parent', but not
|
||||
;; otherwise
|
||||
"L" (number->string txf-l-count) crlf
|
||||
"L" (number->string txf-l-count) crlf
|
||||
(if (= format 4)
|
||||
(if x?
|
||||
(list "P" sold-desc crlf "D" crlf "D" date-str crlf
|
||||
@ -656,11 +656,11 @@
|
||||
'())) ;; not detail
|
||||
(else '()))
|
||||
(if x?
|
||||
(cond
|
||||
(cond
|
||||
((string=? tax-entity-type "F1040")
|
||||
(list "X" x-date-str " "
|
||||
(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 category-key 15) crlf))
|
||||
((or (string=? tax-entity-type "F1065")
|
||||
@ -724,12 +724,15 @@
|
||||
(begin ;; do so
|
||||
(set! missing-pricedb-entry? #f)
|
||||
(set! pricedb-lookup-price
|
||||
(gnc-pricedb-lookup-nearest-in-time
|
||||
(let ((price (gnc-pricedb-lookup-nearest-in-time
|
||||
pricedb
|
||||
account-commodity
|
||||
USD-currency
|
||||
(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
|
||||
(gnc-price-get-value
|
||||
pricedb-lookup-price))
|
||||
@ -784,7 +787,7 @@
|
||||
)
|
||||
" "
|
||||
converted-qty
|
||||
(if
|
||||
(if
|
||||
(and (not (gnc-commodity-equiv account-commodity
|
||||
USD-currency))
|
||||
(not (gnc-commodity-equiv trans-currency
|
||||
@ -827,7 +830,7 @@
|
||||
)
|
||||
""))
|
||||
)
|
||||
)
|
||||
)
|
||||
(list amount conversion-text pricedb-lookup-price conversion-text2)
|
||||
)
|
||||
)
|
||||
@ -850,16 +853,16 @@
|
||||
)
|
||||
(if (= 4 format)
|
||||
(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 "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "3")
|
||||
'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 "cellpadding" "0")
|
||||
'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 "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0")
|
||||
@ -957,18 +960,18 @@
|
||||
(if (and (= 4 format) (gnc-numeric-negative-p
|
||||
(xaccSplitGetAmount tran-split)))
|
||||
(begin
|
||||
(if tax-mode?
|
||||
(if tax-mode?
|
||||
(gnc:html-table-append-row!
|
||||
cap-gains-detail-table
|
||||
(append (list (gnc:make-html-table-cell
|
||||
(string-append
|
||||
(string-append
|
||||
(xaccPrintAmount
|
||||
(gnc-numeric-neg
|
||||
(gnc-numeric-neg
|
||||
(xaccSplitGetAmount
|
||||
tran-split))
|
||||
print-info)
|
||||
" "
|
||||
(gnc-commodity-get-mnemonic
|
||||
(gnc-commodity-get-mnemonic
|
||||
split-acct-commodity))))
|
||||
(list (gnc:make-html-table-cell/markup
|
||||
"text-cell-center"
|
||||
@ -1000,13 +1003,13 @@
|
||||
tax-code
|
||||
copy
|
||||
tax-entity-type
|
||||
(string-append
|
||||
(string-append
|
||||
(xaccPrintAmount
|
||||
(gnc-numeric-neg
|
||||
(gnc-numeric-neg
|
||||
(xaccSplitGetAmount
|
||||
tran-split)) print-info)
|
||||
" "
|
||||
(gnc-commodity-get-mnemonic
|
||||
(gnc-commodity-get-mnemonic
|
||||
split-acct-commodity))
|
||||
)))
|
||||
)
|
||||
@ -1135,7 +1138,7 @@
|
||||
tax-mode? show-TXF-data? USD-currency account-type
|
||||
tax-code acct-full-name acct-beg-bal-collector
|
||||
acct-end-bal-collector copy tax-entity-type)
|
||||
|
||||
|
||||
(let*
|
||||
((account-commodity (xaccAccountGetCommodity account))
|
||||
(format (get-acct-txf-info 'format account-type tax-code))
|
||||
@ -1296,7 +1299,7 @@
|
||||
)
|
||||
#f)
|
||||
(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 "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0")
|
||||
@ -1343,12 +1346,12 @@
|
||||
(if (and (> (length split-list) 0)
|
||||
(not (txf-beg-bal-only? tax-code)))
|
||||
(set! output
|
||||
(map (lambda (split)
|
||||
(map (lambda (split)
|
||||
(let* ((parent (xaccSplitGetParent split))
|
||||
(trans-date (gnc-transaction-get-date-posted parent))
|
||||
;; TurboTax 1999 and 2000 ignore dates after Dec 31
|
||||
(fudge-date (if splits-period
|
||||
(if (and full-year?
|
||||
(if (and full-year?
|
||||
(gnc:timepair-lt to-value trans-date))
|
||||
to-value
|
||||
trans-date)
|
||||
@ -1379,7 +1382,7 @@
|
||||
(eq? account-type ACCT-TYPE-LIABILITY)
|
||||
(eq? account-type ACCT-TYPE-EQUITY))
|
||||
(gnc-numeric-neg splt-amount)
|
||||
splt-amount))
|
||||
splt-amount))
|
||||
(curr-conv-note "")
|
||||
(curr-conv-data (list splt-rpt-amount curr-conv-note #f ""))
|
||||
(curr-conv-data (if (and (gnc-commodity-equiv
|
||||
@ -1437,7 +1440,7 @@
|
||||
(eq? account-type ACCT-TYPE-LIABILITY)
|
||||
(eq? account-type ACCT-TYPE-EQUITY))
|
||||
(gnc-numeric-neg splt-amount)
|
||||
splt-amount))
|
||||
splt-amount))
|
||||
(acct-collector-as-dr 'add account-commodity splt-amount)
|
||||
(set! account-USD-total (gnc-numeric-add-fixed
|
||||
account-USD-total print-amnt))
|
||||
@ -1445,19 +1448,19 @@
|
||||
;; transaction-multi-transfer-detail routine for TXF output and
|
||||
;; to accumulate capital gains totals for account-, tax-code-,
|
||||
;; 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?
|
||||
(null? other-account) split-details?)
|
||||
(= 4 format)
|
||||
)
|
||||
(let ((cap-gain-data
|
||||
(let ((cap-gain-data
|
||||
(process-transaction-multi-transfer-detail
|
||||
split
|
||||
parent
|
||||
USD-currency
|
||||
full-names?
|
||||
trans-date
|
||||
trans-currency
|
||||
trans-currency
|
||||
account-type
|
||||
currency-conversion-date
|
||||
to-value
|
||||
@ -1486,17 +1489,17 @@
|
||||
))
|
||||
(if (and transaction-details? tax-mode?)
|
||||
(begin
|
||||
(gnc:html-table-set-style! date-table "table"
|
||||
(gnc:html-table-set-style! date-table "table"
|
||||
'attribute (list "border" "0")
|
||||
'attribute (list "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0"))
|
||||
(gnc:html-table-append-row!
|
||||
date-table
|
||||
(gnc:make-html-table-cell/markup
|
||||
"date-cell"
|
||||
"date-cell"
|
||||
(strftime "%Y-%b-%d"
|
||||
(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 "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0"))
|
||||
@ -1504,7 +1507,7 @@
|
||||
num-table
|
||||
(gnc:make-html-table-cell (gnc-get-num-action
|
||||
parent split)))
|
||||
(gnc:html-table-set-style! desc-table "table"
|
||||
(gnc:html-table-set-style! desc-table "table"
|
||||
'attribute (list "border" "0")
|
||||
'attribute (list "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0"))
|
||||
@ -1512,14 +1515,14 @@
|
||||
desc-table
|
||||
(gnc:make-html-table-cell
|
||||
(xaccTransGetDescription parent)))
|
||||
(gnc:html-table-set-style! notes-table "table"
|
||||
(gnc:html-table-set-style! notes-table "table"
|
||||
'attribute (list "border" "0")
|
||||
'attribute (list "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0"))
|
||||
(gnc:html-table-append-row!
|
||||
notes-table
|
||||
(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 "cellspacing" "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 "cellspacing" "0")
|
||||
'attribute (list "cellpadding" "0")
|
||||
@ -1744,7 +1747,7 @@
|
||||
|
||||
(define (get-option pagename optname)
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report-obj) pagename optname)))
|
||||
|
||||
(define tax-entity-type (gnc-get-current-book-tax-type))
|
||||
@ -1795,7 +1798,7 @@
|
||||
#f
|
||||
#t))
|
||||
(let* ((form (if form form "")) ;; needed for "N000'
|
||||
(copy (number->string
|
||||
(copy (number->string
|
||||
(xaccAccountGetTaxUSCopyNumber account)))
|
||||
(line (get-acct-txf-info 'line type tax-code-sym))
|
||||
(line (if line
|
||||
@ -1892,7 +1895,7 @@
|
||||
"None"
|
||||
(list "Set as tax-related, no tax code assigned"
|
||||
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
|
||||
selected-accounts-sorted-by-form-line-acct)
|
||||
)
|
||||
@ -1948,7 +1951,7 @@
|
||||
(if prior-char-num?
|
||||
(begin
|
||||
(if (string=? string-part "")
|
||||
#f
|
||||
#f
|
||||
(set! lst (append lst (list
|
||||
(string->number string-part)))))
|
||||
(set! string-part (string char))
|
||||
@ -2040,14 +2043,14 @@
|
||||
"USD"))
|
||||
|
||||
(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")))
|
||||
(to-value (gnc:timepair-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general "To"))))
|
||||
(alt-period (get-option gnc:pagename-general "Alternate Period"))
|
||||
(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"))
|
||||
(full-names? (not (get-option gnc:pagename-display
|
||||
"Do not print full account names")))
|
||||
@ -2063,13 +2066,13 @@
|
||||
(gnc:report-options report-obj)
|
||||
gnc:pagename-display
|
||||
"Do not print Action:Memo data")
|
||||
(get-option gnc:pagename-display
|
||||
(get-option gnc:pagename-display
|
||||
"Do not print Action:Memo data")
|
||||
(get-option gnc:pagename-display
|
||||
(get-option gnc:pagename-display
|
||||
"Do not print T-Num:Memo data")))
|
||||
(shade-alternate-transactions? (if (gnc-html-engine-supports-css)
|
||||
#t
|
||||
(get-option gnc:pagename-display
|
||||
#t
|
||||
(get-option gnc:pagename-display
|
||||
"Shade alternate transactions")))
|
||||
(currency-conversion-date (get-option gnc:pagename-display
|
||||
"Currency conversion date"))
|
||||
@ -2079,7 +2082,7 @@
|
||||
;; If no selected accounts, check all.
|
||||
(selected-accounts (if (not (null? user-sel-accnts))
|
||||
valid-user-sel-accnts
|
||||
(validate (reverse
|
||||
(validate (reverse
|
||||
(gnc-account-get-children-sorted
|
||||
(gnc-get-current-root-account))))))
|
||||
|
||||
@ -2090,13 +2093,13 @@
|
||||
(from-date (gnc:timepair->date from-value))
|
||||
(from-value (gnc:timepair-start-day-time
|
||||
(let ((bdtm from-date))
|
||||
(if (member alt-period
|
||||
(if (member alt-period
|
||||
'(last-year 1st-last 2nd-last
|
||||
3rd-last 4th-last))
|
||||
(set-tm:year bdtm (- (tm:year bdtm) 1)))
|
||||
(or (eq? alt-period 'from-to)
|
||||
(set-tm:mday bdtm 1))
|
||||
(if (< (gnc:date-get-year bdtm)
|
||||
(if (< (gnc:date-get-year bdtm)
|
||||
tax-qtr-real-qtr-year)
|
||||
(case alt-period
|
||||
((1st-est 1st-last last-year) ; Jan 1
|
||||
@ -2122,7 +2125,7 @@
|
||||
|
||||
(to-value (gnc:timepair-end-day-time
|
||||
(let ((bdtm from-date))
|
||||
(if (member alt-period
|
||||
(if (member alt-period
|
||||
'(last-year 1st-last 2nd-last
|
||||
3rd-last 4th-last))
|
||||
(set-tm:year bdtm (- (tm:year bdtm) 1)))
|
||||
@ -2130,7 +2133,7 @@
|
||||
;; The exact same code, in from-value, further above,
|
||||
;; only subtraces one! Go figure!
|
||||
;; So, we add one back below!
|
||||
(if (member alt-period
|
||||
(if (member alt-period
|
||||
'(last-year 1st-last 2nd-last
|
||||
3rd-last 4th-last))
|
||||
(set-tm:year bdtm (+ (tm:year bdtm) 1)))
|
||||
@ -2159,7 +2162,7 @@
|
||||
(set-tm:mon bdtm 8))
|
||||
((4th-est 4th-last last-year) ; Dec 31
|
||||
(set-tm:mon bdtm 11))
|
||||
(else
|
||||
(else
|
||||
(set! bdtm (gnc:timepair->date to-value)))))
|
||||
(set-tm:isdst bdtm -1)
|
||||
(cons (car (mktime bdtm)) 0))))
|
||||
@ -2177,7 +2180,7 @@
|
||||
(define (txf-special-splits-period account from-value to-value)
|
||||
(if (and (xaccAccountGetTaxRelated account)
|
||||
(txf-special-date? (gnc:account-get-txf-code account)))
|
||||
(let*
|
||||
(let*
|
||||
((full-year?
|
||||
(let ((bdto (localtime (car to-value)))
|
||||
(bdfrom (localtime (car from-value))))
|
||||
@ -2252,13 +2255,13 @@
|
||||
(acct-beg-bal-collector (if (not
|
||||
(or (eq? account-type ACCT-TYPE-INCOME)
|
||||
(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)
|
||||
#f))
|
||||
(acct-end-bal-collector (if (not
|
||||
(or (eq? account-type ACCT-TYPE-INCOME)
|
||||
(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)
|
||||
#f))
|
||||
(account-commodity (xaccAccountGetCommodity account))
|
||||
@ -2395,8 +2398,8 @@
|
||||
|
||||
(let ((from-date (strftime "%Y-%b-%d" (localtime (car from-value))))
|
||||
(to-date (strftime "%Y-%b-%d" (localtime (car to-value))))
|
||||
(today-date (strftime "D%m/%d/%Y"
|
||||
(localtime
|
||||
(today-date (strftime "D%m/%d/%Y"
|
||||
(localtime
|
||||
(car (timespecCanonicalDayTime
|
||||
(cons (current-time) 0))))))
|
||||
(tax-year (strftime "%Y" (localtime (car from-value))))
|
||||
@ -2496,7 +2499,7 @@
|
||||
(xaccPrintAmount
|
||||
tax-code-sub-item-USD-total
|
||||
print-info))
|
||||
)
|
||||
)
|
||||
;; print prior tax-code-sub-item
|
||||
;; total and reset accum
|
||||
(render-total-row
|
||||
@ -2562,7 +2565,7 @@
|
||||
)
|
||||
)
|
||||
;; process prior tax code break, if appropriate, before
|
||||
;; processing current account
|
||||
;; processing current account
|
||||
(if (string=? prior-tax-code "")
|
||||
#t ;; do nothing
|
||||
(if tax-mode?
|
||||
@ -2590,7 +2593,7 @@
|
||||
(xaccPrintAmount
|
||||
tax-code-cap-gain-basis-USD-total
|
||||
print-info))
|
||||
)
|
||||
)
|
||||
;; print prior tax-code total and
|
||||
;; reset accum
|
||||
(render-total-row
|
||||
@ -2711,7 +2714,7 @@
|
||||
)
|
||||
)
|
||||
;; process prior form-schedule-line break, if appropriate,
|
||||
;; before processing current account
|
||||
;; before processing current account
|
||||
(if (string=? prior-form-sched-line "")
|
||||
(set! form-sched-line-USD-total (gnc-numeric-zero))
|
||||
(if tax-mode?
|
||||
@ -2738,7 +2741,7 @@
|
||||
(xaccPrintAmount
|
||||
form-sched-line-cap-gain-sales-USD-total
|
||||
print-info))
|
||||
)
|
||||
)
|
||||
;; print prior form-schedule-line total
|
||||
;; and reset accum
|
||||
(render-total-row
|
||||
@ -2835,7 +2838,7 @@
|
||||
""
|
||||
(string-append "Line "
|
||||
current-form-sched-line ": "))
|
||||
description " ("
|
||||
description " ("
|
||||
(substring current-tax-code 1
|
||||
(string-length current-tax-code))
|
||||
(if show-TXF-data?
|
||||
@ -2854,7 +2857,7 @@
|
||||
"Y"
|
||||
"N")
|
||||
", TXF Format "
|
||||
(number->string
|
||||
(number->string
|
||||
(get-acct-txf-info
|
||||
'format
|
||||
type
|
||||
@ -2989,7 +2992,7 @@
|
||||
))
|
||||
|
||||
(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
|
||||
(let ((port (catch #t ;;e.g., system-error
|
||||
(lambda () (open-output-file file-name))
|
||||
@ -3018,7 +3021,7 @@
|
||||
today-date crlf
|
||||
"^" crlf
|
||||
output
|
||||
(if (or
|
||||
(if (or
|
||||
(gnc-numeric-zero-p tax-code-USD-total)
|
||||
(not prior-account))
|
||||
'()
|
||||
@ -3050,7 +3053,7 @@
|
||||
(if prior-account
|
||||
(gnc:display-report-list-item output-txf port
|
||||
"taxtxf.scm - ")
|
||||
#f)
|
||||
#f)
|
||||
(close-output-port port)
|
||||
#t
|
||||
) ; end of let
|
||||
@ -3173,8 +3176,8 @@
|
||||
|
||||
(gnc:html-document-set-title! doc report-name)
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:make-html-text
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:make-html-text
|
||||
(gnc:html-markup-p
|
||||
(gnc:html-markup
|
||||
"center"
|
||||
@ -3199,8 +3202,8 @@
|
||||
|
||||
(if (not (null? txf-invalid-alist))
|
||||
(begin
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:make-html-text
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:make-html-text
|
||||
(gnc:html-markup-p
|
||||
(gnc:html-markup/format
|
||||
"<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)
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:make-html-text
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:make-html-text
|
||||
(gnc:html-markup-p
|
||||
(gnc:html-markup/format
|
||||
" <BR> "))))
|
||||
@ -3272,7 +3275,7 @@
|
||||
|
||||
(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))
|
||||
selected-accounts-sorted-by-form-line-acct))
|
||||
|
||||
@ -3307,7 +3310,7 @@
|
||||
(tax-code-sub-item-total-amount
|
||||
(xaccPrintAmount tax-code-sub-item-USD-total
|
||||
print-info))
|
||||
)
|
||||
)
|
||||
(render-total-row
|
||||
table
|
||||
tax-code-sub-item-total-amount
|
||||
@ -3360,7 +3363,7 @@
|
||||
(xaccPrintAmount
|
||||
tax-code-cap-gain-basis-USD-total
|
||||
print-info))
|
||||
)
|
||||
)
|
||||
(render-total-row table tax-code-total-amount
|
||||
(string-append "Line (Code): "
|
||||
saved-tax-code-text)
|
||||
@ -3405,7 +3408,7 @@
|
||||
(xaccPrintAmount
|
||||
form-sched-line-cap-gain-basis-USD-total
|
||||
print-info))
|
||||
)
|
||||
)
|
||||
;; print prior form-schedule-line total; reset accum
|
||||
(render-total-row
|
||||
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."
|
||||
"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
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:make-html-text
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:make-html-text
|
||||
(gnc:html-markup-p
|
||||
(gnc:html-markup/format
|
||||
(string-append
|
||||
|
@ -6,16 +6,16 @@
|
||||
;; Heavily based on portfolio.scm
|
||||
;; by Robert Merkel (rgmerk@mira.net)
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2 of
|
||||
;; the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2 of
|
||||
;; the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; if not, contact:
|
||||
;;
|
||||
@ -54,34 +54,34 @@
|
||||
(define units-denom 100000000)
|
||||
|
||||
(define (options-generator)
|
||||
(let* ((options (gnc:new-options))
|
||||
(let* ((options (gnc:new-options))
|
||||
;; This is just a helper function for making options.
|
||||
;; See gnucash/src/scm/options.scm for details.
|
||||
(add-option
|
||||
(add-option
|
||||
(lambda (new-option)
|
||||
(gnc:register-option options new-option))))
|
||||
|
||||
;; General Tab
|
||||
;; date at which to report balance
|
||||
(gnc:options-add-report-date!
|
||||
options gnc:pagename-general
|
||||
options gnc:pagename-general
|
||||
(N_ "Date") "a")
|
||||
|
||||
(gnc:options-add-currency!
|
||||
(gnc:options-add-currency!
|
||||
options gnc:pagename-general (N_ "Report's currency") "c")
|
||||
|
||||
(add-option
|
||||
(gnc:make-multichoice-option
|
||||
gnc:pagename-general optname-price-source
|
||||
"d" (N_ "The source of price information.") 'pricedb-nearest
|
||||
(list (vector 'pricedb-latest
|
||||
(list (vector 'pricedb-latest
|
||||
(N_ "Most recent")
|
||||
(N_ "The most recent recorded price."))
|
||||
(vector 'pricedb-nearest
|
||||
(N_ "Nearest in time")
|
||||
(N_ "The price recorded nearest in time to the report date."))
|
||||
)))
|
||||
|
||||
|
||||
(add-option
|
||||
(gnc:make-multichoice-option
|
||||
gnc:pagename-general optname-basis-method
|
||||
@ -99,7 +99,7 @@
|
||||
|
||||
(add-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.")
|
||||
#t))
|
||||
|
||||
@ -117,7 +117,7 @@
|
||||
(N_ "Ignore")
|
||||
(N_ "Ignore brokerage fees entirely."))
|
||||
)))
|
||||
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
@ -161,18 +161,18 @@
|
||||
(lambda () (filter gnc:account-is-stock?
|
||||
(gnc-account-get-descendants-sorted
|
||||
(gnc-get-current-root-account))))
|
||||
(lambda (accounts) (list #t
|
||||
(lambda (accounts) (list #t
|
||||
(filter gnc:account-is-stock? accounts)))
|
||||
#t))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:register-option
|
||||
options
|
||||
(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.")
|
||||
#f))
|
||||
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
options))
|
||||
|
||||
;; This is the rendering function. It accepts a database of options
|
||||
@ -183,7 +183,7 @@
|
||||
;; defined above.
|
||||
|
||||
(define (advanced-portfolio-renderer report-obj)
|
||||
|
||||
|
||||
(let ((work-done 0)
|
||||
(work-to-do 0)
|
||||
(warn-no-price #f)
|
||||
@ -192,10 +192,10 @@
|
||||
;; These are some helper functions for looking up option values.
|
||||
(define (get-op section name)
|
||||
(gnc:lookup-option (gnc:report-options report-obj) section name))
|
||||
|
||||
|
||||
(define (get-option section name)
|
||||
(gnc:option-value (get-op section name)))
|
||||
|
||||
|
||||
(define (split-account-type? split type)
|
||||
(eq? type (xaccAccountGetType (xaccSplitGetAccount split))))
|
||||
|
||||
@ -213,11 +213,11 @@
|
||||
(gnc-numeric-zero)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
;; sum up the total number of units in the b-list built by basis-builder below
|
||||
(define (units-basis b-list)
|
||||
(if (not (eqv? b-list '()))
|
||||
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
|
||||
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
|
||||
units-denom GNC-RND-ROUND)
|
||||
(gnc-numeric-zero)
|
||||
)
|
||||
@ -231,42 +231,42 @@
|
||||
(gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))
|
||||
(apply-basis-ratio (cdr b-list) units-ratio value-ratio))
|
||||
'()
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
;; this builds a list for basis calculation and handles average, fifo and lifo methods
|
||||
;; 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
|
||||
;; 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)
|
||||
(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)
|
||||
|
||||
;; 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
|
||||
((and (not (gnc-numeric-zero-p b-value))
|
||||
(gnc-numeric-positive-p b-units))
|
||||
(case b-method
|
||||
((average-basis)
|
||||
((average-basis)
|
||||
(if (not (eqv? b-list '()))
|
||||
(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-add b-value
|
||||
(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-numeric-add b-units
|
||||
(caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)
|
||||
price-denom GNC-RND-ROUND)))
|
||||
(append b-list
|
||||
(append b-list
|
||||
(list (cons b-units (gnc-numeric-div
|
||||
b-value b-units price-denom GNC-RND-ROUND))))))
|
||||
(else (append b-list
|
||||
(else (append b-list
|
||||
(list (cons b-units (gnc-numeric-div
|
||||
b-value b-units price-denom GNC-RND-ROUND)))))))
|
||||
|
||||
@ -275,7 +275,7 @@
|
||||
(gnc-numeric-negative-p b-units))
|
||||
(if (not (eqv? b-list '()))
|
||||
(case b-method
|
||||
((fifo-basis)
|
||||
((fifo-basis)
|
||||
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
|
||||
((-1)
|
||||
;; Sold less than the first lot, create a new first lot from the remainder
|
||||
@ -284,12 +284,12 @@
|
||||
((0)
|
||||
;; Sold all of the first lot
|
||||
(cdr b-list))
|
||||
((1)
|
||||
((1)
|
||||
;; 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)
|
||||
b-value ;; Only the sign of b-value matters since the new b-units is negative
|
||||
b-method currency-frac))))
|
||||
((filo-basis)
|
||||
((filo-basis)
|
||||
(let ((rev-b-list (reverse b-list)))
|
||||
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))
|
||||
((-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)
|
||||
b-value b-method currency-frac)
|
||||
))))
|
||||
((average-basis)
|
||||
((average-basis)
|
||||
(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)))))
|
||||
'()
|
||||
))
|
||||
|
||||
|
||||
;; no value, just units, this is a split/merge...
|
||||
((and (gnc-numeric-zero-p b-value)
|
||||
(not (gnc-numeric-zero-p b-units)))
|
||||
(let* ((current-units (units-basis b-list))
|
||||
(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))
|
||||
;; 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)
|
||||
(gnc-numeric-zero)
|
||||
(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-numeric-to-string current-units)
|
||||
|
||||
(gnc:debug "blist is " b-list " current units is "
|
||||
(gnc-numeric-to-string current-units)
|
||||
" value ratio is " (gnc-numeric-to-string value-ratio)
|
||||
" units ratio is " (gnc-numeric-to-string units-ratio))
|
||||
(apply-basis-ratio b-list units-ratio value-ratio)
|
||||
(apply-basis-ratio b-list units-ratio value-ratio)
|
||||
))
|
||||
|
||||
;; If there are no units, just a value, then its a spin-off,
|
||||
@ -336,9 +336,9 @@
|
||||
((and (gnc-numeric-zero-p b-units)
|
||||
(not (gnc-numeric-zero-p b-value)))
|
||||
(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)))
|
||||
|
||||
|
||||
(gnc:debug "this is a spinoff")
|
||||
(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
|
||||
(apply-basis-ratio b-list (gnc:make-gnc-numeric 1 1) value-ratio))
|
||||
@ -359,20 +359,22 @@
|
||||
(for-each
|
||||
(lambda (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)
|
||||
(gnc-price-ref price)
|
||||
(gnc-price-list-destroy price-list)
|
||||
price)))
|
||||
|
||||
|
||||
;; Return true if either account is the parent of the other or they are siblings
|
||||
(define (parent-or-sibling? a1 a2)
|
||||
(let ((a2parent (gnc-account-get-parent a2))
|
||||
(a1parent (gnc-account-get-parent a1)))
|
||||
(or (same-account? a2parent a1)
|
||||
(same-account? a1parent a2)
|
||||
(same-account? a1parent a2)
|
||||
(same-account? a1parent a2parent))))
|
||||
|
||||
|
||||
;; 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.
|
||||
;; xaccSplitGetOtherSplit only returns on a two-split txn. It's not a spinoff
|
||||
@ -384,21 +386,21 @@
|
||||
(not (null? other-split))
|
||||
(not (split-account-type? other-split ACCT-TYPE-EXPENSE))
|
||||
(not (split-account-type? other-split ACCT-TYPE-INCOME)))))
|
||||
|
||||
|
||||
|
||||
|
||||
(define (table-add-stock-rows table accounts to-date
|
||||
currency price-fn exchange-fn price-source
|
||||
include-empty show-symbol show-listing show-shares show-price
|
||||
basis-method prefer-pricelist handle-brokerage-fees
|
||||
basis-method prefer-pricelist handle-brokerage-fees
|
||||
total-basis total-value
|
||||
total-moneyin total-moneyout total-income total-gain
|
||||
total-moneyin total-moneyout total-income total-gain
|
||||
total-ugain total-brokerage)
|
||||
|
||||
(let ((share-print-info
|
||||
(gnc-share-print-info-places
|
||||
(inexact->exact (get-option gnc:pagename-display
|
||||
optname-shares-digits)))))
|
||||
|
||||
|
||||
(define (table-add-stock-rows-internal accounts odd-row?)
|
||||
(if (null? accounts) total-value
|
||||
(let* ((row-style (if odd-row? "normal-row" "alternate-row"))
|
||||
@ -447,7 +449,7 @@
|
||||
(exchange-fn
|
||||
;; This currency will usually be the same as tocurrency so the
|
||||
;; call to exchange-fn below will do nothing
|
||||
(gnc:make-gnc-monetary
|
||||
(gnc:make-gnc-monetary
|
||||
(if use-txn
|
||||
(gnc:gnc-monetary-commodity price)
|
||||
(gnc-price-get-currency price))
|
||||
@ -458,30 +460,30 @@
|
||||
currency-frac GNC-RND-ROUND))
|
||||
tocurrency)
|
||||
(exchange-fn fromunits tocurrency)))
|
||||
|
||||
(gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
|
||||
|
||||
(gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
|
||||
(if price
|
||||
(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))
|
||||
|
||||
|
||||
;; If we have a price that can't be converted to the report currency
|
||||
;; don't use it
|
||||
(if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount
|
||||
(exchange-fn
|
||||
(gnc:make-gnc-monetary
|
||||
(if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount
|
||||
(exchange-fn
|
||||
(gnc:make-gnc-monetary
|
||||
(gnc-price-get-currency price)
|
||||
(gnc:make-gnc-numeric 100 1))
|
||||
currency))))
|
||||
(set! price #f))
|
||||
|
||||
|
||||
;; 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.
|
||||
(if (and (not use-txn)
|
||||
(or (not price) (not prefer-pricelist)))
|
||||
(let ((split-list (reverse (gnc:get-match-commodity-splits-sorted
|
||||
(list current)
|
||||
(case price-source
|
||||
(let ((split-list (reverse (gnc:get-match-commodity-splits-sorted
|
||||
(list current)
|
||||
(case price-source
|
||||
((pricedb-latest) (gnc:get-today))
|
||||
((pricedb-nearest) to-date)
|
||||
(else (gnc:get-today))) ;; error, but don't crash
|
||||
@ -494,7 +496,7 @@
|
||||
(let* ((trans (xaccSplitGetParent split))
|
||||
(trans-currency (xaccTransGetCurrency trans))
|
||||
(trans-price (exchange-fn (gnc:make-gnc-monetary
|
||||
trans-currency
|
||||
trans-currency
|
||||
(xaccSplitGetSharePrice split))
|
||||
currency)))
|
||||
(if (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount trans-price)))
|
||||
@ -517,13 +519,13 @@
|
||||
(set! use-txn #t)
|
||||
(set! pricing-txn #f)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; 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))
|
||||
(gnc:debug "Value " (gnc:monetary->string value)
|
||||
(gnc:debug "Value " (gnc:monetary->string value)
|
||||
" from " (gnc-commodity-numeric->string commodity units))
|
||||
|
||||
|
||||
(for-each
|
||||
;; we're looking at each split we find in the account. these splits
|
||||
;; could refer to the same transaction, so we have to examine each
|
||||
@ -531,12 +533,12 @@
|
||||
(lambda (split)
|
||||
(set! work-done (+ 1 work-done))
|
||||
(gnc:report-percent-done (* 100 (/ work-done work-to-do)))
|
||||
|
||||
|
||||
(let* ((parent (xaccSplitGetParent split))
|
||||
(txn-date (gnc-transaction-get-date-posted parent))
|
||||
(commod-currency (xaccTransGetCurrency parent))
|
||||
(commod-currency-frac (gnc-commodity-get-fraction commod-currency)))
|
||||
|
||||
|
||||
(if (and (gnc:timepair-le txn-date to-date)
|
||||
(not (assoc-ref seen_trans (gncTransGetGUID parent))))
|
||||
(let ((trans-income (gnc-numeric-zero))
|
||||
@ -553,30 +555,30 @@
|
||||
;; Add this transaction to the list of processed transactions so we don't
|
||||
;; do it again if there is another split in it for this account
|
||||
(set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans))
|
||||
|
||||
;; Go through all the splits in the transaction to get an overall idea of
|
||||
|
||||
;; Go through all the splits in the transaction to get an overall idea of
|
||||
;; what it does in terms of income, money in or out, shares bought or sold, etc.
|
||||
(for-each
|
||||
(lambda (s)
|
||||
(let ((split-units (xaccSplitGetAmount s))
|
||||
(split-value (xaccSplitGetValue s)))
|
||||
|
||||
(gnc:debug "Pass 1: split units " (gnc-numeric-to-string split-units) " split-value "
|
||||
(gnc-numeric-to-string split-value) " commod-currency "
|
||||
(gnc:debug "Pass 1: split units " (gnc-numeric-to-string split-units) " split-value "
|
||||
(gnc-numeric-to-string split-value) " commod-currency "
|
||||
(gnc-commodity-get-printname commod-currency))
|
||||
|
||||
(cond
|
||||
|
||||
(cond
|
||||
((split-account-type? s ACCT-TYPE-EXPENSE)
|
||||
;; Brokerage expense unless a two split transaction with other split
|
||||
;; in the stock account in which case it's a stock donation to charity.
|
||||
(if (not (same-account? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s))))
|
||||
(set! trans-brokerage
|
||||
(if (not (same-account? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s))))
|
||||
(set! trans-brokerage
|
||||
(gnc-numeric-add trans-brokerage split-value commod-currency-frac GNC-RND-ROUND))))
|
||||
|
||||
|
||||
((split-account-type? s ACCT-TYPE-INCOME)
|
||||
(set! trans-income (gnc-numeric-sub trans-income split-value
|
||||
commod-currency-frac GNC-RND-ROUND)))
|
||||
|
||||
|
||||
((same-account? current (xaccSplitGetAccount s))
|
||||
(set! trans-shares (gnc-numeric-add trans-shares (gnc-numeric-abs split-units)
|
||||
units-denom GNC-RND-ROUND))
|
||||
@ -590,7 +592,7 @@
|
||||
;; 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
|
||||
;; 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))))
|
||||
;; Non-zero amount, add the value to the sale or purchase total.
|
||||
(if (gnc-numeric-positive-p split-value)
|
||||
@ -601,9 +603,9 @@
|
||||
(gnc-numeric-add shares-bought split-units units-denom GNC-RND-ROUND)))
|
||||
(set! trans-sold
|
||||
(gnc-numeric-sub trans-sold split-value commod-currency-frac GNC-RND-ROUND)))))
|
||||
|
||||
|
||||
((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
|
||||
(if (not trans-drp-account)
|
||||
(begin
|
||||
@ -619,7 +621,7 @@
|
||||
))
|
||||
(xaccTransGetSplitList parent)
|
||||
)
|
||||
|
||||
|
||||
(gnc:debug "Income: " (gnc-numeric-to-string trans-income)
|
||||
" Brokerage: " (gnc-numeric-to-string trans-brokerage)
|
||||
" Shares traded: " (gnc-numeric-to-string trans-shares)
|
||||
@ -628,10 +630,10 @@
|
||||
" Value purchased: " (gnc-numeric-to-string trans-bought)
|
||||
" Spinoff value " (gnc-numeric-to-string trans-spinoff)
|
||||
" Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual))
|
||||
|
||||
|
||||
;; We need to calculate several things for this transaction:
|
||||
;; 1. Total income: this is already in trans-income
|
||||
;; 2. Change in basis: calculated by loop below that looks at every
|
||||
;; 2. Change in basis: calculated by loop below that looks at every
|
||||
;; that acquires or disposes of shares
|
||||
;; 3. Realized gain: also calculated below while calculating basis
|
||||
;; 4. Money in to the account: this is the value of shares bought
|
||||
@ -639,22 +641,22 @@
|
||||
;; 5. Money out: the money received by disposing of shares. This
|
||||
;; is in trans-sold plus trans-spinoff
|
||||
;; 6. Brokerage fees: this is in trans-brokerage
|
||||
|
||||
|
||||
;; Income
|
||||
(dividendcoll 'add commod-currency trans-income)
|
||||
|
||||
|
||||
;; Brokerage fees. May be either ignored or part of basis, but that
|
||||
;; will be dealt with elsewhere.
|
||||
(brokeragecoll 'add commod-currency trans-brokerage)
|
||||
|
||||
|
||||
;; Add brokerage fees to trans-bought if not ignoring them and there are any
|
||||
(if (and (not (eq? handle-brokerage-fees 'ignore-brokerage))
|
||||
(gnc-numeric-positive-p trans-brokerage)
|
||||
(gnc-numeric-positive-p trans-shares))
|
||||
(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)))
|
||||
(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
|
||||
;; if this is a reinvestment transaction (both income and purchase) and there seems to
|
||||
;; asset accounts used to hold excess income.
|
||||
@ -670,12 +672,12 @@
|
||||
(parent-or-sibling? trans-drp-account drp-holding-account))
|
||||
(set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-drp-residual
|
||||
commod-currency-frac GNC-RND-ROUND))
|
||||
(begin
|
||||
;; Wrong account (or no account), assume there isn't a DRP holding account
|
||||
(begin
|
||||
;; Wrong account (or no account), assume there isn't a DRP holding account
|
||||
(set! drp-holding-account 'none)
|
||||
(set trans-drp-residual (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
|
||||
;; purchase more shares. If this is not a DRP transaction then all money used to purchase
|
||||
;; shares is money in.
|
||||
@ -691,21 +693,21 @@
|
||||
;; If the DRP holding account balance is negative, adjust it by the amount
|
||||
;; used in this transaction
|
||||
(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
|
||||
commod-currency-frac GNC-RND-ROUND)))
|
||||
;; Money in is never more than amount spent to purchase shares
|
||||
(if (gnc-numeric-negative-p trans-bought)
|
||||
(set! trans-bought (gnc-numeric-zero)))))
|
||||
|
||||
|
||||
(gnc:debug "Adjusted trans-bought " (gnc-numeric-to-string trans-bought)
|
||||
" DRP holding account " (gnc-numeric-to-string drp-holding-amount))
|
||||
|
||||
(moneyincoll 'add commod-currency trans-bought)
|
||||
(moneyoutcoll 'add commod-currency trans-sold)
|
||||
(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
|
||||
(lambda (s)
|
||||
(let
|
||||
@ -713,30 +715,30 @@
|
||||
((split-units (xaccSplitGetAmount s))
|
||||
(split-value (xaccSplitGetValue s)))
|
||||
|
||||
(gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value "
|
||||
(gnc-numeric-to-string split-value) " commod-currency "
|
||||
(gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value "
|
||||
(gnc-numeric-to-string split-value) " commod-currency "
|
||||
(gnc-commodity-get-printname commod-currency))
|
||||
|
||||
(cond
|
||||
|
||||
(cond
|
||||
((and (not (gnc-numeric-zero-p split-units))
|
||||
(same-account? current (xaccSplitGetAccount s)))
|
||||
;; Split into subject account with non-zero amount. This is a purchase
|
||||
;; or a sale, adjust the basis
|
||||
(let* ((split-value-currency (gnc:gnc-monetary-amount
|
||||
(my-exchange-fn (gnc:make-gnc-monetary
|
||||
(let* ((split-value-currency (gnc:gnc-monetary-amount
|
||||
(my-exchange-fn (gnc:make-gnc-monetary
|
||||
commod-currency split-value) currency)))
|
||||
(orig-basis (sum-basis basis-list currency-frac))
|
||||
;; proportion of the fees attributable to this split
|
||||
(fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares
|
||||
GNC-DENOM-AUTO GNC-DENOM-REDUCE))
|
||||
;; Fees for this split in report currency
|
||||
(fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
|
||||
;; Fees for this split in report currency
|
||||
(fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
|
||||
(gnc:make-gnc-monetary commod-currency
|
||||
(gnc-numeric-mul fee-ratio trans-brokerage
|
||||
commod-currency-frac GNC-RND-ROUND))
|
||||
currency)))
|
||||
(split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
|
||||
;; Include brokerage fees in basis
|
||||
(split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
|
||||
;; Include brokerage fees in basis
|
||||
(gnc-numeric-add split-value-currency fees-currency
|
||||
currency-frac GNC-RND-ROUND)
|
||||
split-value-currency)))
|
||||
@ -744,10 +746,10 @@
|
||||
(gnc-numeric-to-string split-value-with-fees))
|
||||
|
||||
;; 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))
|
||||
(gnc:debug "coming out of basis list " basis-list)
|
||||
|
||||
|
||||
;; If it's a sale or the stock is worthless, calculate the gain
|
||||
(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
|
||||
@ -756,7 +758,7 @@
|
||||
(let ((new-basis (sum-basis basis-list currency-frac)))
|
||||
(if (or (gnc-numeric-zero-p new-basis)
|
||||
(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
|
||||
(let ((gain (gnc-numeric-sub (gnc-numeric-abs split-value-with-fees)
|
||||
(gnc-numeric-sub orig-basis new-basis
|
||||
@ -773,30 +775,30 @@
|
||||
;; in an income or expense account.
|
||||
((spin-off? s current)
|
||||
(gnc:debug "before spin-off basis list " basis-list)
|
||||
(set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
|
||||
(my-exchange-fn (gnc:make-gnc-monetary
|
||||
commod-currency split-value)
|
||||
currency))
|
||||
(set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
|
||||
(my-exchange-fn (gnc:make-gnc-monetary
|
||||
commod-currency split-value)
|
||||
currency))
|
||||
basis-method
|
||||
currency-frac))
|
||||
(gnc:debug "after spin-off basis list " basis-list))
|
||||
)
|
||||
))
|
||||
(xaccTransGetSplitList parent)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(xaccAccountGetSplitList current)
|
||||
)
|
||||
|
||||
|
||||
;; Look for income and expense transactions that don't have a split in the
|
||||
;; the account we're processing. We do this as follow
|
||||
;; 1. Make sure the parent account is a currency-valued asset or bank account
|
||||
;; 2. If so go through all the splits in that account
|
||||
;; 3. If a split is part of a two split transaction where the other split is
|
||||
;; to an income or expense account and the leaf name of that account is the
|
||||
;; to an income or expense account and the leaf name of that account is the
|
||||
;; same as the leaf name of the account we're processing, add it to the
|
||||
;; income or expense accumulator
|
||||
;;
|
||||
@ -809,20 +811,20 @@
|
||||
;; Dividends (type INCOME)
|
||||
;; Widget Stock (type INCOME)
|
||||
;;
|
||||
;; If you are producing a report on "Assets:Broker:Widget Stock" a
|
||||
;; transaction that debits the Assets:Broker account and credits the
|
||||
;; "Income:Dividends:Widget Stock" account will count as income in
|
||||
;; the report even though it doesn't have a split in the account
|
||||
;; If you are producing a report on "Assets:Broker:Widget Stock" a
|
||||
;; transaction that debits the Assets:Broker account and credits the
|
||||
;; "Income:Dividends:Widget Stock" account will count as income in
|
||||
;; the report even though it doesn't have a split in the account
|
||||
;; being reported on.
|
||||
|
||||
|
||||
(let ((parent-account (gnc-account-get-parent current))
|
||||
(account-name (xaccAccountGetName current)))
|
||||
(if (and (not (null? parent-account))
|
||||
(member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
|
||||
(member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
|
||||
(gnc-commodity-is-currency (xaccAccountGetCommodity parent-account)))
|
||||
(for-each
|
||||
(lambda (split)
|
||||
(let* ((other-split (xaccSplitGetOtherSplit split))
|
||||
(let* ((other-split (xaccSplitGetOtherSplit split))
|
||||
;; This is safe because xaccSplitGetAccount returns null for a null split
|
||||
(other-acct (xaccSplitGetAccount other-split))
|
||||
(parent (xaccSplitGetParent split))
|
||||
@ -831,7 +833,7 @@
|
||||
(gnc:timepair-le txn-date to-date)
|
||||
(string=? (xaccAccountGetName other-acct) account-name)
|
||||
(gnc-commodity-is-currency (xaccAccountGetCommodity other-acct)))
|
||||
;; This is a two split transaction where the other split is to an
|
||||
;; This is a two split transaction where the other split is to an
|
||||
;; account with the same name as the current account. If it's an
|
||||
;; income or expense account accumulate the value of the transaction
|
||||
(let ((val (xaccSplitGetValue split))
|
||||
@ -840,13 +842,13 @@
|
||||
(gnc:debug "More income " (gnc-numeric-to-string val))
|
||||
(dividendcoll 'add curr val))
|
||||
((split-account-type? other-split ACCT-TYPE-EXPENSE)
|
||||
(gnc:debug "More expense " (gnc-numeric-to-string
|
||||
(gnc:debug "More expense " (gnc-numeric-to-string
|
||||
(gnc-numeric-neg val)))
|
||||
(brokeragecoll 'add curr (gnc-numeric-neg val)))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(xaccAccountGetSplitList parent-account)
|
||||
)
|
||||
@ -858,7 +860,7 @@
|
||||
(gnc:debug "prefer-pricelist is " prefer-pricelist)
|
||||
(gnc:debug "price is " price)
|
||||
|
||||
(gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
|
||||
(gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
|
||||
currency-frac)))
|
||||
(gnc:debug "but the actual basis list is " basis-list)
|
||||
|
||||
@ -872,9 +874,9 @@
|
||||
(income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn))
|
||||
;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well..
|
||||
(gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn))
|
||||
(ugain (gnc:make-gnc-monetary currency
|
||||
(ugain (gnc:make-gnc-monetary currency
|
||||
(gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency))
|
||||
(sum-basis basis-list (gnc-commodity-get-fraction currency))
|
||||
(sum-basis basis-list (gnc-commodity-get-fraction currency))
|
||||
currency-frac GNC-RND-ROUND)))
|
||||
(bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount gain)
|
||||
(gnc:gnc-monetary-amount ugain)
|
||||
@ -916,7 +918,7 @@
|
||||
price
|
||||
)
|
||||
price
|
||||
)
|
||||
)
|
||||
(gnc:html-price-anchor
|
||||
price
|
||||
(gnc:make-gnc-monetary
|
||||
@ -924,7 +926,7 @@
|
||||
(gnc-price-get-value price)))
|
||||
)))))
|
||||
(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
|
||||
currency-frac)))
|
||||
(gnc:make-html-table-header-cell/markup "number-cell" value)
|
||||
@ -947,7 +949,7 @@
|
||||
(if (not (eq? handle-brokerage-fees 'ignore-brokerage))
|
||||
(append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage))))
|
||||
(append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn)
|
||||
(gnc:make-html-table-header-cell/markup "number-cell"
|
||||
(gnc:make-html-table-header-cell/markup "number-cell"
|
||||
(let* ((moneyinvalue (gnc-numeric-to-double
|
||||
(gnc:gnc-monetary-amount moneyin)))
|
||||
(totalreturnvalue (gnc-numeric-to-double
|
||||
@ -958,12 +960,12 @@
|
||||
(sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue moneyinvalue))))))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
row-style
|
||||
activecols)
|
||||
|
||||
|
||||
(if (and (not use-txn) price) (gnc-price-unref price))
|
||||
(table-add-stock-rows-internal rest (not odd-row?))
|
||||
)
|
||||
@ -976,7 +978,7 @@
|
||||
|
||||
(set! work-to-do (gnc:accounts-count-splits accounts))
|
||||
(table-add-stock-rows-internal accounts #t)))
|
||||
|
||||
|
||||
;; Tell the user that we're starting.
|
||||
(gnc:report-starting reportname)
|
||||
|
||||
@ -989,7 +991,7 @@
|
||||
(currency (get-option gnc:pagename-general "Report's currency"))
|
||||
(price-source (get-option gnc:pagename-general
|
||||
optname-price-source))
|
||||
(report-title (get-option gnc:pagename-general
|
||||
(report-title (get-option gnc:pagename-general
|
||||
gnc:optname-reportname))
|
||||
(include-empty (get-option gnc:pagename-accounts
|
||||
optname-zero-shares))
|
||||
@ -1021,7 +1023,7 @@
|
||||
(document (gnc:make-html-document)))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
document (string-append
|
||||
document (string-append
|
||||
report-title
|
||||
(sprintf #f " %s" (gnc-print-date to-date))))
|
||||
|
||||
@ -1031,12 +1033,12 @@
|
||||
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
|
||||
(price-fn
|
||||
(case price-source
|
||||
((pricedb-latest)
|
||||
(lambda (foreign domestic date)
|
||||
((pricedb-latest)
|
||||
(lambda (foreign domestic date)
|
||||
(find-price (gnc-pricedb-lookup-latest-any-currency pricedb foreign)
|
||||
domestic)))
|
||||
((pricedb-nearest)
|
||||
(lambda (foreign domestic date)
|
||||
((pricedb-nearest)
|
||||
(lambda (foreign domestic date)
|
||||
(find-price (gnc-pricedb-lookup-nearest-in-time-any-currency
|
||||
pricedb foreign (timespecCanonicalDayTime date)) domestic)))))
|
||||
(headercols (list (_ "Account")))
|
||||
@ -1047,22 +1049,22 @@
|
||||
(sum-total-gain (gnc-numeric-zero))
|
||||
(sum-total-ugain (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
|
||||
(if show-symbol
|
||||
(if show-symbol
|
||||
(begin (append! headercols (list (_ "Symbol")))
|
||||
(append! totalscols (list " "))))
|
||||
|
||||
(if show-listing
|
||||
(if show-listing
|
||||
(begin (append! headercols (list (_ "Listing")))
|
||||
(append! totalscols (list " "))))
|
||||
|
||||
(if show-shares
|
||||
(if show-shares
|
||||
(begin (append! headercols (list (_ "Shares")))
|
||||
(append! totalscols (list " "))))
|
||||
|
||||
(if show-price
|
||||
(if show-price
|
||||
(begin (append! headercols (list (_ "Price")))
|
||||
(append! totalscols (list " "))))
|
||||
|
||||
@ -1088,14 +1090,14 @@
|
||||
(gnc:html-table-set-col-headers!
|
||||
table
|
||||
headercols)
|
||||
|
||||
|
||||
(table-add-stock-rows
|
||||
table accounts to-date currency price-fn exchange-fn price-source
|
||||
include-empty show-symbol show-listing show-shares show-price basis-method
|
||||
prefer-pricelist handle-brokerage-fees
|
||||
total-basis total-value total-moneyin total-moneyout
|
||||
total-income total-gain total-ugain total-brokerage)
|
||||
|
||||
|
||||
|
||||
(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))
|
||||
@ -1152,17 +1154,17 @@
|
||||
(gnc:make-html-table-cell/markup
|
||||
"total-number-cell" sum-total-totalreturn)
|
||||
(gnc:make-html-table-cell/markup
|
||||
"total-number-cell"
|
||||
"total-number-cell"
|
||||
(let* ((totalinvalue (gnc-numeric-to-double
|
||||
(gnc:gnc-monetary-amount sum-total-moneyin)))
|
||||
(totalreturnvalue (gnc-numeric-to-double
|
||||
(gnc:gnc-monetary-amount sum-total-totalreturn)))
|
||||
)
|
||||
(if (= 0.0 totalinvalue)
|
||||
(if (= 0.0 totalinvalue)
|
||||
""
|
||||
(sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue totalinvalue))))))
|
||||
))
|
||||
|
||||
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
@ -1171,24 +1173,24 @@
|
||||
)
|
||||
|
||||
(gnc:html-document-add-object! document table)
|
||||
(if warn-price-dirty
|
||||
(gnc:html-document-append-objects! document
|
||||
(if warn-price-dirty
|
||||
(gnc:html-document-append-objects! document
|
||||
(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 (_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
|
||||
|
||||
(if warn-no-price
|
||||
(gnc:html-document-append-objects! document
|
||||
(list (gnc:make-html-text (if warn-price-dirty (gnc:html-markup-br) ""))
|
||||
(if warn-no-price
|
||||
(gnc:html-document-append-objects! document
|
||||
(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.")))))
|
||||
)
|
||||
|
||||
;if no accounts selected.
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(gnc:html-make-no-account-warning
|
||||
(gnc:html-make-no-account-warning
|
||||
report-title (gnc:report-id report-obj))))
|
||||
|
||||
|
||||
(gnc:report-finished)
|
||||
document)))
|
||||
|
||||
|
@ -2,16 +2,16 @@
|
||||
;; portfolio.scm
|
||||
;; by Robert Merkel (rgmerk@mira.net)
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2 of
|
||||
;; the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2 of
|
||||
;; the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; if not, contact:
|
||||
;;
|
||||
@ -39,23 +39,23 @@
|
||||
(define optname-zero-shares (N_ "Include accounts with no shares"))
|
||||
|
||||
(define (options-generator)
|
||||
(let* ((options (gnc:new-options))
|
||||
(let* ((options (gnc:new-options))
|
||||
;; This is just a helper function for making options.
|
||||
;; See gnucash/src/scm/options.scm for details.
|
||||
(add-option
|
||||
(add-option
|
||||
(lambda (new-option)
|
||||
(gnc:register-option options new-option))))
|
||||
|
||||
;; General Tab
|
||||
;; date at which to report balance
|
||||
(gnc:options-add-report-date!
|
||||
options gnc:pagename-general
|
||||
options gnc:pagename-general
|
||||
(N_ "Date") "a")
|
||||
|
||||
(gnc:options-add-currency!
|
||||
(gnc:options-add-currency!
|
||||
options gnc:pagename-general (N_ "Report's currency") "c")
|
||||
|
||||
(gnc:options-add-price-source!
|
||||
(gnc:options-add-price-source!
|
||||
options gnc:pagename-general
|
||||
optname-price-source "d" 'pricedb-latest)
|
||||
|
||||
@ -74,18 +74,18 @@
|
||||
(lambda () (filter gnc:account-is-stock?
|
||||
(gnc-account-get-descendants-sorted
|
||||
(gnc-get-current-root-account))))
|
||||
(lambda (accounts) (list #t
|
||||
(lambda (accounts) (list #t
|
||||
(filter gnc:account-is-stock? accounts)))
|
||||
#t))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:register-option
|
||||
options
|
||||
(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.")
|
||||
#f))
|
||||
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
options))
|
||||
|
||||
;; This is the rendering function. It accepts a database of options
|
||||
@ -98,14 +98,14 @@
|
||||
|
||||
(let ((work-done 0)
|
||||
(work-to-do 0))
|
||||
|
||||
|
||||
;; These are some helper functions for looking up option values.
|
||||
(define (get-op section name)
|
||||
(gnc:lookup-option (gnc:report-options report-obj) section name))
|
||||
|
||||
|
||||
(define (get-option section name)
|
||||
(gnc:option-value (get-op section name)))
|
||||
|
||||
|
||||
(define (table-add-stock-rows table accounts to-date currency
|
||||
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" listing)
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell"
|
||||
"number-cell"
|
||||
(xaccPrintAmount units share-print-info))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell"
|
||||
@ -176,7 +176,7 @@
|
||||
(get-option gnc:pagename-general "Date")))
|
||||
(accounts (get-option gnc:pagename-accounts "Accounts"))
|
||||
(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))
|
||||
(price-source (get-option gnc:pagename-general
|
||||
optname-price-source))
|
||||
@ -189,55 +189,67 @@
|
||||
(document (gnc:make-html-document)))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
document (string-append
|
||||
document (string-append
|
||||
report-title
|
||||
(sprintf #f " %s" (gnc-print-date to-date))))
|
||||
|
||||
;(gnc:debug "accounts" accounts)
|
||||
(if (not (null? accounts))
|
||||
(let* ((commodity-list (gnc:accounts-get-commodities
|
||||
(append
|
||||
(gnc:acccounts-get-all-subaccounts
|
||||
(let* ((commodity-list (gnc:accounts-get-commodities
|
||||
(append
|
||||
(gnc:acccounts-get-all-subaccounts
|
||||
accounts) accounts) currency))
|
||||
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
|
||||
(exchange-fn (gnc:case-exchange-fn price-source currency to-date))
|
||||
(price-fn
|
||||
(case price-source
|
||||
((weighted-average average-cost)
|
||||
((weighted-average average-cost)
|
||||
(lambda (foreign date)
|
||||
(cons #f (gnc-numeric-div
|
||||
(gnc:gnc-monetary-amount
|
||||
(exchange-fn (gnc:make-gnc-monetary foreign
|
||||
(gnc:gnc-monetary-amount
|
||||
(exchange-fn (gnc:make-gnc-monetary foreign
|
||||
(gnc-numeric-create 10000 1))
|
||||
currency))
|
||||
(gnc-numeric-create 10000 1)
|
||||
(gnc-numeric-create 10000 1)
|
||||
GNC-DENOM-AUTO
|
||||
(logior (GNC-DENOM-SIGFIGS 5) GNC-RND-ROUND)))))
|
||||
((pricedb-latest)
|
||||
(lambda (foreign date)
|
||||
((pricedb-latest)
|
||||
(lambda (foreign date)
|
||||
(let* ((price
|
||||
(gnc-pricedb-lookup-latest-any-currency
|
||||
pricedb foreign))
|
||||
(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))
|
||||
(cons (car price) v))
|
||||
(cons #f (gnc-numeric-zero)))))
|
||||
(if price (gnc-price-list-destroy price))
|
||||
fn)))
|
||||
((pricedb-nearest)
|
||||
(lambda (foreign date)
|
||||
((pricedb-nearest)
|
||||
(lambda (foreign date)
|
||||
(let* ((price
|
||||
(gnc-pricedb-lookup-nearest-in-time-any-currency
|
||||
pricedb foreign (timespecCanonicalDayTime date)))
|
||||
(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))
|
||||
(cons (car price) v))
|
||||
(cons #f (gnc-numeric-zero)))))
|
||||
(if price (gnc-price-list-destroy price))
|
||||
fn))))))
|
||||
|
||||
|
||||
(gnc:html-table-set-col-headers!
|
||||
table
|
||||
(list (_ "Account")
|
||||
@ -246,22 +258,22 @@
|
||||
(_ "Units")
|
||||
(_ "Price")
|
||||
(_ "Value")))
|
||||
|
||||
|
||||
(table-add-stock-rows
|
||||
table accounts to-date currency
|
||||
table accounts to-date currency
|
||||
exchange-fn price-fn include-empty collector)
|
||||
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"grand-total"
|
||||
(list
|
||||
(gnc:make-html-table-cell/size
|
||||
1 6 (gnc:make-html-text (gnc:html-markup-hr)))))
|
||||
|
||||
|
||||
(collector
|
||||
'format
|
||||
'format
|
||||
(lambda (currency amount)
|
||||
(gnc:html-table-append-row/markup!
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
"grand-total"
|
||||
(list (gnc:make-html-table-cell/markup
|
||||
@ -270,15 +282,15 @@
|
||||
1 5 "total-number-cell"
|
||||
(gnc:make-gnc-monetary currency amount)))))
|
||||
#f)
|
||||
|
||||
|
||||
(gnc:html-document-add-object! document table))
|
||||
|
||||
;if no accounts selected.
|
||||
(gnc:html-document-add-object!
|
||||
document
|
||||
(gnc:html-make-no-account-warning
|
||||
(gnc:html-make-no-account-warning
|
||||
report-title (gnc:report-id report-obj))))
|
||||
|
||||
|
||||
(gnc:report-finished)
|
||||
document)))
|
||||
|
||||
|
@ -1,17 +1,17 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; price-quotes.scm - manage sub-processes.
|
||||
;;; Copyright 2001 Rob Browning <rlb@cs.utexas.edu>
|
||||
;;;
|
||||
;;; This program is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU General Public License as
|
||||
;;; published by the Free Software Foundation; either version 2 of
|
||||
;;; the License, or (at your option) any later version.
|
||||
;;;
|
||||
;;; This program is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;;
|
||||
;;; This program is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU General Public License as
|
||||
;;; published by the Free Software Foundation; either version 2 of
|
||||
;;; the License, or (at your option) any later version.
|
||||
;;;
|
||||
;;; This program is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with this program; if not, contact:
|
||||
;;;
|
||||
@ -35,7 +35,7 @@
|
||||
|
||||
(define (item-list->hash! lst hash
|
||||
getkey getval
|
||||
hashref hashset
|
||||
hashref hashset
|
||||
list-duplicates?)
|
||||
;; 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
|
||||
@ -58,7 +58,7 @@
|
||||
(if existing-val
|
||||
(hashset hash key (cons val existing-val))
|
||||
(hashset hash key (list val))))))
|
||||
|
||||
|
||||
(for-each handle-item lst)
|
||||
hash)
|
||||
|
||||
@ -205,7 +205,7 @@
|
||||
;; a list of the corresponding commodities. Also perform a bit of
|
||||
;; optimization, merging calls for symbols to the same
|
||||
;; Finance::Quote method.
|
||||
;;
|
||||
;;
|
||||
;; 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
|
||||
;; form:
|
||||
@ -223,7 +223,7 @@
|
||||
(commodity-list #f)
|
||||
(currency-list (filter
|
||||
(lambda (a) (not (gnc-commodity-equiv (cadr a) (caddr a))))
|
||||
(call-with-values
|
||||
(call-with-values
|
||||
(lambda () (partition!
|
||||
(lambda (cmd)
|
||||
(not (string=? (car cmd) "currency")))
|
||||
@ -257,7 +257,7 @@
|
||||
;;
|
||||
;; ("yahoo" (commodity-1 currency-1 tz-1)
|
||||
;; (commodity-2 currency-2 tz-2) ...)
|
||||
;;
|
||||
;;
|
||||
;; ("yahoo" "IBM" "AMD" ...)
|
||||
;;
|
||||
|
||||
@ -375,7 +375,15 @@
|
||||
(saved-price #f)
|
||||
(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)
|
||||
(let ((p (assq-ref quote-data price-sym)))
|
||||
(if p
|
||||
@ -412,31 +420,36 @@
|
||||
commodity currency
|
||||
gnc-time))
|
||||
(if (not (null? saved-price))
|
||||
(if (> (gnc-price-get-source saved-price) PRICE-SOURCE-FQ)
|
||||
(begin
|
||||
(gnc-price-begin-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)
|
||||
(begin
|
||||
(if (gnc-commodity-equiv (gnc-price-get-currency saved-price)
|
||||
commodity)
|
||||
(set! price (gnc-numeric-invert price)))
|
||||
(if (> (gnc-price-get-source saved-price) PRICE-SOURCE-FQ)
|
||||
(begin
|
||||
(gnc-price-begin-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)
|
||||
(let ((gnc-price (gnc-price-create book)))
|
||||
(if (not gnc-price)
|
||||
(string-append
|
||||
currency-str ":" (gnc-commodity-get-mnemonic commodity))
|
||||
(begin
|
||||
(gnc-price-begin-edit gnc-price)
|
||||
(gnc-price-set-commodity gnc-price commodity)
|
||||
(gnc-price-set-currency gnc-price currency)
|
||||
(gnc-price-set-time gnc-price gnc-time)
|
||||
(gnc-price-set-source gnc-price PRICE-SOURCE-FQ)
|
||||
(gnc-price-set-typestr gnc-price price-type)
|
||||
(gnc-price-set-value gnc-price price)
|
||||
(gnc-price-commit-edit gnc-price)
|
||||
gnc-price)))))
|
||||
)))
|
||||
(let ((gnc-price (gnc-price-create book)))
|
||||
(if (not gnc-price)
|
||||
(string-append
|
||||
currency-str ":" (gnc-commodity-get-mnemonic commodity))
|
||||
(begin
|
||||
(gnc-price-begin-edit gnc-price)
|
||||
(gnc-price-set-commodity gnc-price commodity)
|
||||
(gnc-price-set-currency gnc-price currency)
|
||||
(gnc-price-set-time gnc-price gnc-time)
|
||||
(gnc-price-set-source gnc-price PRICE-SOURCE-FQ)
|
||||
(gnc-price-set-typestr gnc-price price-type)
|
||||
(gnc-price-set-value gnc-price price)
|
||||
(gnc-price-commit-edit gnc-price)
|
||||
gnc-price)))))
|
||||
))
|
||||
))
|
||||
|
||||
(define (book-add-prices! book prices)
|
||||
(let ((pricedb (gnc-pricedb-get-db book)))
|
||||
|
Loading…
Reference in New Issue
Block a user