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

* src/scm/report/report-list.scm: load tax report if possibly in

Browse Source 
US locale.

	* src/scm/report/taxtxf.scm: work on tax report (unfinished)

	* src/scm/report/hello-world.scm: use new html format functions.
	Add scheme reference.

	* src/gnome/dialog-fincalc.c (gnc_ui_fincalc_dialog_create): hide
	schedule button. Use 'lookup_widget'.

	* src/gnome/gnc-html.c (gnc_html_export): handle cancelling

	* src/scm/html-style-info.scm: remove cruft


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3761 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-03-08 11:24:36 +00:00
parent 2921fad829
commit cad90da64b
11 changed files with 503 additions and 458 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
ChangeLog
View File

@ -1,10 +1,26 @@
<<<<<<< ChangeLog
2001-03-08 Dave Peticolas <dave@krondo.com>
* src/scm/report/report-list.scm: load tax report if possibly in
US locale.
* src/scm/report/taxtxf.scm: work on tax report (unfinished)
2001-03-07 Dave Peticolas <dave@krondo.com>
* src/scm/report/hello-world.scm: use new html format functions.
Add scheme reference.
* src/gnome/dialog-fincalc.c (gnc_ui_fincalc_dialog_create): hide
schedule button. Use 'lookup_widget'.
* src/gnome/gnc-html.c (gnc_html_export): handle cancelling
* src/scm/html-style-info.scm: remove cruft
2001-03-08 Robert Graham Merkel <rgmerk@mira.net>
* src/scm/report/transaction-report.scm: More colourization.
=======
2001-03-07 Bill Gribble <grib@billgribble.com>
* summary: separate the HTML and HTTP processing functions into
@ -42,7 +58,6 @@
(html-markup/format "%a %a %a %a" 1 2 3 4) does what you'd expect,
even if the non-format args are html-markup objects.
>>>>>>> 1.251
2001-03-07 Dave Peticolas <dave@krondo.com>
* src/gnome/top-level.c (gnc_ui_check_events): add timeout

47
src/gnome/dialog-fincalc.c
View File

@ -31,6 +31,7 @@
#include "finproto.h"
#include "finvar.h"
#include "glade-gnc-dialogs.h"
#include "glade-support.h"
#include "gnc-amount-edit.h"
#include "gnc-commodity.h"
#include "gnc-component-manager.h"
@ -528,7 +529,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[PAYMENT_PERIODS] = edit;
gtk_widget_show (edit);
hbox = gtk_object_get_data(fcdo, "payment_periods_hbox");
hbox = lookup_widget (fcd->dialog, "payment_periods_hbox");
gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -544,7 +545,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[INTEREST_RATE] = edit;
gtk_widget_show (edit);
hbox = gtk_object_get_data(fcdo, "interest_rate_hbox");
hbox = lookup_widget (fcd->dialog, "interest_rate_hbox");
gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -562,7 +563,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[PRESENT_VALUE] = edit;
gtk_widget_show (edit);
hbox = gtk_object_get_data(fcdo, "present_value_hbox");
hbox = lookup_widget (fcd->dialog, "present_value_hbox");
gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -578,7 +579,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[PERIODIC_PAYMENT] = edit;
gtk_widget_show (edit);
hbox = gtk_object_get_data(fcdo, "periodic_payment_hbox");
hbox = lookup_widget (fcd->dialog, "periodic_payment_hbox");
gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -594,7 +595,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[FUTURE_VALUE] = edit;
gtk_widget_show (edit);
hbox = gtk_object_get_data(fcdo, "future_value_hbox");
hbox = lookup_widget (fcd->dialog, "future_value_hbox");
gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -602,83 +603,87 @@ gnc_ui_fincalc_dialog_create(void)
GTK_SIGNAL_FUNC(fincalc_entry_changed), fcd);
button = gtk_object_get_data(fcdo, "payment_periods_calc_button");
button = lookup_widget (fcd->dialog, "payment_periods_calc_button");
fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_payment_periods), fcd);
button = gtk_object_get_data(fcdo, "interest_rate_calc_button");
button = lookup_widget (fcd->dialog, "interest_rate_calc_button");
fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_interest_rate), fcd);
button = gtk_object_get_data(fcdo, "present_value_calc_button");
button = lookup_widget (fcd->dialog, "present_value_calc_button");
fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_present_value), fcd);
button = gtk_object_get_data(fcdo, "periodic_payment_calc_button");
button = lookup_widget (fcd->dialog, "periodic_payment_calc_button");
fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_periodic_payment), fcd);
button = gtk_object_get_data(fcdo, "future_value_calc_button");
button = lookup_widget (fcd->dialog, "future_value_calc_button");
fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_future_value), fcd);
button = gtk_object_get_data(fcdo, "payment_periods_clear_button");
button = lookup_widget (fcd->dialog, "payment_periods_clear_button");
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_entry_clear_clicked),
fcd->amounts[PAYMENT_PERIODS]);
button = gtk_object_get_data(fcdo, "interest_rate_clear_button");
button = lookup_widget (fcd->dialog, "interest_rate_clear_button");
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked),
fcd->amounts[INTEREST_RATE]);
button = gtk_object_get_data(fcdo, "present_value_clear_button");
button = lookup_widget (fcd->dialog, "present_value_clear_button");
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked),
fcd->amounts[PRESENT_VALUE]);
button = gtk_object_get_data(fcdo, "periodic_payment_clear_button");
button = lookup_widget (fcd->dialog, "periodic_payment_clear_button");
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked),
fcd->amounts[PERIODIC_PAYMENT]);
button = gtk_object_get_data(fcdo, "future_value_clear_button");
button = lookup_widget (fcd->dialog, "future_value_clear_button");
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked),
fcd->amounts[FUTURE_VALUE]);
menu = gtk_object_get_data(fcdo, "compounding_menu");
menu = lookup_widget (fcd->dialog, "compounding_menu");
fcd->compounding_menu = menu;
gnc_option_menu_init(menu);
menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(menu));
gtk_container_forall(GTK_CONTAINER(menu), connect_fincalc_menu_item, fcd);
menu = gtk_object_get_data(fcdo, "payment_menu");
menu = lookup_widget (fcd->dialog, "payment_menu");
fcd->payment_menu = menu;
gnc_option_menu_init(menu);
menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(menu));
gtk_container_forall(GTK_CONTAINER(menu), connect_fincalc_menu_item, fcd);
button = gtk_object_get_data(fcdo, "period_payment_radio");
button = lookup_widget (fcd->dialog, "period_payment_radio");
fcd->end_of_period_radio = button;
gtk_signal_connect(GTK_OBJECT(button), "toggled",
GTK_SIGNAL_FUNC(fincalc_radio_toggled), fcd);
button = gtk_object_get_data(fcdo, "discrete_compounding_radio");
button = lookup_widget (fcd->dialog, "discrete_compounding_radio");
fcd->discrete_compounding_radio = button;
gtk_signal_connect(GTK_OBJECT(button), "toggled",
GTK_SIGNAL_FUNC(fincalc_radio_toggled), fcd);
button = gtk_object_get_data(fcdo, "close_button");
button = lookup_widget (fcd->dialog, "close_button");
gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(close_button_clicked), fcd);
fcd->payment_total_label = gtk_object_get_data (fcdo, "payment_total_label");
fcd->payment_total_label = lookup_widget (fcd->dialog,
"payment_total_label");
button = lookup_widget (fcd->dialog, "schedule_button");
gtk_widget_hide (button);
init_fi(fcd);

