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> 2001-03-08 Robert Graham Merkel <rgmerk@mira.net>
* src/scm/report/transaction-report.scm: More colourization. * src/scm/report/transaction-report.scm: More colourization.
=======
2001-03-07 Bill Gribble <grib@billgribble.com> 2001-03-07 Bill Gribble <grib@billgribble.com>
* summary: separate the HTML and HTTP processing functions into * 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, (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. even if the non-format args are html-markup objects.
>>>>>>> 1.251
2001-03-07 Dave Peticolas <dave@krondo.com> 2001-03-07 Dave Peticolas <dave@krondo.com>
* src/gnome/top-level.c (gnc_ui_check_events): add timeout * 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 "finproto.h"
#include "finvar.h" #include "finvar.h"
#include "glade-gnc-dialogs.h" #include "glade-gnc-dialogs.h"
#include "glade-support.h"
#include "gnc-amount-edit.h" #include "gnc-amount-edit.h"
#include "gnc-commodity.h" #include "gnc-commodity.h"
#include "gnc-component-manager.h" #include "gnc-component-manager.h"
@ -528,7 +529,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[PAYMENT_PERIODS] = edit; fcd->amounts[PAYMENT_PERIODS] = edit;
gtk_widget_show (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); gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry; entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -544,7 +545,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[INTEREST_RATE] = edit; fcd->amounts[INTEREST_RATE] = edit;
gtk_widget_show (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); gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry; entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -562,7 +563,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[PRESENT_VALUE] = edit; fcd->amounts[PRESENT_VALUE] = edit;
gtk_widget_show (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); gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry; entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -578,7 +579,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[PERIODIC_PAYMENT] = edit; fcd->amounts[PERIODIC_PAYMENT] = edit;
gtk_widget_show (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); gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry; entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -594,7 +595,7 @@ gnc_ui_fincalc_dialog_create(void)
fcd->amounts[FUTURE_VALUE] = edit; fcd->amounts[FUTURE_VALUE] = edit;
gtk_widget_show (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); gtk_box_pack_start (GTK_BOX (hbox), edit, TRUE, TRUE, 0);
entry = GNC_AMOUNT_EDIT (edit)->amount_entry; entry = GNC_AMOUNT_EDIT (edit)->amount_entry;
@ -602,83 +603,87 @@ gnc_ui_fincalc_dialog_create(void)
GTK_SIGNAL_FUNC(fincalc_entry_changed), fcd); 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); fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked", gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_payment_periods), fcd); 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); fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked", gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_interest_rate), fcd); 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); fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked", gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_present_value), fcd); 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); fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked", gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_periodic_payment), fcd); 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); fcd->calc_buttons = g_list_prepend(fcd->calc_buttons, button);
gtk_signal_connect(GTK_OBJECT(button), "clicked", gtk_signal_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(calc_future_value), fcd); 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_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_entry_clear_clicked), GTK_SIGNAL_FUNC(fincalc_entry_clear_clicked),
fcd->amounts[PAYMENT_PERIODS]); 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_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked), GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked),
fcd->amounts[INTEREST_RATE]); 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_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked), GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked),
fcd->amounts[PRESENT_VALUE]); 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_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked), GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked),
fcd->amounts[PERIODIC_PAYMENT]); 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_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked), GTK_SIGNAL_FUNC(fincalc_amount_clear_clicked),
fcd->amounts[FUTURE_VALUE]); fcd->amounts[FUTURE_VALUE]);
menu = gtk_object_get_data(fcdo, "compounding_menu"); menu = lookup_widget (fcd->dialog, "compounding_menu");
fcd->compounding_menu = menu; fcd->compounding_menu = menu;
gnc_option_menu_init(menu); gnc_option_menu_init(menu);
menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(menu)); menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(menu));
gtk_container_forall(GTK_CONTAINER(menu), connect_fincalc_menu_item, fcd); 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; fcd->payment_menu = menu;
gnc_option_menu_init(menu); gnc_option_menu_init(menu);
menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(menu)); menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(menu));
gtk_container_forall(GTK_CONTAINER(menu), connect_fincalc_menu_item, fcd); 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; fcd->end_of_period_radio = button;
gtk_signal_connect(GTK_OBJECT(button), "toggled", gtk_signal_connect(GTK_OBJECT(button), "toggled",
GTK_SIGNAL_FUNC(fincalc_radio_toggled), fcd); 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; fcd->discrete_compounding_radio = button;
gtk_signal_connect(GTK_OBJECT(button), "toggled", gtk_signal_connect(GTK_OBJECT(button), "toggled",
GTK_SIGNAL_FUNC(fincalc_radio_toggled), fcd); 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_connect(GTK_OBJECT(button), "clicked",
GTK_SIGNAL_FUNC(close_button_clicked), fcd); 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); 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; regex_t compiled_h, compiled_o;
regmatch_t match[4]; regmatch_t match[4];
char * machine=NULL, * location = NULL, * base=NULL; char * machine=NULL, * location = NULL, * base=NULL;
int free_location = 0;
regcomp(&compiled_h, http_rexp, REG_EXTENDED); regcomp(&compiled_h, http_rexp, REG_EXTENDED);
regcomp(&compiled_o, other_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); location = g_new0(char, match[2].rm_eo - match[2].rm_so + 1);
strncpy(location, path+match[2].rm_so, strncpy(location, path+match[2].rm_so,
match[2].rm_eo - match[2].rm_so); match[2].rm_eo - match[2].rm_so);
free_location = 1;
} }
} }
break; break;
@ -286,9 +284,7 @@ extract_base_name(URLType type, const gchar * path) {
regfree(&compiled_h); regfree(&compiled_h);
regfree(&compiled_o); regfree(&compiled_o);
if(free_location) { g_free(location);
g_free(location);
}
if(machine) { if(machine) {
strcat(machine, "/"); strcat(machine, "/");
@ -1100,6 +1096,9 @@ gnc_html_export(gnc_html * html) {
FILE *fh; FILE *fh;
filepath = fileBox (_("Save HTML To File"), NULL, NULL); filepath = fileBox (_("Save HTML To File"), NULL, NULL);
if (!filepath)
return;
PINFO (" user selected file=%s\n", filepath); PINFO (" user selected file=%s\n", filepath);
fh = fopen (filepath, "w"); fh = fopen (filepath, "w");
if (NULL == fh) { if (NULL == fh) {

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

@ -115,86 +115,78 @@
#f #f
(N_ "Enable debugging mode")) (N_ "Enable debugging mode"))
(cons (list "loglevel"
"loglevel" 'integer
(list 'integer (lambda (val)
(lambda (val) (gnc:config-var-value-set! gnc:*loglevel* #f val))
(gnc:config-var-value-set! gnc:*loglevel* #f val)) "LOGLEVEL"
"LOGLEVEL" (N_ "Set the logging level from 0 (least) to 6 (most)"))
(N_ "Set the logging level from 0 (least) to 6 (most)")))
(cons (list "nofile"
"nofile" 'boolean
(list 'boolean (lambda (val)
(lambda (val) (gnc:config-var-value-set! gnc:*arg-no-file* #f val))
(gnc:config-var-value-set! gnc:*arg-no-file* #f val)) #f
#f (N_ "Do not load the last file opened"))
(N_ "Do not load the last file opened")))
(cons (list "config-dir"
"config-dir" 'string
(list 'string (lambda (val)
(lambda (val) (gnc:config-var-value-set! gnc:*config-dir* #f val))
(gnc:config-var-value-set! gnc:*config-dir* #f val)) "CONFIGDIR"
"CONFIGDIR" (N_ "Set configuration directory"))
(N_ "Set configuration directory")))
(cons (list "share-dir"
"share-dir" 'string
(list 'string (lambda (val)
(lambda (val) (gnc:config-var-value-set! gnc:*share-dir* #f val))
(gnc:config-var-value-set! gnc:*share-dir* #f val)) "SHAREDIR"
"SHAREDIR" (N_ "Set shared directory"))
(N_ "Set shared directory")))
(cons (list "load-path"
"load-path" 'string
(list 'string (lambda (val)
(lambda (val) (let ((path-list
(let ((path-list (call-with-input-string val (lambda (port) (read port)))))
(call-with-input-string val (lambda (port) (read port))))) (if (list? path-list)
(if (list? path-list) (gnc:config-var-value-set! gnc:*load-path* #f path-list)
(gnc:config-var-value-set! gnc:*load-path* #f path-list) (begin
(begin (gnc:error "non-list given for --load-path: " val)
(gnc:error "non-list given for --load-path: " val) (gnc:shutdown 1)))))
(gnc:shutdown 1))))) "LOADPATH"
"LOADPATH" (N_ "Set the search path for .scm files."))
(N_ "Set the search path for .scm files.")))
(cons (list "doc-path"
"doc-path" 'string
(list 'string (lambda (val)
(lambda (val) (gnc:debug "parsing --doc-path " val)
(gnc:debug "parsing --doc-path " val) (let ((path-list
(let ((path-list (call-with-input-string val (lambda (port) (read port)))))
(call-with-input-string val (lambda (port) (read port))))) (if (list? path-list)
(if (list? path-list) (gnc:config-var-value-set! gnc:*doc-path* #f path-list)
(gnc:config-var-value-set! gnc:*doc-path* #f path-list) (begin
(begin (gnc:error "non-list given for --doc-path: " val)
(gnc:error "non-list given for --doc-path: " val) (gnc:shutdown 1)))))
(gnc:shutdown 1))))) "DOCPATH"
"DOCPATH" (N_ "Set the search path for documentation files"))
(N_ "Set the search path for documentation files")))
(cons (list "evaluate"
"evaluate" 'string
(list 'string (lambda (val)
(lambda (val) (set! gnc:*batch-mode-things-to-do*
(set! gnc:*batch-mode-things-to-do* (cons val gnc:*batch-mode-things-to-do*)))
(cons val gnc:*batch-mode-things-to-do*))) "COMMAND"
"COMMAND" (N_ "Evaluate the guile command"))
(N_ "Evaluate the guile command")))
;; Given a string, --load will load the indicated file, if possible. ;; Given a string, --load will load the indicated file, if possible.
(cons (list "load"
"load" 'string
(list 'string (lambda (val)
(lambda (val) (set! gnc:*batch-mode-things-to-do*
(set! gnc:*batch-mode-things-to-do* (cons (lambda () (load val))
(cons (lambda () (load val)) gnc:*batch-mode-things-to-do*)))
gnc:*batch-mode-things-to-do*))) "FILE"
"FILE" (N_ "Load the given .scm file"))
(N_ "Load the given .scm file")))
; (cons "add-price-quotes" ; (cons "add-price-quotes"
; (cons 'string ; (cons 'string
@ -216,19 +208,17 @@
; ;
; gnc:*batch-mode-things-to-do*))))) ; gnc:*batch-mode-things-to-do*)))))
(cons (list "load-user-config"
"load-user-config" 'boolean
(list 'boolean gnc:load-user-config-if-needed
gnc:load-user-config-if-needed #f
#f (N_ "Load the user configuation"))
(N_ "Load the user configuation")))
(cons (list "load-system-config"
"load-system-config" 'boolean
(list 'boolean gnc:load-system-config-if-needed
gnc:load-system-config-if-needed #f
#f (N_ "Load the system configuation"))))
(N_ "Load the system configuation")))))
(define (gnc:cmd-line-get-boolean-arg args) (define (gnc:cmd-line-get-boolean-arg args)
;; --arg means #t ;; --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) (define (gnc:default-html-gnc-numeric-renderer datum params)
(gnc:amount->string-helper datum (gnc:default-print-info #f))) (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) (define (gnc:default-html-gnc-monetary-renderer datum params)
(gnc:amount->string-helper (gnc:amount->string-helper
@ -290,13 +289,6 @@
(gnc:double-to-gnc-numeric datum 100 GNC-RND-ROUND) (gnc:double-to-gnc-numeric datum 100 GNC-RND-ROUND)
(gnc:default-print-info #f))) (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 ;; <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:html-document-render ssdoc)))
(gnc:define-html-style-sheet (gnc:define-html-style-sheet
'version 1.0 'version 1
'name "Sample Style Sheet" 'name "Sample Style Sheet"
'renderer sample-renderer 'renderer sample-renderer
'options sample-options)) 'options sample-options))

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

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

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

@ -313,62 +313,76 @@ option like this.")
document document
(gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-p (gnc:html-markup-p
(_ "This is a sample GnuCash report. \ (gnc:html-markup/format
See the guile (scheme) source code in ") (_ "This is a sample GnuCash report. \
(gnc:html-markup-tt See the guile (scheme) source code in %s \
gnc:_share-dir-default_ "/gnucash/scm/report") for details on writing your own reports, \
(_ "for details on writing your own reports, \ or extending existing reports.")
or extending existing reports.")) (gnc:html-markup-tt
(gnc:html-markup-p gnc:_share-dir-default_ "/gnucash/scm/report")))
(_ "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-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 (gnc:html-markup-p
(gnc:html-markup/format (gnc:html-markup/format
(_ "The relative date option is %a.") (_ "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/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 %s.")
(gnc:html-markup-b rel-date-string))) (gnc:html-markup-b rel-date-string)))
(gnc:html-markup-p (gnc:html-markup-p
(gnc:html-markup/format (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-b combo-date-string)))
(gnc:html-markup-p (gnc:html-markup-p
(gnc:html-markup/format (gnc:html-markup/format
(_ "The number option is %a.") (_ "The number option is %s.")
(gnc:html-markup-b (number->string num-val)))) (gnc:html-markup-b (number->string num-val))))
;; Here we print the value of the number option formatted as ;; Here we print the value of the number option formatted as
@ -379,7 +393,7 @@ new, totally cool report, consult the mailing list ")
;; it yourself -- it will be wrong in other locales. ;; it yourself -- it will be wrong in other locales.
(gnc:html-markup-p (gnc:html-markup-p
(gnc:html-markup/format (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:html-markup-b
(gnc:amount->string num-val (gnc:default-print-info #f))))))) (gnc:amount->string num-val (gnc:default-print-info #f)))))))

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

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

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

@ -8,8 +8,13 @@
;; reports ;; reports
(gnc:depend "report/account-summary.scm") (gnc:depend "report/account-summary.scm")
(gnc:depend "report/average-balance.scm") (gnc:depend "report/average-balance.scm")
(gnc:depend "report/pnl.scm")
(gnc:depend "report/hello-world.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") (gnc:depend "report/transaction-report.scm")
;; style sheets ;; style sheets

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

@ -1,7 +1,5 @@
;; -*-scheme-*- ;; -*-scheme-*-
;; $Id$
;; by Richard -Gilligan- Uschold ;; by Richard -Gilligan- Uschold
;; Extensivbly modified from balance-and-pnl.scm
;; ;;
;; This prints Tax related accounts and exports TXF files for import to ;; This prints Tax related accounts and exports TXF files for import to
;; TaxCut, TurboTax, etc. ;; TaxCut, TurboTax, etc.
@ -40,101 +38,6 @@
(gnc:depend "report/txf-export.scm") (gnc:depend "report/txf-export.scm")
(gnc:depend "report/txf-export-help.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) (define (make-level-collector num-levels)
(let ((level-collector (make-vector num-levels))) (let ((level-collector (make-vector num-levels)))
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
@ -146,12 +49,110 @@
(let* ((MAX-LEVELS 16) ; Maximum Account Levels (let* ((MAX-LEVELS 16) ; Maximum Account Levels
(levelx-collector (make-level-collector MAX-LEVELS)) (levelx-collector (make-level-collector MAX-LEVELS))
(bg-color "#f6ffdb") (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) (define (lx-collector level action value)
((vector-ref levelx-collector (- level 1)) 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! ;; This is the year it is effective. THIS IS A Y10K BUG!
(define tax-qtr-real-qtr-year 10000) (define tax-qtr-real-qtr-year 10000)
@ -165,12 +166,11 @@
(define (hierarchical-options-generator) (define (hierarchical-options-generator)
(options-generator #t hierarchical-tab-title)) (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:*tax-report-options* (gnc:new-options))
(define (gnc:register-tax-option new-option) (define (gnc:register-tax-option new-option)
(gnc:register-option gnc:*tax-report-options* new-option)) (gnc:register-option gnc:*tax-report-options* new-option))
(gnc:register-tax-option (gnc:register-tax-option
(gnc:make-date-option (gnc:make-date-option
tab-title (N_ "From") tab-title (N_ "From")
@ -178,8 +178,8 @@
(lambda () (lambda ()
(let ((bdtm (gnc:timepair->date (gnc:timepair-canonical-day-time (let ((bdtm (gnc:timepair->date (gnc:timepair-canonical-day-time
(cons (current-time) 0))))) (cons (current-time) 0)))))
(set-tm:mday bdtm 1) ; 01 (set-tm:mday bdtm 1) ; 01
(set-tm:mon bdtm 0) ; Jan (set-tm:mon bdtm 0) ; Jan
(cons 'absolute (cons (car (mktime bdtm)) 0)))) (cons 'absolute (cons (car (mktime bdtm)) 0))))
#f 'absolute #f)) #f 'absolute #f))
@ -226,8 +226,7 @@
tab-title (N_ "Select Accounts (none = all)") tab-title (N_ "Select Accounts (none = all)")
"d" (N_ "Select accounts") "d" (N_ "Select accounts")
(lambda () (gnc:get-current-accounts)) (lambda () (gnc:get-current-accounts))
#f #f #t))
#t))
(gnc:register-tax-option (gnc:register-tax-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
@ -267,8 +266,7 @@
(N_ "TXF Export Init") (N_ "Select Account") (N_ "TXF Export Init") (N_ "Select Account")
"a" (N_ "Select Account") "a" (N_ "Select Account")
(lambda () (gnc:get-current-accounts)) (lambda () (gnc:get-current-accounts))
#f #f #t))
#t))
(gnc:register-tax-option (gnc:register-tax-option
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
@ -282,8 +280,7 @@
(N_ "For INCOME accounts, select here. < ^ # see help") (N_ "For INCOME accounts, select here. < ^ # see help")
"c" (N_ "Select a TXF Income catagory") "c" (N_ "Select a TXF Income catagory")
'() '()
txf-income-catagories txf-income-catagories))
))
(gnc:register-tax-option (gnc:register-tax-option
;;(gnc:make-multichoice-option ;;(gnc:make-multichoice-option
@ -292,8 +289,7 @@
(N_ "For EXPENSE accounts, select here. < ^ # see help") (N_ "For EXPENSE accounts, select here. < ^ # see help")
"d" (N_ "Select a TXF Expense catagory") "d" (N_ "Select a TXF Expense catagory")
'() '()
txf-expense-catagories txf-expense-catagories))
))
(gnc:register-tax-option (gnc:register-tax-option
(gnc:make-multichoice-option (gnc:make-multichoice-option
@ -307,8 +303,7 @@
(N_ "Use Current Account Name"))) (N_ "Use Current Account Name")))
(list->vector (list->vector
(list 'parent (N_ "^ Parent Account") (list 'parent (N_ "^ Parent Account")
(N_ "Use Parent Account Name"))) (N_ "Use Parent Account Name"))))))))
)))))
gnc:*tax-report-options*) gnc:*tax-report-options*)
@ -574,7 +569,7 @@
(list account))))))) (list account)))))))
;; Print error message for duplicate txf codes and accounts ;; Print error message for duplicate txf codes and accounts
(define (txf-print-dups) (define (txf-print-dups doc)
(let ((dups (apply append (let ((dups (apply append
(map (lambda (x) (map (lambda (x)
(let ((cnt (length (cdr x)))) (let ((cnt (length (cdr x))))
@ -589,20 +584,25 @@
(map gnc:account-get-full-name (map gnc:account-get-full-name
(cdr x)))) (cdr x))))
'()))) '())))
txf-dups-alist)))) txf-dups-alist)))
(text (gnc:make-html-text)))
(if (not (null? dups)) (if (not (null? dups))
(cons (begin
(html-para (gnc:html-text-set-style! text 'font-color "#0000ff")
(html-blue (gnc:html-document-add-object! doc text)
(_ "ERROR: There are duplicate TXF codes assigned\ (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\ to some accounts. Only TXF codes prefixed with \"&lt;\" or \"^\" may be\
repeated."))) 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 ;; some codes require special handling
(define (txf-special-split? code) (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) (define (render-txf-account account account-value date)
(let* ((print-info (gnc:account-value-print-info account #f)) (let* ((print-info (gnc:account-value-print-info account #f))
@ -748,15 +748,13 @@
(define (generate-tax-or-txf report-name (define (generate-tax-or-txf report-name
report-description report-description
options report-obj
tax-mode-in) tax-mode-in)
;; These are some helper functions for looking up option values. (define (get-option pagename optname)
(define (get-op section name) (gnc:option-value
(gnc:lookup-option options section name)) (gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
(define (op-value section name)
(gnc:option-value (get-op section name)))
;; the number of account generations: children, grandchildren etc. ;; the number of account generations: children, grandchildren etc.
(define (num-generations account gen) (define (num-generations account gen)
@ -774,17 +772,17 @@
report-name)) report-name))
(tab-title (if hierarchical? hierarchical-tab-title tax-tab-title)) (tab-title (if hierarchical? hierarchical-tab-title tax-tab-title))
(from-value (gnc:date-option-absolute-time (from-value (gnc:date-option-absolute-time
(op-value tab-title "From"))) (get-option tab-title "From")))
(to-value (gnc:timepair-end-day-time (to-value (gnc:timepair-end-day-time
(gnc:date-option-absolute-time (gnc:date-option-absolute-time
(op-value tab-title "To")))) (get-option tab-title "To"))))
(alt-period (op-value tab-title "Alternate Period")) (alt-period (get-option tab-title "Alternate Period"))
(suppress-0 (op-value tab-title "Suppress $0.00 values")) (suppress-0 (get-option tab-title "Suppress $0.00 values"))
(full-names (op-value tab-title (full-names (get-option tab-title
"Print Full account names")) "Print Full account names"))
(tax-mode tax-mode-in) ; these need to different later (tax-mode tax-mode-in) ; these need to different later
(user-sel-accnts (op-value tab-title (user-sel-accnts (get-option tab-title
"Select Accounts (none = all)")) "Select Accounts (none = all)"))
(valid-user-sel-accnts (validate user-sel-accnts hierarchical?)) (valid-user-sel-accnts (validate user-sel-accnts hierarchical?))
;; If no selected accounts, check all. ;; If no selected accounts, check all.
(selected-accounts (if (not (null? user-sel-accnts)) (selected-accounts (if (not (null? user-sel-accnts))
@ -872,10 +870,13 @@
(set! bdtm (gnc:timepair->date to-value))))) (set! bdtm (gnc:timepair->date to-value)))))
(cons (car (mktime bdtm)) 0)))) (cons (car (mktime bdtm)) 0))))
(txf-help (if hierarchical? #f (txf-help
(op-value "TXF Export Init" "Print extended TXF HELP\ (if hierarchical? #f
messages"))) (get-option "TXF Export Init"
(txf-feedback-str-lst '())) "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) (define (handle-txf-special-splits level account from-value to-value)
(if (and (gnc:account-get-txf account) (if (and (gnc:account-get-txf account)
@ -889,21 +890,21 @@
(equal? (strftime "%m%d" (localtime (car to-value))) (equal? (strftime "%m%d" (localtime (car to-value)))
"1231"))) "1231")))
;; Adjust dates so we get the final Estimated Tax ;; Adjust dates so we get the final Estimated Tax
;; paynemt from the right year ;; paymnent from the right year
(from-est (if full-year? (from-est (if full-year?
(let ((bdtm (gnc:timepair->date (let ((bdtm (gnc:timepair->date
(gnc:timepair-canonical-day-time (gnc:timepair-canonical-day-time
from-value)))) from-value))))
(set-tm:mday bdtm 1) ; 01 (set-tm:mday bdtm 1) ; 01
(set-tm:mon bdtm 2) ; Mar (set-tm:mon bdtm 2) ; Mar
(cons (car (mktime bdtm)) 0)) (cons (car (mktime bdtm)) 0))
from-value)) from-value))
(to-est (if full-year? (to-est (if full-year?
(let* ((bdtm (gnc:timepair->date (let* ((bdtm (gnc:timepair->date
(gnc:timepair-canonical-day-time (gnc:timepair-canonical-day-time
from-value)))) from-value))))
(set-tm:mday bdtm 28) ; 28 (set-tm:mday bdtm 28) ; 28
(set-tm:mon bdtm 1) ; Feb (set-tm:mon bdtm 1) ; Feb
(set-tm:year bdtm (+ (tm:year bdtm) 1)) (set-tm:year bdtm (+ (tm:year bdtm) 1))
(cons (car (mktime bdtm)) 0)) (cons (car (mktime bdtm)) 0))
to-value)) to-value))
@ -990,18 +991,20 @@
'()))) '())))
(if (not hierarchical?) (if (not hierarchical?)
(let* ((tax-stat (op-value tab-title "Set/Reset Tax Status")) (let* ((tax-stat (get-option tab-title "Set/Reset Tax Status"))
(txf-acc-lst (op-value "TXF Export Init" "Select Account")) (txf-acc-lst (get-option "TXF Export Init" "Select Account"))
(txf-account (if (null? txf-acc-lst) (txf-account (if (null? txf-acc-lst)
(begin (set! txf-acc-lst '(#f)) (begin (set! txf-acc-lst '(#f))
#f) #f)
(car txf-acc-lst))) (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")) 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")) accounts, select here. < ^ # see help"))
(txf-payer-source (op-value "TXF Export Init" (txf-payer-source (get-option "TXF Export Init"
"< ^ Payer Name source")) "< ^ Payer Name source"))
(txf-full-name-lst (if txf-account (txf-full-name-lst (if txf-account
(map gnc:account-get-full-name (map gnc:account-get-full-name
txf-acc-lst) txf-acc-lst)
@ -1036,7 +1039,7 @@
(report-title (if txf-help (report-title (if txf-help
(_ "Detailed TXF Category Descriptions") (_ "Detailed TXF Category Descriptions")
report-name)) report-name))
(file-name "????")) (file-name #f))
;; Now, the main body ;; Now, the main body
;; Reset all the balance collectors ;; Reset all the balance collectors
@ -1070,13 +1073,14 @@
(if file-name ; cancel TXF if no file selected (if file-name ; cancel TXF if no file selected
(let* ((port (open-output-file file-name)) (let* ((port (open-output-file file-name))
(output (list (output
(map (lambda (x) (handle-level-x-account (list
1 x)) (map (lambda (x) (handle-level-x-account 1 x))
selected-accounts))) selected-accounts)))
(output-txf (list (output-txf (list
"V035" "V035"
"\nAGnuCash 1.5.2" "\nAGnuCash "
gnc:version
"\n" today-date "\n" today-date
"\n^" "\n^"
output))) output)))
@ -1098,62 +1102,84 @@
(map (lambda (x) (handle-level-x-account 1 x)) (map (lambda (x) (handle-level-x-account 1 x))
selected-accounts)))) selected-accounts))))
(list ; Tax (gnc:html-document-set-title! doc report-title)
"<html>"
"<head>" (gnc:html-document-set-style!
"<title>" report-title "</title>" doc "body"
"</head>\n" 'attribute (list "bgcolor" bg-color)
"<body bgcolor=" bg-color ">" 'tag "center")
"<center>"
"<h1>" report-title "</h1>\n" (gnc:html-document-add-object!
"<p>" doc
(if txf-help (gnc:make-html-text
"" (gnc:html-markup-p
(html-black (string-append (_ "Period From:") " " (gnc:html-markup/format
from-date " " (_ "Period from %s to %s") from-date to-date))))
(_ "To:") " "
to-date))) (let ((text (gnc:make-html-text)))
"</p>\n" (gnc:html-text-set-style! text 'font-color "#0000ff")
"<p>" (gnc:html-document-add-object! doc text)
(html-blue (if hierarchical?
"" (if (not hierarchical?)
(if tax-mode-in (if tax-mode-in
(if txf-help (if (not txf-help)
"" (gnc:html-text-append!
(_ "Blue items are exportable to a TXF file")) text
(if file-name (gnc:html-markup-p
(string-append (_ "Blue items are exportable to a TXF file."))))
(_ "Blue items were exported to file: \"") (gnc:html-text-append!
file-name "\"") text
(_ "Blue items were <b>NOT</b> exported to \ (gnc:html-markup-p
txf file!"))))) (if file-name
"</p>\n" (gnc:html-markup/format
"</center>" (_ "Blue items were exported to file %s.")
(if (or hierarchical? txf-help) (gnc:html-markup-tt file-name))
"" (_ "Blue items were <em>not</em> exported to \
(map html-para (map html-blue txf-feedback-str-lst))) txf file!"))))))
(txf-print-dups)
"<table " (if txf-help "border=1 " "border=0 ") "cellpadding=1>" (if (not (or hierarchical? txf-help))
"<tr>" (map (lambda (s)
"<th>" (gnc:html-text-append! text (gnc:html-markup-p s)))
(if txf-help txf-feedback-str-lst)))
(list (_ "Tax Form \\ TXF Code") "<br>"
(_ "Description")) (txf-print-dups doc)
(_ "Account Name"))
"</th>\n" (gnc:html-document-add-object! doc table)
(if txf-help
"" (if txf-help
(do ((i (- max-level 1) (- i 1)) (gnc:html-table-set-style! 'attribute (list "border" "1")))
(head "" (string-append
head "<th align=right>" (_ "(Sub ") (if txf-help
(number->string i) ")</th>"))) (gnc:html-table-append-row!
((< i 1) head))) 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 (if txf-help
(list "<th>" (_ "Extended TXF Help messages") (list "<th>" (_ "Extended TXF Help messages")
(html-blue " Income") (html-red " Expense")) (html-blue " Income") (html-red " Expense"))
(list "<th align=right>" (_ "Total"))) (list "<th align=right>" (_ "Total")))
"</th>\n"
"</tr>\n"
output output
"</table>\n" "</table>\n"
(if (null? (car output)) (if (null? (car output))
@ -1167,45 +1193,45 @@ txf file!")))))
" ") " ")
"</body>" "</body>"
"</html>") "</html>")
))) doc)))
;; copy help strings to catagory structures. ;; copy help strings to category structures.
(txf-help txf-income-catagories) (txf-help txf-income-catagories)
(txf-help txf-expense-catagories) (txf-help txf-expense-catagories)
(txf-help txf-help-catagories) (txf-help txf-help-catagories)
(gnc:define-report ; (gnc:define-report
'version 1 ; 'version 1
'name (N_ "Hierarchical") ; 'name (N_ "Hierarchical")
'options-generator hierarchical-options-generator ; 'options-generator hierarchical-options-generator
'renderer (lambda (options) ; 'renderer (lambda (report-obj)
(generate-tax-or-txf ; (generate-tax-or-txf
(_ "Hierarchical Accounts Report") ; (_ "Hierarchical Accounts Report")
(_ "This page shows your Taxable Income and \ ; (_ "This page shows your Taxable Income and \
Deductable Expenses.") ;Deductable Expenses.")
options ; report-obj
#t))) ; #t)))
(gnc:define-report (gnc:define-report
'version 1 'version 1
'name (N_ "Tax") 'name (N_ "Tax")
'options-generator tax-options-generator 'options-generator tax-options-generator
'renderer (lambda (options) 'renderer (lambda (report-obj)
(generate-tax-or-txf (generate-tax-or-txf
(_ "Taxable Income / Deductible Expenses") (_ "Taxable Income / Deductible Expenses")
(_ "This page shows your Taxable Income and \ (_ "This page shows your Taxable Income and \
Deductable Expenses.") Deductable Expenses.")
options report-obj
#t))) #t)))
(gnc:define-report (gnc:define-report
'version 1 'version 1
'name (N_ "Export .TXF") 'name (N_ "Export .TXF")
'options-generator tax-options-generator 'options-generator tax-options-generator
'renderer (lambda (options) 'renderer (lambda (report-obj)
(generate-tax-or-txf (generate-tax-or-txf
(_ "Taxable Income / Deductible Expenses") (_ "Taxable Income / Deductible Expenses")
(_ "This page shows your Taxable Income and \ (_ "This page shows your Taxable Income and \
Deductable Expenses.") Deductable Expenses.")
options report-obj
#f)))) #f))))