gnucash master: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sat Jan 23 21:19:07 EST 2021
Updated via https://github.com/Gnucash/gnucash/commit/ddc86579 (commit)
via https://github.com/Gnucash/gnucash/commit/6cd21ae9 (commit)
via https://github.com/Gnucash/gnucash/commit/c5e7406c (commit)
via https://github.com/Gnucash/gnucash/commit/ebcb0bc4 (commit)
from https://github.com/Gnucash/gnucash/commit/4ca179c8 (commit)
commit ddc86579c0a74fd4ac24a9c0ad0b214e1d4b29ae
Merge: 4ca179c89 6cd21ae9f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jan 24 09:25:08 2021 +0800
Merge branch 'master-remove-deprecated' #855
commit 6cd21ae9fce20a921235d53f193845eca3de4446
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jan 3 22:13:59 2021 +0800
[gnc-report.c] remove deprecated functions
diff --git a/gnucash/report/gnc-report.c b/gnucash/report/gnc-report.c
index c8ed10c15..75becf0e8 100644
--- a/gnucash/report/gnc-report.c
+++ b/gnucash/report/gnc-report.c
@@ -234,55 +234,6 @@ gnc_run_report_with_error_handling (gint report_id, gchar ** data, gchar **errms
}
}
-static void
-error_handler(const char *str)
-{
- g_warning("Failure running report: %s", str);
-}
-
-gboolean
-gnc_run_report (gint report_id, char ** data)
-{
- SCM scm_text;
- gchar *str;
-
- PWARN ("gnc_run_report is deprecated. use gnc_run_report_with_error_handling instead.");
-
- g_return_val_if_fail (data != NULL, FALSE);
- *data = NULL;
-
- str = g_strdup_printf("(gnc:report-run %d)", report_id);
- scm_text = gfec_eval_string(str, error_handler);
- g_free(str);
-
- if (scm_text == SCM_UNDEFINED || !scm_is_string (scm_text))
- return FALSE;
-
- *data = gnc_scm_to_utf8_string (scm_text);
-
- return TRUE;
-}
-
-gboolean
-gnc_run_report_id_string (const char * id_string, char **data)
-{
- gint report_id;
-
- PWARN ("gnc_run_report_id_string is deprecated. use gnc_run_report_id_string_with_error_handling instead.");
-
- g_return_val_if_fail (id_string != NULL, FALSE);
- g_return_val_if_fail (data != NULL, FALSE);
- *data = NULL;
-
- if (strncmp ("id=", id_string, 3) != 0)
- return FALSE;
-
- if (sscanf (id_string + 3, "%d", &report_id) != 1)
- return FALSE;
-
- return gnc_run_report (report_id, data);
-}
-
gchar*
gnc_report_name( SCM report )
{
diff --git a/gnucash/report/gnc-report.h b/gnucash/report/gnc-report.h
index 3641528c3..b0e83dca2 100644
--- a/gnucash/report/gnc-report.h
+++ b/gnucash/report/gnc-report.h
@@ -38,11 +38,9 @@
void gnc_report_init (void);
-gboolean gnc_run_report (gint report_id, char ** data);
gboolean gnc_run_report_with_error_handling (gint report_id,
gchar **data,
gchar **errmsg);
-gboolean gnc_run_report_id_string (const char * id_string, char **data);
gboolean gnc_run_report_id_string_with_error_handling (const char * id_string,
char **data,
gchar **errmsg);
commit c5e7406c9fb38025b9f84eb690f10fee1a4453bc
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jan 1 20:33:31 2021 +0800
[account.cpp] remove deprecated function
diff --git a/libgnucash/engine/Account.cpp b/libgnucash/engine/Account.cpp
index 090e7d837..6d2bd3b05 100644
--- a/libgnucash/engine/Account.cpp
+++ b/libgnucash/engine/Account.cpp
@@ -3900,27 +3900,6 @@ xaccAccountGetSplitList (const Account *acc)
return GET_PRIVATE(acc)->splits;
}
-gint64
-xaccAccountCountSplits (const Account *acc, gboolean include_children)
-{
- gint64 nr, i;
-
- PWARN ("xaccAccountCountSplits is deprecated and will be removed \
-in GnuCash 5.0. If testing for an empty account, use \
-xaccAccountGetSplitList(account) == NULL instead. To test descendants \
-as well, use gnc_account_and_descendants_empty.");
- g_return_val_if_fail(GNC_IS_ACCOUNT(acc), 0);
-
- nr = g_list_length(xaccAccountGetSplitList(acc));
- if (include_children && (gnc_account_n_children(acc) != 0))
- {
- for (i=0; i < gnc_account_n_children(acc); i++)
- {
- nr += xaccAccountCountSplits(gnc_account_nth_child(acc, i), TRUE);
- }
- }
- return nr;
-}
gboolean gnc_account_and_descendants_empty (Account *acc)
{
diff --git a/libgnucash/engine/Account.h b/libgnucash/engine/Account.h
index 78eff7244..5511392c8 100644
--- a/libgnucash/engine/Account.h
+++ b/libgnucash/engine/Account.h
@@ -1032,18 +1032,6 @@ gboolean xaccAccountIsEquityType(GNCAccountType t);
*/
SplitList* xaccAccountGetSplitList (const Account *account);
-
-/** The xaccAccountCountSplits() routine returns the number of all
- * the splits in the account. xaccAccountCountSplits is O(N). if
- * testing for emptiness, use xaccAccountGetSplitList != NULL.
-
- * @param acc the account for which to count the splits
- *
- * @param include_children also count splits in descendants (TRUE) or
- * for this account only (FALSE).
- */
-gint64 xaccAccountCountSplits (const Account *acc, gboolean include_children);
-
/** The xaccAccountMoveAllSplits() routine reassigns each of the splits
* in accfrom to accto. */
void xaccAccountMoveAllSplits (Account *accfrom, Account *accto);
commit ebcb0bc478ec32a0b8160afe3bd6ef8ca656ddbc
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jan 1 20:30:27 2021 +0800
[master] remove deprecated scheme functions
diff --git a/bindings/guile/CMakeLists.txt b/bindings/guile/CMakeLists.txt
index b5446b027..f8e32acba 100644
--- a/bindings/guile/CMakeLists.txt
+++ b/bindings/guile/CMakeLists.txt
@@ -127,14 +127,6 @@ gnc_add_scheme_targets(scm-engine-2
add_custom_target(scm-engine ALL DEPENDS scm-engine-2 scm-engine-1 scm-engine-0)
-set(scm_gnc_module_DEPENDS
- gnucash-guile)
-
-gnc_add_scheme_targets(scm-gnc-module
- SOURCES gnc-module.scm
- OUTPUT_DIR gnucash
- DEPENDS "${scm_gnc_module_DEPENDS}")
-
set_local_dist(guile_DIST_local
CMakeLists.txt
core-utils.scm
diff --git a/bindings/guile/business-core.scm b/bindings/guile/business-core.scm
index b88acc313..0dd2a9dfd 100644
--- a/bindings/guile/business-core.scm
+++ b/bindings/guile/business-core.scm
@@ -30,7 +30,6 @@
(export gnc:owner-get-address-dep)
(export gnc:owner-get-name-and-address-dep)
(export gnc:owner-get-owner-id)
-(export gnc:owner-from-split)
(export gnc:split->owner)
(define (gnc:owner-get-address owner)
@@ -105,37 +104,9 @@
(gnc:owner-get-owner-id (gncJobGetOwner (gncOwnerGetJob owner))))
(else ""))))
-;; this function aims to find a split's owner. various splits are
-;; supported: (1) any splits in the invoice posted transaction, in
-;; APAR or income/expense accounts (2) any splits from invoice's
-;; payments, in APAR or asset/liability accounts. it returns either
-;; the owner or '() if not found. in addition, if owner was found, the
-;; result-owner argument is mutated to it.
-(define (gnc:owner-from-split split result-owner)
- (define (notnull x) (and (not (null? x)) x))
- (issue-deprecation-warning
- "gnc:owner-from-split is deprecated in 4.x. use gnc:split->owner instead.")
- (let* ((trans (xaccSplitGetParent split))
- (invoice (notnull (gncInvoiceGetInvoiceFromTxn trans)))
- (temp (gncOwnerNew))
- (owner (or (and invoice (gncInvoiceGetOwner invoice))
- (any
- (lambda (split)
- (let* ((lot (xaccSplitGetLot split))
- (invoice (notnull (gncInvoiceGetInvoiceFromLot lot))))
- (or (and invoice (gncInvoiceGetOwner invoice))
- (and (gncOwnerGetOwnerFromLot lot temp) temp))))
- (xaccTransGetSplitList trans)))))
- (gncOwnerFree temp)
- (cond (owner (gncOwnerCopy (gncOwnerGetEndOwner owner) result-owner)
- result-owner)
- (else '()))))
-
-
-;; optimized from above, and simpler: does not search all transaction
-;; splits. It will allocate and memoize (cache) the owners because
-;; gncOwnerGetOwnerFromLot is slow. after use, it must be called with
-;; #f to free the owners.
+;; this function aims to find a split's owner. It will allocate and
+;; memoize (cache) the owners because gncOwnerGetOwnerFromLot is
+;; slow. after use, it must be called with #f to free the owners.
(define gnc:split->owner
(let ((ht (make-hash-table)))
(lambda (split)
diff --git a/bindings/guile/engine.scm b/bindings/guile/engine.scm
index 18656abed..651296869 100644
--- a/bindings/guile/engine.scm
+++ b/bindings/guile/engine.scm
@@ -31,33 +31,3 @@
(gnucash engine commodity-table)
(gnucash engine gnc-numeric))
-(export gnc:account-map-descendants)
-(export gnc:account-map-children)
-(export account-full-name<?)
-(export accounts-get-children-depth)
-
-;; A few account related utility functions which used to be in engine-utilities.scm
-(define (gnc:account-map-descendants thunk account)
- (issue-deprecation-warning "gnc:account-map-descendants is deprecated.")
- (map thunk (or (gnc-account-get-descendants-sorted account) '())))
-
-(define (gnc:account-map-children thunk account)
- (issue-deprecation-warning "gnc:account-map-children is deprecated.")
- (map thunk (or (gnc-account-get-children-sorted account) '())))
-
-;; account related functions
-;; helper for sorting of account list
-(define (account-full-name<? a b)
- (issue-deprecation-warning
- "account-full-name<? is deprecated. use gnc:account-full-name<? instead.")
- (string<? (gnc-account-get-full-name a) (gnc-account-get-full-name b)))
-
-;; return maximum depth over accounts and their children, if any
-(define (accounts-get-children-depth accounts)
- (issue-deprecation-warning "accounts-get-children-depth is deprecated. use \
-gnc:accounts-get-children-depth instead.")
- (1- (apply max
- (map (lambda (acct)
- (+ (gnc-account-get-current-depth acct)
- (gnc-account-get-tree-depth acct)))
- accounts))))
diff --git a/bindings/guile/gnc-module.scm b/bindings/guile/gnc-module.scm
deleted file mode 100644
index 883a094dd..000000000
--- a/bindings/guile/gnc-module.scm
+++ /dev/null
@@ -1,88 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; gnc-module.scm
-;;; Guile module which allows initialization of the gnucash module
-;;; system from Scheme
-;;;
-;;; Copyright 2001 Linux Developers Group
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(define-module (gnucash gnc-module))
-
-(use-modules (ice-9 match))
-
-(define (deprecate . lst)
- ;; 4.x deprecation. remove in 5.x
- (issue-deprecation-warning (string-concatenate lst)))
-
-(define (no-op-deprecation-warning)
- (deprecate "* WARNING * Guile wrappers for the gnc module system have been \
-deprecated. This particular function call is now a no-op. Please use \
-equivalent (use-modules ...) calls instead."))
-
-(define-public gnc:module-system-init no-op-deprecation-warning)
-(define-public gnc:module-system-refresh no-op-deprecation-warning)
-(define-public gnc:module-load-optional no-op-deprecation-warning)
-(define-public gnc:module-unload no-op-deprecation-warning)
-
-(define-public (gnc:module-load gnc-mod-name mod-sys-version)
- (let* ((mod-name-split (string-split gnc-mod-name #\/))
- (mod-name-str (string-join mod-name-split " "))
- (scm-mod-name (map string->symbol mod-name-split)))
-
- (match gnc-mod-name
- ("gnucash/app-utils"
- (deprecate "* WARNING * 'gnc:module-load (\"gnucash/app-utils\" 0)' has \
-been deprecated and will be removed in gnucash 5.0. Use '(use-modules (gnucash \
-engine) (gnucash app-utils))' instead. Use of the '(gnucash engine)' guile \
-module is optional and depends on whether or not you use functions from \
-this module in your code or not.")
- (use-modules (gnucash engine) (gnucash app-utils)))
-
- ((or "gnucash/tax/de_DE" "gnucash/tax/us")
- (set! scm-mod-name `(gnucash locale ,(list-ref scm-mod-name 2) tax))
- (set! mod-name-str (string-join (map symbol->string scm-mod-name) " "))
- (deprecate "* WARNING * '(gnc:module-load \"" gnc-mod-name "\" 0)' has \
-been deprecated. Use '(use-modules (" mod-name-str "))' instead.")
- (module-use! (current-module) (resolve-interface scm-mod-name)))
-
- ((or "gnucash/gnome-utils" "gnucash/report/report-system")
- (when (string=? gnc-mod-name "gnucash/report/report-system")
- (set! mod-name-str "gnucash report"))
- (set! scm-mod-name '(gnucash report))
- (deprecate "* WARNING * '(gnc:module-load \"" gnc-mod-name "\" 0)' has \
-been deprecated. Use '(use-modules (gnucash engine) (gnucash app-utils) \
-(" mod-name-str "))' instead. Use of the '(gnucash engine)' or \
-'(gnucash app-utils)' guile modules is optional and depends on whether \
-or not you use functions from this module in your code or not.")
- (use-modules (gnucash engine) (gnucash app-utils))
- (module-use! (current-module) (resolve-interface scm-mod-name)))
-
- ("gnucash/html"
- (deprecate "* WARNING * '(gnc:module-load \"gnucash/html\" 0)' has \
-been deprecated. Use '(use-modules (gnucash html))' instead.")
- (use-modules (gnucash html))
- (module-use! (current-module) (resolve-interface scm-mod-name)))
-
- (_ (deprecate "* WARNING * '(gnc:module-load \"" gnc-mod-name "\" 0)' \
-has been deprecated. Use '(use-modules (" mod-name-str "))' instead. \
-Additional guile modules may have to be loaded depending on your specific code.")
- (module-use! (current-module) (resolve-interface scm-mod-name))))))
diff --git a/bindings/guile/test/CMakeLists.txt b/bindings/guile/test/CMakeLists.txt
index 9382136c9..0791d791b 100644
--- a/bindings/guile/test/CMakeLists.txt
+++ b/bindings/guile/test/CMakeLists.txt
@@ -32,7 +32,6 @@ set(bindings_test_SCHEME
#list(APPEND engine_test_SCHEME test-scm-query-import.scm) Fails
set(GUILE_DEPENDS
- scm-gnc-module
scm-app-utils
scm-core-utils
scm-engine)
@@ -89,7 +88,6 @@ set(test_scm_SCHEME
)
set(GUILE_DEPENDS
- scm-gnc-module
scm-app-utils
scm-engine
scm-srfi64-extras
diff --git a/bindings/guile/test/test-business-core.scm b/bindings/guile/test/test-business-core.scm
index 9cd0731d1..725459f31 100644
--- a/bindings/guile/test/test-business-core.scm
+++ b/bindings/guile/test/test-business-core.scm
@@ -242,57 +242,4 @@
(env-transfer env 01 01 1990
(get-acct "Income-GBP") (get-acct "Bank-GBP") 10)
- (let ((new-owner (gncOwnerNew)))
-
- (test-equal "new-owner is initially empty"
- ""
- (gncOwnerGetName new-owner))
-
- (test-equal "gnc:owner-from-split (from AR) return"
- "cust-1-name"
- (gncOwnerGetName
- (gnc:owner-from-split
- (last (xaccAccountGetSplitList (get-acct "AR-USD")))
- new-owner)))
-
- (test-equal "gnc:owner-from-split (from AR) mutated"
- "cust-1-name"
- (gncOwnerGetName new-owner))
-
- (set! new-owner (gncOwnerNew))
- (test-equal "gnc:owner-from-split (from inc-acct) return"
- "cust-1-name"
- (gncOwnerGetName
- (gnc:owner-from-split
- (last (xaccAccountGetSplitList (get-acct "Income-USD")))
- new-owner)))
-
- (test-equal "gnc:owner-from-split (from inc-acct) mutated"
- "cust-1-name"
- (gncOwnerGetName new-owner))
-
- (set! new-owner (gncOwnerNew))
- (test-equal "gnc:owner-from-split (from payment txn) return"
- "cust-1-name"
- (gncOwnerGetName
- (gnc:owner-from-split
- (last (xaccAccountGetSplitList (get-acct "Bank-USD")))
- new-owner)))
-
- (test-equal "gnc:owner-from-split (from payment txn) mutated"
- "cust-1-name"
- (gncOwnerGetName new-owner))
-
- (set! new-owner 'reset)
- (test-equal "gnc:owner-from-split (non-business split) return"
- ""
- (gncOwnerGetName
- (gnc:owner-from-split
- (last (xaccAccountGetSplitList (get-acct "Bank-GBP")))
- new-owner)))
-
- (test-equal "gnc:owner-from-split (non-business split) mutated"
- 'reset
- new-owner))
-
))
diff --git a/bindings/guile/test/test-scm-utilities.scm b/bindings/guile/test/test-scm-utilities.scm
index 660767f2c..8da44aaf4 100644
--- a/bindings/guile/test/test-scm-utilities.scm
+++ b/bindings/guile/test/test-scm-utilities.scm
@@ -34,35 +34,6 @@
"fooxyzfooxyz"
(gnc:substring-replace "foobarfoobar" "bar" "xyz"))
- ;; note the following 2 tests illustrate code behaviour: start from
- ;; 2nd matched substring, and perform either 2 or 1 substitution.
- (test-equal "gnc:substring-replace-from-to ... ... 2 2"
- "foobarfooxyzfooxyz"
- (gnc:substring-replace-from-to "foobarfoobarfoobar" "bar" "xyz" 2 2))
-
- (test-equal "gnc:substring-replace-from-to ... ... 2 1"
- "foobarfooxyzfoobar"
- (gnc:substring-replace-from-to "foobarfoobarfoobar" "bar" "xyz" 2 1))
-
- ;; comprehensive test suite for gnc:substring-replace-from-to:
- (test-equal "gnc:substring-replace-from-to ... ... 2 1"
- "foo xxx foo foo foo foo foo foo"
- (gnc:substring-replace-from-to
- "foo foo foo foo foo foo foo foo"
- "foo" "xxx" 2 1))
-
- (test-equal "gnc:substring-replace-from-to ... ... 1 1"
- "xxx foo foo foo foo foo foo foo"
- (gnc:substring-replace-from-to
- "foo foo foo foo foo foo foo foo"
- "foo" "xxx" 1 1))
-
- (test-equal "gnc:substring-replace-from-to ... ... 4 -1"
- "foo foo foo xxx xxx xxx xxx xxx"
- (gnc:substring-replace-from-to
- "foo foo foo foo foo foo foo foo"
- "foo" "xxx" 4 -1))
-
(test-end "substring-replace"))
(define (test-sort-and-delete-duplicates)
diff --git a/bindings/guile/utilities.scm b/bindings/guile/utilities.scm
index ad0852a4a..4aaaab256 100644
--- a/bindings/guile/utilities.scm
+++ b/bindings/guile/utilities.scm
@@ -124,26 +124,6 @@
(define (gnc:substring-replace s1 s2 s3)
(string-replace-substring s1 s2 s3))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; gnc:substring-replace-from-to
-;; same as gnc:substring-replace extended by:
-;; start: from which occurrence onwards the replacement shall start
-;; end-after: max. number times the replacement should executed
-;;
-;; Example: (gnc:substring-replace-from-to "foobarfoobarfoobar" "bar" "xyz" 2 1)
-;; returns "foobarfooxyzfoobar".
-;;
-;; start=1 and end-after<=0 will call gnc:substring-replace (replace all)
-;; start>1 and end-after<=0 will the replace from "start" until end of file
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (gnc:substring-replace-from-to s1 s2 s3 start end-after)
- (issue-deprecation-warning "gnc:substring-replace-from-to is deprecated in 4.x.")
- (string-replace-substring
- s1 s2 s3 0 (string-length s1) (max 0 (1- start))
- (and (positive? end-after) (+ (max 0 (1- start)) (1- end-after)))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; function to sanitize strings. the resulting string can be safely
;; added to html.
diff --git a/gnucash/report/CMakeLists.txt b/gnucash/report/CMakeLists.txt
index a2da0f785..d41b6fe30 100644
--- a/gnucash/report/CMakeLists.txt
+++ b/gnucash/report/CMakeLists.txt
@@ -53,12 +53,8 @@ set (report_SCHEME_1
commodity-utilities.scm
html-acct-table.scm
html-chart.scm
- html-barchart.scm
html-document.scm
html-fonts.scm
- html-piechart.scm
- html-scatter.scm
- html-linechart.scm
html-style-info.scm
html-style-sheet.scm
html-anytag.scm
diff --git a/gnucash/report/eguile-utilities.scm b/gnucash/report/eguile-utilities.scm
index 01c908405..1b0a31bb7 100644
--- a/gnucash/report/eguile-utilities.scm
+++ b/gnucash/report/eguile-utilities.scm
@@ -41,40 +41,6 @@
(define-public fmtnumeric
(compose fmtnumber exact->inexact))
-(define-public (gnc-monetary-neg? monetary)
- ;; return true if the monetary value is negative
- (issue-deprecation-warning "gnc-monetary-neg? is deprecated")
- (negative? (gnc:gnc-monetary-amount monetary)))
-
-;; 'Safe' versions of cdr and cadr that don't crash
-;; if the list is empty (is there a better way?)
-(define-public safe-cdr
- ;; deprecate
- (match-lambda
- ((_ . x) x)
- (_ '())))
-
-(define-public safe-cadr
- ;; deprecate
- (match-lambda
- ((_ x . y) x)
- (_ '())))
-
-; deprecated - use find-stylesheet or find-template instead
-(define-public (find-file fname)
- ;; Find the file 'fname', and return its full path.
- ;; First look in the user's .config/gnucash directory.
- ;; Then look in Gnucash's standard report directory.
- ;; If no file is found, returns just 'fname' for use in error messages.
- (let* ((stylesheetpath (find-stylesheet fname))
- (templatepath (find-template fname)))
- ; make sure there's a trailing delimiter
- (issue-deprecation-warning "find-file is deprecated in 4.x. Please use find-stylesheet or find-template instead.")
- (cond
- ((access? stylesheetpath R_OK) stylesheetpath)
- ((access? templatepath R_OK) templatepath)
- (else fname))))
-
(define (find-internal ftype fname)
;; Find the file fname', and return its full path.
;; First look in the user's .config/gnucash directory.
@@ -101,26 +67,3 @@
;; If no file is found, returns just 'fname' for use in error messages.
(find-internal "templates" fname))
-;; Define syntax for more readable for loops (the built-in for-each
-;; requires an explicit lambda and has the list expression all the way
-;; at the end). Note: deprecated in 4.x, removal in 5.x. this syntax
-;; is pythonic rather than lispy, is not recognized by code
-;; highlighters, and is not necessary to seasoned schemers.
-(export for)
-(define-syntax for
- (syntax-rules (for in do)
- ;; Multiple variables and equal number of lists (in
- ;; parenthesis). e.g.:
- ;; (for (a b) in (lsta lstb) do (display (+ a b)))
- ;; Note that this template must be defined before the
- ;; next one, since the template are evaluated in-order.
- ((for (<var> ...) in (<list> ...) do <expr> ...)
- (begin
- (issue-deprecation-warning "for loops are deprecated. use for-each instead.")
- (for-each (lambda (<var> ...) <expr> ...) <list> ...)))
-
- ;; Single variable and list. e.g.: (for a in lst do (display a))
- ((for <var> in <list> do <expr> ...)
- (begin
- (issue-deprecation-warning "for loops are deprecated. use for-each instead.")
- (for-each (lambda (<var>) <expr> ...) <list>)))))
diff --git a/gnucash/report/html-barchart.scm b/gnucash/report/html-barchart.scm
deleted file mode 100644
index ea3b72ec7..000000000
--- a/gnucash/report/html-barchart.scm
+++ /dev/null
@@ -1,397 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; html-barchart.scm : generate HTML programmatically, with support
-;; for simple style elements.
-;; Copyright 2000 Bill Gribble <grib at gnumatic.com>
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash report html-barchart))
-
-(use-modules (gnucash utilities))
-(use-modules (gnucash report html-chart)
- (gnucash report report-utilities))
-
-(export <html-barchart>)
-(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:html-barchart-prepend-column!)
-(export gnc:html-barchart-render barchart)
-
-(define <html-barchart>
- (make-record-type '<html-barchart>
- '(width
- height
- title
- subtitle
- x-axis-label
- y-axis-label
- col-labels
- row-labels
- col-colors
- legend-reversed?
- row-labels-rotated?
- stacked?
- data
- button-1-bar-urls
- button-2-bar-urls
- button-3-bar-urls
- button-1-legend-urls
- button-2-legend-urls
- button-3-legend-urls)))
-
-(define-syntax-rule (gnc:guard-html-chart api)
- ;; this macro applied to old html-bar/line/scatter/pie apis will
- ;; guard a report writer from passing html-chart objects. this
- ;; should be removed in 5.x series.
- (let ((old-api api))
- (set! api
- (lambda args
- (if (and (pair? args) (gnc:html-chart? (car args)))
- (gnc:warn "using old-api " (procedure-name api) " on html-chart object. set options via gnc:html-chart-set! or its shortcuts gnc:html-chart-set-title! etc, and set data via gnc:html-chart-add-data-series! see sample-graphs.scm for examples.")
- (apply old-api args))))))
-
-(define gnc:html-barchart?
- (record-predicate <html-barchart>))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; <html-barchart> class
-;; generate the <object> form for a barchart.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define gnc:make-html-barchart-internal
- (record-constructor <html-barchart>))
-
-(define (gnc:make-html-barchart)
- (issue-deprecation-warning
- "(gnc:make-html-barchart) is deprecated in 4.x. use gnc:make-html-chart instead.")
- (gnc:make-html-barchart-internal '(pixels . -1) '(pixels . -1) #f #f #f #f '() '() '()
- #f #f #f '() #f #f #f #f #f #f))
-
-(define gnc:html-barchart-data
- (record-accessor <html-barchart> 'data))
-
-(define gnc:html-barchart-set-data!
- (record-modifier <html-barchart> 'data))
-
-(define gnc:html-barchart-width
- (record-accessor <html-barchart> 'width))
-
-(define gnc:html-barchart-set-width!
- (record-modifier <html-barchart> 'width))
-
-(define gnc:html-barchart-height
- (record-accessor <html-barchart> 'height))
-
-(define gnc:html-barchart-set-height!
- (record-modifier <html-barchart> 'height))
-
-(define gnc:html-barchart-x-axis-label
- (record-accessor <html-barchart> 'x-axis-label))
-
-(define gnc:html-barchart-set-x-axis-label!
- (record-modifier <html-barchart> 'x-axis-label))
-
-(define gnc:html-barchart-y-axis-label
- (record-accessor <html-barchart> 'y-axis-label))
-
-(define gnc:html-barchart-set-y-axis-label!
- (record-modifier <html-barchart> 'y-axis-label))
-
-(define gnc:html-barchart-row-labels
- (record-accessor <html-barchart> 'row-labels))
-
-(define gnc:html-barchart-set-row-labels!
- (record-modifier <html-barchart> 'row-labels))
-
-(define gnc:html-barchart-row-labels-rotated?
- (record-accessor <html-barchart> 'row-labels-rotated?))
-
-(define gnc:html-barchart-set-row-labels-rotated?!
- (record-modifier <html-barchart> 'row-labels-rotated?))
-
-(define gnc:html-barchart-stacked?
- (record-accessor <html-barchart> 'stacked?))
-
-(define gnc:html-barchart-set-stacked?!
- (record-modifier <html-barchart> 'stacked?))
-
-(define gnc:html-barchart-col-labels
- (record-accessor <html-barchart> 'col-labels))
-
-(define gnc:html-barchart-set-col-labels!
- (record-modifier <html-barchart> 'col-labels))
-
-(define gnc:html-barchart-col-colors
- (record-accessor <html-barchart> 'col-colors))
-
-(define gnc:html-barchart-set-col-colors!
- (record-modifier <html-barchart> 'col-colors))
-
-(define gnc:html-barchart-legend-reversed?
- (record-accessor <html-barchart> 'legend-reversed?))
-
-(define gnc:html-barchart-set-legend-reversed?!
- (record-modifier <html-barchart> 'legend-reversed?))
-
-(define gnc:html-barchart-title
- (record-accessor <html-barchart> 'title))
-
-(define gnc:html-barchart-set-title!
- (record-modifier <html-barchart> 'title))
-
-(define gnc:html-barchart-subtitle
- (record-accessor <html-barchart> 'subtitle))
-
-(define gnc:html-barchart-set-subtitle!
- (record-modifier <html-barchart> 'subtitle))
-
-;; Note: ATM you can specify one url per column, but this url will be
-;; used for all of the rows. Otherwise we could have cols*rows urls
-;; (quite a lot), but this first requires fixing
-;; guppi_bar_1_callback() in gnome/gnc-html-guppi.c .
-;; FIXME url's haven't been working since GnuCash 1.x
-;; GnuCash 2.x switched from guppy to goffice, which
-;; made it very hard to remain the url functionality
-;; At this point I (gjanssens) is in the process of
-;; moving from goffice to jqplot for our charts
-;; which perhaps may allow urls again in the charts
-;; I'm keeping the parameters below around to remind
-;; us this still has to be investigated again
-(define gnc:html-barchart-button-1-bar-urls
- (record-accessor <html-barchart> 'button-1-bar-urls))
-
-(define gnc:html-barchart-set-button-1-bar-urls!
- (record-modifier <html-barchart> 'button-1-bar-urls))
-
-(define gnc:html-barchart-button-2-bar-urls
- (record-accessor <html-barchart> 'button-2-bar-urls))
-
-(define gnc:html-barchart-set-button-2-bar-urls!
- (record-modifier <html-barchart> 'button-2-bar-urls))
-
-(define gnc:html-barchart-button-3-bar-urls
- (record-accessor <html-barchart> 'button-3-bar-urls))
-
-(define gnc:html-barchart-set-button-3-bar-urls!
- (record-modifier <html-barchart> 'button-3-bar-urls))
-
-(define gnc:html-barchart-button-1-legend-urls
- (record-accessor <html-barchart> 'button-1-legend-urls))
-
-(define gnc:html-barchart-set-button-1-legend-urls!
- (record-modifier <html-barchart> 'button-1-legend-urls))
-
-(define gnc:html-barchart-button-2-legend-urls
- (record-accessor <html-barchart> 'button-2-legend-urls))
-
-(define gnc:html-barchart-set-button-2-legend-urls!
- (record-modifier <html-barchart> 'button-2-legend-urls))
-
-(define gnc:html-barchart-button-3-legend-urls
- (record-accessor <html-barchart> 'button-3-legend-urls))
-
-(define gnc:html-barchart-set-button-3-legend-urls!
- (record-modifier <html-barchart> 'button-3-legend-urls))
-
-(define (gnc:html-barchart-append-row! barchart newrow)
- (let ((dd (gnc:html-barchart-data barchart)))
- (set! dd (append dd (list newrow)))
- (gnc:html-barchart-set-data! barchart dd)))
-
-(define (gnc:html-barchart-prepend-row! barchart newrow)
- (let ((dd (gnc:html-barchart-data barchart)))
- (set! dd (cons newrow dd))
- (gnc:html-barchart-set-data! barchart dd)))
-
-(define (gnc:html-barchart-append-column! barchart newcol)
- (let ((colnum 0)
- (rownum 0)
- (rows (gnc:html-barchart-data barchart))
- (this-row #f)
- (new-row #f))
- ;; find out how many cols are already there in the deepest row
- (for-each
- (lambda (row)
- (let ((l (length row)))
- (if (> l colnum)
- (set! colnum l))))
- rows)
-
- ;; append the elements of 'newrow' to the rowumns
- (for-each
- (lambda (newelt)
- ;; find the row, or append one
- (if (not (null? rows))
- (begin
- (set! new-row #f)
- (set! this-row (car rows))
- (if (null? (cdr rows))
- (set! rows #f)
- (set! rows (cdr rows))))
- (begin
- (set! new-row #t)
- (set! this-row '())))
-
- ;; make sure the rowumn is long enough, then append the data
- (let loop ((l (length this-row))
- (r (reverse this-row)))
- (if (< l colnum)
- (loop (+ l 1) (cons #f r))
- (set! this-row
- (reverse (cons newelt r)))))
- (if new-row
- (gnc:html-barchart-append-row! barchart this-row)
- (list-set! (gnc:html-barchart-data barchart) rownum this-row))
- (set! rownum (+ 1 rownum)))
- newcol)))
-
-(define (gnc:html-barchart-prepend-column! barchart newcol)
- (let ((rows (gnc:html-barchart-data barchart))
- (this-row #f)
- (new-row #f)
- (rownum 0))
- (for-each
- (lambda (elt)
- (if (not (null? rows))
- (begin
- (set! new-row #f)
- (set! this-row (car rows))
- (if (null? (cdr rows))
- (set! rows #f)
- (set! rows (cdr rows))))
- (begin
- (set! new-row #t)
- (set! this-row '())))
- (if new-row
- (gnc:html-barchart-append-row! barchart (list elt))
- (list-set! (gnc:html-barchart-data barchart) rownum
- (cons elt this-row)))
- (set! rownum (+ 1 rownum)))
- newcol)))
-
-(define (gnc:html-barchart-render barchart doc)
- (let* ((chart (gnc:make-html-chart))
- (data (gnc:html-barchart-data barchart)))
- (cond
- ((and (pair? data) (gnc:not-all-zeros data))
- (gnc:html-chart-set-type! chart 'bar)
- (gnc:html-chart-set-width! chart (gnc:html-barchart-width barchart))
- (gnc:html-chart-set-height! chart (gnc:html-barchart-height barchart))
- (gnc:html-chart-set-data-labels! chart (gnc:html-barchart-row-labels barchart))
- (for-each
- (lambda (label series color)
- (gnc:html-chart-add-data-series! chart label series color))
- (gnc:html-barchart-col-labels barchart)
- data
- (gnc:html-barchart-col-colors barchart))
- (gnc:html-chart-set-title! chart (list
- (gnc:html-barchart-title barchart)
- (gnc:html-barchart-subtitle barchart)))
- (gnc:html-chart-set-stacking?! chart (gnc:html-barchart-stacked? barchart))
- (gnc:html-chart-render chart doc))
-
- (else
- (gnc:warn "null-data, not rendering barchart")
- ""))))
-
-(gnc:guard-html-chart gnc:html-barchart-data)
-(gnc:guard-html-chart gnc:html-barchart-set-data!)
-(gnc:guard-html-chart gnc:html-barchart-width)
-(gnc:guard-html-chart gnc:html-barchart-set-width!)
-(gnc:guard-html-chart gnc:html-barchart-height)
-(gnc:guard-html-chart gnc:html-barchart-set-height!)
-(gnc:guard-html-chart gnc:html-barchart-x-axis-label)
-(gnc:guard-html-chart gnc:html-barchart-set-x-axis-label!)
-(gnc:guard-html-chart gnc:html-barchart-y-axis-label)
-(gnc:guard-html-chart gnc:html-barchart-set-y-axis-label!)
-(gnc:guard-html-chart gnc:html-barchart-row-labels)
-(gnc:guard-html-chart gnc:html-barchart-set-row-labels!)
-(gnc:guard-html-chart gnc:html-barchart-row-labels-rotated?)
-(gnc:guard-html-chart gnc:html-barchart-set-row-labels-rotated?!)
-(gnc:guard-html-chart gnc:html-barchart-stacked?)
-(gnc:guard-html-chart gnc:html-barchart-set-stacked?!)
-(gnc:guard-html-chart gnc:html-barchart-col-labels)
-(gnc:guard-html-chart gnc:html-barchart-set-col-labels!)
-(gnc:guard-html-chart gnc:html-barchart-col-colors)
-(gnc:guard-html-chart gnc:html-barchart-set-col-colors!)
-(gnc:guard-html-chart gnc:html-barchart-legend-reversed?)
-(gnc:guard-html-chart gnc:html-barchart-set-legend-reversed?!)
-(gnc:guard-html-chart gnc:html-barchart-title)
-(gnc:guard-html-chart gnc:html-barchart-set-title!)
-(gnc:guard-html-chart gnc:html-barchart-subtitle)
-(gnc:guard-html-chart gnc:html-barchart-set-subtitle!)
-(gnc:guard-html-chart gnc:html-barchart-button-1-bar-urls)
-(gnc:guard-html-chart gnc:html-barchart-set-button-1-bar-urls!)
-(gnc:guard-html-chart gnc:html-barchart-button-2-bar-urls)
-(gnc:guard-html-chart gnc:html-barchart-set-button-2-bar-urls!)
-(gnc:guard-html-chart gnc:html-barchart-button-3-bar-urls)
-(gnc:guard-html-chart gnc:html-barchart-set-button-3-bar-urls!)
-(gnc:guard-html-chart gnc:html-barchart-button-1-legend-urls)
-(gnc:guard-html-chart gnc:html-barchart-set-button-1-legend-urls!)
-(gnc:guard-html-chart gnc:html-barchart-button-2-legend-urls)
-(gnc:guard-html-chart gnc:html-barchart-set-button-2-legend-urls!)
-(gnc:guard-html-chart gnc:html-barchart-button-3-legend-urls)
-(gnc:guard-html-chart gnc:html-barchart-set-button-3-legend-urls!)
-(gnc:guard-html-chart gnc:html-barchart-append-row!)
-(gnc:guard-html-chart gnc:html-barchart-prepend-row!)
-(gnc:guard-html-chart gnc:html-barchart-append-column!)
-(gnc:guard-html-chart gnc:html-barchart-prepend-column!)
-(gnc:guard-html-chart gnc:html-barchart-render)
diff --git a/gnucash/report/html-document.scm b/gnucash/report/html-document.scm
index fa34e0c5f..48a62dbdf 100644
--- a/gnucash/report/html-document.scm
+++ b/gnucash/report/html-document.scm
@@ -25,11 +25,7 @@
(use-modules (gnucash html))
(use-modules (gnucash report html-anytag))
-(use-modules (gnucash report html-barchart))
(use-modules (gnucash report html-chart))
-(use-modules (gnucash report html-linechart))
-(use-modules (gnucash report html-piechart))
-(use-modules (gnucash report html-scatter))
(use-modules (gnucash report html-style-info))
(use-modules (gnucash report html-style-sheet))
(use-modules (gnucash report html-table))
@@ -368,18 +364,6 @@
((gnc:html-table-cell? obj)
(gnc:make-html-object-internal gnc:html-table-cell-render obj))
- ((gnc:html-barchart? obj)
- (gnc:make-html-object-internal gnc:html-barchart-render obj))
-
- ((gnc:html-piechart? obj)
- (gnc:make-html-object-internal gnc:html-piechart-render obj))
-
- ((gnc:html-scatter? obj)
- (gnc:make-html-object-internal gnc:html-scatter-render obj))
-
- ((gnc:html-linechart? obj)
- (gnc:make-html-object-internal gnc:html-linechart-render obj))
-
((gnc:html-object? obj)
obj)
diff --git a/gnucash/report/html-linechart.scm b/gnucash/report/html-linechart.scm
deleted file mode 100644
index b4652e4b7..000000000
--- a/gnucash/report/html-linechart.scm
+++ /dev/null
@@ -1,475 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; html-linechart.scm : generate HTML programmatically, with support
-;; for simple style elements.
-;; Copyright 2008 Sven Henkel <shenkel at gmail.com>
-;;
-;; Adapted from html-barchart.scm which is
-;; Copyright 2000 Bill Gribble <grib at gnumatic.com>
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash report html-linechart))
-
-(use-modules (srfi srfi-1))
-(use-modules (gnucash utilities))
-(use-modules (gnucash report html-chart)
- (gnucash report report-utilities))
-
-(export <html-linechart>)
-(export gnc:html-linechart? )
-(export gnc:make-html-linechart-internal)
-(export gnc:make-html-linechart)
-(export gnc:html-linechart-data)
-(export gnc:html-linechart-set-data!)
-(export gnc:html-linechart-width)
-(export gnc:html-linechart-set-width!)
-(export gnc:html-linechart-height)
-(export gnc:html-linechart-set-height!)
-(export gnc:html-linechart-x-axis-label)
-(export gnc:html-linechart-set-x-axis-label!)
-(export gnc:html-linechart-y-axis-label)
-(export gnc:html-linechart-set-y-axis-label!)
-(export gnc:html-linechart-row-labels)
-(export gnc:html-linechart-set-row-labels!)
-(export gnc:html-linechart-row-labels-rotated?)
-(export gnc:html-linechart-set-row-labels-rotated?!)
-(export gnc:html-linechart-stacked?)
-(export gnc:html-linechart-set-stacked?!)
-(export gnc:html-linechart-markers?)
-(export gnc:html-linechart-set-markers?!)
-(export gnc:html-linechart-major-grid?)
-(export gnc:html-linechart-set-major-grid?!)
-(export gnc:html-linechart-minor-grid?)
-(export gnc:html-linechart-set-minor-grid?!)
-(export gnc:html-linechart-col-labels)
-(export gnc:html-linechart-set-col-labels!)
-(export gnc:html-linechart-col-colors)
-(export gnc:html-linechart-set-col-colors!)
-(export gnc:html-linechart-legend-reversed?)
-(export gnc:html-linechart-set-legend-reversed?!)
-(export gnc:html-linechart-title)
-(export gnc:html-linechart-set-title!)
-(export gnc:html-linechart-subtitle)
-(export gnc:html-linechart-set-subtitle!)
-(export gnc:html-linechart-button-1-line-urls)
-(export gnc:html-linechart-set-button-1-line-urls!)
-(export gnc:html-linechart-button-2-line-urls)
-(export gnc:html-linechart-set-button-2-line-urls!)
-(export gnc:html-linechart-button-3-line-urls)
-(export gnc:html-linechart-set-button-3-line-urls!)
-(export gnc:html-linechart-button-1-legend-urls)
-(export gnc:html-linechart-set-button-1-legend-urls!)
-(export gnc:html-linechart-button-2-legend-urls)
-(export gnc:html-linechart-set-button-2-legend-urls!)
-(export gnc:html-linechart-button-3-legend-urls)
-(export gnc:html-linechart-set-button-3-legend-urls!)
-(export gnc:html-linechart-append-row!)
-(export gnc:html-linechart-prepend-row!)
-(export gnc:html-linechart-append-column!)
-(export gnc:html-linechart-prepend-column!)
-(export gnc:html-linechart-render linechart)
-(export gnc:html-linechart-set-line-width!)
-(export gnc:html-linechart-line-width)
-
-(define <html-linechart>
- (make-record-type '<html-linechart>
- '(width
- height
- title
- subtitle
- x-axis-label
- y-axis-label
- col-labels
- row-labels
- col-colors
- legend-reversed?
- row-labels-rotated?
- stacked?
- markers?
- major-grid?
- minor-grid?
- data
- button-1-line-urls
- button-2-line-urls
- button-3-line-urls
- button-1-legend-urls
- button-2-legend-urls
- button-3-legend-urls
- line-width)))
-
-(define-syntax-rule (gnc:guard-html-chart api)
- ;; this macro applied to old html-bar/line/scatter/pie apis will
- ;; guard a report writer from passing html-chart objects. this
- ;; should be removed in 5.x series.
- (let ((old-api api))
- (set! api
- (lambda args
- (if (and (pair? args) (gnc:html-chart? (car args)))
- (gnc:warn "using old-api " (procedure-name api) " on html-chart object. set options via gnc:html-chart-set! or its shortcuts gnc:html-chart-set-title! etc, and set data via gnc:html-chart-add-data-series! see sample-graphs.scm for examples.")
- (apply old-api args))))))
-
-(define gnc:html-linechart?
- (record-predicate <html-linechart>))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; <html-linechart> class
-;; generate the <object> form for a linechart.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define gnc:make-html-linechart-internal
- (record-constructor <html-linechart>))
-
-(define (gnc:make-html-linechart)
- (issue-deprecation-warning
- "(gnc:make-html-linechart) is deprecated in 4.x. use gnc:make-html-chart instead.")
- (gnc:make-html-linechart-internal
- '(pixels . -1) ;;width
- '(pixels . -1) ;;height
- #f ;;title
- #f ;;subtitle
- #f ;;x-axis-label
- #f ;;y-axis-label
- '() ;;col-labels
- '() ;;row-labels
- '() ;;col-colors
- #f ;;legend-reversed?
- #f ;;row-labels-rotated?
- #f ;;stacked?
- #t ;;markers?
- #t ;;major-grid?
- #t ;;minor-grid?
- '() ;;data
- #f ;;button-1-line-urls
- #f ;;button-2-line-urls
- #f ;;button-3-line-urls
- #f ;;button-1-legend-urls
- #f ;;button-2-legend-urls
- #f ;;button-3-legend-urls
- 1.5 ;;line-width
- )
-)
-
-(define gnc:html-linechart-data
- (record-accessor <html-linechart> 'data))
-
-(define gnc:html-linechart-set-data!
- (record-modifier <html-linechart> 'data))
-
-(define gnc:html-linechart-width
- (record-accessor <html-linechart> 'width))
-
-(define gnc:html-linechart-set-width!
- (record-modifier <html-linechart> 'width))
-
-(define gnc:html-linechart-height
- (record-accessor <html-linechart> 'height))
-
-(define gnc:html-linechart-set-height!
- (record-modifier <html-linechart> 'height))
-
-(define gnc:html-linechart-x-axis-label
- (record-accessor <html-linechart> 'x-axis-label))
-
-(define gnc:html-linechart-set-x-axis-label!
- (record-modifier <html-linechart> 'x-axis-label))
-
-(define gnc:html-linechart-y-axis-label
- (record-accessor <html-linechart> 'y-axis-label))
-
-(define gnc:html-linechart-set-y-axis-label!
- (record-modifier <html-linechart> 'y-axis-label))
-
-(define gnc:html-linechart-row-labels
- (record-accessor <html-linechart> 'row-labels))
-
-(define gnc:html-linechart-set-row-labels!
- (record-modifier <html-linechart> 'row-labels))
-
-(define gnc:html-linechart-row-labels-rotated?
- (record-accessor <html-linechart> 'row-labels-rotated?))
-
-(define gnc:html-linechart-set-row-labels-rotated?!
- (record-modifier <html-linechart> 'row-labels-rotated?))
-
-(define gnc:html-linechart-stacked?
- (record-accessor <html-linechart> 'stacked?))
-
-(define gnc:html-linechart-set-stacked?!
- (record-modifier <html-linechart> 'stacked?))
-
-(define gnc:html-linechart-markers?
- (record-accessor <html-linechart> 'markers?))
-
-(define gnc:html-linechart-set-markers?!
- (record-modifier <html-linechart> 'markers?))
-
-(define gnc:html-linechart-major-grid?
- (record-accessor <html-linechart> 'major-grid?))
-
-(define gnc:html-linechart-set-major-grid?!
- (record-modifier <html-linechart> 'major-grid?))
-
-(define gnc:html-linechart-minor-grid?
- (record-accessor <html-linechart> 'minor-grid?))
-
-(define gnc:html-linechart-set-minor-grid?!
- (record-modifier <html-linechart> 'minor-grid?))
-
-(define gnc:html-linechart-col-labels
- (record-accessor <html-linechart> 'col-labels))
-
-(define gnc:html-linechart-set-col-labels!
- (record-modifier <html-linechart> 'col-labels))
-
-(define gnc:html-linechart-col-colors
- (record-accessor <html-linechart> 'col-colors))
-
-(define gnc:html-linechart-set-col-colors!
- (record-modifier <html-linechart> 'col-colors))
-
-(define gnc:html-linechart-legend-reversed?
- (record-accessor <html-linechart> 'legend-reversed?))
-
-(define gnc:html-linechart-set-legend-reversed?!
- (record-modifier <html-linechart> 'legend-reversed?))
-
-(define gnc:html-linechart-title
- (record-accessor <html-linechart> 'title))
-
-(define gnc:html-linechart-set-title!
- (record-modifier <html-linechart> 'title))
-
-(define gnc:html-linechart-subtitle
- (record-accessor <html-linechart> 'subtitle))
-
-(define gnc:html-linechart-set-subtitle!
- (record-modifier <html-linechart> 'subtitle))
-
-;; Note: ATM you can specify one url per column, but this url will be
-;; used for all of the rows. Otherwise we could have cols*rows urls
-;; (quite a lot), but this first requires fixing
-;; guppi_line_1_callback() in gnome/gnc-html-guppi.c .
-;; FIXME url's haven't been working since GnuCash 1.x
-;; GnuCash 2.x switched from guppy to goffice, which
-;; made it very hard to remain the url functionality
-;; At this point I (gjanssens) is in the process of
-;; moving from goffice to jqplot for our charts
-;; which perhaps may allow urls again in the charts
-;; I'm keeping the parameters below around to remind
-;; us this still has to be investigated again
-(define gnc:html-linechart-button-1-line-urls
- (record-accessor <html-linechart> 'button-1-line-urls))
-
-(define gnc:html-linechart-set-button-1-line-urls!
- (record-modifier <html-linechart> 'button-1-line-urls))
-
-(define gnc:html-linechart-button-2-line-urls
- (record-accessor <html-linechart> 'button-2-line-urls))
-
-(define gnc:html-linechart-set-button-2-line-urls!
- (record-modifier <html-linechart> 'button-2-line-urls))
-
-(define gnc:html-linechart-button-3-line-urls
- (record-accessor <html-linechart> 'button-3-line-urls))
-
-(define gnc:html-linechart-set-button-3-line-urls!
- (record-modifier <html-linechart> 'button-3-line-urls))
-
-(define gnc:html-linechart-button-1-legend-urls
- (record-accessor <html-linechart> 'button-1-legend-urls))
-
-(define gnc:html-linechart-set-button-1-legend-urls!
- (record-modifier <html-linechart> 'button-1-legend-urls))
-
-(define gnc:html-linechart-button-2-legend-urls
- (record-accessor <html-linechart> 'button-2-legend-urls))
-
-(define gnc:html-linechart-set-button-2-legend-urls!
- (record-modifier <html-linechart> 'button-2-legend-urls))
-
-(define gnc:html-linechart-button-3-legend-urls
- (record-accessor <html-linechart> 'button-3-legend-urls))
-
-(define gnc:html-linechart-set-button-3-legend-urls!
- (record-modifier <html-linechart> 'button-3-legend-urls))
-
-(define gnc:html-linechart-line-width
- (record-accessor <html-linechart> 'line-width))
-
-(define gnc:html-linechart-set-line-width!
- (record-modifier <html-linechart> 'line-width))
-
-(define (gnc:html-linechart-append-row! linechart newrow)
- (let ((dd (gnc:html-linechart-data linechart)))
- (set! dd (append dd (list newrow)))
- (gnc:html-linechart-set-data! linechart dd)))
-
-(define (gnc:html-linechart-prepend-row! linechart newrow)
- (let ((dd (gnc:html-linechart-data linechart)))
- (set! dd (cons newrow dd))
- (gnc:html-linechart-set-data! linechart dd)))
-
-(define (gnc:html-linechart-append-column! linechart newcol)
- (let ((colnum 0)
- (rownum 0)
- (rows (gnc:html-linechart-data linechart))
- (this-row #f)
- (new-row #f))
- ;; find out how many cols are already there in the deepest row
- (for-each
- (lambda (row)
- (let ((l (length row)))
- (if (> l colnum)
- (set! colnum l))))
- rows)
-
- ;; append the elements of 'newrow' to the rowumns
- (for-each
- (lambda (newelt)
- ;; find the row, or append one
- (if (not (null? rows))
- (begin
- (set! new-row #f)
- (set! this-row (car rows))
- (if (null? (cdr rows))
- (set! rows #f)
- (set! rows (cdr rows))))
- (begin
- (set! new-row #t)
- (set! this-row '())))
-
- ;; make sure the rowumn is long enough, then append the data
- (let loop ((l (length this-row))
- (r (reverse this-row)))
- (if (< l colnum)
- (loop (+ l 1) (cons #f r))
- (set! this-row
- (reverse (cons newelt r)))))
- (if new-row
- (gnc:html-linechart-append-row! linechart this-row)
- (list-set! (gnc:html-linechart-data linechart) rownum this-row))
- (set! rownum (+ 1 rownum)))
- newcol)))
-
-(define (gnc:html-linechart-prepend-column! linechart newcol)
- (let ((rows (gnc:html-linechart-data linechart))
- (this-row #f)
- (new-row #f)
- (rownum 0))
- (for-each
- (lambda (elt)
- (if (not (null? rows))
- (begin
- (set! new-row #f)
- (set! this-row (car rows))
- (if (null? (cdr rows))
- (set! rows #f)
- (set! rows (cdr rows))))
- (begin
- (set! new-row #t)
- (set! this-row '())))
- (if new-row
- (gnc:html-linechart-append-row! linechart (list elt))
- (list-set! (gnc:html-linechart-data linechart) rownum
- (cons elt this-row)))
- (set! rownum (+ 1 rownum)))
- newcol)))
-
-(define (gnc:html-linechart-render linechart doc)
- (let* ((chart (gnc:make-html-chart))
- (data (gnc:html-linechart-data linechart))
- (line-width (gnc:html-linechart-line-width linechart))
- (radius (if (gnc:html-linechart-markers? linechart) 3 0)))
- (cond
- ((and (pair? data) (gnc:not-all-zeros data))
- (gnc:html-chart-set-type! chart 'line)
- (gnc:html-chart-set-width! chart (gnc:html-linechart-width linechart))
- (gnc:html-chart-set-height! chart (gnc:html-linechart-height linechart))
- (gnc:html-chart-set-data-labels! chart (gnc:html-linechart-row-labels linechart))
- (for-each
- (lambda (label series color)
- (gnc:html-chart-add-data-series! chart label series color
- 'borderWidth line-width
- 'pointRadius radius
- 'fill #f))
- (gnc:html-linechart-col-labels linechart)
- (apply zip data)
- (gnc:html-linechart-col-colors linechart))
- (gnc:html-chart-set-title! chart (list
- (gnc:html-linechart-title linechart)
- (gnc:html-linechart-subtitle linechart)))
- (gnc:html-chart-set-stacking?! chart (gnc:html-linechart-stacked? linechart))
- (gnc:html-chart-render chart doc))
-
- (else
- (gnc:warn "null-data, not rendering linechart")
- ""))))
-
-
-(gnc:guard-html-chart gnc:html-linechart-data)
-(gnc:guard-html-chart gnc:html-linechart-set-data!)
-(gnc:guard-html-chart gnc:html-linechart-width)
-(gnc:guard-html-chart gnc:html-linechart-set-width!)
-(gnc:guard-html-chart gnc:html-linechart-height)
-(gnc:guard-html-chart gnc:html-linechart-set-height!)
-(gnc:guard-html-chart gnc:html-linechart-x-axis-label)
-(gnc:guard-html-chart gnc:html-linechart-set-x-axis-label!)
-(gnc:guard-html-chart gnc:html-linechart-y-axis-label)
-(gnc:guard-html-chart gnc:html-linechart-set-y-axis-label!)
-(gnc:guard-html-chart gnc:html-linechart-row-labels)
-(gnc:guard-html-chart gnc:html-linechart-set-row-labels!)
-(gnc:guard-html-chart gnc:html-linechart-row-labels-rotated?)
-(gnc:guard-html-chart gnc:html-linechart-set-row-labels-rotated?!)
-(gnc:guard-html-chart gnc:html-linechart-stacked?)
-(gnc:guard-html-chart gnc:html-linechart-set-stacked?!)
-(gnc:guard-html-chart gnc:html-linechart-markers?)
-(gnc:guard-html-chart gnc:html-linechart-set-markers?!)
-(gnc:guard-html-chart gnc:html-linechart-major-grid?)
-(gnc:guard-html-chart gnc:html-linechart-set-major-grid?!)
-(gnc:guard-html-chart gnc:html-linechart-minor-grid?)
-(gnc:guard-html-chart gnc:html-linechart-set-minor-grid?!)
-(gnc:guard-html-chart gnc:html-linechart-col-labels)
-(gnc:guard-html-chart gnc:html-linechart-set-col-labels!)
-(gnc:guard-html-chart gnc:html-linechart-col-colors)
-(gnc:guard-html-chart gnc:html-linechart-set-col-colors!)
-(gnc:guard-html-chart gnc:html-linechart-legend-reversed?)
-(gnc:guard-html-chart gnc:html-linechart-set-legend-reversed?!)
-(gnc:guard-html-chart gnc:html-linechart-title)
-(gnc:guard-html-chart gnc:html-linechart-set-title!)
-(gnc:guard-html-chart gnc:html-linechart-subtitle)
-(gnc:guard-html-chart gnc:html-linechart-set-subtitle!)
-(gnc:guard-html-chart gnc:html-linechart-button-1-line-urls)
-(gnc:guard-html-chart gnc:html-linechart-set-button-1-line-urls!)
-(gnc:guard-html-chart gnc:html-linechart-button-2-line-urls)
-(gnc:guard-html-chart gnc:html-linechart-set-button-2-line-urls!)
-(gnc:guard-html-chart gnc:html-linechart-button-3-line-urls)
-(gnc:guard-html-chart gnc:html-linechart-set-button-3-line-urls!)
-(gnc:guard-html-chart gnc:html-linechart-button-1-legend-urls)
-(gnc:guard-html-chart gnc:html-linechart-set-button-1-legend-urls!)
-(gnc:guard-html-chart gnc:html-linechart-button-2-legend-urls)
-(gnc:guard-html-chart gnc:html-linechart-set-button-2-legend-urls!)
-(gnc:guard-html-chart gnc:html-linechart-button-3-legend-urls)
-(gnc:guard-html-chart gnc:html-linechart-set-button-3-legend-urls!)
-(gnc:guard-html-chart gnc:html-linechart-append-row!)
-(gnc:guard-html-chart gnc:html-linechart-prepend-row!)
-(gnc:guard-html-chart gnc:html-linechart-append-column!)
-(gnc:guard-html-chart gnc:html-linechart-prepend-column!)
-(gnc:guard-html-chart gnc:html-linechart-render)
-(gnc:guard-html-chart gnc:html-linechart-set-line-width!)
-(gnc:guard-html-chart gnc:html-linechart-line-width)
diff --git a/gnucash/report/html-piechart.scm b/gnucash/report/html-piechart.scm
deleted file mode 100644
index 103dce3f5..000000000
--- a/gnucash/report/html-piechart.scm
+++ /dev/null
@@ -1,239 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; html-piechart.scm : generate HTML programmatically, with support
-;; for simple style elements.
-;; Copyright 2000 Bill Gribble <grib at gnumatic.com>
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash report html-piechart))
-
-(use-modules (gnucash utilities))
-(use-modules (gnucash report html-chart)
- (gnucash report report-utilities))
-
-(export <html-piechart>)
-(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)
-
-(define <html-piechart>
- (make-record-type '<html-piechart>
- '(width
- height
- title
- subtitle
- data
- colors
- labels
- button-1-slice-urls
- button-2-slice-urls
- button-3-slice-urls
- button-1-legend-urls
- button-2-legend-urls
- button-3-legend-urls)))
-
-
-(define gnc:html-piechart?
- (record-predicate <html-piechart>))
-
-(define-syntax-rule (gnc:guard-html-chart api)
- ;; this macro applied to old html-bar/line/scatter/pie apis will
- ;; guard a report writer from passing html-chart objects. this
- ;; should be removed in 5.x series.
- (let ((old-api api))
- (set! api
- (lambda args
- (if (and (pair? args) (gnc:html-chart? (car args)))
- (gnc:warn "using old-api " (procedure-name api) " on html-chart object. set options via gnc:html-chart-set! or its shortcuts gnc:html-chart-set-title! etc, and set data via gnc:html-chart-add-data-series! see sample-graphs.scm for examples.")
- (apply old-api args))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; <html-piechart> class
-;; generate the <object> form for a piechart.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define gnc:make-html-piechart-internal
- (record-constructor <html-piechart>))
-
-(define (gnc:make-html-piechart)
- (issue-deprecation-warning
- "(gnc:make-html-piechart) is deprecated in 4.x. use gnc:make-html-chart instead.")
- (gnc:make-html-piechart-internal '(pixels . -1) '(pixels . -1) #f #f #f #f #f #f #f #f #f #f #f))
-
-(define gnc:html-piechart-data
- (record-accessor <html-piechart> 'data))
-
-(define gnc:html-piechart-set-data!
- (record-modifier <html-piechart> 'data))
-
-(define gnc:html-piechart-width
- (record-accessor <html-piechart> 'width))
-
-(define gnc:html-piechart-set-width!
- (record-modifier <html-piechart> 'width))
-
-(define gnc:html-piechart-height
- (record-accessor <html-piechart> 'height))
-
-(define gnc:html-piechart-set-height!
- (record-modifier <html-piechart> 'height))
-
-(define gnc:html-piechart-labels
- (record-accessor <html-piechart> 'labels))
-
-(define gnc:html-piechart-set-labels!
- (record-modifier <html-piechart> 'labels))
-
-(define gnc:html-piechart-colors
- (record-accessor <html-piechart> 'colors))
-
-(define gnc:html-piechart-set-colors!
- (record-modifier <html-piechart> 'colors))
-
-(define gnc:html-piechart-title
- (record-accessor <html-piechart> 'title))
-
-(define gnc:html-piechart-set-title!
- (record-modifier <html-piechart> 'title))
-
-(define gnc:html-piechart-subtitle
- (record-accessor <html-piechart> 'subtitle))
-
-(define gnc:html-piechart-set-subtitle!
- (record-modifier <html-piechart> 'subtitle))
-
-;; FIXME url's haven't been working since GnuCash 1.x
-;; GnuCash 2.x switched from guppy to goffice, which
-;; made it very hard to remain the url functionality
-;; At this point I (gjanssens) is in the process of
-;; moving from goffice to jqplot for our charts
-;; which perhaps may allow urls again in the charts
-;; I'm keeping the parameters below around to remind
-;; us this still has to be investigated again
-(define gnc:html-piechart-button-1-slice-urls
- (record-accessor <html-piechart> 'button-1-slice-urls))
-
-(define gnc:html-piechart-set-button-1-slice-urls!
- (record-modifier <html-piechart> 'button-1-slice-urls))
-
-(define gnc:html-piechart-button-2-slice-urls
- (record-accessor <html-piechart> 'button-2-slice-urls))
-
-(define gnc:html-piechart-set-button-2-slice-urls!
- (record-modifier <html-piechart> 'button-2-slice-urls))
-
-(define gnc:html-piechart-button-3-slice-urls
- (record-accessor <html-piechart> 'button-3-slice-urls))
-
-(define gnc:html-piechart-set-button-3-slice-urls!
- (record-modifier <html-piechart> 'button-3-slice-urls))
-
-(define gnc:html-piechart-button-1-legend-urls
- (record-accessor <html-piechart> 'button-1-legend-urls))
-
-(define gnc:html-piechart-set-button-1-legend-urls!
- (record-modifier <html-piechart> 'button-1-legend-urls))
-
-(define gnc:html-piechart-button-2-legend-urls
- (record-accessor <html-piechart> 'button-2-legend-urls))
-
-(define gnc:html-piechart-set-button-2-legend-urls!
- (record-modifier <html-piechart> 'button-2-legend-urls))
-
-(define gnc:html-piechart-button-3-legend-urls
- (record-accessor <html-piechart> 'button-3-legend-urls))
-
-(define gnc:html-piechart-set-button-3-legend-urls!
- (record-modifier <html-piechart> 'button-3-legend-urls))
-
-(define (gnc:html-piechart-render piechart doc)
- (let* ((chart (gnc:make-html-chart))
- (title (gnc:html-piechart-title piechart))
- (subtitle (gnc:html-piechart-subtitle piechart))
- (data (gnc:html-piechart-data piechart))
- (colors (gnc:html-piechart-colors piechart)))
- (cond
- ((and (pair? data) (gnc:not-all-zeros data))
- (gnc:html-chart-set-type! chart 'pie)
- (gnc:html-chart-set-axes-display! chart #f)
- (gnc:html-chart-set-width! chart (gnc:html-piechart-width piechart))
- (gnc:html-chart-set-height! chart (gnc:html-piechart-height piechart))
- (gnc:html-chart-set-data-labels! chart (gnc:html-piechart-labels piechart))
- (gnc:html-chart-add-data-series! chart "" data colors)
- (gnc:html-chart-set-title! chart (list title subtitle))
- (gnc:html-chart-render chart doc))
-
- (else
- (gnc:warn "null-data, not rendering piechart")
- ""))))
-
-(gnc:guard-html-chart gnc:html-piechart-data)
-(gnc:guard-html-chart gnc:html-piechart-set-data!)
-(gnc:guard-html-chart gnc:html-piechart-width)
-(gnc:guard-html-chart gnc:html-piechart-set-width!)
-(gnc:guard-html-chart gnc:html-piechart-height)
-(gnc:guard-html-chart gnc:html-piechart-set-height!)
-(gnc:guard-html-chart gnc:html-piechart-labels)
-(gnc:guard-html-chart gnc:html-piechart-set-labels!)
-(gnc:guard-html-chart gnc:html-piechart-colors)
-(gnc:guard-html-chart gnc:html-piechart-set-colors!)
-(gnc:guard-html-chart gnc:html-piechart-title)
-(gnc:guard-html-chart gnc:html-piechart-set-title!)
-(gnc:guard-html-chart gnc:html-piechart-subtitle)
-(gnc:guard-html-chart gnc:html-piechart-set-subtitle!)
-(gnc:guard-html-chart gnc:html-piechart-button-1-slice-urls)
-(gnc:guard-html-chart gnc:html-piechart-set-button-1-slice-urls!)
-(gnc:guard-html-chart gnc:html-piechart-button-2-slice-urls)
-(gnc:guard-html-chart gnc:html-piechart-set-button-2-slice-urls!)
-(gnc:guard-html-chart gnc:html-piechart-button-3-slice-urls)
-(gnc:guard-html-chart gnc:html-piechart-set-button-3-slice-urls!)
-(gnc:guard-html-chart gnc:html-piechart-button-1-legend-urls)
-(gnc:guard-html-chart gnc:html-piechart-set-button-1-legend-urls!)
-(gnc:guard-html-chart gnc:html-piechart-button-2-legend-urls)
-(gnc:guard-html-chart gnc:html-piechart-set-button-2-legend-urls!)
-(gnc:guard-html-chart gnc:html-piechart-button-3-legend-urls)
-(gnc:guard-html-chart gnc:html-piechart-set-button-3-legend-urls!)
-(gnc:guard-html-chart gnc:html-piechart-render)
diff --git a/gnucash/report/html-scatter.scm b/gnucash/report/html-scatter.scm
deleted file mode 100644
index f8f6f38c0..000000000
--- a/gnucash/report/html-scatter.scm
+++ /dev/null
@@ -1,227 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; html-scatter.scm : generate HTML programmatically, with support
-;; for simple style elements.
-;; Copyright 2001 Christian Stimming <stimming at tuhh.de>
-;;
-;; Adapted from html-barchart.scm which is
-;; Copyright 2000 Bill Gribble <grib at gnumatic.com>
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash report html-scatter))
-
-(use-modules (gnucash utilities))
-(use-modules (gnucash report html-chart)
- (gnucash report report-utilities))
-
-(export <html-scatter>)
-(export gnc:html-scatter-add-datapoint!)
-(export gnc:html-scatter-data)
-(export gnc:html-scatter-height)
-(export gnc:html-scatter-marker)
-(export gnc:html-scatter-markercolor)
-(export gnc:html-scatter-render)
-(export gnc:html-scatter-set-data!)
-(export gnc:html-scatter-set-height!)
-(export gnc:html-scatter-set-marker!)
-(export gnc:html-scatter-set-markercolor!)
-(export gnc:html-scatter-set-subtitle!)
-(export gnc:html-scatter-set-title!)
-(export gnc:html-scatter-set-width!)
-(export gnc:html-scatter-set-x-axis-label!)
-(export gnc:html-scatter-set-y-axis-label!)
-(export gnc:html-scatter-subtitle)
-(export gnc:html-scatter-title)
-(export gnc:html-scatter-width)
-(export gnc:html-scatter-x-axis-label)
-(export gnc:html-scatter-y-axis-label)
-(export gnc:html-scatter?)
-(export gnc:make-html-scatter)
-(export gnc:make-html-scatter-internal)
-
-(define <html-scatter>
- (make-record-type '<html-scatter>
- '(width
- height
- title
- subtitle
- x-axis-label
- y-axis-label
- ;; a list of x-y-value lists.
- data
- ;; Valid marker names are:
- ;; diamond, circle, square, x, plus, dash,
- ;; filledDiamond, filledCircle, filledSquare
- marker
- ;; The color of the markers outline. Should be a hex string,
- ;; as returned by gnc:color-option->hex-string, prefixed by
- ;; #, like "#ff0000" for red
- markercolor
- )))
-
-(define-syntax-rule (gnc:guard-html-chart api)
- ;; this macro applied to old html-bar/line/scatter/pie apis will
- ;; guard a report writer from passing html-chart objects. this
- ;; should be removed in 5.x series.
- (let ((old-api api))
- (set! api
- (lambda args
- (if (and (pair? args) (gnc:html-chart? (car args)))
- (gnc:warn "using old-api " (procedure-name api) " on html-chart object. set options via gnc:html-chart-set! or its shortcuts gnc:html-chart-set-title! etc, and set data via gnc:html-chart-add-data-series! see sample-graphs.scm for examples.")
- (apply old-api args))))))
-
-(define gnc:html-scatter?
- (record-predicate <html-scatter>))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; <html-scatter> class
-;; generate the <object> form for a scatter plot.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define gnc:make-html-scatter-internal
- (record-constructor <html-scatter>))
-
-(define (gnc:make-html-scatter)
- (issue-deprecation-warning
- "(gnc:make-html-scatter) is deprecated in 4.x. use gnc:make-html-chart instead.")
- (gnc:make-html-scatter-internal '(pixels . -1) '(pixels . -1) #f #f #f #f '() #f #f))
-
-(define gnc:html-scatter-width
- (record-accessor <html-scatter> 'width))
-
-(define gnc:html-scatter-set-width!
- (record-modifier <html-scatter> 'width))
-
-(define gnc:html-scatter-height
- (record-accessor <html-scatter> 'height))
-
-(define gnc:html-scatter-set-height!
- (record-modifier <html-scatter> 'height))
-
-(define gnc:html-scatter-title
- (record-accessor <html-scatter> 'title))
-
-(define gnc:html-scatter-set-title!
- (record-modifier <html-scatter> 'title))
-
-(define gnc:html-scatter-subtitle
- (record-accessor <html-scatter> 'subtitle))
-
-(define gnc:html-scatter-set-subtitle!
- (record-modifier <html-scatter> 'subtitle))
-
-(define gnc:html-scatter-x-axis-label
- (record-accessor <html-scatter> 'x-axis-label))
-
-(define gnc:html-scatter-set-x-axis-label!
- (record-modifier <html-scatter> 'x-axis-label))
-
-(define gnc:html-scatter-y-axis-label
- (record-accessor <html-scatter> 'y-axis-label))
-
-(define gnc:html-scatter-set-y-axis-label!
- (record-modifier <html-scatter> 'y-axis-label))
-
-(define gnc:html-scatter-data
- (record-accessor <html-scatter> 'data))
-
-(define gnc:html-scatter-set-data!
- (record-modifier <html-scatter> 'data))
-
-(define gnc:html-scatter-marker
- (record-accessor <html-scatter> 'marker))
-
-(define gnc:html-scatter-set-marker!
- (record-modifier <html-scatter> 'marker))
-
-(define gnc:html-scatter-markercolor
- (record-accessor <html-scatter> 'markercolor))
-
-(define gnc:html-scatter-set-markercolor!
- (record-modifier <html-scatter> 'markercolor))
-
-(define (gnc:html-scatter-add-datapoint! scatter newpoint)
- (if (and (list? newpoint)
- (not (null? newpoint)))
- (gnc:html-scatter-set-data!
- scatter
- (cons newpoint (gnc:html-scatter-data scatter)))))
-
-;; The Renderer
-(define (gnc:html-scatter-render scatter doc)
- (let* ((chart (gnc:make-html-chart))
- (mcolor (gnc:html-scatter-markercolor scatter))
- (data (gnc:html-scatter-data scatter)))
- (cond
- ((and (pair? data) (gnc:not-all-zeros data))
- (gnc:html-chart-set-type! chart 'scatter)
- (gnc:html-chart-set-width! chart (gnc:html-scatter-width scatter))
- (gnc:html-chart-set-height! chart (gnc:html-scatter-height scatter))
- (gnc:html-chart-set-data-labels! chart (make-list (length data) #f))
- (gnc:html-chart-add-data-series! chart "scatter"
- (map
- (lambda (datum)
- (list
- (cons 'x (car datum))
- (cons 'y (cadr datum))))
- data)
- (make-list (length data) mcolor)
- 'showLine #t
- 'fill #f
- 'borderColor mcolor)
- (gnc:html-chart-set-title! chart (list
- (gnc:html-scatter-title scatter)
- (gnc:html-scatter-subtitle scatter)))
- (gnc:html-chart-set! chart
- '(options elements point pointStyle)
- (case (gnc:html-scatter-marker scatter)
- ((filleddiamond diamond) "rectRot")
- ((filledcircle circle) "circle")
- ((filledsquare square) "rect")
- ((cross) "crossRot")
- ((plus) "cross")
- ((dash) "line")
- (else #f)))
- (gnc:html-chart-set! chart '(options scales xAxes (0) type) "linear")
- (gnc:html-chart-render chart doc))
-
- (else
- (gnc:warn "null-data, not rendering scatter")
- ""))))
-
-(gnc:guard-html-chart gnc:html-scatter-width)
-(gnc:guard-html-chart gnc:html-scatter-set-width!)
-(gnc:guard-html-chart gnc:html-scatter-height)
-(gnc:guard-html-chart gnc:html-scatter-set-height!)
-(gnc:guard-html-chart gnc:html-scatter-title)
-(gnc:guard-html-chart gnc:html-scatter-set-title!)
-(gnc:guard-html-chart gnc:html-scatter-subtitle)
-(gnc:guard-html-chart gnc:html-scatter-set-subtitle!)
-(gnc:guard-html-chart gnc:html-scatter-x-axis-label)
-(gnc:guard-html-chart gnc:html-scatter-set-x-axis-label!)
-(gnc:guard-html-chart gnc:html-scatter-y-axis-label)
-(gnc:guard-html-chart gnc:html-scatter-set-y-axis-label!)
-(gnc:guard-html-chart gnc:html-scatter-data)
-(gnc:guard-html-chart gnc:html-scatter-set-data!)
-(gnc:guard-html-chart gnc:html-scatter-marker)
-(gnc:guard-html-chart gnc:html-scatter-set-marker!)
-(gnc:guard-html-chart gnc:html-scatter-markercolor)
-(gnc:guard-html-chart gnc:html-scatter-set-markercolor!)
-(gnc:guard-html-chart gnc:html-scatter-add-datapoint!)
-(gnc:guard-html-chart gnc:html-scatter-render)
diff --git a/gnucash/report/html-table.scm b/gnucash/report/html-table.scm
index e9206548e..c62bae3fd 100644
--- a/gnucash/report/html-table.scm
+++ b/gnucash/report/html-table.scm
@@ -97,7 +97,6 @@
(export gnc:html-table-get-cell)
(export gnc:html-table-set-cell!)
(export gnc:html-table-set-cell/tag!)
-(export gnc:html-table-append-column!)
(export gnc:html-table-render)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -412,30 +411,6 @@
(gnc:html-table-cell-set-tag! tc tag)
(gnc:html-table-set-cell-datum! table row col tc)))
-(define (gnc:html-table-append-column! table newcol)
- (define width (apply max (cons 0 (map length (gnc:html-table-data table)))))
- (define (add-fn a b) (list-set-safe! b width a))
- (issue-deprecation-warning "gnc:html-table-append-column! deprecated. please \
-populate html-table row-wise using gnc:html-table-append-row! instead.")
- (let lp ((newcol newcol)
- (olddata (reverse (gnc:html-table-data table)))
- (res '())
- (numrows 0))
- (cond
- ((null? newcol)
- (gnc:html-table-set-num-rows-internal! table numrows)
- (gnc:html-table-set-data! table res))
- ((null? olddata)
- (lp (cdr newcol)
- '()
- (cons (add-fn (car newcol) '()) res)
- (1+ numrows)))
- (else
- (lp (cdr newcol)
- (cdr olddata)
- (cons (add-fn (car newcol) (car olddata)) res)
- (1+ numrows))))))
-
(define (gnc:html-table-render table doc)
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval)))))
diff --git a/gnucash/report/html-utilities.scm b/gnucash/report/html-utilities.scm
index dcb45ca10..81abad44b 100644
--- a/gnucash/report/html-utilities.scm
+++ b/gnucash/report/html-utilities.scm
@@ -247,33 +247,6 @@
table (list (gnc:make-html-table-cell/size
1 colspan (gnc:make-html-text (gnc:html-markup-hr))))))
-;; Create a html-table of all exchange rates. The report-commodity is
-;; 'common-commodity', the exchange rates are given through the
-;; function 'exchange-fn' and the 'accounts' determine which
-;; commodities to show. Returns a html-object, a <html-table>.
-(define (gnc:html-make-exchangerates common-commodity exchange-fn accounts)
- (issue-deprecation-warning
- "gnc:html-make-exchangerates is deprecated. use gnc:html-make-rates-table instead.")
- (let* ((comm-list (gnc:accounts-get-commodities accounts common-commodity))
- (entries (length comm-list))
- (markup (lambda (c) (gnc:make-html-table-cell/markup "number-cell" c)))
- (table (gnc:make-html-table)))
- (unless (= 0 entries)
- (for-each
- (lambda (commodity)
- (let* ((orig-amt (gnc:make-gnc-monetary commodity 1))
- (exchanged (exchange-fn orig-amt common-commodity))
- (conv-amount (gnc:gnc-monetary-amount exchanged)))
- (gnc:html-table-append-row!
- table (list (markup orig-amt)
- (markup (gnc:default-price-renderer common-commodity
- conv-amount))))))
- comm-list)
- (gnc:html-table-set-col-headers!
- table (list (gnc:make-html-table-header-cell/size
- 1 2 (NG_ "Exchange rate" "Exchange rates" entries)))))
- table))
-
;; Create a html-table of all prices. The report-currency is
;; 'currency', The prices are given through the function 'price-fn'
;; and the 'accounts' determine which commodities to show. Returns a
diff --git a/gnucash/report/report-core.scm b/gnucash/report/report-core.scm
index f61d1a716..b7b5d217c 100644
--- a/gnucash/report/report-core.scm
+++ b/gnucash/report/report-core.scm
@@ -77,7 +77,6 @@
(export gnc:report-options)
(export gnc:report-render-html)
(export gnc:render-report)
-(export gnc:report-run)
(export gnc:report-serialize)
(export gnc:report-set-ctext!)
(export gnc:report-set-dirty?!)
@@ -112,7 +111,6 @@
(export gnc:report-to-template-new)
(export gnc:report-to-template-update)
(export gnc:report-type)
-(export gnc:restore-report-by-guid)
(export gnc:restore-report-by-guid-with-custom-template)
;; Terminology in this file:
@@ -383,20 +381,6 @@ not found.")))
(gnc:report-set-id! r (gnc-report-add r))
(gnc:report-id r)))
-
-(define (gnc:restore-report-by-guid id template-id template-name options)
- (issue-deprecation-warning "gnc:restore-report-by-guid is now deprecated.
- use gnc:restore-report-by-guid-with-custom-template instead.")
- (if options
- (let* ((r (make-report template-id id options #t #t #f #f ""))
- (report-id (gnc-report-add r)))
- (if (number? report-id)
- (gnc:report-set-id! r report-id))
- report-id)
- (begin
- (gui-error-missing-template template-name)
- #f)))
-
(define (gnc:restore-report-by-guid-with-custom-template
id template-id template-name custom-template-id options)
(if options
@@ -761,20 +745,6 @@ not found.")))
(define (get-report) (gnc:report-render-html report #t))
(gnc:apply-with-error-handling get-report '()))
-;; looks up the report by id and renders it with gnc:report-render-html
-;; marks the cursor busy during rendering; returns the html
-(define (gnc:report-run id)
- (issue-deprecation-warning "gnc:report-run is deprecated. use gnc:render-report instead.")
- (let ((report (gnc-report-find id))
- (html #f))
- (gnc-set-busy-cursor '() #t)
- (gnc:backtrace-if-exception
- (lambda ()
- (if report (set! html (gnc:report-render-html report #t)))))
- (gnc-unset-busy-cursor '())
- html))
-
-
;; "thunk" should take the report-type and the report template record
(define (gnc:report-templates-for-each thunk)
(hash-for-each
diff --git a/gnucash/report/report-utilities.scm b/gnucash/report/report-utilities.scm
index cb3240a0b..ee20590d6 100644
--- a/gnucash/report/report-utilities.scm
+++ b/gnucash/report/report-utilities.scm
@@ -592,39 +592,6 @@
accounts)
collector))
-;; Adds all accounts' balances, where the balances are determined with
-;; the get-balance-fn. Intended for usage with a profit and loss
-;; report, hence a) only the income/expense accounts are regarded, and
-;; b) the result is sign reversed. Returns a commodity-collector.
-(define (gnc:accounts-get-comm-total-profit accounts
- get-balance-fn)
- (issue-deprecation-warning "gnc:accounts-get-comm-total-profit deprecated.")
- (gnc:accounts-get-balance-helper
- (gnc:filter-accountlist-type (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE) accounts)
- get-balance-fn
- (lambda(x) #t)))
-
-;; Adds all accounts' balances, where the balances are determined with
-;; the get-balance-fn. Only the income accounts are regarded, and
-;; the result is sign reversed. Returns a commodity-collector.
-(define (gnc:accounts-get-comm-total-income accounts
- get-balance-fn)
- (issue-deprecation-warning "gnc:accounts-get-comm-total-income deprecated.")
- (gnc:accounts-get-balance-helper
- (gnc:filter-accountlist-type (list ACCT-TYPE-INCOME) accounts)
- get-balance-fn
- (lambda(x) #t)))
-
-;; Adds all accounts' balances, where the balances are determined with
-;; the get-balance-fn. Only the expense accounts are regarded, and
-;; the result is sign reversed. Returns a commodity-collector.
-(define (gnc:accounts-get-comm-total-expense accounts
- get-balance-fn)
- (issue-deprecation-warning "gnc:accounts-get-comm-total-expense deprecated.")
- (gnc:accounts-get-balance-helper
- (gnc:filter-accountlist-type (list ACCT-TYPE-EXPENSE) accounts)
- get-balance-fn
- (lambda(x) #t)))
;; Adds all accounts' balances, where the balances are determined with
;; the get-balance-fn. Intended for usage with a balance sheet, hence
@@ -668,41 +635,6 @@
(define (gnc:accountlist-get-comm-balance-at-date-with-closing accountlist date)
(gnc:account-get-trans-type-balance-interval-with-closing accountlist #f #f date))
-;; utility function - ensure that a query matches only non-voids. Destructive.
-(define (gnc:query-set-match-non-voids-only! query book)
- (issue-deprecation-warning
- "gnc:query-set-match-non-voids-only! is deprecated. add query for\
-(logand CLEARED-ALL (lognot CLEARED-VOIDED)) instead.")
- (let ((temp-query (qof-query-create-for-splits)))
- (qof-query-set-book temp-query book)
-
- (xaccQueryAddClearedMatch
- temp-query
- CLEARED-VOIDED
- QOF-QUERY-AND)
-
- (let ((inv-query (qof-query-invert temp-query)))
- (qof-query-merge-in-place query inv-query QOF-QUERY-AND)
- (qof-query-destroy inv-query)
- (qof-query-destroy temp-query))))
-
-;; utility function - ensure that a query matches only voids. Destructive
-
-(define (gnc:query-set-match-voids-only! query book)
- (issue-deprecation-warning
- "gnc:query-set-match-non-voids-only! is deprecated. add CLEARED-VOIDED \
-query instead.")
- (let ((temp-query (qof-query-create-for-splits)))
- (qof-query-set-book temp-query book)
-
- (xaccQueryAddClearedMatch
- temp-query
- CLEARED-VOIDED
- QOF-QUERY-AND)
-
- (qof-query-merge-in-place query temp-query QOF-QUERY-AND)
- (qof-query-destroy temp-query)))
-
(define (gnc:split-voided? split)
(let ((trans (xaccSplitGetParent split)))
(xaccTransGetVoidStatus trans)))
diff --git a/gnucash/report/reports/CMakeLists.txt b/gnucash/report/reports/CMakeLists.txt
index deb34de22..b551a6861 100644
--- a/gnucash/report/reports/CMakeLists.txt
+++ b/gnucash/report/reports/CMakeLists.txt
@@ -4,7 +4,6 @@ add_subdirectory(support)
#These provide some functions used by more than one report.
set (reports_common_SCHEME
- aging.scm #deprecated 4.x to be removed in 5.x
cash-flow-calc.scm
)
@@ -13,10 +12,7 @@ set (reports_common_SCHEME
set (reports_standard_with_exposed_generator_SCHEME
standard/new-aging.scm
standard/register.scm
- standard/owner-report.scm #deprecated 4.x to be removed in 5.x
standard/new-owner-report.scm
- standard/payables.scm #deprecated 4.x to be removed in 5.x
- standard/receivables.scm #deprecated 4.x to be removed in 5.x
)
set (reports_standard_SCHEME
@@ -51,7 +47,6 @@ set (reports_standard_SCHEME
standard/taxinvoice.scm
standard/receipt.scm
standard/invoice.scm
- standard/job-report.scm
standard/balsheet-eg.scm
)
@@ -169,199 +164,6 @@ add_custom_target(scm-reports ALL DEPENDS
scm-reports-us
scm-reports-de_DE)
-# Module interfaces deprecated in 4.x, will be removed for 5.x
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports"
- NEW_MODULE "gnucash reports"
- DEPENDS "scm-rpt-reports")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report aging"
- NEW_MODULE "gnucash reports aging"
- DEPENDS "scm-reports-common")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports average-balance"
- NEW_MODULE "gnucash reports example average-balance"
- DEPENDS "scm-reports-example")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports daily-reports"
- NEW_MODULE "gnucash reports example daily-reports"
- DEPENDS "scm-reports-example")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report hello-world"
- NEW_MODULE "gnucash reports example hello-world"
- DEPENDS "scm-reports-example")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report test-graphing"
- NEW_MODULE "gnucash reports example sample-graphs"
- DEPENDS "scm-reports-example")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report locale-specific de_DE"
- NEW_MODULE "gnucash reports locale-specific de_DE taxtxf"
- DEPENDS "scm-reports-de_DE")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report taxtxf-de_DE"
- NEW_MODULE "gnucash reports locale-specific de_DE taxtxf"
- DEPENDS "scm-reports-de_DE")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report locale-specific us"
- NEW_MODULE "gnucash reports locale-specific us taxtxf"
- DEPENDS "scm-reports-us")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report taxtxf"
- NEW_MODULE "gnucash reports locale-specific us taxtxf"
- DEPENDS "scm-reports-us")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports account-piecharts"
- NEW_MODULE "gnucash reports standard account-piecharts"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports account-summary"
- NEW_MODULE "gnucash reports standard account-summary"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports advanced-portfolio"
- NEW_MODULE "gnucash reports standard advanced-portfolio"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports balance-forecast"
- NEW_MODULE "gnucash reports standard balance-forecast"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports balance-sheet"
- NEW_MODULE "gnucash reports standard balance-sheet"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report balsheet-eg"
- NEW_MODULE "gnucash reports standard balsheet-eg"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports balsheet-pnl"
- NEW_MODULE "gnucash reports standard balsheet-pnl"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports budget-balance-sheet"
- NEW_MODULE "gnucash reports standard budget-balance-sheet"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports budget-barchart"
- NEW_MODULE "gnucash reports standard budget-barchart"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports budget-flow"
- NEW_MODULE "gnucash reports standard budget-flow"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports budget"
- NEW_MODULE "gnucash reports standard budget"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports budget-income-statement"
- NEW_MODULE "gnucash reports standard budget-income-statement"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports cashflow-barchart"
- NEW_MODULE "gnucash reports standard cashflow-barchart"
- DEPENDS "scm-reports-standard-2")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports cash-flow"
- NEW_MODULE "gnucash reports standard cash-flow"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports category-barchart"
- NEW_MODULE "gnucash reports standard category-barchart"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report customer-summary"
- NEW_MODULE "gnucash reports standard customer-summary"
- DEPENDS "scm-reports-standard-2")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report welcome-to-gnucash"
- NEW_MODULE "gnucash reports standard dashboard"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports equity-statement"
- NEW_MODULE "gnucash reports standard equity-statement"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports general-journal"
- NEW_MODULE "gnucash reports standard general-journal"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports general-ledger"
- NEW_MODULE "gnucash reports standard general-ledger"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports income-gst-statement"
- NEW_MODULE "gnucash reports standard income-gst-statement"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports income-statement"
- NEW_MODULE "gnucash reports standard income-statement"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report invoice"
- NEW_MODULE "gnucash reports standard invoice"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report job-report"
- NEW_MODULE "gnucash reports standard job-report"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports net-charts"
- NEW_MODULE "gnucash reports standard net-charts"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report owner-report"
- NEW_MODULE "gnucash reports standard owner-report"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report payables"
- NEW_MODULE "gnucash reports standard payables"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports portfolio"
- NEW_MODULE "gnucash reports standard portfolio"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports price-scatter"
- NEW_MODULE "gnucash reports standard price-scatter"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report receipt"
- NEW_MODULE "gnucash reports standard receipt"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report receivables"
- NEW_MODULE "gnucash reports standard receivables"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports reconcile-report"
- NEW_MODULE "gnucash reports standard reconcile-report"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports register"
- NEW_MODULE "gnucash reports standard register"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports sx-summary"
- NEW_MODULE "gnucash reports standard account-summary"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report taxinvoice"
- NEW_MODULE "gnucash reports standard taxinvoice"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports transaction"
- NEW_MODULE "gnucash reports standard transaction"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report standard-reports trial-balance"
- NEW_MODULE "gnucash reports standard trial-balance"
- DEPENDS "scm-reports-standard")
-gnc_add_scheme_deprecated_module (
- OLD_MODULE "gnucash report view-column"
- NEW_MODULE "gnucash reports standard view-column"
- DEPENDS "scm-reports-standard")
set_local_dist(reports_DIST_local CMakeLists.txt ${reports_SCHEME}
${reports_common_SCHEME} ${reports_standard_SCHEME} ${reports_standard_SCHEME_2}
diff --git a/gnucash/report/reports/aging.scm b/gnucash/report/reports/aging.scm
deleted file mode 100644
index 9a0d895ed..000000000
--- a/gnucash/report/reports/aging.scm
+++ /dev/null
@@ -1,847 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; aging.scm : accounts payable/receivable aging report utilities
-;;
-;; By Derek Atkins <warlord at MIT.EDU> taken from the original...
-;; By Robert Merkel (rgmerk at mira.net)
-;; Copyright (c) 2002, 2003 Derek Atkins <warlord at MIT.EDU>
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash reports aging))
-
-(use-modules (gnucash engine))
-(use-modules (gnucash utilities))
-(use-modules (gnucash core-utils))
-(use-modules (gnucash app-utils))
-(use-modules (gnucash report))
-(use-modules (gnucash gnome-utils))
-(use-modules (srfi srfi-9))
-
-(define optname-to-date (N_ "To"))
-(define optname-sort-by (N_ "Sort By"))
-(define optname-sort-order (N_ "Sort Order"))
-(define optname-report-currency (N_ "Report's currency"))
-(define optname-price-source (N_ "Price Source"))
-(define optname-multicurrency-totals (N_ "Show Multi-currency Totals"))
-(define optname-show-zeros (N_ "Show zero balance items"))
-(define optname-date-driver (N_ "Due or Post Date"))
-
-;; Display tab options
-(define optname-addr-source (N_ "Address Source")) ;; Billing or Shipping addresses
-(define optname-disp-addr-name (N_ "Address Name"))
-(define optname-disp-addr1 (N_ "Address 1"))
-(define optname-disp-addr2 (N_ "Address 2"))
-(define optname-disp-addr3 (N_ "Address 3"))
-(define optname-disp-addr4 (N_ "Address 4"))
-(define optname-disp-addr-phone (N_ "Address Phone"))
-(define optname-disp-addr-fax (N_ "Address Fax"))
-(define optname-disp-addr-email (N_ "Address Email"))
-(define optname-disp-active (N_ "Active"))
-
-(export optname-show-zeros)
-
-;; The idea is: have a hash with the key being the contact name
-;; (In future this might be GUID'ed, but for now it's a string
-;; from the description or the split memo.
-;; The value is a record which contains the currency that contact
-;; is stored in (you can only owe a particular contact one
-;; currency, it just gets far too difficult otherwise), and a list
-;; of buckets containing the money owed for each interval,
-;; oldest first.
-;; overpayment is just that - it stores the current overpayment,
-;; if any. Any bills get taken out of the overpayment before
-;; incurring debt.
-
-(define-record-type :company-info
- (make-company-private currency bucket overpayment owner-obj)
- company-info?
- (currency company-get-currency)
- (bucket company-get-buckets company-set-buckets)
- (overpayment company-get-overpayment company-set-overpayment)
- (owner-obj company-get-owner-obj company-set-owner-obj!))
-
-(define num-buckets 5)
-(define (new-bucket-vector)
- (make-vector num-buckets (gnc-numeric-zero)))
-
-(define (make-company currency owner-obj)
- (make-company-private currency (new-bucket-vector) 0 owner-obj))
-
-;; Put an invoice in the appropriate bucket
-
-(define (process-invoice company amount bucket-intervals date)
- (define (in-interval this-date current-bucket)
- (< this-date current-bucket))
-
- (define (find-bucket current-bucket bucket-intervals date)
- (gnc:debug "looking for bucket for date: " date)
- (begin
- (gnc:debug "current bucket: " current-bucket)
- (gnc:debug "bucket-intervals: " bucket-intervals)
- (if (> current-bucket (vector-length bucket-intervals))
- (gnc:error "sanity check failed in find-bucket")
- (if (in-interval date (vector-ref bucket-intervals current-bucket))
- (begin
- (gnc:debug "found bucket")
- current-bucket)
- (find-bucket (+ current-bucket 1) bucket-intervals date)))))
-
- (define (calculate-adjusted-values amount overpayment)
- (if (>= (gnc-numeric-compare amount overpayment) 0)
- (cons (gnc-numeric-sub-fixed amount overpayment)
- (gnc-numeric-zero))
- (cons (gnc-numeric-zero)
- (gnc-numeric-sub-fixed overpayment amount))))
-
- (let* ((current-overpayment (company-get-overpayment company))
- (adjusted-values (calculate-adjusted-values amount current-overpayment))
- (adjusted-amount (car adjusted-values))
- (adjusted-overpayment (cdr adjusted-values))
- (bucket-index (find-bucket 0 bucket-intervals date))
- (buckets (company-get-buckets company))
- (new-bucket-value
- (gnc-numeric-add-fixed adjusted-amount (vector-ref buckets bucket-index))))
- (vector-set! buckets bucket-index new-bucket-value)
- (company-set-buckets company buckets)
- (company-set-overpayment company adjusted-overpayment)))
-
-
-;; NOTE: We assume that bill payments occur in a FIFO manner - ie
-;; any payment to a company goes towards the *oldest* bill first
-
-
-(define (process-payment company amount)
- (define (process-payment-driver amount buckets current-bucket-index)
- (if (>= current-bucket-index (vector-length buckets))
- amount
- (let ((current-bucket-amt (vector-ref buckets current-bucket-index)))
- (if (>= (gnc-numeric-compare current-bucket-amt amount) 0)
- (begin
- (vector-set! buckets current-bucket-index (gnc-numeric-sub-fixed
- current-bucket-amt amount))
- (gnc-numeric-zero))
- (begin
- (vector-set! buckets current-bucket-index (gnc-numeric-zero))
- (process-payment-driver
- (gnc-numeric-sub-fixed amount current-bucket-amt)
- buckets
- (+ current-bucket-index 1)))))))
-
- (let ((overpayment (company-get-overpayment company)))
- ;; if there's already an overpayment, make it bigger
- (gnc:debug "processing payment of " amount)
- (gnc:debug "overpayment was " overpayment)
-
- (if (gnc-numeric-positive-p overpayment)
- (company-set-overpayment company (gnc-numeric-add-fixed overpayment amount))
-
- (let ((result (process-payment-driver amount (company-get-buckets company) 0)))
- (gnc:debug "payment-driver processed. new overpayment: " result)
- (company-set-overpayment company result)))))
-
-;; determine date function to use
-(define (get-selected-date-from-txn transaction date-type)
- (if (eq? date-type 'postdate)
- (xaccTransGetDate transaction)
- (xaccTransRetDateDue transaction)))
-
-;; deal with a transaction - figure out if we've seen the company before
-;; if so, either process it as a bill or a payment, if not, create
-;; a new company record in the hash
-
-(define (update-company-hash hash split bucket-intervals
- reverse? show-zeros date-type)
-
- (define (do-update value)
- (let* ((transaction (xaccSplitGetParent split))
- (temp-owner (gncOwnerNew))
- (owner (gnc:owner-from-split split temp-owner)))
-
- (if (not (null? owner))
- (let* ((guid (gncOwnerReturnGUID owner))
- (this-currency (xaccTransGetCurrency transaction))
- (this-date (get-selected-date-from-txn transaction date-type))
- (company-info (hash-ref hash guid)))
-
- (gnc:debug "update-company-hash called")
- (gnc:debug "owner: " owner ", guid: " guid)
- (gnc:debug "split-value: " value)
- (if reverse? (set! value (gnc-numeric-neg value)))
- (if company-info
- ;; if it's an existing company, destroy the temp owner and
- ;; then make sure the currencies match
- (begin
- (if (not (gnc-commodity-equiv
- this-currency
- (company-get-currency company-info)))
- (let ((error-str
- (string-append "IGNORING TRANSACTION!\n" "Invoice Owner: " (gnc:strify owner)
- "\nTransaction:" (gnc:strify transaction)
- "\nSplits are:\n"
- (string-join
- (map gnc:strify (xaccTransGetSplitList transaction))
- "\n")
- "\nTransaction Currency:" (gnc:strify this-currency)
- "\nClient Currency:" (gnc:strify (company-get-currency company-info)))))
- (gnc-error-dialog '() error-str)
- (gnc:error error-str)
- (cons #f (format #f (G_ "Transactions relating to '~a' contain \
-more than one currency. This report is not designed to cope with this possibility.") (gncOwnerGetName owner))))
- (begin
- (gnc:debug "it's an old company")
- (if (gnc-numeric-negative-p value)
- (process-invoice company-info (gnc-numeric-neg value) bucket-intervals this-date)
- (process-payment company-info value))
- (hash-set! hash guid company-info)
- (cons #t guid)))
- (gncOwnerFree temp-owner))
-
- ;; if it's a new company
- (begin
- (gnc:debug "value" value)
- (let ((new-company (make-company this-currency owner)))
- (if (gnc-numeric-negative-p value)
- (process-invoice new-company (gnc-numeric-neg value) bucket-intervals this-date)
- (process-payment new-company value))
- (hash-set! hash guid new-company))
- (cons #t guid))))
- ; else (no owner)
- (gncOwnerFree temp-owner))))
-
- ;; figure out if this split is part of a closed lot
- ;; also save the split value...
- (let* ((lot (xaccSplitGetLot split))
- (value (xaccSplitGetValue split))
- (is-paid? (if (null? lot) #f (gnc-lot-is-closed lot))))
-
- ;; if it's closed, then ignore it because it doesn't matter.
- ;; XXX: we _could_ just set the value to 0 in order to list
- ;; the company. I'm not sure what to do. Perhaps add an
- ;; option?
- (if (or (not is-paid?) show-zeros)
- (do-update value))))
-
-;; get the total debt from the buckets
-(define (buckets-get-total buckets)
- (let ((running-total (gnc-numeric-zero))
- (buckets-list (vector->list buckets)))
- (for-each (lambda (bucket)
- (set! running-total
- (gnc-numeric-add-fixed bucket running-total)))
- buckets-list)
- running-total))
-
-
-;; compare by the total in the buckets
-(define (safe-strcmp a b)
- (if (and a b)
- (cond
- ((string<? a b) -1)
- ((string>? a b) 1)
- (else 0))
- (cond
- (a 1)
- (b -1)
- (else 0))))
-
-(define (compare-total litem-a litem-b)
- (let* ((company-a (cdr litem-a))
- (bucket-a (company-get-buckets company-a))
- (company-b (cdr litem-b))
- (bucket-b (company-get-buckets company-b))
- (total-a (buckets-get-total bucket-a))
- (total-b (buckets-get-total bucket-b))
- (difference-sign (gnc-numeric-compare (gnc-numeric-sub-fixed total-a total-b) (gnc-numeric-zero))))
- ;; if same totals, compare by name
- (if (= difference-sign 0)
- (safe-strcmp (car litem-a) (car litem-b))
- difference-sign)))
-
-;; compare by buckets, oldest first.
-
-(define (compare-buckets litem-a litem-b)
- (define (driver buckets-a buckets-b)
- (if (null? buckets-a)
- 0
- (let ((diff (gnc-numeric-compare
- (gnc-numeric-sub-fixed
- (car buckets-a)
- (car buckets-b))
- (gnc-numeric-zero))))
- (if (= diff 0)
- (driver (cdr buckets-a) (cdr buckets-b))
- diff))))
-
- (let* ((company-a (cdr litem-a))
- (bucket-a (vector->list (company-get-buckets company-a)))
- (company-b (cdr litem-b))
- (bucket-b (vector->list (company-get-buckets company-b)))
-
- (difference (driver bucket-a bucket-b)))
- ;; if same totals, compare by name
- (if (= difference 0)
- (safe-strcmp (car litem-a) (car litem-b))
- difference)))
-
-
-;; set up the query to get the splits in the chosen account
-(define (setup-query query account date)
- (qof-query-set-book query (gnc-get-current-book))
- (xaccQueryAddClearedMatch
- query (logand CLEARED-ALL (lognot CLEARED-VOIDED)) QOF-QUERY-AND)
- (xaccQueryAddSingleAccountMatch query account QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT query #f 0 #t date QOF-QUERY-AND)
- (qof-query-set-sort-order query
- (list SPLIT-TRANS TRANS-DATE-POSTED)
- '() '())
- (qof-query-set-sort-increasing query #t #t #t))
-
-(define (aging-options-generator options)
- (let* ((add-option
- (lambda (new-option)
- (gnc:register-option options new-option))))
-
-
- (gnc:options-add-report-date!
- options gnc:pagename-general
- optname-to-date "a")
- ;; Use a default report date of 'today'
- (gnc:option-set-value (gnc:lookup-option options
- gnc:pagename-general
- optname-to-date)
- (cons 'relative 'today))
-
- ;; all about currencies
- (gnc:options-add-currency!
- options gnc:pagename-general
- optname-report-currency "b")
-
- (gnc:options-add-price-source!
- options gnc:pagename-general
- optname-price-source "c" 'weighted-average)
-
- (add-option
- (gnc:make-multichoice-option
- gnc:pagename-general
- optname-sort-by
- "i"
- (N_ "Sort companies by.")
- 'name
- (list
- (vector 'name (N_ "Name") (N_ "Name of the company."))
- (vector 'total (N_ "Total Owed") (N_ "Total amount owed to/from Company."))
- (vector 'oldest-bracket (N_ "Bracket Total Owed") (N_ "Amount owed in oldest bracket - if same go to next oldest.")))))
-
- (add-option
- (gnc:make-multichoice-option
- gnc:pagename-general
- optname-sort-order
- "ia"
- (N_ "Sort order.")
- 'increasing
- (list
- (vector 'increasing (N_ "Increasing") (N_ "0 .. 999,999.99, A .. Z."))
- (vector 'decreasing (N_ "Decreasing") (N_ "999,999.99 .. 0, Z .. A.")))))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-general
- optname-multicurrency-totals
- "i"
- (N_ "Show multi-currency totals. If not selected, convert all \
-totals to report currency.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-general
- optname-show-zeros
- "j"
- (N_ "Show all vendors/customers even if they have a zero balance.")
- #f))
-
- (add-option
- (gnc:make-multichoice-option
- gnc:pagename-general
- optname-date-driver
- "k"
- (N_ "Leading date.")
- 'duedate
- (list
- (vector 'duedate (N_ "Due Date") (N_ "Due date is leading.")) ;; Should be using standard label for due date?
- (vector 'postdate (N_ "Post Date") (N_ "Post date is leading."))))) ;; Should be using standard label for post date?
-
- ;; display tab options
-
- ;; option optname-addr-source is added in receivables.scm
- ;; as cannot access the value of an option in aging-options-generator
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-addr-name
- "b"
- (N_ "Display Address Name. This, and other fields, may be useful if \
-copying this report to a spreadsheet for use in a mail merge.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-addr1
- "c"
- (N_ "Display Address 1.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-addr2
- "d"
- (N_ "Display Address 2.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-addr3
- "e"
- (N_ "Display Address 3.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-addr4
- "f"
- (N_ "Display Address 4.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-addr-phone
- "g"
- (N_ "Display Phone.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-addr-fax
- "h"
- (N_ "Display Fax.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-addr-email
- "i"
- (N_ "Display Email.")
- #f))
-
- (add-option
- (gnc:make-simple-boolean-option
- gnc:pagename-display
- optname-disp-active
- "j"
- (N_ "Display Active status.")
- #f))
-
- (gnc:options-set-default-section options "General")
- options))
-
-(define (make-interval-list to-date)
- (let ((begindate to-date))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (gnc:make-date-list begindate to-date ThirtyDayDelta)))
-
-;; Have make-list create a stepped list, then add a date in the future for the "current" bucket
-(define (make-extended-interval-list to-date)
- (define dayforcurrent (incdate to-date YearDelta)) ;; MAGIC CONSTANT
- (define oldintervalreversed (reverse (make-interval-list to-date)))
- (reverse (cons dayforcurrent oldintervalreversed)))
-
-(define (aging-renderer report-obj reportname account reverse?)
-
- (define receivable #t) ;; receivable=#t payable=#f
-
- (define (get-name a)
- (let* ((owner (company-get-owner-obj (cdr a))))
- (gncOwnerGetName owner)))
-
- ;; Predicates for sorting the companys once the data has been collected
-
- ;; Format: (cons 'sort-key (cons 'increasing-pred 'decreasing-pred))
- (define sort-preds
- (list
- (cons 'name (cons (lambda (a b)
- (string<? (get-name a) (get-name b)))
- (lambda (a b)
- (string>? (get-name a) (get-name b)))))
- (cons 'total (cons (lambda (a b)
- (< (compare-total a b) 0))
- (lambda (a b)
- (> (compare-total a b) 0))))
- (cons 'oldest-bracket (cons
- (lambda (a b)
- (< (compare-buckets a b) 0))
- (lambda (a b)
- (> (compare-buckets a b) 0))))))
-
-
- (define (get-sort-pred sort-criterion sort-order)
- (let ((choice (assq-ref sort-preds sort-criterion)))
- (gnc:debug "sort-criterion" sort-criterion)
- (gnc:debug "sort-order" sort-order)
- (gnc:debug "choice: " choice)
- (if choice
- (if (eq? sort-order 'increasing)
- (car choice)
- (cdr choice))
- (begin
- (gnc:warn "internal sorting option errorin aging.scm")
- (lambda (a b)
- (string<? (car a) (car b)))))))
-
- (define (get-op section name)
- (gnc:lookup-option (gnc:report-options report-obj) section name))
-
- (define (op-value section name)
- (gnc:option-value (get-op section name)))
-
-
- ;; XXX: This is a hack - will be fixed when we move to a
- ;; more general interval scheme in this report
- (define make-heading-list
- (list
- (G_ "Company")
- (G_ "Current")
- (G_ "0-30 days")
- (G_ "31-60 days")
- (G_ "61-90 days")
- (G_ "91+ days")
- (G_ "Total")))
-
-;; following cols are optional
-;; (G_ "Address Name")
-;; (G_ "Address 1")
-;; (G_ "Address 2")
-;; (G_ "Address 3")
-;; (G_ "Address 4")
-;; (G_ "Phone")
-;; (G_ "Fax")
-;; (G_ "Email")
-;; (G_ "Active")
-
-
- ;; Make a list of commodity collectors for column totals
-
- (define (make-collector-list)
- (define (make-collector-driver done total)
- (if (< done total)
- (cons
- (gnc:make-commodity-collector)
- (make-collector-driver (+ done 1) total))
- '()))
- (make-collector-driver 0 (+ num-buckets 1)))
-
-
- ;; update the column totals
-
- (define (add-to-column-totals column-totals monetary-list)
- (begin
- (gnc:debug "column-totals" column-totals)
- (gnc:debug "monetary-list" monetary-list)
- (map (lambda (amount collector)
- (begin
- (gnc:debug "amount" amount)
- (gnc:debug "collector" collector)
- (collector 'add
- (gnc:gnc-monetary-commodity amount)
- (gnc:gnc-monetary-amount amount))))
- monetary-list
- column-totals)))
-
- ;; convert the buckets in the header data structure
- (define (convert-to-monetary-list bucket-list currency overpayment)
- (let* ((running-total (gnc-numeric-neg overpayment))
- (monetised-buckets
- (map (lambda (bucket-list-entry)
- (begin
- (set! running-total
- (gnc-numeric-add-fixed running-total bucket-list-entry))
- (gnc:make-gnc-monetary currency bucket-list-entry)))
- (vector->list bucket-list))))
- (append (reverse monetised-buckets)
- (list (gnc:make-gnc-monetary currency running-total)))))
-
- ;; convert the collectors to the right output format
-
- (define (convert-collectors collector-list report-currency
- exchange-fn
- multi-currencies-p)
- (define (fmt-one-currency collector)
- (let ((monetary (gnc:sum-collector-commodity collector report-currency exchange-fn)))
- (if monetary
- monetary
- (begin
- (gnc:warn "Exchange-lookup failed in fmt-one-currency")
- #f))))
-
- (define (fmt-multiple-currencies collector)
- (let ((mini-table (gnc:make-html-table)))
- (collector 'format
- (lambda (commodity amount)
- (gnc:html-table-append-row!
- mini-table
- (list (gnc:make-gnc-monetary
- commodity amount))))
- #f)
- mini-table))
-
- (let ((fmt-function
- (if multi-currencies-p
- fmt-multiple-currencies
- fmt-one-currency)))
- (map fmt-function collector-list)))
-
- ;; return pointer to either billing or shipping address
- ;; note customers have a shipping address but not vendors
-
- (define (get-addr owner disp-addr-source)
- (if (and receivable (eq? disp-addr-source 'shipping))
- (gncCustomerGetShipAddr (gncOwnerGetCustomer owner)) ;; shipping
- (gncOwnerGetAddr owner))) ;; billing
-
- (issue-deprecation-warning
- "old aging reports are deprecated and will be removed in 5.x")
-
- (set! receivable (eq? (op-value "__hidden" "receivable-or-payable") 'R))
- (gnc:report-starting reportname)
- (let* ((companys (make-hash-table 23))
- (report-title (op-value gnc:pagename-general gnc:optname-reportname))
- ;; document will be the HTML document that we return.
- (report-date (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
- (op-value gnc:pagename-general optname-to-date))))
- (interval-vec (list->vector (make-extended-interval-list report-date)))
- (sort-pred (get-sort-pred
- (op-value gnc:pagename-general optname-sort-by)
- (op-value gnc:pagename-general optname-sort-order)))
- (report-currency (op-value gnc:pagename-general optname-report-currency))
- (price-source (op-value gnc:pagename-general optname-price-source))
- (multi-totals-p (op-value gnc:pagename-general optname-multicurrency-totals))
- (show-zeros (op-value gnc:pagename-general optname-show-zeros))
- (date-type (op-value gnc:pagename-general optname-date-driver))
- (disp-addr-source (if receivable
- (op-value gnc:pagename-display optname-addr-source)
- 'billing))
- (disp-addr-name (op-value gnc:pagename-display optname-disp-addr-name))
- (disp-addr1 (op-value gnc:pagename-display optname-disp-addr1))
- (disp-addr2 (op-value gnc:pagename-display optname-disp-addr2))
- (disp-addr3 (op-value gnc:pagename-display optname-disp-addr3))
- (disp-addr4 (op-value gnc:pagename-display optname-disp-addr4))
- (disp-addr-phone (op-value gnc:pagename-display optname-disp-addr-phone))
- (disp-addr-fax (op-value gnc:pagename-display optname-disp-addr-fax))
- (disp-addr-email (op-value gnc:pagename-display optname-disp-addr-email))
- (disp-active (op-value gnc:pagename-display optname-disp-active))
- (heading-list make-heading-list)
- (exchange-fn (gnc:case-exchange-fn price-source report-currency report-date))
- (total-collector-list (make-collector-list))
- (table (gnc:make-html-table))
- (query (qof-query-create-for-splits))
- (company-list '())
- (work-done 0)
- (work-to-do 0)
- (document (gnc:make-html-document)))
-; (gnc:debug "Account: " account)
-
- ;; add optional column headings
- (if disp-addr-name
- (set! heading-list (append heading-list (list (G_ "Address Name")))))
- (if disp-addr1
- (set! heading-list (append heading-list (list (G_ "Address 1")))))
- (if disp-addr2
- (set! heading-list (append heading-list (list (G_ "Address 2")))))
- (if disp-addr3
- (set! heading-list (append heading-list (list (G_ "Address 3")))))
- (if disp-addr4
- (set! heading-list (append heading-list (list (G_ "Address 4")))))
- (if disp-addr-phone
- (set! heading-list (append heading-list (list (G_ "Phone")))))
- (if disp-addr-fax
- (set! heading-list (append heading-list (list (G_ "Fax")))))
- (if disp-addr-email
- (set! heading-list (append heading-list (list (G_ "Email")))))
- (if disp-active
- (set! heading-list (append heading-list (list (G_ "Active")))))
-
- ;; set default title
- (gnc:html-document-set-title! document report-title)
- ;; maybe redefine better...
- (if (and account (not (null? account)))
- (begin
- (gnc:html-document-set-title!
- document (string-append report-title ": " (xaccAccountGetName account)))
- (gnc:html-document-set-headline! document
- (gnc:html-markup
- "!"
- report-title
- ": "
- (gnc:html-markup-anchor
- (gnc:account-anchor-text account)
- (xaccAccountGetName account))))))
-
- (gnc:html-table-set-col-headers! table heading-list)
-
- (if (and account (not (null? account)))
- (begin
- (setup-query query account report-date)
- ;; get the appropriate splits
- (let ((splits (qof-query-run query)))
-; (gnc:debug "splits" splits)
-
- ;; build the table
- (set! work-to-do (length splits))
- ;; work-done is already zero
- (for-each (lambda (split)
- (gnc:report-percent-done (* 50 (/ work-done work-to-do)))
- (set! work-done (+ 1 work-done))
- (update-company-hash companys
- split
- interval-vec
- reverse? show-zeros
- date-type))
- splits)
-; (gnc:debug "companys" companys)
- ;; turn the hash into a list
- (hash-for-each (lambda (key value)
- (set! company-list
- (cons (cons key value) company-list)))
- companys)
-; (gnc:debug "company list" company-list)
-
- (set! company-list (sort-list! company-list
- sort-pred))
-
- ;; build the table
- (set! work-to-do (length company-list))
- (set! work-done 0)
- (for-each (lambda (company-list-entry)
- (gnc:report-percent-done (+ 50 (* 50 (/ work-done work-to-do))))
- (set! work-done (+ 1 work-done))
- (let* ((monetary-list (convert-to-monetary-list
- (company-get-buckets
- (cdr company-list-entry))
- (company-get-currency
- (cdr company-list-entry))
- (company-get-overpayment
- (cdr company-list-entry))))
- (owner (company-get-owner-obj
- (cdr company-list-entry)))
- (company-name (gncOwnerGetName owner))
- (addr (get-addr owner disp-addr-source))
- (addr-name (gncAddressGetName addr))
- (addr-addr1 (gncAddressGetAddr1 addr))
- (addr-addr2 (gncAddressGetAddr2 addr))
- (addr-addr3 (gncAddressGetAddr3 addr))
- (addr-addr4 (gncAddressGetAddr4 addr))
- (addr-phone (gncAddressGetPhone addr))
- (addr-fax (gncAddressGetFax addr))
- (addr-email (gncAddressGetEmail addr))
- (company-active (if (gncOwnerGetActive owner)
- (C_ "One-letter indication for 'yes'" "Y") (C_ "One-letter indication for 'no'" "N")))
- (opt-fld-list '())
- )
-;; (gnc:debug "aging-renderer: disp-addr-source=" disp-addr-source
-;; " owner=" owner
-;; " gncOwnerGetID=" (gncOwnerGetID owner) ;; cust no
-;; " gncCustomerGetShipAddr="
-;; (gncCustomerGetShipAddr (gncOwnerGetCustomer owner)))
- (if disp-addr-name
- (set! opt-fld-list (append opt-fld-list (list addr-name))))
- (if disp-addr1
- (set! opt-fld-list (append opt-fld-list (list addr-addr1))))
- (if disp-addr2
- (set! opt-fld-list (append opt-fld-list (list addr-addr2))))
- (if disp-addr3
- (set! opt-fld-list (append opt-fld-list (list addr-addr3))))
- (if disp-addr4
- (set! opt-fld-list (append opt-fld-list (list addr-addr4))))
- (if disp-addr-phone
- (set! opt-fld-list (append opt-fld-list (list addr-phone))))
- (if disp-addr-fax
- (set! opt-fld-list (append opt-fld-list (list addr-fax))))
- (if disp-addr-email
- (set! opt-fld-list (append opt-fld-list (list addr-email))))
- (if disp-active
- (set! opt-fld-list (append opt-fld-list (list company-active))))
- (add-to-column-totals total-collector-list
- monetary-list)
-
- (let* ((ml (reverse monetary-list))
- (total (car ml))
- (rest (cdr ml)))
-
- (set! monetary-list
- (reverse
- (cons
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:owner-report-text owner account report-date)
- total))
- rest))))
-
- (gnc:html-table-append-row! table
- (append
- (cons
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:owner-anchor-text owner)
- company-name))
- monetary-list)
- opt-fld-list))
- (gncOwnerFree owner)))
- company-list)
-
- ;; add the totals
- (gnc:html-table-append-row!
- table
- (cons (G_ "Total") (convert-collectors total-collector-list
- report-currency
- exchange-fn
- multi-totals-p)))
-
- (gnc:html-document-add-object!
- document table)))
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (G_ "No valid account selected. Click on the Options button and select the account to use."))))
- (qof-query-destroy query)
- (gnc:report-finished)
- document))
-
-(export aging-options-generator)
-(export aging-renderer)
diff --git a/gnucash/report/reports/example/average-balance.scm b/gnucash/report/reports/example/average-balance.scm
index 042a7d36c..a25950bad 100644
--- a/gnucash/report/reports/example/average-balance.scm
+++ b/gnucash/report/reports/example/average-balance.scm
@@ -455,9 +455,7 @@
barchart (gnc-commodity-get-nice-symbol report-currency))
(gnc:html-chart-set-data-labels! barchart col-labels)
- ;; (gnc:html-barchart-set-col-colors! barchart col-colors)
(gnc:html-chart-set-data-labels! barchart (map car data))
- ;; (gnc:html-chart-set-row-labels-rotated?! barchart #t)
(gnc:html-chart-set-width! barchart width)
(gnc:html-chart-set-height! barchart height)
(gnc:html-chart-set-height! barchart height)
diff --git a/gnucash/report/reports/standard/income-gst-statement.scm b/gnucash/report/reports/standard/income-gst-statement.scm
index 234422416..c4e4bc846 100644
--- a/gnucash/report/reports/standard/income-gst-statement.scm
+++ b/gnucash/report/reports/standard/income-gst-statement.scm
@@ -70,7 +70,7 @@ accounts may be tagged with *EUGOODS* in the account description."))
(gnc:html-markup-p
(G_ "This message will be removed when tax accounts are specified."))))
-(define* (gst-statement-renderer rpt #:optional export-type file-name)
+(define* (gst-statement-renderer rpt #:optional export-type)
(define (opt-val section name)
(gnc:option-value
(gnc:lookup-option (gnc:report-options rpt) section name)))
@@ -83,10 +83,6 @@ accounts may be tagged with *EUGOODS* in the account description."))
#:custom-source-accounts sales-purch-accounts
#:custom-split-filter gst-custom-split-filter
#:export-type export-type))
- (when file-name
- (issue-deprecation-warning "gst-statement-renderer filename is \
-obsolete, and not supported for exports. please set html-document \
-export-string instead. this warning will be removed in GnuCash 5.0"))
(when (null? (opt-val "Accounts" "Tax Accounts"))
(gnc:html-document-add-object! document TAX-SETUP-DESC))
document)
diff --git a/gnucash/report/reports/standard/job-report.scm b/gnucash/report/reports/standard/job-report.scm
deleted file mode 100644
index 00a31d6d5..000000000
--- a/gnucash/report/reports/standard/job-report.scm
+++ /dev/null
@@ -1,601 +0,0 @@
-;; -*-scheme-*-
-;; owner-report.scm -- Print out a detailed owner report, which is a
-;; summary of invoices and payments for a particular
-;; company (the owner) applied to an account.
-;;
-;; Created by: Derek Atkins <warlord at MIT.EDU>
-;; Copyright (c) 2002, 2003 Derek Atkins <warlord at MIT.EDU>
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-
-
-(define-module (gnucash reports standard job-report))
-
-(use-modules (gnucash engine))
-(use-modules (gnucash utilities)) ; for gnc:debug
-(use-modules (gnucash core-utils))
-(use-modules (gnucash app-utils))
-(use-modules (gnucash report))
-(use-modules (srfi srfi-1))
-
-(define acct-string (N_ "Account"))
-(define owner-string (N_ "Job"))
-(define owner-page gnc:pagename-general)
-
-(define date-header (N_ "Date"))
-(define due-date-header (N_ "Due Date"))
-(define reference-header (N_ "Reference"))
-(define type-header (N_ "Type"))
-(define desc-header (N_ "Description"))
-(define amount-header (N_ "Amount"))
-
-(define (date-col columns-used)
- (vector-ref columns-used 0))
-(define (date-due-col columns-used)
- (vector-ref columns-used 1))
-(define (num-col columns-used)
- (vector-ref columns-used 2))
-(define (type-col columns-used)
- (vector-ref columns-used 3))
-(define (memo-col columns-used)
- (vector-ref columns-used 4))
-(define (value-col columns-used)
- (vector-ref columns-used 5))
-
-(define columns-used-size 6)
-
-(define (build-column-used options)
- (define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option options section name)))
- (define (make-set-col col-vector)
- (let ((col 0))
- (lambda (used? index)
- (if used?
- (begin
- (vector-set! col-vector index col)
- (set! col (+ col 1)))
- (vector-set! col-vector index #f)))))
-
- (let* ((col-vector (make-vector columns-used-size #f))
- (set-col (make-set-col col-vector)))
- (set-col (opt-val "Display Columns" date-header) 0)
- (set-col (opt-val "Display Columns" due-date-header) 1)
- (set-col (opt-val "Display Columns" reference-header) 2)
- (set-col (opt-val "Display Columns" type-header) 3)
- (set-col (opt-val "Display Columns" desc-header) 4)
- (set-col (opt-val "Display Columns" amount-header) 5)
- col-vector))
-
-(define (make-heading-list column-vector)
- (let ((heading-list '()))
- (if (date-col column-vector)
- (addto! heading-list (G_ date-header)))
- (if (date-due-col column-vector)
- (addto! heading-list (G_ due-date-header)))
- (if (num-col column-vector)
- (addto! heading-list (G_ reference-header)))
- (if (type-col column-vector)
- (addto! heading-list (G_ type-header)))
- (if (memo-col column-vector)
- (addto! heading-list (G_ desc-header)))
- (if (value-col column-vector)
- (addto! heading-list (G_ amount-header)))
- (reverse heading-list)))
-
-
-(define num-buckets 4)
-(define (new-bucket-vector)
- (make-vector num-buckets (gnc-numeric-zero)))
-
-(define (make-interval-list to-date)
- (let ((begindate to-date))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (gnc:make-date-list begindate to-date ThirtyDayDelta)))
-
-
-(define (make-aging-table options query bucket-intervals reverse? currency)
- (let ((lots (xaccQueryGetLots query QUERY-TXN-MATCH-ANY))
- (buckets (new-bucket-vector))
- (payments (gnc-numeric-zero))
- (table (gnc:make-html-table)))
-
- (define (in-interval this-date current-bucket)
- (< this-date current-bucket))
-
- (define (find-bucket current-bucket bucket-intervals date)
- (begin
- (if (>= current-bucket (vector-length bucket-intervals))
- (gnc:error "sanity check failed in find-bucket")
- (if (in-interval date (vector-ref bucket-intervals current-bucket))
- current-bucket
- (find-bucket (+ current-bucket 1) bucket-intervals date)))))
-
- (define (apply-invoice date value)
- (let* ((bucket-index (find-bucket 0 bucket-intervals date))
- (new-value (gnc-numeric-add-fixed
- value
- (vector-ref buckets bucket-index))))
- (vector-set! buckets bucket-index new-value)))
-
- (define (apply-payment value)
- (set! payments (gnc-numeric-add-fixed value payments)))
-
- (for-each
- (lambda (lot)
- (let* ((bal (gnc-lot-get-balance lot))
- (invoice (gncInvoiceGetInvoiceFromLot lot))
- (post-date (gncInvoiceGetDatePosted invoice)))
-
- (if (not (gnc-numeric-zero-p bal))
- (begin
- (if reverse?
- (set! bal (gnc-numeric-neg bal)))
- (if (not (null? invoice))
- (begin
- (apply-invoice post-date bal))
- (apply-payment bal))))))
- lots)
-
- (gnc:html-table-set-col-headers!
- table
- (list (G_ "0-30 days")
- (G_ "31-60 days")
- (G_ "61-90 days")
- (G_ "91+ days")))
-
- (gnc:html-table-append-row!
- table
- (reverse (map (lambda (entry)
- (gnc:make-gnc-monetary currency entry))
- (vector->list buckets))))
-
- table))
-
-;;
-;; Make a row list based on the visible columns
-;;
-(define (make-row column-vector date due-date num type-str memo monetary)
- (let ((row-contents '()))
- (if (date-col column-vector)
- (addto! row-contents (qof-print-date date)))
- (if (date-due-col column-vector)
- (addto! row-contents
- (if due-date
- (qof-print-date due-date)
- "")))
- (if (num-col column-vector)
- (addto! row-contents num))
- (if (type-col column-vector)
- (addto! row-contents type-str))
- (if (memo-col column-vector)
- (addto! row-contents memo))
- (if (value-col column-vector)
- (addto! row-contents
- (gnc:make-html-table-cell/markup "number-cell" monetary)))
- row-contents))
-
-;;
-;; Adds the 'Balance' row to the table if it has not been printed and
-;; total is not zero
-;;
-;; Returns printed?
-;;
-(define (add-balance-row table column-vector txn odd-row? printed? start-date total)
- (if (not printed?)
- (begin
- (set! printed? #t)
- (if (not (gnc-numeric-zero-p total))
- (let ((row (make-row column-vector start-date #f "" (G_ "Balance") ""
- (gnc:make-gnc-monetary (xaccTransGetCurrency txn) total)))
- (row-style (if odd-row? "normal-row" "alternate-row")))
- (gnc:html-table-append-row/markup! table row-style (reverse row))
- (set! odd-row? (not odd-row?))
- (set! row-style (if odd-row? "normal-row" "alternate-row")))
- )))
- printed?)
-
-;;
-;; Make sure the caller checks the type first and only calls us with
-;; invoice and payment transactions. we don't verify it here.
-;;
-;; Return a list of (printed? value odd-row?)
-;;
-(define (add-txn-row table txn acc column-vector odd-row? printed?
- inv-str reverse? start-date total)
- (let* ((type (xaccTransGetTxnType txn))
- (date (xaccTransGetDate txn))
- (due-date #f)
- (value (xaccTransGetAccountValue txn acc))
- (split (xaccTransGetSplit txn 0))
- (invoice (gncInvoiceGetInvoiceFromTxn txn))
- (currency (xaccTransGetCurrency txn))
- (type-str
- (cond
- ((equal? type TXN-TYPE-INVOICE)
- (if (not (null? invoice))
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:invoice-anchor-text invoice)
- inv-str))
- inv-str))
- ((equal? type TXN-TYPE-PAYMENT) (G_ "Payment, thank you!"))
- (else (G_ "Unknown"))))
- )
-
- (if reverse?
- (set! value (gnc-numeric-neg value)))
-
- (if (< start-date date)
- (begin
-
- ; Adds 'balance' row if needed
- (set! printed? (add-balance-row table column-vector txn odd-row? printed? start-date total))
-
- ; Now print out the invoice row
- (if (and (not (null? invoice))
- (gncInvoiceIsPosted invoice))
- (set! due-date (gncInvoiceGetDateDue invoice)))
-
- (let ((row (make-row column-vector date due-date (gnc-get-num-action txn split)
- type-str (xaccSplitGetMemo split)
- (gnc:make-gnc-monetary currency value)))
- (row-style (if odd-row? "normal-row" "alternate-row")))
-
- (gnc:html-table-append-row/markup! table row-style
- (reverse row)))
-
- (set! odd-row? (not odd-row?))
- ))
-
- (list printed? value odd-row?)
- ))
-
-
-(define (make-txn-table options query acc start-date end-date)
- (let ((txns (xaccQueryGetTransactions query QUERY-TXN-MATCH-ANY))
- (used-columns (build-column-used options))
- (total (gnc-numeric-zero))
- (currency (xaccAccountGetCommodity acc))
- (table (gnc:make-html-table))
- (inv-str (gnc:option-value (gnc:lookup-option options "__reg"
- "inv-str")))
- (reverse? (gnc:option-value (gnc:lookup-option options "__reg"
- "reverse?"))))
-
- (gnc:html-table-set-col-headers!
- table
- (make-heading-list used-columns))
-
- ; Order the transactions properly
- (set! txns (sort txns (lambda (a b) (> 0 (xaccTransOrder a b)))))
-
- (let ((printed? #f)
- (odd-row? #t))
- (for-each
- (lambda (txn)
- (let ((type (xaccTransGetTxnType txn)))
- (if
- (or (equal? type TXN-TYPE-INVOICE)
- (equal? type TXN-TYPE-PAYMENT))
- (let ((result (add-txn-row table txn acc used-columns odd-row? printed?
- inv-str reverse? start-date total)))
-
- (set! printed? (car result))
- (set! total (gnc-numeric-add-fixed total (cadr result)))
- (set! odd-row? (caddr result))
- ))))
- txns)
- ;Balance row may not have been added if all transactions were before
- ;start-date (and no other rows would be added either) so add it now
- (if (not (null? txns))
- (add-balance-row table used-columns (car txns) odd-row? printed? start-date total)
- ))
-
- (gnc:html-table-append-row/markup!
- table
- "grand-total"
- (append (cons (gnc:make-html-table-cell/markup
- "total-label-cell"
- (if (gnc-numeric-negative-p total)
- (G_ "Total Credit")
- (G_ "Total Due")))
- '())
- (list (gnc:make-html-table-cell/size/markup
- 1 (value-col used-columns)
- "total-number-cell"
- (gnc:make-gnc-monetary currency total)))))
-
- (let* ((interval-vec (list->vector (make-interval-list end-date))))
- (gnc:html-table-append-row/markup!
- table
- "grand-total"
- (list (gnc:make-html-table-cell/size/markup
- 1 (+ 1 (value-col used-columns))
- "centered-label-cell"
- (make-aging-table options query interval-vec reverse? currency)))))
-
- table))
-
-(define (options-generator acct-type-list owner-type inv-str reverse?)
-
- (define gnc:*report-options* (gnc:new-options))
-
- (define (gnc:register-inv-option new-option)
- (gnc:register-option gnc:*report-options* new-option))
-
- (gnc:register-inv-option
- (gnc:make-internal-option "__reg" "inv-str" inv-str))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option "__reg" "reverse?" "" "" reverse?))
-
- (gnc:register-inv-option
- (gnc:make-owner-option owner-page owner-string "v"
- (N_ "The job for this report.")
- (lambda () '()) #f owner-type))
-
- (gnc:register-inv-option
- (gnc:make-internal-option "__reg" "owner-type" owner-type))
-
- (gnc:register-inv-option
- (gnc:make-account-sel-limited-option owner-page acct-string "w"
- (N_ "The account to search for transactions.")
- #f #f acct-type-list))
-
- (gnc:options-add-date-interval!
- gnc:*report-options* gnc:pagename-general
- (N_ "From") (N_ "To") "a")
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") date-header
- "b" (N_ "Display the transaction date?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") due-date-header
- "c" (N_ "Display the transaction date?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") reference-header
- "d" (N_ "Display the transaction reference?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") type-header
- "g" (N_ "Display the transaction type?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") desc-header
- "ha" (N_ "Display the transaction description?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") amount-header
- "hb" (N_ "Display the transaction amount?") #t))
-
- (gnc:options-set-default-section gnc:*report-options* "General")
-
- gnc:*report-options*)
-
-(define (job-options-generator)
- (options-generator (list ACCT-TYPE-RECEIVABLE) GNC-OWNER-JOB
- (G_ "Invoice") #f))
-
-(define (setup-query q owner account end-date)
- (let* ((guid (gncOwnerReturnGUID owner)))
-
- (qof-query-add-guid-match
- q
- (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-OWNER
- QOF-PARAM-GUID)
- guid QOF-QUERY-OR)
- (qof-query-add-guid-match
- q
- (list SPLIT-LOT OWNER-FROM-LOT QOF-PARAM-GUID)
- guid QOF-QUERY-OR)
- (qof-query-add-guid-match
- q
- (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-OWNER
- QOF-PARAM-GUID)
- guid QOF-QUERY-OR)
-
- (xaccQueryAddSingleAccountMatch q account QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT q #f end-date #t end-date QOF-QUERY-AND)
- (qof-query-set-book q (gnc-get-current-book))
- q))
-
-(define (make-owner-table owner)
- (let ((table (gnc:make-html-table)))
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 0)
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 0))
-
- (gnc:html-table-append-row!
- table
- (list (gnc:multiline-to-html-text
- (gnc:owner-get-name-and-address-dep owner))))
-
- (gnc:html-table-append-row!
- table (gnc:make-html-text (gnc:html-markup-br)))
-
- (gnc:html-table-set-last-row-style!
- table "td"
- 'attribute (list "valign" "top"))
- table))
-
-(define (make-myname-table book date-format)
- (let* ((table (gnc:make-html-table))
- (name (gnc:company-info book gnc:*company-name*))
- (addy (gnc:company-info book gnc:*company-addy*)))
-
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 0)
- 'attribute (list "align" "right")
- 'attribute (list "valign" "top")
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 0))
-
- (gnc:html-table-append-row! table (list (or name "")))
-
- (gnc:html-table-append-row! table (list (gnc:multiline-to-html-text (or addy ""))))
-
- (gnc:html-table-append-row!
- table (list (gnc-print-time64 (current-time) date-format)))
- table))
-
-(define (make-break! document)
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-br))))
-
-(define (reg-renderer report-obj)
- (define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option (gnc:report-options report-obj) section name)))
-
- (issue-deprecation-warning
- "old job report is deprecated and will be removed in 5.x. Its functionality \
-is now merged into new-owner-report.scm.")
-
- (let* ((document (gnc:make-html-document))
- (table '())
- (orders '())
- (query (qof-query-create-for-splits))
- (account (opt-val owner-page acct-string))
- (owner (opt-val owner-page owner-string))
- (start-date (gnc:time64-start-day-time
- (gnc:date-option-absolute-time
- (opt-val gnc:pagename-general (N_ "From")))))
- (end-date (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
- (opt-val gnc:pagename-general (N_ "To")))))
- (book (gnc-get-current-book))
- (date-format (gnc:options-fancy-date book))
- (type (opt-val "__reg" "owner-type"))
- (type-str "")
- (report-title-str ""))
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER)
- (set! type-str (N_ "Customer"))
- (set! report-title-str (G_ "Customer Report")))
- ((eqv? type GNC-OWNER-JOB)
- (set! type-str (N_ "Job"))
- (set! report-title-str (G_ "Job Report")))
- ((eqv? type GNC-OWNER-VENDOR)
- (set! type-str (N_ "Vendor"))
- (set! report-title-str (G_ "Vendor Report")))
- ((eqv? type GNC-OWNER-EMPLOYEE)
- (set! type-str (N_ "Employee"))
- (set! report-title-str (G_ "Employee Report"))))
-
- (gnc:html-document-set-title! document report-title-str)
-
- (if (gncOwnerIsValid owner)
- (begin
- (setup-query query owner account end-date)
-
- (gnc:html-document-set-title!
- document
- (string-append report-title-str ": " (gncOwnerGetName owner)))
-
- (gnc:html-document-set-headline!
- document (gnc:html-markup
- "span"
- report-title-str ": "
- (gnc:html-markup-anchor
- (gnc:job-anchor-text (gncOwnerGetJob owner))
- (gncOwnerGetName owner))))
-
- (if (not (null? account))
- (begin
- (set! table (make-txn-table (gnc:report-options report-obj)
- query account start-date end-date))
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 1)
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 4)))
-
- (set!
- table
- (gnc:make-html-text
- (G_ "No valid account selected. Click on the Options button and select the account to use."))))
-
- (gnc:html-document-add-object!
- document
- (make-myname-table book date-format))
-
- (gnc:html-document-add-object!
- document
- (make-owner-table owner))
-
- (make-break! document)
-
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (string-append
- (G_ "Date Range")
- ": "
- (qof-print-date start-date)
- " - "
- (qof-print-date end-date))))
-
- (make-break! document)
-
- (gnc:html-document-add-object! document table))
-
- ;; else....
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (string-append
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER)
- (G_ "No valid customer selected."))
- ((eqv? type GNC-OWNER-JOB)
- (G_ "No valid job selected."))
- ((eqv? type GNC-OWNER-VENDOR)
- (G_ "No valid vendor selected."))
- ((eqv? type GNC-OWNER-EMPLOYEE)
- (G_ "No valid employee selected."))
- (else ""))
- " "
- (G_ "Click on the \"Options\" button to select a company.")))))
-
- (qof-query-destroy query)
- document))
-
-(gnc:define-report
- 'version 1
- 'name "Job Report (legacy)"
- 'report-guid "5518ac227e474f47a34439f2d4d049de-old"
- 'menu-path (list gnc:menuname-business-reports)
- 'options-generator job-options-generator
- 'renderer reg-renderer
- 'in-menu? (gnc-prefs-is-extra-enabled))
diff --git a/gnucash/report/reports/standard/owner-report.scm b/gnucash/report/reports/standard/owner-report.scm
deleted file mode 100644
index c2ef11b91..000000000
--- a/gnucash/report/reports/standard/owner-report.scm
+++ /dev/null
@@ -1,861 +0,0 @@
-;; -*-scheme-*-
-;; owner-report.scm -- Print out a detailed owner report, which is a
-;; summary of invoices and payments for a particular
-;; company (the owner) applied to an account.
-;;
-;; Created by: Derek Atkins <warlord at MIT.EDU>
-;; Copyright (c) 2002, 2003 Derek Atkins <warlord at MIT.EDU>
-;; Modified by AMM to show tax figures of invoice.
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-
-
-(define-module (gnucash reports standard owner-report))
-
-(use-modules (srfi srfi-1))
-(use-modules (srfi srfi-8))
-(use-modules (gnucash engine))
-(use-modules (gnucash utilities)) ; for gnc:debug
-(use-modules (gnucash core-utils))
-(use-modules (gnucash app-utils))
-(use-modules (gnucash report))
-
-;; Option names
-(define optname-from-date (N_ "From"))
-(define optname-to-date (N_ "To"))
-(define optname-date-driver (N_ "Due or Post Date"))
-
-;; let's define a name for the report-guid's, much prettier
-(define employee-report-guid "08ae9c2e884b4f9787144f47eacd7f44-old")
-(define vendor-report-guid "d7d1e53505ee4b1b82efad9eacedaea0-old")
-(define customer-report-guid "c146317be32e4948a561ec7fc89d15c1-old")
-
-(define acct-string (N_ "Account"))
-(define owner-page gnc:pagename-general)
-(define date-header (N_ "Date"))
-(define due-date-header (N_ "Due Date"))
-(define reference-header (N_ "Reference"))
-(define type-header (N_ "Type"))
-(define desc-header (N_ "Description"))
-(define sale-header (N_ "Sale"))
-(define tax-header (N_ "Tax"))
-(define credit-header (N_ "Credits"))
-(define debit-header (N_ "Debits"))
-(define amount-header (N_ "Amount"))
-
-;; Depending on the report type we want to set up some lists/cases
-;; with strings to ease overview and translation
-;; note: we default to company
-
-;; owner-string & doctype-str are nearly equivalent, report is vendor report
-;; but default option naming was Company.
-
-;; Names in Option panel (Untranslated! Because it is used for option
-;; naming and lookup only, and the display of the option name will be
-;; translated somewhere else.)
-(define (owner-string owner-type)
- (cond ((eqv? owner-type GNC-OWNER-CUSTOMER) (N_ "Customer"))
- ((eqv? owner-type GNC-OWNER-EMPLOYEE) (N_ "Employee"))
- ;; FALL THROUGH
- (else
- (N_ "Company"))))
-
-;; Error strings in case there is no (valid) selection (translated)
-(define (invalid-selection-title-string owner-type)
- (cond ((eqv? owner-type GNC-OWNER-CUSTOMER) (G_ "No valid customer selected."))
- ((eqv? owner-type GNC-OWNER-EMPLOYEE) (G_ "No valid employee selected."))
- ;; FALL THROUGH
- (else
- (G_ "No valid company selected."))))
-
-(define (invalid-selection-string owner-type)
- (cond ((eqv? owner-type GNC-OWNER-CUSTOMER) (G_ "This report requires a customer to be selected."))
- ((eqv? owner-type GNC-OWNER-EMPLOYEE) (G_ "This report requires a employee to be selected."))
- ;; FALL THROUGH
- (else
- (G_ "This report requires a company to be selected."))))
-
-;; Html formatted error message documents
-(define (gnc:html-make-no-owner-warning
- report-title-string report-id)
- (gnc:html-make-generic-warning
- report-title-string
- report-id
- invalid-selection-title-string
- invalid-selection-string))
-
-(define (gnc:html-make-no-valid-account-warning
- report-title-string report-id)
- (gnc:html-make-generic-warning
- report-title-string
- report-id
- (G_ "No valid account selected")
- (G_ "This report requires a valid account to be selected.")))
-
-
-;; Document names, used in report names (translated)
-(define (doctype-str owner-type)
- (cond ((eqv? owner-type GNC-OWNER-CUSTOMER) (G_ "Customer"))
- ((eqv? owner-type GNC-OWNER-EMPLOYEE) (G_ "Employee"))
- ;; FALL THROUGH
- (else
- (G_ "Vendor"))))
-
-(define (date-col columns-used)
- (vector-ref columns-used 0))
-(define (date-due-col columns-used)
- (vector-ref columns-used 1))
-(define (num-col columns-used)
- (vector-ref columns-used 2))
-(define (type-col columns-used)
- (vector-ref columns-used 3))
-(define (memo-col columns-used)
- (vector-ref columns-used 4))
-(define (sale-col columns-used)
- (vector-ref columns-used 5))
-(define (tax-col columns-used)
- (vector-ref columns-used 6))
-(define (credit-col columns-used)
- (vector-ref columns-used 7))
-(define (debit-col columns-used)
- (vector-ref columns-used 8))
-(define (value-col columns-used)
- (vector-ref columns-used 9))
-
-(define columns-used-size 10)
-
-(define (build-column-used options)
- (define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option options section name)))
- (define (make-set-col col-vector)
- (let ((col 0))
- (lambda (used? index)
- (if used?
- (begin
- (vector-set! col-vector index col)
- (set! col (+ col 1)))
- (vector-set! col-vector index #f)))))
-
- (let* ((col-vector (make-vector columns-used-size #f))
- (set-col (make-set-col col-vector)))
- (set-col (opt-val "Display Columns" date-header) 0)
- (set-col (opt-val "Display Columns" due-date-header) 1)
- (set-col (opt-val "Display Columns" reference-header) 2)
- (set-col (opt-val "Display Columns" type-header) 3)
- (set-col (opt-val "Display Columns" desc-header) 4)
- (set-col (opt-val "Display Columns" sale-header) 5)
- (set-col (opt-val "Display Columns" tax-header) 6)
- (set-col (opt-val "Display Columns" credit-header) 7)
- (set-col (opt-val "Display Columns" debit-header) 8)
- (set-col (opt-val "Display Columns" amount-header) 9)
- col-vector))
-
-(define (make-heading-list column-vector)
- (let ((heading-list '()))
- (if (date-col column-vector)
- (addto! heading-list (G_ date-header)))
- (if (date-due-col column-vector)
- (addto! heading-list (G_ due-date-header)))
- (if (num-col column-vector)
- (addto! heading-list (G_ reference-header)))
- (if (type-col column-vector)
- (addto! heading-list (G_ type-header)))
- (if (memo-col column-vector)
- (addto! heading-list (G_ desc-header)))
- (if (sale-col column-vector)
- (addto! heading-list (G_ sale-header)))
- (if (tax-col column-vector)
- (addto! heading-list (G_ tax-header)))
- (if (credit-col column-vector)
- (addto! heading-list (G_ credit-header)))
- (if (debit-col column-vector)
- (addto! heading-list (G_ debit-header)))
- (if (value-col column-vector)
- (addto! heading-list (G_ amount-header)))
- (reverse heading-list)))
-
-
-(define num-buckets 5)
-(define (new-bucket-vector)
- (make-vector num-buckets (gnc-numeric-zero)))
-
-(define (make-interval-list to-date)
- (let ((begindate to-date))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (set! begindate (decdate begindate ThirtyDayDelta))
- (gnc:make-date-list begindate to-date ThirtyDayDelta)))
-
-;; Have make-list create a stepped list, then add a date in the future for the "current" bucket
-(define (make-extended-interval-list to-date)
- (define dayforcurrent (incdate to-date YearDelta)) ;; MAGIC CONSTANT
- (define oldintervalreversed (reverse (make-interval-list to-date)))
- (reverse (cons dayforcurrent oldintervalreversed)))
-
-(define (make-aging-table options query bucket-intervals reverse? date-type currency)
- (let ((lots (xaccQueryGetLots query QUERY-TXN-MATCH-ANY))
- (buckets (new-bucket-vector))
- (payments (gnc-numeric-zero))
- (table (gnc:make-html-table)))
-
- (define (in-interval this-date current-bucket)
- (< this-date current-bucket))
-
- (define (find-bucket current-bucket bucket-intervals date)
- (begin
- (if (>= current-bucket (vector-length bucket-intervals))
- (gnc:error "sanity check failed in find-bucket")
- (if (in-interval date (vector-ref bucket-intervals current-bucket))
- current-bucket
- (find-bucket (+ current-bucket 1) bucket-intervals date)))))
-
- (define (apply-invoice date value)
- (let* ((bucket-index (find-bucket 0 bucket-intervals date))
- (new-value (gnc-numeric-add-fixed
- value
- (vector-ref buckets bucket-index))))
- (vector-set! buckets bucket-index new-value)))
-
- (define (apply-payment value)
- (set! payments (gnc-numeric-add-fixed value payments)))
-
- (for-each
- (lambda (lot)
- (let* ((bal (gnc-lot-get-balance lot))
- (invoice (gncInvoiceGetInvoiceFromLot lot))
- (date (if (eq? date-type 'postdate)
- (gncInvoiceGetDatePosted invoice)
- (gncInvoiceGetDateDue invoice)))
- )
-
- (if (not (gnc-numeric-zero-p bal))
- (begin
- (if reverse?
- (set! bal (gnc-numeric-neg bal)))
- (if (not (null? invoice))
- (begin
- (apply-invoice date bal))
- (apply-payment bal))))))
- lots)
-
- (gnc:html-table-set-col-headers!
- table
- (list (G_ "Current")
- (G_ "0-30 days")
- (G_ "31-60 days")
- (G_ "61-90 days")
- (G_ "91+ days")))
-
- (gnc:html-table-append-row!
- table
- (reverse (map (lambda (entry)
- (gnc:make-gnc-monetary currency entry))
- (vector->list buckets))))
-
- table))
-
-;;
-;; Make a row list based on the visible columns
-;;
-(define (make-row column-vector date due-date num type-str memo monetary credit debit sale tax)
- (let ((row-contents '()))
- (if (date-col column-vector)
- (addto! row-contents (qof-print-date date)))
- (if (date-due-col column-vector)
- (addto! row-contents
- (if due-date
- (qof-print-date due-date)
- "")))
- (if (num-col column-vector)
- (addto! row-contents (gnc:html-string-sanitize num)))
- (if (type-col column-vector)
- (addto! row-contents type-str))
- (if (memo-col column-vector)
- (addto! row-contents (gnc:html-string-sanitize memo)))
- (if (sale-col column-vector)
- (addto! row-contents
- (gnc:make-html-table-cell/markup "number-cell" sale)))
- (if (tax-col column-vector)
- (addto! row-contents
- (gnc:make-html-table-cell/markup "number-cell" tax)))
- (if (credit-col column-vector)
- (addto! row-contents
- (gnc:make-html-table-cell/markup "number-cell" credit)))
- (if (debit-col column-vector)
- (addto! row-contents
- (gnc:make-html-table-cell/markup "number-cell" debit)))
- (if (value-col column-vector)
- (addto! row-contents
- (gnc:make-html-table-cell/markup "number-cell" monetary)))
- row-contents))
-
-;;
-;; Adds the 'Balance' row to the table if it has not been printed and
-;; total is not zero
-;;
-;; Returns printed?
-;;
-(define (add-balance-row table column-vector txn odd-row? printed? start-date total)
- (if (not printed?)
- (begin
- (set! printed? #t)
- (if (and (value-col column-vector) (not (gnc-numeric-zero-p total)))
- (let ((row (make-row column-vector start-date #f "" (G_ "Balance") ""
- (gnc:make-gnc-monetary (xaccTransGetCurrency txn) total) "" "" "" ""))
- (row-style (if odd-row? "normal-row" "alternate-row")))
- (gnc:html-table-append-row/markup! table row-style (reverse row))
- (set! odd-row? (not odd-row?))
- (set! row-style (if odd-row? "normal-row" "alternate-row")))
- )))
- printed?)
-
-;;
-;; Make sure the caller checks the type first and only calls us with
-;; invoice and payment transactions. we don't verify it here.
-;;
-;; Return a list of (printed? value odd-row?)
-;;
-(define (add-txn-row table txn acc column-vector odd-row? printed?
- reverse? start-date total)
- (let* ((type (xaccTransGetTxnType txn))
- (date (xaccTransGetDate txn))
- (due-date #f)
- (value (xaccTransGetAccountValue txn acc))
- (sale (gnc-numeric-zero))
- (tax (gnc-numeric-zero))
- (split (xaccTransGetSplit txn 0))
- (invoice (gncInvoiceGetInvoiceFromTxn txn))
- (currency (xaccTransGetCurrency txn))
- (type-str
- (cond
- ((equal? type TXN-TYPE-INVOICE)
- (if (not (null? invoice))
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:invoice-anchor-text invoice)
- (gncInvoiceGetTypeString invoice)))
- (G_ "Unknown")))
- ((equal? type TXN-TYPE-PAYMENT)
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:split-anchor-text split) (G_ "Payment"))))
- (else (G_ "Unknown"))))
- )
-
- (if reverse?
- (set! value (gnc-numeric-neg value)))
-
- (if (<= start-date date)
- (begin
-
- ; Adds 'balance' row if needed
- (set! printed? (add-balance-row table column-vector txn odd-row? printed? start-date total))
-
- ; Now print out the invoice row
- (if (not (null? invoice))
- (begin
- (set! due-date (and (gncInvoiceIsPosted invoice)
- (gncInvoiceGetDateDue invoice)))
- (set! sale (gncInvoiceGetTotalSubtotal invoice))
- (set! tax (gncInvoiceGetTotalTax invoice))))
-
- (if (gncInvoiceGetIsCreditNote invoice)
- (begin
- (set! tax (gnc-numeric-neg tax))
- (set! sale (gnc-numeric-neg sale))))
-
- (let ((row (make-row column-vector date due-date (gnc-get-num-action txn split)
- type-str (xaccSplitGetMemo split)
- (gnc:make-gnc-monetary currency value)
- (if (not (gnc-numeric-negative-p value))
- (gnc:make-gnc-monetary currency value) "")
- (if (gnc-numeric-negative-p value)
- (gnc:make-gnc-monetary currency value) "")
- (if (not (null? invoice))
- (gnc:make-gnc-monetary currency sale) "")
- (if (not (null? invoice))
- (gnc:make-gnc-monetary currency tax) "")
- ))
- (row-style (if odd-row? "normal-row" "alternate-row")))
-
- (gnc:html-table-append-row/markup! table row-style
- (reverse row)))
-
- (set! odd-row? (not odd-row?))
- ))
-
- (list printed? value odd-row? sale tax)
- ))
-
-
-(define (make-txn-table options query acc start-date end-date date-type)
- (let ((txns (xaccQueryGetTransactions query QUERY-TXN-MATCH-ANY))
- (used-columns (build-column-used options))
- (total (gnc-numeric-zero))
- (debit (gnc-numeric-zero))
- (credit (gnc-numeric-zero))
-
- (tax (gnc-numeric-zero))
- (sale (gnc-numeric-zero))
- (currency (xaccAccountGetCommodity acc))
- (table (gnc:make-html-table))
- (reverse? (gnc:option-value (gnc:lookup-option options "__reg"
- "reverse?"))))
-
- (gnc:html-table-set-col-headers!
- table
- (make-heading-list used-columns))
-
- ; Order the transactions properly
- (set! txns (sort txns (lambda (a b) (> 0 (xaccTransOrder a b)))))
-
- (let ((printed? #f)
- (odd-row? #t))
- (for-each
- (lambda (txn)
- (let ((type (xaccTransGetTxnType txn)))
- (if
- (or (equal? type TXN-TYPE-INVOICE)
- (equal? type TXN-TYPE-PAYMENT))
- (let ((result (add-txn-row table txn acc used-columns odd-row? printed?
- reverse? start-date total)))
-
- (set! printed? (car result))
- (if (and printed? total)
- (begin
- (set! sale (gnc-numeric-add-fixed sale (cadddr result)))
- (set! tax (gnc-numeric-add-fixed tax (car (cddddr result))))
- (if (gnc-numeric-negative-p (cadr result))
- (set! debit (gnc-numeric-add-fixed debit (cadr result)))
- (set! credit (gnc-numeric-add-fixed credit (cadr result))))))
- (set! total (gnc-numeric-add-fixed total (cadr result)))
- (set! odd-row? (caddr result))
- ))))
- txns)
- ;Balance row may not have been added if all transactions were before
- ;start-date (and no other rows would be added either) so add it now
- (if (not (null? txns))
- (add-balance-row table used-columns (car txns) odd-row? printed? start-date total)
- ))
-
- (if (or (sale-col used-columns) (tax-col used-columns) (credit-col used-columns) (debit-col used-columns))
- (gnc:html-table-append-row/markup!
- table
- "grand-total"
- (append (cons (gnc:make-html-table-cell/markup
- "total-label-cell"
- (G_ "Period Totals"))
- '())
-
- (let ((row-contents '())
- (pre-span 0))
-
- ; HTML gets generated in reverse order
- (if (value-col used-columns) (addto! row-contents
- (gnc:make-html-table-cell/size/markup
- 1 1 "total-number-cell"
- (gnc:make-gnc-monetary currency (gnc-numeric-add-fixed credit debit)))))
- (if (debit-col used-columns) (addto! row-contents
- (gnc:make-html-table-cell/size/markup
- 1 1 "total-number-cell"
- (gnc:make-gnc-monetary currency debit))))
- (if (credit-col used-columns) (addto! row-contents
- (gnc:make-html-table-cell/size/markup
- 1 1 "total-number-cell"
- (gnc:make-gnc-monetary currency credit))))
- (if (tax-col used-columns) (addto! row-contents
- (gnc:make-html-table-cell/size/markup
- 1 1 "total-number-cell"
- (gnc:make-gnc-monetary currency tax))))
- (if (sale-col used-columns) (addto! row-contents
- (gnc:make-html-table-cell/size/markup
- 1 1 "total-number-cell"
- (gnc:make-gnc-monetary currency sale))))
- (if (memo-col used-columns) (set! pre-span (+ pre-span 1)))
- (if (type-col used-columns) (set! pre-span (+ pre-span 1)))
- (if (num-col used-columns) (set! pre-span (+ pre-span 1)))
- (if (date-due-col used-columns) (set! pre-span (+ pre-span 1)))
- (if (date-col used-columns) (set! pre-span (+ pre-span 1)))
- (if (>= pre-span 2) (addto! row-contents (gnc:make-html-table-cell/size 1 (- pre-span 1) "")))
- row-contents))))
-
- (if (value-col used-columns)
- (gnc:html-table-append-row/markup!
- table
- "grand-total"
- (append (cons (gnc:make-html-table-cell/markup
- "total-label-cell"
- (if (gnc-numeric-negative-p total)
- (G_ "Total Credit")
- (G_ "Total Due")))
- '())
- (list (gnc:make-html-table-cell/size/markup
- 1 (value-col used-columns)
- "total-number-cell"
- (gnc:make-gnc-monetary currency total))))))
-
- (let* ((interval-vec (list->vector (make-extended-interval-list end-date))))
- (gnc:html-table-append-row/markup!
- table
- "grand-total"
- (list (gnc:make-html-table-cell/size
- 1 columns-used-size
- (make-aging-table options query interval-vec reverse? date-type currency)))))
-
- table))
-
-(define (options-generator acct-type-list owner-type reverse?)
-
- (define gnc:*report-options* (gnc:new-options))
-
- (define (gnc:register-inv-option new-option)
- (gnc:register-option gnc:*report-options* new-option))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option "__reg" "reverse?" "" "" reverse?))
-
- (gnc:register-inv-option
- (gnc:make-owner-option owner-page (owner-string owner-type) "v"
- (N_ "The company for this report.")
- (lambda () '()) #f owner-type))
-
- (gnc:register-inv-option
- (gnc:make-internal-option "__reg" "owner-type" owner-type))
-
- (gnc:register-inv-option
- (gnc:make-account-sel-limited-option owner-page acct-string "w"
- (N_ "The account to search for transactions.")
- #f #f acct-type-list))
-
- (gnc:options-add-date-interval!
- gnc:*report-options* gnc:pagename-general
- optname-from-date optname-to-date "a")
- ;; Use a default report date of 'today'
- (gnc:option-set-default-value
- (gnc:lookup-option gnc:*report-options* gnc:pagename-general optname-to-date)
- (cons 'relative 'today))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") date-header
- "b" (N_ "Display the transaction date?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") due-date-header
- "c" (N_ "Display the transaction date?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") reference-header
- "d" (N_ "Display the transaction reference?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") type-header
- "g" (N_ "Display the transaction type?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") desc-header
- "ha" (N_ "Display the transaction description?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") sale-header
- "haa" (N_ "Display the sale amount column?") #f))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") tax-header
- "hab" (N_ "Display the tax column?") #f))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") credit-header
- "hac" (N_ "Display the period credits column?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") debit-header
- "had" (N_ "Display the period debits column?") #t))
-
- (gnc:register-inv-option
- (gnc:make-simple-boolean-option
- (N_ "Display Columns") amount-header
- "hb" (N_ "Display the transaction amount?") #t))
-
- (gnc:register-inv-option
- (gnc:make-multichoice-option
- gnc:pagename-general
- optname-date-driver
- "k"
- (N_ "Leading date.")
- 'duedate
- (list
- (vector 'duedate (N_ "Due Date") (N_ "Due date is leading.")) ;; Should be using standard label for due date?
- (vector 'postdate (N_ "Post Date") (N_ "Post date is leading."))))) ;; Should be using standard label for post date?
-
- (gnc:options-set-default-section gnc:*report-options* "General")
-
- gnc:*report-options*)
-
-(define (customer-options-generator)
- (options-generator (list ACCT-TYPE-RECEIVABLE) GNC-OWNER-CUSTOMER #f))
-
-(define (vendor-options-generator)
- (options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-VENDOR #t))
-
-(define (employee-options-generator)
- (options-generator (list ACCT-TYPE-PAYABLE) GNC-OWNER-EMPLOYEE #t))
-
-(define (setup-query q owner account end-date)
- (let* ((guid (gncOwnerReturnGUID (gncOwnerGetEndOwner owner))))
-
- (qof-query-add-guid-match
- q
- (list SPLIT-TRANS INVOICE-FROM-TXN INVOICE-OWNER
- OWNER-PARENTG)
- guid QOF-QUERY-OR)
- (qof-query-add-guid-match
- q
- (list SPLIT-LOT OWNER-FROM-LOT OWNER-PARENTG)
- guid QOF-QUERY-OR)
- (qof-query-add-guid-match
- q
- (list SPLIT-LOT INVOICE-FROM-LOT INVOICE-OWNER
- OWNER-PARENTG)
- guid QOF-QUERY-OR)
-
- (xaccQueryAddSingleAccountMatch q account QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT q #f end-date #t end-date QOF-QUERY-AND)
- (qof-query-set-book q (gnc-get-current-book))
- q))
-
-(define (make-owner-table owner)
- (let ((table (gnc:make-html-table)))
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 0)
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 0))
-
- (gnc:html-table-append-row!
- table (gnc:multiline-to-html-text (gnc:owner-get-name-and-address-dep owner)))
-
- (gnc:html-table-append-row!
- table (gnc:make-html-text (gnc:html-markup-br)))
-
- (gnc:html-table-set-last-row-style!
- table "td"
- 'attribute (list "valign" "top"))
-
- table))
-
-(define (make-date-row! table label date)
- (gnc:html-table-append-row!
- table
- (list
- (string-append label ": ")
- (qof-print-date date))))
-
-(define (make-date-table)
- (let ((table (gnc:make-html-table)))
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 0)
- 'attribute (list "cellpadding" 0))
- (gnc:html-table-set-last-row-style!
- table "td"
- 'attribute (list "valign" "top"))
- table))
-
-(define (make-myname-table book date-format)
- (let* ((table (gnc:make-html-table))
- (name (gnc:company-info book gnc:*company-name*))
- (addy (gnc:company-info book gnc:*company-addy*)))
-
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 0)
- 'attribute (list "align" "right")
- 'attribute (list "valign" "top")
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 0))
-
- (gnc:html-table-append-row! table (list (or name "")))
-
- (gnc:html-table-append-row!
- table (list (gnc:multiline-to-html-text (or addy ""))))
-
- (gnc:html-table-append-row!
- table (list (gnc-print-time64 (gnc:get-today) date-format)))
-
- table))
-
-(define (make-break! document)
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (gnc:html-markup-br))))
-
-(define (reg-renderer report-obj)
- (define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option (gnc:report-options report-obj) section name)))
-
- (issue-deprecation-warning
- "old owner reports are deprecated and will be removed in 5.x")
-
- (let* ((document (gnc:make-html-document))
- (table '())
- (orders '())
- (query (qof-query-create-for-splits))
- (account (opt-val owner-page acct-string))
- (start-date (gnc:time64-start-day-time
- (gnc:date-option-absolute-time
- (opt-val gnc:pagename-general optname-from-date))))
- (end-date (gnc:time64-end-day-time
- (gnc:date-option-absolute-time
- (opt-val gnc:pagename-general optname-to-date))))
- (book (gnc-get-current-book))
- (date-format (gnc:options-fancy-date book))
- (type (opt-val "__reg" "owner-type"))
- (owner-descr (owner-string type))
- (date-type (opt-val gnc:pagename-general optname-date-driver))
- (owner (opt-val owner-page owner-descr))
- (report-title (string-append (doctype-str type) " " (G_ "Report"))))
- (if (not (gncOwnerIsValid owner))
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-owner-warning
- report-title (gnc:report-id report-obj)))
-
- ;; else....
- (begin
- (set! report-title (string-append report-title ": " (gncOwnerGetName owner)))
- (if (null? account)
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-valid-account-warning
- report-title (gnc:report-id report-obj)))
-
- ;; else....
- (begin
- (setup-query query owner account end-date)
- (gnc:html-document-set-title! document report-title)
-
- (gnc:html-document-set-headline!
- document (gnc:html-markup
- "span"
- (doctype-str type)
- " " (G_ "Report:") " "
- (gnc:html-markup-anchor
- (gnc:owner-anchor-text owner)
- (gncOwnerGetName owner))))
-
- (set! table (make-txn-table (gnc:report-options report-obj)
- query account start-date end-date date-type))
- (gnc:html-table-set-style!
- table "table"
- 'attribute (list "border" 1)
- 'attribute (list "cellspacing" 0)
- 'attribute (list "cellpadding" 4))
-
- (gnc:html-document-add-object!
- document
- (make-myname-table book date-format))
-
- (gnc:html-document-add-object!
- document
- (make-owner-table owner))
-
- (make-break! document)
-
- (gnc:html-document-add-object!
- document
- (gnc:make-html-text
- (string-append
- (G_ "Date Range")
- ": "
- (qof-print-date start-date)
- " - "
- (qof-print-date end-date))))
-
- (make-break! document)
-
- (gnc:html-document-add-object! document table)
- (qof-query-destroy query)))))
- document))
-
-(define* (find-first-account type #:key currency)
- (or (find
- (lambda (acc)
- (and (eqv? type (xaccAccountGetType acc))
- (or (not currency)
- (gnc-commodity-equiv currency (xaccAccountGetCommodity acc)))))
- (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
- '()))
-
-(define* (find-first-account-for-owner owner #:key currency)
- (let ((type (gncOwnerGetType (gncOwnerGetEndOwner owner))))
- (cond
- ((eqv? type GNC-OWNER-CUSTOMER)
- (find-first-account ACCT-TYPE-RECEIVABLE #:currency currency))
-
- ((eqv? type GNC-OWNER-VENDOR)
- (find-first-account ACCT-TYPE-PAYABLE #:currency currency))
-
- ((eqv? type GNC-OWNER-EMPLOYEE)
- (find-first-account ACCT-TYPE-PAYABLE #:currency currency))
-
- ((eqv? type GNC-OWNER-JOB)
- (find-first-account-for-owner (gncOwnerGetEndOwner owner)
- #:currency currency))
-
- (else
- '()))))
-
-(gnc:define-report
- 'version 1
- 'name "Customer Report (legacy)"
- 'report-guid customer-report-guid
- 'menu-path (list gnc:menuname-business-reports)
- 'options-generator customer-options-generator
- 'renderer reg-renderer
- 'in-menu? (gnc-prefs-is-extra-enabled))
-
-(gnc:define-report
- 'version 1
- 'name "Vendor Report (legacy)"
- 'report-guid vendor-report-guid
- 'menu-path (list gnc:menuname-business-reports)
- 'options-generator vendor-options-generator
- 'renderer reg-renderer
- 'in-menu? (gnc-prefs-is-extra-enabled))
-
-(gnc:define-report
- 'version 1
- 'name "Employee Report (legacy)"
- 'report-guid employee-report-guid
- 'menu-path (list gnc:menuname-business-reports)
- 'options-generator employee-options-generator
- 'renderer reg-renderer
- 'in-menu? (gnc-prefs-is-extra-enabled))
-
diff --git a/gnucash/report/reports/standard/payables.scm b/gnucash/report/reports/standard/payables.scm
deleted file mode 100644
index 31aeb7d02..000000000
--- a/gnucash/report/reports/standard/payables.scm
+++ /dev/null
@@ -1,81 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; payables.scm : accounts payable aging report
-;;
-;; By Derek Atkins <warlord at MIT.EDU>
-;; Copyright (c) 2002, 2003 Derek Atkins <warlord at MIT.EDU>
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash reports standard payables))
-
-(use-modules (gnucash engine))
-(use-modules (gnucash utilities))
-(use-modules (gnucash core-utils))
-(use-modules (gnucash app-utils))
-(use-modules (gnucash report))
-(use-modules (gnucash reports aging))
-
-(define acc-page gnc:pagename-general)
-(define this-acc (N_ "Payable Account"))
-
-(define (options-generator)
- (let* ((options (gnc:new-options))
- (add-option
- (lambda (new-option)
- (gnc:register-option options new-option))))
-
- (add-option
- (gnc:make-account-sel-limited-option
- acc-page this-acc
- "w" (N_ "The payable account you wish to examine.")
- #f #f (list ACCT-TYPE-PAYABLE)))
-
- ;; As aging.scm functions are used by both receivables.scm and payables.scm
- ;; add option "receivable" on hidden page "__hidden" with default value 'P
- ;; so aging.scm functions can tell if they are reporting on
- ;; accounts receivable or payable, as customers have a shipping address
- ;; but vendors do not. The Address Source option therefore only applies
- ;; to customers.
- (add-option
- (gnc:make-internal-option "__hidden" "receivable-or-payable" 'P))
-
- (aging-options-generator options)))
-
-(define (payables-renderer report-obj)
- (define (opt-val section name)
- (gnc:option-value
- (gnc:lookup-option (gnc:report-options report-obj) section name)))
-
- (let ((payables-account (opt-val acc-page this-acc)))
- (gnc:debug "payables-account" payables-account)
- (aging-renderer report-obj this-acc payables-account #f)))
-
-(define payables-aging-guid "e57770f2dbca46619d6dac4ac5469b50-old")
-
-;; Here we define the actual report with gnc:define-report
-(gnc:define-report
- 'version 1
- 'name "Payable Aging (legacy)"
- 'report-guid payables-aging-guid
- 'menu-path (list gnc:menuname-business-reports)
- 'options-generator options-generator
- 'renderer payables-renderer
- 'in-menu? (gnc-prefs-is-extra-enabled))
-
diff --git a/gnucash/report/reports/standard/receivables.scm b/gnucash/report/reports/standard/receivables.scm
deleted file mode 100644
index 519d5514f..000000000
--- a/gnucash/report/reports/standard/receivables.scm
+++ /dev/null
@@ -1,94 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; receivables.scm : accounts receivable aging report
-;;
-;; By Derek Atkins <warlord at MIT.EDU>
-;; Copyright (c) 2002, 2003 Derek Atkins <warlord at MIT.EDU>
-;;
-;; 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
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash reports standard receivables))
-
-(use-modules (gnucash engine))
-(use-modules (gnucash utilities))
-(use-modules (gnucash core-utils))
-(use-modules (gnucash app-utils))
-(use-modules (gnucash report))
-(use-modules (gnucash reports aging))
-
-(define acc-page gnc:pagename-general)
-(define this-acc (N_ "Receivables Account"))
-(define optname-addr-source (N_ "Address Source")) ;; Billing or Shipping addresses
-
-(define (options-generator)
- (let* ((options (gnc:new-options))
- (add-option
- (lambda (new-option)
- (gnc:register-option options new-option))))
-
- (add-option
- (gnc:make-account-sel-limited-option
- acc-page this-acc
- "w" (N_ "The receivables account you wish to examine.")
- #f #f (list ACCT-TYPE-RECEIVABLE)))
-
- ;; As aging.scm functions are used by both receivables.scm and payables.scm
- ;; add option "receivable" on hidden page "__hidden" with default value 'R
- ;; so aging.scm functions can tell if they are reporting on
- ;; accounts receivable or payable, as customers have a shipping address
- ;; but vendors do not. The Address Source option therefore only applies
- ;; to customers.
- (add-option
- (gnc:make-internal-option "__hidden" "receivable-or-payable" 'R))
-
- (add-option
- (gnc:make-multichoice-option
- gnc:pagename-display
- optname-addr-source
- "a"
- (N_ "Address source.")
- 'billing
- (list
- (vector 'billing (N_ "Billing") (N_ "Address fields from billing address."))
- (vector 'shipping (N_ "Shipping") (N_ "Address fields from shipping address.")))))
-
- (aging-options-generator options)))
-
-(define (receivables-renderer report-obj)
- (define (op-value section name)
- (gnc:option-value
- (gnc:lookup-option (gnc:report-options report-obj) section name)))
-
- (let* ((receivables-account (op-value acc-page this-acc)))
- (gnc:debug "receivables-account" receivables-account)
-
- (aging-renderer report-obj this-acc receivables-account #t)))
-
-(define receivables-aging-guid "9cf76bed17f14401b8e3e22d0079cb98-old")
-
-;; Here we define the actual report with gnc:define-report
-(gnc:define-report
- 'version 1
- 'name "Receivable Aging (legacy)"
- 'report-guid receivables-aging-guid
- 'menu-path (list gnc:menuname-business-reports)
- 'options-generator options-generator
- 'renderer receivables-renderer
- 'in-menu? (gnc-prefs-is-extra-enabled))
-
diff --git a/gnucash/report/reports/standard/test/test-owner-report.scm b/gnucash/report/reports/standard/test/test-owner-report.scm
index a5bdc4273..825777ff5 100644
--- a/gnucash/report/reports/standard/test/test-owner-report.scm
+++ b/gnucash/report/reports/standard/test/test-owner-report.scm
@@ -14,11 +14,7 @@
(use-modules (system vm vm))
(define uuid-list
- (list (cons 'employee "08ae9c2e884b4f9787144f47eacd7f44-old")
- (cons 'vendor "d7d1e53505ee4b1b82efad9eacedaea0-old")
- (cons 'customer "c146317be32e4948a561ec7fc89d15c1-old")
- (cons 'customer-new "c146317be32e4948a561ec7fc89d15c1")
- (cons 'job "5518ac227e474f47a34439f2d4d049de-old")))
+ (list (cons 'customer-new "c146317be32e4948a561ec7fc89d15c1")))
(setlocale LC_ALL "C")
@@ -301,32 +297,6 @@
(gnc-dmy2time64 22 06 1980) ;due
"inv $3 CN" #t #f))
- ;; (gnc:dump-book) (newline)
- ;; (gnc:dump-invoices) (newline)
- (display "customer-report tests:\n")
- (test-begin "customer-report")
- (let* ((options (default-testing-options 'customer owner-1 (get-acct "AR-USD")))
- (sxml (options->sxml 'customer options "customer-report basic")))
- (test-equal "inv-descriptions"
- '("inv >90 $11.50" "inv 60-90 $7.50" "inv 30-60 $8.50"
- "inv >90 payment" "inv >90 payment" "inv <30days $4.00"
- "inv $200" "inv $200" "inv current $6.75" "inv $3 CN"
- "$31.75" "$8.00" "$8.00")
- (sxml-get-row-col sxml #f 5))
- (test-equal "debit-amounts"
- '("$11.50" "$7.50" "$8.50" "$4.00" "$200.00" "$6.75")
- (sxml-get-row-col sxml #f 6))
- (test-equal "crebit-amounts"
- '("-$1.50" "-$2.00" "-$200.00" "-$3.00")
- (sxml-get-row-col sxml #f 7))
- ;; from the report, find the 3rd table, last row, find embedded
- ;; table, retrieve tr contents
- (test-equal "aging-table"
- '("$6.75" "$1.00" "$8.50" "$7.50" "$8.00")
- ((sxpath `(// (table 3) // (tr -1) // table // tbody // tr // *text*))
- sxml)))
- (test-end "customer-report")
-
(display "new-owner-report tests:\n")
(test-begin "new-customer-report")
(let* ((options (default-testing-options 'customer-new
@@ -371,29 +341,4 @@
'("$0.00" "$6.75" "$1.00" "$8.50" "$7.50" "$8.00" "$31.75")
((sxpath `(// (table 3) // (tr -1) // table // tbody // tr // *text*))
sxml)))
- (test-end "new-customer-report")
-
- (display "job-report tests:\n")
- ;; inv for job
- (let ((inv-2-copy (gncInvoiceCopy inv-2)))
- (gncInvoiceAddEntry inv-2-copy (entry 25/4))
- (gncInvoicePostToAccount inv-2-copy
- (get-acct "AR-USD") ;post-to acc
- (gnc-dmy2time64 13 05 1980) ;posted
- (gnc-dmy2time64 18 06 1980) ;due
- "inv for job" #t #f)
- (gncInvoiceApplyPayment
- inv-2-copy '() (get-acct "Bank-USD") 25/4 1
- (gnc-dmy2time64 18 06 1980)
- "inv for job" "fully paid"))
-
- (test-begin "job-report")
- (let* ((options (default-testing-options 'job owner-2 (get-acct "AR-USD")))
- (sxml (options->sxml 'job options "job-report basic")))
- (test-equal "inv-descriptions"
- '("inv for job" "inv for job")
- (sxml-get-row-col sxml #f 5))
- (test-equal "amounts"
- '("$6.25" "-$6.25")
- (sxml-get-row-col sxml #f 6)))
- (test-end "job-report")))
+ (test-end "new-customer-report")))
diff --git a/gnucash/report/test/test-report-html.scm b/gnucash/report/test/test-report-html.scm
index 7e5b75c7c..8fe3d406d 100644
--- a/gnucash/report/test/test-report-html.scm
+++ b/gnucash/report/test/test-report-html.scm
@@ -703,39 +703,14 @@ HTML Document Title</title></head><body></body>\n\
)
)
(test-end "HTML Table - Cell Access and Edit")
- (test-begin "HTML Table - Append Columns")
- (let (
- (test-doc (gnc:make-html-document))
- (test-table (gnc:make-html-table))
- )
- (gnc:html-table-set-caption! test-table #t)
- (gnc:html-table-append-row! test-table "r1c1")
- (gnc:html-table-append-row! test-table '("r2c1" "r2c2" "r2c3"))
- (gnc:html-table-append-row! test-table '("r3c1" "r3c2"))
- (gnc:html-table-append-column! test-table '("r1c4" "r2c4" "r3c4" "r4c4"))
- (test-equal "HTML Table - Check Num Rows after append column"
- 4
- (gnc:html-table-num-rows test-table)
- )
- (test-equal "HTML Table - Check data after append column"
- '((#f #f #f "r4c4") ("r3c1" "r3c2" #f "r3c4") ("r2c1" "r2c2" "r2c3" "r2c4") ("r1c1" #f #f "r1c4"))
- (gnc:html-table-data test-table)
- )
- (test-equal "HTML Table - Check Cell Access after append column"
- "r3c2"
- (gnc:html-table-get-cell test-table 2 1)
- )
- )
- (test-end "HTML Table - Append Columns")
(test-begin "HTML Table - Table Rendering")
(let (
(test-doc (gnc:make-html-document))
(test-table (gnc:make-html-table))
)
(gnc:html-table-set-caption! test-table #t)
- (gnc:html-table-append-row! test-table "Row 1")
- (gnc:html-table-append-row! test-table "Row 2")
- (gnc:html-table-append-column! test-table '("Col A" "Col B"))
+ (gnc:html-table-append-row! test-table '("Row 1" "Col A"))
+ (gnc:html-table-append-row! test-table '("Row 2" "Col B"))
(test-equal "HTML Table - Check table rendering result"
"<table><caption><boolean> #t</caption>\n\
<tbody>\
diff --git a/gnucash/report/test/test-report-utilities.scm b/gnucash/report/test/test-report-utilities.scm
index 647540b2d..e3478e155 100644
--- a/gnucash/report/test/test-report-utilities.scm
+++ b/gnucash/report/test/test-report-utilities.scm
@@ -383,30 +383,6 @@
(gnc-dmy2time64 01 01 2001)
#t)))
- (test-equal "gnc:accounts-get-comm-total-profit"
- '(("GBP" . 612) ("USD" . 2389))
- (collector->list
- (gnc:accounts-get-comm-total-profit all-accounts
- (lambda (acct)
- (gnc:account-get-comm-balance-at-date
- acct (gnc-dmy2time64 01 01 2001) #f)))))
-
- (test-equal "gnc:accounts-get-comm-total-income"
- '(("GBP" . 612) ("USD" . 2573))
- (collector->list
- (gnc:accounts-get-comm-total-income all-accounts
- (lambda (acct)
- (gnc:account-get-comm-balance-at-date
- acct (gnc-dmy2time64 01 01 2001) #f)))))
-
- (test-equal "gnc:accounts-get-comm-total-expense"
- '(("USD" . -184))
- (collector->list
- (gnc:accounts-get-comm-total-expense all-accounts
- (lambda (acct)
- (gnc:account-get-comm-balance-at-date
- acct (gnc-dmy2time64 01 01 2001) #f)))))
-
(test-equal "gnc:accounts-get-comm-total-assets"
'(("GBP" . 608) ("USD" . 2394))
(collector->list
diff --git a/gnucash/report/test/test-report.scm b/gnucash/report/test/test-report.scm
index 80a24ef49..018f69146 100644
--- a/gnucash/report/test/test-report.scm
+++ b/gnucash/report/test/test-report.scm
@@ -134,13 +134,8 @@
(test-begin "test-make-report")
(test-assert "gnc:make-report succeeds"
(gnc:make-report test4-guid))
- (test-equal "gnc:restore-report-by-guid"
- 1
- (gnc:restore-report-by-guid 1 test4-guid test4-name "options"))
- (test-assert "gnc:restore-report-by-guid, no options"
- (not (gnc:restore-report-by-guid 1 test4-guid test4-name #f)))
(test-equal "gnc:restore-report-by-guid-with-custom-template"
- 2
+ 1
(gnc:restore-report-by-guid-with-custom-template
"id" test4-guid test4-name "custom-template-id" "options"))
(test-assert "gnc:restore-report-by-guid-with-custom-template, no options"
diff --git a/gnucash/report/trep-engine.scm b/gnucash/report/trep-engine.scm
index f6e1a31ee..66fba6a72 100644
--- a/gnucash/report/trep-engine.scm
+++ b/gnucash/report/trep-engine.scm
@@ -1979,7 +1979,7 @@ be excluded from periodic reporting.")
report-obj #:key custom-calculated-cells empty-report-message
custom-split-filter split->date split->date-include-false?
custom-source-accounts
- export-type filename)
+ export-type)
;; the trep-renderer is a define* function which, at minimum, takes
;; the report object
;;
@@ -2011,11 +2011,6 @@ be excluded from periodic reporting.")
(((? from-account?) . _) #t)
((_ . rest) (lp rest)))))
- (when filename
- (issue-deprecation-warning "trep-renderer filename is obsolete, and not \
-supported for exports. please set html-document export-string instead. this \
-warning will be removed in GnuCash 5.0"))
-
(gnc:report-starting (opt-val gnc:pagename-general gnc:optname-reportname))
(let* ((document (gnc:make-html-document))
diff --git a/libgnucash/app-utils/app-utils.scm b/libgnucash/app-utils/app-utils.scm
index 9a5f5269a..b9f218a36 100644
--- a/libgnucash/app-utils/app-utils.scm
+++ b/libgnucash/app-utils/app-utils.scm
@@ -38,14 +38,3 @@
(export gnc:get-debit-string)
(export gnc:get-credit-string)
(export gnc:config-file-format-version)
-
-;; Symbols deprecated in 4.x, to remove for 5.x
-(define (gnc:get-debit-string acct-type)
- (issue-deprecation-warning "gnc:get-debit-string is deprecated in 4.x. Please use (gnucash engine)'s gnc-account-get-debit-string instead.")
- (gnc-account-get-debit-string acct-type))
-(define (gnc:get-credit-string acct-type)
- (issue-deprecation-warning "gnc:get-credit-string is deprecated in 4.x. Please use (gnucash engine)'s gnc-account-get-credit-string instead.")
- (gnc-account-get-debit-string acct-type))
-(define (gnc:config-file-format-version version)
- (issue-deprecation-warning "gnc:config-file-format-version is deprecated in 4.x and will be removed from a future version.")
- #t)
diff --git a/libgnucash/app-utils/c-interface.scm b/libgnucash/app-utils/c-interface.scm
index 0468fe501..967ee1224 100644
--- a/libgnucash/app-utils/c-interface.scm
+++ b/libgnucash/app-utils/c-interface.scm
@@ -26,7 +26,6 @@
(export gnc:apply-with-error-handling)
(export gnc:eval-string-with-error-handling)
(export gnc:backtrace-if-exception)
-(export gnc:last-captured-error)
(define (gnc:call-with-error-handling cmd args)
(let ((captured-stack #f)
@@ -78,22 +77,5 @@
((result #f) result)
((_ captured-error)
(display captured-error (current-error-port))
- ;; the next line will be removed in 5.x - deprecated
- (set! gnc:last-captured-error (gnc:html-string-sanitize captured-error))
(when (defined? 'gnc:warn) (gnc:warn captured-error))
#f)))
-
-(define gnc:last-captured-error "") ;deprecate - remove in 5.x
-
-;; This database can be used to store and retrieve translatable
-;; strings. Strings that are returned by the lookup function are
-;; translated with gettext.
-(define (gnc:make-string-database)
- (define string-hash (make-hash-table))
- (issue-deprecation-warning "gnc:make-string-database is deprecated. It \
-will be removed in GnuCash 5.x")
- (lambda args
- (match args
- (('lookup key) (G_ (hash-ref string-hash key)))
- (('store key string) (hash-set! string-hash key string))
- (_ (gnc:warn "string-database: bad action")))))
Summary of changes:
bindings/guile/CMakeLists.txt | 8 -
bindings/guile/business-core.scm | 35 +-
bindings/guile/engine.scm | 30 -
bindings/guile/gnc-module.scm | 88 ---
bindings/guile/test/CMakeLists.txt | 2 -
bindings/guile/test/test-business-core.scm | 53 --
bindings/guile/test/test-scm-utilities.scm | 29 -
bindings/guile/utilities.scm | 20 -
gnucash/report/CMakeLists.txt | 4 -
gnucash/report/eguile-utilities.scm | 57 --
gnucash/report/gnc-report.c | 49 --
gnucash/report/gnc-report.h | 2 -
gnucash/report/html-barchart.scm | 397 ----------
gnucash/report/html-document.scm | 16 -
gnucash/report/html-linechart.scm | 475 ------------
gnucash/report/html-piechart.scm | 239 ------
gnucash/report/html-scatter.scm | 227 ------
gnucash/report/html-table.scm | 25 -
gnucash/report/html-utilities.scm | 27 -
gnucash/report/report-core.scm | 30 -
gnucash/report/report-utilities.scm | 68 --
gnucash/report/reports/CMakeLists.txt | 198 -----
gnucash/report/reports/aging.scm | 847 --------------------
gnucash/report/reports/example/average-balance.scm | 2 -
.../reports/standard/income-gst-statement.scm | 6 +-
gnucash/report/reports/standard/job-report.scm | 601 --------------
gnucash/report/reports/standard/owner-report.scm | 861 ---------------------
gnucash/report/reports/standard/payables.scm | 81 --
gnucash/report/reports/standard/receivables.scm | 94 ---
.../reports/standard/test/test-owner-report.scm | 59 +-
gnucash/report/test/test-report-html.scm | 29 +-
gnucash/report/test/test-report-utilities.scm | 24 -
gnucash/report/test/test-report.scm | 7 +-
gnucash/report/trep-engine.scm | 7 +-
libgnucash/app-utils/app-utils.scm | 11 -
libgnucash/app-utils/c-interface.scm | 18 -
libgnucash/engine/Account.cpp | 21 -
libgnucash/engine/Account.h | 12 -
38 files changed, 10 insertions(+), 4749 deletions(-)
delete mode 100644 bindings/guile/gnc-module.scm
delete mode 100644 gnucash/report/html-barchart.scm
delete mode 100644 gnucash/report/html-linechart.scm
delete mode 100644 gnucash/report/html-piechart.scm
delete mode 100644 gnucash/report/html-scatter.scm
delete mode 100644 gnucash/report/reports/aging.scm
delete mode 100644 gnucash/report/reports/standard/job-report.scm
delete mode 100644 gnucash/report/reports/standard/owner-report.scm
delete mode 100644 gnucash/report/reports/standard/payables.scm
delete mode 100644 gnucash/report/reports/standard/receivables.scm
More information about the gnucash-changes
mailing list