From d9be6ea67bbf760c92409b71caeba77651b1846f Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Fri, 17 Aug 2001 00:44:01 +0000 Subject: [PATCH] 2001-08-16 Bill Gribble * move report system into gnc-modules. This required a new module of application framework stuff, src/app-utils. * src/report/report-system/: the report-html-generation code and the various report utilities and infrastructure * src/report/standard-reports/: non-locale-specific financial reports * src/report/utility-reports: non-financial reports * src/report/locale-specific: reports that only apply to specific locales. * src/report/stylesheet: report style sheet definitions git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@5144 57a11ea4-9604-0410-9ed3-97b8803252fd --- ChangeLog | 27 +- configure.in | 25 +- make-gnucash-patch.in | 1 + src/FileDialog.c | 4 +- src/Makefile.am | 12 +- src/README.modules | 9 + src/app-utils/Makefile.am | 67 + src/app-utils/app-utils.scm | 208 ++ src/{scm => app-utils}/c-interface.scm | 7 +- src/{scm => app-utils}/date-utilities.scm | 439 ++-- src/app-utils/gfec.c | 165 ++ src/app-utils/gfec.h | 20 + src/app-utils/global-options.c | 498 ++++ src/app-utils/global-options.h | 104 + src/{ => app-utils}/gnc-component-manager.c | 1 - src/{ => app-utils}/gnc-component-manager.h | 0 src/app-utils/gnc-gettext-util.c | 10 + src/app-utils/gnc-gettext-util.h | 3 + src/app-utils/gnc-helpers.c | 106 + src/app-utils/gnc-helpers.h | 34 + src/{ => app-utils}/gnc-ui-util.c | 1 - src/{ => app-utils}/gnc-ui-util.h | 0 src/app-utils/gncmod-app-utils.c | 62 + src/app-utils/guile-util.c | 1133 ++++++++ src/app-utils/guile-util.h | 94 + src/app-utils/gw-app-utils-spec.scm | 240 ++ src/{scm => app-utils}/hooks.scm | 2 - src/app-utils/option-util.c | 2307 +++++++++++++++++ src/app-utils/option-util.h | 242 ++ src/{scm => app-utils}/options.scm | 0 src/app-utils/test/Makefile.am | 17 + src/app-utils/test/test-link-module.c | 6 + src/app-utils/test/test-load-module | 18 + src/backend/postgres/test/Makefile.am | 6 +- src/engine/Makefile.am | 2 +- src/engine/engine-helpers.c | 6 - src/engine/engine-helpers.h | 3 - src/engine/engine.scm | 9 +- src/engine/gw-engine-spec.scm | 16 +- src/gnome/Makefile.am | 1 + src/gnome/dialog-account.c | 1 + src/gnome/druid-hierarchy.c | 2 +- src/gnome/top-level.h | 5 +- src/gnome/window-reconcile.c | 2 +- src/gnome/window-register.c | 1 + src/import-export/qif-import/Makefile.am | 1 + src/import-export/qif-import/qif-import.scm | 3 - src/import-export/qif-io-core/Makefile.am | 2 +- .../qif-io-core/test/Makefile.am | 4 +- .../qif-io-core/test/test-load-module.scm | 9 +- src/register/ledger-core/Makefile.am | 1 + src/register/register-core/Makefile.am | 1 + src/register/register-gnome/Makefile.am | 1 + src/report/Makefile.am | 7 + src/report/locale-specific/Makefile.am | 1 + src/report/locale-specific/us/Makefile.am | 30 + .../us/gncmod-locale-reports-us.c | 52 + .../locale-specific/us}/taxtxf.scm | 12 +- .../locale-specific/us/test/Makefile.am | 7 + .../locale-specific/us/test/test-load-module | 16 + .../locale-specific/us}/txf-export-help.scm | 1 - .../locale-specific/us}/txf-export.scm | 3 - src/report/locale-specific/us/us.scm | 3 + src/report/report-system/Makefile.am | 44 + .../report-system}/commodity-utilities.scm | 4 - .../report-system/doc}/report-html.txt | 0 .../report-system/gncmod-report-system.c | 66 + .../report-system}/html-barchart.scm | 9 +- .../report-system}/html-document.scm | 5 +- .../report-system}/html-piechart.scm | 6 +- .../report-system}/html-scatter.scm | 6 +- .../report-system}/html-style-info.scm | 1 - .../report-system}/html-style-sheet.scm | 2 - .../report-system}/html-table.scm | 2 - .../report-system}/html-text.scm | 9 +- .../report-system}/html-utilities.scm | 9 +- .../report-system}/options-utilities.scm | 3 - src/report/report-system/report-system.scm | 544 ++++ .../report-system}/report-utilities.scm | 19 +- src/{scm => report/report-system}/report.scm | 11 +- src/report/report-system/test/Makefile.am | 15 + .../report-system/test/test-link-module.c | 6 + .../report-system/test/test-load-module | 26 + src/report/standard-reports/Makefile.am | 36 + .../standard-reports}/account-piecharts.scm | 6 +- .../standard-reports}/account-summary.scm | 5 +- .../standard-reports}/average-balance.scm | 7 +- .../standard-reports}/balance-sheet.scm | 5 +- .../standard-reports}/category-barchart.scm | 5 +- .../gncmod-standard-reports.c | 51 + .../standard-reports}/net-barchart.scm | 7 +- .../standard-reports}/payables.scm | 7 +- .../standard-reports}/pnl.scm | 5 +- .../standard-reports}/portfolio.scm | 5 +- .../standard-reports}/price-scatter.scm | 5 +- .../standard-reports}/register.scm | 8 +- .../standard-reports/standard-reports.scm | 21 + src/report/standard-reports/test/Makefile.am | 6 + .../standard-reports/test/test-load-module | 19 + .../standard-reports}/transaction.scm | 6 +- src/report/stylesheets/Makefile.am | 27 + src/report/stylesheets/gncmod-stylesheets.c | 52 + src/report/stylesheets/stylesheet-fancy.scm | 308 +++ src/report/stylesheets/stylesheet-plain.scm | 175 ++ src/report/stylesheets/stylesheets.scm | 11 + src/report/stylesheets/test/Makefile.am | 6 + src/report/stylesheets/test/test-load-module | 19 + src/report/utility-reports/Makefile.am | 28 + .../utility-reports/gncmod-utility-reports.c | 52 + .../utility-reports}/hello-world.scm | 11 +- .../utility-reports}/iframe-url.scm | 5 +- src/report/utility-reports/test/Makefile.am | 6 + .../utility-reports/test/test-load-module | 19 + .../utility-reports/utility-reports.scm | 14 + src/report/utility-reports/view-column.scm | 228 ++ .../utility-reports}/welcome-to-gnucash.scm | 41 +- src/scm/Makefile.am | 29 +- src/scm/main.scm | 10 +- src/scm/report-html.scm | 68 - src/scm/report/.cvsignore | 3 - src/scm/report/Makefile.am | 43 - src/scm/report/report-list.scm | 34 - src/scm/report/stylesheet-fancy.scm | 313 --- src/scm/report/stylesheet-plain.scm | 174 -- src/scm/report/view-column.scm | 224 -- src/scm/tip-of-the-day.scm | 1 - 126 files changed, 7649 insertions(+), 1313 deletions(-) create mode 100644 src/app-utils/Makefile.am create mode 100644 src/app-utils/app-utils.scm rename src/{scm => app-utils}/c-interface.scm (98%) rename src/{scm => app-utils}/date-utilities.scm (69%) create mode 100644 src/app-utils/gfec.c create mode 100644 src/app-utils/gfec.h create mode 100644 src/app-utils/global-options.c create mode 100644 src/app-utils/global-options.h rename src/{ => app-utils}/gnc-component-manager.c (99%) rename src/{ => app-utils}/gnc-component-manager.h (100%) create mode 100644 src/app-utils/gnc-gettext-util.c create mode 100644 src/app-utils/gnc-gettext-util.h create mode 100644 src/app-utils/gnc-helpers.c create mode 100644 src/app-utils/gnc-helpers.h rename src/{ => app-utils}/gnc-ui-util.c (99%) rename src/{ => app-utils}/gnc-ui-util.h (100%) create mode 100644 src/app-utils/gncmod-app-utils.c create mode 100644 src/app-utils/guile-util.c create mode 100644 src/app-utils/guile-util.h create mode 100644 src/app-utils/gw-app-utils-spec.scm rename src/{scm => app-utils}/hooks.scm (99%) create mode 100644 src/app-utils/option-util.c create mode 100644 src/app-utils/option-util.h rename src/{scm => app-utils}/options.scm (100%) create mode 100644 src/app-utils/test/Makefile.am create mode 100644 src/app-utils/test/test-link-module.c create mode 100755 src/app-utils/test/test-load-module create mode 100644 src/report/Makefile.am create mode 100644 src/report/locale-specific/Makefile.am create mode 100644 src/report/locale-specific/us/Makefile.am create mode 100644 src/report/locale-specific/us/gncmod-locale-reports-us.c rename src/{scm/report => report/locale-specific/us}/taxtxf.scm (99%) create mode 100644 src/report/locale-specific/us/test/Makefile.am create mode 100755 src/report/locale-specific/us/test/test-load-module rename src/{scm/report => report/locale-specific/us}/txf-export-help.scm (99%) rename src/{scm/report => report/locale-specific/us}/txf-export.scm (99%) create mode 100644 src/report/locale-specific/us/us.scm create mode 100644 src/report/report-system/Makefile.am rename src/{scm => report/report-system}/commodity-utilities.scm (99%) rename src/{scm => report/report-system/doc}/report-html.txt (100%) create mode 100644 src/report/report-system/gncmod-report-system.c rename src/{scm => report/report-system}/html-barchart.scm (99%) rename src/{scm => report/report-system}/html-document.scm (99%) rename src/{scm => report/report-system}/html-piechart.scm (98%) rename src/{scm => report/report-system}/html-scatter.scm (98%) rename src/{scm => report/report-system}/html-style-info.scm (99%) rename src/{scm => report/report-system}/html-style-sheet.scm (99%) rename src/{scm => report/report-system}/html-table.scm (99%) rename src/{scm => report/report-system}/html-text.scm (98%) rename src/{scm => report/report-system}/html-utilities.scm (99%) rename src/{scm => report/report-system}/options-utilities.scm (99%) create mode 100644 src/report/report-system/report-system.scm rename src/{scm => report/report-system}/report-utilities.scm (98%) rename src/{scm => report/report-system}/report.scm (99%) create mode 100644 src/report/report-system/test/Makefile.am create mode 100644 src/report/report-system/test/test-link-module.c create mode 100755 src/report/report-system/test/test-load-module create mode 100644 src/report/standard-reports/Makefile.am rename src/{scm/report => report/standard-reports}/account-piecharts.scm (99%) rename src/{scm/report => report/standard-reports}/account-summary.scm (98%) rename src/{scm/report => report/standard-reports}/average-balance.scm (98%) rename src/{scm/report => report/standard-reports}/balance-sheet.scm (99%) rename src/{scm/report => report/standard-reports}/category-barchart.scm (99%) create mode 100644 src/report/standard-reports/gncmod-standard-reports.c rename src/{scm/report => report/standard-reports}/net-barchart.scm (98%) rename src/{scm/report => report/standard-reports}/payables.scm (99%) rename src/{scm/report => report/standard-reports}/pnl.scm (98%) rename src/{scm/report => report/standard-reports}/portfolio.scm (98%) rename src/{scm/report => report/standard-reports}/price-scatter.scm (98%) rename src/{scm/report => report/standard-reports}/register.scm (99%) create mode 100644 src/report/standard-reports/standard-reports.scm create mode 100644 src/report/standard-reports/test/Makefile.am create mode 100755 src/report/standard-reports/test/test-load-module rename src/{scm/report => report/standard-reports}/transaction.scm (99%) create mode 100644 src/report/stylesheets/Makefile.am create mode 100644 src/report/stylesheets/gncmod-stylesheets.c create mode 100644 src/report/stylesheets/stylesheet-fancy.scm create mode 100644 src/report/stylesheets/stylesheet-plain.scm create mode 100644 src/report/stylesheets/stylesheets.scm create mode 100644 src/report/stylesheets/test/Makefile.am create mode 100755 src/report/stylesheets/test/test-load-module create mode 100644 src/report/utility-reports/Makefile.am create mode 100644 src/report/utility-reports/gncmod-utility-reports.c rename src/{scm/report => report/utility-reports}/hello-world.scm (99%) rename src/{scm/report => report/utility-reports}/iframe-url.scm (90%) create mode 100644 src/report/utility-reports/test/Makefile.am create mode 100755 src/report/utility-reports/test/test-load-module create mode 100644 src/report/utility-reports/utility-reports.scm create mode 100644 src/report/utility-reports/view-column.scm rename src/{scm/report => report/utility-reports}/welcome-to-gnucash.scm (82%) delete mode 100644 src/scm/report-html.scm delete mode 100644 src/scm/report/.cvsignore delete mode 100644 src/scm/report/Makefile.am delete mode 100644 src/scm/report/report-list.scm delete mode 100644 src/scm/report/stylesheet-fancy.scm delete mode 100644 src/scm/report/stylesheet-plain.scm delete mode 100644 src/scm/report/view-column.scm diff --git a/ChangeLog b/ChangeLog index 7049e8e131..38d8332c44 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,21 @@ +2001-08-16 Bill Gribble + + * move report system into gnc-modules. This required a new + module of application framework stuff, src/app-utils. + + * src/report/report-system/: the report-html-generation code + and the various report utilities and infrastructure + + * src/report/standard-reports/: non-locale-specific financial + reports + + * src/report/utility-reports: non-financial reports + + * src/report/locale-specific: reports that only apply to specific + locales. + + * src/report/stylesheet: report style sheet definitions + 2001-08-16 Robert Graham Merkel * src/engine/FreqSpec.c: Take out day and month name arrays - use @@ -7,10 +25,11 @@ buttons to obsolete-sx dialog. * src/gnome/dialog-sxsincelast.c: Remove string literals and magic - numbers. (freq_type_to_string) remove. (_create_transactions_on): - catch errors a bit better. (sx_obsolete_row_{un}sel): remove unnecessary - warnings. (sx_obsolete_{un}select_all_clicked): add callbacks for - "select all" and "unselect all" buttons. + numbers. (freq_type_to_string) remove. + (_create_transactions_on): catch errors a bit + better. (sx_obsolete_row_{un}sel): remove unnecessary warnings. + (sx_obsolete_{un}select_all_clicked): add callbacks for "select + all" and "unselect all" buttons. 2001-08-15 Christian Stimming diff --git a/configure.in b/configure.in index 9e40a0481a..7813b3a631 100644 --- a/configure.in +++ b/configure.in @@ -620,11 +620,8 @@ AC_OUTPUT( po/Makefile rpm/Makefile src/Makefile - src/calculation/Makefile - src/doc/Makefile - src/doc/design/Makefile - src/engine/Makefile - src/engine/test/Makefile + src/app-utils/Makefile + src/app-utils/test/Makefile src/backend/Makefile src/backend/file/Makefile src/backend/file/test/Makefile @@ -633,6 +630,11 @@ AC_OUTPUT( src/backend/postgres/Makefile src/backend/postgres/test/Makefile src/backend/rpc/Makefile + src/calculation/Makefile + src/doc/Makefile + src/doc/design/Makefile + src/engine/Makefile + src/engine/test/Makefile src/experimental/Makefile src/experimental/cbb/Makefile src/experimental/cbb/cbb-engine/Makefile @@ -663,10 +665,21 @@ AC_OUTPUT( src/register/ledger-core/Makefile src/register/register-core/Makefile src/register/register-gnome/Makefile + src/report/Makefile + src/report/report-system/test/Makefile + src/report/report-system/Makefile + src/report/standard-reports/test/Makefile + src/report/standard-reports/Makefile + src/report/locale-specific/Makefile + src/report/locale-specific/us/Makefile + src/report/locale-specific/us/test/Makefile + src/report/stylesheets/test/Makefile + src/report/stylesheets/Makefile + src/report/utility-reports/Makefile + src/report/utility-reports/test/Makefile src/scm/Makefile src/scm/gnumeric/Makefile src/scm/printing/Makefile - src/scm/report/Makefile src/test/Makefile dnl # non-makefiles diff --git a/make-gnucash-patch.in b/make-gnucash-patch.in index 1126276e5a..5e75f1a6f2 100644 --- a/make-gnucash-patch.in +++ b/make-gnucash-patch.in @@ -267,6 +267,7 @@ __DATA__ #*# *.P +*.pp *.a *.bak *.bin diff --git a/src/FileDialog.c b/src/FileDialog.c index 2848fdec2a..a1cadac48f 100644 --- a/src/FileDialog.c +++ b/src/FileDialog.c @@ -37,7 +37,7 @@ #include "gnc-event.h" #include "gnc-ui.h" #include "messages.h" -#include "guile/global-options.h" +#include "global-options.h" /* FIXME: this is wrong. This file should not need this include. */ #include "gnc-book-p.h" @@ -176,7 +176,7 @@ show_book_error (GNCBackendError io_error, const char *newfile) case ERR_SQL_DB_TOO_OLD: fmt = _("This database is from an older version of GnuCash.\n" - "Do you want to upgrade the database " + "Do you want to want to upgrade the database" "to the current version?"); if (gnc_verify_dialog (fmt, TRUE)) { uh_oh = FALSE; } break; diff --git a/src/Makefile.am b/src/Makefile.am index 389b86bae4..d01377071f 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -4,8 +4,10 @@ SUBDIRS = \ gnc-module \ engine \ backend \ + app-utils \ register \ import-export \ + report \ calculation \ experimental \ guile \ @@ -27,7 +29,9 @@ bin_PROGRAMS = gnucash gnucash-make-guids # that's fixed. gnucash_LDADD = \ -Lengine -Lengine/.libs \ + -Lgnc-module -Lgnc-module/.libs \ gnc-module/libgncmodule.la \ + app-utils/libgncmod-app-utils.la \ engine/libgncmod-engine.la \ engine/libgw-engine.la \ engine/libgw-glib.la \ @@ -56,10 +60,8 @@ gnucash_LDADD = \ gnucash_SOURCES = \ EuroUtils.c \ FileDialog.c \ - gnc-component-manager.c \ - gnc-exp-parser.c \ gnc-main.c \ - gnc-ui-util.c + gnc-exp-parser.c gnucash_make_guids_LDADD = \ gnc-module/libgncmodule.la \ @@ -79,11 +81,8 @@ noinst_HEADERS = \ FileDialog.h \ RecnWindow.h \ file-history.h \ - gnc-component-manager.h \ - gnc-exp-parser.h \ gnc-ui.h \ gnc-ui-common.h \ - gnc-ui-util.h \ messages.h EXTRA_DIST = \ @@ -93,6 +92,7 @@ EXTRA_DIST = \ CFLAGS = @CFLAGS@ ${GNOME_INCLUDEDIR} ${GUILE_INCS} INCLUDES = \ + -I./app-utils \ -I./calculation \ -I./engine \ -I./guile \ diff --git a/src/README.modules b/src/README.modules index 3d78e60bf3..7b703d5513 100644 --- a/src/README.modules +++ b/src/README.modules @@ -26,3 +26,12 @@ register/register-gnome Gnome-specific register code, formerly in import-export/qif-import the old qif importer with Gnome druid import-export/qif-io-core new qif import/export module. unfinished. +report/report-system the report infrastructure and HTML handling +report/standard-reports most of the reports that are in gnucash +report/utility-reports the multicolumn view, the iframe report, etc. +report/locale-specific-reports reports that should only be loaded in + certain locales. subdir per locale. +report/stylesheets predefined style sheet templates + +app-utils utils for the gnucash app framework (component + mgr, cmd line processing, gettext stuff, etc) diff --git a/src/app-utils/Makefile.am b/src/app-utils/Makefile.am new file mode 100644 index 0000000000..2b4170e4c7 --- /dev/null +++ b/src/app-utils/Makefile.am @@ -0,0 +1,67 @@ +SUBDIRS = . test + +pkglib_LTLIBRARIES = libgncmod-app-utils.la + +CFLAGS = @CFLAGS@ ${GLIB_CFLAGS} ${G_WRAP_COMPILE_ARGS} + +INCLUDES = -I${top_srcdir}/src/gnc-module \ + -I${top_srcdir}/src/engine ${GUILE_INCS} \ + -I.. + +libgncmod_app_utils_la_SOURCES = \ + gfec.c \ + global-options.c \ + gnc-component-manager.c \ + gnc-gettext-util.c \ + gnc-helpers.c \ + gncmod-app-utils.c \ + gnc-ui-util.c \ + guile-util.c \ + option-util.c + +noinst_HEADERS = \ + gnc-component-manager.h \ + gnc-gettext-util.h \ + gnc-helpers.h \ + gnc-ui-util.h \ + guile-util.h + +libgncmod_app_utils_la_LDFLAGS = -module + +libgncmod_app_utils_la_LIBADD = \ + -L../engine -L../engine/.libs -lgncmod-engine \ + -L../gnc-module -L../gnc-module/.libs -lgncmodule \ + ${GUILE_LIBS} ${GLIB_LIBS} + +libgw_app_utils_la_SOURCES=gw-app-utils.c +libgw_app_utils_la_LDFLAGS=-module + +gncmoddir=${GNC_SHAREDIR}/guile-modules/gnucash +gncmod_DATA=app-utils.scm + +gncscmdir=${GNC_SHAREDIR}/scm +gncscm_DATA=c-interface.scm options.scm hooks.scm date-utilities.scm + +gwmoddir=${GNC_SHAREDIR}/guile-modules/g-wrapped +gwmod_LTLIBRARIES=libgw-app-utils.la +gwmod_DATA=gw-app-utils-spec.scm + +noinst_DATA=.scm-links + +.scm-links: + rm -f gnucash g-wrapped + ln -sf . gnucash + ln -sf . g-wrapped + touch .scm-links + +gw-app-utils.c gw-app-utils.h: .scm-links gw-app-utils-spec.scm + FLAVOR=gnome guile -c \ + "(set! %load-path (cons \"${G_WRAP_MODULE_DIR}\" %load-path)) \ + (set! %load-path (cons \"${PWD}\" %load-path)) \ + (set! %load-path (cons \"${top_srcdir}/src/engine\" %load-path)) \ + (primitive-load \"./gw-app-utils-spec.scm\") \ + (gw:generate-module \"gw-app-utils\")" + +BUILT_SOURCES += gw-app-utils.c gw-app-utils.h +CLEANFILES += gw-app-utils.c gw-app-utils.h gw-app-utils.html \ + gnucash g-wrapped .scm-links diff --git a/src/app-utils/app-utils.scm b/src/app-utils/app-utils.scm new file mode 100644 index 0000000000..f2baee9ee3 --- /dev/null +++ b/src/app-utils/app-utils.scm @@ -0,0 +1,208 @@ + +(define-module (gnucash app-utils)) +(use-modules (g-wrapped gw-app-utils)) +(use-modules (srfi srfi-1)) + + +;; c-interface.scm +(export gnc:error->string) +(export gnc:gettext) +(export gnc:_) +(export _) +(export-syntax N_) +(export gnc:make-string-database) + +(export gnc:make-option) +(export gnc:option-section) +(export gnc:option-name) +(export gnc:option-sort-tag) +(export gnc:option-type) +(export gnc:option-documentation) +(export gnc:option-getter) +(export gnc:option-setter) +(export gnc:option-default-getter) +(export gnc:option-generate-restore-form) +(export gnc:option-value-validator) +(export gnc:option-data) +(export gnc:option-data-fns) +(export gnc:option-set-changed-callback) +(export gnc:option-strings-getter) +(export gnc:option-widget-changed-proc) +(export gnc:option-value) +(export gnc:option-set-value) +(export gnc:option-index-get-name) +(export gnc:option-index-get-description) +(export gnc:option-index-get-value) +(export gnc:option-value-get-index) +(export gnc:option-number-of-indices) +(export gnc:option-default-value) +(export gnc:restore-form-generator) +(export gnc:value->string) +(export gnc:make-string-option) +(export gnc:make-text-option) +(export gnc:make-font-option) +(export gnc:make-currency-option) +(export gnc:make-commodity-option) +(export gnc:make-simple-boolean-option) +(export gnc:make-complex-boolean-option) +(export gnc:make-pixmap-option) +(export gnc:make-date-option) +(export gnc:get-rd-option-data-subtype) +(export gnc:get-rd-option-data-show-time) +(export gnc:get-rd-option-data-rd-list) +(export gnc:date-option-get-subtype) +(export gnc:date-option-show-time?) +(export gnc:date-option-value-type) +(export gnc:date-option-absolute-time) +(export gnc:date-option-relative-time) +(export gnc:make-account-list-option) +(export gnc:multichoice-list-lookup) +(export gnc:make-multichoice-option) +(export gnc:make-multichoice-callback-option) +(export gnc:make-list-option) + +(export gnc:make-number-range-option) +(export gnc:make-internal-option) +(export gnc:make-query-option) +(export gnc:make-color-option) + +(export gnc:color->html) +(export gnc:color-option->html) +(export gnc:color-option->hex-string) +(export gnc:new-options) + +(export gnc:register-option) +(export gnc:options-register-callback) +(export gnc:options-register-c-callback) +(export gnc:options-unregister-callback-id) +(export gnc:options-for-each) +(export gnc:options-for-each-general) +(export gnc:lookup-option) +(export gnc:generate-restore-forms) +(export gnc:options-clear-changes) +(export gnc:options-touch) +(export gnc:options-run-callbacks) +(export gnc:options-set-default-section) +(export gnc:options-get-default-section) +(export gnc:options-copy-values) +(export gnc:send-options) +(export gnc:save-options) + +;; date-utilities.scm + +(export gnc:reldate-list) +(export gnc:timepair->secs) +(export gnc:secs->timepair) +(export gnc:timepair->date) +(export gnc:date->timepair) +(export gnc:date-get-year) +(export gnc:date-get-month-day) +(export gnc:date-get-month) +(export gnc:date-get-week-day) +(export gnc:date-get-year-day) +(export gnc:timepair-get-year) +(export gnc:timepair-get-month-day) +(export gnc:timepair-get-month) +(export gnc:timepair-get-week-day) +(export gnc:timepair-get-year-day) +(export gnc:date-get-month-string) +(export gnc:leap-year?) +(export gnc:days-in-year) +(export gnc:days-in-month) +(export gnc:date-to-year-fraction) +(export gnc:date-year-delta) +(export gnc:date-to-month-fraction) +(export gnc:date-to-week-fraction) +(export gnc:date-to-day-fraction) +(export moddatek) +(export decdate) +(export incdate) +(export gnc:timepair-later) +(export gnc:timepair-lt) +(export gnc:timepair-earlier) +(export gnc:timepair-gt) +(export gnc:timepair-le) +(export gnc:timepair-ge) +(export gnc:timepair-eq) +(export gnc:timepair-earlier-date) +(export gnc:timepair-later-date) +(export gnc:timepair-le-date) +(export gnc:timepair-ge-date) +(export gnc:timepair-eq-date) +(export gnc:make-date-interval-list) +(export gnc:make-date-list) +(export make-zdate) +(export SecDelta ) +(export DayDelta) +(export WeekDelta ) +(export TwoWeekDelta) +(export MonthDelta) +(export QuarterDelta) +(export HalfYearDelta) +(export YearDelta ) +(export ThirtyDayDelta) +(export NinetyDayDelta) +(export gnc:timepair-delta) +(export gnc:time-elapsed) +(export gnc:timepair-to-datestring) +(export gnc:timepair-start-day-time) +(export gnc:timepair-end-day-time) +(export gnc:timepair-previous-day) +(export gnc:reldate-get-symbol) +(export gnc:reldate-get-string) +(export gnc:reldate-get-desc) +(export gnc:reldate-get-fn) +(export gnc:make-reldate-hash) +(export gnc:reldate-string-db) +(export gnc:relative-date-values) +(export gnc:relative-date-hash) +(export gnc:get-absolute-from-relative-date) +(export gnc:get-relative-date-strings) +(export gnc:get-relative-date-string) +(export gnc:get-relative-date-desc) +(export gnc:get-start-cal-year) +(export gnc:get-end-cal-year) +(export gnc:get-start-prev-year) +(export gnc:get-end-prev-year) +(export gnc:get-start-cur-fin-year) +(export gnc:get-start-prev-fin-year) +(export gnc:get-end-prev-fin-year) +(export gnc:get-end-cur-fin-year) +(export gnc:get-start-this-month) +(export gnc:get-end-this-month) +(export gnc:get-start-prev-month) +(export gnc:get-end-prev-month) +(export gnc:get-start-current-quarter) +(export gnc:get-end-current-quarter) +(export gnc:get-start-prev-quarter) +(export gnc:get-end-prev-quarter) +(export gnc:get-today) +(export gnc:get-one-month-ago) +(export gnc:get-three-months-ago) +(export gnc:get-six-months-ago) +(export gnc:get-one-year-ago) +(export gnc:reldate-initialize) + +;; hooks +(export gnc:hook-export) +(export gnc:hook-danglers-get) +(export gnc:hook-danglers-set!) +(export gnc:hook-danglers->list) +(export gnc:hook-replace-danglers) +(export gnc:hook-run-danglers) +(export gnc:hook-lookup) +(export gnc:hook-add-dangler) +(export gnc:hook-remove-dangler) +(export gnc:hook-description-get) +(export gnc:hook-name-get) +(export gnc:*startup-hook*) +(export gnc:*shutdown-hook*) +(export gnc:*ui-startup-hook*) +(export gnc:*ui-shutdown-hook*) +(export gnc:*book-opened-hook*) +(export gnc:*book-closed-hook*) + +(load-from-path "c-interface.scm") +(load-from-path "options.scm") +(load-from-path "hooks.scm") +(load-from-path "date-utilities.scm") diff --git a/src/scm/c-interface.scm b/src/app-utils/c-interface.scm similarity index 98% rename from src/scm/c-interface.scm rename to src/app-utils/c-interface.scm index 8abaeeca9c..a4ddfdf016 100644 --- a/src/scm/c-interface.scm +++ b/src/app-utils/c-interface.scm @@ -15,10 +15,11 @@ ;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 ;; Boston, MA 02111-1307, USA gnu@gnu.org -(require 'hash-table) - +(use-modules (ice-9 slib)) (use-modules (ice-9 syncase)) +(require 'hash-table) + (define (gnc:error->string tag args) (define (write-error port) (if (and (list? args) (not (null? args))) @@ -69,5 +70,5 @@ (if func (apply func args) (gnc:warn "string-database: bad message" message "\n")))) - + dispatch) diff --git a/src/scm/date-utilities.scm b/src/app-utils/date-utilities.scm similarity index 69% rename from src/scm/date-utilities.scm rename to src/app-utils/date-utilities.scm index 2281a1bded..82292effd5 100644 --- a/src/scm/date-utilities.scm +++ b/src/app-utils/date-utilities.scm @@ -19,10 +19,6 @@ ;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 ;; Boston, MA 02111-1307, USA gnu@gnu.org -(use-modules (srfi srfi-19)) - -(gnc:support "date-utilities.scm") - (define gnc:reldate-list '()) (define (gnc:timepair->secs tp) @@ -246,6 +242,7 @@ (set-tm:isdst zd -1) zd)) + (define SecDelta (let ((ddt (make-zdate))) (set-tm:sec ddt 1) @@ -671,246 +668,242 @@ ;;start-cur-fin-year start-prev-fin-year end-prev-fin-year (define (gnc:reldate-initialize) - (begin - (gnc:reldate-string-db - 'store 'start-cal-year-string - (N_ "Current Year Start")) - (gnc:reldate-string-db - 'store 'start-cal-year-desc - (N_ "Start of the current calendar year")) + (gnc:reldate-string-db + 'store 'start-cal-year-string + (N_ "Current Year Start")) - (gnc:reldate-string-db - 'store 'end-cal-year-string - (N_ "Current Year End")) - (gnc:reldate-string-db - 'store 'end-cal-year-desc - (N_ "End of the current calendar year")) + (gnc:reldate-string-db + 'store 'start-cal-year-desc + (N_ "Start of the current calendar year")) - (gnc:reldate-string-db - 'store 'start-prev-year-string - (N_ "Previous Year Start")) - (gnc:reldate-string-db - 'store 'start-prev-year-desc - (N_ "Beginning of the previous calendar year")) + (gnc:reldate-string-db + 'store 'end-cal-year-string + (N_ "Current Year End")) + (gnc:reldate-string-db + 'store 'end-cal-year-desc + (N_ "End of the current calendar year")) - (gnc:reldate-string-db - 'store 'end-prev-year-string - (N_ "Previous Year End")) - (gnc:reldate-string-db - 'store 'end-prev-year-desc - (N_ "End of the Previous Year")) + (gnc:reldate-string-db + 'store 'start-prev-year-string + (N_ "Previous Year Start")) + (gnc:reldate-string-db + 'store 'start-prev-year-desc + (N_ "Beginning of the previous calendar year")) - (gnc:reldate-string-db - 'store 'start-cur-fin-year-string - (N_ "Current Financial Year Start")) - (gnc:reldate-string-db - 'store 'start-cur-fin-year-desc - (N_ "Start of the current financial year/accounting period")) + (gnc:reldate-string-db + 'store 'end-prev-year-string + (N_ "Previous Year End")) + (gnc:reldate-string-db + 'store 'end-prev-year-desc + (N_ "End of the Previous Year")) - (gnc:reldate-string-db - 'store 'start-prev-fin-year-string - (N_ "Previous Financial Year Start")) - (gnc:reldate-string-db - 'store 'start-prev-fin-year-desc - (N_ "The start of the previous financial year/accounting period")) + (gnc:reldate-string-db + 'store 'start-cur-fin-year-string + (N_ "Current Financial Year Start")) + (gnc:reldate-string-db + 'store 'start-cur-fin-year-desc + (N_ "Start of the current financial year/accounting period")) - (gnc:reldate-string-db - 'store 'end-prev-fin-year-string - (N_ "End Previous Financial Year")) - (gnc:reldate-string-db - 'store 'end-prev-fin-year-desc - (N_ "End of the previous Financial year/Accounting Period")) + (gnc:reldate-string-db + 'store 'start-prev-fin-year-string + (N_ "Previous Financial Year Start")) + (gnc:reldate-string-db + 'store 'start-prev-fin-year-desc + (N_ "The start of the previous financial year/accounting period")) - (gnc:reldate-string-db - 'store 'end-cur-fin-year-string - (N_ "End Current Financial Year")) - (gnc:reldate-string-db - 'store 'end-cur-fin-year-desc - (N_ "End of the current Financial year/Accounting Period")) + (gnc:reldate-string-db + 'store 'end-prev-fin-year-string + (N_ "End Previous Financial Year")) + (gnc:reldate-string-db + 'store 'end-prev-fin-year-desc + (N_ "End of the previous Financial year/Accounting Period")) - (gnc:reldate-string-db - 'store 'start-this-month-string - (N_ "Start of this month")) - (gnc:reldate-string-db - 'store 'start-this-month-desc - (N_ "Start of the current month")) + (gnc:reldate-string-db + 'store 'end-cur-fin-year-string + (N_ "End Current Financial Year")) + (gnc:reldate-string-db + 'store 'end-cur-fin-year-desc + (N_ "End of the current Financial year/Accounting Period")) - (gnc:reldate-string-db - 'store 'end-this-month-string - (N_ "End of this month")) - (gnc:reldate-string-db - 'store 'end-this-month-desc - (N_ "End of the current month")) + (gnc:reldate-string-db + 'store 'start-this-month-string + (N_ "Start of this month")) + (gnc:reldate-string-db + 'store 'start-this-month-desc + (N_ "Start of the current month")) - (gnc:reldate-string-db - 'store 'start-prev-month-string - (N_ "Start of previous month")) - (gnc:reldate-string-db - 'store 'start-prev-month-desc - (N_ "The beginning of the previous month")) + (gnc:reldate-string-db + 'store 'end-this-month-string + (N_ "End of this month")) + (gnc:reldate-string-db + 'store 'end-this-month-desc + (N_ "End of the current month")) - (gnc:reldate-string-db - 'store 'end-prev-month-string - (N_ "End of previous month")) - (gnc:reldate-string-db - 'store 'end-prev-month-desc - (N_ "Last day of previous month")) + (gnc:reldate-string-db + 'store 'start-prev-month-string + (N_ "Start of previous month")) + (gnc:reldate-string-db + 'store 'start-prev-month-desc + (N_ "The beginning of the previous month")) - (gnc:reldate-string-db - 'store 'start-current-quarter-string - (N_ "Start of current quarter")) - (gnc:reldate-string-db - 'store 'start-current-quarter-desc - (N_ "The start of the latest quarterly accounting period")) + (gnc:reldate-string-db + 'store 'end-prev-month-string + (N_ "End of previous month")) + (gnc:reldate-string-db + 'store 'end-prev-month-desc + (N_ "Last day of previous month")) - (gnc:reldate-string-db - 'store 'end-current-quarter-string - (N_ "End of current quarter")) - (gnc:reldate-string-db - 'store 'end-current-quarter-desc - (N_ "The end of the latest quarterly accounting period")) + (gnc:reldate-string-db + 'store 'start-current-quarter-string + (N_ "Start of current quarter")) + (gnc:reldate-string-db + 'store 'start-current-quarter-desc + (N_ "The start of the latest quarterly accounting period")) - (gnc:reldate-string-db - 'store 'start-prev-quarter-string - (N_ "Start of previous quarter")) - (gnc:reldate-string-db - 'store 'start-prev-quarter-desc - (N_ "The start of the previous quarterly accounting period")) + (gnc:reldate-string-db + 'store 'end-current-quarter-string + (N_ "End of current quarter")) + (gnc:reldate-string-db + 'store 'end-current-quarter-desc + (N_ "The end of the latest quarterly accounting period")) - (gnc:reldate-string-db - 'store 'end-prev-quarter-string - (N_ "End of previous quarter")) - (gnc:reldate-string-db - 'store 'end-prev-quarter-desc - (N_ "End of previous quarterly accounting period")) + (gnc:reldate-string-db + 'store 'start-prev-quarter-string + (N_ "Start of previous quarter")) + (gnc:reldate-string-db + 'store 'start-prev-quarter-desc + (N_ "The start of the previous quarterly accounting period")) - (gnc:reldate-string-db - 'store 'today-string - (N_ "Today")) - (gnc:reldate-string-db - 'store 'today-desc (N_ "The current date")) + (gnc:reldate-string-db + 'store 'end-prev-quarter-string + (N_ "End of previous quarter")) + (gnc:reldate-string-db + 'store 'end-prev-quarter-desc + (N_ "End of previous quarterly accounting period")) - (gnc:reldate-string-db - 'store 'one-month-ago-string - (N_ "One Month Ago")) - (gnc:reldate-string-db - 'store 'one-month-ago-desc (N_ "One Month Ago")) + (gnc:reldate-string-db + 'store 'today-string + (N_ "Today")) + (gnc:reldate-string-db + 'store 'today-desc (N_ "The current date")) - (gnc:reldate-string-db - 'store 'one-week-ago-string - (N_ "One Week Ago")) - (gnc:reldate-string-db - 'store 'one-week-ago-desc (N_ "One Week Ago")) + (gnc:reldate-string-db + 'store 'one-month-ago-string + (N_ "One Month Ago")) + (gnc:reldate-string-db + 'store 'one-month-ago-desc (N_ "One Month Ago")) - (gnc:reldate-string-db - 'store 'three-months-ago-string - (N_ "Three Months Ago")) - (gnc:reldate-string-db - 'store 'three-months-ago-desc (N_ "Three Months Ago")) + (gnc:reldate-string-db + 'store 'one-week-ago-string + (N_ "One Week Ago")) + (gnc:reldate-string-db + 'store 'one-week-ago-desc (N_ "One Week Ago")) - (gnc:reldate-string-db - 'store 'six-months-ago-string - (N_ "Six Months Ago")) - (gnc:reldate-string-db - 'store 'six-months-ago-desc (N_ "Six Months Ago")) + (gnc:reldate-string-db + 'store 'three-months-ago-string + (N_ "Three Months Ago")) + (gnc:reldate-string-db + 'store 'three-months-ago-desc (N_ "Three Months Ago")) - (gnc:reldate-string-db - 'store 'one-year-ago-string (N_ "One Year Ago")) - (gnc:reldate-string-db - 'store 'one-year-ago-desc (N_ "One Year Ago")) + (gnc:reldate-string-db + 'store 'six-months-ago-string + (N_ "Six Months Ago")) + (gnc:reldate-string-db + 'store 'six-months-ago-desc (N_ "Six Months Ago")) - (set! gnc:relative-date-values - (list - (vector 'start-cal-year - (gnc:reldate-string-db 'lookup 'start-cal-year-string) - (gnc:reldate-string-db 'lookup 'start-cal-year-desc) - gnc:get-start-cal-year) - (vector 'end-cal-year - (gnc:reldate-string-db 'lookup 'end-cal-year-string) - (gnc:reldate-string-db 'lookup 'end-cal-year-desc) - gnc:get-end-cal-year) - (vector 'start-prev-year - (gnc:reldate-string-db 'lookup 'start-prev-year-string) - (gnc:reldate-string-db 'lookup 'start-prev-year-desc) - gnc:get-start-prev-year) - (vector 'end-prev-year - (gnc:reldate-string-db 'lookup 'end-prev-year-string) - (gnc:reldate-string-db 'lookup 'end-prev-year-desc) - gnc:get-end-prev-year) - (vector 'start-cur-fin-year - (gnc:reldate-string-db 'lookup 'start-cur-fin-year-string) - (gnc:reldate-string-db 'lookup 'start-cur-fin-year-desc) - gnc:get-start-cur-fin-year) - (vector 'start-prev-fin-year - (gnc:reldate-string-db 'lookup 'start-prev-fin-year-string) - (gnc:reldate-string-db 'lookup 'start-prev-fin-year-desc) - gnc:get-start-prev-fin-year) - (vector 'end-prev-fin-year - (gnc:reldate-string-db 'lookup 'end-prev-fin-year-string) - (gnc:reldate-string-db 'lookup 'end-prev-fin-year-desc) - gnc:get-end-prev-fin-year) - (vector 'end-cur-fin-year - (gnc:reldate-string-db 'lookup 'end-cur-fin-year-string) - (gnc:reldate-string-db 'lookup 'end-cur-fin-year-desc) - gnc:get-end-cur-fin-year) - (vector 'start-this-month - (gnc:reldate-string-db 'lookup 'start-this-month-string) - (gnc:reldate-string-db 'lookup 'start-this-month-desc) - gnc:get-start-this-month) - (vector 'end-this-month - (gnc:reldate-string-db 'lookup 'end-this-month-string) - (gnc:reldate-string-db 'lookup 'end-this-month-desc) - gnc:get-end-this-month) - (vector 'start-prev-month - (gnc:reldate-string-db 'lookup 'start-prev-month-string) - (gnc:reldate-string-db 'lookup 'start-prev-month-desc) - gnc:get-start-prev-month) - (vector 'end-prev-month - (gnc:reldate-string-db 'lookup 'end-prev-month-string) - (gnc:reldate-string-db 'lookup 'end-prev-month-desc) - gnc:get-end-prev-month) - (vector 'start-current-quarter - (gnc:reldate-string-db 'lookup 'start-current-quarter-string) - (gnc:reldate-string-db 'lookup 'start-current-quarter-desc) - gnc:get-start-current-quarter) - (vector 'end-current-quarter - (gnc:reldate-string-db 'lookup 'end-current-quarter-string) - (gnc:reldate-string-db 'lookup 'end-current-quarter-desc) - gnc:get-end-current-quarter) - (vector 'start-prev-quarter - (gnc:reldate-string-db 'lookup 'start-prev-quarter-string) - (gnc:reldate-string-db 'lookup 'start-prev-quarter-desc) - gnc:get-start-prev-quarter) - (vector 'end-prev-quarter - (gnc:reldate-string-db 'lookup 'end-prev-quarter-string) - (gnc:reldate-string-db 'lookup 'end-prev-quarter-desc) - gnc:get-end-prev-quarter) - (vector 'today - (gnc:reldate-string-db 'lookup 'today-string) - (gnc:reldate-string-db 'lookup 'today-desc) - gnc:get-today) - (vector 'one-month-ago - (gnc:reldate-string-db 'lookup 'one-month-ago-string) - (gnc:reldate-string-db 'lookup 'one-month-ago-desc) - gnc:get-one-month-ago) - (vector 'three-months-ago - (gnc:reldate-string-db 'lookup 'three-months-ago-string) - (gnc:reldate-string-db 'lookup 'three-months-ago-desc) - gnc:get-three-months-ago) - (vector 'six-months-ago - (gnc:reldate-string-db 'lookup 'six-months-ago-string) - (gnc:reldate-string-db 'lookup 'six-months-ago-desc) - gnc:get-three-months-ago) - (vector 'one-year-ago - (gnc:reldate-string-db 'lookup 'one-year-ago-string) - (gnc:reldate-string-db 'lookup 'one-year-ago-desc) - gnc:get-one-year-ago))) + (gnc:reldate-string-db + 'store 'one-year-ago-string (N_ "One Year Ago")) + (gnc:reldate-string-db + 'store 'one-year-ago-desc (N_ "One Year Ago")) + + (set! gnc:relative-date-values + (list + (vector 'start-cal-year + (gnc:reldate-string-db 'lookup 'start-cal-year-string) + (gnc:reldate-string-db 'lookup 'start-cal-year-desc) + gnc:get-start-cal-year) + (vector 'end-cal-year + (gnc:reldate-string-db 'lookup 'end-cal-year-string) + (gnc:reldate-string-db 'lookup 'end-cal-year-desc) + gnc:get-end-cal-year) + (vector 'start-prev-year + (gnc:reldate-string-db 'lookup 'start-prev-year-string) + (gnc:reldate-string-db 'lookup 'start-prev-year-desc) + gnc:get-start-prev-year) + (vector 'end-prev-year + (gnc:reldate-string-db 'lookup 'end-prev-year-string) + (gnc:reldate-string-db 'lookup 'end-prev-year-desc) + gnc:get-end-prev-year) + (vector 'start-cur-fin-year + (gnc:reldate-string-db 'lookup 'start-cur-fin-year-string) + (gnc:reldate-string-db 'lookup 'start-cur-fin-year-desc) + gnc:get-start-cur-fin-year) + (vector 'start-prev-fin-year + (gnc:reldate-string-db 'lookup 'start-prev-fin-year-string) + (gnc:reldate-string-db 'lookup 'start-prev-fin-year-desc) + gnc:get-start-prev-fin-year) + (vector 'end-prev-fin-year + (gnc:reldate-string-db 'lookup 'end-prev-fin-year-string) + (gnc:reldate-string-db 'lookup 'end-prev-fin-year-desc) + gnc:get-end-prev-fin-year) + (vector 'end-cur-fin-year + (gnc:reldate-string-db 'lookup 'end-cur-fin-year-string) + (gnc:reldate-string-db 'lookup 'end-cur-fin-year-desc) + gnc:get-end-cur-fin-year) + (vector 'start-this-month + (gnc:reldate-string-db 'lookup 'start-this-month-string) + (gnc:reldate-string-db 'lookup 'start-this-month-desc) + gnc:get-start-this-month) + (vector 'end-this-month + (gnc:reldate-string-db 'lookup 'end-this-month-string) + (gnc:reldate-string-db 'lookup 'end-this-month-desc) + gnc:get-end-this-month) + (vector 'start-prev-month + (gnc:reldate-string-db 'lookup 'start-prev-month-string) + (gnc:reldate-string-db 'lookup 'start-prev-month-desc) + gnc:get-start-prev-month) + (vector 'end-prev-month + (gnc:reldate-string-db 'lookup 'end-prev-month-string) + (gnc:reldate-string-db 'lookup 'end-prev-month-desc) + gnc:get-end-prev-month) + (vector 'start-current-quarter + (gnc:reldate-string-db 'lookup 'start-current-quarter-string) + (gnc:reldate-string-db 'lookup 'start-current-quarter-desc) + gnc:get-start-current-quarter) + (vector 'end-current-quarter + (gnc:reldate-string-db 'lookup 'end-current-quarter-string) + (gnc:reldate-string-db 'lookup 'end-current-quarter-desc) + gnc:get-end-current-quarter) + (vector 'start-prev-quarter + (gnc:reldate-string-db 'lookup 'start-prev-quarter-string) + (gnc:reldate-string-db 'lookup 'start-prev-quarter-desc) + gnc:get-start-prev-quarter) + (vector 'end-prev-quarter + (gnc:reldate-string-db 'lookup 'end-prev-quarter-string) + (gnc:reldate-string-db 'lookup 'end-prev-quarter-desc) + gnc:get-end-prev-quarter) + (vector 'today + (gnc:reldate-string-db 'lookup 'today-string) + (gnc:reldate-string-db 'lookup 'today-desc) + gnc:get-today) + (vector 'one-month-ago + (gnc:reldate-string-db 'lookup 'one-month-ago-string) + (gnc:reldate-string-db 'lookup 'one-month-ago-desc) + gnc:get-one-month-ago) + (vector 'three-months-ago + (gnc:reldate-string-db 'lookup 'three-months-ago-string) + (gnc:reldate-string-db 'lookup 'three-months-ago-desc) + gnc:get-three-months-ago) + (vector 'six-months-ago + (gnc:reldate-string-db 'lookup 'six-months-ago-string) + (gnc:reldate-string-db 'lookup 'six-months-ago-desc) + gnc:get-three-months-ago) + (vector 'one-year-ago + (gnc:reldate-string-db 'lookup 'one-year-ago-string) + (gnc:reldate-string-db 'lookup 'one-year-ago-desc) + gnc:get-one-year-ago))) - (gnc:make-reldate-hash gnc:relative-date-hash gnc:relative-date-values) - (set! gnc:reldate-list - (map (lambda (x) (vector-ref x 0)) gnc:relative-date-values)))) - -;; Startup -(let ((hook (gnc:hook-lookup 'startup-hook))) - (gnc:hook-add-dangler hook gnc:reldate-initialize)) + (gnc:make-reldate-hash gnc:relative-date-hash gnc:relative-date-values) + (set! gnc:reldate-list + (map (lambda (x) (vector-ref x 0)) gnc:relative-date-values))) diff --git a/src/app-utils/gfec.c b/src/app-utils/gfec.c new file mode 100644 index 0000000000..669ff6c209 --- /dev/null +++ b/src/app-utils/gfec.c @@ -0,0 +1,165 @@ +/* Authors: Eric M. Ludlam + * Russ McManus + * Dave Peticolas + * + * gfec stands for 'guile fancy error catching'. + * This code is in the public domain. + */ + +#include +#include + +#include "gfec.h" + + +/* We assume that data is actually a char**. The way we return results + * from this function is to malloc a fresh string, and store it in + * this pointer. It is the caller's responsibility to do something + * smart with this freshly allocated storage. the caller can determine + * whether there was an error by initializing the char* passed in to + * NULL. If there is an error, the char string will not be NULL on + * return. */ +static SCM +gfec_catcher(void *data, SCM tag, SCM throw_args) +{ + SCM func; + SCM result; + char *msg = NULL; + + func = gh_eval_str("gnc:error->string"); + if (gh_procedure_p(func)) + { + result = gh_call2(func, tag, throw_args); + if (gh_string_p(result)) + msg = gh_scm2newstr(result, NULL); + } + + if (msg == NULL) + { + msg = strdup("Error running guile function."); + assert(msg != NULL); + } + + *(char**)data = msg; + + return SCM_UNDEFINED; +} + + +/* The arguments to scm_internal_stack_catch: + ------------------------------------------ + SCM tag : this should be SCM_BOOL_T to catch all errors. + scm_catch_body_t body : the function to run. + void *body_data : a pointer to pass to body + scm_catch_handler_t handler : the hander function + void *handler_data : a pointer to pass to the handler +*/ + +static SCM +gfec_file_helper(void *data) +{ + char *file = data; + + return gh_eval_file(file); +} + +SCM +gfec_eval_file(const char *file, gfec_error_handler error_handler) +{ + char *err_msg = NULL; + SCM result; + + result = scm_internal_stack_catch(SCM_BOOL_T, + gfec_file_helper, + (void *) file, + gfec_catcher, + &err_msg); + + if (err_msg != NULL) + { + if (error_handler) + error_handler(err_msg); + + free(err_msg); + + return SCM_UNDEFINED; + } + + return result; +} + +static SCM +gfec_string_helper(void *data) +{ + char *string = data; + + return gh_eval_str(string); +} + +SCM +gfec_eval_string(const char *str, gfec_error_handler error_handler) +{ + char *err_msg = NULL; + SCM result; + + result = scm_internal_stack_catch(SCM_BOOL_T, + gfec_string_helper, + (void *) str, + gfec_catcher, + &err_msg); + + if (err_msg != NULL) + { + if (error_handler) + error_handler(err_msg); + + free(err_msg); + + return SCM_UNDEFINED; + } + + return result; +} + +struct gfec_apply_rec +{ + SCM proc; + SCM arglist; +}; + +static SCM +gfec_apply_helper(void *data) +{ + struct gfec_apply_rec *apply_rec = (struct gfec_apply_rec *)data; + + return gh_apply(apply_rec->proc, apply_rec->arglist); +} + +SCM +gfec_apply(SCM proc, SCM arglist, gfec_error_handler error_handler) +{ + char *err_msg = NULL; + struct gfec_apply_rec apply_rec; + SCM result; + + apply_rec.proc = proc; + apply_rec.arglist = arglist; + + result = scm_internal_stack_catch(SCM_BOOL_T, + gfec_apply_helper, + &apply_rec, + gfec_catcher, + &err_msg); + + if (err_msg != NULL) + { + if (error_handler) + error_handler(err_msg); + + free(err_msg); + + return SCM_UNDEFINED; + } + + return result; +} diff --git a/src/app-utils/gfec.h b/src/app-utils/gfec.h new file mode 100644 index 0000000000..651fdca921 --- /dev/null +++ b/src/app-utils/gfec.h @@ -0,0 +1,20 @@ +/* Authors: Eric M. Ludlam + * Russ McManus + * Dave Peticolas + * + * gfec stands for 'guile fancy error catching'. + * This code is in the public domain. + */ + +#ifndef GFEC_H +#define GFEC_H + +#include + +typedef void (*gfec_error_handler)(const char *error_message); + +SCM gfec_eval_file(const char *file, gfec_error_handler error_handler); +SCM gfec_eval_string(const char *str, gfec_error_handler error_handler); +SCM gfec_apply(SCM proc, SCM arglist, gfec_error_handler error_handler); + +#endif diff --git a/src/app-utils/global-options.c b/src/app-utils/global-options.c new file mode 100644 index 0000000000..e5b30cb194 --- /dev/null +++ b/src/app-utils/global-options.c @@ -0,0 +1,498 @@ +/********************************************************************\ + * global-options.c -- GNOME global option handling * + * Copyright (C) 1998,1999 Linas Vepstas * + * * + * This program is free software; you can redistribute it and/or * + * modify it under the terms of the GNU General Public License as * + * published by the Free Software Foundation; either version 2 of * + * the License, or (at your option) any later version. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * + * GNU General Public License for more details. * + * * + * You should have received a copy of the GNU General Public License* + * along with this program; if not, contact: * + * * + * Free Software Foundation Voice: +1-617-542-5942 * + * 59 Temple Place - Suite 330 Fax: +1-617-542-2652 * + * Boston, MA 02111-1307, USA gnu@gnu.org * +\********************************************************************/ + +#include "config.h" + +#include "global-options.h" +#include "option-util.h" +#include "gnc-engine-util.h" +#include "gnc-ui-util.h" + + +/* This static indicates the debugging module that this .o belongs to. */ +static short module = MOD_GUI; + +static GNCOptionDB *global_options = NULL; + + +/********************************************************************\ + * gnc_options_init * + * initialize the options structures from the guile side * + * * + * Args: none * + * Returns: nothing * +\********************************************************************/ +void +gnc_options_init(void) +{ + SCM func = gh_eval_str("gnc:send-global-options"); + SCM options; + + if (gh_procedure_p(func)) + options = gh_call0(func); + else + { + PERR("gnc_options_init: no guile options!"); + return; + } + + global_options = gnc_option_db_new(options); +} + + +/********************************************************************\ + * gnc_options_shutdown * + * unregister the scheme options and free the structure memory * + * * + * Args: none * + * Returns: nothing * +\********************************************************************/ +void +gnc_options_shutdown(void) +{ + gnc_option_db_destroy(global_options); + global_options = NULL; +} + + +/********************************************************************\ + * gnc_register_option_change_callback * + * register a callback to be called whenever an option changes * + * * + * Args: callback - the callback function * + * user_data - the user data for the callback * + * section - the section to get callbacks for. * + * If NULL, get callbacks for any section changes.* + * name - the option name to get callbacks for. * + * If NULL, get callbacks for any option in the * + * section. Only used if section is non-NULL. * + * Returns: SCM handle for unregistering * +\********************************************************************/ +SCM +gnc_register_option_change_callback(OptionChangeCallback callback, + void *user_data, + char *section, + char *name) +{ + return gnc_option_db_register_change_callback(global_options, callback, + user_data, section, name); +} + + +/********************************************************************\ + * gnc_unregister_option_change_callback_id * + * unregister the change callback associated with the given id * + * * + * Args: callback_id - the callback function id * + * Returns: nothing * +\********************************************************************/ +void +gnc_unregister_option_change_callback_id(SCM callback_id) +{ + gnc_option_db_unregister_change_callback_id(global_options, callback_id); +} + + +/********************************************************************\ + * gnc_get_option_by_name * + * returns an option given section name and name * + * * + * Args: section_name - name of section to search for * + * name - name to search for * + * Returns: given option, or NULL if none * +\********************************************************************/ +GNCOption * +gnc_get_option_by_name(const char *section_name, const char *name) +{ + return gnc_option_db_get_option_by_name(global_options, + section_name, name); +} + + +/********************************************************************\ + * gnc_get_option_by_SCM * + * returns an option given SCM handle. Uses section and name. * + * * + * Args: guile_option - SCM handle of option * + * Returns: given option, or NULL if none * +\********************************************************************/ +GNCOption * +gnc_get_option_by_SCM(SCM guile_option) +{ + return gnc_option_db_get_option_by_SCM(global_options, guile_option); +} + + +/********************************************************************\ + * gnc_lookup_option * + * looks up an option. If present, returns its SCM value, * + * otherwise returns the default. * + * * + * Args: section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: option value * +\********************************************************************/ +SCM +gnc_lookup_option(const char *section, const char *name, SCM default_value) +{ + return gnc_option_db_lookup_option(global_options, section, + name, default_value); +} + + +/********************************************************************\ + * gnc_lookup_boolean_option * + * looks up a boolean option. If present, returns its value, * + * otherwise returns the default. * + * * + * Args: section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: gboolean option value * +\********************************************************************/ +gboolean +gnc_lookup_boolean_option(const char *section, const char *name, + gboolean default_value) +{ + return gnc_option_db_lookup_boolean_option(global_options, section, + name, default_value); +} + + +/********************************************************************\ + * gnc_lookup_string_option * + * looks up a string option. If present, returns its malloc'ed * + * value, otherwise returns the strdup'ed default, or NULL if * + * default was NULL. * + * * + * Args: section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: char * option value * +\********************************************************************/ +char * +gnc_lookup_string_option(const char *section, const char *name, + const char *default_value) +{ + return gnc_option_db_lookup_string_option(global_options, section, + name, default_value); +} + + +/********************************************************************\ + * gnc_lookup_font_option * + * looks up a font option. If present, returns its malloc'ed * + * string value, otherwise returns the strdup'ed default, or NULL * + * if default was NULL. * + * * + * Args: section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: char * option value * +\********************************************************************/ +char * +gnc_lookup_font_option(const char *section, const char *name, + const char *default_value) +{ + return gnc_option_db_lookup_font_option(global_options, section, + name, default_value); +} + + +/********************************************************************\ + * gnc_lookup_multichoice_option * + * looks up a multichoice option. If present, returns its * + * name as a malloc'ed string * + * value, otherwise returns the strdup'ed default, or NULL if * + * default was NULL. * + * * + * Args: section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: char * option value * +\********************************************************************/ +char * +gnc_lookup_multichoice_option(const char *section, const char *name, + const char *default_value) +{ + return gnc_option_db_lookup_multichoice_option(global_options, section, + name, default_value); +} + + +/********************************************************************\ + * gnc_lookup_number_option * + * looks up a number option. If present, return its value * + * as a gdouble, otherwise returns default_value. * + * * + * Args: section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: char * option value * +\********************************************************************/ +gdouble +gnc_lookup_number_option(const char *section, const char *name, + gdouble default_value) +{ + return gnc_option_db_lookup_number_option(global_options, section, + name, default_value); +} + + +/********************************************************************\ + * gnc_lookup_color_option * + * looks up a color option. If present, returns its value in the * + * color variable, otherwise leaves the color variable alone. * + * * + * Args: section - section name of option * + * name - name of option * + * red - where to store the red value * + * blue - where to store the blue value * + * green - where to store the green value * + * alpha - where to store the alpha value * + * Return: true if option was found * +\********************************************************************/ +gboolean gnc_lookup_color_option(const char *section, const char *name, + gdouble *red, gdouble *green, + gdouble *blue, gdouble *alpha) +{ + return gnc_option_db_lookup_color_option(global_options, section, name, + red, green, blue, alpha); +} + + +/********************************************************************\ + * gnc_lookup_color_option_argb * + * looks up a color option. If present, returns its argb value, * + * otherwise returns the given default value. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default_value - default value to return if problem * + * Return: argb value * +\********************************************************************/ +guint32 +gnc_lookup_color_option_argb(const char *section, const char *name, + guint32 default_value) +{ + return gnc_option_db_lookup_color_option_argb(global_options, section, name, + default_value); +} + + +/********************************************************************\ + * gnc_lookup_list_option * + * looks up a list option. If present, returns its value as a * + * list of strings representing the symbols. * + * * + * Args: section - section name of option * + * name - name of option * + * default_value - default value to return if problem * + * Return: list of values * +\********************************************************************/ +GSList * +gnc_lookup_list_option(const char *section, const char *name, + GSList *default_value) +{ + return gnc_option_db_lookup_list_option(global_options, section, name, + default_value); +} + + +/********************************************************************\ + * gnc_lookup_currency_option * + * looks up a currency option. * + * * + * Args: section - section name of option * + * name - name of option * + * default_value - default value to return if problem * + * Return: currency object or NULL * +\********************************************************************/ +gnc_commodity * +gnc_lookup_currency_option(const char *section, + const char *name, + gnc_commodity *default_value) +{ + return gnc_option_db_lookup_currency_option(global_options, section, name, + default_value); +} + + +/********************************************************************\ + * gnc_default_currency * + * Return the default currency set by the user. * + * * + * Args: section - section name of option * + * name - name of option * + * default_value - default value to return if problem * + * Return: currency object or NULL * +\********************************************************************/ +gnc_commodity * +gnc_default_currency (void) +{ + gnc_commodity *currency; + + currency = gnc_lookup_currency_option ("International", + "Default Currency", NULL); + if (currency) + return currency; + + return gnc_locale_default_currency (); +} + + +/********************************************************************\ + * gnc_set_option_default * + * set the option to its default value * + * * + * Args: section - section name of option * + * name - name of option * + * Returns: nothing * +\********************************************************************/ +void +gnc_set_option_default(const char *section, const char *name) +{ + gnc_option_db_set_option_default(global_options, section, name); +} + + +/********************************************************************\ + * gnc_set_option * + * sets the option to the given value. If successful * + * returns TRUE, otherwise FALSE. * + * * + * Args: section - section name of option * + * name - name of option * + * value - value to set to * + * Return: success indicator * +\********************************************************************/ +gboolean +gnc_set_option(const char *section, const char *name, SCM value) +{ + return gnc_option_db_set_option(global_options, section, name, value); +} + + +/********************************************************************\ + * gnc_set_number_option * + * sets the number option to the given value. If successful * + * returns TRUE, otherwise FALSE. * + * * + * Args: section - section name of option * + * name - name of option * + * value - value to set to * + * Return: success indicator * +\********************************************************************/ +gboolean +gnc_set_number_option(const char *section, const char *name, gdouble value) +{ + return gnc_option_db_set_number_option(global_options, section, name, value); +} + +/********************************************************************\ + * gnc_set_boolean_option * + * sets the boolean option to the given value. If successful * + * returns TRUE, otherwise FALSE. * + * * + * Args: section - section name of option * + * name - name of option * + * value - value to set to * + * Return: success indicator * +\********************************************************************/ +gboolean +gnc_set_boolean_option(const char *section, const char *name, gboolean value) +{ + return gnc_option_db_set_boolean_option(global_options, section, name, value); +} + + +/********************************************************************\ + * _gnc_option_refresh_ui * + * sets the GUI representation of an option with its * + * current guile value. Designed to be called from guile * + * * + * Args: option - SCM handle to option * + * Return: nothing * +\********************************************************************/ +void +_gnc_option_refresh_ui(SCM guile_option) +{ + GNCOption *option; + + option = gnc_option_db_get_option_by_SCM(global_options, guile_option); + gnc_option_set_ui_value(option, FALSE); +} + +/********************************************************************\ + * gnc_option_refresh_ui_by_name * + * sets the GUI representation of an option with its current * + * current guile value. Designed to be called from GUI * + * * + * Args: section_name: name of option's section * + * name : name of option * + * Return: nothing * +\********************************************************************/ +void +gnc_option_refresh_ui_by_name(const char *section_name, const char *name) +{ + GNCOption *option; + option = gnc_option_db_get_option_by_name(global_options, section_name, + name); + gnc_option_set_ui_value(option, FALSE); +} + +/********************************************************************\ + * gnc_set_option_selectable_by_name * + * sets the the sensitivity of a global option widget * + * * + * Args: section_name: name of option's section * + * name : name of option * + * Return: nothing * +\********************************************************************/ +void +gnc_set_option_selectable_by_name(const char *section_name, + const char *name, + gboolean selectable) +{ + GNCOption *option; + + option = gnc_option_db_get_option_by_name(global_options, section_name, + name); + if (option) + gnc_set_option_selectable (option, selectable); +} + +/********************************************************************\ + * gnc_get_global_options * + * returns the global options database. Should only be called * + * be the options gui builder, nothing else * + * * + * Args: none * + * Return: global options database * +\********************************************************************/ +GNCOptionDB * +gnc_get_global_options(void) +{ + return global_options; +} diff --git a/src/app-utils/global-options.h b/src/app-utils/global-options.h new file mode 100644 index 0000000000..9c0a184fcc --- /dev/null +++ b/src/app-utils/global-options.h @@ -0,0 +1,104 @@ +/********************************************************************\ + * global-options.h -- GNOME global option handling * + * Copyright (C) 1998,1999 Linas Vepstas * + * * + * This program is free software; you can redistribute it and/or * + * modify it under the terms of the GNU General Public License as * + * published by the Free Software Foundation; either version 2 of * + * the License, or (at your option) any later version. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * + * GNU General Public License for more details. * + * * + * You should have received a copy of the GNU General Public License* + * along with this program; if not, contact: * + * * + * Free Software Foundation Voice: +1-617-542-5942 * + * 59 Temple Place - Suite 330 Fax: +1-617-542-2652 * + * Boston, MA 02111-1307, USA gnu@gnu.org * +\********************************************************************/ + +#ifndef GLOBAL_OPTIONS_H +#define GLOBAL_OPTIONS_H + +#include "config.h" + +#include + +#include "gnc-common.h" +#include "option-util.h" + + +void gnc_options_init(void); +void gnc_options_shutdown(void); + +SCM gnc_register_option_change_callback(OptionChangeCallback callback, + void *user_data, + char *section, + char *name); + +void gnc_unregister_option_change_callback_id(SCM callback_id); + +GNCOption * gnc_get_option_by_name(const char *section_name, const char *name); +GNCOption * gnc_get_option_by_SCM(SCM guile_option); + +SCM gnc_lookup_option(const char *section, const char *name, + SCM default_value); + +gboolean gnc_lookup_boolean_option(const char *section, const char *name, + gboolean default_value); + +char * gnc_lookup_string_option(const char *section, const char *name, + const char *default_value); + +char * gnc_lookup_font_option(const char *section, const char *name, + const char *default_value); + +char * gnc_lookup_multichoice_option(const char *section, const char *name, + const char *default_value); + +gdouble gnc_lookup_number_option(const char *section, const char *name, + gdouble default_value); + +gboolean gnc_lookup_color_option(const char *section, const char *name, + gdouble *red, gdouble *green, + gdouble *blue, gdouble *alpha); + +guint32 gnc_lookup_color_option_argb(const char *section, const char *name, + guint32 default_value); + +GSList * gnc_lookup_list_option(const char *section, const char *name, + GSList *default_value); + +gnc_commodity * +gnc_lookup_currency_option(const char *section, + const char *name, + gnc_commodity *default_value); + +gnc_commodity * gnc_default_currency (void); + +void gnc_set_option_default(const char *section, const char *name); + +gboolean gnc_set_option(const char *section, const char *name, SCM value); + +gboolean gnc_set_number_option(const char *section, const char *name, + gdouble value); + +gboolean gnc_set_boolean_option(const char *section, const char *name, + gboolean value); + +void gnc_option_refresh_ui_by_name(const char *section_name, + const char *name); + +void gnc_set_option_selectable_by_name(const char *section, + const char *name, + gboolean selectable); + +/* private */ + +void _gnc_option_refresh_ui(SCM option); +GNCOptionDB * gnc_get_global_options(void); + +#endif /* GLOBAL_OPTIONS_H */ diff --git a/src/gnc-component-manager.c b/src/app-utils/gnc-component-manager.c similarity index 99% rename from src/gnc-component-manager.c rename to src/app-utils/gnc-component-manager.c index 81660275ce..52e8bee9d3 100644 --- a/src/gnc-component-manager.c +++ b/src/app-utils/gnc-component-manager.c @@ -21,7 +21,6 @@ #include -#include "FileDialog.h" #include "Group.h" #include "gnc-component-manager.h" #include "gnc-engine-util.h" diff --git a/src/gnc-component-manager.h b/src/app-utils/gnc-component-manager.h similarity index 100% rename from src/gnc-component-manager.h rename to src/app-utils/gnc-component-manager.h diff --git a/src/app-utils/gnc-gettext-util.c b/src/app-utils/gnc-gettext-util.c new file mode 100644 index 0000000000..efa80a83fc --- /dev/null +++ b/src/app-utils/gnc-gettext-util.c @@ -0,0 +1,10 @@ + +#include +#include + +char * +gnc_gettext_helper(const char *string) +{ + return strdup(_(string)); +} + diff --git a/src/app-utils/gnc-gettext-util.h b/src/app-utils/gnc-gettext-util.h new file mode 100644 index 0000000000..a86b12696a --- /dev/null +++ b/src/app-utils/gnc-gettext-util.h @@ -0,0 +1,3 @@ + +char * gnc_gettext_helper(const char * str); + diff --git a/src/app-utils/gnc-helpers.c b/src/app-utils/gnc-helpers.c new file mode 100644 index 0000000000..683337fd72 --- /dev/null +++ b/src/app-utils/gnc-helpers.c @@ -0,0 +1,106 @@ +/********************************************************************\ + * gnc-helpers.c -- gnucash g-wrap helper functions * + * Copyright (C) 2000 Linas Vepstas * + * * + * This program is free software; you can redistribute it and/or * + * modify it under the terms of the GNU General Public License as * + * published by the Free Software Foundation; either version 2 of * + * the License, or (at your option) any later version. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * + * GNU General Public License for more details. * + * * + * You should have received a copy of the GNU General Public License* + * along with this program; if not, contact: * + * * + * Free Software Foundation Voice: +1-617-542-5942 * + * 59 Temple Place - Suite 330 Fax: +1-617-542-2652 * + * Boston, MA 02111-1307, USA gnu@gnu.org * + * * +\********************************************************************/ + +#include "config.h" + +#include "gnc-ui-util.h" +#include "engine-helpers.h" +#include + +#include + +/* Type converters for GNCPrintAmountInfo */ +SCM +gnc_printinfo2scm(GNCPrintAmountInfo info) +{ + SCM info_scm = SCM_EOL; + + info_scm = gh_cons (gh_bool2scm (info.monetary), info_scm); + info_scm = gh_cons (gh_bool2scm (info.use_locale), info_scm); + info_scm = gh_cons (gh_bool2scm (info.use_symbol), info_scm); + info_scm = gh_cons (gh_bool2scm (info.use_separators), info_scm); + + info_scm = gh_cons (gh_int2scm (info.min_decimal_places), info_scm); + info_scm = gh_cons (gh_int2scm (info.max_decimal_places), info_scm); + + info_scm = gh_cons (gnc_commodity_to_scm (info.commodity), info_scm); + + info_scm = gh_cons (gh_symbol2scm ("print-info"), info_scm); + + return info_scm; +} + +GNCPrintAmountInfo +gnc_scm2printinfo(SCM info_scm) +{ + GNCPrintAmountInfo info; + + /* skip type */ + info_scm = gh_cdr (info_scm); + info.commodity = gnc_scm_to_commodity (gh_car (info_scm)); + + info_scm = gh_cdr (info_scm); + info.max_decimal_places = gh_scm2int (gh_car (info_scm)); + + info_scm = gh_cdr (info_scm); + info.min_decimal_places = gh_scm2int (gh_car (info_scm)); + + info_scm = gh_cdr (info_scm); + info.use_separators = gh_scm2bool (gh_car (info_scm)); + + info_scm = gh_cdr (info_scm); + info.use_symbol = gh_scm2bool (gh_car (info_scm)); + + info_scm = gh_cdr (info_scm); + info.use_locale = gh_scm2bool (gh_car (info_scm)); + + info_scm = gh_cdr (info_scm); + info.monetary = gh_scm2bool (gh_car (info_scm)); + + return info; +} + +int +gnc_printinfo_p(SCM info_scm) +{ + char *symbol; + int retval; + + if (!gh_list_p(info_scm) || gh_null_p(info_scm)) + return 0; + + info_scm = gh_car (info_scm); + if (!gh_symbol_p (info_scm)) + return 0; + + symbol = gh_symbol2newstr (info_scm, NULL); + if (symbol == NULL) + return 0; + + retval = strcmp (symbol, "print-info") == 0; + + free (symbol); + + return retval; +} + diff --git a/src/app-utils/gnc-helpers.h b/src/app-utils/gnc-helpers.h new file mode 100644 index 0000000000..3f48f09b9a --- /dev/null +++ b/src/app-utils/gnc-helpers.h @@ -0,0 +1,34 @@ +/********************************************************************\ + * gnc-helpers.h -- gnucash g-wrap helper functions * + * Copyright (C) 2000 Linas Vepstas * + * * + * This program is free software; you can redistribute it and/or * + * modify it under the terms of the GNU General Public License as * + * published by the Free Software Foundation; either version 2 of * + * the License, or (at your option) any later version. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * + * GNU General Public License for more details. * + * * + * You should have received a copy of the GNU General Public License* + * along with this program; if not, contact: * + * * + * Free Software Foundation Voice: +1-617-542-5942 * + * 59 Temple Place - Suite 330 Fax: +1-617-542-2652 * + * Boston, MA 02111-1307, USA gnu@gnu.org * + * * +\********************************************************************/ + +#ifndef __GNC_HELPERS__ +#define __GNC_HELPERS__ + +#include "gnc-ui-util.h" +#include + +SCM gnc_printinfo2scm(GNCPrintAmountInfo info); +GNCPrintAmountInfo gnc_scm2printinfo(SCM info_scm); +int gnc_printinfo_p(SCM info_scm); + +#endif diff --git a/src/gnc-ui-util.c b/src/app-utils/gnc-ui-util.c similarity index 99% rename from src/gnc-ui-util.c rename to src/app-utils/gnc-ui-util.c index 0de7afda55..fe74d85ed5 100644 --- a/src/gnc-ui-util.c +++ b/src/app-utils/gnc-ui-util.c @@ -37,7 +37,6 @@ #include "FileDialog.h" #include "Group.h" #include "global-options.h" -#include "gnc-ui.h" #include "gnc-ui-util.h" #include "gnc-common.h" #include "gnc-component-manager.h" diff --git a/src/gnc-ui-util.h b/src/app-utils/gnc-ui-util.h similarity index 100% rename from src/gnc-ui-util.h rename to src/app-utils/gnc-ui-util.h diff --git a/src/app-utils/gncmod-app-utils.c b/src/app-utils/gncmod-app-utils.c new file mode 100644 index 0000000000..9e95589e0a --- /dev/null +++ b/src/app-utils/gncmod-app-utils.c @@ -0,0 +1,62 @@ +/********************************************************************* + * gncmod-app-utils.c + * module definition/initialization for the report infrastructure + * + * Copyright (c) 2001 Linux Developers Group, Inc. + *********************************************************************/ + +#include +#include +#include +#include +#include + +#include "gnc-module.h" + +/* version of the gnc module system interface we require */ +int gnc_module_system_interface = 0; + +/* module versioning uses libtool semantics. */ +int gnc_module_current = 0; +int gnc_module_revision = 0; +int gnc_module_age = 0; + +char * +gnc_module_path(void) { + return g_strdup("gnucash/app-utils"); +} + +char * +gnc_module_description(void) { + return g_strdup("Utilities for building gnc applications"); +} + +static void +lmod(char * mn) +{ + char * form = g_strdup_printf("(use-modules %s)\n", mn); + gh_eval_str(form); + g_free(form); +} + +int +gnc_module_init(int refcount) { + /* load the engine (we depend on it) */ + if(!gnc_module_load("gnucash/engine", 0)) { + return FALSE; + } + + /* publish g-wrapped bindings */ + /* load the scheme code */ + lmod("(g-wrapped gw-app-utils)"); + lmod("(gnucash app-utils)"); + + return TRUE; +} + + +void +gnc_module_finish(int refcount) { + +} + diff --git a/src/app-utils/guile-util.c b/src/app-utils/guile-util.c new file mode 100644 index 0000000000..908b57ba19 --- /dev/null +++ b/src/app-utils/guile-util.c @@ -0,0 +1,1133 @@ +/********************************************************************\ + * guile-util.c -- utility functions for using guile for GnuCash * + * Copyright (C) 1999 Linas Vepstas * + * Copyright (C) 2000 Dave Peticolas * + * * + * This program is free software; you can redistribute it and/or * + * modify it under the terms of the GNU General Public License as * + * published by the Free Software Foundation; either version 2 of * + * the License, or (at your option) any later version. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * + * GNU General Public License for more details. * + * * + * You should have received a copy of the GNU General Public License* + * along with this program; if not, write to the Free Software * + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. * +\********************************************************************/ + +#include "config.h" + +#include + +#include "global-options.h" +#include "gnc-engine-util.h" +#include "engine-helpers.h" +#include "glib-helpers.h" +#include "guile-util.h" +#include "messages.h" + +#include + +/* This static indicates the debugging module this .o belongs to. */ +static short module = MOD_GUILE; + + +struct _setters +{ + SCM split_scm_account_guid; + SCM split_scm_memo; + SCM split_scm_action; + SCM split_scm_reconcile_state; + SCM split_scm_amount; + SCM split_scm_value; + + SCM trans_scm_date; + SCM trans_scm_num; + SCM trans_scm_description; + SCM trans_scm_notes; + SCM trans_scm_append_split_scm; +} setters; + +struct _getters +{ + SCM split_scm_memo; + SCM split_scm_action; + SCM split_scm_amount; + SCM split_scm_value; + + SCM trans_scm_split_scms; + SCM trans_scm_split_scm; + SCM trans_scm_other_split_scm; + + SCM debit_string; + SCM credit_string; +} getters; + +struct _predicates +{ + SCM is_split_scm; + SCM is_trans_scm; +} predicates; + + +static void +initialize_scm_functions() +{ + static gboolean scm_funcs_inited = FALSE; + + if (scm_funcs_inited) + return; + + setters.split_scm_account_guid = + gh_eval_str("gnc:split-scm-set-account-guid"); + setters.split_scm_memo = gh_eval_str("gnc:split-scm-set-memo"); + setters.split_scm_action = gh_eval_str("gnc:split-scm-set-action"); + setters.split_scm_reconcile_state = + gh_eval_str("gnc:split-scm-set-reconcile-state"); + setters.split_scm_amount = gh_eval_str("gnc:split-scm-set-amount"); + setters.split_scm_value = gh_eval_str("gnc:split-scm-set-value"); + + setters.trans_scm_date = gh_eval_str("gnc:transaction-scm-set-date-posted"); + setters.trans_scm_num = gh_eval_str("gnc:transaction-scm-set-num"); + setters.trans_scm_description = + gh_eval_str("gnc:transaction-scm-set-description"); + setters.trans_scm_notes = gh_eval_str("gnc:transaction-scm-set-notes"); + setters.trans_scm_append_split_scm = + gh_eval_str("gnc:transaction-scm-append-split-scm"); + + getters.split_scm_memo = gh_eval_str("gnc:split-scm-get-memo"); + getters.split_scm_action = gh_eval_str("gnc:split-scm-get-action"); + getters.split_scm_amount = gh_eval_str("gnc:split-scm-get-amount"); + getters.split_scm_value = gh_eval_str("gnc:split-scm-get-value"); + + getters.trans_scm_split_scms = + gh_eval_str("gnc:transaction-scm-get-split-scms"); + getters.trans_scm_split_scm = + gh_eval_str("gnc:transaction-scm-get-split-scm"); + getters.trans_scm_other_split_scm = + gh_eval_str("gnc:transaction-scm-get-other-split-scm"); + + getters.debit_string = gh_eval_str("gnc:get-debit-string"); + getters.credit_string = gh_eval_str("gnc:get-credit-string"); + + predicates.is_split_scm = gh_eval_str("gnc:split-scm?"); + predicates.is_trans_scm = gh_eval_str("gnc:transaction-scm?"); + + scm_funcs_inited = TRUE; +} + + +/********************************************************************\ + * gnc_guile_call1_to_string * + * returns the malloc'ed string returned by the guile function * + * or NULL if it can't be retrieved * + * * + * Args: func - the guile function to call * + * arg - the single function argument * + * Returns: malloc'ed char * or NULL * +\********************************************************************/ +char * +gnc_guile_call1_to_string(SCM func, SCM arg) +{ + SCM value; + + if (gh_procedure_p(func)) + { + value = gh_call1(func, arg); + + if (gh_string_p(value)) + return gh_scm2newstr(value, NULL); + else + { + PERR("bad value\n"); + } + } + else + { + PERR("not a procedure\n"); + } + + return NULL; +} + + +/********************************************************************\ + * gnc_guile_call1_symbol_to_string * + * returns the malloc'ed string returned by the guile function * + * or NULL if it can't be retrieved. The return value of the * + * function should be a symbol. * + * * + * Args: func - the guile function to call * + * arg - the single function argument * + * Returns: malloc'ed char * or NULL * +\********************************************************************/ +char * +gnc_guile_call1_symbol_to_string(SCM func, SCM arg) +{ + SCM value; + + if (gh_procedure_p(func)) + { + value = gh_call1(func, arg); + + if (gh_symbol_p(value)) + return gh_symbol2newstr(value, NULL); + else + { + PERR("bad value\n"); + } + } + else + { + PERR("not a procedure\n"); + } + + return NULL; +} + + +/********************************************************************\ + * gnc_guile_call1_to_procedure * + * returns the SCM handle to the procedure returned by the guile * + * function, or SCM_UNDEFINED if it couldn't be retrieved. * + * * + * Args: func - the guile function to call * + * arg - the single function argument * + * Returns: SCM function handle or SCM_UNDEFINED * +\********************************************************************/ +SCM +gnc_guile_call1_to_procedure(SCM func, SCM arg) +{ + SCM value; + + if (gh_procedure_p(func)) + { + value = gh_call1(func, arg); + + if (gh_procedure_p(value)) + return value; + else + { + PERR("bad value\n"); + } + } + else + { + PERR("not a procedure\n"); + } + + return SCM_UNDEFINED; +} + + +/********************************************************************\ + * gnc_guile_call1_to_list * + * returns the SCM handle to the list returned by the guile * + * function, or SCM_UNDEFINED if it couldn't be retrieved. * + * * + * Args: func - the guile function to call * + * arg - the single function argument * + * Returns: SCM list handle or SCM_UNDEFINED * +\********************************************************************/ +SCM +gnc_guile_call1_to_list(SCM func, SCM arg) +{ + SCM value; + + if (gh_procedure_p(func)) + { + value = gh_call1(func, arg); + + if (gh_list_p(value)) + return value; + else + { + PERR("bad value\n"); + } + } + else + { + PERR("not a procedure\n"); + } + + return SCM_UNDEFINED; +} + + +/********************************************************************\ + * gnc_guile_call1_to_vector * + * returns the SCM handle to the vector returned by the guile * + * function, or SCM_UNDEFINED if it couldn't be retrieved. * + * * + * Args: func - the guile function to call * + * arg - the single function argument * + * Returns: SCM vector handle or SCM_UNDEFINED * +\********************************************************************/ +SCM +gnc_guile_call1_to_vector(SCM func, SCM arg) +{ + SCM value; + + if (gh_procedure_p(func)) + { + value = gh_call1(func, arg); + + if (gh_vector_p(value)) + return value; + else + { + PERR("bad value\n"); + } + } + else + { + PERR("not a procedure\n"); + } + + return SCM_UNDEFINED; +} + + +/********************************************************************\ + * gnc_depend * + * ensure the given scm file has been loaded, or return FALSE * + * if it cannot be loaded for any reason. * + * * + * Args: scm_file - the file to load if it hasn't been already * + * Returns: true if the file has been loaded, false otherwise * +\********************************************************************/ +gboolean +gnc_depend(const char *scm_file) +{ + static SCM depend_func = SCM_UNDEFINED; + SCM arg; + + if (scm_file == NULL) + return FALSE; + + if (depend_func == SCM_UNDEFINED) + depend_func = gh_eval_str("gnc:depend"); + + if (!gh_procedure_p(depend_func)) + return FALSE; + + arg = gh_str02scm(scm_file); + + return gh_scm2bool(gh_call1(depend_func, arg)); +} + + +/********************************************************************\ + * gnc_copy_split * + * returns a scheme representation of a split. If the split is * + * NULL, SCM_UNDEFINED is returned. * + * * + * Args: split - the split to copy * + * use_cut_semantics - if TRUE, copy is for a 'cut' operation * + * Returns: SCM representation of split or SCM_UNDEFINED * +\********************************************************************/ +SCM +gnc_copy_split(Split *split, gboolean use_cut_semantics) +{ + static SCM split_type = SCM_UNDEFINED; + SCM func; + SCM arg; + + if (split == NULL) + return SCM_UNDEFINED; + + func = gh_eval_str("gnc:split->split-scm"); + if (!gh_procedure_p(func)) + return SCM_UNDEFINED; + + if(split_type == SCM_UNDEFINED) { + split_type = gh_eval_str(""); + /* don't really need this - types are bound globally anyway. */ + if(split_type != SCM_UNDEFINED) scm_protect_object(split_type); + } + + arg = gw_wcp_assimilate_ptr(split, split_type); + + return gh_call2(func, arg, gh_bool2scm(use_cut_semantics)); +} + + +/********************************************************************\ + * gnc_copy_split_scm_onto_split * + * copies a scheme representation of a split onto an actual split.* + * * + * Args: split_scm - the scheme representation of a split * + * split - the split to copy onto * + * Returns: Nothing * +\********************************************************************/ +void +gnc_copy_split_scm_onto_split(SCM split_scm, Split *split) +{ + static SCM split_type = SCM_UNDEFINED; + SCM result; + SCM func; + SCM arg; + + if (split_scm == SCM_UNDEFINED) + return; + + if (split == NULL) + return; + + func = gh_eval_str("gnc:split-scm?"); + if (!gh_procedure_p(func)) + return; + + result = gh_call1(func, split_scm); + if (!gh_scm2bool(result)) + return; + + func = gh_eval_str("gnc:split-scm-onto-split"); + if (!gh_procedure_p(func)) + return; + + if(split_type == SCM_UNDEFINED) { + split_type = gh_eval_str(""); + /* don't really need this - types are bound globally anyway. */ + if(split_type != SCM_UNDEFINED) scm_protect_object(split_type); + } + + arg = gw_wcp_assimilate_ptr(split, split_type); + gh_call2(func, split_scm, arg); +} + + +/********************************************************************\ + * gnc_is_split_scm * + * returns true if the scm object is a scheme split * + * * + * Args: scm - a scheme object * + * Returns: true if scm is a scheme split * +\********************************************************************/ +gboolean +gnc_is_split_scm(SCM scm) +{ + initialize_scm_functions(); + + return gh_scm2bool(gh_call1(predicates.is_split_scm, scm)); +} + + +/********************************************************************\ + * gnc_is_trans_scm * + * returns true if the scm object is a scheme transaction * + * * + * Args: scm - a scheme object * + * Returns: true if scm is a scheme transaction * +\********************************************************************/ +gboolean +gnc_is_trans_scm(SCM scm) +{ + initialize_scm_functions(); + + return gh_scm2bool(gh_call1(predicates.is_trans_scm, scm)); +} + + +/********************************************************************\ + * gnc_split_scm_set_account * + * set the account of a scheme representation of a split. * + * * + * Args: split_scm - the scheme split * + * account - the account to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_split_scm_set_account(SCM split_scm, Account *account) +{ + char *guid_string; + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return; + if (account == NULL) + return; + + guid_string = guid_to_string(xaccAccountGetGUID(account)); + if (guid_string == NULL) + return; + + arg = gh_str02scm(guid_string); + + gh_call2(setters.split_scm_account_guid, split_scm, arg); + + g_free(guid_string); +} + + +/********************************************************************\ + * gnc_split_scm_set_memo * + * set the memo of a scheme representation of a split. * + * * + * Args: split_scm - the scheme split * + * memo - the memo to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_split_scm_set_memo(SCM split_scm, const char *memo) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return; + if (memo == NULL) + return; + + arg = gh_str02scm(memo); + + gh_call2(setters.split_scm_memo, split_scm, arg); +} + + +/********************************************************************\ + * gnc_split_scm_set_action * + * set the action of a scheme representation of a split. * + * * + * Args: split_scm - the scheme split * + * action - the action to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_split_scm_set_action(SCM split_scm, const char *action) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return; + if (action == NULL) + return; + + arg = gh_str02scm(action); + + gh_call2(setters.split_scm_action, split_scm, arg); +} + + +/********************************************************************\ + * gnc_split_scm_set_reconcile_state * + * set the reconcile state of a scheme split. * + * * + * Args: split_scm - the scheme split * + * reconcile_state - the reconcile state to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_split_scm_set_reconcile_state(SCM split_scm, char reconcile_state) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return; + + arg = gh_char2scm(reconcile_state); + + gh_call2(setters.split_scm_reconcile_state, split_scm, arg); +} + + +/********************************************************************\ + * gnc_split_scm_set_amount * + * set the amount of a scheme split * + * * + * Args: split_scm - the scheme split * + * amount - the amount to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_split_scm_set_amount(SCM split_scm, gnc_numeric amount) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return; + + arg = gnc_numeric_to_scm(amount); + gh_call2(setters.split_scm_amount, split_scm, arg); +} + + +/********************************************************************\ + * gnc_split_scm_set_value * + * set the value of a scheme split * + * * + * Args: split_scm - the scheme split * + * value - the value to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_split_scm_set_value(SCM split_scm, gnc_numeric value) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return; + + arg = gnc_numeric_to_scm(value); + gh_call2(setters.split_scm_value, split_scm, arg); +} + + +/********************************************************************\ + * gnc_split_scm_get_memo * + * return the newly allocated memo of a scheme split, or NULL. * + * * + * Args: split_scm - the scheme split * + * Returns: newly allocated memo string * +\********************************************************************/ +char * +gnc_split_scm_get_memo(SCM split_scm) +{ + SCM result; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return NULL; + + result = gh_call1(getters.split_scm_memo, split_scm); + if (!gh_string_p(result)) + return NULL; + + return gh_scm2newstr(result, NULL); +} + + +/********************************************************************\ + * gnc_split_scm_get_action * + * return the newly allocated action of a scheme split, or NULL. * + * * + * Args: split_scm - the scheme split * + * Returns: newly allocated action string * +\********************************************************************/ +char * +gnc_split_scm_get_action(SCM split_scm) +{ + SCM result; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return NULL; + + result = gh_call1(getters.split_scm_action, split_scm); + if (!gh_string_p(result)) + return NULL; + + return gh_scm2newstr(result, NULL); +} + + +/********************************************************************\ + * gnc_split_scm_get_amount * + * return the amount of a scheme split * + * * + * Args: split_scm - the scheme split * + * Returns: amount of scheme split * +\********************************************************************/ +gnc_numeric +gnc_split_scm_get_amount(SCM split_scm) +{ + SCM result; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return gnc_numeric_zero (); + + result = gh_call1(getters.split_scm_amount, split_scm); + if (!gnc_numeric_p(result)) + return gnc_numeric_zero (); + + return gnc_scm_to_numeric(result); +} + + +/********************************************************************\ + * gnc_split_scm_get_value * + * return the value of a scheme split * + * * + * Args: split_scm - the scheme split * + * Returns: value of scheme split * +\********************************************************************/ +gnc_numeric +gnc_split_scm_get_value(SCM split_scm) +{ + SCM result; + + initialize_scm_functions(); + + if (!gnc_is_split_scm(split_scm)) + return gnc_numeric_zero (); + + result = gh_call1(getters.split_scm_value, split_scm); + if (!gnc_numeric_p(result)) + return gnc_numeric_zero (); + + return gnc_scm_to_numeric(result); +} + + +/********************************************************************\ + * gnc_copy_trans * + * returns a scheme representation of a transaction. If the * + * transaction is NULL, SCM_UNDEFINED is returned. * + * * + * Args: trans - the transaction to copy * + * use_cut_semantics - if TRUE, copy is for a 'cut' operation * + * Returns: SCM representation of transaction or SCM_UNDEFINED * +\********************************************************************/ +SCM +gnc_copy_trans(Transaction *trans, gboolean use_cut_semantics) +{ + static SCM trans_type = SCM_UNDEFINED; + SCM func; + SCM arg; + + if (trans == NULL) + return SCM_UNDEFINED; + + func = gh_eval_str("gnc:transaction->transaction-scm"); + if (!gh_procedure_p(func)) + return SCM_UNDEFINED; + + if(trans_type == SCM_UNDEFINED) { + trans_type = gh_eval_str(""); + /* don't really need this - types are bound globally anyway. */ + if(trans_type != SCM_UNDEFINED) scm_protect_object(trans_type); + } + + arg = gw_wcp_assimilate_ptr(trans, trans_type); + + return gh_call2(func, arg, gh_bool2scm(use_cut_semantics)); +} + + +/********************************************************************\ + * gnc_copy_trans_scm_onto_trans * + * copies a scheme representation of a transaction onto * + * an actual transaction. * + * * + * Args: trans_scm - the scheme representation of a transaction * + * trans - the transaction to copy onto * + * Returns: Nothing * +\********************************************************************/ +void +gnc_copy_trans_scm_onto_trans(SCM trans_scm, Transaction *trans, + gboolean do_commit) +{ + gnc_copy_trans_scm_onto_trans_swap_accounts(trans_scm, trans, NULL, NULL, + do_commit); +} + + +/********************************************************************\ + * gnc_copy_trans_scm_onto_trans_swap_accounts * + * copies a scheme representation of a transaction onto * + * an actual transaction. If guid_1 and guid_2 are not NULL, * + * the account guids of the splits are swapped accordingly. * + * * + * Args: trans_scm - the scheme representation of a transaction * + * trans - the transaction to copy onto * + * guid_1 - account guid to swap with guid_2 * + * guid_2 - account guid to swap with guid_1 * + * do_commit - whether to commit the edits * + * Returns: Nothing * +\********************************************************************/ +void +gnc_copy_trans_scm_onto_trans_swap_accounts(SCM trans_scm, + Transaction *trans, + const GUID *guid_1, + const GUID *guid_2, + gboolean do_commit) +{ + static SCM trans_type = SCM_UNDEFINED; + SCM result; + SCM func; + SCM arg; + + if (trans_scm == SCM_UNDEFINED) + return; + + if (trans == NULL) + return; + + func = gh_eval_str("gnc:transaction-scm?"); + if (!gh_procedure_p(func)) + return; + + result = gh_call1(func, trans_scm); + if (!gh_scm2bool(result)) + return; + + func = gh_eval_str("gnc:transaction-scm-onto-transaction"); + if (!gh_procedure_p(func)) + return; + + if(trans_type == SCM_UNDEFINED) { + trans_type = gh_eval_str(""); + /* don't really need this - types are bound globally anyway. */ + if(trans_type != SCM_UNDEFINED) scm_protect_object(trans_type); + } + + arg = gw_wcp_assimilate_ptr(trans, trans_type); + + if ((guid_1 == NULL) || (guid_2 == NULL)) + { + SCM args = SCM_EOL; + SCM commit; + + commit = gh_bool2scm(do_commit); + + args = gh_cons(commit, args); + args = gh_cons(SCM_EOL, args); + args = gh_cons(arg, args); + args = gh_cons(trans_scm, args); + + gh_apply(func, args); + } + else + { + SCM from, to; + SCM map = SCM_EOL; + SCM args = SCM_EOL; + SCM commit; + char *guid_str; + + commit = gh_bool2scm(do_commit); + + args = gh_cons(commit, args); + + guid_str = guid_to_string(guid_1); + from = gh_str02scm(guid_str); + g_free (guid_str); + + guid_str = guid_to_string(guid_2); + to = gh_str02scm(guid_str); + g_free (guid_str); + + map = gh_cons(gh_cons(from, to), map); + map = gh_cons(gh_cons(to, from), map); + + args = gh_cons(map, args); + args = gh_cons(arg, args); + args = gh_cons(trans_scm, args); + + gh_apply(func, args); + } +} + +/********************************************************************\ + * gnc_trans_scm_set_date * + * set the date of a scheme transaction. * + * * + * Args: trans_scm - the scheme transaction * + * ts - the time to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_trans_scm_set_date(SCM trans_scm, Timespec *ts) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_trans_scm(trans_scm)) + return; + if (ts == NULL) + return; + + arg = gnc_timespec2timepair(*ts); + + gh_call2(setters.trans_scm_date, trans_scm, arg); +} + + +/********************************************************************\ + * gnc_trans_scm_set_num * + * set the num of a scheme transaction. * + * * + * Args: trans_scm - the scheme transaction * + * num - the num to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_trans_scm_set_num(SCM trans_scm, const char *num) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_trans_scm(trans_scm)) + return; + if (num == NULL) + return; + + arg = gh_str02scm(num); + + gh_call2(setters.trans_scm_num, trans_scm, arg); +} + + +/********************************************************************\ + * gnc_trans_scm_set_description * + * set the description of a scheme transaction. * + * * + * Args: trans_scm - the scheme transaction * + * description - the description to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_trans_scm_set_description(SCM trans_scm, const char *description) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_trans_scm(trans_scm)) + return; + if (description == NULL) + return; + + arg = gh_str02scm(description); + + gh_call2(setters.trans_scm_description, trans_scm, arg); +} + + +/********************************************************************\ + * gnc_trans_scm_set_notes * + * set the notes of a scheme transaction. * + * * + * Args: trans_scm - the scheme transaction * + * notes - the notes to set * + * Returns: Nothing * +\********************************************************************/ +void +gnc_trans_scm_set_notes(SCM trans_scm, const char *notes) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_trans_scm(trans_scm)) + return; + if (notes == NULL) + return; + + arg = gh_str02scm(notes); + + gh_call2(setters.trans_scm_notes, trans_scm, arg); +} + + +/********************************************************************\ + * gnc_trans_scm_append_split_scm * + * append the scheme split onto the scheme transaction * + * * + * Args: trans_scm - the scheme transaction * + * split_scm - the scheme split to append * + * Returns: Nothing * +\********************************************************************/ +void +gnc_trans_scm_append_split_scm(SCM trans_scm, SCM split_scm) +{ + initialize_scm_functions(); + + if (!gnc_is_trans_scm(trans_scm)) + return; + if (!gnc_is_split_scm(split_scm)) + return; + + gh_call2(setters.trans_scm_append_split_scm, trans_scm, split_scm); +} + + +/********************************************************************\ + * gnc_trans_scm_get_split_scm * + * get the indexth scheme split of a scheme transaction. * + * * + * Args: trans_scm - the scheme transaction * + * index - the index of the split to get * + * Returns: scheme split to get, or SCM_UNDEFINED if none * +\********************************************************************/ +SCM +gnc_trans_scm_get_split_scm(SCM trans_scm, int index) +{ + SCM arg; + + initialize_scm_functions(); + + if (!gnc_is_trans_scm(trans_scm)) + return SCM_UNDEFINED; + + arg = gh_int2scm(index); + + return gh_call2(getters.trans_scm_split_scm, trans_scm, arg); +} + + +/********************************************************************\ + * gnc_trans_scm_get_other_split_scm * + * get the other scheme split of a scheme transaction. * + * * + * Args: trans_scm - the scheme transaction * + * split_scm - the split not to get * + * Returns: other scheme split, or SCM_UNDEFINED if none * +\********************************************************************/ +SCM +gnc_trans_scm_get_other_split_scm(SCM trans_scm, SCM split_scm) +{ + SCM result; + + initialize_scm_functions(); + + if (!gnc_is_trans_scm(trans_scm)) + return SCM_UNDEFINED; + if (!gnc_is_split_scm(split_scm)) + return SCM_UNDEFINED; + + result = gh_call2(getters.trans_scm_other_split_scm, trans_scm, split_scm); + + if (!gnc_is_split_scm(result)) + return SCM_UNDEFINED; + + return result; +} + + +/********************************************************************\ + * gnc_trans_scm_get_num_splits * + * get the number of scheme splits in a scheme transaction. * + * * + * Args: trans_scm - the scheme transaction * + * Returns: number of scheme splits in the transaction * +\********************************************************************/ +int +gnc_trans_scm_get_num_splits(SCM trans_scm) +{ + SCM result; + + initialize_scm_functions(); + + if (!gnc_is_trans_scm(trans_scm)) + return 0; + + result = gh_call1(getters.trans_scm_split_scms, trans_scm); + + if (!gh_list_p(result)) + return 0; + + return gh_length(result); +} + + +/********************************************************************\ + * gnc_get_debit_string * + * return a debit string for a given account type * + * * + * Args: account_type - type of account to get debit string for * + * Return: g_malloc'd debit string or NULL * +\********************************************************************/ +char * +gnc_get_debit_string(GNCAccountType account_type) +{ + char *type_string; + char *string; + char *temp; + SCM result; + SCM arg; + + initialize_scm_functions(); + + if (gnc_lookup_boolean_option("General", "Use accounting labels", FALSE)) + return g_strdup(_("Debit")); + + if ((account_type < NO_TYPE) || (account_type >= NUM_ACCOUNT_TYPES)) + account_type = NO_TYPE; + + type_string = xaccAccountTypeEnumAsString(account_type); + + arg = gh_symbol2scm(type_string); + + result = gh_call1(getters.debit_string, arg); + if (!gh_string_p(result)) + return NULL; + + string = gh_scm2newstr(result, NULL); + if (string) + { + temp = g_strdup (string); + free (string); + } + else + temp = NULL; + + return temp; +} + + +/********************************************************************\ + * gnc_get_credit_string * + * return a credit string for a given account type * + * * + * Args: account_type - type of account to get credit string for * + * Return: g_malloc'd credit string or NULL * +\********************************************************************/ +char * +gnc_get_credit_string(GNCAccountType account_type) +{ + char *type_string; + char *string; + char *temp; + SCM result; + SCM arg; + + initialize_scm_functions(); + + if (gnc_lookup_boolean_option("General", "Use accounting labels", FALSE)) + return g_strdup(_("Credit")); + + if ((account_type < NO_TYPE) || (account_type >= NUM_ACCOUNT_TYPES)) + account_type = NO_TYPE; + + type_string = xaccAccountTypeEnumAsString(account_type); + + arg = gh_symbol2scm(type_string); + + result = gh_call1(getters.credit_string, arg); + if (!gh_string_p(result)) + return NULL; + + string = gh_scm2newstr(result, NULL); + if (string) + { + temp = g_strdup (string); + free (string); + } + else + temp = NULL; + + return temp; +} + + diff --git a/src/app-utils/guile-util.h b/src/app-utils/guile-util.h new file mode 100644 index 0000000000..f46d921967 --- /dev/null +++ b/src/app-utils/guile-util.h @@ -0,0 +1,94 @@ +/********************************************************************\ + * guile-util.h -- utility functions for using guile for GnuCash * + * Copyright (C) 1999 Linas Vepstas * + * * + * This program is free software; you can redistribute it and/or * + * modify it under the terms of the GNU General Public License as * + * published by the Free Software Foundation; either version 2 of * + * the License, or (at your option) any later version. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * + * GNU General Public License for more details. * + * * + * You should have received a copy of the GNU General Public License* + * along with this program; if not, contact: * + * * + * Free Software Foundation Voice: +1-617-542-5942 * + * 59 Temple Place - Suite 330 Fax: +1-617-542-2652 * + * Boston, MA 02111-1307, USA gnu@gnu.org * + * * +\********************************************************************/ + +#ifndef GUILE_UTIL_H +#define GUILE_UTIL_H + +#include +#include + +#include "date.h" +#include "gnc-book.h" +#include "gnc-numeric.h" +#include "Group.h" + + +/* Helpful functions for calling functions that return + * specific kinds of values. These functions do error + * checking to verify the result is of the correct type. */ +char * gnc_guile_call1_to_string(SCM func, SCM arg); +char * gnc_guile_call1_symbol_to_string(SCM func, SCM arg); +SCM gnc_guile_call1_to_procedure(SCM func, SCM arg); +SCM gnc_guile_call1_to_list(SCM func, SCM arg); +SCM gnc_guile_list_ref(SCM list, int index); +SCM gnc_guile_call1_to_vector(SCM func, SCM arg); + +/* Accessing the gnucash/guile dependency mechanism */ +gboolean gnc_depend(const char *scm_file); + +/* The next set of functions is for manipulating scheme + * representations of splits and transactions. */ +gboolean gnc_is_split_scm(SCM scm); +gboolean gnc_is_trans_scm(SCM scm); + +SCM gnc_copy_split(Split *split, gboolean use_cut_semantics); +void gnc_copy_split_scm_onto_split(SCM split_scm, Split *split); + +void gnc_split_scm_set_account(SCM split_scm, Account *account); +void gnc_split_scm_set_memo(SCM split_scm, const char *memo); +void gnc_split_scm_set_action(SCM split_scm, const char *action); +void gnc_split_scm_set_reconcile_state(SCM split_scm, char reconcile_state); +void gnc_split_scm_set_amount(SCM split_scm, gnc_numeric amount); +void gnc_split_scm_set_value(SCM split_scm, gnc_numeric value); + +char * gnc_split_scm_get_memo(SCM split_scm); +char * gnc_split_scm_get_action(SCM split_scm); +gnc_numeric gnc_split_scm_get_amount(SCM split_scm); +gnc_numeric gnc_split_scm_get_value(SCM split_scm); + +SCM gnc_copy_trans(Transaction *trans, gboolean use_cut_semantics); +void gnc_copy_trans_scm_onto_trans(SCM trans_scm, Transaction *trans, + gboolean do_commit); +void gnc_copy_trans_scm_onto_trans_swap_accounts(SCM trans_scm, + Transaction *trans, + const GUID *guid_1, + const GUID *guid_2, + gboolean do_commit); + +void gnc_trans_scm_set_date(SCM trans_scm, Timespec *ts); +void gnc_trans_scm_set_num(SCM trans_scm, const char *num); +void gnc_trans_scm_set_description(SCM trans_scm, const char *description); +void gnc_trans_scm_set_notes(SCM trans_scm, const char *notes); +void gnc_trans_scm_append_split_scm(SCM trans_scm, SCM split_scm); + +SCM gnc_trans_scm_get_split_scm(SCM trans_scm, int index); +SCM gnc_trans_scm_get_other_split_scm(SCM trans_scm, SCM split_scm); +int gnc_trans_scm_get_num_splits(SCM trans_scm); + +/* Two functions that return string synonyms for the terms 'debit' and + * 'credit' as appropriate for the given account type and user preferences. + * They should be g_freed when no longer needed. */ +char * gnc_get_debit_string(GNCAccountType account_type); +char * gnc_get_credit_string(GNCAccountType account_type); + +#endif diff --git a/src/app-utils/gw-app-utils-spec.scm b/src/app-utils/gw-app-utils-spec.scm new file mode 100644 index 0000000000..46891ef15a --- /dev/null +++ b/src/app-utils/gw-app-utils-spec.scm @@ -0,0 +1,240 @@ +(define-module (g-wrapped gw-app-utils-spec)) + +(use-modules (g-wrap)) +(use-modules (g-wrapped gw-engine-spec)) + +(debug-set! maxdepth 100000) +(debug-set! stack 2000000) + +(let ((mod (gw:new-module "gw-app-utils"))) + (define (standard-c-call-gen result func-call-code) + (list (gw:result-get-c-name result) " = " func-call-code ";\n")) + + (define (add-standard-result-handlers! type c->scm-converter) + (define (standard-pre-handler result) + (let* ((ret-type-name (gw:result-get-proper-c-type-name result)) + (ret-var-name (gw:result-get-c-name result))) + (list "{\n" + " " ret-type-name " " ret-var-name ";\n"))) + + (gw:type-set-pre-call-result-ccodegen! type standard-pre-handler) + + (gw:type-set-post-call-result-ccodegen! + type + (lambda (result) + (let* ((scm-name (gw:result-get-scm-name result)) + (c-name (gw:result-get-c-name result))) + (list + (c->scm-converter scm-name c-name) + " }\n"))))) + + (gw:module-depends-on mod "gw-runtime") + (gw:module-depends-on mod "gw-engine") + + (gw:module-set-guile-module! mod '(g-wrapped gw-app-utils)) + + (gw:module-set-declarations-ccodegen! + mod + (lambda (client-only?) + (list + "#include \n" + "#include \n" + "#include \n" + "#include \n" + "#include \n" + "#include \n" + ))) + (let ((wt (gw:wrap-type + mod + ' + "GNCPrintAmountInfo" "const GNCPrintAmountInfo"))) + (gw:type-set-scm-arg-type-test-ccodegen! + wt + (lambda (param) + (let ((old-func + (lambda (x) (list "gnc_printinfo_p(" x ")")))) + (old-func (gw:param-get-scm-name param))))) + (gw:type-set-pre-call-arg-ccodegen! + wt + (lambda (param) + (let* ((scm-name (gw:param-get-scm-name param)) + (c-name (gw:param-get-c-name param)) + (old-func + (lambda (x) (list "gnc_scm2printinfo(" x ")")))) + (list c-name + " = " + (old-func scm-name) + ";\n")))) + (gw:type-set-call-ccodegen! wt standard-c-call-gen) + + (add-standard-result-handlers! + wt + (lambda (scm-name c-name) + (let ((old-func + (lambda (x) (list "gnc_printinfo2scm(" x ")")))) + (list scm-name + " = " + (old-func c-name) + ";\n"))))) + + (gw:wrap-non-native-type + mod ' + "OptionChangeCallback" "const OptionChangeCallback") + + (gw:wrap-function + mod + 'gnc:gettext-helper + '( gw:const) + "gnc_gettext_helper" + '((( gw:const) string)) + "Returns the translated version of string") + + (gw:wrap-function + mod + 'gnc:c-options-init + ' + "gnc_options_init" + '() + "Initialize the C side options code.") + + (gw:wrap-function + mod + 'gnc:c-options-shutdown + ' + "gnc_options_shutdown" + '() + "Shutdown the C side options code.") + + (gw:wrap-function + mod + 'gnc:amount->string-helper + '( gw:const) + "xaccPrintAmount" + '(( amount) + ( info)) + "Print amount using current locale. The info argument +determines formatting details.") + + (gw:wrap-function + mod + 'gnc:option-refresh-ui + ' + "_gnc_option_refresh_ui" + '(( option)) + "Refresh the gui option with the current values.") + + (gw:wrap-function + mod + 'gnc:option-invoke-callback + ' + "_gnc_option_invoke_callback" + '(( callback) ( data)) + "Invoke the c option callback on the given data.") + + (gw:wrap-function + mod + 'gnc:option-db-register-option + ' + "_gnc_option_db_register_option" + '(( db_handle) ( option)) + "Register the option with the option database db_handle.") + + (gw:wrap-function + mod + 'gnc:locale-decimal-places + ' + "gnc_locale_decimal_places" + '() + "Return the number of decimal places for this locale.") + + (gw:wrap-function + mod + 'gnc:locale-default-currency + '( gw:const) + "gnc_locale_default_currency" + '() + "Return the default currency for the current locale.") + + (gw:wrap-function + mod + 'gnc:suspend-gui-refresh + ' + "gnc_suspend_gui_refresh" + '() + "Suspend gui refresh events.") + + (gw:wrap-function + mod + 'gnc:resume-gui-refresh + ' + "gnc_resume_gui_refresh" + '() + "Resume gui refresh events.") + + (gw:wrap-function + mod + 'gnc:default-print-info + ' + "gnc_default_print_info" + '(( use_symbol)) + "Return the default print info object.") + + (gw:wrap-function + mod + 'gnc:commodity-print-info + ' + "gnc_commodity_print_info" + '(( commodity) ( use_symbol)) + "Return the default print info for commodity.") + + (gw:wrap-function + mod + 'gnc:account-print-info + ' + "gnc_account_print_info" + '(( account) ( use_symbol)) + "Return a print info for printing account balances.") + + (gw:wrap-function + mod + 'gnc:split-amount-print-info + ' + "gnc_split_amount_print_info" + '(( split) ( use_symbol)) + "Return a print info for printing split amounts.") + + (gw:wrap-function + mod + 'gnc:split-value-print-info + ' + "gnc_split_value_print_info" + '(( split) ( use_symbol)) + "Return a print info for print split value quantities.") + + (gw:wrap-function + mod + 'gnc:default-share-print-info + ' + "gnc_default_share_print_info" + '() + "Return a print info for printing generic share quantities.") + + (gw:wrap-function + mod + 'gnc:default-price-print-info + ' + "gnc_default_price_print_info" + '() + "Return a print info for printing generic price quantities.") + + (gw:wrap-function + mod + 'gnc:account-reverse-balance? + ' + "gnc_reverse_balance" + '(( account)) + "Given an account, find out whether the balance should be reversed for display")) + + + + diff --git a/src/scm/hooks.scm b/src/app-utils/hooks.scm similarity index 99% rename from src/scm/hooks.scm rename to src/app-utils/hooks.scm index e623ebecf0..7e9b820e86 100644 --- a/src/scm/hooks.scm +++ b/src/app-utils/hooks.scm @@ -21,8 +21,6 @@ ;;;; This is not functional yet, but it should be close... -(gnc:support "hooks.scm") - ;;; Private ;; Central repository for all hooks -- so we can look them up later by name. diff --git a/src/app-utils/option-util.c b/src/app-utils/option-util.c new file mode 100644 index 0000000000..b66a53d1f8 --- /dev/null +++ b/src/app-utils/option-util.c @@ -0,0 +1,2307 @@ +/********************************************************************\ + * option-util.c -- GNOME<->guile option interface * + * Copyright (C) 1998,1999 Linas Vepstas * + * Copyright (C) 2000 Dave Peticolas * + * * + * This program is free software; you can redistribute it and/or * + * modify it under the terms of the GNU General Public License as * + * published by the Free Software Foundation; either version 2 of * + * the License, or (at your option) any later version. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * + * GNU General Public License for more details. * + * * + * You should have received a copy of the GNU General Public License* + * along with this program; if not, contact: * + * * + * Free Software Foundation Voice: +1-617-542-5942 * + * 59 Temple Place - Suite 330 Fax: +1-617-542-2652 * + * Boston, MA 02111-1307, USA gnu@gnu.org * +\********************************************************************/ + +#include "config.h" + +#include +#include +#include + +#include "option-util.h" +#include "engine-helpers.h" +#include "glib-helpers.h" +#include "guile-util.h" +#include "gnc-engine-util.h" + +#include + +/****** Structures *************************************************/ + +struct _GNCOptionSection +{ + char * section_name; + + GSList * options; +}; + +struct _GNCOptionDB +{ + SCM guile_options; + + GSList *option_sections; + + gboolean options_dirty; + + GNCOptionDBHandle handle; +}; + +typedef struct _Getters Getters; +struct _Getters +{ + SCM section; + SCM name; + SCM type; + SCM sort_tag; + SCM documentation; + SCM getter; + SCM setter; + SCM default_getter; + SCM value_validator; + SCM option_data; + SCM index_to_name; + SCM index_to_description; + SCM index_to_value; + SCM value_to_index; + SCM number_of_indices; + SCM option_widget_changed_cb; + SCM date_option_subtype; + SCM date_option_show_time; + SCM date_option_value_type; + SCM date_option_value_absolute; + SCM date_option_value_relative; +}; + + +/****** Globals ****************************************************/ + +static Getters getters = {0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0}; + +/* This static indicates the debugging module this .o belongs to. */ +static short module = MOD_GUI; + +static GHashTable *option_dbs = NULL; +static int last_db_handle = 0; + + +/*******************************************************************/ + + +/********************************************************************\ + * gnc_option_db_init * + * initialize the options structures from the guile side * + * * + * Args: odb - the option database to initialize * + * Returns: nothing * +\********************************************************************/ +static void +gnc_option_db_init(GNCOptionDB *odb) +{ + SCM func = gh_eval_str("gnc:send-options"); + + gh_call2(func, gh_int2scm(odb->handle), odb->guile_options); +} + + +/********************************************************************\ + * gnc_option_db_new * + * allocate a new option database and initialize its values * + * * + * Args: guile_options - SCM handle to options * + * Returns: a new option database * +\********************************************************************/ +GNCOptionDB * +gnc_option_db_new(SCM guile_options) +{ + GNCOptionDB *odb; + GNCOptionDB *lookup; + + odb = g_new0(GNCOptionDB, 1); + + odb->guile_options = guile_options; + scm_protect_object(guile_options); + + odb->option_sections = NULL; + odb->options_dirty = FALSE; + + if (option_dbs == NULL) + option_dbs = g_hash_table_new(g_int_hash, g_int_equal); + + do + { + odb->handle = last_db_handle++; + lookup = g_hash_table_lookup(option_dbs, &odb->handle); + } while (lookup != NULL); + + g_hash_table_insert(option_dbs, &odb->handle, odb); + + gnc_option_db_init(odb); + + return odb; +} + +typedef struct +{ + GNCOptionDB *odb; + SCM guile_options; +} ODBFindInfo; + +static void +option_db_finder (gpointer key, gpointer value, gpointer data) +{ + ODBFindInfo *find_info = data; + GNCOptionDB *odb = value; + + if (odb && (odb->guile_options == find_info->guile_options)) + find_info->odb = odb; +} + +static GNCOptionDB * +gnc_option_db_find (SCM guile_options) +{ + ODBFindInfo find_info; + + find_info.odb = NULL; + find_info.guile_options = guile_options; + + g_hash_table_foreach (option_dbs, option_db_finder, &find_info); + + return find_info.odb; +} + +/********************************************************************\ + * gnc_option_db_destroy * + * unregister the scheme options and free all the memory * + * associated with an option database, including the database * + * itself * + * * + * Args: options database to destroy * + * Returns: nothing * +\********************************************************************/ +void +gnc_option_db_destroy(GNCOptionDB *odb) +{ + GSList *snode; + + if (odb == NULL) + return; + + for (snode = odb->option_sections; snode; snode = snode->next) + { + GNCOptionSection *section = snode->data; + GSList *onode; + + for (onode = section->options; onode; onode = onode->next) + { + GNCOption *option = onode->data; + + scm_unprotect_object(option->guile_option); + g_free (option); + } + + /* Free the option list */ + g_slist_free(section->options); + section->options = NULL; + + if (section->section_name != NULL) + free(section->section_name); + section->section_name = NULL; + + g_free (section); + } + + g_slist_free(odb->option_sections); + + odb->option_sections = NULL; + odb->options_dirty = FALSE; + + g_hash_table_remove(option_dbs, &odb->handle); + + if (g_hash_table_size(option_dbs) == 0) + { + g_hash_table_destroy(option_dbs); + option_dbs = NULL; + } + + scm_unprotect_object(odb->guile_options); + odb->guile_options = SCM_UNDEFINED; + + g_free(odb); +} + + +/********************************************************************\ + * gnc_option_db_register_change_callback * + * register a callback to be called whenever an option changes * + * * + * Args: odb - the option database to register with * + * callback - the callback function to register * + * user_data - the user data for the callback * + * section - the section to get callbacks for. * + * If NULL, get callbacks for any section changes.* + * name - the option name to get callbacks for. * + * If NULL, get callbacks for any option in the * + * section. Only used if section is non-NULL. * + * Returns: SCM handle for unregistering * +\********************************************************************/ +SCM +gnc_option_db_register_change_callback(GNCOptionDB *odb, + OptionChangeCallback callback, + void *data, + const char *section, + const char *name) +{ + static SCM void_type = SCM_UNDEFINED; + static SCM callback_type = SCM_UNDEFINED; + + SCM register_proc; + SCM arg; + SCM args; + + if (!odb || !callback) + return SCM_UNDEFINED; + + /* Get the register procedure */ + register_proc = gh_eval_str("gnc:options-register-c-callback"); + if (!gh_procedure_p(register_proc)) + { + PERR("not a procedure\n"); + return SCM_UNDEFINED; + } + + if(void_type == SCM_UNDEFINED) { + void_type = gh_eval_str(""); + /* don't really need this - types are bound globally anyway. */ + if(void_type != SCM_UNDEFINED) scm_protect_object(void_type); + } + if(callback_type == SCM_UNDEFINED) { + callback_type = gh_eval_str(""); + /* don't really need this - types are bound globally anyway. */ + if(callback_type != SCM_UNDEFINED) + scm_protect_object(callback_type); + } + + /* Now build the args list for apply */ + args = SCM_EOL; + + /* first the guile options database */ + args = gh_cons(odb->guile_options, args); + + /* next the data */ + arg = gw_wcp_assimilate_ptr(data, void_type); + args = gh_cons(arg, args); + + /* next the callback */ + arg = gw_wcp_assimilate_ptr(callback, callback_type); + args = gh_cons(arg, args); + + /* next the name */ + if (name == NULL) + arg = SCM_BOOL_F; + else + arg = gh_str02scm(name); + args = gh_cons(arg, args); + + /* next the section */ + if (section == NULL) + arg = SCM_BOOL_F; + else + arg = gh_str02scm(section); + args = gh_cons(arg, args); + + /* now apply the procedure */ + return gh_apply(register_proc, args); +} + + +/********************************************************************\ + * gnc_option_db_unregister_change_callback_id * + * unregister the change callback associated with the given id * + * * + * Args: odb - the option database to register with * + * callback - the callback function to register * + * Returns: nothing * +\********************************************************************/ +void +gnc_option_db_unregister_change_callback_id(GNCOptionDB *odb, SCM callback_id) +{ + SCM proc; + + if (callback_id == SCM_UNDEFINED) + return; + + proc = gh_eval_str("gnc:options-unregister-callback-id"); + if (!gh_procedure_p(proc)) + { + PERR("not a procedure\n"); + return; + } + + gh_call2(proc, callback_id, odb->guile_options); +} + +void +_gnc_option_invoke_callback(OptionChangeCallback callback, void *data) +{ + callback(data); +} + +static void +gnc_call_option_change_callbacks(GNCOptionDB *odb) +{ + SCM proc; + + proc = gh_eval_str("gnc:options-run-callbacks"); + if (!gh_procedure_p(proc)) + { + PERR("not a procedure\n"); + return; + } + + gh_call1(proc, odb->guile_options); +} + + +static void +initialize_getters(void) +{ + static gboolean getters_initialized = FALSE; + + if (getters_initialized) + return; + + getters.section = gh_eval_str("gnc:option-section"); + getters.name = gh_eval_str("gnc:option-name"); + getters.type = gh_eval_str("gnc:option-type"); + getters.sort_tag = gh_eval_str("gnc:option-sort-tag"); + getters.documentation = + gh_eval_str("gnc:option-documentation"); + getters.getter = gh_eval_str("gnc:option-getter"); + getters.setter = gh_eval_str("gnc:option-setter"); + getters.default_getter = + gh_eval_str("gnc:option-default-getter"); + getters.value_validator = + gh_eval_str("gnc:option-value-validator"); + getters.option_data = gh_eval_str("gnc:option-data"); + getters.index_to_name = gh_eval_str("gnc:option-index-get-name"); + getters.index_to_description = + gh_eval_str("gnc:option-index-get-description"); + getters.number_of_indices = gh_eval_str("gnc:option-number-of-indices"); + getters.index_to_value = gh_eval_str("gnc:option-index-get-value"); + getters.value_to_index = gh_eval_str("gnc:option-value-get-index"); + getters.option_widget_changed_cb = + gh_eval_str("gnc:option-widget-changed-proc"); + getters.date_option_subtype = gh_eval_str("gnc:date-option-get-subtype"); + getters.date_option_show_time = gh_eval_str("gnc:date-option-show-time?"); + getters.date_option_value_type = gh_eval_str ("gnc:date-option-value-type"); + getters.date_option_value_absolute = + gh_eval_str("gnc:date-option-absolute-time"); + getters.date_option_value_relative = + gh_eval_str("gnc:date-option-relative-time"); + + getters_initialized = TRUE; +} + + +/********************************************************************\ + * gnc_option_section * + * returns the malloc'ed section name of the option, or NULL * + * if it can't be retrieved. * + * * + * Args: option - the GNCOption * + * Returns: malloc'ed char * or NULL * +\********************************************************************/ +char * +gnc_option_section(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_to_string(getters.section, option->guile_option); +} + + +/********************************************************************\ + * gnc_option_name * + * returns the malloc'ed name of the option, or NULL * + * if it can't be retrieved. * + * * + * Args: option - the GNCOption * + * Returns: malloc'ed char * or NULL * +\********************************************************************/ +char * +gnc_option_name(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_to_string(getters.name, option->guile_option); +} + + +/********************************************************************\ + * gnc_option_type * + * returns the malloc'ed type of the option, or NULL * + * if it can't be retrieved. * + * * + * Args: option - the GNCOption * + * Returns: malloc'ed char * or NULL * +\********************************************************************/ +char * +gnc_option_type(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_symbol_to_string(getters.type, + option->guile_option); +} + + +/********************************************************************\ + * gnc_option_sort_tag * + * returns the malloc'ed sort tag of the option, or NULL * + * if it can't be retrieved. * + * * + * Args: option - the GNCOption * + * Returns: malloc'ed char * or NULL * +\********************************************************************/ +char * +gnc_option_sort_tag(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_to_string(getters.sort_tag, option->guile_option); +} + + +/********************************************************************\ + * gnc_option_documentation * + * returns the malloc'ed sort tag of the option, or NULL * + * if it can't be retrieved. * + * * + * Args: option - the GNCOption * + * Returns: malloc'ed char * or NULL * +\********************************************************************/ +char * +gnc_option_documentation(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_to_string(getters.documentation, + option->guile_option); +} + + +/********************************************************************\ + * gnc_option_getter * + * returns the SCM handle for the option getter function. * + * This value should be tested with gh_procedure_p before use. * + * * + * Args: option - the GNCOption * + * Returns: SCM handle to function * +\********************************************************************/ +SCM +gnc_option_getter(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_to_procedure(getters.getter, + option->guile_option); +} + + +/********************************************************************\ + * gnc_option_setter * + * returns the SCM handle for the option setter function. * + * This value should be tested with gh_procedure_p before use. * + * * + * Args: option - the GNCOption * + * Returns: SCM handle to function * +\********************************************************************/ +SCM +gnc_option_setter(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_to_procedure(getters.setter, + option->guile_option); +} + + +/********************************************************************\ + * gnc_option_default_getter * + * returns the SCM handle for the option default_getter function. * + * This value should be tested with gh_procedure_p before use. * + * * + * Args: option - the GNCOption * + * Returns: SCM handle to function * +\********************************************************************/ +SCM +gnc_option_default_getter(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_to_procedure(getters.default_getter, + option->guile_option); +} + + +/********************************************************************\ + * gnc_option_value_validator * + * returns the SCM handle for the option value validator function.* + * This value should be tested with gh_procedure_p before use. * + * * + * Args: option - the GNCOption * + * Returns: SCM handle to function * +\********************************************************************/ +SCM +gnc_option_value_validator(GNCOption *option) +{ + initialize_getters(); + + return gnc_guile_call1_to_procedure(getters.value_validator, + option->guile_option); +} + + +/********************************************************************\ + * gnc_option_widget_changed_proc_getter * + * returns the SCM handle for the function to be called if the * + * GUI widget representing the option is changed. * + * This value should be tested with gh_procedure_p before use. * + * If no such function exists, returns SCM_UNDEFINED. * + * * + * Args: option - the GNCOption * + * Returns: SCM handle to function * + * If no such function exists, returns SCM_UNDEFINED. * +\********************************************************************/ +SCM +gnc_option_widget_changed_proc_getter(GNCOption *option) +{ + SCM cb; + + initialize_getters(); + + if( gh_procedure_p( getters.option_widget_changed_cb ) ) + { + /* call the callback function getter to get the actual callback function */ + cb = gh_call1(getters.option_widget_changed_cb, option->guile_option); + + if( gh_procedure_p( cb ) ) /* a callback exists */ + { + return( cb ); + } + /* else no callback exists - this is a legal situation */ + } + else /* getters not set up correctly? */ + { + PERR("getters.option_widget_changed_cb is not a valid procedure\n"); + } + + return( SCM_UNDEFINED ); +} + + +/********************************************************************\ + * gnc_option_call_option_widget_changed_proc * + * If there is an option_widget_changed_cb for this option, call * + * it with the SCM value of the option that is passed in. If * + * there is no such callback function or value, do nothing. * + * * + * Args: option - the GNCOption * + * Returns: void * +\********************************************************************/ +void +gnc_option_call_option_widget_changed_proc(GNCOption *option) +{ + SCM cb, value; + + cb = gnc_option_widget_changed_proc_getter(option); + + if( cb != SCM_UNDEFINED ) + { + value = gnc_option_get_ui_value(option); + + if( value != SCM_UNDEFINED ) + { + gh_call1(cb, value); + } + } +} + + +/********************************************************************\ + * gnc_option_num_permissible_values * + * returns the number of permissible values in the option, or * + * -1 if there are no values available. * + * * + * Args: option - the GNCOption * + * Returns: number of permissible options or -1 * +\********************************************************************/ +int +gnc_option_num_permissible_values(GNCOption *option) +{ + SCM value; + + initialize_getters(); + + value = gh_call1(getters.number_of_indices, option->guile_option); + + if(gh_exact_p(value)) + { + return gh_scm2int(value); + } + else + { + return -1; + } +} + + +/********************************************************************\ + * gnc_option_permissible_value_index * + * returns the index of the permissible value matching the * + * provided value, or -1 if it couldn't be found * + * * + * Args: option - the GNCOption * + * value - the SCM handle of the value * + * Returns: index of permissible value, or -1 * +\********************************************************************/ +int +gnc_option_permissible_value_index(GNCOption *option, SCM search_value) +{ + SCM value; + value = gh_call2(getters.value_to_index, option->guile_option, search_value); + if (value == SCM_BOOL_F) + { + return -1; + } + else + { + return gh_scm2int(value); + } +} + + +/********************************************************************\ + * gnc_option_permissible_value * + * returns the SCM handle to the indexth permissible value in the * + * option, or SCM_UNDEFINED if the index was out of range or * + * there was some other problem. * + * * + * Args: option - the GNCOption * + * index - the index of the permissible value * + * Returns: SCM handle to option value or SCM_UNDEFINED * +\********************************************************************/ +SCM +gnc_option_permissible_value(GNCOption *option, int index) +{ + SCM value; + + if (index < 0) + return SCM_UNDEFINED; + + initialize_getters(); + + value = gh_call2(getters.index_to_value, option->guile_option, + gh_int2scm(index)); + + return value; +} + + +/********************************************************************\ + * gnc_option_permissible_value_name * + * returns the malloc'd name of the indexth permissible value in * + * the option, or NULL if the index was out of range or there are * + * no values available. * + * * + * Args: option - the GNCOption * + * index - the index of the permissible value * + * Returns: malloc'd name of permissible value or NULL * +\********************************************************************/ +char * +gnc_option_permissible_value_name(GNCOption *option, int index) +{ + SCM name; + + if (index < 0) + return NULL; + + initialize_getters(); + + name = gh_call2(getters.index_to_name, option->guile_option, + gh_int2scm(index)); + if (name == SCM_UNDEFINED) + return NULL; + + return gh_scm2newstr(name, NULL); +} + + +/********************************************************************\ + * gnc_option_permissible_value_description * + * returns the malloc'd description of the indexth permissible * + * value in the option, or NULL if the index was out of range or * + * there are no values available. * + * * + * Args: option - the GNCOption * + * index - the index of the permissible value * + * Returns: malloc'd description of permissible value or NULL * +\********************************************************************/ +char * +gnc_option_permissible_value_description(GNCOption *option, int index) +{ + SCM help; + + if (index < 0) + return NULL; + + initialize_getters(); + + help = gh_call2(getters.index_to_description, option->guile_option, + gh_int2scm(index)); + if (help == SCM_UNDEFINED) + return NULL; + + return gh_scm2newstr(help, NULL); +} + + +/********************************************************************\ + * gnc_option_show_time * + * returns true if the gui should display the time as well as * + * the date for this option. Only use this for date options. * + * * + * Args: option - the GNCOption * + * Returns: true if time should be shown * +\********************************************************************/ +gboolean +gnc_option_show_time(GNCOption *option) +{ + SCM value; + + initialize_getters(); + + value = gh_call1(getters.date_option_show_time, option->guile_option); + + return gh_scm2bool(value); +} + + +/********************************************************************\ + * gnc_option_multiple_selection * + * returns true if the gui should allow multiple selection of * + * accounts. Only use this for account options. * + * * + * Args: option - the GNCOption * + * Returns: true if multiple selection allowed * +\********************************************************************/ +gboolean +gnc_option_multiple_selection(GNCOption *option) +{ + SCM value; + + initialize_getters(); + + value = gh_call1(getters.option_data, option->guile_option); + + return !gh_scm2bool(gh_not(value)); +} + + +/********************************************************************\ + * gnc_option_get_range_info * + * returns the range info for a number range option in the pointer* + * arguments. NULL arguments are ignored. Use only for number * + * range options. * + * * + * Args: option - the GNCOption * + * Returns: true if everything went ok :) * +\********************************************************************/ +gboolean gnc_option_get_range_info(GNCOption *option, + double *lower_bound, + double *upper_bound, + int *num_decimals, + double *step_size) +{ + SCM list; + SCM value; + + initialize_getters(); + + list = gh_call1(getters.option_data, option->guile_option); + + if (!gh_list_p(list) || gh_null_p(list)) + return FALSE; + + /* lower bound */ + value = gh_car(list); + list = gh_cdr(list); + + if (!gh_number_p(value)) + return FALSE; + + if (lower_bound != NULL) + *lower_bound = gh_scm2double(value); + + if (!gh_list_p(list) || gh_null_p(list)) + return FALSE; + + /* upper bound */ + value = gh_car(list); + list = gh_cdr(list); + + if (!gh_number_p(value)) + return FALSE; + + if (upper_bound != NULL) + *upper_bound = gh_scm2double(value); + + if (!gh_list_p(list) || gh_null_p(list)) + return FALSE; + + /* number of decimals */ + value = gh_car(list); + list = gh_cdr(list); + + if (!gh_number_p(value)) + return FALSE; + + if (num_decimals != NULL) + *num_decimals = gh_scm2int(value); + + if (!gh_list_p(list) || gh_null_p(list)) + return FALSE; + + /* step size */ + value = gh_car(list); + list = gh_cdr(list); + + if (!gh_number_p(value)) + return FALSE; + + if (step_size != NULL) + *step_size = gh_scm2double(value); + + return TRUE; +} + + +/********************************************************************\ + * gnc_option_color_range * + * returns the color range for rgba values. * + * Only use this for color options. * + * * + * Args: option - the GNCOption * + * Returns: color range for the option * +\********************************************************************/ +gdouble +gnc_option_color_range(GNCOption *option) +{ + SCM list; + SCM value; + + initialize_getters(); + + list = gh_call1(getters.option_data, option->guile_option); + if (!gh_list_p(list) || gh_null_p(list)) + return 0.0; + + value = gh_car(list); + if (!gh_number_p(value)) + return 0.0; + + return gh_scm2double(value); +} + + +/********************************************************************\ + * gnc_option_use_alpha * + * returns true if the color option should use alpha transparency * + * Only use this for color options. * + * * + * Args: option - the GNCOption * + * Returns: true if alpha transparency should be used * +\********************************************************************/ +gdouble +gnc_option_use_alpha(GNCOption *option) +{ + SCM list; + SCM value; + + initialize_getters(); + + list = gh_call1(getters.option_data, option->guile_option); + if (!gh_list_p(list) || gh_null_p(list)) + return FALSE; + + list = gh_cdr(list); + if (!gh_list_p(list) || gh_null_p(list)) + return FALSE; + + value = gh_car(list); + if (!gh_boolean_p(value)) + return FALSE; + + return gh_scm2bool(value); +} + + +/********************************************************************\ + * gnc_option_get_color_argb * + * returns the argb value of a color option * + * * + * Args: option - the GNCOption * + * Returns: argb value of option * +\********************************************************************/ +guint32 +gnc_option_get_color_argb(GNCOption *option) +{ + gdouble red, green, blue, alpha; + guint32 color = 0; + + if (!gnc_option_get_color_info(option, FALSE, &red, &green, &blue, &alpha)) + return 0; + + color |= (guint32) (alpha * 255.0); + color <<= 8; + + color |= (guint32) (red * 255.0); + color <<= 8; + + color |= (guint32) (green * 255.0); + color <<= 8; + + color |= (guint32) (blue * 255.0); + + return color; +} + + +/********************************************************************\ + * gnc_option_get_color_info * + * gets the color information from a color option. rgba values * + * returned are between 0.0 and 1.0. * + * * + * Args: option - option to get info from * + * use_default - use the default or current value * + * red - where to store the red value * + * blue - where to store the blue value * + * green - where to store the green value * + * alpha - where to store the alpha value * + * Return: true if everything went ok * +\********************************************************************/ +gboolean +gnc_option_get_color_info(GNCOption *option, + gboolean use_default, + gdouble *red, + gdouble *green, + gdouble *blue, + gdouble *alpha) +{ + gdouble scale; + gdouble rgba; + SCM getter; + SCM value; + + if (option == NULL) + return FALSE; + + if (use_default) + getter = gnc_option_default_getter(option); + else + getter = gnc_option_getter(option); + if (getter == SCM_UNDEFINED) + return FALSE; + + value = gh_call0(getter); + if (!gh_list_p(value) || gh_null_p(value) || !gh_number_p(gh_car(value))) + return FALSE; + + scale = gnc_option_color_range(option); + if (scale <= 0.0) + return FALSE; + + scale = 1.0 / scale; + + rgba = gh_scm2double(gh_car(value)); + if (red != NULL) + *red = MIN(1.0, rgba * scale); + + value = gh_cdr(value); + if (!gh_list_p(value) || gh_null_p(value) || !gh_number_p(gh_car(value))) + return FALSE; + + rgba = gh_scm2double(gh_car(value)); + if (green != NULL) + *green = MIN(1.0, rgba * scale); + + value = gh_cdr(value); + if (!gh_list_p(value) || gh_null_p(value) || !gh_number_p(gh_car(value))) + return FALSE; + + rgba = gh_scm2double(gh_car(value)); + if (blue != NULL) + *blue = MIN(1.0, rgba * scale); + + value = gh_cdr(value); + if (!gh_list_p(value) || gh_null_p(value) || !gh_number_p(gh_car(value))) + return FALSE; + + rgba = gh_scm2double(gh_car(value)); + if (alpha != NULL) + *alpha = MIN(1.0, rgba * scale); + + return TRUE; +} + + +/********************************************************************\ + * gnc_option_set_default * + * set the option to its default value * + * * + * Args: option - the GNCOption * + * Returns: nothing * +\********************************************************************/ +void +gnc_option_set_default(GNCOption *option) +{ + SCM default_getter; + SCM setter; + SCM value; + + if (option == NULL) + return; + + default_getter = gnc_option_default_getter(option); + if (default_getter == SCM_UNDEFINED) + return; + + value = gh_call0(default_getter); + + setter = gnc_option_setter(option); + if (setter == SCM_UNDEFINED) + return; + + gh_call1(setter, value); +} + + +static gint +compare_sections(gconstpointer a, gconstpointer b) +{ + const GNCOptionSection *sa = a; + const GNCOptionSection *sb = b; + + return safe_strcmp(sa->section_name, sb->section_name); +} + +static gint +compare_option_tags(gconstpointer a, gconstpointer b) +{ + GNCOption *oa = (GNCOption *) a; + GNCOption *ob = (GNCOption *) b; + char *tag_a = gnc_option_sort_tag(oa); + char *tag_b = gnc_option_sort_tag(ob); + gint result; + + result = safe_strcmp(tag_a, tag_b); + + if (tag_a != NULL) + free(tag_a); + + if (tag_b != NULL) + free(tag_b); + + return result; +} + +#if 0 +static gint +compare_option_names(gconstpointer a, gconstpointer b) +{ + GNCOption *oa = (GNCOption *) a; + GNCOption *ob = (GNCOption *) b; + char *name_a = gnc_option_name(oa); + char *name_b = gnc_option_name(ob); + gint result; + + result = safe_strcmp(name_a, name_b); + + if (name_a != NULL) + free(name_a); + + if (name_b != NULL) + free(name_b); + + return result; +} +#endif + + +/********************************************************************\ + * gnc_option_db_dirty * + * returns true if guile has registered more options into the * + * database since the last time the database was cleaned. * + * * + * Returns: dirty flag * +\********************************************************************/ +gboolean +gnc_option_db_dirty(GNCOptionDB *odb) +{ + assert(odb != NULL); + + return odb->options_dirty; +} + + +/********************************************************************\ + * gnc_option_db_clean * + * resets the dirty flag of the option database * + * * +\********************************************************************/ +void +gnc_option_db_clean(GNCOptionDB *odb) +{ + assert(odb != NULL); + + odb->options_dirty = FALSE; +} + + +/********************************************************************\ + * _gnc_option_db_register_option * + * registers an option with an option database. Intended to be * + * called from guile. * + * * + * Args: odb - the option database * + * option - the guile option * + * Returns: nothing * +\********************************************************************/ +void +_gnc_option_db_register_option(GNCOptionDBHandle handle, SCM guile_option) +{ + GNCOptionDB *odb; + GNCOption *option; + GNCOptionSection *section; + + odb = g_hash_table_lookup(option_dbs, &handle); + + assert(odb != NULL); + + odb->options_dirty = TRUE; + + /* Make the option structure */ + option = g_new0(GNCOption, 1); + option->guile_option = guile_option; + option->changed = FALSE; + option->widget = NULL; + + /* Prevent guile from garbage collecting the option */ + scm_protect_object(guile_option); + + /* Make the section structure */ + section = g_new0(GNCOptionSection, 1); + section->section_name = gnc_option_section(option); + section->options = NULL; + + /* See if the section is already there */ + { + GSList *old; + + old = g_slist_find_custom(odb->option_sections, section, compare_sections); + + if (old != NULL) + { + if (section->section_name != NULL) + free(section->section_name); + g_free(section); + section = old->data; + } + else + odb->option_sections = g_slist_insert_sorted(odb->option_sections, + section, compare_sections); + } + + section->options = g_slist_insert_sorted(section->options, option, + compare_option_tags); +} + + +/********************************************************************\ + * gnc_option_db_num_sections * + * returns the number of option sections registered so far in the * + * database * + * * + * Args: odb - the database to count sections for * + * Returns: number of option sections * +\********************************************************************/ +guint +gnc_option_db_num_sections(GNCOptionDB *odb) +{ + return g_slist_length(odb->option_sections); +} + + +/********************************************************************\ + * gnc_option_db_get_section * + * returns the ith option section in the database, or NULL * + * * + * Args: odb - the option database * + * i - index of section * + * Returns: ith option sectioin * +\********************************************************************/ +GNCOptionSection * +gnc_option_db_get_section(GNCOptionDB *odb, gint i) +{ + return g_slist_nth_data(odb->option_sections, i); +} + + +/********************************************************************\ + * gnc_option_section_name * + * returns the name of the options section * + * * + * Args: section - section to get name of * + * Returns: name of option section * +\********************************************************************/ +const char * +gnc_option_section_name(GNCOptionSection *section) +{ + return section->section_name; +} + + +/********************************************************************\ + * gnc_option_section_num_options * + * returns the number of options in a given section * + * * + * Args: section - section to count options for * + * Returns: number of options in section * +\********************************************************************/ +guint +gnc_option_section_num_options(GNCOptionSection *section) +{ + return g_slist_length(section->options); +} + + +/********************************************************************\ + * gnc_get_option_section_option * + * returns the ith option in a given section * + * * + * Args: section - section to retrieve option for * + * i - index of option * + * Returns: ith option in section * +\********************************************************************/ +GNCOption * +gnc_get_option_section_option(GNCOptionSection *section, int i) +{ + return g_slist_nth_data(section->options, i); +} + + +/********************************************************************\ + * gnc_option_db_get_option_by_name * + * returns an option given section name and name * + * * + * Args: odb - option database to search in * + * section_name - name of section to search for * + * name - name to search for * + * Returns: given option, or NULL if none * +\********************************************************************/ +GNCOption * +gnc_option_db_get_option_by_name(GNCOptionDB *odb, const char *section_name, + const char *name) +{ + GSList *section_node; + GSList *option_node; + GNCOptionSection section_key; + GNCOptionSection *section; + GNCOption *option; + gint result; + char *node_name; + + if (odb == NULL) + return NULL; + + section_key.section_name = (char *) section_name; + + section_node = g_slist_find_custom(odb->option_sections, §ion_key, + compare_sections); + + if (section_node == NULL) + return NULL; + + section = section_node->data; + option_node = section->options; + + while (option_node != NULL) + { + option = option_node->data; + + node_name = gnc_option_name(option); + result = safe_strcmp(name, node_name); + free(node_name); + + if (result == 0) + return option; + + option_node = option_node->next; + } + + return NULL; +} + + +/********************************************************************\ + * gnc_option_db_get_option_by_SCM * + * returns an option given SCM handle. Uses section and name. * + * * + * Args: odb - option database to search in * + * guile_option - SCM handle of option * + * Returns: given option, or NULL if none * +\********************************************************************/ +GNCOption * +gnc_option_db_get_option_by_SCM(GNCOptionDB *odb, SCM guile_option) +{ + GNCOption option_key; + GNCOption *option; + char *section_name; + char *name; + + option_key.guile_option = guile_option; + + section_name = gnc_option_section(&option_key); + name = gnc_option_name(&option_key); + + option = gnc_option_db_get_option_by_name(odb, section_name, name); + + if (section_name != NULL) + free(section_name); + + if (name != NULL) + free(name); + + return option; +} + + +static SCM +gnc_option_valid_value(GNCOption *option, SCM value) +{ + SCM validator; + SCM result, ok; + + validator = gnc_option_value_validator(option); + + result = gh_call1(validator, value); + if (!gh_list_p(result) || gh_null_p(result)) + return SCM_UNDEFINED; + + ok = gh_car(result); + if (!gh_boolean_p(ok)) + return SCM_UNDEFINED; + + if (!gh_scm2bool(ok)) + return SCM_UNDEFINED; + + result = gh_cdr(result); + if (!gh_list_p(result) || gh_null_p(result)) + return SCM_UNDEFINED; + + return gh_car(result); +} + + +static void +gnc_commit_option(GNCOption *option) +{ + SCM validator, setter, value; + SCM result, ok; + + /* Validate the ui's value */ + value = gnc_option_get_ui_value(option); + if (value == SCM_UNDEFINED) + return; + + validator = gnc_option_value_validator(option); + + result = gh_call1(validator, value); + if (!gh_list_p(result) || gh_null_p(result)) + { + PERR("bad validation result\n"); + return; + } + + /* First element determines validity */ + ok = gh_car(result); + if (!gh_boolean_p(ok)) + { + PERR("bad validation result\n"); + return; + } + + if (gh_scm2bool(ok)) + { + /* Second element is value to use */ + value = gh_cadr(result); + setter = gnc_option_setter(option); + + gh_call1(setter, value); + + gnc_option_set_ui_value (option, FALSE); + } + else + { + SCM oops; + char *section, *name, *message, *full; + + /* Second element is error message */ + oops = gh_cadr(result); + if (!gh_string_p(oops)) + { + PERR("bad validation result\n"); + return; + } + + message = gh_scm2newstr(oops, NULL); + name = gnc_option_name(option); + section = gnc_option_section(option); + + full = g_strdup_printf("There is a problem with option %s:%s.\n%s", + section ? section : "(null)", + name ? name : "(null)", + message ? message : "(null)"); + + printf("%s\n", full); + +#if 0 + /* FIXME : figure out how to get this back */ + gnc_error_dialog(full); +#endif + + g_free(full); + + if (message != NULL) + free(message); + if (name != NULL) + free(name); + if (section != NULL) + free(section); + } +} + + +/********************************************************************\ + * gnc_option_db_commit * + * commits the options which have changed, and which are valid * + * for those which are not valid, error dialogs are shown. * + * * + * Args: odb - option database to commit * + * Return: nothing * +\********************************************************************/ +void +gnc_option_db_commit(GNCOptionDB *odb) +{ + GSList *section_node; + GSList *option_node; + GNCOptionSection *section; + GNCOption *option; + gboolean changed_something = FALSE; + + assert(odb != NULL); + + section_node = odb->option_sections; + while (section_node != NULL) + { + section = section_node->data; + + option_node = section->options; + while (option_node != NULL) + { + option = option_node->data; + + if (option->changed) + { + gnc_commit_option(option_node->data); + changed_something = TRUE; + option->changed = FALSE; + } + + option_node = option_node->next; + } + + section_node = section_node->next; + } + + if (changed_something) + gnc_call_option_change_callbacks(odb); +} + + +/********************************************************************\ + * gnc_option_db_get_default_section * + * returns the malloc'd section name of the default section, * + * or NULL if there is none. * + * * + * Args: odb - option database to get default page for * + * Return: g_malloc'd default section name * +\********************************************************************/ +char * +gnc_option_db_get_default_section(GNCOptionDB *odb) +{ + SCM getter; + SCM value; + + if (odb == NULL) + return NULL; + + getter = gh_eval_str("gnc:options-get-default-section"); + if (!gh_procedure_p(getter)) + return NULL; + + value = gh_call1(getter, odb->guile_options); + if (!gh_string_p(value)) + return NULL; + + return gh_scm2newstr(value, NULL); +} + + +/********************************************************************\ + * gnc_option_db_lookup_option * + * looks up an option. If present, returns its SCM value, * + * otherwise returns the default. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: option value * +\********************************************************************/ +SCM +gnc_option_db_lookup_option(GNCOptionDB *odb, + const char *section, + const char *name, + SCM default_value) +{ + GNCOption *option; + SCM getter; + + option = gnc_option_db_get_option_by_name(odb, section, name); + + if (option == NULL) + return default_value; + + getter = gnc_option_getter(option); + if (getter == SCM_UNDEFINED) + return default_value; + + return gh_call0(getter); +} + +/********************************************************************\ + * gnc_option_db_lookup_boolean_option * + * looks up a boolean option. If present, returns its value, * + * otherwise returns the default. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: gboolean option value * +\********************************************************************/ +gboolean +gnc_option_db_lookup_boolean_option(GNCOptionDB *odb, + const char *section, + const char *name, + gboolean default_value) +{ + GNCOption *option; + SCM getter; + SCM value; + + option = gnc_option_db_get_option_by_name(odb, section, name); + + if (option == NULL) + return default_value; + + getter = gnc_option_getter(option); + if (getter == SCM_UNDEFINED) + return default_value; + + value = gh_call0(getter); + + if (gh_boolean_p(value)) + return gh_scm2bool(value); + else + return default_value; +} + + +/********************************************************************\ + * gnc_option_db_lookup_string_option * + * looks up a string option. If present, returns its malloc'ed * + * value, otherwise returns the strdup'ed default, or NULL if * + * default was NULL. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: char * option value * +\********************************************************************/ +char * +gnc_option_db_lookup_string_option(GNCOptionDB *odb, + const char *section, + const char *name, + const char *default_value) +{ + GNCOption *option; + SCM getter; + SCM value; + + option = gnc_option_db_get_option_by_name(odb, section, name); + + if (option != NULL) + { + getter = gnc_option_getter(option); + if (getter != SCM_UNDEFINED) + { + value = gh_call0(getter); + if (gh_string_p(value)) + return gh_scm2newstr(value, NULL); + } + } + + if (default_value == NULL) + return NULL; + + return strdup(default_value); +} + + +/********************************************************************\ + * gnc_option_db_lookup_font_option * + * looks up a font option. If present, returns its malloc'ed * + * string value, otherwise returns the strdup'ed default, or NULL * + * if default was NULL. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: char * option value * +\********************************************************************/ +char * +gnc_option_db_lookup_font_option(GNCOptionDB *odb, + const char *section, + const char *name, + const char *default_value) +{ + return gnc_option_db_lookup_string_option(odb, section, name, default_value); +} + + +/********************************************************************\ + * gnc_option_db_lookup_multichoice_option * + * looks up a multichoice option. If present, returns its * + * name as a malloc'ed string * + * value, otherwise returns the strdup'ed default, or NULL if * + * default was NULL. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: char * option value * +\********************************************************************/ +char * +gnc_option_db_lookup_multichoice_option(GNCOptionDB *odb, + const char *section, + const char *name, + const char *default_value) +{ + GNCOption *option; + SCM getter; + SCM value; + + option = gnc_option_db_get_option_by_name(odb, section, name); + + if (option != NULL) + { + getter = gnc_option_getter(option); + if (getter != SCM_UNDEFINED) + { + value = gh_call0(getter); + if (gh_symbol_p(value)) + return gh_symbol2newstr(value, NULL); + } + } + + if (default_value == NULL) + return NULL; + + return strdup(default_value); +} + + +/********************************************************************\ + * gnc_option_db_lookup_date_option * + * looks up a date option. If present, returns the absolute date * + * represented in the set_ab_value argument provided, otherwise * + * copies the default_value argument (if non-NULL) to the * + * set_value argument. If the default_value argument is NULL, * + * copies the current date to set_ab_value. Whatever value is * + * stored in set_value is return as an approximate (no * + * nanoseconds) time_t value. set_value may be NULL, in which * + * case only the return value can be used. If is_relative is * + * non-NULL, it is set to whether the date option is currently * + * storing a relative date. If it is, and set_rel_value * + * is non-NULL, it returns a newly allocated string * + * representing the scheme symbol for that relative date * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * set_ab_value - location to store absolute option value * + * set_rel_value - location to store relative option value * + * default - default value if not found * + * Return: time_t approximation of set_value * +\********************************************************************/ +time_t +gnc_option_db_lookup_date_option(GNCOptionDB *odb, + const char *section, + const char *name, + gboolean *is_relative, + Timespec *set_ab_value, + char **set_rel_value, + Timespec *default_value) +{ + GNCOption *option; + Timespec temp; + char *symbol; + SCM getter; + SCM value; + + initialize_getters(); + + if (set_ab_value == NULL) + set_ab_value = &temp; + + if(set_rel_value != NULL) + { + *set_rel_value = NULL; + } + + if (is_relative != NULL) + { + *is_relative = FALSE; + } + + option = gnc_option_db_get_option_by_name(odb, section, name); + + if (option != NULL) + { + getter = gnc_option_getter(option); + if (getter != SCM_UNDEFINED) + { + value = gh_call0(getter); + + if (gh_pair_p(value)) + { + Timespec absolute; + + absolute = gnc_date_option_value_get_absolute (value); + + *set_ab_value = absolute; + + symbol = gnc_date_option_value_get_type (value); + + if (safe_strcmp(symbol, "relative") == 0) + { + SCM relative = gnc_date_option_value_get_relative (value); + + if (is_relative != NULL) + *is_relative = TRUE; + + if (set_rel_value != NULL) + *set_rel_value = gh_symbol2newstr (relative, NULL); + } + + if (symbol) + free (symbol); + } + } + } + else + { + if (default_value == NULL) + { + set_ab_value->tv_sec = time (NULL); + set_ab_value->tv_nsec = 0; + } + else + *set_ab_value = *default_value; + } + + return set_ab_value->tv_sec; +} + + +/********************************************************************\ + * gnc_option_db_lookup_number_option * + * looks up a number option. If present, returns its value * + * as a gdouble, otherwise returns the default_value. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default - default value if not found * + * Return: gdouble representation of value * +\********************************************************************/ +gdouble +gnc_option_db_lookup_number_option(GNCOptionDB *odb, + const char *section, + const char *name, + gdouble default_value) +{ + GNCOption *option; + SCM getter; + SCM value; + + option = gnc_option_db_get_option_by_name(odb, section, name); + + if (option != NULL) + { + getter = gnc_option_getter(option); + if (getter != SCM_UNDEFINED) + { + value = gh_call0(getter); + if (gh_number_p(value)) + return gh_scm2double(value); + } + } + + return default_value; +} + + +/********************************************************************\ + * gnc_option_db_lookup_color_option * + * looks up a color option. If present, returns its value in the * + * color variable, otherwise leaves the color variable alone. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * red - where to store the red value * + * blue - where to store the blue value * + * green - where to store the green value * + * alpha - where to store the alpha value * + * Return: true if option was found * +\********************************************************************/ +gboolean gnc_option_db_lookup_color_option(GNCOptionDB *odb, + const char *section, + const char *name, + gdouble *red, + gdouble *green, + gdouble *blue, + gdouble *alpha) +{ + GNCOption *option; + + option = gnc_option_db_get_option_by_name(odb, section, name); + + return gnc_option_get_color_info(option, FALSE, red, green, blue, alpha); +} + + +/********************************************************************\ + * gnc_option_db_lookup_color_option_argb * + * looks up a color option. If present, returns its argb value, * + * otherwise returns the given default value. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default_value - default value to return if problem * + * Return: argb value * +\********************************************************************/ +guint32 gnc_option_db_lookup_color_option_argb(GNCOptionDB *odb, + const char *section, + const char *name, + guint32 default_value) +{ + GNCOption *option; + + option = gnc_option_db_get_option_by_name(odb, section, name); + if (option == NULL) + return default_value; + + return gnc_option_get_color_argb(option); +} + + +/********************************************************************\ + * gnc_option_db_lookup_list_option * + * looks up a list option. If present, returns its value as a * + * list of strings representing the symbols. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default_value - default value to return if problem * + * Return: list of values * +\********************************************************************/ +GSList * +gnc_option_db_lookup_list_option(GNCOptionDB *odb, + const char *section, + const char *name, + GSList *default_value) +{ + GNCOption *option; + GSList *list = NULL; + SCM getter; + SCM value; + SCM item; + + option = gnc_option_db_get_option_by_name(odb, section, name); + if (option == NULL) + return default_value; + + getter = gnc_option_getter(option); + if (getter == SCM_UNDEFINED) + return default_value; + + value = gh_call0(getter); + while (gh_list_p(value) && !gh_null_p(value)) + { + item = gh_car(value); + value = gh_cdr(value); + + if (!gh_symbol_p(item)) + { + gnc_free_list_option_value(list); + + return default_value; + } + + list = g_slist_prepend(list, gh_symbol2newstr(item, NULL)); + } + + if (!gh_list_p(value) || !gh_null_p(value)) + { + gnc_free_list_option_value(list); + + return default_value; + } + + return list; +} + + +/********************************************************************\ + * gnc_option_db_lookup_currency_option * + * looks up a currency option. If present, returns its value as a * + * gnc_commodity object. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * default_value - default value to return if problem * + * Return: commodity or NULL if no commodity found * +\********************************************************************/ +gnc_commodity * +gnc_option_db_lookup_currency_option(GNCOptionDB *odb, + const char *section, + const char *name, + gnc_commodity *default_value) +{ + GNCOption *option; + SCM getter; + SCM value; + + option = gnc_option_db_get_option_by_name(odb, section, name); + if (option == NULL) + return default_value; + + getter = gnc_option_getter(option); + if (getter == SCM_UNDEFINED) + return default_value; + + value = gh_call0(getter); + + return gnc_scm_to_commodity (value); +} + +static void +free_helper(gpointer string, gpointer not_used) +{ + if (string) free(string); +} + +void +gnc_free_list_option_value(GSList *list) +{ + g_slist_foreach(list, free_helper, NULL); + g_slist_free(list); +} + + +/********************************************************************\ + * gnc_option_db_set_option_default * + * set the option to its default value * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * Returns: nothing * +\********************************************************************/ +void +gnc_option_db_set_option_default(GNCOptionDB *odb, + const char *section, + const char *name) +{ + GNCOption *option; + + option = gnc_option_db_get_option_by_name(odb, section, name); + + gnc_option_set_default(option); +} + + +/********************************************************************\ + * gnc_option_db_set_number_option * + * sets the option to the given value. If successful * + * returns TRUE, otherwise FALSE. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * value - value to set to * + * Return: success indicator * +\********************************************************************/ +gboolean +gnc_option_db_set_option(GNCOptionDB *odb, + const char *section, + const char *name, + SCM value) +{ + GNCOption *option; + SCM setter; + + option = gnc_option_db_get_option_by_name(odb, section, name); + if (option == NULL) + return FALSE; + + value = gnc_option_valid_value(option, value); + if (value == SCM_UNDEFINED) + return FALSE; + + setter = gnc_option_setter(option); + if (setter == SCM_UNDEFINED) + return FALSE; + + gh_call1(setter, value); + + return TRUE; +} + + +/********************************************************************\ + * gnc_option_db_set_number_option * + * sets the number option to the given value. If successful * + * returns TRUE, otherwise FALSE. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * value - value to set to * + * Return: success indicator * +\********************************************************************/ +gboolean +gnc_option_db_set_number_option(GNCOptionDB *odb, + const char *section, + const char *name, + gdouble value) +{ + GNCOption *option; + SCM scm_value; + SCM setter; + + option = gnc_option_db_get_option_by_name(odb, section, name); + if (option == NULL) + return FALSE; + + scm_value = gh_double2scm(value); + + scm_value = gnc_option_valid_value(option, scm_value); + if (scm_value == SCM_UNDEFINED) + return FALSE; + + setter = gnc_option_setter(option); + if (setter == SCM_UNDEFINED) + return FALSE; + + gh_call1(setter, scm_value); + + return TRUE; +} + +/********************************************************************\ + * gnc_option_db_set_boolean_option * + * sets the boolean option to the given value. If successful * + * returns TRUE, otherwise FALSE. * + * * + * Args: odb - option database to search in * + * section - section name of option * + * name - name of option * + * value - value to set to * + * Return: success indicator * +\********************************************************************/ +gboolean +gnc_option_db_set_boolean_option(GNCOptionDB *odb, + const char *section, + const char *name, + gboolean value) +{ + GNCOption *option; + SCM scm_value; + SCM setter; + + option = gnc_option_db_get_option_by_name(odb, section, name); + if (option == NULL) + return FALSE; + + scm_value = gh_bool2scm(value); + + scm_value = gnc_option_valid_value(option, scm_value); + if (scm_value == SCM_UNDEFINED) + return FALSE; + + setter = gnc_option_setter(option); + if (setter == SCM_UNDEFINED) + return FALSE; + + gh_call1(setter, scm_value); + + return TRUE; +} + +/*******************************************************************\ + * gnc_option_date_option_get_subtype * + * find out whether a date option is a relative or absolute date * + * * + * Args: option - option to get date subtype for * + * Return: newly allocated subtype string or NULL * +\*******************************************************************/ +char * +gnc_option_date_option_get_subtype(GNCOption *option) +{ + SCM value; + + initialize_getters(); + + value = gh_call1(getters.date_option_subtype, option->guile_option); + + if (gh_symbol_p(value)) + return gh_symbol2newstr(value, NULL); + else + return NULL; +} + +/*******************************************************************\ + * gnc_date_option_value_get_type * + * get the type of a date option value * + * * + * Args: option_value - option value to get type of * + * Return: newly allocated type string or NULL * +\*******************************************************************/ +char * +gnc_date_option_value_get_type (SCM option_value) +{ + SCM value; + + initialize_getters(); + + value = gh_call1 (getters.date_option_value_type, option_value); + if (!gh_symbol_p (value)) + return NULL; + + return gh_symbol2newstr (value, NULL); +} + +/*******************************************************************\ + * gnc_date_option_value_get_absolute * + * get the absolute time of a date option value * + * * + * Args: option_value - option value to get absolute time of * + * Return: Timespec value * +\*******************************************************************/ +Timespec +gnc_date_option_value_get_absolute (SCM option_value) +{ + SCM value; + + initialize_getters(); + + value = gh_call1 (getters.date_option_value_absolute, option_value); + + return gnc_timepair2timespec (value); +} + +/*******************************************************************\ + * gnc_date_option_value_get_relative * + * get the relative time of a date option value * + * * + * Args: option_value - option value to get relative time of * + * Return: SCM value * +\*******************************************************************/ +SCM +gnc_date_option_value_get_relative (SCM option_value) +{ + initialize_getters(); + + return gh_call1 (getters.date_option_value_relative, option_value); +} + +/*******************************************************************\ + * gnc_option_db_set_option_selectable_by_name * + * set the sensitivity of the option widget * + * * + * Args: guile_options - guile side option db * + * section - section of option * + * name - name of option * + * selectable - selectable status * + * Return: SCM value * +\*******************************************************************/ +void +gnc_option_db_set_option_selectable_by_name(SCM guile_option, + const char *section, + const char *name, + gboolean selectable) +{ + GNCOptionDB *odb; + GNCOption *option; + + odb = gnc_option_db_find (guile_option); + if (!odb) + return; + + option = gnc_option_db_get_option_by_name(odb, section, name); + if (!option) + return; + + gnc_set_option_selectable (option, selectable); +} diff --git a/src/app-utils/option-util.h b/src/app-utils/option-util.h new file mode 100644 index 0000000000..b5abe3d5c1 --- /dev/null +++ b/src/app-utils/option-util.h @@ -0,0 +1,242 @@ +/********************************************************************\ + * option-util.h -- GNOME<->guile option interface * + * Copyright (C) 1998,1999 Linas Vepstas * + * Copyright (C) 2000 Dave Peticolas * + * * + * This program is free software; you can redistribute it and/or * + * modify it under the terms of the GNU General Public License as * + * published by the Free Software Foundation; either version 2 of * + * the License, or (at your option) any later version. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * + * GNU General Public License for more details. * + * * + * You should have received a copy of the GNU General Public License* + * along with this program; if not, contact: * + * * + * Free Software Foundation Voice: +1-617-542-5942 * + * 59 Temple Place - Suite 330 Fax: +1-617-542-2652 * + * Boston, MA 02111-1307, USA gnu@gnu.org * +\********************************************************************/ + +#ifndef OPTION_UTIL_H +#define OPTION_UTIL_H + +#include "config.h" + +#include +#include + +#include "gnc-common.h" +#include "gnc-commodity.h" +#include "date.h" + + +typedef struct _GNCOption GNCOption; +struct _GNCOption +{ + /* Handle to the scheme-side option */ + SCM guile_option; + + /* Flag to indicate change by the UI */ + gboolean changed; + + /* The widget which is holding this option */ + void * widget; +}; + +typedef struct _GNCOptionSection GNCOptionSection; +typedef struct _GNCOptionDB GNCOptionDB; + +typedef int GNCOptionDBHandle; + +typedef void (*OptionChangeCallback)(gpointer user_data); + +/***** Prototypes ********************************************************/ + +GNCOptionDB * gnc_option_db_new(SCM guile_options); +void gnc_option_db_destroy(GNCOptionDB *odb); + +SCM gnc_option_db_register_change_callback(GNCOptionDB *odb, + OptionChangeCallback callback, + void *data, + const char *section, + const char *name); + +void gnc_option_db_unregister_change_callback_id(GNCOptionDB *odb, + SCM callback_id); + +char * gnc_option_section(GNCOption *option); +char * gnc_option_name(GNCOption *option); +char * gnc_option_type(GNCOption *option); +char * gnc_option_sort_tag(GNCOption *option); +char * gnc_option_documentation(GNCOption *option); +SCM gnc_option_getter(GNCOption *option); +SCM gnc_option_setter(GNCOption *option); +SCM gnc_option_default_getter(GNCOption *option); +SCM gnc_option_value_validator(GNCOption *option); +SCM gnc_option_widget_changed_proc_getter(GNCOption *option); + +int gnc_option_num_permissible_values(GNCOption *option); +int gnc_option_permissible_value_index(GNCOption *option, SCM value); +SCM gnc_option_permissible_value(GNCOption *option, int index); +char * gnc_option_permissible_value_name(GNCOption *option, int index); +char * gnc_option_permissible_value_description(GNCOption *option, int index); + +gboolean gnc_option_show_time(GNCOption *option); + +gboolean gnc_option_multiple_selection(GNCOption *option); + +gboolean gnc_option_get_range_info(GNCOption *option, + double *lower_bound, + double *upper_bound, + int *num_decimals, + double *step_size); + +gdouble gnc_option_color_range(GNCOption *option); +gdouble gnc_option_use_alpha(GNCOption *option); +guint32 gnc_option_get_color_argb(GNCOption *option); +gboolean gnc_option_get_color_info(GNCOption *option, + gboolean use_default, + gdouble *red, + gdouble *green, + gdouble *blue, + gdouble *alpha); + +void gnc_option_call_option_widget_changed_proc (GNCOption *option); + +void gnc_option_set_default(GNCOption *option); + +guint gnc_option_db_num_sections(GNCOptionDB *odb); + +const char * gnc_option_section_name(GNCOptionSection *section); +guint gnc_option_section_num_options(GNCOptionSection *section); + +GNCOptionSection * gnc_option_db_get_section(GNCOptionDB *odb, gint i); + +GNCOption * gnc_get_option_section_option(GNCOptionSection *section, int i); + +GNCOption * gnc_option_db_get_option_by_name(GNCOptionDB *odb, + const char *section_name, + const char *name); + +GNCOption * gnc_option_db_get_option_by_SCM(GNCOptionDB *odb, + SCM guile_option); + +gboolean gnc_option_db_dirty(GNCOptionDB *odb); +void gnc_option_db_clean(GNCOptionDB *odb); + +void gnc_option_db_commit(GNCOptionDB *odb); + +char * gnc_option_db_get_default_section(GNCOptionDB *odb); + +SCM gnc_option_db_lookup_option(GNCOptionDB *odb, + const char *section, + const char *name, + SCM default_value); + +gboolean gnc_option_db_lookup_boolean_option(GNCOptionDB *odb, + const char *section, + const char *name, + gboolean default_value); + +char * gnc_option_db_lookup_string_option(GNCOptionDB *odb, + const char *section, + const char *name, + const char *default_value); + +char * gnc_option_db_lookup_font_option(GNCOptionDB *odb, + const char *section, + const char *name, + const char *default_value); + +char * gnc_option_db_lookup_multichoice_option(GNCOptionDB *odb, + const char *section, + const char *name, + const char *default_value); + +time_t gnc_option_db_lookup_date_option(GNCOptionDB *odb, + const char *section, + const char *name, + gboolean *is_relative, + Timespec *set_ab_value, + char **set_rel_value, + Timespec *default_value); + +gdouble gnc_option_db_lookup_number_option(GNCOptionDB *odb, + const char *section, + const char *name, + gdouble default_value); + +gboolean gnc_option_db_lookup_color_option(GNCOptionDB *odb, + const char *section, + const char *name, + gdouble *red, + gdouble *green, + gdouble *blue, + gdouble *alpha); + +guint32 gnc_option_db_lookup_color_option_argb(GNCOptionDB *odb, + const char *section, + const char *name, + guint32 default_value); + +GSList * gnc_option_db_lookup_list_option(GNCOptionDB *odb, + const char *section, + const char *name, + GSList *default_value); + +void gnc_free_list_option_value(GSList *list); + +gnc_commodity * +gnc_option_db_lookup_currency_option(GNCOptionDB *odb, + const char *section, + const char *name, + gnc_commodity *default_value); + +void gnc_option_db_set_option_default(GNCOptionDB *odb, + const char *section, + const char *name); + +gboolean gnc_option_db_set_option(GNCOptionDB *odb, + const char *section, + const char *name, + SCM value); + +gboolean gnc_option_db_set_number_option(GNCOptionDB *odb, + const char *section, + const char *name, + gdouble value); + +gboolean gnc_option_db_set_boolean_option(GNCOptionDB *odb, + const char *section, + const char *name, + gboolean value); + +char * gnc_option_date_option_get_subtype(GNCOption *option); + +char * gnc_date_option_value_get_type (SCM option_value); +Timespec gnc_date_option_value_get_absolute (SCM option_value); +SCM gnc_date_option_value_get_relative (SCM option_value); + +void gnc_option_db_set_option_selectable_by_name(SCM guile_options, + const char *section, + const char *name, + gboolean selectable); + +/* private */ +void _gnc_option_db_register_option(GNCOptionDBHandle handle, + SCM guile_option); + +void _gnc_option_invoke_callback(OptionChangeCallback callback, void *data); + + +/* These must be defined in gui-specific code */ +SCM gnc_option_get_ui_value(GNCOption *option); +void gnc_option_set_ui_value(GNCOption *option, gboolean use_default); +void gnc_set_option_selectable (GNCOption *option, gboolean selectable); + + +#endif /* OPTION_UTIL_H */ diff --git a/src/scm/options.scm b/src/app-utils/options.scm similarity index 100% rename from src/scm/options.scm rename to src/app-utils/options.scm diff --git a/src/app-utils/test/Makefile.am b/src/app-utils/test/Makefile.am new file mode 100644 index 0000000000..89a6c4f524 --- /dev/null +++ b/src/app-utils/test/Makefile.am @@ -0,0 +1,17 @@ +TESTS=test-link-module test-load-module + +TESTS_ENVIRONMENT= \ + GNC_MODULE_PATH=../../engine:../../gnc-module:.. \ + GUILE_LOAD_PATH=${G_WRAP_MODULE_DIR}:../../engine:..:../../gnc-module:${top_srcdir}/lib \ + LTDL_LIBRARY_PATH=.. \ + LD_LIBRARY_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/src/gnc-module/.libs:${top_srcdir}/src/engine:${top_srcdir}/src/engine/.libs + +LDADD = \ + ../../engine/libgncmod-engine.la \ + ../../gnc-module/libgncmodule.la + +bin_PROGRAMS=test-link-module + +test-link-module: test-link-module.c + + diff --git a/src/app-utils/test/test-link-module.c b/src/app-utils/test/test-link-module.c new file mode 100644 index 0000000000..c0d815b3d5 --- /dev/null +++ b/src/app-utils/test/test-link-module.c @@ -0,0 +1,6 @@ +#include + +int +main(int argc, char ** argv) { + exit(0); +} diff --git a/src/app-utils/test/test-load-module b/src/app-utils/test/test-load-module new file mode 100755 index 0000000000..d08f5c3bc4 --- /dev/null +++ b/src/app-utils/test/test-load-module @@ -0,0 +1,18 @@ +#! /bin/bash +exec guile -s "$0" +!# + +(use-modules (gnucash gnc-module)) +(gnc:module-system-init) + +(if (gnc:module-load "gnucash/app-utils" 0) + (begin + (if (and (procedure? gnc:error->string) + (procedure? gnc:c-options-init) + (macro? N_) + (string=? (N_ "foobar") "foobar")) + (exit 0) + (exit -1))) + (exit -1)) + + diff --git a/src/backend/postgres/test/Makefile.am b/src/backend/postgres/test/Makefile.am index 06fc42d002..c702296397 100644 --- a/src/backend/postgres/test/Makefile.am +++ b/src/backend/postgres/test/Makefile.am @@ -3,7 +3,5 @@ TESTS=test-load-module TESTS_ENVIRONMENT=\ GNC_MODULE_PATH=${top_srcdir}/src/engine:${top_srcdir}/src/backend/postgres \ GUILE_LOAD_PATH=${G_WRAP_MODULE_DIR}:..:${top_srcdir}/src/gnc-module \ - LTDL_LIBRARY_PATH=${top_srcdir}/src/gnc-module - - - + LTDL_LIBRARY_PATH=${top_srcdir}/src/gnc-module \ + LD_LIBRARY_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/src/gnc-module\.libs:${top_srcdir}/src/engine:${top_srcdir}/src/engine/.libs diff --git a/src/engine/Makefile.am b/src/engine/Makefile.am index ba2c48ec7e..bc98e34129 100644 --- a/src/engine/Makefile.am +++ b/src/engine/Makefile.am @@ -84,7 +84,7 @@ gncmod_DATA=engine.scm gncscmdir=${GNC_SHAREDIR}/scm gncscm_DATA=commodity-table.scm engine-init.scm engine-interface.scm \ -engine-utilities.scm gnc-numeric.scm iso-4217-currencies.scm +engine-utilities.scm gnc-numeric.scm iso-4217-currencies.scm gwmoddir=${GNC_SHAREDIR}/guile-modules/g-wrapped gwmod_LTLIBRARIES=libgw-glib.la libgw-engine.la diff --git a/src/engine/engine-helpers.c b/src/engine/engine-helpers.c index 11d970a317..a6e25a814c 100644 --- a/src/engine/engine-helpers.c +++ b/src/engine/engine-helpers.c @@ -76,12 +76,6 @@ gnc_transaction_set_date(Transaction *t, Timespec ts) xaccTransSetDatePostedTS(t, &ts); } -char * -gnc_gettext_helper(const char *string) -{ - return strdup(_(string)); -} - SCM gnc_timespec2timepair(Timespec t) { diff --git a/src/engine/engine-helpers.h b/src/engine/engine-helpers.h index a5e5222633..1fcb2b7049 100644 --- a/src/engine/engine-helpers.h +++ b/src/engine/engine-helpers.h @@ -44,9 +44,6 @@ void gnc_transaction_set_date_entered(Transaction *t, const Timespec d); void gnc_transaction_set_date(Transaction *t, Timespec ts); -char * gnc_gettext_helper(const char *string); - - /* Helpers for various types */ SCM gnc_timespec2timepair(Timespec t); diff --git a/src/engine/engine.scm b/src/engine/engine.scm index d8b5f3725c..fb0da8ec14 100644 --- a/src/engine/engine.scm +++ b/src/engine/engine.scm @@ -1,11 +1,6 @@ (define-module (gnucash engine)) (use-modules (g-wrapped gw-engine)) -(load-from-path "gnc-numeric.scm") -(load-from-path "commodity-table.scm") -(load-from-path "engine-interface.scm") -(load-from-path "engine-utilities.scm") - (export GNC-RND-FLOOR) (export GNC-RND-CEIL) (export GNC-RND-TRUNC) @@ -103,3 +98,7 @@ (export trans-splits) (export gnc:transaction-scm-onto-transaction) +(load-from-path "gnc-numeric.scm") +(load-from-path "commodity-table.scm") +(load-from-path "engine-interface.scm") +(load-from-path "engine-utilities.scm") diff --git a/src/engine/gw-engine-spec.scm b/src/engine/gw-engine-spec.scm index 4f898bc07d..37662e87bd 100644 --- a/src/engine/gw-engine-spec.scm +++ b/src/engine/gw-engine-spec.scm @@ -254,7 +254,6 @@ "#include \n" "#include \n" "#include \n" - "#include \n" "#include \n" "#include \n" "#include \n" @@ -2320,11 +2319,22 @@ of having a parent transaction with which one is working...") '(( arg)) "Convert gnc_numeric to a printable string") - (gw:wrap-function mod 'gnc:run-rpc-server ' "gnc_run_rpc_server" '() - "Run the RPC Server")) + "Run the RPC Server") + + ;; src/engine/date.h + + (gw:wrap-function + mod + 'gnc:timepair-canonical-day-time + ' + "timespecCanonicalDayTime" '(( tp)) + "Convert a timepair on a certain day (localtime) to\ +the timepair representing midday on that day")) + + diff --git a/src/gnome/Makefile.am b/src/gnome/Makefile.am index cc313ca4b2..a5607f64cc 100644 --- a/src/gnome/Makefile.am +++ b/src/gnome/Makefile.am @@ -138,6 +138,7 @@ INCLUDES = \ -I${top_srcdir}/src \ -I${top_srcdir}/src/calculation \ -I${top_srcdir}/src/engine \ + -I${top_srcdir}/src/app-utils \ -I${top_srcdir}/src/backend/file \ -I${top_srcdir}/src/g-wrap \ -I${top_srcdir}/src/guile \ diff --git a/src/gnome/dialog-account.c b/src/gnome/dialog-account.c index 490ca7d839..815fe4fc6f 100644 --- a/src/gnome/dialog-account.c +++ b/src/gnome/dialog-account.c @@ -43,6 +43,7 @@ #include "gnc-ui.h" #include "messages.h" #include "query-user.h" +#include "top-level.h" #include "window-help.h" #include "window-main.h" diff --git a/src/gnome/druid-hierarchy.c b/src/gnome/druid-hierarchy.c index 2fca768c34..69f8422e4c 100644 --- a/src/gnome/druid-hierarchy.c +++ b/src/gnome/druid-hierarchy.c @@ -39,7 +39,7 @@ #include "gnc-dir.h" #include "io-example-account.h" #include "query-user.h" - +#include "top-level.h" static GtkWidget *hierarchy_window = NULL; static AccountGroup *our_final_group = NULL; diff --git a/src/gnome/top-level.h b/src/gnome/top-level.h index 6969322532..5283b82be4 100644 --- a/src/gnome/top-level.h +++ b/src/gnome/top-level.h @@ -40,5 +40,8 @@ void gnc_ui_destroy(void); int gnc_ui_show_main_window(void); int gnc_ui_start_event_loop(void); int gnc_ui_main(void); - +const char * gnc_register_default_font(void); +const char * gnc_register_default_hint_font(void); +gboolean gnc_reverse_balance_type(GNCAccountType type); +gboolean gnc_reverse_balance(Account *account); #endif diff --git a/src/gnome/window-reconcile.c b/src/gnome/window-reconcile.c index b94febf3eb..36b36b40bf 100644 --- a/src/gnome/window-reconcile.c +++ b/src/gnome/window-reconcile.c @@ -56,7 +56,7 @@ #include "window-help.h" #include "window-reconcile.h" #include "window-register.h" - +#include "top-level.h" #define WINDOW_RECONCILE_CM_CLASS "window-reconcile" diff --git a/src/gnome/window-register.c b/src/gnome/window-register.c index 6bbb3837fe..0df2195406 100644 --- a/src/gnome/window-register.c +++ b/src/gnome/window-register.c @@ -56,6 +56,7 @@ #include "window-help.h" #include "window-reconcile.h" #include "window-register.h" +#include "top-level.h" typedef struct _RegDateWindow RegDateWindow; diff --git a/src/import-export/qif-import/Makefile.am b/src/import-export/qif-import/Makefile.am index 7bf6c21324..6c520f5fb2 100644 --- a/src/import-export/qif-import/Makefile.am +++ b/src/import-export/qif-import/Makefile.am @@ -32,6 +32,7 @@ INCLUDES = \ -I${top_srcdir}/src \ -I${top_srcdir}/src/engine \ -I${top_srcdir}/src/gnc-module \ + -I${top_srcdir}/src/app-utils \ -I${top_srcdir}/src/guile \ -I${top_srcdir}/src/gnome \ ${GLIB_CFLAGS} \ diff --git a/src/import-export/qif-import/qif-import.scm b/src/import-export/qif-import/qif-import.scm index 6f1ddc2ed1..5333425700 100644 --- a/src/import-export/qif-import/qif-import.scm +++ b/src/import-export/qif-import/qif-import.scm @@ -6,9 +6,6 @@ ;;; $Id$ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:depend "utilities.scm") -(gnc:depend "report-utilities.scm") - (define-module (gnucash import-export qif-import)) (use-modules (g-wrapped gw-runtime)) (use-modules (gnucash gnc-module)) diff --git a/src/import-export/qif-io-core/Makefile.am b/src/import-export/qif-io-core/Makefile.am index 59e47a044e..5ca671a483 100644 --- a/src/import-export/qif-io-core/Makefile.am +++ b/src/import-export/qif-io-core/Makefile.am @@ -5,7 +5,7 @@ CFLAGS=@CFLAGS@ ${GLIB_CFLAGS} INCLUDES = -I${top_srcdir}/src/gnc-module ${GUILE_INCS} -libgncmod_qifiocore_la_SOURCES=gnc-qifiocore.c +libgncmod_qifiocore_la_SOURCES=gncmod-qifiocore.c libgncmod_qifiocore_la_LDFLAGS=-module noinst_DATA=.scm-links diff --git a/src/import-export/qif-io-core/test/Makefile.am b/src/import-export/qif-io-core/test/Makefile.am index 3f440ef0cc..c59732f81a 100644 --- a/src/import-export/qif-io-core/test/Makefile.am +++ b/src/import-export/qif-io-core/test/Makefile.am @@ -6,5 +6,7 @@ TESTS=test-load-module test-parser test-reader test-file-formats \ test-import-phase-1 TESTS_ENVIRONMENT = \ - GNC_MODULE_PATH="${top_srcdir}/src/modules/qif-io-core:${top_srcdir}/src/modules/engine" GUILE_LOAD_PATH="../:../../engine/:../../../gnc-module/:${G_WRAP_MODULE_DIR}" + GNC_MODULE_PATH="${top_srcdir}/src/modules/qif-io-core:${top_srcdir}/src/modules/engine" \ + GUILE_LOAD_PATH="../:../../engine/:../../../gnc-module/:${G_WRAP_MODULE_DIR}" \ + LD_LIBRARY_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/src/gnc-module/.libs:${top_srcdir}/src/engine:${top_srcdir}/src/engine/.libs:${top_srcdir}/src/app-utils:${top_srcdir}/src/app-utils/.libs diff --git a/src/import-export/qif-io-core/test/test-load-module.scm b/src/import-export/qif-io-core/test/test-load-module.scm index d1781697b0..fc4f058810 100644 --- a/src/import-export/qif-io-core/test/test-load-module.scm +++ b/src/import-export/qif-io-core/test/test-load-module.scm @@ -3,5 +3,10 @@ (gnc:module-system-init) (define (run-test) - (gnc:module-load "gnucash/qif-io/core" 0)) - + (if (gnc:module-load "gnucash/qif-io/core" 0) + (begin + (display "ok\n") + (exit 0)) + (begin + (display "failed\n") + (exit -1)))) diff --git a/src/register/ledger-core/Makefile.am b/src/register/ledger-core/Makefile.am index 50f7813994..fb295d5a59 100644 --- a/src/register/ledger-core/Makefile.am +++ b/src/register/ledger-core/Makefile.am @@ -23,6 +23,7 @@ INCLUDES= \ -I${top_srcdir}/src/engine \ -I${top_srcdir}/src/guile \ -I${top_srcdir}/src/gnc-module \ + -I${top_srcdir}/src/app-utils \ -I${top_srcdir}/src/register/register-core \ ${GNOME_INCLUDEDIR} \ ${GLIB_CFLAGS} diff --git a/src/register/register-core/Makefile.am b/src/register/register-core/Makefile.am index 3cbf0ff3d0..a7fc3c6607 100644 --- a/src/register/register-core/Makefile.am +++ b/src/register/register-core/Makefile.am @@ -47,6 +47,7 @@ CFLAGS = @CFLAGS@ INCLUDES = \ -I${top_srcdir}/src \ -I${top_srcdir}/src/engine \ + -I${top_srcdir}/src/app-utils \ -I${top_srcdir}/src/gnc-module \ -I${top_srcdir}/src/guile \ ${GLIB_CFLAGS} \ diff --git a/src/register/register-gnome/Makefile.am b/src/register/register-gnome/Makefile.am index cccfdc8199..1b60c5e6b6 100644 --- a/src/register/register-gnome/Makefile.am +++ b/src/register/register-gnome/Makefile.am @@ -42,6 +42,7 @@ INCLUDES = \ -I${top_srcdir}/src/engine \ -I${top_srcdir}/src/guile \ -I${top_srcdir}/src/gnc-module \ + -I${top_srcdir}/src/app-utils \ -I${top_srcdir}/src/register/ledger-core \ -I${top_srcdir}/src/register/register-core \ ${GLIB_CFLAGS} \ diff --git a/src/report/Makefile.am b/src/report/Makefile.am new file mode 100644 index 0000000000..61f7872f98 --- /dev/null +++ b/src/report/Makefile.am @@ -0,0 +1,7 @@ +SUBDIRS=\ + report-system \ + standard-reports \ + utility-reports \ + locale-specific \ + stylesheets + diff --git a/src/report/locale-specific/Makefile.am b/src/report/locale-specific/Makefile.am new file mode 100644 index 0000000000..8af7182f36 --- /dev/null +++ b/src/report/locale-specific/Makefile.am @@ -0,0 +1 @@ +SUBDIRS=us diff --git a/src/report/locale-specific/us/Makefile.am b/src/report/locale-specific/us/Makefile.am new file mode 100644 index 0000000000..db92288c7a --- /dev/null +++ b/src/report/locale-specific/us/Makefile.am @@ -0,0 +1,30 @@ +SUBDIRS=. test + +pkglib_LTLIBRARIES=libgncmod-locale-reports-us.la + +libgncmod_locale_reports_us_la_SOURCES=\ + gncmod-locale-reports-us.c + +libgncmod_locale_reports_us_la_LDFLAGS=-module + +INCLUDES=-I${top_srcdir}/src/gnc-module ${GLIB_CFLAGS} + +.scm-links: + rm -f gnucash report locale-specific us + ln -sf . gnucash + ln -sf . report + ln -sf . locale-specific + ln -sf . us + touch .scm-links + +noinst_DATA = .scm-links + +gncscmmoddir=${GNC_SHAREDIR}/guile-modules/gnucash/report/locale-specific +gncscmmod_DATA = \ + us.scm \ + taxtxf.scm + +gncscmdir=${GNC_SHAREDIR}/scm +gncscm_DATA = txf-export.scm txf-export-help.scm + +CLEANFILES += gnucash report locale-specific us diff --git a/src/report/locale-specific/us/gncmod-locale-reports-us.c b/src/report/locale-specific/us/gncmod-locale-reports-us.c new file mode 100644 index 0000000000..654a5025dd --- /dev/null +++ b/src/report/locale-specific/us/gncmod-locale-reports-us.c @@ -0,0 +1,52 @@ +/********************************************************************* + * gncmod-locale-reports-us.c + * module definition/initialization for the standard reports + * + * Copyright (c) 2001 Linux Developers Group, Inc. + *********************************************************************/ + +#include +#include +#include +#include "gnc-module.h" + +/* version of the gnc module system interface we require */ +int gnc_module_system_interface = 0; + +/* module versioning uses libtool semantics. */ +int gnc_module_current = 0; +int gnc_module_revision = 0; +int gnc_module_age = 0; + +char * +gnc_module_path(void) { + return g_strdup("gnucash/report/locale-specific/us"); +} + +char * +gnc_module_description(void) { + return g_strdup("US income tax reports and related material"); +} + +int +gnc_module_init(int refcount) { + /* load the report system */ + if(!gnc_module_load("gnucash/report/report-system", 0)) { + return FALSE; + } + + /* load the report generation scheme code */ + if(gh_eval_str("(use-modules (gnucash report locale-specific us))") + == SCM_BOOL_F) { + return FALSE; + } + + return TRUE; +} + + +void +gnc_module_finish(int refcount) { + +} + diff --git a/src/scm/report/taxtxf.scm b/src/report/locale-specific/us/taxtxf.scm similarity index 99% rename from src/scm/report/taxtxf.scm rename to src/report/locale-specific/us/taxtxf.scm index 69d5ae0447..c782752c06 100644 --- a/src/scm/report/taxtxf.scm +++ b/src/report/locale-specific/us/taxtxf.scm @@ -27,13 +27,6 @@ ;; subtracts 2! see "(to-value" ;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "text-export.scm") -(gnc:depend "report-utilities.scm") -(gnc:depend "options.scm") -(gnc:depend "date-utilities.scm") -(gnc:depend "report/txf-export.scm") -(gnc:depend "report/txf-export-help.scm") - (define-module (gnucash report taxtxf)) (use-modules (srfi srfi-1)) @@ -41,7 +34,10 @@ (require 'printf) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) + +(load-from-path "txf-export.scm") +(load-from-path "txf-export-help.scm") (define (make-level-collector num-levels) (let ((level-collector (make-vector num-levels))) diff --git a/src/report/locale-specific/us/test/Makefile.am b/src/report/locale-specific/us/test/Makefile.am new file mode 100644 index 0000000000..f8955ea44e --- /dev/null +++ b/src/report/locale-specific/us/test/Makefile.am @@ -0,0 +1,7 @@ +TESTS=test-load-module + +TESTS_ENVIRONMENT= \ + GNC_MODULE_PATH=${top_srcdir}/src/engine:${top_srcdir}/src/report/report-system:${top_srcdir}/src/app-utils:.. \ + GUILE_LOAD_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/lib:..:${G_WRAP_MODULE_DIR} \ + LD_LIBRARY_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/src/gnc-module/.libs:${top_srcdir}/src/engine:${top_srcdir}/src/engine/.libs:${top_srcdir}/src/app-utils:${top_srcdir}/src/app-utils/.libs + diff --git a/src/report/locale-specific/us/test/test-load-module b/src/report/locale-specific/us/test/test-load-module new file mode 100755 index 0000000000..af76a75994 --- /dev/null +++ b/src/report/locale-specific/us/test/test-load-module @@ -0,0 +1,16 @@ +#! /bin/sh +exec guile -s "$0" +!# + +(display " testing US locale-specific report module load ... ") +(use-modules (gnucash gnc-module)) +(gnc:module-system-init) + +(if (gnc:module-load "gnucash/report/locale-specific/us" 0) + (begin + (display "ok\n") + (exit 0)) + (begin + (display "failed\n") + (exit -1))) + diff --git a/src/scm/report/txf-export-help.scm b/src/report/locale-specific/us/txf-export-help.scm similarity index 99% rename from src/scm/report/txf-export-help.scm rename to src/report/locale-specific/us/txf-export-help.scm index 2a5da3ca97..a4fb5a7da4 100644 --- a/src/scm/report/txf-export-help.scm +++ b/src/report/locale-specific/us/txf-export-help.scm @@ -7,7 +7,6 @@ ;; ;; (n <- TurboTax (N <- IRS ;; -(gnc:support "report/txf-export-help.scm") (define txf-help-strings '( diff --git a/src/scm/report/txf-export.scm b/src/report/locale-specific/us/txf-export.scm similarity index 99% rename from src/scm/report/txf-export.scm rename to src/report/locale-specific/us/txf-export.scm index 1c3e31de4b..f57f05627a 100644 --- a/src/scm/report/txf-export.scm +++ b/src/report/locale-specific/us/txf-export.scm @@ -4,9 +4,6 @@ ;; These are TXF codes and a brief description of each. See taxtxf.scm ;; and txf-export-help.scm ;; -(gnc:support "report/txf-export.scm") -(gnc:depend "report/txf-export-help.scm") - (define (gnc:txf-get-payer-name-source categories code) (gnc:txf-get-code-info categories code 0)) (define (gnc:txf-get-form categories code) diff --git a/src/report/locale-specific/us/us.scm b/src/report/locale-specific/us/us.scm new file mode 100644 index 0000000000..e26bc43a68 --- /dev/null +++ b/src/report/locale-specific/us/us.scm @@ -0,0 +1,3 @@ + +(define-module (gnucash report locale-specific us)) +(use-modules (gnucash report taxtxf)) diff --git a/src/report/report-system/Makefile.am b/src/report/report-system/Makefile.am new file mode 100644 index 0000000000..c2903d9e11 --- /dev/null +++ b/src/report/report-system/Makefile.am @@ -0,0 +1,44 @@ +SUBDIRS=. test + +pkglib_LTLIBRARIES=libgncmod-report-system.la + +libgncmod_report_system_la_SOURCES=gncmod-report-system.c +libgncmod_report_system_la_LDFLAGS=-module +libgncmod_report_system_la_LIBADD = \ + -L../../gnc-module -L../../gnc-module/.libs -lgncmodule \ + -L../../app-utils -L../../app-utils/.libs -lgncmod-app-utils \ + ${GLIB_LIBS} ${GUILE_LIBS} + + +INCLUDES=-I${top_srcdir}/src/gnc-module ${GLIB_CFLAGS} + +.scm-links: + rm -f gnucash report + ln -sf . gnucash + ln -sf . report + touch .scm-links + +gncscmmoddir=${GNC_SHAREDIR}/guile-modules/gnucash/report/ +gncscmmod_DATA=report-system.scm + +noinst_DATA=.scm-links + +gncscmdir=${GNC_SHAREDIR}/scm +gncscm_DATA=\ + commodity-utilities.scm \ + html-barchart.scm \ + html-document.scm \ + html-piechart.scm \ + html-scatter.scm \ + html-style-info.scm \ + html-style-sheet.scm \ + html-table.scm \ + html-text.scm \ + html-utilities.scm \ + options-utilities.scm \ + report-utilities.scm \ + report.scm + +CLEANFILES += gnucash report .scm-links + + diff --git a/src/scm/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm similarity index 99% rename from src/scm/commodity-utilities.scm rename to src/report/report-system/commodity-utilities.scm index 77af700fed..b88a853f14 100644 --- a/src/scm/commodity-utilities.scm +++ b/src/report/report-system/commodity-utilities.scm @@ -20,10 +20,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "commodity-utilities.scm") -(gnc:depend "report-utilities.scm") - -(use-modules (srfi srfi-1)) ;; Returns true if the commodity comm represents a currency, false if ;; it represents a stock or mutual-fund. diff --git a/src/scm/report-html.txt b/src/report/report-system/doc/report-html.txt similarity index 100% rename from src/scm/report-html.txt rename to src/report/report-system/doc/report-html.txt diff --git a/src/report/report-system/gncmod-report-system.c b/src/report/report-system/gncmod-report-system.c new file mode 100644 index 0000000000..5571de02dd --- /dev/null +++ b/src/report/report-system/gncmod-report-system.c @@ -0,0 +1,66 @@ +/********************************************************************* + * gncmod-report-system.c + * module definition/initialization for the report infrastructure + * + * Copyright (c) 2001 Linux Developers Group, Inc. + *********************************************************************/ + +#include +#include +#include +#include "gnc-module.h" + +/* version of the gnc module system interface we require */ +int gnc_module_system_interface = 0; + +/* module versioning uses libtool semantics. */ +int gnc_module_current = 0; +int gnc_module_revision = 0; +int gnc_module_age = 0; + +char * +gnc_module_path(void) { + return g_strdup("gnucash/report/report-system"); +} + +char * +gnc_module_description(void) { + return g_strdup("Core components of Gnucash report generation system"); +} + +static void +lmod(char * mn) +{ + char * form = g_strdup_printf("(use-modules %s)\n", mn); + gh_eval_str(form); + g_free(form); +} + +int +gnc_module_init(int refcount) { + /* load the engine (we depend on it) */ + if(!gnc_module_load("gnucash/engine", 0)) { + return FALSE; + } + + if(!gnc_module_load("gnucash/app-utils", 0)) { + return FALSE; + } + + lmod("(gnucash report report-system)"); + + /* if this is the first time the module's being loaded, initialize + * the relative date system */ + if(refcount == 0) { + gh_eval_str("(gnc:reldate-initialize)"); + } + + return TRUE; +} + + +void +gnc_module_finish(int refcount) { + +} + diff --git a/src/scm/html-barchart.scm b/src/report/report-system/html-barchart.scm similarity index 99% rename from src/scm/html-barchart.scm rename to src/report/report-system/html-barchart.scm index 4784083bd1..1a46cb7b76 100644 --- a/src/scm/html-barchart.scm +++ b/src/report/report-system/html-barchart.scm @@ -21,9 +21,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "html-barchart.scm") - -(use-modules (ice-9 regex)) (define (make-record-type "" @@ -203,7 +200,7 @@ rows) ;; append the elements of 'newrow' to the rowumns - (for-each-in-order + (for-each (lambda (newelt) ;; find the row, or append one (if (not (null? rows)) @@ -246,7 +243,7 @@ (this-row #f) (new-row #f) (rownum 0)) - (for-each-in-order + (for-each (lambda (elt) (if (not (null? rows)) (begin @@ -389,7 +386,7 @@ (push "\">\n"))) (push " class ;; this is the top-level object representing an entire HTML document. @@ -139,7 +136,7 @@ (push ((gnc:html-markup/no-end "body") doc)))) ;; now render the children - (for-each-in-order + (for-each (lambda (child) (push (gnc:html-object-render child doc))) (gnc:html-document-objects doc)) diff --git a/src/scm/html-piechart.scm b/src/report/report-system/html-piechart.scm similarity index 98% rename from src/scm/html-piechart.scm rename to src/report/report-system/html-piechart.scm index 416594bfef..460cc72c55 100644 --- a/src/scm/html-piechart.scm +++ b/src/report/report-system/html-piechart.scm @@ -21,10 +21,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "html-piechart.scm") - -(use-modules (ice-9 regex)) - (define (make-record-type "" '(width height title subtitle data colors labels @@ -211,7 +207,7 @@ (push " \n") (push " (make-record-type "" '(width height title subtitle @@ -210,13 +208,13 @@ (push " \n") (push " \n") (push " class diff --git a/src/scm/html-style-sheet.scm b/src/report/report-system/html-style-sheet.scm similarity index 99% rename from src/scm/html-style-sheet.scm rename to src/report/report-system/html-style-sheet.scm index 6e9edeff80..c5eee53782 100644 --- a/src/scm/html-style-sheet.scm +++ b/src/report/report-system/html-style-sheet.scm @@ -21,8 +21,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "html-style-sheet.scm") - (define *gnc:_style-sheet-templates_* (make-hash-table 23)) (define *gnc:_style-sheets_* (make-hash-table 23)) diff --git a/src/scm/html-table.scm b/src/report/report-system/html-table.scm similarity index 99% rename from src/scm/html-table.scm rename to src/report/report-system/html-table.scm index cc45ff0d05..fe9b197cf5 100644 --- a/src/scm/html-table.scm +++ b/src/report/report-system/html-table.scm @@ -21,8 +21,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "html-table.scm") - (define (make-record-type "" '(col-headers diff --git a/src/scm/html-text.scm b/src/report/report-system/html-text.scm similarity index 98% rename from src/scm/html-text.scm rename to src/report/report-system/html-text.scm index b5818222d4..d10fe5cc13 100644 --- a/src/scm/html-text.scm +++ b/src/report/report-system/html-text.scm @@ -21,11 +21,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'record) -(require 'hash-table) - -(gnc:support "html-text.scm") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; class @@ -212,7 +207,7 @@ (gnc:html-style-table-compile (gnc:html-text-style p) (gnc:html-document-style-stack doc)) (gnc:html-document-push-style doc (gnc:html-text-style p)) - (for-each-in-order + (for-each (lambda (elt) (cond ((procedure? elt) (push (elt doc))) @@ -227,7 +222,7 @@ (let* ((retval '()) (push (lambda (l) (set! retval (cons l retval))))) (push (gnc:html-document-markup-start doc markup attrib)) - (for-each-in-order + (for-each (lambda (elt) (cond ((procedure? elt) (push (elt doc))) diff --git a/src/scm/html-utilities.scm b/src/report/report-system/html-utilities.scm similarity index 99% rename from src/scm/html-utilities.scm rename to src/report/report-system/html-utilities.scm index 78d5310c90..fd4fde29c7 100644 --- a/src/scm/html-utilities.scm +++ b/src/report/report-system/html-utilities.scm @@ -20,12 +20,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "html-utilities.scm") - -(gnc:depend "report-utilities.scm") -(gnc:depend "html-text.scm") -(gnc:depend "commodity-utilities.scm") - ;; returns a list with n #f (empty cell) values (define (gnc:html-make-empty-cells n) (if (> n 0) @@ -693,4 +687,5 @@ (gnc:html-markup-h2 (_ "No data")) (gnc:html-markup-p (_ "The selected accounts contain no data/transactions (or only zeroes) for the selected time period"))) - p)) \ No newline at end of file + p)) + diff --git a/src/scm/options-utilities.scm b/src/report/report-system/options-utilities.scm similarity index 99% rename from src/scm/options-utilities.scm rename to src/report/report-system/options-utilities.scm index 69bc9cd672..35a51f26ed 100644 --- a/src/scm/options-utilities.scm +++ b/src/report/report-system/options-utilities.scm @@ -21,9 +21,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "options-utilities.scm") - -(gnc:depend "options.scm") ;; These are just a bunch of options which were useful in several ;; reports and hence they got defined in a seperate function. diff --git a/src/report/report-system/report-system.scm b/src/report/report-system/report-system.scm new file mode 100644 index 0000000000..457656234e --- /dev/null +++ b/src/report/report-system/report-system.scm @@ -0,0 +1,544 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; report-system.scm +;; module definition for the report system code +;; +;; Copyright (c) 2001 Linux Developers Group, Inc. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-module (gnucash report report-system)) + +(use-modules (ice-9 slib)) +(use-modules (ice-9 regex)) +(use-modules (srfi srfi-1)) +(use-modules (srfi srfi-19)) +(use-modules (gnucash gnc-module)) + +(require 'hash-table) + +(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/app-utils" 0) + +;; commodity-utilities.scm +(export gnc:commodity-is-currency?) +(export gnc:get-match-commodity-splits) +(export gnc:get-match-commodity-splits-sorted) +(export gnc:get-all-commodity-splits ) +(export gnc:commodity-numeric->string) +(export gnc:exchange-by-euro-numeric) +(export gnc:get-commodity-totalavg-prices) +(export gnc:get-commoditylist-totalavg-prices) +(export gnc:get-commodity-inst-prices) +(export gnc:get-commoditylist-inst-prices) +(export gnc:pricelist-price-find-nearest) +(export gnc:pricealist-lookup-nearest-in-time) +(export gnc:resolve-unknown-comm) +(export gnc:get-exchange-totals) +(export gnc:make-exchange-alist) +(export gnc:exchange-by-euro) +(export gnc:exchange-if-same) +(export gnc:make-exchange-function) +(export gnc:exchange-by-pricevalue-helper) +(export gnc:exchange-by-pricedb-helper) +(export gnc:exchange-by-pricedb-latest ) +(export gnc:exchange-by-pricedb-nearest) +(export gnc:exchange-by-pricealist-nearest) +(export gnc:case-exchange-fn) +(export gnc:case-exchange-time-fn) +(export gnc:sum-collector-commodity) +(export gnc:sum-collector-stocks) + + +;; options-utilities.scm + +(export gnc:options-add-report-date!) +(export gnc:options-add-date-interval!) +(export gnc:options-add-interval-choice!) +(export gnc:options-add-account-levels!) +(export gnc:options-add-account-selection!) +(export gnc:options-add-include-subaccounts!) +(export gnc:options-add-group-accounts!) +(export gnc:options-add-currency!) +(export gnc:options-add-currency-selection!) +(export gnc:options-add-price-source!) +(export gnc:options-add-plot-size!) +(export gnc:options-add-marker-choice!) + +;; html-utilities.scm + +(export gnc:html-make-empty-cells) +(export gnc:account-anchor-text) +(export gnc:split-anchor-text) +(export gnc:transaction-anchor-text) +(export gnc:report-anchor-text) +(export gnc:make-report-anchor) +(export gnc:html-account-anchor) +(export gnc:html-split-anchor) +(export gnc:html-transaction-anchor) +(export gnc:assign-colors) +(export gnc:html-table-append-ruler!) +(export gnc:html-table-append-ruler/markup!) +(export gnc:html-acct-table-cell) +(export gnc:html-acct-table-row-helper! ) +(export gnc:html-acct-table-comm-row-helper!) +(export gnc:html-build-acct-table ) +(export gnc:html-make-exchangerates) +(export gnc:html-make-no-account-warning) +(export gnc:html-make-empty-data-warning) + +;; report.scm +(export gnc:menuname-reports) +(export gnc:menuname-asset-liability) +(export gnc:menuname-income-expense ) +(export gnc:menuname-taxes) +(export gnc:menuname-utility) +(export gnc:pagename-general) +(export gnc:pagename-accounts) +(export gnc:pagename-display) +(export gnc:optname-reportname) + +(export gnc:define-report) +(export ) +(export *gnc:_reports_*) +(export gnc:report-type) +(export gnc:report-set-type!) +(export gnc:report-id) +(export gnc:report-set-id!) +(export gnc:report-options) +(export gnc:report-set-options!) +(export gnc:report-needs-save?) +(export gnc:report-set-needs-save?!) +(export gnc:report-dirty?) +(export gnc:report-set-dirty?!) +(export gnc:report-editor-widget) +(export gnc:report-set-editor-widget!) +(export gnc:report-ctext) +(export gnc:report-set-ctext!) +(export gnc:report-edit-options) +(export gnc:make-report) +(export gnc:restore-report) +(export gnc:make-report-options) +(export gnc:report-options-editor) +(export gnc:report-export-thunk) +(export gnc:report-menu-name) +(export gnc:report-name) +(export gnc:report-stylesheet) +(export gnc:report-set-stylesheet!) +(export gnc:all-report-template-names) +(export gnc:report-remove-by-id) +(export gnc:find-report) +(export gnc:report-generate-restore-forms) +(export gnc:backtrace-if-exception) +(export gnc:report-render-html) +(export gnc:report-run) + +;; html-barchart.scm + +(export ) +(export gnc:html-barchart? ) +(export gnc:make-html-barchart-internal) +(export gnc:make-html-barchart) +(export gnc:html-barchart-data) +(export gnc:html-barchart-set-data!) +(export gnc:html-barchart-width) +(export gnc:html-barchart-set-width!) +(export gnc:html-barchart-height) +(export gnc:html-barchart-set-height!) +(export gnc:html-barchart-x-axis-label) +(export gnc:html-barchart-set-x-axis-label!) +(export gnc:html-barchart-y-axis-label) +(export gnc:html-barchart-set-y-axis-label!) +(export gnc:html-barchart-row-labels) +(export gnc:html-barchart-set-row-labels!) +(export gnc:html-barchart-row-labels-rotated?) +(export gnc:html-barchart-set-row-labels-rotated?!) +(export gnc:html-barchart-stacked?) +(export gnc:html-barchart-set-stacked?!) +(export gnc:html-barchart-col-labels) +(export gnc:html-barchart-set-col-labels!) +(export gnc:html-barchart-col-colors) +(export gnc:html-barchart-set-col-colors!) +(export gnc:html-barchart-legend-reversed?) +(export gnc:html-barchart-set-legend-reversed?!) +(export gnc:html-barchart-title) +(export gnc:html-barchart-set-title!) +(export gnc:html-barchart-subtitle) +(export gnc:html-barchart-set-subtitle!) +(export gnc:html-barchart-button-1-bar-urls) +(export gnc:html-barchart-set-button-1-bar-urls!) +(export gnc:html-barchart-button-2-bar-urls) +(export gnc:html-barchart-set-button-2-bar-urls!) +(export gnc:html-barchart-button-3-bar-urls) +(export gnc:html-barchart-set-button-3-bar-urls!) +(export gnc:html-barchart-button-1-legend-urls) +(export gnc:html-barchart-set-button-1-legend-urls!) +(export gnc:html-barchart-button-2-legend-urls) +(export gnc:html-barchart-set-button-2-legend-urls!) +(export gnc:html-barchart-button-3-legend-urls) +(export gnc:html-barchart-set-button-3-legend-urls!) +(export gnc:html-barchart-append-row!) +(export gnc:html-barchart-prepend-row!) +(export gnc:html-barchart-append-column!) +(export gnc:not-all-zeros) +(export gnc:html-barchart-prepend-column!) +(export gnc:html-barchart-render barchart) + +;; html-document.scm + +(export ) +(export gnc:html-document?) +(export gnc:make-html-document-internal) +(export gnc:make-html-document) +(export gnc:html-document-set-title!) +(export gnc:html-document-title) +(export gnc:html-document-set-style-sheet!) +(export gnc:html-document-style-sheet) +(export gnc:html-document-set-style-stack!) +(export gnc:html-document-style-stack) +(export gnc:html-document-set-style-internal!) +(export gnc:html-document-style) +(export gnc:html-document-set-objects!) +(export gnc:html-document-objects) +(export gnc:html-document?) +(export gnc:html-document-set-style!) +(export gnc:html-document-tree-collapse) +(export gnc:html-document-render) +(export gnc:html-document-push-style) +(export gnc:html-document-pop-style) +(export gnc:html-document-add-object!) +(export gnc:html-document-append-objects!) +(export gnc:html-document-fetch-markup-style) +(export gnc:html-document-fetch-data-style) +(export gnc:html-document-markup-start) +(export gnc:html-document-markup-end) +(export gnc:html-document-render-data) +(export ) +(export gnc:html-object?) +(export gnc:make-html-object-internal) +(export gnc:make-html-object) +(export gnc:html-object-renderer) +(export gnc:html-object-set-renderer!) +(export gnc:html-object-data) +(export gnc:html-object-set-data!) +(export gnc:html-object-render) + +;; html-piechart.scm + +(export ) +(export gnc:html-piechart?) +(export gnc:make-html-piechart-internal) +(export gnc:make-html-piechart) +(export gnc:html-piechart-data) +(export gnc:html-piechart-set-data!) +(export gnc:html-piechart-width) +(export gnc:html-piechart-set-width!) +(export gnc:html-piechart-height) +(export gnc:html-piechart-set-height!) +(export gnc:html-piechart-labels) +(export gnc:html-piechart-set-labels!) +(export gnc:html-piechart-colors) +(export gnc:html-piechart-set-colors!) +(export gnc:html-piechart-title) +(export gnc:html-piechart-set-title!) +(export gnc:html-piechart-subtitle) +(export gnc:html-piechart-set-subtitle!) +(export gnc:html-piechart-button-1-slice-urls) +(export gnc:html-piechart-set-button-1-slice-urls!) +(export gnc:html-piechart-button-2-slice-urls) +(export gnc:html-piechart-set-button-2-slice-urls!) +(export gnc:html-piechart-button-3-slice-urls) +(export gnc:html-piechart-set-button-3-slice-urls!) +(export gnc:html-piechart-button-1-legend-urls) +(export gnc:html-piechart-set-button-1-legend-urls!) +(export gnc:html-piechart-button-2-legend-urls) +(export gnc:html-piechart-set-button-2-legend-urls!) +(export gnc:html-piechart-button-3-legend-urls) +(export gnc:html-piechart-set-button-3-legend-urls!) +(export gnc:html-piechart-render) + +;; html-scatter.scm + +(export ) +(export gnc:html-scatter?) +(export gnc:make-html-scatter-internal) +(export gnc:make-html-scatter) +(export gnc:html-scatter-width) +(export gnc:html-scatter-set-width!) +(export gnc:html-scatter-height) +(export gnc:html-scatter-set-height!) +(export gnc:html-scatter-title) +(export gnc:html-scatter-set-title!) +(export gnc:html-scatter-subtitle) +(export gnc:html-scatter-set-subtitle!) +(export gnc:html-scatter-x-axis-label) +(export gnc:html-scatter-set-x-axis-label!) +(export gnc:html-scatter-y-axis-label) +(export gnc:html-scatter-set-y-axis-label!) +(export gnc:html-scatter-data) +(export gnc:html-scatter-set-data!) +(export gnc:html-scatter-marker) +(export gnc:html-scatter-set-marker!) +(export gnc:html-scatter-markercolor) +(export gnc:html-scatter-set-markercolor!) +(export gnc:html-scatter-add-datapoint!) +(export gnc:html-scatter-render) + +;; html-style-info.scm + +(export make-kvtable) +(export kvt-ref) +(export kvt-set!) +(export kvt-fold) +(export ) +(export gnc:html-markup-style-info?) +(export gnc:make-html-markup-style-info-internal) +(export gnc:make-html-markup-style-info) +(export gnc:html-markup-style-info-set!) +(export gnc:html-markup-style-info-tag) +(export gnc:html-markup-style-info-set-tag!) +(export gnc:html-markup-style-info-attributes) +(export gnc:html-markup-style-info-set-attributes!) +(export gnc:html-markup-style-info-font-face) +(export gnc:html-markup-style-info-set-font-face-internal!) +(export gnc:html-markup-style-info-set-font-face!) +(export gnc:html-markup-style-info-font-size) +(export gnc:html-markup-style-info-set-font-size-internal!) +(export gnc:html-markup-style-info-set-font-size!) +(export gnc:html-markup-style-info-font-color) +(export gnc:html-markup-style-info-set-font-color-internal!) +(export gnc:html-markup-style-info-set-font-color!) +(export gnc:html-markup-style-info-closing-font-tag) +(export gnc:html-markup-style-info-set-closing-font-tag!) +(export gnc:html-markup-style-info-inheritable?) +(export gnc:html-markup-style-info-set-inheritable?!) +(export gnc:html-markup-style-info-set-attribute!) +(export gnc:html-markup-style-info-merge) +(export gnc:html-style-info-merge) +(export gnc:html-data-style-info-merge) +(export ) +(export gnc:html-data-style-info?) +(export gnc:make-html-data-style-info-internal) +(export gnc:make-html-data-style-info) +(export gnc:html-data-style-info?) +(export gnc:html-data-style-info-renderer) +(export gnc:html-data-style-info-set-renderer!) +(export gnc:html-data-style-info-data) +(export gnc:html-data-style-info-set-data!) +(export gnc:html-data-style-info-inheritable?) +(export gnc:html-data-style-info-set-inheritable?!) +(export gnc:default-html-string-renderer) +(export gnc:default-html-gnc-numeric-renderer) +(export gnc:default-html-gnc-monetary-renderer) +(export gnc:default-html-number-renderer) +(export ) +(export gnc:html-style-table?) +(export gnc:make-html-style-table-internal) +(export gnc:make-html-style-table) +(export gnc:html-style-table-primary) +(export gnc:html-style-table-compiled) +(export gnc:html-style-table-set-compiled!) +(export gnc:html-style-table-inheritable) +(export gnc:html-style-table-set-inheritable!) +(export gnc:html-style-table-compiled?) +(export gnc:html-style-table-compile) +(export gnc:html-style-table-uncompile) +(export gnc:html-style-table-fetch) +(export gnc:html-style-table-set!) + +;; html-style-sheet.scm + +(export ) +(export gnc:html-style-sheet-template?) +(export gnc:html-style-sheet-template-version) +(export gnc:html-style-sheet-template-set-version!) +(export gnc:html-style-sheet-template-name) +(export gnc:html-style-sheet-template-set-name!) +(export gnc:html-style-sheet-template-options-generator) +(export gnc:html-style-sheet-template-set-options-generator!) +(export gnc:html-style-sheet-template-renderer) +(export gnc:html-style-sheet-template-set-renderer!) +(export gnc:html-style-sheet-template-find) +(export gnc:define-html-style-sheet) +(export ) +(export gnc:html-style-sheet?) +(export gnc:html-style-sheet-name) +(export gnc:html-style-sheet-set-name!) +(export gnc:html-style-sheet-type) +(export gnc:html-style-sheet-set-type!) +(export gnc:html-style-sheet-options) +(export gnc:html-style-sheet-set-options!) +(export gnc:html-style-sheet-renderer) +(export gnc:html-style-sheet-set-renderer!) +(export gnc:make-html-style-sheet-internal) +(export gnc:html-style-sheet-style) +(export gnc:save-style-sheet-options) +(export gnc:html-style-sheet-set-style!) +(export gnc:make-html-style-sheet) +(export gnc:restore-html-style-sheet) +(export gnc:html-style-sheet-apply-changes) +(export gnc:html-style-sheet-render) +(export gnc:get-html-style-sheets) +(export gnc:get-html-templates) +(export gnc:html-style-sheet-find) +(export gnc:html-style-sheet-remove) + +;; html-table.scm + +(export ) +(export gnc:html-table?) +(export ) +(export gnc:make-html-table-cell-internal) +(export gnc:make-html-table-cell) +(export gnc:make-html-table-cell/size) +(export gnc:make-html-table-cell/markup) +(export gnc:make-html-table-cell/size/markup) +(export gnc:make-html-table-header-cell) +(export gnc:make-html-table-header-cell/markup) +(export gnc:make-html-table-header-cell/size) +(export gnc:html-table-cell?) +(export gnc:html-table-cell-rowspan) +(export gnc:html-table-cell-set-rowspan!) +(export gnc:html-table-cell-colspan) +(export gnc:html-table-cell-set-colspan!) +(export gnc:html-table-cell-tag) +(export gnc:html-table-cell-set-tag!) +(export gnc:html-table-cell-data) +(export gnc:html-table-cell-set-data-internal!) +(export gnc:html-table-cell-style) +(export gnc:html-table-cell-set-style-internal!) +(export gnc:html-table-cell-set-style!) +(export gnc:html-table-cell-append-objects!) +(export gnc:html-table-cell-render) +(export gnc:make-html-table-internal) +(export gnc:make-html-table) +(export gnc:html-table-data) +(export gnc:html-table-set-data!) +(export gnc:html-table-caption) +(export gnc:html-table-set-caption!) +(export gnc:html-table-col-headers) +(export gnc:html-table-set-col-headers!) +(export gnc:html-table-row-headers) +(export gnc:html-table-set-row-headers!) +(export gnc:html-table-style) +(export gnc:html-table-set-style-internal!) +(export gnc:html-table-row-styles) +(export gnc:html-table-set-row-styles!) +(export gnc:html-table-row-markup-table) +(export gnc:html-table-row-markup) +(export gnc:html-table-set-row-markup-table!) +(export gnc:html-table-set-row-markup!) +(export gnc:html-table-col-styles) +(export gnc:html-table-set-col-styles!) +(export gnc:html-table-col-headers-style) +(export gnc:html-table-set-col-headers-style!) +(export gnc:html-table-row-headers-style) +(export gnc:html-table-set-row-headers-style!) +(export gnc:html-table-set-style!) +(export gnc:html-table-set-col-style!) +(export gnc:html-table-set-row-style!) +(export gnc:html-table-row-style) +(export gnc:html-table-col-style) +(export gnc:html-table-num-rows) +(export gnc:html-table-set-num-rows-internal!) +(export gnc:html-table-num-columns) +(export gnc:html-table-append-row/markup!) +(export gnc:html-table-prepend-row/markup!) +(export gnc:html-table-append-row!) +(export gnc:html-table-remove-last-row!) +(export gnc:html-table-prepend-row!) +(export gnc:html-table-set-cell!) +(export gnc:html-table-append-column!) +(export gnc:html-table-prepend-column!) +(export gnc:html-table-render) + +;; html-text.scm + +(export ) +(export gnc:html-text?) +(export gnc:make-html-text-internal) +(export gnc:make-html-text) +(export gnc:html-text?) +(export gnc:html-text-body) +(export gnc:html-text-set-body-internal!) +(export gnc:html-text-set-body!) +(export gnc:html-text-style) +(export gnc:html-text-set-style-internal!) +(export gnc:html-text-set-style!) +(export gnc:html-text-append!) +(export gnc:html-markup) +(export gnc:html-markup/attr) +(export gnc:html-markup/no-end) +(export gnc:html-markup/attr/no-end) +(export gnc:html-markup/format) +(export gnc:html-markup-p) +(export gnc:html-markup-tt) +(export gnc:html-markup-em) +(export gnc:html-markup-b) +(export gnc:html-markup-i) +(export gnc:html-markup-h1) +(export gnc:html-markup-h2) +(export gnc:html-markup-h3) +(export gnc:html-markup-br) +(export gnc:html-markup-hr) +(export gnc:html-markup-ul) +(export gnc:html-markup-anchor) +(export gnc:html-markup-img) +(export gnc:html-text-render) +(export gnc:html-text-render-markup) + +;; report-utilities.scm + +(export list-ref-safe) +(export list-set-safe!) +(export gnc:amount->string) +(export gnc:commodity-value->string) +(export gnc:monetary->string) +(export gnc:account-has-shares?) +(export gnc:account-is-stock?) +(export gnc:account-is-inc-exp?) +(export gnc:filter-accountlist-type) +(export gnc:decompose-accountlist) +(export gnc:account-get-type-string-plural) +(export gnc:accounts-get-commodities) +(export gnc:get-current-group-depth) +(export gnc:account-separator-char) +(export gnc:account-get-full-name) +(export gnc:split-get-corr-account-full-name) +(export gnc:account-get-immediate-subaccounts) +(export gnc:account-get-all-subaccounts) +(export gnc:acccounts-get-all-subaccounts) +(export gnc:transaction-map-splits) +(export gnc:make-stats-collector) +(export gnc:make-drcr-collector) +(export gnc:make-value-collector) +(export gnc:make-numeric-collector) +(export gnc:make-commodity-collector) +(export gnc:account-get-balance-at-date) +(export gnc:account-get-comm-balance-at-date) +(export gnc:group-get-balance-at-date) +(export gnc:accounts-get-balance-helper) +(export gnc:accounts-get-comm-total-profit) +(export gnc:accounts-get-comm-total-income) +(export gnc:accounts-get-comm-total-expense) +(export gnc:accounts-get-comm-total-assets) +(export gnc:group-get-comm-balance-at-date) +(export gnc:account-get-balance-interval) +(export gnc:account-get-comm-balance-interval) +(export gnc:group-get-balance-interval) +(export gnc:group-get-comm-balance-interval) +(export gnc:transaction-get-splits) +(export gnc:split-get-other-splits) + +(load-from-path "commodity-utilities.scm") +(load-from-path "html-barchart.scm") +(load-from-path "html-document.scm") +(load-from-path "html-piechart.scm") +(load-from-path "html-scatter.scm") +(load-from-path "html-style-info.scm") + +(load-from-path "html-style-sheet.scm") +(load-from-path "html-table.scm") +(load-from-path "html-text.scm") +(load-from-path "html-utilities.scm") +(load-from-path "options-utilities.scm") +(load-from-path "report-utilities.scm") +(load-from-path "report.scm") diff --git a/src/scm/report-utilities.scm b/src/report/report-system/report-utilities.scm similarity index 98% rename from src/scm/report-utilities.scm rename to src/report/report-system/report-utilities.scm index c279b6ef54..a8b03fd7ce 100644 --- a/src/scm/report-utilities.scm +++ b/src/report/report-system/report-utilities.scm @@ -17,7 +17,24 @@ ;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 ;; Boston, MA 02111-1307, USA gnu@gnu.org -(gnc:support "report-utilities.scm") +(define (list-ref-safe list elt) + (if (> (length list) elt) + (list-ref list elt) + #f)) + +(define (list-set-safe! l elt val) + (if (and (list? l) (> (length l) elt)) + (list-set! l elt val) + (let ((filler (list val))) + (if (not (list? l)) + (set! l '())) + (let loop ((i (length l))) + (if (< i elt) + (begin + (set! filler (cons #f filler)) + (loop (+ 1 i))))) + (set! l (append! l filler)))) + l) (define gnc:amount->string gnc:amount->string-helper) diff --git a/src/scm/report.scm b/src/report/report-system/report.scm similarity index 99% rename from src/scm/report.scm rename to src/report/report-system/report.scm index 0daaaf1433..d43f753e65 100644 --- a/src/scm/report.scm +++ b/src/report/report-system/report.scm @@ -20,10 +20,6 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'hash-table) -(require 'record) - -(gnc:support "report.scm") ;; This hash should contain all the reports available and will be used ;; to generate the reports menu whenever a new window opens and to @@ -51,7 +47,6 @@ (define gnc:pagename-display (N_ "Display")) (define gnc:optname-reportname (N_ "Report name")) - (define (gnc:report-menu-setup) ;; since this menu gets added to every child window, we say it ;; comes after the "_File" menu. @@ -152,7 +147,7 @@ #f ;; version #f ;; name #f ;; options-generator - gnc:default-options-editor ;; options-editor + #f ;; options-editor #f ;; options-cleanup-cb #f ;; options-changed-cb #f ;; renderer @@ -369,7 +364,9 @@ (hash-ref *gnc:_report-templates_* (gnc:report-type report)))) (if template - (gnc:report-template-options-editor template) + (let ((ed (gnc:report-template-options-editor template))) + (if ed ed + gnc:default-options-editor)) #f))) (define (gnc:report-export-thunk report) diff --git a/src/report/report-system/test/Makefile.am b/src/report/report-system/test/Makefile.am new file mode 100644 index 0000000000..bd4277d696 --- /dev/null +++ b/src/report/report-system/test/Makefile.am @@ -0,0 +1,15 @@ +TESTS=test-link-module test-load-module + +TESTS_ENVIRONMENT= \ + GNC_MODULE_PATH=${top_srcdir}/src/engine:${top_srcdir}/src/app-utils:.. \ + GUILE_LOAD_PATH=${top_srcdir}/src/gnc-module:..:${G_WRAP_MODULE_DIR}:${top_srcdir}/lib:${top_srcdir}/src/scm:${top_srcdir}/src/app-utils:${top_srcdir}/src/engine \ + LTDL_LIBRARY_PATH=.. \ + LD_LIBRARY_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/src/gnc-module/.libs:${top_srcdir}/src/app-utils:${top_srcdir}/src/app-utils/.libs:${top_srcdir}/src/engine:${top_srcdir}/src/engine/.libs + + +bin_PROGRAMS=test-link-module + +LDADD = \ + ../libgncmod-report-system.la + +test-link-module: test-link-module.c diff --git a/src/report/report-system/test/test-link-module.c b/src/report/report-system/test/test-link-module.c new file mode 100644 index 0000000000..c0d815b3d5 --- /dev/null +++ b/src/report/report-system/test/test-link-module.c @@ -0,0 +1,6 @@ +#include + +int +main(int argc, char ** argv) { + exit(0); +} diff --git a/src/report/report-system/test/test-load-module b/src/report/report-system/test/test-load-module new file mode 100755 index 0000000000..4a6e03bde2 --- /dev/null +++ b/src/report/report-system/test/test-load-module @@ -0,0 +1,26 @@ +#! /bin/sh +exec guile -s "$0" +!# + +(debug-enable 'debug) +(debug-enable 'backtrace) + +(debug-set! stack 5000000) +(debug-set! maxdepth 10000) + +(display " testing report module load ... ") +(use-modules (ice-9 syncase)) +(use-modules (gnucash gnc-module)) +(gnc:module-system-init) + +(if (gnc:module-load "gnucash/report/report-system" 0) + (begin + (display "ok\n") + (exit 0)) + (begin + (display "failed\n") + (exit -1))) + + + + diff --git a/src/report/standard-reports/Makefile.am b/src/report/standard-reports/Makefile.am new file mode 100644 index 0000000000..d12c75cf8b --- /dev/null +++ b/src/report/standard-reports/Makefile.am @@ -0,0 +1,36 @@ +SUBDIRS=. test + +pkglib_LTLIBRARIES=libgncmod-standard-reports.la + +libgncmod_standard_reports_la_SOURCES=\ + gncmod-standard-reports.c + +libgncmod_standard_reports_la_LDFLAGS=-module + +INCLUDES=-I${top_srcdir}/src/gnc-module ${GLIB_CFLAGS} + +.scm-links: + rm -f gnucash report + ln -sf . gnucash + ln -sf . report + touch .scm-links + +noinst_DATA = .scm-links + +gncscmmoddir=${GNC_SHAREDIR}/guile-modules/gnucash/report/ +gncscmmod_DATA = \ + account-piecharts.scm \ + account-summary.scm \ + average-balance.scm \ + balance-sheet.scm \ + category-barchart.scm \ + net-barchart.scm \ + payables.scm \ + pnl.scm \ + portfolio.scm \ + price-scatter.scm \ + register.scm \ + standard-reports.scm \ + transaction.scm + +CLEANFILES += gnucash report .scm-links diff --git a/src/scm/report/account-piecharts.scm b/src/report/standard-reports/account-piecharts.scm similarity index 99% rename from src/scm/report/account-piecharts.scm rename to src/report/standard-reports/account-piecharts.scm index 325a65f537..0adb419b79 100644 --- a/src/scm/report/account-piecharts.scm +++ b/src/report/standard-reports/account-piecharts.scm @@ -23,10 +23,6 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") -(gnc:depend "date-utilities.scm") - (define-module (gnucash report account-piecharts)) (use-modules (srfi srfi-1)) @@ -34,7 +30,7 @@ (require 'printf) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) (define menuname-income (N_ "Income Piechart")) (define menuname-expense (N_ "Expense Piechart")) diff --git a/src/scm/report/account-summary.scm b/src/report/standard-reports/account-summary.scm similarity index 98% rename from src/scm/report/account-summary.scm rename to src/report/standard-reports/account-summary.scm index c5eba1ea92..9df70a41f4 100644 --- a/src/scm/report/account-summary.scm +++ b/src/report/standard-reports/account-summary.scm @@ -26,15 +26,12 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") - (define-module (gnucash report account-summary)) (use-modules (srfi srfi-1)) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) ;; account summary report ;; prints a table of account information with clickable diff --git a/src/scm/report/average-balance.scm b/src/report/standard-reports/average-balance.scm similarity index 98% rename from src/scm/report/average-balance.scm rename to src/report/standard-reports/average-balance.scm index 9a9d353c61..7d847dfa54 100644 --- a/src/scm/report/average-balance.scm +++ b/src/report/standard-reports/average-balance.scm @@ -7,17 +7,12 @@ ;; or indirect losses incurred as a result of using this software. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") -(gnc:depend "report-utilities.scm") -(gnc:depend "date-utilities.scm") - (define-module (gnucash report average-balance)) (use-modules (srfi srfi-1)) (use-modules (ice-9 slib)) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) (define optname-from-date (N_ "From")) (define optname-to-date (N_ "To")) diff --git a/src/scm/report/balance-sheet.scm b/src/report/standard-reports/balance-sheet.scm similarity index 99% rename from src/scm/report/balance-sheet.scm rename to src/report/standard-reports/balance-sheet.scm index fc5ee864a7..928e941b06 100644 --- a/src/scm/report/balance-sheet.scm +++ b/src/report/standard-reports/balance-sheet.scm @@ -25,16 +25,13 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") - (define-module (gnucash report balance-sheet)) (use-modules (ice-9 slib)) (require 'printf) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) ;; first define all option's names so that they are properly defined ;; in *one* place. diff --git a/src/scm/report/category-barchart.scm b/src/report/standard-reports/category-barchart.scm similarity index 99% rename from src/scm/report/category-barchart.scm rename to src/report/standard-reports/category-barchart.scm index fad0c2b822..c7a3e949ca 100644 --- a/src/scm/report/category-barchart.scm +++ b/src/report/standard-reports/category-barchart.scm @@ -23,16 +23,13 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") -(gnc:depend "date-utilities.scm") - (define-module (gnucash report category-barchart)) (use-modules (srfi srfi-1)) (use-modules (ice-9 slib)) (require 'printf) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) ;; The option names are defined here to 1. save typing and 2. avoid ;; spelling errors. The *reportnames* are defined here (and not only diff --git a/src/report/standard-reports/gncmod-standard-reports.c b/src/report/standard-reports/gncmod-standard-reports.c new file mode 100644 index 0000000000..12535d497a --- /dev/null +++ b/src/report/standard-reports/gncmod-standard-reports.c @@ -0,0 +1,51 @@ +/********************************************************************* + * gncmod-standard-reports.c + * module definition/initialization for the standard reports + * + * Copyright (c) 2001 Linux Developers Group, Inc. + *********************************************************************/ + +#include +#include +#include +#include "gnc-module.h" + +/* version of the gnc module system interface we require */ +int gnc_module_system_interface = 0; + +/* module versioning uses libtool semantics. */ +int gnc_module_current = 0; +int gnc_module_revision = 0; +int gnc_module_age = 0; + +char * +gnc_module_path(void) { + return g_strdup("gnucash/report/standard-reports"); +} + +char * +gnc_module_description(void) { + return g_strdup("Standard income, asset, balance sheet, etc. reports"); +} + +int +gnc_module_init(int refcount) { + /* load the report system */ + if(!gnc_module_load("gnucash/report/report-system", 0)) { + return FALSE; + } + + /* load the report generation scheme code */ + if(gh_eval_str("(use-modules (gnucash report standard-reports))") == + SCM_BOOL_F) { + return FALSE; + } + return TRUE; +} + + +void +gnc_module_finish(int refcount) { + +} + diff --git a/src/scm/report/net-barchart.scm b/src/report/standard-reports/net-barchart.scm similarity index 98% rename from src/scm/report/net-barchart.scm rename to src/report/standard-reports/net-barchart.scm index 12c1504d00..66c200bb6e 100644 --- a/src/scm/report/net-barchart.scm +++ b/src/report/standard-reports/net-barchart.scm @@ -24,11 +24,6 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") -(gnc:depend "date-utilities.scm") - - (define-module (gnucash report net-barchart)) (use-modules (srfi srfi-1)) @@ -36,7 +31,7 @@ (require 'printf) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) (define optname-from-date (N_ "From")) (define optname-to-date (N_ "To")) diff --git a/src/scm/report/payables.scm b/src/report/standard-reports/payables.scm similarity index 99% rename from src/scm/report/payables.scm rename to src/report/standard-reports/payables.scm index 80fc572335..00c3bf97f7 100644 --- a/src/scm/report/payables.scm +++ b/src/report/standard-reports/payables.scm @@ -22,11 +22,6 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -(gnc:depend "report-html.scm") -(gnc:depend "date-utilities.scm") - - (define-module (gnucash report payables)) (use-modules (ice-9 slib)) @@ -35,7 +30,7 @@ (require 'record) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) (define opt-pay-acc (N_ "Payables Account")) (define sect-acc (N_ "Accounts")) diff --git a/src/scm/report/pnl.scm b/src/report/standard-reports/pnl.scm similarity index 98% rename from src/scm/report/pnl.scm rename to src/report/standard-reports/pnl.scm index 4956715a29..eada7732df 100644 --- a/src/scm/report/pnl.scm +++ b/src/report/standard-reports/pnl.scm @@ -22,9 +22,6 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") - (define-module (gnucash report pnl)) (use-modules (srfi srfi-1)) @@ -32,7 +29,7 @@ (require 'printf) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) ;; Profit and loss report. Actually, people in finances might want ;; something different under this name, but they are welcomed to diff --git a/src/scm/report/portfolio.scm b/src/report/standard-reports/portfolio.scm similarity index 98% rename from src/scm/report/portfolio.scm rename to src/report/standard-reports/portfolio.scm index 4b50163a47..ceb5ccd9e0 100644 --- a/src/scm/report/portfolio.scm +++ b/src/report/standard-reports/portfolio.scm @@ -21,9 +21,6 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") - (define-module (gnucash report portfolio)) (use-modules (srfi srfi-1)) @@ -31,7 +28,7 @@ (require 'printf) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) (define optname-price-source (N_ "Price Source")) diff --git a/src/scm/report/price-scatter.scm b/src/report/standard-reports/price-scatter.scm similarity index 98% rename from src/scm/report/price-scatter.scm rename to src/report/standard-reports/price-scatter.scm index c5a6f386bc..e480a5f550 100644 --- a/src/scm/report/price-scatter.scm +++ b/src/report/standard-reports/price-scatter.scm @@ -22,9 +22,6 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") - (define-module (gnucash report price-scatter)) (use-modules (srfi srfi-1)) @@ -32,7 +29,7 @@ (require 'printf) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) (define optname-from-date (N_ "From")) (define optname-to-date (N_ "To")) diff --git a/src/scm/report/register.scm b/src/report/standard-reports/register.scm similarity index 99% rename from src/scm/report/register.scm rename to src/report/standard-reports/register.scm index a818a665fb..aa1c7d1aa3 100644 --- a/src/scm/report/register.scm +++ b/src/report/standard-reports/register.scm @@ -1,11 +1,6 @@ ;; -*-scheme-*- ;; register.scm -;; depends must be outside module scope -- and should eventually go away. - -(gnc:depend "report-html.scm") -(gnc:depend "date-utilities.scm") - (define-module (gnucash report register)) (export gnc:show-register-report) @@ -16,6 +11,9 @@ (use-modules (ice-9 slib)) (require 'record) +(use-modules (gnucash gnc-module)) +(gnc:module-load "gnucash/report/report-system" 0) + (define-macro (addto! alist element) `(set! ,alist (cons ,element ,alist))) diff --git a/src/report/standard-reports/standard-reports.scm b/src/report/standard-reports/standard-reports.scm new file mode 100644 index 0000000000..516b583a64 --- /dev/null +++ b/src/report/standard-reports/standard-reports.scm @@ -0,0 +1,21 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; standard-reports.scm +;; load the standard report definitions +;; +;; Copyright (c) 2001 Linux Developers Group, Inc. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-module (gnucash report standard-reports)) + +(use-modules (gnucash report account-piecharts)) +(use-modules (gnucash report account-summary)) +(use-modules (gnucash report average-balance)) +(use-modules (gnucash report balance-sheet)) +(use-modules (gnucash report category-barchart)) +(use-modules (gnucash report net-barchart)) +(use-modules (gnucash report payables)) +(use-modules (gnucash report pnl)) +(use-modules (gnucash report portfolio)) +(use-modules (gnucash report price-scatter)) +(use-modules (gnucash report register)) +(use-modules (gnucash report transaction)) diff --git a/src/report/standard-reports/test/Makefile.am b/src/report/standard-reports/test/Makefile.am new file mode 100644 index 0000000000..12e50adf0b --- /dev/null +++ b/src/report/standard-reports/test/Makefile.am @@ -0,0 +1,6 @@ +TESTS=test-load-module + +TESTS_ENVIRONMENT= \ + GNC_MODULE_PATH=${top_srcdir}/src/engine:${top_srcdir}/src/report/report-system:${top_srcdir}/src/app-utils:.. \ + GUILE_LOAD_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/lib:..:${G_WRAP_MODULE_DIR} \ + LD_LIBRARY_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/src/gnc-module/.libs:${top_srcdir}/src/engine:${top_srcdir}/src/engine/.libs:${top_srcdir}/src/app-utils:${top_srcdir}/src/app-utils/.libs diff --git a/src/report/standard-reports/test/test-load-module b/src/report/standard-reports/test/test-load-module new file mode 100755 index 0000000000..9d6df8560b --- /dev/null +++ b/src/report/standard-reports/test/test-load-module @@ -0,0 +1,19 @@ +#! /bin/sh +exec guile -s "$0" +!# + +(display " testing standard report module load ... ") +(use-modules (gnucash gnc-module)) +(gnc:module-system-init) + +(if (gnc:module-load "gnucash/report/standard-reports" 0) + (begin + (display "ok\n") + (exit 0)) + (begin + (display "failed\n") + (exit -1))) + + + + diff --git a/src/scm/report/transaction.scm b/src/report/standard-reports/transaction.scm similarity index 99% rename from src/scm/report/transaction.scm rename to src/report/standard-reports/transaction.scm index 415077d6a6..f55b5f23a3 100644 --- a/src/scm/report/transaction.scm +++ b/src/report/standard-reports/transaction.scm @@ -27,10 +27,6 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") -(gnc:depend "date-utilities.scm") - (define-module (gnucash report transaction)) (use-modules (srfi srfi-1)) @@ -39,7 +35,7 @@ (require 'record) (use-modules (gnucash gnc-module)) -(gnc:module-load "gnucash/engine" 0) +(gnc:module-load "gnucash/report/report-system" 0) (define-macro (addto! alist element) `(set! ,alist (cons ,element ,alist))) diff --git a/src/report/stylesheets/Makefile.am b/src/report/stylesheets/Makefile.am new file mode 100644 index 0000000000..47a4cc66cd --- /dev/null +++ b/src/report/stylesheets/Makefile.am @@ -0,0 +1,27 @@ +SUBDIRS=. test + +pkglib_LTLIBRARIES=libgncmod-stylesheets.la + +libgncmod_stylesheets_la_SOURCES=\ + gncmod-stylesheets.c + +libgncmod_stylesheets_la_LDFLAGS=-module + +INCLUDES=-I${top_srcdir}/src/gnc-module ${GLIB_CFLAGS} + +.scm-links: + rm -f gnucash report + ln -sf . gnucash + ln -sf . report + touch .scm-links + +noinst_DATA = .scm-links + +gncscmmoddir=${GNC_SHAREDIR}/guile-modules/gnucash/report/ +gncscmmod_DATA = \ + stylesheets.scm \ + stylesheet-plain.scm \ + stylesheet-fancy.scm + +CLEANFILES += gnucash report .scm-links + diff --git a/src/report/stylesheets/gncmod-stylesheets.c b/src/report/stylesheets/gncmod-stylesheets.c new file mode 100644 index 0000000000..0ce68b9d63 --- /dev/null +++ b/src/report/stylesheets/gncmod-stylesheets.c @@ -0,0 +1,52 @@ +/********************************************************************* + * gncmod-stylesheets.c + * module definition/initialization for the standard reports + * + * Copyright (c) 2001 Linux Developers Group, Inc. + *********************************************************************/ + +#include +#include +#include +#include "gnc-module.h" + +/* version of the gnc module system interface we require */ +int gnc_module_system_interface = 0; + +/* module versioning uses libtool semantics. */ +int gnc_module_current = 0; +int gnc_module_revision = 0; +int gnc_module_age = 0; + +char * +gnc_module_path(void) { + return g_strdup("gnucash/report/stylesheets"); +} + +char * +gnc_module_description(void) { + return g_strdup("Standard report stylesheet definitions"); +} + +int +gnc_module_init(int refcount) { + /* load the report system */ + if(!gnc_module_load("gnucash/report/report-system", 0)) { + return FALSE; + } + + /* load the report generation scheme code */ + if(gh_eval_str("(use-modules (gnucash report stylesheets))") == + SCM_BOOL_F) { + return FALSE; + } + + return TRUE; +} + + +void +gnc_module_finish(int refcount) { + +} + diff --git a/src/report/stylesheets/stylesheet-fancy.scm b/src/report/stylesheets/stylesheet-fancy.scm new file mode 100644 index 0000000000..e6f4f9e4cc --- /dev/null +++ b/src/report/stylesheets/stylesheet-fancy.scm @@ -0,0 +1,308 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; stylesheet-header.scm : stylesheet with nicer layout +;; Copyright 2000 Bill Gribble +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, contact: +;; +;; Free Software Foundation Voice: +1-617-542-5942 +;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 +;; Boston, MA 02111-1307, USA gnu@gnu.org +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(define-module (gnucash report stylesheet-fancy)) + +(use-modules (gnucash gnc-module)) +(gnc:module-load "gnucash/report/report-system" 0) + +(define (fancy-options) + (let* ((options (gnc:new-options)) + (opt-register + (lambda (opt) + (gnc:register-option options opt)))) + (opt-register + (gnc:make-string-option + (N_ "General") + (N_ "Preparer") "a" + (N_ "Name of person preparing the report") + "")) + (opt-register + (gnc:make-string-option + (N_ "General") + (N_ "Prepared for") "b" + (N_ "Name of organization or company prepared for") + "")) + (opt-register + (gnc:make-simple-boolean-option + (N_ "General") + (N_ "Show preparer info") "c" + (N_ "Name of organization or company") + #f)) + (opt-register + (gnc:make-simple-boolean-option + (N_ "General") + (N_ "Enable Links") "c" + (N_ "Enable hyperlinks in reports") + #t)) + + (opt-register + (gnc:make-pixmap-option + (N_ "Images") + (N_ "Background Tile") "a" (N_ "Background tile for reports.") + "")) + (opt-register + (gnc:make-pixmap-option + (N_ "Images") + (N_ "Heading Banner") "b" (N_ "Banner for top of report.") + "")) + (opt-register + (gnc:make-pixmap-option + (N_ "Images") + (N_ "Logo") "c" (N_ "Company logo image.") + "")) + + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Background Color") "a" (N_ "General background color for report.") + (list #xff #xff #xff 0) + 255 #f)) + + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Text Color") "b" (N_ "Normal body text color.") + (list #x00 #x00 #x00 0) + 255 #f)) + + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Link Color") "c" (N_ "Link text color.") + (list #xb2 #x22 #x22 0) + 255 #f)) + + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Table Cell Color") "c" (N_ "Default background for table cells.") + (list #xff #xff #xff 0) + 255 #f)) + + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Alternate Table Cell Color") "d" + (N_ "Default alternate background for table cells.") + (list #xff #xff #xff 0) + 255 #f)) + + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Subheading/Subtotal Cell Color") "e" + (N_ "Default color for subtotal rows.") + (list #xee #xe8 #xaa 0) + 255 #f)) + + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Sub-subheading/total Cell Color") "f" + (N_ "Color for subsubtotals") + (list #xfa #xfa #xd2 0) + 255 #f)) + + (opt-register + (gnc:make-color-option + (N_ "Colors") + (N_ "Grand Total Cell Color") "g" + (N_ "Color for grand totals") + (list #xff #xff #x00 0) + 255 #f)) + + (opt-register + (gnc:make-number-range-option + (N_ "Tables") + (N_ "Table cell spacing") "a" (N_ "Space between table cells") + 1 0 20 0 1)) + + (opt-register + (gnc:make-number-range-option + (N_ "Tables") + (N_ "Table cell padding") "b" (N_ "Space between table cells") + 1 0 20 0 1)) + + (opt-register + (gnc:make-number-range-option + (N_ "Tables") + (N_ "Table border width") "c" (N_ "Bevel depth on tables") + 1 0 20 0 1)) + options)) + +(define (fancy-renderer options doc) + (let* ((ssdoc (gnc:make-html-document)) + (opt-val + (lambda (section name) + (gnc:option-value + (gnc:lookup-option options section name)))) + (color-val + (lambda (section name) + (gnc:color-option->html + (gnc:lookup-option options section name)))) + (preparer (opt-val (N_ "General") (N_ "Preparer"))) + (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) + (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) + (links? (opt-val (N_ "General") (N_ "Enable Links"))) + (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) + (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) + (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) + (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) + (alternate-row-color (color-val (N_ "Colors") + (N_ "Alternate Table Cell Color"))) + (primary-subheading-color + (color-val (N_ "Colors") + (N_ "Subheading/Subtotal Cell Color"))) + (secondary-subheading-color + (color-val (N_ "Colors") + (N_ "Sub-subheading/total Cell Color"))) + (grand-total-color (color-val (N_ "Colors") + (N_ "Grand Total Cell Color"))) + (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) + (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) + (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) + (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) + (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) + (border (opt-val (N_ "Tables") (N_ "Table border width")))) + + (gnc:html-document-set-style! + ssdoc "body" + 'attribute (list "bgcolor" bgcolor) + 'attribute (list "text" textcolor) + 'attribute (list "link" linkcolor)) + + (gnc:html-document-set-style! + ssdoc "number-cell" + 'tag "td" + 'attribute (list "align" "right")) + + (if (and bgpixmap + (not (string=? bgpixmap ""))) + (gnc:html-document-set-style! + ssdoc "body" + 'attribute (list "background" bgpixmap))) + + (gnc:html-document-set-style! + ssdoc "table" + 'attribute (list "border" border) + 'attribute (list "cellspacing" spacing) + 'attribute (list "cellpadding" padding)) + + (gnc:html-document-set-style! + ssdoc "normal-row" + 'attribute (list "bgcolor" normal-row-color) + 'tag "tr") + (gnc:html-document-set-style! + ssdoc "alternate-row" + 'attribute (list "bgcolor" alternate-row-color) + 'tag "tr") + (gnc:html-document-set-style! + ssdoc "primary-subheading" + 'attribute (list "bgcolor" primary-subheading-color) + 'tag "tr") + (gnc:html-document-set-style! + ssdoc "secondary-subheading" + 'attribute (list "bgcolor" secondary-subheading-color) + 'tag "tr") + (gnc:html-document-set-style! + ssdoc "grand-total" + 'attribute (list "bgcolor" grand-total-color) + 'tag "tr") + + (gnc:html-document-set-style! + ssdoc "text-cell" + 'tag "td" + 'attribute (list "align" "left")) + + (gnc:html-document-set-style! + ssdoc "total-number-cell" + 'tag '("td" "b") + 'attribute (list "align" "right")) + + (gnc:html-document-set-style! + ssdoc "total-label-cell" + 'tag '("td" "b") + 'attribute (list "align" "left")) + + ;; don't surround marked-up links with + (if (not links?) + (gnc:html-document-set-style! + ssdoc "a" 'tag "")) + + (let ((t (gnc:make-html-table))) + ;; we don't want a bevel for this table, but we don't want + ;; that to propagate + (gnc:html-table-set-style! + t "table" + 'attribute (list "border" 0) + 'inheritable? #f) + + (gnc:html-table-set-cell! + t 1 1 + (if show-preparer? + ;; title plus preparer info + (gnc:make-html-text + (gnc:html-markup-b + (gnc:html-document-title doc)) + (gnc:html-markup-br) + (_ "Prepared by: ") + (gnc:html-markup-b preparer) + (gnc:html-markup-br) + (_ "Prepared for: ") + (gnc:html-markup-b prepared-for) + (gnc:html-markup-br) + (_ "Date: ") + (gnc:timepair-to-datestring + (cons (current-time) 0))) + + ;; title only + (gnc:make-html-text + (gnc:html-markup-b + (gnc:html-document-title doc))))) + + (gnc:html-table-set-cell! + t 0 0 + (gnc:make-html-text + (gnc:html-markup-img logopixmap))) + + (gnc:html-table-set-cell! + t 0 1 + (gnc:make-html-text + (gnc:html-markup-img headpixmap))) + + (apply + gnc:html-table-set-cell! + t 2 1 + (gnc:html-document-objects doc)) + + (gnc:html-document-add-object! ssdoc t)) + ssdoc)) + +(gnc:define-html-style-sheet + 'version 1 + 'name (N_ "Fancy") + 'renderer fancy-renderer + 'options-generator fancy-options) + +(gnc:make-html-style-sheet "Fancy" (N_ "Technicolor")) diff --git a/src/report/stylesheets/stylesheet-plain.scm b/src/report/stylesheets/stylesheet-plain.scm new file mode 100644 index 0000000000..05d810e0b9 --- /dev/null +++ b/src/report/stylesheets/stylesheet-plain.scm @@ -0,0 +1,175 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; stylesheet-plain.scm : the default stylesheet, very simple. +;; Copyright 2000 Bill Gribble +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, contact: +;; +;; Free Software Foundation Voice: +1-617-542-5942 +;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 +;; Boston, MA 02111-1307, USA gnu@gnu.org +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(define-module (gnucash report stylesheet-plain)) + +(use-modules (gnucash gnc-module)) +(gnc:module-load "gnucash/report/report-system" 0) + +;; plain style sheet +;; this should generally be the default style sheet for most reports. +;; it's supposed to be lightweight and unobtrusive. +(define (plain-options) + (let* ((options (gnc:new-options)) + (opt-register + (lambda (opt) + (gnc:register-option options opt)))) + (opt-register + (gnc:make-color-option + (N_ "General") + (N_ "Background Color") "a" (N_ "Background color for reports.") + (list #xff #xff #xff 0) + 255 #f)) + (opt-register + (gnc:make-pixmap-option + (N_ "General") + (N_ "Background Pixmap") "b" (N_ "Background tile for reports.") + "")) + (opt-register + (gnc:make-simple-boolean-option + (N_ "General") + (N_ "Enable Links") "c" (N_ "Enable hyperlinks in reports.") + #t)) + (opt-register + (gnc:make-number-range-option + (N_ "Tables") + (N_ "Table cell spacing") "c" (N_ "Space between table cells") + 4 0 20 0 1)) + (opt-register + (gnc:make-number-range-option + (N_ "Tables") + (N_ "Table cell padding") "d" (N_ "Space between table cells") + 0 0 20 0 1)) + (opt-register + (gnc:make-number-range-option + (N_ "Tables") + (N_ "Table border width") "e" (N_ "Bevel depth on tables") + 0 0 20 0 1)) + options)) + +(define (plain-renderer options doc) + (let* ((ssdoc (gnc:make-html-document)) + (opt-val + (lambda (section name) + (gnc:option-value + (gnc:lookup-option options section name)))) + (bgcolor + (gnc:color-option->html + (gnc:lookup-option options + "General" + "Background Color"))) + (bgpixmap (opt-val "General" "Background Pixmap")) + (links? (opt-val "General" "Enable Links")) + (spacing (opt-val "Tables" "Table cell spacing")) + (padding (opt-val "Tables" "Table cell padding")) + (border (opt-val "Tables" "Table border width"))) + + (gnc:html-document-set-style! + ssdoc "body" + 'attribute (list "bgcolor" bgcolor)) + + (if (and bgpixmap + (not (string=? bgpixmap ""))) + (gnc:html-document-set-style! + ssdoc "body" + 'attribute (list "background" bgpixmap))) + + (gnc:html-document-set-style! + ssdoc "table" + 'attribute (list "border" border) + 'attribute (list "cellspacing" spacing) + 'attribute (list "cellpadding" padding)) + + (gnc:html-document-set-style! + ssdoc "number-cell" + 'tag "td" + 'attribute (list "align" "right")) + + (gnc:html-document-set-style! + ssdoc "number-header" + 'tag "th" + 'attribute (list "align" "right")) + + (gnc:html-document-set-style! + ssdoc "text-cell" + 'tag "td" + 'attribute (list "align" "left")) + + (gnc:html-document-set-style! + ssdoc "total-number-cell" + 'tag '("td" "b") + 'attribute (list "align" "right")) + + (gnc:html-document-set-style! + ssdoc "total-label-cell" + 'tag '("td" "b") + 'attribute (list "align" "left")) + + (gnc:html-document-set-style! + ssdoc "normal-row" + 'tag "tr") + + (gnc:html-document-set-style! + ssdoc "alternate-row" + 'attribute (list "bgcolor" bgcolor) + 'tag "tr") + (gnc:html-document-set-style! + ssdoc "primary-subheading" + 'attribute (list "bgcolor" bgcolor) + 'tag "tr") + (gnc:html-document-set-style! + ssdoc "secondary-subheading" + 'attribute (list "bgcolor" bgcolor) + 'tag "tr") + (gnc:html-document-set-style! + ssdoc "grand-total" + 'attribute (list "bgcolor" bgcolor) + 'tag "tr") + + ;; don't surround marked-up links with + (if (not links?) + (gnc:html-document-set-style! + ssdoc "a" + 'tag "")) + + (let ((title (gnc:html-document-title doc))) + (if title + (gnc:html-document-add-object! + ssdoc + (gnc:make-html-text + (gnc:html-markup-p + (gnc:html-markup-h3 title)))))) + + (gnc:html-document-append-objects! ssdoc + (gnc:html-document-objects doc)) + + ssdoc)) + +(gnc:define-html-style-sheet + 'version 1 + 'name (N_ "Plain") + 'renderer plain-renderer + 'options-generator plain-options) + +;; instantiate a default style sheet +(gnc:make-html-style-sheet "Plain" (N_ "Default")) diff --git a/src/report/stylesheets/stylesheets.scm b/src/report/stylesheets/stylesheets.scm new file mode 100644 index 0000000000..454afe4cbb --- /dev/null +++ b/src/report/stylesheets/stylesheets.scm @@ -0,0 +1,11 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; stylesheets.scm +;; load the standard report definitions +;; +;; Copyright (c) 2001 Linux Developers Group, Inc. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-module (gnucash report stylesheets)) + +(use-modules (gnucash report stylesheet-plain)) +(use-modules (gnucash report stylesheet-fancy)) diff --git a/src/report/stylesheets/test/Makefile.am b/src/report/stylesheets/test/Makefile.am new file mode 100644 index 0000000000..12e50adf0b --- /dev/null +++ b/src/report/stylesheets/test/Makefile.am @@ -0,0 +1,6 @@ +TESTS=test-load-module + +TESTS_ENVIRONMENT= \ + GNC_MODULE_PATH=${top_srcdir}/src/engine:${top_srcdir}/src/report/report-system:${top_srcdir}/src/app-utils:.. \ + GUILE_LOAD_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/lib:..:${G_WRAP_MODULE_DIR} \ + LD_LIBRARY_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/src/gnc-module/.libs:${top_srcdir}/src/engine:${top_srcdir}/src/engine/.libs:${top_srcdir}/src/app-utils:${top_srcdir}/src/app-utils/.libs diff --git a/src/report/stylesheets/test/test-load-module b/src/report/stylesheets/test/test-load-module new file mode 100755 index 0000000000..d87907925c --- /dev/null +++ b/src/report/stylesheets/test/test-load-module @@ -0,0 +1,19 @@ +#! /bin/bash +exec guile -s "$0" +!# + +(display " testing stylesheet module load ... ") +(use-modules (gnucash gnc-module)) +(gnc:module-system-init) + +(if (gnc:module-load "gnucash/report/stylesheets" 0) + (begin + (display "ok\n") + (exit 0)) + (begin + (display "failed\n") + (exit -1))) + + + + diff --git a/src/report/utility-reports/Makefile.am b/src/report/utility-reports/Makefile.am new file mode 100644 index 0000000000..5eac951089 --- /dev/null +++ b/src/report/utility-reports/Makefile.am @@ -0,0 +1,28 @@ +SUBDIRS=. test + +pkglib_LTLIBRARIES=libgncmod-utility-reports.la + +libgncmod_utility_reports_la_SOURCES=\ + gncmod-utility-reports.c + +libgncmod_utility_reports_la_LDFLAGS=-module + +INCLUDES=-I${top_srcdir}/src/gnc-module ${GLIB_CFLAGS} + +.scm-links: + rm -f gnucash report + ln -sf . gnucash + ln -sf . report + touch .scm-links + +noinst_DATA = .scm-links + +gncscmmoddir=${GNC_SHAREDIR}/guile-modules/gnucash/report/ +gncscmmod_DATA = \ + hello-world.scm \ + iframe-url.scm \ + utility-reports.scm \ + view-column.scm \ + welcome-to-gnucash.scm + +CLEANFILES += gnucash report .scm-links diff --git a/src/report/utility-reports/gncmod-utility-reports.c b/src/report/utility-reports/gncmod-utility-reports.c new file mode 100644 index 0000000000..5b4785f799 --- /dev/null +++ b/src/report/utility-reports/gncmod-utility-reports.c @@ -0,0 +1,52 @@ +/********************************************************************* + * gncmod-utility-reports.c + * module definition/initialization for the utility reports + * + * Copyright (c) 2001 Linux Developers Group, Inc. + *********************************************************************/ + +#include +#include +#include +#include "gnc-module.h" + +/* version of the gnc module system interface we require */ +int gnc_module_system_interface = 0; + +/* module versioning uses libtool semantics. */ +int gnc_module_current = 0; +int gnc_module_revision = 0; +int gnc_module_age = 0; + +char * +gnc_module_path(void) { + return g_strdup("gnucash/report/utility-reports"); +} + +char * +gnc_module_description(void) { + return g_strdup("Non-financial (utility) reports"); +} + +int +gnc_module_init(int refcount) { + /* load the report system */ + if(!gnc_module_load("gnucash/report/report-system", 0)) { + return FALSE; + } + + /* load the report generation scheme code */ + if(gh_eval_str("(use-modules (gnucash report utility-reports))") == + SCM_BOOL_F) { + return FALSE; + } + + return TRUE; +} + + +void +gnc_module_finish(int refcount) { + +} + diff --git a/src/scm/report/hello-world.scm b/src/report/utility-reports/hello-world.scm similarity index 99% rename from src/scm/report/hello-world.scm rename to src/report/utility-reports/hello-world.scm index 6bc0fc140d..e61aad9cfd 100644 --- a/src/scm/report/hello-world.scm +++ b/src/report/utility-reports/hello-world.scm @@ -4,12 +4,13 @@ ;; It illustrates the basic techniques used to create ;; new reports for GnuCash. -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") - (define-module (gnucash report hello-world)) -(use-modules (gnucash engine)) +(debug-enable 'debug) +(debug-enable 'backtrace) + +(use-modules (gnucash gnc-module)) +(gnc:module-load "gnucash/report/report-system" 0) ;; This function will generate a set of options that GnuCash ;; will use to display a dialog where the user can select @@ -216,7 +217,7 @@ option like this.") (define (op-value section name) (gnc:option-value (get-op section name))) - + ;; The first thing we do is make local variables for all the specific ;; options in the set of options given to the function. This set will ;; be generated by the options generator above. diff --git a/src/scm/report/iframe-url.scm b/src/report/utility-reports/iframe-url.scm similarity index 90% rename from src/scm/report/iframe-url.scm rename to src/report/utility-reports/iframe-url.scm index e138b2dab8..c43cad2c09 100644 --- a/src/scm/report/iframe-url.scm +++ b/src/report/utility-reports/iframe-url.scm @@ -1,8 +1,7 @@ -;; depends must be outside module scope -- and should eventually go away. -(gnc:depend "report-html.scm") - (define-module (gnucash report iframe-url)) +(use-modules (gnucash gnc-module)) +(gnc:module-load "gnucash/report/report-system" 0) (define (options-generator) (let ((options (gnc:new-options))) diff --git a/src/report/utility-reports/test/Makefile.am b/src/report/utility-reports/test/Makefile.am new file mode 100644 index 0000000000..12e50adf0b --- /dev/null +++ b/src/report/utility-reports/test/Makefile.am @@ -0,0 +1,6 @@ +TESTS=test-load-module + +TESTS_ENVIRONMENT= \ + GNC_MODULE_PATH=${top_srcdir}/src/engine:${top_srcdir}/src/report/report-system:${top_srcdir}/src/app-utils:.. \ + GUILE_LOAD_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/lib:..:${G_WRAP_MODULE_DIR} \ + LD_LIBRARY_PATH=${top_srcdir}/src/gnc-module:${top_srcdir}/src/gnc-module/.libs:${top_srcdir}/src/engine:${top_srcdir}/src/engine/.libs:${top_srcdir}/src/app-utils:${top_srcdir}/src/app-utils/.libs diff --git a/src/report/utility-reports/test/test-load-module b/src/report/utility-reports/test/test-load-module new file mode 100755 index 0000000000..bd3907c4b3 --- /dev/null +++ b/src/report/utility-reports/test/test-load-module @@ -0,0 +1,19 @@ +#! /bin/sh +exec guile -s "$0" +!# + +(display " testing utility report module load ... ") +(use-modules (gnucash gnc-module)) +(gnc:module-system-init) + +(if (gnc:module-load "gnucash/report/utility-reports" 0) + (begin + (display "ok\n") + (exit 0)) + (begin + (display "failed\n") + (exit -1))) + + + + diff --git a/src/report/utility-reports/utility-reports.scm b/src/report/utility-reports/utility-reports.scm new file mode 100644 index 0000000000..9d8040516d --- /dev/null +++ b/src/report/utility-reports/utility-reports.scm @@ -0,0 +1,14 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; standard-reports.scm +;; load the standard report definitions +;; +;; Copyright (c) 2001 Linux Developers Group, Inc. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-module (gnucash report utility-reports)) + +(use-modules (gnucash report hello-world)) +(use-modules (gnucash report iframe-url)) +(use-modules (gnucash report view-column)) +(use-modules (gnucash report welcome-to-gnucash)) + diff --git a/src/report/utility-reports/view-column.scm b/src/report/utility-reports/view-column.scm new file mode 100644 index 0000000000..333e65eddc --- /dev/null +++ b/src/report/utility-reports/view-column.scm @@ -0,0 +1,228 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; view-column.scm : simple multi-column table view. +;; Copyright 2001 Bill Gribble +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, contact: +;; +;; Free Software Foundation Voice: +1-617-542-5942 +;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 +;; Boston, MA 02111-1307, USA gnu@gnu.org +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; multi-column view. this is the no brainer. The only parameters +;; are the list of reports to display (with rowspan and colspan for +;; each), in order, and the number of columns in the table. It gets +;; edited in a special window. Every view gets a stylesheet so we +;; don't have to worry about that here. + +(define-module (gnucash report view-column)) + +(use-modules (gnucash gnc-module)) +(gnc:module-load "gnucash/report/report-system" 0) + +(define (make-options) + (let* ((options (gnc:new-options)) + (opt-register + (lambda (opt) + (gnc:register-option options opt)))) + ;; the report-list is edited by a special add-on page for the + ;; options editor. + (opt-register + (gnc:make-internal-option + "__general" "report-list" '())) + + (opt-register + (gnc:make-number-range-option + (N_ "General") (N_ "Number of columns") "a" + (N_ "Number of columns before wrapping to a new row") + 1 0 20 0 1)) + + options)) + +(define (edit-options option-obj report-obj) + (gnc:column-view-edit-options option-obj report-obj)) + +(define (make-child-options-callback view child) + (let* ((view-opts (gnc:report-options view)) + (child-opts (gnc:report-options child)) + (id + (gnc:options-register-callback + #f #f + (lambda () + (gnc:report-set-dirty?! child #t) + (gnc:options-touch view-opts)) + child-opts))) + id)) + +(define (render-view report) + (let* ((view-doc (gnc:make-html-document)) + (options (gnc:report-options report)) + (report-opt (gnc:lookup-option options "__general" "report-list")) + (reports (gnc:option-value report-opt)) + (table-width + (gnc:option-value + (gnc:lookup-option + options (N_ "General") (N_ "Number of columns")))) + (column-allocs (make-hash-table 11)) + (column-tab (gnc:make-html-table)) + (current-row '()) + (current-width 0) + (current-row-num 0)) + + ;; make sure each subreport has an option change callback that + ;; pings the parent + (let ((new-reports '())) + (for-each + (lambda (report-info) + (let ((child (car report-info)) + (rowspan (cadr report-info)) + (colspan (caddr report-info)) + (callback (cadddr report-info))) + (if (not callback) + (begin + (set! callback + (make-child-options-callback + report (gnc:find-report child))) + (set! report-info + (list child rowspan colspan callback)))) + (set! new-reports (cons report-info new-reports)))) + reports) + (gnc:option-set-value report-opt (reverse new-reports))) + + ;; we really would rather do something smart here with the + ;; report's cached text if possible. For the moment, we'll have + ;; to rerun every report, every time... FIXME + (for-each + (lambda (report-info) + ;; run the report renderer, pick out the document style table + ;; and objects from the returned document, then make a new + ;; HTML table cell with those objects as content and append + ;; it to the table. The weird stuff with the column-allocs + ;; hash is an attempt to compute how many columnc are + ;; actually used in a row; items with non-1 rowspans will take + ;; up cells in the row without actually being in the row. + (let* ((subreport (gnc:find-report (car report-info))) + (colspan (cadr report-info)) + (rowspan (caddr report-info)) + (opt-callback (cadddr report-info)) + (toplevel-cell (gnc:make-html-table-cell/size rowspan colspan)) + (report-table (gnc:make-html-table)) + (contents-cell (gnc:make-html-table-cell))) + + ;; set the report's style properly ... this way it will + ;; also get marked as dirty when the stylesheet is edited. + (gnc:report-set-stylesheet! + subreport (gnc:report-stylesheet report)) + + ;; render the report body ... hopefully this will DTRT + ;; and cache when it's ok to cache. + (gnc:html-table-cell-append-objects! + contents-cell (gnc:report-render-html subreport #f)) + + ;; increment the alloc number for each occupied row + (let loop ((row current-row-num)) + (let ((allocation (hash-ref column-allocs row))) + (if (not allocation) + (set! allocation 0)) + (hash-set! column-allocs row (+ colspan allocation)) + (if (< (+ 1 (- row current-row-num)) rowspan) + (loop (+ 1 row))))) + + (gnc:html-table-cell-set-style! + toplevel-cell "td" + 'attribute (list "valign" "top") + 'inheritable? #f) + + ;; put the report in the contents-cell + (gnc:html-table-append-row! report-table (list contents-cell)) + + ;; and a parameter editor link + (gnc:html-table-append-row! + report-table + (list (gnc:make-html-text + (gnc:html-markup-anchor + (sprintf #f "gnc-options:report-id=%a" (car report-info)) + (_ "Edit Options")) + " " + (gnc:html-markup-anchor + (sprintf #f "gnc-report:id=%a" (car report-info)) + (_ "Single Report"))))) + + ;; add the report-table to the toplevel-cell + (gnc:html-table-cell-append-objects! + toplevel-cell report-table) + + (set! current-row (append current-row (list toplevel-cell))) + (set! current-width (+ current-width colspan)) + (if (>= current-width table-width) + (begin + (gnc:html-table-append-row! column-tab current-row) + ;; cells above with non-1 rowspan can force 'pre-allocation' + ;; of space on this row + (set! current-row-num (+ 1 current-row-num)) + (set! current-width (hash-ref column-allocs current-row-num)) + (if (not current-width) (set! current-width 0)) + (set! current-row '()))))) + reports) + + (if (not (null? current-row)) + (gnc:html-table-append-row! column-tab current-row)) + + ;; make sure the table is nice and big + (gnc:html-table-set-style! + column-tab "table" + 'attribute (list "width" "100%")) + + (gnc:html-document-add-object! view-doc column-tab) + ;; and we're done. + view-doc)) + +(define (options-changed-cb report) + (let* ((options (gnc:report-options report)) + (reports + (gnc:option-value + (gnc:lookup-option options "__general" "report-list")))) + (for-each + (lambda (child) + (gnc:report-set-dirty?! (gnc:find-report (car child)) #t)) + reports))) + +(define (cleanup-options report) + (let* ((options (gnc:report-options report)) + (report-opt (gnc:lookup-option options "__general" "report-list")) + (reports (gnc:option-value report-opt)) + (new-reports '())) + (for-each + (lambda (report-info) + (let ((rep (car report-info)) + (rowspan (cadr report-info)) + (colspan (caddr report-info))) + (set! report-info + (list rep rowspan colspan #f)) + (set! new-reports (cons report-info new-reports)))) + reports) + (gnc:option-set-value report-opt (reverse new-reports)))) + +;; define the view now. +(gnc:define-report + 'version 1 + 'name (N_ "Multicolumn View") + 'menu-path (list gnc:menuname-utility) + 'renderer render-view + 'options-generator make-options + 'options-editor edit-options + 'options-cleanup-cb cleanup-options + 'options-changed-cb options-changed-cb) + + diff --git a/src/scm/report/welcome-to-gnucash.scm b/src/report/utility-reports/welcome-to-gnucash.scm similarity index 82% rename from src/scm/report/welcome-to-gnucash.scm rename to src/report/utility-reports/welcome-to-gnucash.scm index 09c34c4642..251613e05b 100644 --- a/src/scm/report/welcome-to-gnucash.scm +++ b/src/report/utility-reports/welcome-to-gnucash.scm @@ -20,8 +20,11 @@ ;; Boston, MA 02111-1307, USA gnu@gnu.org ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(gnc:support "report/welcome-to-gnucash.scm") -(gnc:depend "report-html.scm") +(define-module (gnucash report welcome-to-gnucash)) +(export gnc:make-welcome-report) + +(use-modules (gnucash gnc-module)) +(gnc:module-load "gnucash/report/report-system" 0) (define (gnc:make-welcome-report) (let* ((view (gnc:make-report "Multicolumn View")) @@ -66,22 +69,22 @@ (gnc:main-window-open-report view #f) view)) -(let () - (define (options) - (gnc:new-options)) +(define (options) + (gnc:new-options)) - (define (renderer report-obj) - (let ((doc (gnc:make-html-document))) - (gnc:html-document-add-object! - doc - (gnc:make-html-text - (gnc:html-markup-h2 (_ "Welcome to GnuCash 1.6!")) - (gnc:html-markup-p - (_ "GnuCash 1.6 has lots of nice features. Here are a few.")))) - doc)) +(define (renderer report-obj) + (let ((doc (gnc:make-html-document))) + (gnc:html-document-add-object! + doc + (gnc:make-html-text + (gnc:html-markup-h2 (_ "Welcome to GnuCash 1.6!")) + (gnc:html-markup-p + (_ "GnuCash 1.6 has lots of nice features. Here are a few.")))) + doc)) + +(gnc:define-report + 'name (N_ "Welcome to GnuCash 1.6") + 'in-menu? #f + 'options-generator options + 'renderer renderer) - (gnc:define-report - 'name (N_ "Welcome to GnuCash 1.6") - 'in-menu? #f - 'options-generator options - 'renderer renderer)) diff --git a/src/scm/Makefile.am b/src/scm/Makefile.am index 86de2c0112..bb4c2ebebb 100644 --- a/src/scm/Makefile.am +++ b/src/scm/Makefile.am @@ -1,5 +1,5 @@ -SUBDIRS = gnumeric printing report +SUBDIRS = gnumeric printing gncscmdir = ${GNC_SCM_INSTALL_DIR} gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash @@ -10,37 +10,19 @@ gnc_autogen_scm_files = \ bootstrap.scm gnc_regular_scm_files = \ - c-interface.scm \ command-line.scm \ commodity-import.scm \ - commodity-utilities.scm \ config-var.scm \ - date-utilities.scm \ depend.scm \ doc.scm \ extensions.scm \ graph.scm \ help-topics-index.scm \ - hooks.scm \ - html-barchart.scm \ - html-document.scm \ - html-piechart.scm \ - html-scatter.scm \ - html-style-info.scm \ - html-style-sheet.scm \ - html-text.scm \ - html-table.scm \ - html-utilities.scm \ main.scm \ main-window.scm \ - options.scm \ - options-utilities.scm \ path.scm \ prefs.scm \ price-quotes.scm \ - report.scm \ - report-html.scm \ - report-utilities.scm \ slib-backup.scm \ startup.scm \ structure.scm \ @@ -55,6 +37,15 @@ gnc_regular_scm_files = \ gncscm_DATA = ${gnc_autogen_scm_files} ${gnc_regular_scm_files} +noinst_DATA = .scm-links + +.scm-links: + rm -f gnucash + ln -sf . gnucash + touch .scm-links + +CLEANFILES += .scm-links gnucash + SCM_FILES = ${gncscm_DATA} ${gncscmmod_DATA} EXTRA_DIST = \ diff --git a/src/scm/main.scm b/src/scm/main.scm index 4a5f3f50d0..7c628e228e 100644 --- a/src/scm/main.scm +++ b/src/scm/main.scm @@ -51,27 +51,27 @@ ;; right now we have to statically load all these at startup time. ;; Hopefully we can gradually make them autoloading. (gnc:module-load "gnucash/engine" 0) + (gnc:module-load "gnucash/app-utils" 0) (gnc:module-load "gnucash/register/ledger-core" 0) (gnc:module-load "gnucash/register/register-core" 0) (gnc:module-load "gnucash/register/register-gnome" 0) (gnc:module-load "gnucash/import-export/qif-import" 0) - + (gnc:module-load "gnucash/report/report-system" 0) + (gnc:module-load "gnucash/report/standard-reports" 0) + (gnc:module-load "gnucash/report/utility-reports" 0) + ;; Now we can load a bunch of files. (gnc:depend "config-var.scm") (gnc:depend "utilities.scm") (gnc:depend "path.scm") - (gnc:depend "c-interface.scm") (gnc:depend "options.scm") (gnc:depend "prefs.scm") (gnc:depend "command-line.scm") - (gnc:depend "hooks.scm") (gnc:depend "doc.scm") (gnc:depend "extensions.scm") (gnc:depend "text-export.scm") - (gnc:depend "report.scm") (gnc:depend "main-window.scm") (gnc:depend "commodity-import.scm") - (gnc:depend "report/report-list.scm") (gnc:depend "printing/print-check.scm") (gnc:depend "price-quotes.scm") (gnc:depend "tip-of-the-day.scm") diff --git a/src/scm/report-html.scm b/src/scm/report-html.scm deleted file mode 100644 index b378c7ff76..0000000000 --- a/src/scm/report-html.scm +++ /dev/null @@ -1,68 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; report-html.scm : generate HTML programmatically, with support -;; for simple style elements. -;; Copyright 2000 Bill Gribble -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, contact: -;; -;; Free Software Foundation Voice: +1-617-542-5942 -;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 -;; Boston, MA 02111-1307, USA gnu@gnu.org -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(use-modules (ice-9 slib)) - -(require 'hash-table) -(require 'record) - -(gnc:support "report-html.scm") - -(gnc:depend "html-document.scm") -(gnc:depend "html-text.scm") -(gnc:depend "html-table.scm") -(gnc:depend "html-piechart.scm") -(gnc:depend "html-barchart.scm") -(gnc:depend "html-scatter.scm") -(gnc:depend "html-style-info.scm") -(gnc:depend "html-style-sheet.scm") -(gnc:depend "html-utilities.scm") - -(gnc:depend "report-utilities.scm") - -(define (for-each-in-order thunk list) - (let loop ((ll list)) - (if (pair? ll) - (let ((e (car ll))) - (thunk e) - (if (not (null? (cdr ll))) - (loop (cdr ll))))))) - -(define (list-ref-safe list elt) - (if (> (length list) elt) - (list-ref list elt) - #f)) - -(define (list-set-safe! l elt val) - (if (and (list? l) (> (length l) elt)) - (list-set! l elt val) - (let ((filler (list val))) - (if (not (list? l)) - (set! l '())) - (let loop ((i (length l))) - (if (< i elt) - (begin - (set! filler (cons #f filler)) - (loop (+ 1 i))))) - (set! l (append! l filler)))) - l) diff --git a/src/scm/report/.cvsignore b/src/scm/report/.cvsignore deleted file mode 100644 index a403b17fe4..0000000000 --- a/src/scm/report/.cvsignore +++ /dev/null @@ -1,3 +0,0 @@ -Makefile -Makefile.in -guile-strings.c diff --git a/src/scm/report/Makefile.am b/src/scm/report/Makefile.am deleted file mode 100644 index cb7e8afc07..0000000000 --- a/src/scm/report/Makefile.am +++ /dev/null @@ -1,43 +0,0 @@ - -gncscmdir = ${GNC_SCM_INSTALL_DIR}/report - -gncscm_DATA = \ - report-list.scm \ - stylesheet-fancy.scm \ - stylesheet-plain.scm \ - txf-export-help.scm \ - txf-export.scm \ - view-column.scm \ - welcome-to-gnucash.scm - -gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report - -gncscmmod_DATA = \ - account-piecharts.scm \ - account-summary.scm \ - average-balance.scm \ - balance-sheet.scm \ - category-barchart.scm \ - hello-world.scm \ - iframe-url.scm \ - net-barchart.scm \ - payables.scm \ - portfolio.scm \ - pnl.scm \ - price-scatter.scm \ - register.scm \ - taxtxf.scm \ - transaction.scm - -SCM_FILES = ${gncscm_DATA} ${gncscmmod_DATA} - -EXTRA_DIST = \ - .cvsignore \ - ${SCM_FILES} - -guile-strings.c: ${SCM_FILES} - rm -f guile-strings.c - guile -s ../xgettext.scm ${SCM_FILES} -CLEANFILES += guile-strings.c - -all-local: guile-strings.c diff --git a/src/scm/report/report-list.scm b/src/scm/report/report-list.scm deleted file mode 100644 index f15fcd6897..0000000000 --- a/src/scm/report/report-list.scm +++ /dev/null @@ -1,34 +0,0 @@ - -;; Index file to load all of the releavant reports. -(gnc:support "report/report-list.scm") - -;; Helper functions for reports (which haven't been included -;; elsewhere) -(gnc:depend "options-utilities.scm") - -;; reports -(use-modules (gnucash report account-piecharts)) -(use-modules (gnucash report account-summary)) -(use-modules (gnucash report average-balance)) -(use-modules (gnucash report balance-sheet)) -(use-modules (gnucash report category-barchart)) -(use-modules (gnucash report hello-world)) -(use-modules (gnucash report iframe-url)) -(use-modules (gnucash report net-barchart)) -(use-modules (gnucash report payables)) -(use-modules (gnucash report pnl)) -(use-modules (gnucash report portfolio)) -(use-modules (gnucash report price-scatter)) -(use-modules (gnucash report register)) -(use-modules (gnucash report taxtxf)) -(use-modules (gnucash report transaction)) - -;; style sheets -(gnc:depend "report/stylesheet-plain.scm") -(gnc:depend "report/stylesheet-fancy.scm") - -;; view templates -(gnc:depend "report/view-column.scm") - -;; welcome to gnucash -(gnc:depend "report/welcome-to-gnucash.scm") diff --git a/src/scm/report/stylesheet-fancy.scm b/src/scm/report/stylesheet-fancy.scm deleted file mode 100644 index dd93788224..0000000000 --- a/src/scm/report/stylesheet-fancy.scm +++ /dev/null @@ -1,313 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; stylesheet-header.scm : stylesheet with nicer layout -;; Copyright 2000 Bill Gribble -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, contact: -;; -;; Free Software Foundation Voice: +1-617-542-5942 -;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 -;; Boston, MA 02111-1307, USA gnu@gnu.org -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(gnc:support "report/stylesheet-fancy.scm") -(gnc:depend "report-html.scm") -(gnc:depend "date-utilities.scm") - -;; plain style sheet -;; this should generally be the default style sheet for most reports. -;; it's supposed to be lightweight and unobtrusive. - -(let () - (define (fancy-options) - (let* ((options (gnc:new-options)) - (opt-register - (lambda (opt) - (gnc:register-option options opt)))) - (opt-register - (gnc:make-string-option - (N_ "General") - (N_ "Preparer") "a" - (N_ "Name of person preparing the report") - "")) - (opt-register - (gnc:make-string-option - (N_ "General") - (N_ "Prepared for") "b" - (N_ "Name of organization or company prepared for") - "")) - (opt-register - (gnc:make-simple-boolean-option - (N_ "General") - (N_ "Show preparer info") "c" - (N_ "Name of organization or company") - #f)) - (opt-register - (gnc:make-simple-boolean-option - (N_ "General") - (N_ "Enable Links") "c" - (N_ "Enable hyperlinks in reports") - #t)) - - (opt-register - (gnc:make-pixmap-option - (N_ "Images") - (N_ "Background Tile") "a" (N_ "Background tile for reports.") - "")) - (opt-register - (gnc:make-pixmap-option - (N_ "Images") - (N_ "Heading Banner") "b" (N_ "Banner for top of report.") - "")) - (opt-register - (gnc:make-pixmap-option - (N_ "Images") - (N_ "Logo") "c" (N_ "Company logo image.") - "")) - - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Background Color") "a" (N_ "General background color for report.") - (list #xff #xff #xff 0) - 255 #f)) - - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Text Color") "b" (N_ "Normal body text color.") - (list #x00 #x00 #x00 0) - 255 #f)) - - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Link Color") "c" (N_ "Link text color.") - (list #xb2 #x22 #x22 0) - 255 #f)) - - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Table Cell Color") "c" (N_ "Default background for table cells.") - (list #xff #xff #xff 0) - 255 #f)) - - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Alternate Table Cell Color") "d" - (N_ "Default alternate background for table cells.") - (list #xff #xff #xff 0) - 255 #f)) - - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Subheading/Subtotal Cell Color") "e" - (N_ "Default color for subtotal rows.") - (list #xee #xe8 #xaa 0) - 255 #f)) - - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Sub-subheading/total Cell Color") "f" - (N_ "Color for subsubtotals") - (list #xfa #xfa #xd2 0) - 255 #f)) - - (opt-register - (gnc:make-color-option - (N_ "Colors") - (N_ "Grand Total Cell Color") "g" - (N_ "Color for grand totals") - (list #xff #xff #x00 0) - 255 #f)) - - (opt-register - (gnc:make-number-range-option - (N_ "Tables") - (N_ "Table cell spacing") "a" (N_ "Space between table cells") - 1 0 20 0 1)) - - (opt-register - (gnc:make-number-range-option - (N_ "Tables") - (N_ "Table cell padding") "b" (N_ "Space between table cells") - 1 0 20 0 1)) - - (opt-register - (gnc:make-number-range-option - (N_ "Tables") - (N_ "Table border width") "c" (N_ "Bevel depth on tables") - 1 0 20 0 1)) - options)) - - (define (fancy-renderer options doc) - (let* ((ssdoc (gnc:make-html-document)) - (opt-val - (lambda (section name) - (gnc:option-value - (gnc:lookup-option options section name)))) - (color-val - (lambda (section name) - (gnc:color-option->html - (gnc:lookup-option options section name)))) - (preparer (opt-val (N_ "General") (N_ "Preparer"))) - (prepared-for (opt-val (N_ "General") (N_ "Prepared for"))) - (show-preparer? (opt-val (N_ "General") (N_ "Show preparer info"))) - (links? (opt-val (N_ "General") (N_ "Enable Links"))) - (bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) - (textcolor (color-val (N_ "Colors") (N_ "Text Color"))) - (linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) - (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color"))) - (alternate-row-color (color-val (N_ "Colors") - (N_ "Alternate Table Cell Color"))) - (primary-subheading-color - (color-val (N_ "Colors") - (N_ "Subheading/Subtotal Cell Color"))) - (secondary-subheading-color - (color-val (N_ "Colors") - (N_ "Sub-subheading/total Cell Color"))) - (grand-total-color (color-val (N_ "Colors") - (N_ "Grand Total Cell Color"))) - (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) - (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) - (logopixmap (opt-val (N_ "Images") (N_ "Logo"))) - (spacing (opt-val (N_ "Tables") (N_ "Table cell spacing"))) - (padding (opt-val (N_ "Tables") (N_ "Table cell padding"))) - (border (opt-val (N_ "Tables") (N_ "Table border width")))) - - (gnc:html-document-set-style! - ssdoc "body" - 'attribute (list "bgcolor" bgcolor) - 'attribute (list "text" textcolor) - 'attribute (list "link" linkcolor)) - - (gnc:html-document-set-style! - ssdoc "number-cell" - 'tag "td" - 'attribute (list "align" "right")) - - (if (and bgpixmap - (not (string=? bgpixmap ""))) - (gnc:html-document-set-style! - ssdoc "body" - 'attribute (list "background" bgpixmap))) - - (gnc:html-document-set-style! - ssdoc "table" - 'attribute (list "border" border) - 'attribute (list "cellspacing" spacing) - 'attribute (list "cellpadding" padding)) - - (gnc:html-document-set-style! - ssdoc "normal-row" - 'attribute (list "bgcolor" normal-row-color) - 'tag "tr") - (gnc:html-document-set-style! - ssdoc "alternate-row" - 'attribute (list "bgcolor" alternate-row-color) - 'tag "tr") - (gnc:html-document-set-style! - ssdoc "primary-subheading" - 'attribute (list "bgcolor" primary-subheading-color) - 'tag "tr") - (gnc:html-document-set-style! - ssdoc "secondary-subheading" - 'attribute (list "bgcolor" secondary-subheading-color) - 'tag "tr") - (gnc:html-document-set-style! - ssdoc "grand-total" - 'attribute (list "bgcolor" grand-total-color) - 'tag "tr") - - (gnc:html-document-set-style! - ssdoc "text-cell" - 'tag "td" - 'attribute (list "align" "left")) - - (gnc:html-document-set-style! - ssdoc "total-number-cell" - 'tag '("td" "b") - 'attribute (list "align" "right")) - - (gnc:html-document-set-style! - ssdoc "total-label-cell" - 'tag '("td" "b") - 'attribute (list "align" "left")) - - ;; don't surround marked-up links with - (if (not links?) - (gnc:html-document-set-style! - ssdoc "a" 'tag "")) - - (let ((t (gnc:make-html-table))) - ;; we don't want a bevel for this table, but we don't want - ;; that to propagate - (gnc:html-table-set-style! - t "table" - 'attribute (list "border" 0) - 'inheritable? #f) - - (gnc:html-table-set-cell! - t 1 1 - (if show-preparer? - ;; title plus preparer info - (gnc:make-html-text - (gnc:html-markup-b - (gnc:html-document-title doc)) - (gnc:html-markup-br) - (_ "Prepared by: ") - (gnc:html-markup-b preparer) - (gnc:html-markup-br) - (_ "Prepared for: ") - (gnc:html-markup-b prepared-for) - (gnc:html-markup-br) - (_ "Date: ") - (gnc:timepair-to-datestring - (cons (current-time) 0))) - - ;; title only - (gnc:make-html-text - (gnc:html-markup-b - (gnc:html-document-title doc))))) - - (gnc:html-table-set-cell! - t 0 0 - (gnc:make-html-text - (gnc:html-markup-img logopixmap))) - - (gnc:html-table-set-cell! - t 0 1 - (gnc:make-html-text - (gnc:html-markup-img headpixmap))) - - (apply - gnc:html-table-set-cell! - t 2 1 - (gnc:html-document-objects doc)) - - (gnc:html-document-add-object! ssdoc t)) - ssdoc)) - - (gnc:define-html-style-sheet - 'version 1 - 'name (N_ "Fancy") - 'renderer fancy-renderer - 'options-generator fancy-options) - - #t) - -(gnc:make-html-style-sheet "Fancy" (N_ "Technicolor")) diff --git a/src/scm/report/stylesheet-plain.scm b/src/scm/report/stylesheet-plain.scm deleted file mode 100644 index ef444e17e9..0000000000 --- a/src/scm/report/stylesheet-plain.scm +++ /dev/null @@ -1,174 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; stylesheet-plain.scm : the default stylesheet, very simple. -;; Copyright 2000 Bill Gribble -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, contact: -;; -;; Free Software Foundation Voice: +1-617-542-5942 -;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 -;; Boston, MA 02111-1307, USA gnu@gnu.org -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(gnc:support "report/stylesheet-plain.scm") -(gnc:depend "report-html.scm") - -;; plain style sheet -;; this should generally be the default style sheet for most reports. -;; it's supposed to be lightweight and unobtrusive. - -(let () - (define (plain-options) - (let* ((options (gnc:new-options)) - (opt-register - (lambda (opt) - (gnc:register-option options opt)))) - (opt-register - (gnc:make-color-option - (N_ "General") - (N_ "Background Color") "a" (N_ "Background color for reports.") - (list #xff #xff #xff 0) - 255 #f)) - (opt-register - (gnc:make-pixmap-option - (N_ "General") - (N_ "Background Pixmap") "b" (N_ "Background tile for reports.") - "")) - (opt-register - (gnc:make-simple-boolean-option - (N_ "General") - (N_ "Enable Links") "c" (N_ "Enable hyperlinks in reports.") - #t)) - (opt-register - (gnc:make-number-range-option - (N_ "Tables") - (N_ "Table cell spacing") "c" (N_ "Space between table cells") - 4 0 20 0 1)) - (opt-register - (gnc:make-number-range-option - (N_ "Tables") - (N_ "Table cell padding") "d" (N_ "Space between table cells") - 0 0 20 0 1)) - (opt-register - (gnc:make-number-range-option - (N_ "Tables") - (N_ "Table border width") "e" (N_ "Bevel depth on tables") - 0 0 20 0 1)) - options)) - - (define (plain-renderer options doc) - (let* ((ssdoc (gnc:make-html-document)) - (opt-val - (lambda (section name) - (gnc:option-value - (gnc:lookup-option options section name)))) - (bgcolor - (gnc:color-option->html - (gnc:lookup-option options - "General" - "Background Color"))) - (bgpixmap (opt-val "General" "Background Pixmap")) - (links? (opt-val "General" "Enable Links")) - (spacing (opt-val "Tables" "Table cell spacing")) - (padding (opt-val "Tables" "Table cell padding")) - (border (opt-val "Tables" "Table border width"))) - - (gnc:html-document-set-style! - ssdoc "body" - 'attribute (list "bgcolor" bgcolor)) - - (if (and bgpixmap - (not (string=? bgpixmap ""))) - (gnc:html-document-set-style! - ssdoc "body" - 'attribute (list "background" bgpixmap))) - - (gnc:html-document-set-style! - ssdoc "table" - 'attribute (list "border" border) - 'attribute (list "cellspacing" spacing) - 'attribute (list "cellpadding" padding)) - - (gnc:html-document-set-style! - ssdoc "number-cell" - 'tag "td" - 'attribute (list "align" "right")) - - (gnc:html-document-set-style! - ssdoc "number-header" - 'tag "th" - 'attribute (list "align" "right")) - - (gnc:html-document-set-style! - ssdoc "text-cell" - 'tag "td" - 'attribute (list "align" "left")) - - (gnc:html-document-set-style! - ssdoc "total-number-cell" - 'tag '("td" "b") - 'attribute (list "align" "right")) - - (gnc:html-document-set-style! - ssdoc "total-label-cell" - 'tag '("td" "b") - 'attribute (list "align" "left")) - - (gnc:html-document-set-style! - ssdoc "normal-row" - 'tag "tr") - - (gnc:html-document-set-style! - ssdoc "alternate-row" - 'attribute (list "bgcolor" bgcolor) - 'tag "tr") - (gnc:html-document-set-style! - ssdoc "primary-subheading" - 'attribute (list "bgcolor" bgcolor) - 'tag "tr") - (gnc:html-document-set-style! - ssdoc "secondary-subheading" - 'attribute (list "bgcolor" bgcolor) - 'tag "tr") - (gnc:html-document-set-style! - ssdoc "grand-total" - 'attribute (list "bgcolor" bgcolor) - 'tag "tr") - - ;; don't surround marked-up links with - (if (not links?) - (gnc:html-document-set-style! - ssdoc "a" - 'tag "")) - - (let ((title (gnc:html-document-title doc))) - (if title - (gnc:html-document-add-object! - ssdoc - (gnc:make-html-text - (gnc:html-markup-p - (gnc:html-markup-h3 title)))))) - - (gnc:html-document-append-objects! ssdoc - (gnc:html-document-objects doc)) - - ssdoc)) - - (gnc:define-html-style-sheet - 'version 1 - 'name (N_ "Plain") - 'renderer plain-renderer - 'options-generator plain-options)) - -;; instantiate a default style sheet -(gnc:make-html-style-sheet "Plain" (N_ "Default")) diff --git a/src/scm/report/view-column.scm b/src/scm/report/view-column.scm deleted file mode 100644 index 1355818e00..0000000000 --- a/src/scm/report/view-column.scm +++ /dev/null @@ -1,224 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; view-column.scm : simple multi-column table view. -;; Copyright 2001 Bill Gribble -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, contact: -;; -;; Free Software Foundation Voice: +1-617-542-5942 -;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 -;; Boston, MA 02111-1307, USA gnu@gnu.org -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(gnc:support "report/view-column.scm") - -;; multi-column view. this is the no brainer. The only parameters -;; are the list of reports to display (with rowspan and colspan for -;; each), in order, and the number of columns in the table. It gets -;; edited in a special window. Every view gets a stylesheet so we -;; don't have to worry about that here. - -(let () - (define (make-options) - (let* ((options (gnc:new-options)) - (opt-register - (lambda (opt) - (gnc:register-option options opt)))) - ;; the report-list is edited by a special add-on page for the - ;; options editor. - (opt-register - (gnc:make-internal-option - "__general" "report-list" '())) - - (opt-register - (gnc:make-number-range-option - (N_ "General") (N_ "Number of columns") "a" - (N_ "Number of columns before wrapping to a new row") - 1 0 20 0 1)) - - options)) - - (define (edit-options option-obj report-obj) - (gnc:column-view-edit-options option-obj report-obj)) - - (define (make-child-options-callback view child) - (let* ((view-opts (gnc:report-options view)) - (child-opts (gnc:report-options child)) - (id - (gnc:options-register-callback - #f #f - (lambda () - (gnc:report-set-dirty?! child #t) - (gnc:options-touch view-opts)) - child-opts))) - id)) - - (define (render-view report) - (let* ((view-doc (gnc:make-html-document)) - (options (gnc:report-options report)) - (report-opt (gnc:lookup-option options "__general" "report-list")) - (reports (gnc:option-value report-opt)) - (table-width - (gnc:option-value - (gnc:lookup-option - options (N_ "General") (N_ "Number of columns")))) - (column-allocs (make-hash-table 11)) - (column-tab (gnc:make-html-table)) - (current-row '()) - (current-width 0) - (current-row-num 0)) - - ;; make sure each subreport has an option change callback that - ;; pings the parent - (let ((new-reports '())) - (for-each - (lambda (report-info) - (let ((child (car report-info)) - (rowspan (cadr report-info)) - (colspan (caddr report-info)) - (callback (cadddr report-info))) - (if (not callback) - (begin - (set! callback - (make-child-options-callback - report (gnc:find-report child))) - (set! report-info - (list child rowspan colspan callback)))) - (set! new-reports (cons report-info new-reports)))) - reports) - (gnc:option-set-value report-opt (reverse new-reports))) - - ;; we really would rather do something smart here with the - ;; report's cached text if possible. For the moment, we'll have - ;; to rerun every report, every time... FIXME - (for-each - (lambda (report-info) - ;; run the report renderer, pick out the document style table - ;; and objects from the returned document, then make a new - ;; HTML table cell with those objects as content and append - ;; it to the table. The weird stuff with the column-allocs - ;; hash is an attempt to compute how many columnc are - ;; actually used in a row; items with non-1 rowspans will take - ;; up cells in the row without actually being in the row. - (let* ((subreport (gnc:find-report (car report-info))) - (colspan (cadr report-info)) - (rowspan (caddr report-info)) - (opt-callback (cadddr report-info)) - (toplevel-cell (gnc:make-html-table-cell/size rowspan colspan)) - (report-table (gnc:make-html-table)) - (contents-cell (gnc:make-html-table-cell))) - - ;; set the report's style properly ... this way it will - ;; also get marked as dirty when the stylesheet is edited. - (gnc:report-set-stylesheet! - subreport (gnc:report-stylesheet report)) - - ;; render the report body ... hopefully this will DTRT - ;; and cache when it's ok to cache. - (gnc:html-table-cell-append-objects! - contents-cell (gnc:report-render-html subreport #f)) - - ;; increment the alloc number for each occupied row - (let loop ((row current-row-num)) - (let ((allocation (hash-ref column-allocs row))) - (if (not allocation) - (set! allocation 0)) - (hash-set! column-allocs row (+ colspan allocation)) - (if (< (+ 1 (- row current-row-num)) rowspan) - (loop (+ 1 row))))) - - (gnc:html-table-cell-set-style! - toplevel-cell "td" - 'attribute (list "valign" "top") - 'inheritable? #f) - - ;; put the report in the contents-cell - (gnc:html-table-append-row! report-table (list contents-cell)) - - ;; and a parameter editor link - (gnc:html-table-append-row! - report-table - (list (gnc:make-html-text - (gnc:html-markup-anchor - (sprintf #f "gnc-options:report-id=%a" (car report-info)) - (_ "Edit Options")) - " " - (gnc:html-markup-anchor - (sprintf #f "gnc-report:id=%a" (car report-info)) - (_ "Single Report"))))) - - ;; add the report-table to the toplevel-cell - (gnc:html-table-cell-append-objects! - toplevel-cell report-table) - - (set! current-row (append current-row (list toplevel-cell))) - (set! current-width (+ current-width colspan)) - (if (>= current-width table-width) - (begin - (gnc:html-table-append-row! column-tab current-row) - ;; cells above with non-1 rowspan can force 'pre-allocation' - ;; of space on this row - (set! current-row-num (+ 1 current-row-num)) - (set! current-width (hash-ref column-allocs current-row-num)) - (if (not current-width) (set! current-width 0)) - (set! current-row '()))))) - reports) - - (if (not (null? current-row)) - (gnc:html-table-append-row! column-tab current-row)) - - ;; make sure the table is nice and big - (gnc:html-table-set-style! - column-tab "table" - 'attribute (list "width" "100%")) - - (gnc:html-document-add-object! view-doc column-tab) - ;; and we're done. - view-doc)) - - (define (options-changed-cb report) - (let* ((options (gnc:report-options report)) - (reports - (gnc:option-value - (gnc:lookup-option options "__general" "report-list")))) - (for-each - (lambda (child) - (gnc:report-set-dirty?! (gnc:find-report (car child)) #t)) - reports))) - - (define (cleanup-options report) - (let* ((options (gnc:report-options report)) - (report-opt (gnc:lookup-option options "__general" "report-list")) - (reports (gnc:option-value report-opt)) - (new-reports '())) - (for-each - (lambda (report-info) - (let ((rep (car report-info)) - (rowspan (cadr report-info)) - (colspan (caddr report-info))) - (set! report-info - (list rep rowspan colspan #f)) - (set! new-reports (cons report-info new-reports)))) - reports) - (gnc:option-set-value report-opt (reverse new-reports)))) - - ;; define the view now. - (gnc:define-report - 'version 1 - 'name (N_ "Multicolumn View") - 'menu-path (list gnc:menuname-utility) - 'renderer render-view - 'options-generator make-options - 'options-editor edit-options - 'options-cleanup-cb cleanup-options - 'options-changed-cb options-changed-cb)) diff --git a/src/scm/tip-of-the-day.scm b/src/scm/tip-of-the-day.scm index be28e70887..5c61c317fb 100644 --- a/src/scm/tip-of-the-day.scm +++ b/src/scm/tip-of-the-day.scm @@ -25,7 +25,6 @@ (gnc:depend "config-var.scm") (gnc:depend "prefs.scm") -(gnc:depend "hooks.scm") (define (non-negative-integer? value) (and (integer? value) (>= value 0)))