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>
|
||||
|
||||
* src/scm/report/report-list.scm, Makefile.am: Added new file.
|
||||
@ -32,7 +67,6 @@
|
||||
* src/engine/gnc-pricedb.[ch]: added
|
||||
gnc_pricedb_lookup_nearest_in_time, courtesy Rob B.
|
||||
|
||||
|
||||
2001-03-28 James LewisMoss <jimdres@mindspring.com>
|
||||
|
||||
* src/test/gnc-test-stuff.c (get_random_split): set a share
|
||||
|
||||
@ -881,7 +881,7 @@ sr_balance_trans (SplitRegister *reg, Transaction *trans)
|
||||
xaccTransScrubImbalance (trans, gncGetCurrentGroup (),
|
||||
default_account);
|
||||
break;
|
||||
|
||||
|
||||
case 3:
|
||||
xaccTransScrubImbalance (trans, gncGetCurrentGroup (),
|
||||
other_account);
|
||||
@ -986,7 +986,14 @@ LedgerMoveCursor (Table *table, VirtualLocation *p_new_virt_loc)
|
||||
(pending_trans == old_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))
|
||||
xaccTransCommitEdit (old_trans);
|
||||
|
||||
@ -314,7 +314,7 @@ count_coms(gpointer key, gpointer value, gpointer user_data)
|
||||
GHashTable *tbl = ((gnc_commodity_namespace*)value)->table;
|
||||
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 */
|
||||
return;
|
||||
|
||||
@ -41,9 +41,10 @@ EXTRA_DIST = \
|
||||
README \
|
||||
$(RPCGEN_SRCS)
|
||||
|
||||
INCLUDES = -I.. -I/usr/lib/glib/include
|
||||
INCLUDES = -I..
|
||||
|
||||
LDFLAGS = -lpthread
|
||||
LDADD = -lpthread
|
||||
CFLAGS = @CFLAGS@ ${GLIB_CFLAGS}
|
||||
|
||||
#RPCGEN=rpcgen -M
|
||||
RPCGEN=rpcgen
|
||||
|
||||
@ -799,7 +799,7 @@ gnc_commoditylist * rpcend_build_gnccommoditylist (gnc_commodity_table *ct,
|
||||
GList *cl, *this_cl;
|
||||
|
||||
/* Ignore all the ISO4217 commodities */
|
||||
if (!strcmp (namespace, "ISO4217"))
|
||||
if (!strcmp (namespace, GNC_COMMODITY_NS_ISO))
|
||||
continue;
|
||||
|
||||
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");
|
||||
}
|
||||
|
||||
void rpcend_do_free_gncquery (gncQuery *gq, gboolean isRpc)
|
||||
static void rpcend_do_free_gncquery (gncQuery *gq, gboolean isRpc)
|
||||
{
|
||||
gncQTOrlist *orlist, *nextor;
|
||||
|
||||
|
||||
@ -516,6 +516,8 @@ gnc_html_embedded_barchart(gnc_html * parent,
|
||||
char ** callbacks=NULL;
|
||||
char * gtitle = NULL;
|
||||
|
||||
chart->parent = parent;
|
||||
|
||||
if((param = g_hash_table_lookup(params, "data_rows")) != NULL) {
|
||||
sscanf(param, "%d", &datarows);
|
||||
arglist[argind].name = "data_rows";
|
||||
@ -611,11 +613,11 @@ gnc_html_embedded_barchart(gnc_html * parent,
|
||||
g_free(callbacks);
|
||||
}
|
||||
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;
|
||||
GTK_VALUE_POINTER(arglist[argind]) = &guppi_bar_2_callback;
|
||||
argind++;
|
||||
arglist[argind].name = "bar_callback1_data";
|
||||
arglist[argind].name = "bar_callback2_data";
|
||||
arglist[argind].type = GTK_TYPE_POINTER;
|
||||
GTK_VALUE_POINTER(arglist[argind]) = chart;
|
||||
argind++;
|
||||
@ -626,11 +628,11 @@ gnc_html_embedded_barchart(gnc_html * parent,
|
||||
g_free(callbacks);
|
||||
}
|
||||
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;
|
||||
GTK_VALUE_POINTER(arglist[argind]) = &guppi_bar_3_callback;
|
||||
argind++;
|
||||
arglist[argind].name = "bar_callback1_data";
|
||||
arglist[argind].name = "bar_callback3_data";
|
||||
arglist[argind].type = GTK_TYPE_POINTER;
|
||||
GTK_VALUE_POINTER(arglist[argind]) = chart;
|
||||
argind++;
|
||||
@ -744,6 +746,8 @@ gnc_html_embedded_scatter(gnc_html * parent,
|
||||
double * y_data=NULL;
|
||||
char * gtitle = NULL;
|
||||
|
||||
chart->parent = parent;
|
||||
|
||||
if((param = g_hash_table_lookup(params, "datasize")) != NULL) {
|
||||
sscanf(param, "%d", &datasize);
|
||||
arglist[argind].name = "data_size";
|
||||
|
||||
@ -28,6 +28,9 @@
|
||||
#include <guile/gh.h>
|
||||
#include <popt.h>
|
||||
#include <stdlib.h>
|
||||
#ifdef GTKHTML_HAVE_GCONF
|
||||
#include <gconf/gconf.h>
|
||||
#endif
|
||||
|
||||
#include "AccWindow.h"
|
||||
#include "FileBox.h"
|
||||
@ -179,6 +182,10 @@ gnucash_ui_init(void)
|
||||
char **restargv2;
|
||||
poptContext returnedPoptContext;
|
||||
|
||||
#ifdef GTKHTML_HAVE_GCONF
|
||||
GError *gerror;
|
||||
#endif
|
||||
|
||||
ENTER ("\n");
|
||||
|
||||
/* 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);
|
||||
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 */
|
||||
poptFreeContext (returnedPoptContext);
|
||||
gnc_free_argv (restargv);
|
||||
|
||||
@ -272,12 +272,29 @@
|
||||
(display escaped)
|
||||
(display " ")))
|
||||
nlist)))))
|
||||
|
||||
|
||||
|
||||
(let* ((retval '())
|
||||
(push (lambda (l) (set! retval (cons l retval))))
|
||||
(title (gnc:html-barchart-title 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))
|
||||
(y-label (gnc:html-barchart-y-axis-label barchart))
|
||||
(data (gnc:html-barchart-data barchart))
|
||||
@ -303,6 +320,36 @@
|
||||
(begin
|
||||
(push " <param name=\"subtitle\" value=\"")
|
||||
(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))
|
||||
(let ((rows (length data))
|
||||
(cols 0))
|
||||
@ -360,4 +407,3 @@
|
||||
(push "</object> \n"))
|
||||
" ")
|
||||
retval))
|
||||
|
||||
|
||||
@ -293,7 +293,7 @@
|
||||
;; "" tags mean "show no tag"; #f tags means use default.
|
||||
(cond ((not tag)
|
||||
(set! tag markup))
|
||||
((string=? tag "")
|
||||
((and (string? tag) (string=? tag ""))
|
||||
(set! tag #f)))
|
||||
(let* ((retval '())
|
||||
(push (lambda (l) (set! retval (cons l retval)))))
|
||||
|
||||
@ -140,7 +140,8 @@
|
||||
((string? rendered-elt)
|
||||
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
|
||||
(simple-format "hold on there podner. form='~s'\n" rendered-elt)
|
||||
""))))
|
||||
|
||||
@ -14,7 +14,6 @@ gncscm_DATA = \
|
||||
report-list.scm \
|
||||
stylesheet-fancy.scm \
|
||||
stylesheet-plain.scm \
|
||||
table-test.scm \
|
||||
taxtxf.scm \
|
||||
transaction-report.scm \
|
||||
txf-export-help.scm \
|
||||
|
||||
@ -347,11 +347,9 @@
|
||||
other-anchor
|
||||
(gnc:account-anchor-text (car pair))))
|
||||
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-legend-urls! chart urls))
|
||||
|
||||
|
||||
(gnc:html-document-add-object! document chart)
|
||||
document)))
|
||||
|
||||
|
||||
@ -16,7 +16,7 @@
|
||||
(add-option
|
||||
(lambda (new-option)
|
||||
(gnc:register-option options new-option))))
|
||||
|
||||
|
||||
(add-option
|
||||
(gnc:make-date-option
|
||||
"General" "Date"
|
||||
@ -30,8 +30,9 @@
|
||||
"General" "Accounts"
|
||||
"b"
|
||||
"Stock Accounts to report on"
|
||||
(lambda () (filter gnc:account-is-stock? (gnc:group-get-account-list
|
||||
(gnc:get-current-group))))
|
||||
(lambda () (filter gnc:account-is-stock?
|
||||
(gnc:group-get-subaccounts
|
||||
(gnc:get-current-group))))
|
||||
(lambda (accounts) (list #t (filter gnc:account-is-stock? accounts)))
|
||||
#t))
|
||||
|
||||
@ -46,7 +47,7 @@
|
||||
|
||||
(gnc:options-set-default-section options "General")
|
||||
options))
|
||||
|
||||
|
||||
;; This is the rendering function. It accepts a database of options
|
||||
;; and generates an object of type <html-document>. See the file
|
||||
;; report-html.txt for documentation; the file report-html.scm
|
||||
@ -62,7 +63,8 @@
|
||||
(define (op-value 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
|
||||
(let* ((current (car accounts))
|
||||
(rest (cdr accounts))
|
||||
@ -70,39 +72,41 @@
|
||||
(commodity (gnc:account-get-commodity current))
|
||||
(ticker-symbol (gnc:commodity-get-mnemonic 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)))
|
||||
|
||||
(price (gnc:price-get-value
|
||||
(gnc:pricedb-lookup-nearest-in-time pricedb
|
||||
commodity
|
||||
currency
|
||||
to-date)))
|
||||
|
||||
(value-num (gnc:numeric-mul units
|
||||
price
|
||||
(gnc:commodity-get-fraction currency)
|
||||
GNC-RND-ROUND))
|
||||
(dummy (begin
|
||||
(gnc:warn "price " price)
|
||||
(gnc:warn "units " units)
|
||||
(gnc:warn "value-num" value-num)))
|
||||
(value (gnc:make-gnc-monetary currency
|
||||
value-num)))
|
||||
|
||||
(price (gnc:pricedb-lookup-nearest-in-time pricedb
|
||||
commodity
|
||||
currency
|
||||
to-date))
|
||||
|
||||
(price-value (if price
|
||||
(gnc:price-get-value price)
|
||||
(gnc:numeric-zero)))
|
||||
|
||||
(value-num (gnc:numeric-mul
|
||||
units
|
||||
price-value
|
||||
(gnc:commodity-get-fraction currency)
|
||||
GNC-RND-ROUND))
|
||||
|
||||
(value (gnc:make-gnc-monetary currency value-num)))
|
||||
(collector 'add currency value-num)
|
||||
(gnc:html-table-append-row! table (list name
|
||||
ticker-symbol
|
||||
listing
|
||||
(gnc:numeric-to-double units)
|
||||
(gnc:make-gnc-monetary
|
||||
currency
|
||||
price)
|
||||
value
|
||||
)
|
||||
)
|
||||
(table-add-stock-rows table rest to-date currency pricedb collector))))
|
||||
|
||||
|
||||
(gnc:html-table-append-row!
|
||||
table
|
||||
(list name
|
||||
ticker-symbol
|
||||
listing
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell" (gnc:numeric-to-double units))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell" (gnc:make-gnc-monetary currency price-value))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"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
|
||||
;; options in the set of options given to the function. This set will
|
||||
;; be generated by the options generator above.
|
||||
@ -114,47 +118,58 @@
|
||||
(table (gnc:make-html-table))
|
||||
(document (gnc:make-html-document))
|
||||
(pricedb (gnc:book-get-pricedb (gnc:get-current-book))))
|
||||
|
||||
|
||||
|
||||
(gnc:html-document-set-title! document (sprintf #f
|
||||
(_ "Investment Portfolio Report: %s")
|
||||
(gnc:timepair-to-datestring to-date)))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
document (sprintf #f
|
||||
(_ "Investment Portfolio Report: %s")
|
||||
(gnc:timepair-to-datestring to-date)))
|
||||
|
||||
(gnc:html-table-set-col-headers!
|
||||
table
|
||||
(list
|
||||
(N_ "Account")
|
||||
(N_ "Symbol")
|
||||
(N_ "Listing")
|
||||
(N_ "Units")
|
||||
(N_ "Price")
|
||||
(N_ "Value")))
|
||||
|
||||
(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)
|
||||
(list (_ "Account")
|
||||
(_ "Symbol")
|
||||
(_ "Listing")
|
||||
(_ "Units")
|
||||
(_ "Price")
|
||||
(_ "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)
|
||||
|
||||
(gnc:html-document-add-object! document table)
|
||||
|
||||
document))
|
||||
|
||||
(gnc:define-report
|
||||
|
||||
|
||||
;; The version of this report.
|
||||
'version 1
|
||||
|
||||
|
||||
;; The name of this report. This will be used, among other things,
|
||||
;; for making its menu item in the main menu. You need to use the
|
||||
;; untranslated value here!
|
||||
'name (N_ "Investment Portfolio")
|
||||
|
||||
|
||||
;; The options generator function defined above.
|
||||
'options-generator options-generator
|
||||
|
||||
|
||||
;; The rendering function defined above.
|
||||
'renderer portfolio-renderer))
|
||||
|
||||
|
||||
@ -21,7 +21,6 @@
|
||||
(equal? locale "en_US"))
|
||||
(gnc:depend "report/taxtxf.scm")))
|
||||
(gnc:depend "report/transaction-report.scm")
|
||||
(gnc:depend "report/table-test.scm")
|
||||
|
||||
;; style sheets
|
||||
(gnc:depend "report/stylesheet-plain.scm")
|
||||
|
||||
@ -110,6 +110,15 @@
|
||||
'tag "th"
|
||||
'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>
|
||||
(if (not links?)
|
||||
(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
|
||||
((string? item) (display item port))
|
||||
((null? item) #t)
|
||||
((list? item) (map (lambda (item) (gnc:display-report-list-item item port
|
||||
warn-msg))
|
||||
((list? item) (map (lambda (item)
|
||||
(gnc:display-report-list-item item port warn-msg))
|
||||
item))
|
||||
(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)
|
||||
((vector-ref levelx-collector (- level 1)) action value))
|
||||
|
||||
@ -196,109 +166,34 @@
|
||||
tab-title (N_ "Print Full account names")
|
||||
"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*)
|
||||
|
||||
(define tax-key "{tax}")
|
||||
|
||||
(define tax-end-key "{/tax}")
|
||||
|
||||
;; 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
|
||||
; codes from the same payer are
|
||||
; grouped in the accounts list
|
||||
(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
|
||||
(define txf-dups-alist '())
|
||||
|
||||
(define (txf-payer? str)
|
||||
(member str '("<" "^")))
|
||||
(define (txf-payer? payer)
|
||||
(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)
|
||||
(if txf-pos
|
||||
(substring txf-notes (- txf-pos 4) txf-pos)
|
||||
"000"))
|
||||
(define (gnc:account-get-txf-format account)
|
||||
(if txf-pos
|
||||
(string->number (substring txf-notes (- txf-pos 8) (- txf-pos 7)))
|
||||
0))
|
||||
(let ((code (gnc:account-get-tax-US-code account)))
|
||||
(string->symbol (if code code "N000"))))
|
||||
|
||||
(define (gnc:get-txf-format code income?)
|
||||
(gnc:txf-get-format (if income?
|
||||
txf-income-categories
|
||||
txf-expense-categories)
|
||||
code))
|
||||
|
||||
(define (gnc:account-get-txf-payer-source account)
|
||||
(if txf-pos
|
||||
(substring txf-notes tax-pos (+ 1 tax-pos))
|
||||
" "))
|
||||
(define (gnc:account-get-txf-string account)
|
||||
(if txf-pos
|
||||
(substring txf-notes tax-pos txf-pos)
|
||||
" "))
|
||||
(let ((pns (gnc:account-get-tax-US-payer-name-source account)))
|
||||
(string->symbol (if pns pns "none"))))
|
||||
|
||||
;; because we use the list-option input structure, we have to build our own
|
||||
;; search function
|
||||
@ -310,179 +205,6 @@
|
||||
(list-ref txf-list 0)
|
||||
(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
|
||||
(define (txf-check-dups account)
|
||||
(let* ((code (string->symbol (gnc:account-get-txf-code account)))
|
||||
@ -496,21 +218,22 @@
|
||||
|
||||
;; Print error message for duplicate txf codes and accounts
|
||||
(define (txf-print-dups doc)
|
||||
(let ((dups (apply append
|
||||
(map (lambda (x)
|
||||
(let ((cnt (length (cdr x))))
|
||||
(if (> cnt 1)
|
||||
(let* ((acc (cadr x))
|
||||
(txf (gnc:account-get-txf acc)))
|
||||
(cons (string-append
|
||||
"Code \""
|
||||
(gnc:account-get-txf-string acc)
|
||||
"\" has duplicates in "
|
||||
(number->string cnt) " accounts:")
|
||||
(map gnc:account-get-full-name
|
||||
(cdr x))))
|
||||
'())))
|
||||
txf-dups-alist)))
|
||||
(let ((dups
|
||||
(apply append
|
||||
(map (lambda (x)
|
||||
(let ((cnt (length (cdr x))))
|
||||
(if (> cnt 1)
|
||||
(let* ((acc (cadr x))
|
||||
(txf (gnc:account-get-txf acc)))
|
||||
(cons (string-append
|
||||
"Code \""
|
||||
(gnc:account-get-txf-code acc)
|
||||
"\" has duplicates in "
|
||||
(number->string cnt) " accounts:")
|
||||
(map gnc:account-get-full-name
|
||||
(cdr x))))
|
||||
'())))
|
||||
txf-dups-alist)))
|
||||
(text (gnc:make-html-text)))
|
||||
(if (not (null? dups))
|
||||
(begin
|
||||
@ -548,9 +271,9 @@
|
||||
(strftime "%m/%d/%Y" (localtime (car date)))
|
||||
#f))
|
||||
;; 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))
|
||||
(account-name (if (equal? payer-src "^")
|
||||
(account-name (if (eq? payer-src 'parent)
|
||||
(gnc:account-get-name
|
||||
(gnc:group-get-parent
|
||||
(gnc:account-get-parent account)))
|
||||
@ -626,7 +349,7 @@
|
||||
;; Returns the Parent if a child or grandchild is valid.
|
||||
(define (validate accounts)
|
||||
(apply append (map (lambda (a)
|
||||
(if (gnc:account-get-tax a)
|
||||
(if (gnc:account-get-tax-related a)
|
||||
(list a)
|
||||
;; check children
|
||||
(if (null? (validate
|
||||
@ -828,7 +551,7 @@
|
||||
|
||||
(if (gnc:account-is-inc-exp? 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
|
||||
account from-value to-value #f)
|
||||
0))) ; don't add non tax related
|
||||
|
||||
Loading…
Reference in New Issue
Block a user