9
src/gnome/gnc-html.c
View File

@ -244,7 +244,6 @@ extract_base_name(URLType type, const gchar * path) {
regex_t compiled_h, compiled_o;
regmatch_t match[4];
char * machine=NULL, * location = NULL, * base=NULL;
int free_location = 0;
regcomp(&compiled_h, http_rexp, REG_EXTENDED);
regcomp(&compiled_o, other_rexp, REG_EXTENDED);
@ -265,7 +264,6 @@ extract_base_name(URLType type, const gchar * path) {
location = g_new0(char, match[2].rm_eo - match[2].rm_so + 1);
strncpy(location, path+match[2].rm_so,
match[2].rm_eo - match[2].rm_so);
free_location = 1;
}
}
break;
@ -286,9 +284,7 @@ extract_base_name(URLType type, const gchar * path) {
regfree(&compiled_h);
regfree(&compiled_o);
if(free_location) {
g_free(location);
}
g_free(location);
if(machine) {
strcat(machine, "/");
@ -1100,6 +1096,9 @@ gnc_html_export(gnc_html * html) {
FILE *fh;
filepath = fileBox (_("Save HTML To File"), NULL, NULL);
if (!filepath)
return;
PINFO (" user selected file=%s\n", filepath);
fh = fopen (filepath, "w");
if (NULL == fh) {

158
src/scm/command-line.scm
View File

@ -115,86 +115,78 @@
#f
(N_ "Enable debugging mode"))
(cons
"loglevel"
(list 'integer
(lambda (val)
(gnc:config-var-value-set! gnc:*loglevel* #f val))
"LOGLEVEL"
(N_ "Set the logging level from 0 (least) to 6 (most)")))
(list "loglevel"
'integer
(lambda (val)
(gnc:config-var-value-set! gnc:*loglevel* #f val))
"LOGLEVEL"
(N_ "Set the logging level from 0 (least) to 6 (most)"))
(cons
"nofile"
(list 'boolean
(lambda (val)
(gnc:config-var-value-set! gnc:*arg-no-file* #f val))
#f
(N_ "Do not load the last file opened")))
(list "nofile"
'boolean
(lambda (val)
(gnc:config-var-value-set! gnc:*arg-no-file* #f val))
#f
(N_ "Do not load the last file opened"))
(cons
"config-dir"
(list 'string
(lambda (val)
(gnc:config-var-value-set! gnc:*config-dir* #f val))
"CONFIGDIR"
(N_ "Set configuration directory")))
(list "config-dir"
'string
(lambda (val)
(gnc:config-var-value-set! gnc:*config-dir* #f val))
"CONFIGDIR"
(N_ "Set configuration directory"))
(cons
"share-dir"
(list 'string
(lambda (val)
(gnc:config-var-value-set! gnc:*share-dir* #f val))
"SHAREDIR"
(N_ "Set shared directory")))
(list "share-dir"
'string
(lambda (val)
(gnc:config-var-value-set! gnc:*share-dir* #f val))
"SHAREDIR"
(N_ "Set shared directory"))
(cons
"load-path"
(list 'string
(lambda (val)
(let ((path-list
(call-with-input-string val (lambda (port) (read port)))))
(if (list? path-list)
(gnc:config-var-value-set! gnc:*load-path* #f path-list)
(begin
(gnc:error "non-list given for --load-path: " val)
(gnc:shutdown 1)))))
"LOADPATH"
(N_ "Set the search path for .scm files.")))
(list "load-path"
'string
(lambda (val)
(let ((path-list
(call-with-input-string val (lambda (port) (read port)))))
(if (list? path-list)
(gnc:config-var-value-set! gnc:*load-path* #f path-list)
(begin
(gnc:error "non-list given for --load-path: " val)
(gnc:shutdown 1)))))
"LOADPATH"
(N_ "Set the search path for .scm files."))
(cons
"doc-path"
(list 'string
(lambda (val)
(gnc:debug "parsing --doc-path " val)
(let ((path-list
(call-with-input-string val (lambda (port) (read port)))))
(if (list? path-list)
(gnc:config-var-value-set! gnc:*doc-path* #f path-list)
(begin
(gnc:error "non-list given for --doc-path: " val)
(gnc:shutdown 1)))))
"DOCPATH"
(N_ "Set the search path for documentation files")))
(list "doc-path"
'string
(lambda (val)
(gnc:debug "parsing --doc-path " val)
(let ((path-list
(call-with-input-string val (lambda (port) (read port)))))
(if (list? path-list)
(gnc:config-var-value-set! gnc:*doc-path* #f path-list)
(begin
(gnc:error "non-list given for --doc-path: " val)
(gnc:shutdown 1)))))
"DOCPATH"
(N_ "Set the search path for documentation files"))
(cons
"evaluate"
(list 'string
(lambda (val)
(set! gnc:*batch-mode-things-to-do*
(cons val gnc:*batch-mode-things-to-do*)))
"COMMAND"
(N_ "Evaluate the guile command")))
(list "evaluate"
'string
(lambda (val)
(set! gnc:*batch-mode-things-to-do*
(cons val gnc:*batch-mode-things-to-do*)))
"COMMAND"
(N_ "Evaluate the guile command"))
;; Given a string, --load will load the indicated file, if possible.
(cons
"load"
(list 'string
(lambda (val)
(set! gnc:*batch-mode-things-to-do*
(cons (lambda () (load val))
gnc:*batch-mode-things-to-do*)))
"FILE"
(N_ "Load the given .scm file")))
(list "load"
'string
(lambda (val)
(set! gnc:*batch-mode-things-to-do*
(cons (lambda () (load val))
gnc:*batch-mode-things-to-do*)))
"FILE"
(N_ "Load the given .scm file"))
; (cons "add-price-quotes"
; (cons 'string
@ -216,19 +208,17 @@
;
; gnc:*batch-mode-things-to-do*)))))
(cons
"load-user-config"
(list 'boolean
gnc:load-user-config-if-needed
#f
(N_ "Load the user configuation")))
(list "load-user-config"
'boolean
gnc:load-user-config-if-needed
#f
(N_ "Load the user configuation"))
(cons
"load-system-config"
(list 'boolean
gnc:load-system-config-if-needed
#f
(N_ "Load the system configuation")))))
(list "load-system-config"
'boolean
gnc:load-system-config-if-needed
#f
(N_ "Load the system configuation"))))
(define (gnc:cmd-line-get-boolean-arg args)
;; --arg means #t

8
src/scm/html-style-info.scm
View File

@ -278,7 +278,6 @@
(define (gnc:default-html-gnc-numeric-renderer datum params)
(gnc:amount->string-helper datum (gnc:default-print-info #f)))
; (sprintf #f "%.2f" (gnc:numeric-to-double datum)))
(define (gnc:default-html-gnc-monetary-renderer datum params)
(gnc:amount->string-helper
@ -290,13 +289,6 @@
(gnc:double-to-gnc-numeric datum 100 GNC-RND-ROUND)
(gnc:default-print-info #f)))
; (gnc:print-double-amount datum))
; (sprintf #f "%.2f" datum))
; (format #f "~,2f" datum))
; "(NUM)")
; (sprintf 20 "%.2f" datum))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <html-style-table> class

6
src/scm/report-html.txt
View File

@ -403,11 +403,7 @@ We have three different kinds of style control information available:
(gnc:html-document-render ssdoc)))
(gnc:define-html-style-sheet
'version 1.0
'version 1
'name "Sample Style Sheet"
'renderer sample-renderer
'options sample-options))

4
src/scm/report/Makefile.am
View File

@ -9,7 +9,11 @@ gncscm_DATA = \
report-list.scm \
stylesheet-plain.scm \
stylesheet-fancy.scm \
taxtxf.scm \
txf-export.scm \
txf-export-help.scm \
transaction-report.scm
EXTRA_DIST = \
.cvsignore \
${gncscm_DATA}

120
src/scm/report/hello-world.scm
View File

@ -300,7 +300,7 @@ option like this.")
;; current locale, then the translation is returned,
;; otherwise the original string is returned.
(gnc:html-document-set-title! document (_ "Hello, World"))
;; we make a "text object" to add a bunch of text to.
;; the function gnc:make-html-text can take any number of
;; arguments. The gnc:html-markup functions are designed
@ -308,67 +308,81 @@ option like this.")
;; the appearance of the report from the Gnucash UI; you
;; should use the HTML markup functions whenever possible
;; rather than including literal HTML in your report.
(gnc:html-document-add-object!
document
(gnc:make-html-text
(gnc:html-markup-p
(_ "This is a sample GnuCash report. \
See the guile (scheme) source code in ")
(gnc:html-markup-tt
gnc:_share-dir-default_ "/gnucash/scm/report")
(_ "for details on writing your own reports, \
or extending existing reports."))
(gnc:html-markup-p
(_ "For help on writing reports, or to contribute your brand \
new, totally cool report, consult the mailing list ")
(gnc:html-markup-anchor
"mailto:gnucash-devel@gnucash.org"
(gnc:html-markup-tt "gnucash-devel@gnucash.org")) ". "
(_ "For details on subscribing to that list, see ")
(gnc:html-markup/format
(_ "This is a sample GnuCash report. \
See the guile (scheme) source code in %s \
for details on writing your own reports, \
or extending existing reports.")
(gnc:html-markup-tt
gnc:_share-dir-default_ "/gnucash/scm/report")))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "For help on writing reports, or to contribute your brand \
new, totally cool report, consult the mailing list %s.")
(gnc:html-markup-anchor
"mailto:gnucash-devel@gnucash.org"
(gnc:html-markup-tt "gnucash-devel@gnucash.org")))
(gnc:html-markup/format
(_ "For details on subscribing to that list, see %s.")
(gnc:html-markup-anchor
"http://www.gnucash.org"
(gnc:html-markup-tt
"www.gnucash.org")) ".")
(gnc:html-markup-p
(_ "The current time is ")
(gnc:html-markup-b time-string) ".")
(gnc:html-markup-p
(_ "The boolean option is ")
(gnc:html-markup-b (if bool-val (_ "true") (_ "false"))) ".")
(gnc:html-markup-p
(_ "The multi-choice option is ")
(gnc:html-markup-b (symbol->string mult-val)) ".")
(gnc:html-markup-p
(_ "The string option is ")
(gnc:html-markup-b string-val) ".")
(gnc:html-markup-p
(_ "The date option is ")
(gnc:html-markup-b date-string) ".")
(gnc:html-markup-p
(_ "The date and time option is ")
(gnc:html-markup-b date-string2) ".")
(gnc:html-markup-p
"www.gnucash.org")))
(gnc:html-markup/format
(_ "You can learn more about writing scheme using this %s.")
(gnc:html-markup-anchor
"http://www.scheme.com/tspl2d/index.html"
(_ "online book"))))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The current time is %s.")
(gnc:html-markup-b time-string)))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The boolean option is %s.")
(gnc:html-markup-b (if bool-val (_ "true") (_ "false")))))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The multi-choice option is %s.")
(gnc:html-markup-b (symbol->string mult-val))))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The string option is %s.")
(gnc:html-markup-b string-val)))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The date option is %s.")
(gnc:html-markup-b date-string)))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The date and time option is %s.")
(gnc:html-markup-b date-string2)))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The relative date option is %a.")
(_ "The relative date option is %s.")
(gnc:html-markup-b rel-date-string)))
(gnc:html-markup-p
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The combination date option is %a.")
(_ "The combination date option is %s.")
(gnc:html-markup-b combo-date-string)))
(gnc:html-markup-p
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The number option is %a.")
(_ "The number option is %s.")
(gnc:html-markup-b (number->string num-val))))
;; Here we print the value of the number option formatted as
@ -379,10 +393,10 @@ new, totally cool report, consult the mailing list ")
;; it yourself -- it will be wrong in other locales.
(gnc:html-markup-p
(gnc:html-markup/format
(_ "The number option formatted as currency is %a.")
(_ "The number option formatted as currency is %s.")
(gnc:html-markup-b
(gnc:amount->string num-val (gnc:default-print-info #f)))))))
;; you can add as many objects as you want. Here's another
;; one. We'll make a single-column table of the selected list
;; options just for grins.
@ -435,7 +449,7 @@ new, totally cool report, consult the mailing list ")
document
(gnc:make-html-text
(gnc:html-markup-p (_ "You have selected no accounts.")))))
(gnc:html-document-add-object!
document
(gnc:make-html-text

3
src/scm/report/pnl.scm
View File

@ -118,8 +118,7 @@
(from-date-tp (gnc:timepair-start-day-time
(vector-ref (get-option pagename-general
optname-from-date) 1)))
(doc (gnc:make-html-document))
(txt (gnc:make-html-text)))
(doc (gnc:make-html-document)))
(gnc:html-document-set-title!
doc (string-append (_ "Profit and Loss") " "

7
src/scm/report/report-list.scm
View File

@ -8,8 +8,13 @@
;; reports
(gnc:depend "report/account-summary.scm")
(gnc:depend "report/average-balance.scm")
(gnc:depend "report/pnl.scm")
(gnc:depend "report/hello-world.scm")
(gnc:depend "report/pnl.scm")
(let ((locale (setlocale LC_MESSAGES)))
(if (or (equal? locale "C")
(equal? locale "en")
(equal? locale "en_US"))
(gnc:depend "report/taxtxf.scm")))
(gnc:depend "report/transaction-report.scm")
;; style sheets

576
src/scm/report/taxtxf.scm
View File

@ -1,7 +1,5 @@
;; -*-scheme-*-
;; $Id$
;; by Richard -Gilligan- Uschold
;; Extensivbly modified from balance-and-pnl.scm
;;
;; This prints Tax related accounts and exports TXF files for import to
;; TaxCut, TurboTax, etc.
@ -40,101 +38,6 @@
(gnc:depend "report/txf-export.scm")
(gnc:depend "report/txf-export-help.scm")
;; This and the next function are the same as in transaction-report.scm
(define (make-split-list account split-filter-pred)
(let ((num-splits (gnc:account-get-split-count account)))
(let loop ((index 0)
(split (gnc:account-get-split account 0))
(slist '()))
(if (= index num-splits)
(reverse slist)
(loop (+ index 1)
(gnc:account-get-split account (+ index 1))
(if (split-filter-pred split)
(cons split slist)
slist))))))
;; 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)
(let ((tp
(gnc:transaction-get-date-posted
(gnc:split-get-parent split))))
(and (gnc:timepair-ge-date tp begin-date-tp)
(gnc:timepair-le-date tp end-date-tp)))))
;; This is nearly identical to, and could be shared with
;; display-report-list-item in report.scm. This adds warn-msg parameter
(define (gnc:display-report-list-item item port warn-msg)
(cond
((string? item) (display item port))
((null? item) #t)
((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."))))
;; make a list of accounts from a group pointer
(define (gnc:group-ptr->list group-prt)
(if (not group-prt)
'()
(gnc:group-map-accounts (lambda (x) x) group-prt)))
;; some html helpers
(define (html-blue html)
(if html
(string-append "<font color=\"#0000ff\">" html "</font>")
#f))
(define (html-red html)
(if html
(string-append "<font color=\"#ff0000\">" html "</font>")
#f))
(define (html-black html)
(if html
(string-append "<font color=\"#000000\">" html "</font>")
#f))
(define (html-table-row-align-color color lst align-list)
(if (string? lst)
lst
(list "<TR bgcolor=" color ">"
(map html-table-col-align lst align-list)
"</TR>")))
;; 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 (make-level-collector num-levels)
(let ((level-collector (make-vector num-levels)))
(do ((i 0 (+ i 1)))
@ -146,15 +49,113 @@
(let* ((MAX-LEVELS 16) ; Maximum Account Levels
(levelx-collector (make-level-collector MAX-LEVELS))
(bg-color "#f6ffdb")
(white "#ffffff"))
(red "#ff0000")
(white "#ffffff")
(blue "#0000ff"))
;; This and the next function are the same as in transaction-report.scm
(define (make-split-list account split-filter-pred)
(let ((num-splits (gnc:account-get-split-count account)))
(let loop ((index 0)
(split (gnc:account-get-split account 0))
(slist '()))
(if (= index num-splits)
(reverse slist)
(loop (+ index 1)
(gnc:account-get-split account (+ index 1))
(if (split-filter-pred split)
(cons split slist)
slist))))))
;; 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)
(let ((tp
(gnc:transaction-get-date-posted
(gnc:split-get-parent split))))
(and (gnc:timepair-ge-date tp begin-date-tp)
(gnc:timepair-le-date tp end-date-tp)))))
;; This is nearly identical to, and could be shared with
;; display-report-list-item in report.scm. This adds warn-msg parameter
(define (gnc:display-report-list-item item port warn-msg)
(cond
((string? item) (display item port))
((null? item) #t)
((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."))))
;; make a list of accounts from a group pointer
(define (gnc:group-ptr->list group-prt)
(if (not group-prt)
'()
(gnc:group-map-accounts (lambda (x) x) group-prt)))
;; some html helpers
(define (html-blue html)
(if html
(string-append "<font color=\"#0000ff\">" html "</font>")
#f))
(define (html-red html)
(if html
(string-append "<font color=\"#ff0000\">" html "</font>")
#f))
(define (html-black html)
(if html
(string-append "<font color=\"#000000\">" html "</font>")
#f))
(define (html-table-row-align-color color lst align-list)
(if (string? lst)
lst
lst))
; (list "<TR bgcolor=" color ">"
; (map html-table-col-align lst align-list)
; "</TR>")))
;; 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))
;; IRS asked congress to make the tax quarters sthe same as real quarters
;; IRS asked congress to make the tax quarters the same as real quarters
;; This is the year it is effective. THIS IS A Y10K BUG!
(define tax-qtr-real-qtr-year 10000)
(define tax-tab-title (N_ "TAX Report Options"))
(define hierarchical-tab-title (N_ "Hierarchical Options"))
@ -165,12 +166,11 @@
(define (hierarchical-options-generator)
(options-generator #t hierarchical-tab-title))
(define (options-generator hierarchical? tab-title)
(define (options-generator hierarchical? tab-title)
(define gnc:*tax-report-options* (gnc:new-options))
(define (gnc:register-tax-option new-option)
(gnc:register-option gnc:*tax-report-options* new-option))
(gnc:register-tax-option
(gnc:make-date-option
tab-title (N_ "From")
@ -178,11 +178,11 @@
(lambda ()
(let ((bdtm (gnc:timepair->date (gnc:timepair-canonical-day-time
(cons (current-time) 0)))))
(set-tm:mday bdtm 1) ; 01
(set-tm:mon bdtm 0) ; Jan
(set-tm:mday bdtm 1) ; 01
(set-tm:mon bdtm 0) ; Jan
(cons 'absolute (cons (car (mktime bdtm)) 0))))
#f 'absolute #f))
(gnc:register-tax-option
(gnc:make-date-option
tab-title (N_ "To")
@ -191,7 +191,7 @@
(cons 'absolute (gnc:timepair-canonical-day-time
(cons (current-time) 0))))
#f 'absolute #f))
(gnc:register-tax-option
(gnc:make-multichoice-option
tab-title (N_ "Alternate Period")
@ -226,19 +226,18 @@
tab-title (N_ "Select Accounts (none = all)")
"d" (N_ "Select accounts")
(lambda () (gnc:get-current-accounts))
#f
#t))
#f #t))
(gnc:register-tax-option
(gnc:make-simple-boolean-option
tab-title (N_ "Suppress $0.00 values")
"f" (N_ "$0.00 valued Accounts won't be printed.") #t))
(gnc:register-tax-option
(gnc:make-simple-boolean-option
tab-title (N_ "Print Full account names")
"g" (N_ "Print all Parent account names") #f))
(if (not hierarchical?)
(begin
(gnc:register-tax-option
@ -261,20 +260,19 @@
(N_ "Reset Tax Related & sub-accounts")
(N_ "Reset Selected & sub-accounts as not Tax Related")))
)))
(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))
#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
@ -282,8 +280,7 @@
(N_ "For INCOME accounts, select here. < ^ # see help")
"c" (N_ "Select a TXF Income catagory")
'()
txf-income-catagories
))
txf-income-catagories))
(gnc:register-tax-option
;;(gnc:make-multichoice-option
@ -292,8 +289,7 @@
(N_ "For EXPENSE accounts, select here. < ^ # see help")
"d" (N_ "Select a TXF Expense catagory")
'()
txf-expense-catagories
))
txf-expense-catagories))
(gnc:register-tax-option
(gnc:make-multichoice-option
@ -307,15 +303,14 @@
(N_ "Use Current Account Name")))
(list->vector
(list 'parent (N_ "^ Parent Account")
(N_ "Use Parent Account Name")))
)))))
(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
; this only works if different
@ -330,7 +325,7 @@
(define (txf-payer? str)
(member str '("<" "^")))
;; 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.
@ -340,7 +335,7 @@
(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 ""))
@ -350,7 +345,7 @@
(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)
@ -369,7 +364,7 @@
(if txf-pos
(substring txf-notes tax-pos txf-pos)
" "))
;; because we use the list-option input structure, we have to build our own
;; search function
(define (txfq-ref key txf-list)
@ -379,7 +374,7 @@
(if (>= i len)
(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 catagories-lst)
@ -400,7 +395,7 @@
(number->string (vector-ref txf-vec 3))
" \\ " (symbol->string
(car code-lst))))))))))
;; insert help strings in txf catagories
(define (txf-help cat-list)
(do ((i 0 (+ i 1))
@ -414,7 +409,7 @@
(list-set! cat-list i item)
#t)
#f))))
;; print txf help strings
(define (txf-print-help vect inc)
(let* ((form-desc (vector-ref vect 1))
@ -433,7 +428,7 @@
(list (html-red form-code-desc)
(html-red help)))
(list "left" "left"))))
;; 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)
@ -444,7 +439,7 @@
(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
@ -454,7 +449,7 @@
;; 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))
@ -493,7 +488,7 @@
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)
@ -536,7 +531,7 @@
(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)
@ -561,7 +556,7 @@
(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)))
@ -572,9 +567,9 @@
(if item
(cons account item)
(list account)))))))
;; Print error message for duplicate txf codes and accounts
(define (txf-print-dups)
(define (txf-print-dups doc)
(let ((dups (apply append
(map (lambda (x)
(let ((cnt (length (cdr x))))
@ -589,21 +584,26 @@
(map gnc:account-get-full-name
(cdr x))))
'())))
txf-dups-alist))))
txf-dups-alist)))
(text (gnc:make-html-text)))
(if (not (null? dups))
(cons
(html-para
(html-blue
(_ "ERROR: There are duplicate TXF codes assigned\
(begin
(gnc:html-text-set-style! text 'font-color "#0000ff")
(gnc:html-document-add-object! doc text)
(gnc:html-text-append!
text
(gnc:html-markup-p
(_ "ERROR: There are duplicate TXF codes assigned\
to some accounts. Only TXF codes prefixed with \"&lt;\" or \"^\" may be\
repeated.")))
(map html-para (map html-blue dups)))
'())))
(map (lambda (s)
(gnc:html-text-append! text (gnc:html-markup-p s)))
dups)))))
;; some codes require special handling
(define (txf-special-split? code)
(member code '("N521"))) ; only one for now
(member code '("N521"))) ; only one for now
(define (render-txf-account account account-value date)
(let* ((print-info (gnc:account-value-print-info account #f))
(value (gnc:amount->string account-value print-info))
@ -651,7 +651,7 @@
(else '()))
"\n^"))
"")))
;; Render any level
(define (render-level-x-account level max-level account lx-value
suppress-0 full-names txf-date hierarchical?)
@ -748,16 +748,14 @@
(define (generate-tax-or-txf report-name
report-description
options
report-obj
tax-mode-in)
;; These are some helper functions for looking up option values.
(define (get-op section name)
(gnc:lookup-option options section name))
(define (op-value section name)
(gnc:option-value (get-op section name)))
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
;; the number of account generations: children, grandchildren etc.
(define (num-generations account gen)
(let ((children (gnc:account-get-children account)))
@ -774,17 +772,17 @@
report-name))
(tab-title (if hierarchical? hierarchical-tab-title tax-tab-title))
(from-value (gnc:date-option-absolute-time
(op-value tab-title "From")))
(get-option tab-title "From")))
(to-value (gnc:timepair-end-day-time
(gnc:date-option-absolute-time
(op-value tab-title "To"))))
(alt-period (op-value tab-title "Alternate Period"))
(suppress-0 (op-value tab-title "Suppress $0.00 values"))
(full-names (op-value tab-title
"Print Full account names"))
(get-option tab-title "To"))))
(alt-period (get-option tab-title "Alternate Period"))
(suppress-0 (get-option tab-title "Suppress $0.00 values"))
(full-names (get-option tab-title
"Print Full account names"))
(tax-mode tax-mode-in) ; these need to different later
(user-sel-accnts (op-value tab-title
"Select Accounts (none = all)"))
(user-sel-accnts (get-option tab-title
"Select Accounts (none = all)"))
(valid-user-sel-accnts (validate user-sel-accnts hierarchical?))
;; If no selected accounts, check all.
(selected-accounts (if (not (null? user-sel-accnts))
@ -797,7 +795,7 @@
selected-accounts))
0))
(max-level (min MAX-LEVELS (max 1 generations)))
;; Alternate dates are relative to from-date
(from-date (gnc:timepair->date from-value))
(from-value (gnc:timepair-start-day-time
@ -829,7 +827,7 @@
((4th-est 4th-last) ; Oct 1
(set-tm:mon bdtm 9))))
(cons (car (mktime bdtm)) 0))))
(to-value (gnc:timepair-end-day-time
(let ((bdtm from-date))
(if (member alt-period
@ -872,11 +870,14 @@
(set! bdtm (gnc:timepair->date to-value)))))
(cons (car (mktime bdtm)) 0))))
(txf-help (if hierarchical? #f
(op-value "TXF Export Init" "Print extended TXF HELP\
messages")))
(txf-feedback-str-lst '()))
(txf-help
(if hierarchical? #f
(get-option "TXF Export Init"
"Print extended TXF HELP messages")))
(txf-feedback-str-lst '())
(doc (gnc:make-html-document))
(table (gnc:make-html-table)))
(define (handle-txf-special-splits level account from-value to-value)
(if (and (gnc:account-get-txf account)
(txf-special-split? (gnc:account-get-txf-code account)))
@ -889,21 +890,21 @@
(equal? (strftime "%m%d" (localtime (car to-value)))
"1231")))
;; Adjust dates so we get the final Estimated Tax
;; paynemt from the right year
;; paymnent from the right year
(from-est (if full-year?
(let ((bdtm (gnc:timepair->date
(gnc:timepair-canonical-day-time
from-value))))
(set-tm:mday bdtm 1) ; 01
(set-tm:mon bdtm 2) ; Mar
(set-tm:mday bdtm 1) ; 01
(set-tm:mon bdtm 2) ; Mar
(cons (car (mktime bdtm)) 0))
from-value))
(to-est (if full-year?
(let* ((bdtm (gnc:timepair->date
(gnc:timepair-canonical-day-time
from-value))))
(set-tm:mday bdtm 28) ; 28
(set-tm:mon bdtm 1) ; Feb
(set-tm:mday bdtm 28) ; 28
(set-tm:mon bdtm 1) ; Feb
(set-tm:year bdtm (+ (tm:year bdtm) 1))
(cons (car (mktime bdtm)) 0))
to-value))
@ -929,7 +930,7 @@
(render-txf-account account value date))))
split-list))
'()))
(define (handle-level-x-account level account)
(let ((type (gw:enum-GNCAccountType-val->sym
(gnc:account-get-type account) #f))
@ -948,13 +949,13 @@
(+ 1 level) x)
'()))
children)))
(account-balance (if (or hierarchical?
(gnc:account-get-tax account))
(d-gnc:account-get-balance-interval
account from-value to-value #f)
0))) ; don't add non tax related
(set! account-balance (+ (if (> max-level level)
(lx-collector (+ 1 level)
'total #f)
@ -988,20 +989,22 @@
(list level-x-output childrens-output)))))))
;; Ignore
'())))
(if (not hierarchical?)
(let* ((tax-stat (op-value tab-title "Set/Reset Tax Status"))
(txf-acc-lst (op-value "TXF Export Init" "Select Account"))
(let* ((tax-stat (get-option tab-title "Set/Reset Tax Status"))
(txf-acc-lst (get-option "TXF Export Init" "Select Account"))
(txf-account (if (null? txf-acc-lst)
(begin (set! txf-acc-lst '(#f))
#f)
(car txf-acc-lst)))
(txf-income (op-value "TXF Export Init" "For INCOME accounts,\
(txf-income (get-option "TXF Export Init"
"For INCOME accounts,\
select here. < ^ # see help"))
(txf-expense (op-value "TXF Export Init" "For EXPENSE\
(txf-expense (get-option "TXF Export Init"
"For EXPENSE\
accounts, select here. < ^ # see help"))
(txf-payer-source (op-value "TXF Export Init"
"< ^ Payer Name source"))
(txf-payer-source (get-option "TXF Export Init"
"< ^ Payer Name source"))
(txf-full-name-lst (if txf-account
(map gnc:account-get-full-name
txf-acc-lst)
@ -1016,14 +1019,14 @@
(key-status user-sel-accnts #t tax-key tax-end-key #t))
((tax-reset-kids)
(key-status user-sel-accnts #f tax-key tax-end-key #t))))
(txf-fun-str-lst (map (lambda (a) (txf-function
a txf-income txf-expense
txf-payer-source))
txf-acc-lst)))
(set! txf-feedback-str-lst (map txf-feedback-str txf-fun-str-lst
txf-full-name-lst))))
(let ((output '())
(from-date (strftime "%Y-%b-%d" (localtime (car from-value))))
(to-date (strftime "%Y-%b-%d" (localtime (car to-value))))
@ -1036,8 +1039,8 @@
(report-title (if txf-help
(_ "Detailed TXF Category Descriptions")
report-name))
(file-name "????"))
(file-name #f))
;; Now, the main body
;; Reset all the balance collectors
(do ((i 1 (+ i 1)))
@ -1067,25 +1070,26 @@
#f)
#t))
fname)))
(if file-name ; cancel TXF if no file selected
(let* ((port (open-output-file file-name))
(output (list
(map (lambda (x) (handle-level-x-account
1 x))
selected-accounts)))
(output
(list
(map (lambda (x) (handle-level-x-account 1 x))
selected-accounts)))
(output-txf (list
"V035"
"\nAGnuCash 1.5.2"
"\nAGnuCash "
gnc:version
"\n" today-date
"\n^"
output)))
(gnc:display-report-list-item output-txf port
"taxtxf.scm - ")
(newline port)
(close-output-port port)))))
(set! tax-mode #t) ; now do tax mode to display report
(set! output (list
(if txf-help
@ -1097,63 +1101,85 @@
txf-expense-catagories))
(map (lambda (x) (handle-level-x-account 1 x))
selected-accounts))))
(list ; Tax
"<html>"
"<head>"
"<title>" report-title "</title>"
"</head>\n"
"<body bgcolor=" bg-color ">"
"<center>"
"<h1>" report-title "</h1>\n"
"<p>"
(if txf-help
""
(html-black (string-append (_ "Period From:") " "
from-date " "
(_ "To:") " "
to-date)))
"</p>\n"
"<p>"
(html-blue (if hierarchical?
""
(if tax-mode-in
(if txf-help
""
(_ "Blue items are exportable to a TXF file"))
(if file-name
(string-append
(_ "Blue items were exported to file: \"")
file-name "\"")
(_ "Blue items were <b>NOT</b> exported to \
txf file!")))))
"</p>\n"
"</center>"
(if (or hierarchical? txf-help)
""
(map html-para (map html-blue txf-feedback-str-lst)))
(txf-print-dups)
"<table " (if txf-help "border=1 " "border=0 ") "cellpadding=1>"
"<tr>"
"<th>"
(if txf-help
(list (_ "Tax Form \\ TXF Code") "<br>"
(_ "Description"))
(_ "Account Name"))
"</th>\n"
(if txf-help
""
(do ((i (- max-level 1) (- i 1))
(head "" (string-append
head "<th align=right>" (_ "(Sub ")
(number->string i) ")</th>")))
((< i 1) head)))
(gnc:html-document-set-title! doc report-title)
(gnc:html-document-set-style!
doc "body"
'attribute (list "bgcolor" bg-color)
'tag "center")
(gnc:html-document-add-object!
doc
(gnc:make-html-text
(gnc:html-markup-p
(gnc:html-markup/format
(_ "Period from %s to %s") from-date to-date))))
(let ((text (gnc:make-html-text)))
(gnc:html-text-set-style! text 'font-color "#0000ff")
(gnc:html-document-add-object! doc text)
(if (not hierarchical?)
(if tax-mode-in
(if (not txf-help)
(gnc:html-text-append!
text
(gnc:html-markup-p
(_ "Blue items are exportable to a TXF file."))))
(gnc:html-text-append!
text
(gnc:html-markup-p
(if file-name
(gnc:html-markup/format
(_ "Blue items were exported to file %s.")
(gnc:html-markup-tt file-name))
(_ "Blue items were <em>not</em> exported to \
txf file!"))))))
(if (not (or hierarchical? txf-help))
(map (lambda (s)
(gnc:html-text-append! text (gnc:html-markup-p s)))
txf-feedback-str-lst)))
(txf-print-dups doc)
(gnc:html-document-add-object! doc table)
(if txf-help
(gnc:html-table-set-style! 'attribute (list "border" "1")))
(if txf-help
(gnc:html-table-append-row!
table
(list
(gnc:make-html-table-header-cell
(_ "Tax Form \\ TXF Code")
(gnc:html-markup-br)
(_ "Description"))
(gnc:make-html-table-header-cell "")
(gnc:make-html-table-header-cell
(_ "Extended TXF Help messages") " "
(html-blue "Income") " "
(html-red "Expense"))))
(gnc:html-table-append-row!
table
(list
(gnc:make-html-table-header-cell
(_ "Account Name")))))
(list
(if txf-help
""
(do ((i (- max-level 1) (- i 1))
(head "" (string-append
head "<th align=right>" (_ "(Sub ")
(number->string i) ")</th>")))
((< i 1) head)))
(if txf-help
(list "<th>" (_ "Extended TXF Help messages")
(html-blue " Income") (html-red " Expense"))
(list "<th align=right>" (_ "Total")))
"</th>\n"
"</tr>\n"
output
"</table>\n"
(if (null? (car output))
@ -1167,45 +1193,45 @@ txf file!")))))
" ")
"</body>"
"</html>")
)))
doc)))
;; copy help strings to catagory structures.
;; copy help strings to category structures.
(txf-help txf-income-catagories)
(txf-help txf-expense-catagories)
(txf-help txf-help-catagories)
(gnc:define-report
'version 1
'name (N_ "Hierarchical")
'options-generator hierarchical-options-generator
'renderer (lambda (options)
(generate-tax-or-txf
(_ "Hierarchical Accounts Report")
(_ "This page shows your Taxable Income and \
Deductable Expenses.")
options
#t)))
; (gnc:define-report
; 'version 1
; 'name (N_ "Hierarchical")
; 'options-generator hierarchical-options-generator
; 'renderer (lambda (report-obj)
; (generate-tax-or-txf
; (_ "Hierarchical Accounts Report")
; (_ "This page shows your Taxable Income and \
;Deductable Expenses.")
; report-obj
; #t)))
(gnc:define-report
'version 1
'name (N_ "Tax")
'options-generator tax-options-generator
'renderer (lambda (options)
'renderer (lambda (report-obj)
(generate-tax-or-txf
(_ "Taxable Income / Deductible Expenses")
(_ "This page shows your Taxable Income and \
Deductable Expenses.")
options
report-obj
#t)))
(gnc:define-report
'version 1
'name (N_ "Export .TXF")
'options-generator tax-options-generator
'renderer (lambda (options)
'renderer (lambda (report-obj)
(generate-tax-or-txf
(_ "Taxable Income / Deductible Expenses")
(_ "This page shows your Taxable Income and \
Deductable Expenses.")
options
report-obj
#f))))