mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
* src/scm/report/category-barchart.scm: remove url FIXME
* src/scm/html-barchart.scm: add bar & legend urls to render * src/gnome/top-level.c: Robert Stephenson's patch for gtkhtml & gconf * src/gnome/gnc-html-guppi.c: fix bugs * src/scm/html-text.scm: fix bug * src/scm/report/portfolio.scm: work on display * src/scm/report/stylesheet-plain.scm: add styles for totals * src/scm/html-document.scm: bug fix * src/scm/report/taxtxf.scm: more work * src/engine/gnc-commodity.c (count_coms): use GNC_COMMODITY_NS_ISO instead of the string const. * src/engine/rpc/Makefile.am: use GLIB_CFLAGS instead of hard-coded include dir. * src/engine/rpc/RpcUtils.c (rpcend_build_gnccommoditylist): use GNC_COMMODITY_NS_ISO instead of the string const. Fix compiler warning. * src/SplitLedger.c: fix bug git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3857 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
parent
56902584d2
commit
92eb3d6f4c
36
ChangeLog
36
ChangeLog
@ -1,3 +1,38 @@
|
|||||||
|
2001-03-29 Dave Peticolas <dave@krondo.com>
|
||||||
|
|
||||||
|
* src/scm/report/category-barchart.scm: remove url FIXME
|
||||||
|
|
||||||
|
* src/scm/html-barchart.scm: add bar & legend urls to render
|
||||||
|
|
||||||
|
* src/gnome/top-level.c: Robert Stephenson's patch for
|
||||||
|
gtkhtml & gconf
|
||||||
|
|
||||||
|
* src/gnome/gnc-html-guppi.c: fix bugs
|
||||||
|
|
||||||
|
* src/scm/html-text.scm: fix bug
|
||||||
|
|
||||||
|
* src/scm/report/portfolio.scm: work on display
|
||||||
|
|
||||||
|
* src/scm/report/stylesheet-plain.scm: add styles for totals
|
||||||
|
|
||||||
|
* src/scm/html-document.scm: bug fix
|
||||||
|
|
||||||
|
* src/scm/report/taxtxf.scm: more work
|
||||||
|
|
||||||
|
* src/engine/gnc-commodity.c (count_coms): use
|
||||||
|
GNC_COMMODITY_NS_ISO instead of the string const.
|
||||||
|
|
||||||
|
* src/engine/rpc/Makefile.am: use GLIB_CFLAGS instead of
|
||||||
|
hard-coded include dir.
|
||||||
|
|
||||||
|
* src/engine/rpc/RpcUtils.c (rpcend_build_gnccommoditylist): use
|
||||||
|
GNC_COMMODITY_NS_ISO instead of the string const. Fix compiler
|
||||||
|
warning.
|
||||||
|
|
||||||
|
2001-03-28 Dave Peticolas <dave@krondo.com>
|
||||||
|
|
||||||
|
* src/SplitLedger.c: fix bug
|
||||||
|
|
||||||
2001-03-29 Christian Stimming <stimming@tuhh.de>
|
2001-03-29 Christian Stimming <stimming@tuhh.de>
|
||||||
|
|
||||||
* src/scm/report/report-list.scm, Makefile.am: Added new file.
|
* src/scm/report/report-list.scm, Makefile.am: Added new file.
|
||||||
@ -32,7 +67,6 @@
|
|||||||
* src/engine/gnc-pricedb.[ch]: added
|
* src/engine/gnc-pricedb.[ch]: added
|
||||||
gnc_pricedb_lookup_nearest_in_time, courtesy Rob B.
|
gnc_pricedb_lookup_nearest_in_time, courtesy Rob B.
|
||||||
|
|
||||||
|
|
||||||
2001-03-28 James LewisMoss <jimdres@mindspring.com>
|
2001-03-28 James LewisMoss <jimdres@mindspring.com>
|
||||||
|
|
||||||
* src/test/gnc-test-stuff.c (get_random_split): set a share
|
* src/test/gnc-test-stuff.c (get_random_split): set a share
|
||||||
|
|||||||
@ -986,7 +986,14 @@ LedgerMoveCursor (Table *table, VirtualLocation *p_new_virt_loc)
|
|||||||
(pending_trans == old_trans) &&
|
(pending_trans == old_trans) &&
|
||||||
(old_trans != new_trans))
|
(old_trans != new_trans))
|
||||||
{
|
{
|
||||||
sr_balance_trans (reg, old_trans);
|
if (sr_balance_trans (reg, old_trans))
|
||||||
|
{
|
||||||
|
new_trans = old_trans;
|
||||||
|
new_split = old_split;
|
||||||
|
new_trans_split = old_trans_split;
|
||||||
|
new_class = old_class;
|
||||||
|
new_virt_loc = table->current_cursor_loc;
|
||||||
|
}
|
||||||
|
|
||||||
if (xaccTransIsOpen (old_trans))
|
if (xaccTransIsOpen (old_trans))
|
||||||
xaccTransCommitEdit (old_trans);
|
xaccTransCommitEdit (old_trans);
|
||||||
|
|||||||
@ -314,7 +314,7 @@ count_coms(gpointer key, gpointer value, gpointer user_data)
|
|||||||
GHashTable *tbl = ((gnc_commodity_namespace*)value)->table;
|
GHashTable *tbl = ((gnc_commodity_namespace*)value)->table;
|
||||||
guint *count = (guint*)user_data;
|
guint *count = (guint*)user_data;
|
||||||
|
|
||||||
if(safe_strcmp((char*)key, "ISO4217") == 0)
|
if(safe_strcmp((char*)key, GNC_COMMODITY_NS_ISO) == 0)
|
||||||
{
|
{
|
||||||
/* don't count default commodities */
|
/* don't count default commodities */
|
||||||
return;
|
return;
|
||||||
|
|||||||
@ -41,9 +41,10 @@ EXTRA_DIST = \
|
|||||||
README \
|
README \
|
||||||
$(RPCGEN_SRCS)
|
$(RPCGEN_SRCS)
|
||||||
|
|
||||||
INCLUDES = -I.. -I/usr/lib/glib/include
|
INCLUDES = -I..
|
||||||
|
|
||||||
LDFLAGS = -lpthread
|
LDADD = -lpthread
|
||||||
|
CFLAGS = @CFLAGS@ ${GLIB_CFLAGS}
|
||||||
|
|
||||||
#RPCGEN=rpcgen -M
|
#RPCGEN=rpcgen -M
|
||||||
RPCGEN=rpcgen
|
RPCGEN=rpcgen
|
||||||
|
|||||||
@ -799,7 +799,7 @@ gnc_commoditylist * rpcend_build_gnccommoditylist (gnc_commodity_table *ct,
|
|||||||
GList *cl, *this_cl;
|
GList *cl, *this_cl;
|
||||||
|
|
||||||
/* Ignore all the ISO4217 commodities */
|
/* Ignore all the ISO4217 commodities */
|
||||||
if (!strcmp (namespace, "ISO4217"))
|
if (!strcmp (namespace, GNC_COMMODITY_NS_ISO))
|
||||||
continue;
|
continue;
|
||||||
|
|
||||||
cl = gnc_commodity_table_get_commodities (ct, namespace);
|
cl = gnc_commodity_table_get_commodities (ct, namespace);
|
||||||
@ -1229,7 +1229,7 @@ static void rpcend_do_build_gncquery (gncQuery *gq, gncQuery *from_q,
|
|||||||
LEAVE ("done");
|
LEAVE ("done");
|
||||||
}
|
}
|
||||||
|
|
||||||
void rpcend_do_free_gncquery (gncQuery *gq, gboolean isRpc)
|
static void rpcend_do_free_gncquery (gncQuery *gq, gboolean isRpc)
|
||||||
{
|
{
|
||||||
gncQTOrlist *orlist, *nextor;
|
gncQTOrlist *orlist, *nextor;
|
||||||
|
|
||||||
|
|||||||
@ -516,6 +516,8 @@ gnc_html_embedded_barchart(gnc_html * parent,
|
|||||||
char ** callbacks=NULL;
|
char ** callbacks=NULL;
|
||||||
char * gtitle = NULL;
|
char * gtitle = NULL;
|
||||||
|
|
||||||
|
chart->parent = parent;
|
||||||
|
|
||||||
if((param = g_hash_table_lookup(params, "data_rows")) != NULL) {
|
if((param = g_hash_table_lookup(params, "data_rows")) != NULL) {
|
||||||
sscanf(param, "%d", &datarows);
|
sscanf(param, "%d", &datarows);
|
||||||
arglist[argind].name = "data_rows";
|
arglist[argind].name = "data_rows";
|
||||||
@ -611,11 +613,11 @@ gnc_html_embedded_barchart(gnc_html * parent,
|
|||||||
g_free(callbacks);
|
g_free(callbacks);
|
||||||
}
|
}
|
||||||
if((param = g_hash_table_lookup(params, "bar_urls_2")) != NULL) {
|
if((param = g_hash_table_lookup(params, "bar_urls_2")) != NULL) {
|
||||||
arglist[argind].name = "bar_callback1";
|
arglist[argind].name = "bar_callback2";
|
||||||
arglist[argind].type = GTK_TYPE_POINTER;
|
arglist[argind].type = GTK_TYPE_POINTER;
|
||||||
GTK_VALUE_POINTER(arglist[argind]) = &guppi_bar_2_callback;
|
GTK_VALUE_POINTER(arglist[argind]) = &guppi_bar_2_callback;
|
||||||
argind++;
|
argind++;
|
||||||
arglist[argind].name = "bar_callback1_data";
|
arglist[argind].name = "bar_callback2_data";
|
||||||
arglist[argind].type = GTK_TYPE_POINTER;
|
arglist[argind].type = GTK_TYPE_POINTER;
|
||||||
GTK_VALUE_POINTER(arglist[argind]) = chart;
|
GTK_VALUE_POINTER(arglist[argind]) = chart;
|
||||||
argind++;
|
argind++;
|
||||||
@ -626,11 +628,11 @@ gnc_html_embedded_barchart(gnc_html * parent,
|
|||||||
g_free(callbacks);
|
g_free(callbacks);
|
||||||
}
|
}
|
||||||
if((param = g_hash_table_lookup(params, "bar_urls_3")) != NULL) {
|
if((param = g_hash_table_lookup(params, "bar_urls_3")) != NULL) {
|
||||||
arglist[argind].name = "bar_callback1";
|
arglist[argind].name = "bar_callback3";
|
||||||
arglist[argind].type = GTK_TYPE_POINTER;
|
arglist[argind].type = GTK_TYPE_POINTER;
|
||||||
GTK_VALUE_POINTER(arglist[argind]) = &guppi_bar_3_callback;
|
GTK_VALUE_POINTER(arglist[argind]) = &guppi_bar_3_callback;
|
||||||
argind++;
|
argind++;
|
||||||
arglist[argind].name = "bar_callback1_data";
|
arglist[argind].name = "bar_callback3_data";
|
||||||
arglist[argind].type = GTK_TYPE_POINTER;
|
arglist[argind].type = GTK_TYPE_POINTER;
|
||||||
GTK_VALUE_POINTER(arglist[argind]) = chart;
|
GTK_VALUE_POINTER(arglist[argind]) = chart;
|
||||||
argind++;
|
argind++;
|
||||||
@ -744,6 +746,8 @@ gnc_html_embedded_scatter(gnc_html * parent,
|
|||||||
double * y_data=NULL;
|
double * y_data=NULL;
|
||||||
char * gtitle = NULL;
|
char * gtitle = NULL;
|
||||||
|
|
||||||
|
chart->parent = parent;
|
||||||
|
|
||||||
if((param = g_hash_table_lookup(params, "datasize")) != NULL) {
|
if((param = g_hash_table_lookup(params, "datasize")) != NULL) {
|
||||||
sscanf(param, "%d", &datasize);
|
sscanf(param, "%d", &datasize);
|
||||||
arglist[argind].name = "data_size";
|
arglist[argind].name = "data_size";
|
||||||
|
|||||||
@ -28,6 +28,9 @@
|
|||||||
#include <guile/gh.h>
|
#include <guile/gh.h>
|
||||||
#include <popt.h>
|
#include <popt.h>
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
|
#ifdef GTKHTML_HAVE_GCONF
|
||||||
|
#include <gconf/gconf.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
#include "AccWindow.h"
|
#include "AccWindow.h"
|
||||||
#include "FileBox.h"
|
#include "FileBox.h"
|
||||||
@ -179,6 +182,10 @@ gnucash_ui_init(void)
|
|||||||
char **restargv2;
|
char **restargv2;
|
||||||
poptContext returnedPoptContext;
|
poptContext returnedPoptContext;
|
||||||
|
|
||||||
|
#ifdef GTKHTML_HAVE_GCONF
|
||||||
|
GError *gerror;
|
||||||
|
#endif
|
||||||
|
|
||||||
ENTER ("\n");
|
ENTER ("\n");
|
||||||
|
|
||||||
/* We're going to have to have other ways to handle X and GUI
|
/* We're going to have to have other ways to handle X and GUI
|
||||||
@ -202,6 +209,12 @@ gnucash_ui_init(void)
|
|||||||
restargv2 = (char**)poptGetArgs(returnedPoptContext);
|
restargv2 = (char**)poptGetArgs(returnedPoptContext);
|
||||||
gnc_set_remaining_argv(argv_length(restargv2), (const char**)restargv2);
|
gnc_set_remaining_argv(argv_length(restargv2), (const char**)restargv2);
|
||||||
|
|
||||||
|
#ifdef GTKHTML_HAVE_GCONF
|
||||||
|
if( !gconf_init(restargc, restargv, &gerror) )
|
||||||
|
g_error_free(gerror);
|
||||||
|
gerror = NULL;
|
||||||
|
#endif
|
||||||
|
|
||||||
/* this must come after using the poptGetArgs return value */
|
/* this must come after using the poptGetArgs return value */
|
||||||
poptFreeContext (returnedPoptContext);
|
poptFreeContext (returnedPoptContext);
|
||||||
gnc_free_argv (restargv);
|
gnc_free_argv (restargv);
|
||||||
|
|||||||
@ -273,11 +273,28 @@
|
|||||||
(display " ")))
|
(display " ")))
|
||||||
nlist)))))
|
nlist)))))
|
||||||
|
|
||||||
|
|
||||||
(let* ((retval '())
|
(let* ((retval '())
|
||||||
(push (lambda (l) (set! retval (cons l retval))))
|
(push (lambda (l) (set! retval (cons l retval))))
|
||||||
(title (gnc:html-barchart-title barchart))
|
(title (gnc:html-barchart-title barchart))
|
||||||
(subtitle (gnc:html-barchart-subtitle barchart))
|
(subtitle (gnc:html-barchart-subtitle barchart))
|
||||||
|
(url-1
|
||||||
|
(catenate-escaped-strings
|
||||||
|
(gnc:html-barchart-button-1-bar-urls barchart)))
|
||||||
|
(url-2
|
||||||
|
(catenate-escaped-strings
|
||||||
|
(gnc:html-barchart-button-2-bar-urls barchart)))
|
||||||
|
(url-3
|
||||||
|
(catenate-escaped-strings
|
||||||
|
(gnc:html-barchart-button-3-bar-urls barchart)))
|
||||||
|
(legend-1
|
||||||
|
(catenate-escaped-strings
|
||||||
|
(gnc:html-barchart-button-1-legend-urls barchart)))
|
||||||
|
(legend-2
|
||||||
|
(catenate-escaped-strings
|
||||||
|
(gnc:html-barchart-button-2-legend-urls barchart)))
|
||||||
|
(legend-3
|
||||||
|
(catenate-escaped-strings
|
||||||
|
(gnc:html-barchart-button-3-legend-urls barchart)))
|
||||||
(x-label (gnc:html-barchart-x-axis-label barchart))
|
(x-label (gnc:html-barchart-x-axis-label barchart))
|
||||||
(y-label (gnc:html-barchart-y-axis-label barchart))
|
(y-label (gnc:html-barchart-y-axis-label barchart))
|
||||||
(data (gnc:html-barchart-data barchart))
|
(data (gnc:html-barchart-data barchart))
|
||||||
@ -303,6 +320,36 @@
|
|||||||
(begin
|
(begin
|
||||||
(push " <param name=\"subtitle\" value=\"")
|
(push " <param name=\"subtitle\" value=\"")
|
||||||
(push subtitle) (push "\">\n")))
|
(push subtitle) (push "\">\n")))
|
||||||
|
(if url-1
|
||||||
|
(begin
|
||||||
|
(push " <param name=\"bar_urls_1\" value=\"")
|
||||||
|
(push url-1)
|
||||||
|
(push "\">\n")))
|
||||||
|
(if url-2
|
||||||
|
(begin
|
||||||
|
(push " <param name=\"bar_urls_2\" value=\"")
|
||||||
|
(push url-1)
|
||||||
|
(push "\">\n")))
|
||||||
|
(if url-3
|
||||||
|
(begin
|
||||||
|
(push " <param name=\"bar_urls_3\" value=\"")
|
||||||
|
(push url-1)
|
||||||
|
(push "\">\n")))
|
||||||
|
(if legend-1
|
||||||
|
(begin
|
||||||
|
(push " <param name=\"legend_urls_1\" value=\"")
|
||||||
|
(push legend-1)
|
||||||
|
(push "\">\n")))
|
||||||
|
(if legend-2
|
||||||
|
(begin
|
||||||
|
(push " <param name=\"legend_urls_2\" value=\"")
|
||||||
|
(push legend-2)
|
||||||
|
(push "\">\n")))
|
||||||
|
(if legend-3
|
||||||
|
(begin
|
||||||
|
(push " <param name=\"legend_urls_3\" value=\"")
|
||||||
|
(push legend-3)
|
||||||
|
(push "\">\n")))
|
||||||
(if (and data (list? data))
|
(if (and data (list? data))
|
||||||
(let ((rows (length data))
|
(let ((rows (length data))
|
||||||
(cols 0))
|
(cols 0))
|
||||||
@ -360,4 +407,3 @@
|
|||||||
(push "</object> \n"))
|
(push "</object> \n"))
|
||||||
" ")
|
" ")
|
||||||
retval))
|
retval))
|
||||||
|
|
||||||
|
|||||||
@ -293,7 +293,7 @@
|
|||||||
;; "" tags mean "show no tag"; #f tags means use default.
|
;; "" tags mean "show no tag"; #f tags means use default.
|
||||||
(cond ((not tag)
|
(cond ((not tag)
|
||||||
(set! tag markup))
|
(set! tag markup))
|
||||||
((string=? tag "")
|
((and (string? tag) (string=? tag ""))
|
||||||
(set! tag #f)))
|
(set! tag #f)))
|
||||||
(let* ((retval '())
|
(let* ((retval '())
|
||||||
(push (lambda (l) (set! retval (cons l retval)))))
|
(push (lambda (l) (set! retval (cons l retval)))))
|
||||||
|
|||||||
@ -140,7 +140,8 @@
|
|||||||
((string? rendered-elt)
|
((string? rendered-elt)
|
||||||
rendered-elt)
|
rendered-elt)
|
||||||
((list? rendered-elt)
|
((list? rendered-elt)
|
||||||
(apply string-append (gnc:report-tree-collapse rendered-elt)))
|
(apply string-append
|
||||||
|
(gnc:html-document-tree-collapse rendered-elt)))
|
||||||
(#t
|
(#t
|
||||||
(simple-format "hold on there podner. form='~s'\n" rendered-elt)
|
(simple-format "hold on there podner. form='~s'\n" rendered-elt)
|
||||||
""))))
|
""))))
|
||||||
|
|||||||
@ -14,7 +14,6 @@ gncscm_DATA = \
|
|||||||
report-list.scm \
|
report-list.scm \
|
||||||
stylesheet-fancy.scm \
|
stylesheet-fancy.scm \
|
||||||
stylesheet-plain.scm \
|
stylesheet-plain.scm \
|
||||||
table-test.scm \
|
|
||||||
taxtxf.scm \
|
taxtxf.scm \
|
||||||
transaction-report.scm \
|
transaction-report.scm \
|
||||||
txf-export-help.scm \
|
txf-export-help.scm \
|
||||||
|
|||||||
@ -347,8 +347,6 @@
|
|||||||
other-anchor
|
other-anchor
|
||||||
(gnc:account-anchor-text (car pair))))
|
(gnc:account-anchor-text (car pair))))
|
||||||
all-data)))
|
all-data)))
|
||||||
;; FIXME: The url stuff works here, but it not yet
|
|
||||||
;; implemented in html-barchart.scm -- fix that there.
|
|
||||||
(gnc:html-barchart-set-button-1-bar-urls! chart urls)
|
(gnc:html-barchart-set-button-1-bar-urls! chart urls)
|
||||||
(gnc:html-barchart-set-button-1-legend-urls! chart urls))
|
(gnc:html-barchart-set-button-1-legend-urls! chart urls))
|
||||||
|
|
||||||
|
|||||||
@ -30,8 +30,9 @@
|
|||||||
"General" "Accounts"
|
"General" "Accounts"
|
||||||
"b"
|
"b"
|
||||||
"Stock Accounts to report on"
|
"Stock Accounts to report on"
|
||||||
(lambda () (filter gnc:account-is-stock? (gnc:group-get-account-list
|
(lambda () (filter gnc:account-is-stock?
|
||||||
(gnc:get-current-group))))
|
(gnc:group-get-subaccounts
|
||||||
|
(gnc:get-current-group))))
|
||||||
(lambda (accounts) (list #t (filter gnc:account-is-stock? accounts)))
|
(lambda (accounts) (list #t (filter gnc:account-is-stock? accounts)))
|
||||||
#t))
|
#t))
|
||||||
|
|
||||||
@ -62,7 +63,8 @@
|
|||||||
(define (op-value section name)
|
(define (op-value section name)
|
||||||
(gnc:option-value (get-op section name)))
|
(gnc:option-value (get-op section name)))
|
||||||
|
|
||||||
(define (table-add-stock-rows table accounts to-date currency pricedb collector)
|
(define (table-add-stock-rows table accounts to-date
|
||||||
|
currency pricedb collector)
|
||||||
(if (null? accounts) collector
|
(if (null? accounts) collector
|
||||||
(let* ((current (car accounts))
|
(let* ((current (car accounts))
|
||||||
(rest (cdr accounts))
|
(rest (cdr accounts))
|
||||||
@ -70,38 +72,40 @@
|
|||||||
(commodity (gnc:account-get-commodity current))
|
(commodity (gnc:account-get-commodity current))
|
||||||
(ticker-symbol (gnc:commodity-get-mnemonic commodity))
|
(ticker-symbol (gnc:commodity-get-mnemonic commodity))
|
||||||
(listing (gnc:commodity-get-namespace commodity))
|
(listing (gnc:commodity-get-namespace commodity))
|
||||||
(unit-collector (gnc:account-get-comm-balance-at-date current to-date #f))
|
(unit-collector (gnc:account-get-comm-balance-at-date
|
||||||
|
current to-date #f))
|
||||||
(units (cadr (unit-collector 'getpair commodity #f)))
|
(units (cadr (unit-collector 'getpair commodity #f)))
|
||||||
|
|
||||||
(price (gnc:price-get-value
|
(price (gnc:pricedb-lookup-nearest-in-time pricedb
|
||||||
(gnc:pricedb-lookup-nearest-in-time pricedb
|
commodity
|
||||||
commodity
|
currency
|
||||||
currency
|
to-date))
|
||||||
to-date)))
|
|
||||||
|
|
||||||
(value-num (gnc:numeric-mul units
|
(price-value (if price
|
||||||
price
|
(gnc:price-get-value price)
|
||||||
(gnc:commodity-get-fraction currency)
|
(gnc:numeric-zero)))
|
||||||
GNC-RND-ROUND))
|
|
||||||
(dummy (begin
|
(value-num (gnc:numeric-mul
|
||||||
(gnc:warn "price " price)
|
units
|
||||||
(gnc:warn "units " units)
|
price-value
|
||||||
(gnc:warn "value-num" value-num)))
|
(gnc:commodity-get-fraction currency)
|
||||||
(value (gnc:make-gnc-monetary currency
|
GNC-RND-ROUND))
|
||||||
value-num)))
|
|
||||||
|
(value (gnc:make-gnc-monetary currency value-num)))
|
||||||
(collector 'add currency value-num)
|
(collector 'add currency value-num)
|
||||||
(gnc:html-table-append-row! table (list name
|
(gnc:html-table-append-row!
|
||||||
ticker-symbol
|
table
|
||||||
listing
|
(list name
|
||||||
(gnc:numeric-to-double units)
|
ticker-symbol
|
||||||
(gnc:make-gnc-monetary
|
listing
|
||||||
currency
|
(gnc:make-html-table-header-cell/markup
|
||||||
price)
|
"number-cell" (gnc:numeric-to-double units))
|
||||||
value
|
(gnc:make-html-table-header-cell/markup
|
||||||
)
|
"number-cell" (gnc:make-gnc-monetary currency price-value))
|
||||||
)
|
(gnc:make-html-table-header-cell/markup
|
||||||
(table-add-stock-rows table rest to-date currency pricedb collector))))
|
"number-cell" value)))
|
||||||
|
(table-add-stock-rows
|
||||||
|
table rest to-date currency pricedb collector))))
|
||||||
|
|
||||||
;; The first thing we do is make local variables for all the specific
|
;; The first thing we do is make local variables for all the specific
|
||||||
;; options in the set of options given to the function. This set will
|
;; options in the set of options given to the function. This set will
|
||||||
@ -115,31 +119,43 @@
|
|||||||
(document (gnc:make-html-document))
|
(document (gnc:make-html-document))
|
||||||
(pricedb (gnc:book-get-pricedb (gnc:get-current-book))))
|
(pricedb (gnc:book-get-pricedb (gnc:get-current-book))))
|
||||||
|
|
||||||
|
(gnc:html-document-set-title!
|
||||||
|
document (sprintf #f
|
||||||
(gnc:html-document-set-title! document (sprintf #f
|
(_ "Investment Portfolio Report: %s")
|
||||||
(_ "Investment Portfolio Report: %s")
|
(gnc:timepair-to-datestring to-date)))
|
||||||
(gnc:timepair-to-datestring to-date)))
|
|
||||||
|
|
||||||
|
|
||||||
(gnc:html-table-set-col-headers!
|
(gnc:html-table-set-col-headers!
|
||||||
table
|
table
|
||||||
(list
|
(list (_ "Account")
|
||||||
(N_ "Account")
|
(_ "Symbol")
|
||||||
(N_ "Symbol")
|
(_ "Listing")
|
||||||
(N_ "Listing")
|
(_ "Units")
|
||||||
(N_ "Units")
|
(_ "Price")
|
||||||
(N_ "Price")
|
(_ "Value")))
|
||||||
(N_ "Value")))
|
|
||||||
|
(table-add-stock-rows
|
||||||
|
table accounts to-date currency pricedb collector)
|
||||||
|
|
||||||
|
(gnc:html-table-append-row!
|
||||||
|
table
|
||||||
|
(list
|
||||||
|
(gnc:make-html-table-cell/size
|
||||||
|
1 6 (gnc:make-html-text (gnc:html-markup-hr)))))
|
||||||
|
|
||||||
|
(collector
|
||||||
|
'format
|
||||||
|
(lambda (currency amount)
|
||||||
|
(gnc:html-table-append-row!
|
||||||
|
table
|
||||||
|
(list (gnc:make-html-table-cell/markup
|
||||||
|
"total-label-cell" (_ "Total"))
|
||||||
|
(gnc:make-html-table-cell/size/markup
|
||||||
|
1 5 "total-number-cell"
|
||||||
|
(gnc:make-gnc-monetary currency amount)))))
|
||||||
|
#f)
|
||||||
|
|
||||||
(table-add-stock-rows table accounts to-date currency pricedb collector)
|
|
||||||
(collector 'format
|
|
||||||
(lambda (currency amount)
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list (gnc:make-gnc-monetary currency amount))))
|
|
||||||
#f)
|
|
||||||
(gnc:html-document-add-object! document table)
|
(gnc:html-document-add-object! document table)
|
||||||
|
|
||||||
document))
|
document))
|
||||||
|
|
||||||
(gnc:define-report
|
(gnc:define-report
|
||||||
@ -157,4 +173,3 @@
|
|||||||
|
|
||||||
;; The rendering function defined above.
|
;; The rendering function defined above.
|
||||||
'renderer portfolio-renderer))
|
'renderer portfolio-renderer))
|
||||||
|
|
||||||
|
|||||||
@ -21,7 +21,6 @@
|
|||||||
(equal? locale "en_US"))
|
(equal? locale "en_US"))
|
||||||
(gnc:depend "report/taxtxf.scm")))
|
(gnc:depend "report/taxtxf.scm")))
|
||||||
(gnc:depend "report/transaction-report.scm")
|
(gnc:depend "report/transaction-report.scm")
|
||||||
(gnc:depend "report/table-test.scm")
|
|
||||||
|
|
||||||
;; style sheets
|
;; style sheets
|
||||||
(gnc:depend "report/stylesheet-plain.scm")
|
(gnc:depend "report/stylesheet-plain.scm")
|
||||||
|
|||||||
@ -110,6 +110,15 @@
|
|||||||
'tag "th"
|
'tag "th"
|
||||||
'attribute (list "align" "right"))
|
'attribute (list "align" "right"))
|
||||||
|
|
||||||
|
(gnc:html-document-set-style!
|
||||||
|
ssdoc "total-number-cell"
|
||||||
|
'tag '("td" "b")
|
||||||
|
'attribute (list "align" "right"))
|
||||||
|
|
||||||
|
(gnc:html-document-set-style!
|
||||||
|
ssdoc "total-label-cell"
|
||||||
|
'tag '("td" "b"))
|
||||||
|
|
||||||
;; don't surround marked-up links with <a> </a>
|
;; don't surround marked-up links with <a> </a>
|
||||||
(if (not links?)
|
(if (not links?)
|
||||||
(gnc:html-document-set-style!
|
(gnc:html-document-set-style!
|
||||||
|
|||||||
@ -1,37 +0,0 @@
|
|||||||
;; -*-scheme-*-
|
|
||||||
(gnc:support "report/table-test.scm")
|
|
||||||
(gnc:depend "report-html.scm")
|
|
||||||
|
|
||||||
(let ()
|
|
||||||
(define (options-generator)
|
|
||||||
(let* ((options (gnc:new-options)))
|
|
||||||
options))
|
|
||||||
|
|
||||||
(define (renderer report-obj)
|
|
||||||
(let ((document (gnc:make-html-document))
|
|
||||||
(tab (gnc:make-html-table)))
|
|
||||||
|
|
||||||
(gnc:html-document-set-style!
|
|
||||||
document "totalcell"
|
|
||||||
'tag "td"
|
|
||||||
'attribute (list "bgcolor" "ff00ff"))
|
|
||||||
|
|
||||||
(gnc:html-document-set-style!
|
|
||||||
document "subtotalrow"
|
|
||||||
'tag "tr"
|
|
||||||
'attribute (list "bgcolor" "ffff00"))
|
|
||||||
|
|
||||||
(gnc:html-table-append-row! tab (list 0 1 2 3 4 5 6))
|
|
||||||
(gnc:html-table-append-row/markup!
|
|
||||||
tab "subtotalrow"
|
|
||||||
(list 0 1 2 3 4 5
|
|
||||||
(gnc:make-html-table-cell/markup "totalcell" 6)))
|
|
||||||
|
|
||||||
(gnc:html-document-add-object! document tab)
|
|
||||||
document))
|
|
||||||
|
|
||||||
(gnc:define-report
|
|
||||||
'version 1
|
|
||||||
'name (N_ "Table test")
|
|
||||||
'options-generator options-generator
|
|
||||||
'renderer renderer))
|
|
||||||
@ -76,41 +76,11 @@
|
|||||||
(cond
|
(cond
|
||||||
((string? item) (display item port))
|
((string? item) (display item port))
|
||||||
((null? item) #t)
|
((null? item) #t)
|
||||||
((list? item) (map (lambda (item) (gnc:display-report-list-item item port
|
((list? item) (map (lambda (item)
|
||||||
warn-msg))
|
(gnc:display-report-list-item item port warn-msg))
|
||||||
item))
|
item))
|
||||||
(else (gnc:warn warn-msg item " is the wrong type."))))
|
(else (gnc:warn warn-msg item " is the wrong type."))))
|
||||||
|
|
||||||
;; a few string functions I couldn't find elsewhere
|
|
||||||
(define (string-search string sub-str start)
|
|
||||||
(do ((sub-len (string-length sub-str))
|
|
||||||
;; must recompute sub-len because order is unknown
|
|
||||||
(limit (- (string-length string) (string-length sub-str)))
|
|
||||||
(char0 (string-ref sub-str 0))
|
|
||||||
;; find first char of sub-str ; must recompute char0
|
|
||||||
(match0 (string-index string (string-ref sub-str 0) start) ; init
|
|
||||||
(string-index string char0 (+ 1 match0))) ; step
|
|
||||||
(match #f #f))
|
|
||||||
((or (not match0) (> match0 limit)
|
|
||||||
;; does entire sub-str match?
|
|
||||||
(let ()
|
|
||||||
(set! match (string=? sub-str (substring string match0
|
|
||||||
(+ match0 sub-len))))
|
|
||||||
(if match (set! match match0))
|
|
||||||
match))
|
|
||||||
match)))
|
|
||||||
|
|
||||||
(define (string-search? string sub-str start)
|
|
||||||
(number? (string-search string sub-str start)))
|
|
||||||
|
|
||||||
(define (string-substitute string search-str sub-str start)
|
|
||||||
(let ((pos (string-search string search-str start)))
|
|
||||||
(if pos
|
|
||||||
(let ((search-len (string-length search-str)))
|
|
||||||
(string-append (substring string 0 pos) sub-str
|
|
||||||
(substring string (+ pos search-len))))
|
|
||||||
string)))
|
|
||||||
|
|
||||||
(define (lx-collector level action value)
|
(define (lx-collector level action value)
|
||||||
((vector-ref levelx-collector (- level 1)) action value))
|
((vector-ref levelx-collector (- level 1)) action value))
|
||||||
|
|
||||||
@ -196,109 +166,34 @@
|
|||||||
tab-title (N_ "Print Full account names")
|
tab-title (N_ "Print Full account names")
|
||||||
"g" (N_ "Print all Parent account names") #f))
|
"g" (N_ "Print all Parent account names") #f))
|
||||||
|
|
||||||
(gnc:register-tax-option
|
|
||||||
(gnc:make-account-list-option
|
|
||||||
(N_ "TXF Export Init") (N_ "Select Account")
|
|
||||||
"a" (N_ "Select Account")
|
|
||||||
(lambda () (gnc:get-current-accounts))
|
|
||||||
#f #t))
|
|
||||||
|
|
||||||
(gnc:register-tax-option
|
|
||||||
(gnc:make-simple-boolean-option
|
|
||||||
(N_ "TXF Export Init") (N_ "Print extended TXF HELP messages")
|
|
||||||
"b" (N_ "Print TXF HELP") #f))
|
|
||||||
|
|
||||||
(gnc:register-tax-option
|
|
||||||
;;(gnc:make-multichoice-option
|
|
||||||
(gnc:make-list-option
|
|
||||||
(N_ "TXF Export Init")
|
|
||||||
(N_ "For INCOME accounts, select here. < ^ # see help")
|
|
||||||
"c" (N_ "Select a TXF Income category")
|
|
||||||
'()
|
|
||||||
txf-income-categories))
|
|
||||||
|
|
||||||
(gnc:register-tax-option
|
|
||||||
;;(gnc:make-multichoice-option
|
|
||||||
(gnc:make-list-option
|
|
||||||
(N_ "TXF Export Init")
|
|
||||||
(N_ "For EXPENSE accounts, select here. < ^ # see help")
|
|
||||||
"d" (N_ "Select a TXF Expense category")
|
|
||||||
'()
|
|
||||||
txf-expense-categories))
|
|
||||||
|
|
||||||
(gnc:register-tax-option
|
|
||||||
(gnc:make-multichoice-option
|
|
||||||
(N_ "TXF Export Init") (N_ "< ^ Payer Name source")
|
|
||||||
"e" (N_ "Select the source of the Payer Name") 'default
|
|
||||||
(list (list->vector
|
|
||||||
(list 'default (N_ "Default")
|
|
||||||
(N_ "Use Indicated Default")))
|
|
||||||
(list->vector
|
|
||||||
(list 'current (N_ "< Current Account")
|
|
||||||
(N_ "Use Current Account Name")))
|
|
||||||
(list->vector
|
|
||||||
(list 'parent (N_ "^ Parent Account")
|
|
||||||
(N_ "Use Parent Account Name"))))))
|
|
||||||
|
|
||||||
gnc:*tax-report-options*)
|
gnc:*tax-report-options*)
|
||||||
|
|
||||||
(define tax-key "{tax}")
|
|
||||||
|
|
||||||
(define tax-end-key "{/tax}")
|
|
||||||
|
|
||||||
;; Render txf information
|
;; Render txf information
|
||||||
(define txf-last-payer "") ; if same as current, inc txf-l-coount
|
(define txf-last-payer #f) ; if same as current, inc txf-l-count
|
||||||
; this only works if different
|
; this only works if different
|
||||||
; codes from the same payer are
|
; codes from the same payer are
|
||||||
; grouped in the accounts list
|
; grouped in the accounts list
|
||||||
(define txf-l-count 0) ; count repeated N codes
|
(define txf-l-count 0) ; count repeated N codes
|
||||||
(define txf-notes "") ; tmp storage for account notes
|
|
||||||
(define txf-pos 0) ; tmp storage for tax-end-key in notes
|
|
||||||
(define tax-pos 0) ; tmp storage for tax-key in notes
|
|
||||||
;; stores assigned txf codes so we can check for duplicates
|
;; stores assigned txf codes so we can check for duplicates
|
||||||
(define txf-dups-alist '())
|
(define txf-dups-alist '())
|
||||||
|
|
||||||
(define (txf-payer? str)
|
(define (txf-payer? payer)
|
||||||
(member str '("<" "^")))
|
(member str '('current 'parent)))
|
||||||
|
|
||||||
;; These gnc:account-get-xxx functions will be relpaced when the tax
|
|
||||||
;; and txf information gets its own account fields, and is no longer
|
|
||||||
;; in the notes field.
|
|
||||||
|
|
||||||
;; This is a bit of a fudge, matching against strings in account notes.
|
|
||||||
;; It'd be better if these were unique account fields.
|
|
||||||
(define (gnc:account-get-tax account)
|
|
||||||
(let* ((notes (gnc:account-get-notes account)))
|
|
||||||
(string-search? (if notes notes "") tax-key 0)))
|
|
||||||
|
|
||||||
(define (gnc:account-get-txf account)
|
|
||||||
(let* ((notes (gnc:account-get-notes account)))
|
|
||||||
(set! txf-notes (if notes notes ""))
|
|
||||||
(set! txf-pos (string-search txf-notes tax-end-key 0))
|
|
||||||
(if txf-pos
|
|
||||||
(begin (set! tax-pos (+ (string-search txf-notes tax-key 0)
|
|
||||||
(string-length tax-key)))
|
|
||||||
#t)
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
;; NOTE: You must call gnc:account-get-txf FIRST, or the txf-notes, tax-pos,
|
|
||||||
;; and txf-pos variables will not be valid!!
|
|
||||||
(define (gnc:account-get-txf-code account)
|
(define (gnc:account-get-txf-code account)
|
||||||
(if txf-pos
|
(let ((code (gnc:account-get-tax-US-code account)))
|
||||||
(substring txf-notes (- txf-pos 4) txf-pos)
|
(string->symbol (if code code "N000"))))
|
||||||
"000"))
|
|
||||||
(define (gnc:account-get-txf-format account)
|
(define (gnc:get-txf-format code income?)
|
||||||
(if txf-pos
|
(gnc:txf-get-format (if income?
|
||||||
(string->number (substring txf-notes (- txf-pos 8) (- txf-pos 7)))
|
txf-income-categories
|
||||||
0))
|
txf-expense-categories)
|
||||||
|
code))
|
||||||
|
|
||||||
(define (gnc:account-get-txf-payer-source account)
|
(define (gnc:account-get-txf-payer-source account)
|
||||||
(if txf-pos
|
(let ((pns (gnc:account-get-tax-US-payer-name-source account)))
|
||||||
(substring txf-notes tax-pos (+ 1 tax-pos))
|
(string->symbol (if pns pns "none"))))
|
||||||
" "))
|
|
||||||
(define (gnc:account-get-txf-string account)
|
|
||||||
(if txf-pos
|
|
||||||
(substring txf-notes tax-pos txf-pos)
|
|
||||||
" "))
|
|
||||||
|
|
||||||
;; because we use the list-option input structure, we have to build our own
|
;; because we use the list-option input structure, we have to build our own
|
||||||
;; search function
|
;; search function
|
||||||
@ -310,179 +205,6 @@
|
|||||||
(list-ref txf-list 0)
|
(list-ref txf-list 0)
|
||||||
(list-ref txf-list i)))))
|
(list-ref txf-list i)))))
|
||||||
|
|
||||||
;; return a string to insert in account-notes, or an error symbol
|
|
||||||
;; We only want one, but list-option returns a list.
|
|
||||||
(define (txf-string code-lst categories-lst)
|
|
||||||
(cond ((or (null? code-lst)
|
|
||||||
(not (symbol? (car code-lst))))
|
|
||||||
'none)
|
|
||||||
((> (length code-lst) 1) ; only allow ONE selection at a time
|
|
||||||
'mult) ; The GUI should exclude this
|
|
||||||
((eq? 'N000 (car code-lst))
|
|
||||||
#f)
|
|
||||||
(else
|
|
||||||
(let ((txf-vec (txfq-ref (car code-lst) categories-lst)))
|
|
||||||
(if txf-vec
|
|
||||||
(let ((str (vector-ref txf-vec 1)))
|
|
||||||
(if (equal? "#" (substring str 0 1))
|
|
||||||
'notyet ; not implimented yet
|
|
||||||
(string-append str " \\ "
|
|
||||||
(number->string (vector-ref txf-vec 3))
|
|
||||||
" \\ " (symbol->string
|
|
||||||
(car code-lst))))))))))
|
|
||||||
|
|
||||||
;; print txf help strings
|
|
||||||
(define (txf-print-help table vect inc)
|
|
||||||
(let* ((markup (if inc "income" "expense"))
|
|
||||||
(form-desc (vector-ref vect 1))
|
|
||||||
(code (symbol->string (vector-ref vect 0)))
|
|
||||||
(desc-len (string-length form-desc))
|
|
||||||
(bslash (string-search form-desc "\\" 0))
|
|
||||||
(form (substring form-desc 0 (+ bslash 2)))
|
|
||||||
(desc (substring form-desc (+ bslash 2) desc-len))
|
|
||||||
(help (vector-ref vect 2)))
|
|
||||||
(gnc:html-table-append-row!
|
|
||||||
table
|
|
||||||
(list
|
|
||||||
(gnc:make-html-table-cell
|
|
||||||
(gnc:make-html-text
|
|
||||||
(gnc:html-markup markup
|
|
||||||
(gnc:html-markup-b form)
|
|
||||||
code
|
|
||||||
(gnc:html-markup-br)
|
|
||||||
desc)))
|
|
||||||
(gnc:make-html-table-cell
|
|
||||||
(gnc:make-html-text
|
|
||||||
(gnc:html-markup markup help)))))))
|
|
||||||
|
|
||||||
;; Set or Reset txf string in account notes. str == #f resets.
|
|
||||||
;; Returns a code that indicates the function executed.
|
|
||||||
(define (txf-status account key end-key str)
|
|
||||||
(let ((key-len (string-length key))
|
|
||||||
(end-len (string-length end-key)))
|
|
||||||
(let* ((notes (gnc:account-get-notes account))
|
|
||||||
(notes (if notes notes ""))
|
|
||||||
(key-start (string-search notes key 0))
|
|
||||||
(end-start (string-search notes end-key 0))
|
|
||||||
(notes-len (string-length notes)))
|
|
||||||
|
|
||||||
;; 8 conditions: (key-start, end-start, str) function
|
|
||||||
;; #f #f #f nothing
|
|
||||||
;; num #f #f nothing
|
|
||||||
;; #f num #f nothing (illegal)
|
|
||||||
;; #f num str nothing (illegal)
|
|
||||||
;; num num #f reset
|
|
||||||
;; num num str replace
|
|
||||||
;; #f #f str set, tax too
|
|
||||||
;; num #f str set
|
|
||||||
|
|
||||||
(if key-start
|
|
||||||
(let ((key-end (+ key-start key-len)))
|
|
||||||
(cond ((and end-start (not str))
|
|
||||||
;; reset txf status
|
|
||||||
(let ((ret-val 'remove))
|
|
||||||
(gnc:account-set-notes
|
|
||||||
account (string-append (substring notes 0 key-end)
|
|
||||||
(substring
|
|
||||||
notes (+ end-start end-len)
|
|
||||||
notes-len)))
|
|
||||||
ret-val))
|
|
||||||
((and end-start str)
|
|
||||||
;; replace txf status with str
|
|
||||||
(let ((ret-val 'replace))
|
|
||||||
(gnc:account-set-notes
|
|
||||||
account (string-append (substring notes 0 key-end)
|
|
||||||
str
|
|
||||||
(substring notes end-start
|
|
||||||
notes-len)))
|
|
||||||
ret-val))
|
|
||||||
((and (not end-start) str)
|
|
||||||
;; set str and end-key
|
|
||||||
(let ((ret-val 'add))
|
|
||||||
(gnc:account-set-notes
|
|
||||||
account (string-append (substring notes 0 key-end)
|
|
||||||
str end-key
|
|
||||||
(substring notes key-end
|
|
||||||
notes-len)))
|
|
||||||
ret-val))
|
|
||||||
(else
|
|
||||||
'none1)))
|
|
||||||
(if (and (not end-start) str)
|
|
||||||
;; insert key, str and end-key
|
|
||||||
(let ((ret-val 'both))
|
|
||||||
(gnc:account-set-notes account (string-append
|
|
||||||
key str end-key notes))
|
|
||||||
ret-val)
|
|
||||||
'none2)))))
|
|
||||||
|
|
||||||
;; execute the selected function on the account. Return a list
|
|
||||||
;; containing the function code executed and the txf-string or error message
|
|
||||||
(define (txf-function acc txf-inc txf-exp txf-payer)
|
|
||||||
(if acc
|
|
||||||
(let ((txf-type (gw:enum-<gnc:AccountType>-val->sym
|
|
||||||
(gnc:account-get-type acc) #f)))
|
|
||||||
(if (gnc:account-is-inc-exp? acc)
|
|
||||||
(let* ((str (if (eq? txf-type 'income)
|
|
||||||
(txf-string txf-inc
|
|
||||||
txf-income-categories)
|
|
||||||
(txf-string txf-exp
|
|
||||||
txf-expense-categories)))
|
|
||||||
(fun (case str
|
|
||||||
((mult)
|
|
||||||
(set! str
|
|
||||||
"multiple TXF codes were selected,")
|
|
||||||
'none)
|
|
||||||
((none)
|
|
||||||
(set! str "no TXF code was selected,")
|
|
||||||
'none)
|
|
||||||
((notyet)
|
|
||||||
(set! str
|
|
||||||
"selected TXF code is not implimented yet,")
|
|
||||||
'none)
|
|
||||||
(else
|
|
||||||
(begin
|
|
||||||
(if (and str (not (eq? txf-payer 'default))
|
|
||||||
(txf-payer? (substring str 0 1)))
|
|
||||||
(let ((payer (case txf-payer
|
|
||||||
((current) "<")
|
|
||||||
((parent) "^")))
|
|
||||||
(len (string-length str)))
|
|
||||||
(set! str (string-append
|
|
||||||
payer
|
|
||||||
(substring str 1 len)))))
|
|
||||||
(txf-status acc tax-key tax-end-key str))))))
|
|
||||||
;; make "<" char html compatable
|
|
||||||
(if str
|
|
||||||
(set! str (string-substitute str "<" "<" 0)))
|
|
||||||
(list fun str))
|
|
||||||
(list 'notIE "txf-account not of type income or expense")))
|
|
||||||
(list 'noAcc "no txf-account")))
|
|
||||||
|
|
||||||
;; generate a feedback string for the txf function executed
|
|
||||||
(define (txf-feedback-str fun-str full-name)
|
|
||||||
(case (car fun-str)
|
|
||||||
((none none1 none2 notIE)
|
|
||||||
(string-append "No TXF init function"
|
|
||||||
(if (cadr fun-str)
|
|
||||||
(string-append " because, " (cadr fun-str))
|
|
||||||
"")
|
|
||||||
" for account: \"" full-name "\""))
|
|
||||||
((noAcc)
|
|
||||||
(string-append "No TXF init function because, " (cadr fun-str)))
|
|
||||||
((remove)
|
|
||||||
(string-append "The TXF code was removed from account: \""
|
|
||||||
full-name "\""))
|
|
||||||
((replace)
|
|
||||||
(string-append "The TXF code: \"" (cadr fun-str) "\", replaced the "
|
|
||||||
"existing code from account: \"" full-name "\""))
|
|
||||||
((add)
|
|
||||||
(string-append "The TXF code: \"" (cadr fun-str)
|
|
||||||
"\", was added to account: \"" full-name "\""))
|
|
||||||
((both)
|
|
||||||
(string-append "TAX status was set and the TXF code: \""
|
|
||||||
(cadr fun-str) "\", was added to account: \""
|
|
||||||
full-name "\""))))
|
|
||||||
|
|
||||||
;; check for duplicate txf codes
|
;; check for duplicate txf codes
|
||||||
(define (txf-check-dups account)
|
(define (txf-check-dups account)
|
||||||
(let* ((code (string->symbol (gnc:account-get-txf-code account)))
|
(let* ((code (string->symbol (gnc:account-get-txf-code account)))
|
||||||
@ -496,21 +218,22 @@
|
|||||||
|
|
||||||
;; Print error message for duplicate txf codes and accounts
|
;; Print error message for duplicate txf codes and accounts
|
||||||
(define (txf-print-dups doc)
|
(define (txf-print-dups doc)
|
||||||
(let ((dups (apply append
|
(let ((dups
|
||||||
(map (lambda (x)
|
(apply append
|
||||||
(let ((cnt (length (cdr x))))
|
(map (lambda (x)
|
||||||
(if (> cnt 1)
|
(let ((cnt (length (cdr x))))
|
||||||
(let* ((acc (cadr x))
|
(if (> cnt 1)
|
||||||
(txf (gnc:account-get-txf acc)))
|
(let* ((acc (cadr x))
|
||||||
(cons (string-append
|
(txf (gnc:account-get-txf acc)))
|
||||||
"Code \""
|
(cons (string-append
|
||||||
(gnc:account-get-txf-string acc)
|
"Code \""
|
||||||
"\" has duplicates in "
|
(gnc:account-get-txf-code acc)
|
||||||
(number->string cnt) " accounts:")
|
"\" has duplicates in "
|
||||||
(map gnc:account-get-full-name
|
(number->string cnt) " accounts:")
|
||||||
(cdr x))))
|
(map gnc:account-get-full-name
|
||||||
'())))
|
(cdr x))))
|
||||||
txf-dups-alist)))
|
'())))
|
||||||
|
txf-dups-alist)))
|
||||||
(text (gnc:make-html-text)))
|
(text (gnc:make-html-text)))
|
||||||
(if (not (null? dups))
|
(if (not (null? dups))
|
||||||
(begin
|
(begin
|
||||||
@ -548,9 +271,9 @@
|
|||||||
(strftime "%m/%d/%Y" (localtime (car date)))
|
(strftime "%m/%d/%Y" (localtime (car date)))
|
||||||
#f))
|
#f))
|
||||||
;; Only formats 1,3 implimented now! Others are treated as 1.
|
;; Only formats 1,3 implimented now! Others are treated as 1.
|
||||||
(format (gnc:account-get-txf-format account))
|
(format (gnc:get-txf-format code (eq? type 'income)))
|
||||||
(payer-src (gnc:account-get-txf-payer-source account))
|
(payer-src (gnc:account-get-txf-payer-source account))
|
||||||
(account-name (if (equal? payer-src "^")
|
(account-name (if (eq? payer-src 'parent)
|
||||||
(gnc:account-get-name
|
(gnc:account-get-name
|
||||||
(gnc:group-get-parent
|
(gnc:group-get-parent
|
||||||
(gnc:account-get-parent account)))
|
(gnc:account-get-parent account)))
|
||||||
@ -626,7 +349,7 @@
|
|||||||
;; Returns the Parent if a child or grandchild is valid.
|
;; Returns the Parent if a child or grandchild is valid.
|
||||||
(define (validate accounts)
|
(define (validate accounts)
|
||||||
(apply append (map (lambda (a)
|
(apply append (map (lambda (a)
|
||||||
(if (gnc:account-get-tax a)
|
(if (gnc:account-get-tax-related a)
|
||||||
(list a)
|
(list a)
|
||||||
;; check children
|
;; check children
|
||||||
(if (null? (validate
|
(if (null? (validate
|
||||||
@ -828,7 +551,7 @@
|
|||||||
|
|
||||||
(if (gnc:account-is-inc-exp? account)
|
(if (gnc:account-is-inc-exp? account)
|
||||||
(let ((children (gnc:account-get-children account))
|
(let ((children (gnc:account-get-children account))
|
||||||
(account-balance (if (gnc:account-get-tax account)
|
(account-balance (if (gnc:account-get-tax-related account)
|
||||||
(gnc:account-get-balance-interval
|
(gnc:account-get-balance-interval
|
||||||
account from-value to-value #f)
|
account from-value to-value #f)
|
||||||
0))) ; don't add non tax related
|
0))) ; don't add non tax related
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user