mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Revert "Revert "Merge Stefan Bayer's 'SepaInternalTransfer' into maint.""
The original merge was of a PR based on master into maint, bringing along all of the development changes in master along with it. We don't want that so the merge was reverted and the PR's two changes cherry-picked in. That fixed maint, but then the next regular merge of maint into master naturally included that revert commit undoing the changes in master. Not so good. Reverting the revert, this commit, restores the changes, albeit with messed up history.
This commit is contained in:
John Ralls
parent
5603acba31
commit
c1c75e8f81
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -30,44 +30,3 @@
|
||||
(gnucash engine business-core)
|
||||
(gnucash engine commodity-table)
|
||||
(gnucash engine gnc-numeric))
|
||||
|
||||
(export gnc-pricedb-lookup-latest-before-t64)
|
||||
(export gnc-pricedb-lookup-latest-before-any-currency-t64)
|
||||
(export gnc:account-map-descendants)
|
||||
(export gnc:account-map-children)
|
||||
(export account-full-name<?)
|
||||
(export accounts-get-children-depth)
|
||||
|
||||
(define (gnc-pricedb-lookup-latest-before-t64 . args)
|
||||
(issue-deprecation-warning "gnc-pricedb-lookup-latest-before-t64 has been renamed to gnc-pricedb-lookup-nearest-before-t64")
|
||||
(apply gnc-pricedb-lookup-nearest-before-t64 args))
|
||||
|
||||
(define (gnc-pricedb-lookup-latest-before-any-currency-t64 . args)
|
||||
(issue-deprecation-warning "gnc-pricedb-lookup-latest-before-any-currency-t64 has been renamed to gnc-pricedb-lookup-nearest-before-any-currency-t64")
|
||||
(apply gnc-pricedb-lookup-nearest-before-any-currency-t64 args))
|
||||
|
||||
;; 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))))
|
||||
|
||||
@ -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@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))))))
|
||||
@ -31,7 +31,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)
|
||||
@ -41,12 +40,6 @@ gnc_add_scheme_test_targets(scm-test-engine-extras
|
||||
OUTPUT_DIR "tests"
|
||||
DEPENDS "${GUILE_DEPENDS}")
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash engine test test-extras"
|
||||
NEW_MODULE "tests test-engine-extras"
|
||||
DEPENDS "scm-test-engine-extras")
|
||||
|
||||
gnc_add_scheme_test_targets(scm-test-engine
|
||||
SOURCES "${bindings_test_SCHEME}"
|
||||
OUTPUT_DIR "tests"
|
||||
@ -69,12 +62,6 @@ if (HAVE_SRFI64)
|
||||
OUTPUT_DIR "tests"
|
||||
DEPENDS "${GUILE_DEPENDS};scm-test-engine-extras;scm-srfi64-extras")
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash engine test srfi64-extras"
|
||||
NEW_MODULE "tests srfi64-extras"
|
||||
DEPENDS "scm-srfi64-extras")
|
||||
|
||||
gnc_add_scheme_test_targets (scm-test-with-srfi64
|
||||
SOURCES "${scm_tests_with_srfi64_SOURCES}"
|
||||
OUTPUT_DIR "tests"
|
||||
@ -91,7 +78,6 @@ set(test_scm_SCHEME
|
||||
)
|
||||
|
||||
set(GUILE_DEPENDS
|
||||
scm-gnc-module
|
||||
scm-app-utils
|
||||
scm-engine
|
||||
scm-srfi64-extras
|
||||
@ -130,6 +116,7 @@ set(test_guile_DIST
|
||||
)
|
||||
|
||||
# Define two imaginary deprecated guile modules to test the compat file generation code
|
||||
# See commit bbcffa3ec for old code using this function.
|
||||
gnc_add_scheme_deprecated_module (OLD_MODULE "gnucash deprecated-module")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash superseded-module"
|
||||
|
||||
@ -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))
|
||||
|
||||
))
|
||||
|
||||
@ -11,10 +11,4 @@
|
||||
(define (test-engine)
|
||||
(test-begin "testing function availability")
|
||||
|
||||
(test-assert "testing gnc-pricedb-lookup-latest-before-t64"
|
||||
(gnc-pricedb-lookup-latest-before-t64 '() '() '() 0))
|
||||
|
||||
(test-assert "testing gnc-pricedb-lookup-latest-before-any-currency-t64"
|
||||
(gnc-pricedb-lookup-latest-before-any-currency-t64 '() '() 0))
|
||||
|
||||
(test-end "testing deprecated functions"))
|
||||
|
||||
@ -7,25 +7,12 @@
|
||||
(define (run-test)
|
||||
(test-runner-factory gnc:test-runner)
|
||||
(test-begin "test-scm-utilities.scm")
|
||||
(test-traverse-vec)
|
||||
(test-substring-replace)
|
||||
(test-sort-and-delete-duplicates)
|
||||
(test-gnc:html-string-sanitize)
|
||||
(test-gnc:list-flatten)
|
||||
(test-end "test-scm-utilities.scm"))
|
||||
|
||||
(define (test-traverse-vec)
|
||||
(test-begin "traverse-vec")
|
||||
(test-equal "list->vec"
|
||||
(vector 1 (vector 2 3))
|
||||
(traverse-list->vec
|
||||
(list 1 (list 2 3))))
|
||||
(test-equal "vec->list"
|
||||
(list 1 (list 2 3))
|
||||
(traverse-vec->list
|
||||
(vector 1 (vector 2 3))))
|
||||
(test-end "traverse-vec"))
|
||||
|
||||
(define (test-substring-replace)
|
||||
(test-begin "substring-replace")
|
||||
|
||||
@ -34,35 +21,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)
|
||||
|
||||
@ -32,8 +32,6 @@
|
||||
(export addto!)
|
||||
(export sort-and-delete-duplicates)
|
||||
(export gnc:list-flatten)
|
||||
(export traverse-list->vec)
|
||||
(export traverse-vec->list)
|
||||
(export gnc:substring-replace-from-to)
|
||||
(export gnc:substring-replace)
|
||||
(export gnc:html-string-sanitize)
|
||||
@ -66,22 +64,6 @@
|
||||
(define-syntax-rule (addto! alist element)
|
||||
(set! alist (cons element alist)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; pair of utility functions for use with guile-json which requires
|
||||
;; lists converted vectors to save as json arrays. traverse list
|
||||
;; converting into vectors, and vice versa.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (traverse-list->vec lst)
|
||||
(issue-deprecation-warning "traverse-list->vec unused.")
|
||||
(cond
|
||||
((list? lst) (list->vector (map traverse-list->vec lst)))
|
||||
(else lst)))
|
||||
|
||||
(define (traverse-vec->list vec)
|
||||
(issue-deprecation-warning "traverse-vec->list unused.")
|
||||
(cond
|
||||
((vector? vec) (map traverse-vec->list (vector->list vec)))
|
||||
(else vec)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; general and efficient string-replace-substring function, based on
|
||||
@ -126,26 +108,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.
|
||||
|
||||
@ -66,12 +66,6 @@ gnc_add_scheme_test_targets(scm-test-core
|
||||
|
||||
add_dependencies(check scm-test-core)
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash unittest-support"
|
||||
NEW_MODULE "tests unittest-support"
|
||||
DEPENDS "scm-test-core")
|
||||
|
||||
|
||||
if (GTEST_SRC_DIR)
|
||||
# in contrast to GoogleTest build system libraries libgtest.a and libgtest_main.a
|
||||
|
||||
@ -255,12 +255,6 @@ gnc_add_scheme_targets(scm-gnome
|
||||
OUTPUT_DIR gnucash
|
||||
DEPENDS "${GUILE_DEPENDS}")
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report report-gnome"
|
||||
NEW_MODULE"gnucash report-menus"
|
||||
DEPENDS "scm-gnome")
|
||||
|
||||
set_dist_list(gnome_DIST
|
||||
CMakeLists.txt gnome.i gnucash.appdata.xml.in.in gnucash.desktop.in.in
|
||||
gnucash.releases.xml ${gnc_gnome_noinst_HEADERS} ${gnc_gnome_SOURCES} ${gnome_SCHEME})
|
||||
|
||||
@ -5,12 +5,6 @@
|
||||
</schema>
|
||||
|
||||
<schema id="org.gnucash.general" path="/org/gnucash/general/">
|
||||
<key name="migrate-prefs-done" type="b">
|
||||
<default>false</default>
|
||||
<summary>-Obsolete-</summary>
|
||||
<description>This setting is obsolete and will be removed in the next major @PROJECT_NAME@ release series.</description>
|
||||
</key>
|
||||
|
||||
<key name="prefs-version" type="i">
|
||||
<default>0</default>
|
||||
<summary>The version of these settings</summary>
|
||||
@ -425,26 +419,6 @@ For example setting this to 2.0 will display reports at twice their typical size
|
||||
<child name="options" schema="org.gnucash.dialogs.options"/>
|
||||
</schema>
|
||||
|
||||
<schema id="org.gnucash.dialogs.business-assoc" path="/org/gnucash/dialogs/business-assoc/">
|
||||
<key type="(iiii)" name="last-geometry">
|
||||
<default>(-1,-1,-1,-1)</default>
|
||||
<summary>Last window position and size</summary>
|
||||
<description>This setting describes the size and position of the window when it was last closed.
|
||||
The numbers are the X and Y coordinates of the top left corner of the window
|
||||
followed by the width and height of the window.</description>
|
||||
</key>
|
||||
</schema>
|
||||
|
||||
<schema id="org.gnucash.dialogs.trans-assoc" path="/org/gnucash/dialogs/trans-assoc/">
|
||||
<key type="(iiii)" name="last-geometry">
|
||||
<default>(-1,-1,-1,-1)</default>
|
||||
<summary>Last window position and size</summary>
|
||||
<description>This setting describes the size and position of the window when it was last closed.
|
||||
The numbers are the X and Y coordinates of the top left corner of the window
|
||||
followed by the width and height of the window.</description>
|
||||
</key>
|
||||
</schema>
|
||||
|
||||
<schema id="org.gnucash.dialogs.account" path="/org/gnucash/dialogs/account/">
|
||||
<key name="last-geometry" type="(iiii)">
|
||||
<default>(-1,-1,-1,-1)</default>
|
||||
|
||||
@ -241,11 +241,6 @@
|
||||
<summary>Color the register using a gnucash specific color theme</summary>
|
||||
<description>When enabled the register will use a GnuCash specific color theme (green/yellow). Otherwise it will use the system color theme. Regardless of this setting the user can always override the color theme via a gnucash specific css file to be stored in the gnucash used config directory. More information can be found in the gnucash FAQ.</description>
|
||||
</key>
|
||||
<key name="use-theme-colors" type="b">
|
||||
<default>false</default>
|
||||
<summary>Superseded by "use-gnucash-color-theme"</summary>
|
||||
<description>This option is temporarily kept around for backwards compatibility. It will be removed in a future version.</description>
|
||||
</key>
|
||||
<key name="enter-moves-to-end" type="b">
|
||||
<default>false</default>
|
||||
<summary>"Enter" key moves to bottom of register</summary>
|
||||
|
||||
@ -1373,15 +1373,783 @@
|
||||
|
||||
</release>
|
||||
|
||||
<release version="4009">
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business-assoc"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.trans-assoc"
|
||||
old-key="last-geometry"/>
|
||||
<release version="5000">
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="migrate-prefs-done"/>
|
||||
old-key="prefs-version"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="save-window-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="account-separator"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="assoc-head"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="file-compression"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="autosave-show-explanation"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="autosave-interval-minutes"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="save-on-close-expires"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="save-on-close-wait-time"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="negative-in-red"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="auto-decimal-point"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="auto-decimal-places"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="force-price-decimal"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="retain-type-never"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="retain-type-days"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="retain-type-forever"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="retain-days"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="reversed-accounts-none"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="reversed-accounts-credit"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="reversed-accounts-incomeexpense"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="show-account-color"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="show-account-color-tabs"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="use-accounting-labels"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="tab-close-buttons"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="tab-width"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="tab-open-adjacent"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="currency-choice-locale"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="currency-choice-other"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="currency-other"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="clock-24h"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="date-format"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="date-completion-thisyear"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="date-completion-sliding"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="date-backmonths"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="grid-lines-horizontal"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="grid-lines-vertical"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="show-splash-screen"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="tab-position-top"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="tab-position-bottom"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="tab-position-left"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="tab-position-right"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="summarybar-position-top"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="summarybar-position-bottom"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="tab-next-recent"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general"
|
||||
old-key="num-source"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="use-gnucash-color-theme"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="use-theme-colors"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="enter-moves-to-end"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="auto-raise-lists"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="tab-to-transfer-on-memorised"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="use-new-window"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="alternate-color-by-transaction"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="draw-horizontal-lines"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="draw-vertical-lines"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="future-after-blank-transaction"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="default-style-ledger"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="default-style-autoledger"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="default-style-journal"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="double-line-mode"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="show-leaf-account-names"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="show-extra-dates"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="show-extra-dates-on-selection"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="show-calendar-buttons"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="selection-to-blank-on-expand"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="max-transactions"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.register"
|
||||
old-key="key-length"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.report"
|
||||
old-key="use-new-window"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.report"
|
||||
old-key="currency-choice-locale"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.report"
|
||||
old-key="currency-choice-other"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.report"
|
||||
old-key="currency-other"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.report"
|
||||
old-key="default-zoom"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.report.pdf-export"
|
||||
old-key="filename-format"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.report.pdf-export"
|
||||
old-key="filename-date-format"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dev"
|
||||
old-key="allow-file-incompatibility"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.account"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.imap-editor"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.find-account"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.preferences"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.price-editor"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.pricedb-editor"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.reset-warnings"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.tax-info"
|
||||
old-key="paned-position"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.tax-info"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.fincalc"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.find"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.find"
|
||||
old-key="search-for-active-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.export-accounts"
|
||||
old-key="last-path"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.log-replay"
|
||||
old-key="last-path"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.open-save"
|
||||
old-key="last-path"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.report"
|
||||
old-key="last-path"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.report-saved-configs"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.lot-viewer"
|
||||
old-key="hpane-position"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.lot-viewer"
|
||||
old-key="vpane-position"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.lot-viewer"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.new-user"
|
||||
old-key="first-startup"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.new-hierarchy"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.new-hierarchy"
|
||||
old-key="show-on-new-file"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.search"
|
||||
old-key="new-search-limit"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.transfer"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business-doclink"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.trans-doclink"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.style-sheet"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.options"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.customer-search"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.customer-search"
|
||||
old-key="search-for-active-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.employee-search"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.employee-search"
|
||||
old-key="search-for-active-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice-search"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice-search"
|
||||
old-key="search-for-active-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.job-search"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.job-search"
|
||||
old-key="search-for-active-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.order-search"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.order-search"
|
||||
old-key="search-for-active-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.vendor-search"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.vendor-search"
|
||||
old-key="search-for-active-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice"
|
||||
old-key="tax-included"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice"
|
||||
old-key="auto-pay"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice"
|
||||
old-key="notify-when-due"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice"
|
||||
old-key="days-in-advance"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice"
|
||||
old-key="enable-toolbuttons"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice"
|
||||
old-key="invoice-printreport"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice"
|
||||
old-key="use-new-window"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.invoice"
|
||||
old-key="accumulate-splits"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.bill"
|
||||
old-key="tax-included"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.bill"
|
||||
old-key="auto-pay"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.bill"
|
||||
old-key="notify-when-due"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.bill"
|
||||
old-key="days-in-advance"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.business.tax-tables"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="check-format-guid"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="check-position"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="first-page-count"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="date-format"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="date-format-user"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-units"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-payee"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-date"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-amount-words"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-amount-number"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-address"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-notes"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-memo"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-translation"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="custom-rotation"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="splits-amount"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="splits-memo"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="splits-account"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="print-date-format"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="default-font"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="blocking-chars"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.checkprinting"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.commodities"
|
||||
old-key="include-iso"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.commodities"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.export.csv"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.export.csv"
|
||||
old-key="last-path"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.export.csv"
|
||||
old-key="paned-position"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.csv"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.csv"
|
||||
old-key="last-path"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="enable-skip"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="enable-update"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="use-bayes"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="match-threshold"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="match-date-threshold"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="match-date-not-threshold"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="auto-add-threshold"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="auto-clear-threshold"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="atm-fee-threshold"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic"
|
||||
old-key="auto-create-commodity"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic.match-picker"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic.match-picker"
|
||||
old-key="display-reconciled"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic.account-picker"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.generic.transaction-list"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.qif"
|
||||
old-key="default-status-notcleared"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.qif"
|
||||
old-key="default-status-cleared"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.qif"
|
||||
old-key="default-status-reconciled"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.qif"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.qif"
|
||||
old-key="last-path"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.qif"
|
||||
old-key="show-doc"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.qif.account-picker"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.reconcile"
|
||||
old-key="check-cleared"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.reconcile"
|
||||
old-key="auto-interest-transfer"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.reconcile"
|
||||
old-key="auto-cc-payment"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.reconcile"
|
||||
old-key="always-reconcile-to-today"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.reconcile"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.since-last-run"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.since-last-run"
|
||||
old-key="show-at-file-open"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.since-last-run"
|
||||
old-key="show-notify-window-at-file-open"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.since-last-run"
|
||||
old-key="review-transactions"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.transaction-editor"
|
||||
old-key="create-auto"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.transaction-editor"
|
||||
old-key="create-days"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.transaction-editor"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.transaction-editor"
|
||||
old-key="notify"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.sxs.transaction-editor"
|
||||
old-key="remind-days"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.totd"
|
||||
old-key="current-tip"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.totd"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.totd"
|
||||
old-key="show-at-startup"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.general.finance-quote"
|
||||
old-key="alphavantage-api-key"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="maxfiles"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file0"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file1"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file2"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file3"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file4"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file5"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file6"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file7"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file8"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.history"
|
||||
old-key="file9"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="checkprinting-multi-acct"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="closing-window-question"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="inv-entry-mod"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="inv-entry-dup"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="price-comm-del"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="price-comm-del-quotes"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="price-quotes-del"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="price-quotes-replace"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-is-acct-pay-rec"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-is-read-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-recd-split-mod"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-recd-split-unrec"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-split-del"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-split-del-recd"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-split-del-all"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-split-del-all-recd"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-trans-del"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-trans-del-recd"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-trans-dup"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.permanent"
|
||||
old-key="reg-trans-mod"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="checkprinting-multi-acct"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="closing-window-question"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="inv-entry-mod"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="inv-entry-dup"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="price-comm-del"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="price-comm-del-quotes"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="price-quotes-del"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="price-quotes-replace"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-is-acct-pay-rec"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-is-read-only"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-recd-split-mod"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-recd-split-unrec"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-split-del"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-split-del-recd"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-split-del-all"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-split-del-all-recd"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-trans-del"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-trans-del-recd"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-trans-dup"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.warnings.temporary"
|
||||
old-key="reg-trans-mod"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages"
|
||||
old-key="account-code-visible"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages"
|
||||
old-key="account-code-width"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="grand-total"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="non-currency"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="start-choice-relative"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="start-choice-absolute"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="start-date"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="start-period"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="end-choice-relative"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="end-choice-absolute"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="end-date"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.window.pages.account-tree.summary"
|
||||
old-key="end-period"/>
|
||||
|
||||
</release>
|
||||
|
||||
@ -1,3 +1,15 @@
|
||||
<!-- GSettings preference transformation rules
|
||||
|
||||
Refer to gnucash/gschemas/pref_transformations.xml for more information
|
||||
about this file.
|
||||
|
||||
|
||||
Note
|
||||
====
|
||||
Do not remove this file from the GnuCash sources even if there are
|
||||
currently no active rules. Instead keep this introductory comment in
|
||||
place and remove all other content.
|
||||
-->
|
||||
|
||||
<release version="4007">
|
||||
|
||||
@ -62,3 +74,43 @@
|
||||
new-key="last-geometry"/>
|
||||
|
||||
</release>
|
||||
|
||||
<release version="5000">
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.flicker"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.ab-initial"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="close-on-finish"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="remember-pin"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="use-ns-transaction-text"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="verbose-debug"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="format-dtaus"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="format-csv"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="format-swift-mt940"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="format-swift-mt942"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci"
|
||||
old-key="last-path"/>
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.hbci.connection-dialog"
|
||||
old-key="last-geometry"/>
|
||||
|
||||
</release>
|
||||
|
||||
@ -1,3 +1,15 @@
|
||||
<!-- GSettings preference transformation rules
|
||||
|
||||
Refer to gnucash/gschemas/pref_transformations.xml for more information
|
||||
about this file.
|
||||
|
||||
|
||||
Note
|
||||
====
|
||||
Do not remove this file from the GnuCash sources even if there are
|
||||
currently no active rules. Instead keep this introductory comment in
|
||||
place and remove all other content.
|
||||
-->
|
||||
|
||||
<release version="4007">
|
||||
|
||||
@ -6,3 +18,10 @@
|
||||
new-path="org.gnucash.GnuCash.dialogs.import.ofx"
|
||||
new-key="last-path"/>
|
||||
</release>
|
||||
|
||||
<release version="5000">
|
||||
|
||||
<obsolete old-path="org.gnucash.dialogs.import.ofx"
|
||||
old-key="last-path"/>
|
||||
</release>
|
||||
|
||||
|
||||
@ -91,18 +91,6 @@ gnc_add_scheme_targets(scm-qif-import
|
||||
DEPENDS "${GUILE_DEPENDS};scm-qif-import-0"
|
||||
MAKE_LINKS)
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash import-export qif-import"
|
||||
NEW_MODULE "gnucash qif-import"
|
||||
DEPENDS "scm-qif-import-2"
|
||||
MAKE_LINKS)
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash import-export string"
|
||||
NEW_MODULE "gnucash string"
|
||||
DEPENDS "scm-qif-import-0"
|
||||
MAKE_LINKS)
|
||||
|
||||
set_local_dist(qif_import_DIST_local CMakeLists.txt file-format.txt ${qif_import_SOURCES} ${qif_import_noinst_HEADERS}
|
||||
${qif_import_SCHEME_0} ${qif_import_SCHEME} ${qif_import_SCHEME_2})
|
||||
set(qif_import_DIST ${qif_import_DIST_local} ${test_qif_import_DIST} PARENT_SCOPE)
|
||||
|
||||
@ -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
|
||||
@ -116,30 +112,6 @@ gnc_add_scheme_targets(scm-report-eguile
|
||||
OUTPUT_DIR "gnucash"
|
||||
DEPENDS scm-report-eguile-parts)
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report eguile-gnc"
|
||||
NEW_MODULE "gnucash eguile"
|
||||
DEPENDS "scm-report-eguile")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report eguile-html-utilities"
|
||||
NEW_MODULE "gnucash eguile"
|
||||
DEPENDS "scm-report-eguile")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report eguile-utilities"
|
||||
NEW_MODULE "gnucash eguile"
|
||||
DEPENDS "scm-report-eguile")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report report-system"
|
||||
NEW_MODULE "gnucash report"
|
||||
DEPENDS "scm-report-2")
|
||||
|
||||
gnc_add_scheme_deprecated_module (OLD_MODULE "gnucash report business-reports")
|
||||
gnc_add_scheme_deprecated_module (OLD_MODULE "gnucash report report-system collectors")
|
||||
gnc_add_scheme_deprecated_module (OLD_MODULE "gnucash report report-system report-collectors")
|
||||
gnc_add_scheme_deprecated_module (OLD_MODULE "gnucash report stylesheets")
|
||||
gnc_add_scheme_deprecated_module (OLD_MODULE "gnucash report utility-reports")
|
||||
|
||||
add_custom_target(scm-report ALL DEPENDS scm-report-2 scm-report-eguile)
|
||||
|
||||
set_local_dist(report_DIST_local CMakeLists.txt
|
||||
|
||||
@ -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>)))))
|
||||
|
||||
@ -235,55 +235,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 )
|
||||
{
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -1,397 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; html-barchart.scm : generate HTML programmatically, with support
|
||||
;; for simple style elements.
|
||||
;; Copyright 2000 Bill Gribble <grib@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@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)
|
||||
@ -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))
|
||||
@ -367,18 +363,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)
|
||||
|
||||
|
||||
@ -1,475 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; html-linechart.scm : generate HTML programmatically, with support
|
||||
;; for simple style elements.
|
||||
;; Copyright 2008 Sven Henkel <shenkel@gmail.com>
|
||||
;;
|
||||
;; Adapted from html-barchart.scm which is
|
||||
;; Copyright 2000 Bill Gribble <grib@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@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)
|
||||
@ -1,239 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; html-piechart.scm : generate HTML programmatically, with support
|
||||
;; for simple style elements.
|
||||
;; Copyright 2000 Bill Gribble <grib@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@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)
|
||||
@ -1,227 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; html-scatter.scm : generate HTML programmatically, with support
|
||||
;; for simple style elements.
|
||||
;; Copyright 2001 Christian Stimming <stimming@tuhh.de>
|
||||
;;
|
||||
;; Adapted from html-barchart.scm which is
|
||||
;; Copyright 2000 Bill Gribble <grib@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@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)
|
||||
@ -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)))))
|
||||
|
||||
@ -248,33 +248,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
|
||||
|
||||
@ -79,7 +79,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?!)
|
||||
@ -114,7 +113,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:
|
||||
@ -388,20 +386,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
|
||||
@ -766,20 +750,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
|
||||
|
||||
@ -593,39 +593,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
|
||||
@ -669,41 +636,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)))
|
||||
|
||||
@ -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
|
||||
@ -52,7 +48,6 @@ set (reports_standard_SCHEME
|
||||
standard/taxinvoice.scm
|
||||
standard/receipt.scm
|
||||
standard/invoice.scm
|
||||
standard/job-report.scm
|
||||
standard/balsheet-eg.scm
|
||||
)
|
||||
|
||||
@ -170,199 +165,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}
|
||||
|
||||
@ -1,847 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; aging.scm : accounts payable/receivable aging report utilities
|
||||
;;
|
||||
;; By Derek Atkins <warlord@MIT.EDU> taken from the original...
|
||||
;; By Robert Merkel (rgmerk@mira.net)
|
||||
;; Copyright (c) 2002, 2003 Derek Atkins <warlord@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@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 of the company"))
|
||||
(vector 'total (N_ "Total amount owed to/from Company"))
|
||||
(vector 'oldest-bracket (N_ "Bracket Total Owed")))))
|
||||
|
||||
(add-option
|
||||
(gnc:make-multichoice-option
|
||||
gnc:pagename-general
|
||||
optname-sort-order
|
||||
"ia"
|
||||
(N_ "Sort order.")
|
||||
'increasing
|
||||
(list
|
||||
(vector 'increasing (N_ "Ascending"))
|
||||
(vector 'decreasing (N_ "Descending")))))
|
||||
|
||||
(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"))
|
||||
(vector 'postdate (N_ "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)
|
||||
@ -455,7 +455,6 @@
|
||||
|
||||
(gnc:html-chart-set-data-labels! barchart col-labels)
|
||||
(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)
|
||||
|
||||
@ -42,7 +42,6 @@
|
||||
(export gnc:invoice-report-create)
|
||||
(export gnc:payables-report-create)
|
||||
(export gnc:receivables-report-create)
|
||||
(export gnc:owner-report-create) ;deprecate
|
||||
(export gnc:owner-report-create-with-enddate)
|
||||
|
||||
(let ((loc-spec (if (string-prefix? "de_DE" (gnc-locale-name)) 'de_DE 'us)))
|
||||
@ -90,5 +89,4 @@
|
||||
|
||||
(define gnc:payables-report-create payables-report-create-internal)
|
||||
(define gnc:receivables-report-create receivables-report-create-internal)
|
||||
(define gnc:owner-report-create owner-report-create) ;deprecated
|
||||
(define gnc:owner-report-create-with-enddate owner-report-create-with-enddate)
|
||||
|
||||
@ -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@MIT.EDU>
|
||||
;; Copyright (c) 2002, 2003 Derek Atkins <warlord@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@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))
|
||||
@ -1240,10 +1240,6 @@ and do not match the transaction."))))))))
|
||||
(guid (assv-ref guid-alist type)))
|
||||
(owner-report-create-internal guid owner type enddate)))
|
||||
|
||||
(define (owner-report-create owner account)
|
||||
(issue-deprecation-warning "owner-report-create is not used anymore. call owner-report-create-with-enddate instead")
|
||||
(owner-report-create-with-enddate owner account #f))
|
||||
|
||||
(define (gnc:owner-report-create-internal
|
||||
account split query journal? double? title debit-string credit-string)
|
||||
|
||||
@ -1256,5 +1252,4 @@ and do not match the transaction."))))))))
|
||||
|
||||
(gnc:register-report-hook ACCT-TYPE-RECEIVABLE #t gnc:owner-report-create-internal)
|
||||
(gnc:register-report-hook ACCT-TYPE-PAYABLE #t gnc:owner-report-create-internal)
|
||||
(export owner-report-create) ;deprecate
|
||||
(export owner-report-create-with-enddate)
|
||||
|
||||
@ -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@MIT.EDU>
|
||||
;; Copyright (c) 2002, 2003 Derek Atkins <warlord@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@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"))
|
||||
(vector 'postdate (N_ "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))
|
||||
|
||||
@ -1,81 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; payables.scm : accounts payable aging report
|
||||
;;
|
||||
;; By Derek Atkins <warlord@MIT.EDU>
|
||||
;; Copyright (c) 2002, 2003 Derek Atkins <warlord@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@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))
|
||||
|
||||
@ -1,94 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; receivables.scm : accounts receivable aging report
|
||||
;;
|
||||
;; By Derek Atkins <warlord@MIT.EDU>
|
||||
;; Copyright (c) 2002, 2003 Derek Atkins <warlord@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@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 address"))
|
||||
(vector 'shipping (N_ "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))
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -306,32 +302,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
|
||||
@ -384,29 +354,4 @@
|
||||
((sxpath `(// (table 3) // thead // (tr 2) // *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")))
|
||||
|
||||
@ -20,28 +20,6 @@ gnc_add_scheme_targets(scm-report-stylesheets-1
|
||||
DEPENDS "${GUILE_DEPENDS}"
|
||||
MAKE_LINKS)
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report stylesheet-easy"
|
||||
NEW_MODULE "gnucash report stylesheets footer"
|
||||
DEPENDS "scm-report-stylesheets-1")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report stylesheet-fancy"
|
||||
NEW_MODULE "gnucash report stylesheets footer"
|
||||
DEPENDS "scm-report-stylesheets-1")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report stylesheet-footer"
|
||||
NEW_MODULE "gnucash report stylesheets footer"
|
||||
DEPENDS "scm-report-stylesheets-1")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report stylesheet-head-or-tail"
|
||||
NEW_MODULE "gnucash report stylesheets head-or-tail"
|
||||
DEPENDS "scm-report-stylesheets-1")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash report stylesheet-plain"
|
||||
NEW_MODULE "gnucash report stylesheets plain"
|
||||
DEPENDS "scm-report-stylesheets-1")
|
||||
|
||||
add_custom_target(scm-report-stylesheets ALL DEPENDS scm-report-stylesheets-1)
|
||||
|
||||
set_local_dist(stylesheets_DIST_local CMakeLists.txt ${stylesheets_SCHEME})
|
||||
|
||||
@ -53,9 +53,3 @@ set_dist_list(test_report_DIST
|
||||
${scm_test_report_SOURCES}
|
||||
test-report-extras.scm
|
||||
)
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "tests test-report-system-extras"
|
||||
NEW_MODULE "tests test-report-extras"
|
||||
DEPENDS "scm-test-report")
|
||||
|
||||
@ -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>\
|
||||
|
||||
@ -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
|
||||
|
||||
@ -150,13 +150,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"
|
||||
|
||||
@ -1945,7 +1945,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
|
||||
;;
|
||||
@ -1978,11 +1978,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))
|
||||
|
||||
@ -225,14 +225,6 @@ gnc_add_scheme_targets(scm-app-utils-2
|
||||
DEPENDS "scm-bus-prefs"
|
||||
MAKE_LINKS)
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (OLD_MODULE "migrate-prefs")
|
||||
gnc_add_scheme_deprecated_module (OLD_MODULE "migrate-prefs-user")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash gettext"
|
||||
NEW_MODULE "gnucash core-utils"
|
||||
DEPENDS "scm-core-utils")
|
||||
|
||||
add_custom_target(scm-app-utils ALL DEPENDS scm-app-utils-2 scm-app-utils-1)
|
||||
|
||||
set_local_dist(app_utils_DIST_local
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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")))))
|
||||
|
||||
@ -105,21 +105,7 @@
|
||||
(export gnc:get-start-prev-quarter)
|
||||
(export gnc:get-end-prev-quarter)
|
||||
(export gnc:get-today)
|
||||
(export gnc:get-one-month-ago)
|
||||
(export gnc:get-three-months-ago)
|
||||
(export gnc:get-six-months-ago)
|
||||
(export gnc:get-one-year-ago)
|
||||
(export gnc:reldate-initialize)
|
||||
(export gnc:get-end-next-month)
|
||||
(export gnc:get-end-next-quarter)
|
||||
(export gnc:get-end-next-year)
|
||||
(export gnc:get-one-month-ahead)
|
||||
(export gnc:get-one-year-ahead)
|
||||
(export gnc:get-six-months-ahead)
|
||||
(export gnc:get-start-next-month)
|
||||
(export gnc:get-start-next-quarter)
|
||||
(export gnc:get-start-next-year)
|
||||
(export gnc:get-three-months-ahead)
|
||||
|
||||
;; get stuff from localtime date vector
|
||||
(define (gnc:date-get-year datevec)
|
||||
@ -584,30 +570,6 @@ Defaulting to today."))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-start-next-year)
|
||||
(issue-deprecation-warning "gnc:get-start-next-year is deprecated.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:sec now 0)
|
||||
(set-tm:min now 0)
|
||||
(set-tm:hour now 0)
|
||||
(set-tm:mday now 1)
|
||||
(set-tm:mon now 0)
|
||||
(set-tm:year now (+ (tm:year now) 1))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-end-next-year)
|
||||
(issue-deprecation-warning "gnc:get-end-next-year is deprecated.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:sec now 59)
|
||||
(set-tm:min now 59)
|
||||
(set-tm:hour now 23)
|
||||
(set-tm:mday now 31)
|
||||
(set-tm:mon now 11)
|
||||
(set-tm:year now (+ (tm:year now) 1))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-start-accounting-period)
|
||||
(gnc-accounting-period-fiscal-start))
|
||||
|
||||
@ -661,38 +623,6 @@ Defaulting to today."))
|
||||
(+ (tm:year now) 1900)))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-start-next-month)
|
||||
(issue-deprecation-warning "gnc:get-start-next-month is deprecated.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:sec now 0)
|
||||
(set-tm:min now 0)
|
||||
(set-tm:hour now 0)
|
||||
(set-tm:mday now 1)
|
||||
(if (= (tm:mon now) 11)
|
||||
(begin
|
||||
(set-tm:mon now 0)
|
||||
(set-tm:year now (+ (tm:year now) 1)))
|
||||
(set-tm:mon now (+ (tm:mon now) 1)))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-end-next-month)
|
||||
(issue-deprecation-warning "gnc:get-end-next-month is deprecated.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:sec now 59)
|
||||
(set-tm:min now 59)
|
||||
(set-tm:hour now 23)
|
||||
(if (= (tm:mon now) 11)
|
||||
(begin
|
||||
(set-tm:mon now 0)
|
||||
(set-tm:year now (+ (tm:year now) 1)))
|
||||
(set-tm:mon now (+ (tm:mon now) 1)))
|
||||
(set-tm:mday now (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900)))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-start-current-quarter)
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:sec now 0)
|
||||
@ -746,152 +676,9 @@ Defaulting to today."))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-start-next-quarter)
|
||||
(issue-deprecation-warning "gnc:get-start-next-quarter is deprecated.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:sec now 0)
|
||||
(set-tm:min now 0)
|
||||
(set-tm:hour now 0)
|
||||
(set-tm:mday now 1)
|
||||
(if (> (tm:mon now) 8)
|
||||
(begin
|
||||
(set-tm:mon now 0)
|
||||
(set-tm:year now (+ (tm:year now) 1)))
|
||||
(set-tm:mon now (+ (tm:mon now) (- 3 (modulo (tm:mon now) 3)))))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-end-next-quarter)
|
||||
(issue-deprecation-warning "gnc:get-end-next-quarter is deprecated.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:sec now 59)
|
||||
(set-tm:min now 59)
|
||||
(set-tm:hour now 23)
|
||||
(if (> (tm:mon now) 8)
|
||||
(begin
|
||||
(set-tm:mon now 2)
|
||||
(set-tm:year now (+ (tm:year now) 1)))
|
||||
(set-tm:mon now (+ (tm:mon now)
|
||||
(+ 1 (modulo (tm:mon now) 3)))))
|
||||
(set-tm:mday now (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900)))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now)))
|
||||
|
||||
(define (gnc:get-today)
|
||||
(current-time))
|
||||
|
||||
(define (gnc:get-one-month-ago)
|
||||
(issue-deprecation-warning "gnc:get-one-month-ago is deprecated.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(if (= (tm:mon now) 0)
|
||||
(begin
|
||||
(set-tm:mon now 11)
|
||||
(set-tm:year now (- (tm:year now) 1)))
|
||||
(set-tm:mon now (- (tm:mon now) 1)))
|
||||
(let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900))))
|
||||
(if (< month-days (tm:mday now))
|
||||
(set-tm:mday now month-days))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now))))
|
||||
|
||||
(define (gnc:get-three-months-ago)
|
||||
(issue-deprecation-warning "gnc:get-three-months-ago is unused.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(if (< (tm:mon now) 3)
|
||||
(begin
|
||||
(set-tm:mon now (+ (tm:mon now) 12))
|
||||
(set-tm:year now (- (tm:year now) 1))))
|
||||
(set-tm:mon now (- (tm:mon now) 3))
|
||||
(let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900))))
|
||||
(if (< month-days (tm:mday now))
|
||||
(set-tm:mday now month-days))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now))))
|
||||
|
||||
(define (gnc:get-six-months-ago)
|
||||
(issue-deprecation-warning "gnc:get-six-months-ago is unused.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(if (< (tm:mon now) 6)
|
||||
(begin
|
||||
(set-tm:mon now (+ (tm:mon now) 12))
|
||||
(set-tm:year now (- (tm:year now) 1))))
|
||||
(set-tm:mon now (- (tm:mon now) 6))
|
||||
(let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900))))
|
||||
(if (< month-days (tm:mday now))
|
||||
(set-tm:mday now month-days))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now))))
|
||||
|
||||
(define (gnc:get-one-year-ago)
|
||||
(issue-deprecation-warning "gnc:get-one-year-ago is unused.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:year now (- (tm:year now) 1))
|
||||
(let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900))))
|
||||
(if (< month-days (tm:mday now))
|
||||
(set-tm:mday now month-days))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now))))
|
||||
|
||||
(define (gnc:get-one-month-ahead)
|
||||
(issue-deprecation-warning "gnc:get-one-month-ahead is deprecated.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(if (= (tm:mon now) 11)
|
||||
(begin
|
||||
(set-tm:mon now 0)
|
||||
(set-tm:year now (+ (tm:year now) 1)))
|
||||
(set-tm:mon now (+ (tm:mon now) 1)))
|
||||
(let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900))))
|
||||
(if (< month-days (tm:mday now))
|
||||
(set-tm:mday now month-days))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now))))
|
||||
|
||||
(define (gnc:get-three-months-ahead)
|
||||
(issue-deprecation-warning "gnc:get-three-months-ahead is unused.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(if (> (tm:mon now) 8)
|
||||
(begin
|
||||
(set-tm:mon now (- (tm:mon now) 9))
|
||||
(set-tm:year now (+ (tm:year now) 1))
|
||||
(set-tm:mon now (+ (tm:mon now) 3))))
|
||||
(let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900))))
|
||||
(if (< month-days (tm:mday now))
|
||||
(set-tm:mday now month-days))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now))))
|
||||
|
||||
(define (gnc:get-six-months-ahead)
|
||||
(issue-deprecation-warning "gnc:get-six-months-ahead is unused.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(if (> (tm:mon now) 5)
|
||||
(begin
|
||||
(set-tm:mon now (- (tm:mon now) 6))
|
||||
(set-tm:year now (+ (tm:year now) 1))
|
||||
(set-tm:mon now (+ (tm:mon now) 6))))
|
||||
(let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900))))
|
||||
(if (< month-days (tm:mday now))
|
||||
(set-tm:mday now month-days))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now))))
|
||||
|
||||
(define (gnc:get-one-year-ahead)
|
||||
(issue-deprecation-warning "gnc:get-one-year-ahead is unused.")
|
||||
(let ((now (gnc-localtime (current-time))))
|
||||
(set-tm:year now (+ (tm:year now) 1))
|
||||
(let ((month-days (gnc:days-in-month (+ (tm:mon now) 1)
|
||||
(+ (tm:year now) 1900))))
|
||||
(if (< month-days (tm:mday now))
|
||||
(set-tm:mday now month-days))
|
||||
(set-tm:isdst now -1)
|
||||
(gnc-mktime now))))
|
||||
|
||||
;; There is no GNC:RELATIVE-DATES list like the one mentioned in
|
||||
;; gnucash-design.info, is there? Here are the currently defined
|
||||
@ -943,20 +730,6 @@ Defaulting to today."))
|
||||
'store 'end-prev-year-desc
|
||||
(N_ "Last day of the previous calendar year."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'start-next-year-string
|
||||
(N_ "Start of next year"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'start-next-year-desc
|
||||
(N_ "First day of the next calendar year."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'end-next-year-string
|
||||
(N_ "End of next year"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'end-next-year-desc
|
||||
(N_ "Last day of the next calendar year."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'start-accounting-period-string
|
||||
(N_ "Start of accounting period"))
|
||||
@ -999,20 +772,6 @@ Defaulting to today."))
|
||||
'store 'end-prev-month-desc
|
||||
(N_ "Last day of previous month."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'start-next-month-string
|
||||
(N_ "Start of next month"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'start-next-month-desc
|
||||
(N_ "First day of the next month."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'end-next-month-string
|
||||
(N_ "End of next month"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'end-next-month-desc
|
||||
(N_ "Last day of next month."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'start-current-quarter-string
|
||||
(N_ "Start of current quarter"))
|
||||
@ -1041,84 +800,12 @@ Defaulting to today."))
|
||||
'store 'end-prev-quarter-desc
|
||||
(N_ "Last day of previous quarterly accounting period."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'start-next-quarter-string
|
||||
(N_ "Start of next quarter"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'start-next-quarter-desc
|
||||
(N_ "First day of the next quarterly accounting period."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'end-next-quarter-string
|
||||
(N_ "End of next quarter"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'end-next-quarter-desc
|
||||
(N_ "Last day of next quarterly accounting period."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'today-string
|
||||
(N_ "Today"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'today-desc (N_ "The current date."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-month-ago-string
|
||||
(N_ "One Month Ago"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-month-ago-desc (N_ "One Month Ago."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-week-ago-string
|
||||
(N_ "One Week Ago"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-week-ago-desc (N_ "One Week Ago."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'three-months-ago-string
|
||||
(N_ "Three Months Ago"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'three-months-ago-desc (N_ "Three Months Ago."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'six-months-ago-string
|
||||
(N_ "Six Months Ago"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'six-months-ago-desc (N_ "Six Months Ago."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-year-ago-string (N_ "One Year Ago"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-year-ago-desc (N_ "One Year Ago."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-month-ahead-string
|
||||
(N_ "One Month Ahead"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-month-ahead-desc (N_ "One Month Ahead."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-week-ahead-string
|
||||
(N_ "One Week Ahead"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-week-ahead-desc (N_ "One Week Ahead."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'three-months-ahead-string
|
||||
(N_ "Three Months Ahead"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'three-months-ahead-desc (N_ "Three Months Ahead."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'six-months-ahead-string
|
||||
(N_ "Six Months Ahead"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'six-months-ahead-desc (N_ "Six Months Ahead."))
|
||||
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-year-ahead-string (N_ "One Year Ahead"))
|
||||
(gnc:reldate-string-db
|
||||
'store 'one-year-ahead-desc (N_ "One Year Ahead."))
|
||||
|
||||
(set! gnc:relative-date-values
|
||||
(list
|
||||
(vector 'start-cal-year
|
||||
@ -1133,18 +820,10 @@ Defaulting to today."))
|
||||
(gnc:reldate-string-db 'lookup 'start-prev-year-string)
|
||||
(gnc:reldate-string-db 'lookup 'start-prev-year-desc)
|
||||
gnc:get-start-prev-year)
|
||||
(vector 'start-next-year
|
||||
(gnc:reldate-string-db 'lookup 'start-next-year-string)
|
||||
(gnc:reldate-string-db 'lookup 'start-next-year-desc)
|
||||
gnc:get-start-next-year)
|
||||
(vector 'end-prev-year
|
||||
(gnc:reldate-string-db 'lookup 'end-prev-year-string)
|
||||
(gnc:reldate-string-db 'lookup 'end-prev-year-desc)
|
||||
gnc:get-end-prev-year)
|
||||
(vector 'end-next-year
|
||||
(gnc:reldate-string-db 'lookup 'end-next-year-string)
|
||||
(gnc:reldate-string-db 'lookup 'end-next-year-desc)
|
||||
gnc:get-end-next-year)
|
||||
(vector 'start-accounting-period
|
||||
(gnc:reldate-string-db 'lookup 'start-accounting-period-string)
|
||||
(gnc:reldate-string-db 'lookup 'start-accounting-period-desc)
|
||||
@ -1169,14 +848,6 @@ Defaulting to today."))
|
||||
(gnc:reldate-string-db 'lookup 'end-prev-month-string)
|
||||
(gnc:reldate-string-db 'lookup 'end-prev-month-desc)
|
||||
gnc:get-end-prev-month)
|
||||
(vector 'start-next-month
|
||||
(gnc:reldate-string-db 'lookup 'start-next-month-string)
|
||||
(gnc:reldate-string-db 'lookup 'start-next-month-desc)
|
||||
gnc:get-start-next-month)
|
||||
(vector 'end-next-month
|
||||
(gnc:reldate-string-db 'lookup 'end-next-month-string)
|
||||
(gnc:reldate-string-db 'lookup 'end-next-month-desc)
|
||||
gnc:get-end-next-month)
|
||||
(vector 'start-current-quarter
|
||||
(gnc:reldate-string-db 'lookup 'start-current-quarter-string)
|
||||
(gnc:reldate-string-db 'lookup 'start-current-quarter-desc)
|
||||
@ -1193,50 +864,11 @@ Defaulting to today."))
|
||||
(gnc:reldate-string-db 'lookup 'end-prev-quarter-string)
|
||||
(gnc:reldate-string-db 'lookup 'end-prev-quarter-desc)
|
||||
gnc:get-end-prev-quarter)
|
||||
(vector 'start-next-quarter
|
||||
(gnc:reldate-string-db 'lookup 'start-next-quarter-string)
|
||||
(gnc:reldate-string-db 'lookup 'start-next-quarter-desc)
|
||||
gnc:get-start-next-quarter)
|
||||
(vector 'end-next-quarter
|
||||
(gnc:reldate-string-db 'lookup 'end-next-quarter-string)
|
||||
(gnc:reldate-string-db 'lookup 'end-next-quarter-desc)
|
||||
gnc:get-end-next-quarter)
|
||||
(vector 'today
|
||||
(gnc:reldate-string-db 'lookup 'today-string)
|
||||
(gnc:reldate-string-db 'lookup 'today-desc)
|
||||
gnc:get-today)
|
||||
(vector 'one-month-ago
|
||||
(gnc:reldate-string-db 'lookup 'one-month-ago-string)
|
||||
(gnc:reldate-string-db 'lookup 'one-month-ago-desc)
|
||||
gnc:get-one-month-ago)
|
||||
(vector 'three-months-ago
|
||||
(gnc:reldate-string-db 'lookup 'three-months-ago-string)
|
||||
(gnc:reldate-string-db 'lookup 'three-months-ago-desc)
|
||||
gnc:get-three-months-ago)
|
||||
(vector 'six-months-ago
|
||||
(gnc:reldate-string-db 'lookup 'six-months-ago-string)
|
||||
(gnc:reldate-string-db 'lookup 'six-months-ago-desc)
|
||||
gnc:get-three-months-ago)
|
||||
(vector 'one-year-ago
|
||||
(gnc:reldate-string-db 'lookup 'one-year-ago-string)
|
||||
(gnc:reldate-string-db 'lookup 'one-year-ago-desc)
|
||||
gnc:get-one-year-ago)
|
||||
(vector 'one-month-ahead
|
||||
(gnc:reldate-string-db 'lookup 'one-month-ahead-string)
|
||||
(gnc:reldate-string-db 'lookup 'one-month-ahead-desc)
|
||||
gnc:get-one-month-ahead)
|
||||
(vector 'three-months-ahead
|
||||
(gnc:reldate-string-db 'lookup 'three-months-ahead-string)
|
||||
(gnc:reldate-string-db 'lookup 'three-months-ahead-desc)
|
||||
gnc:get-three-months-ahead)
|
||||
(vector 'six-months-ahead
|
||||
(gnc:reldate-string-db 'lookup 'six-months-ahead-string)
|
||||
(gnc:reldate-string-db 'lookup 'six-months-ahead-desc)
|
||||
gnc:get-three-months-ahead)
|
||||
(vector 'one-year-ahead
|
||||
(gnc:reldate-string-db 'lookup 'one-year-ahead-string)
|
||||
(gnc:reldate-string-db 'lookup 'one-year-ahead-desc)
|
||||
gnc:get-one-year-ahead)))
|
||||
))
|
||||
|
||||
;; initialise gnc:relative-date-hash
|
||||
(set! gnc:relative-date-hash (make-hash-table))
|
||||
|
||||
@ -3986,27 +3986,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)
|
||||
{
|
||||
|
||||
@ -1050,18 +1050,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);
|
||||
|
||||
@ -73,16 +73,6 @@ gnc_add_scheme_targets(scm-tax-de_DE-3
|
||||
OUTPUT_DIR "gnucash/locale/de_DE"
|
||||
DEPENDS "scm-tax-de_DE-2;${GUILE_DEPENDS}")
|
||||
|
||||
# Module interfaces deprecated in 4.x, will be removed for 5.x
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash tax de_DE"
|
||||
NEW_MODULE "gnucash locale de_DE tax"
|
||||
DEPENDS "scm-tax-de_DE-3")
|
||||
gnc_add_scheme_deprecated_module (
|
||||
OLD_MODULE "gnucash tax us"
|
||||
NEW_MODULE "gnucash locale us tax"
|
||||
DEPENDS "scm-tax-us-3")
|
||||
|
||||
add_custom_target(scm-locale-tax ALL DEPENDS scm-tax-us-1 scm-tax-us-2 scm-tax-us-3 scm-tax-de_DE-1 scm-tax-de_DE-2 scm-tax-de_DE-3)
|
||||
|
||||
set(de_DE_tax_EXTRA_DIST
|
||||
|
||||
@ -9,7 +9,6 @@ bindings/guile/gnc-engine-guile.c
|
||||
bindings/guile/gnc-guile-bindings.c
|
||||
bindings/guile/gnc-guile-utils.c
|
||||
bindings/guile/gnc-kvp-guile.cpp
|
||||
bindings/guile/gnc-module.scm
|
||||
bindings/guile/gnc-numeric.scm
|
||||
bindings/guile/utilities.scm
|
||||
bindings/python/app_utils.py
|
||||
@ -443,13 +442,9 @@ gnucash/report/eguile-utilities.scm
|
||||
gnucash/report/gnc-report.c
|
||||
gnucash/report/html-acct-table.scm
|
||||
gnucash/report/html-anytag.scm
|
||||
gnucash/report/html-barchart.scm
|
||||
gnucash/report/html-chart.scm
|
||||
gnucash/report/html-document.scm
|
||||
gnucash/report/html-fonts.scm
|
||||
gnucash/report/html-linechart.scm
|
||||
gnucash/report/html-piechart.scm
|
||||
gnucash/report/html-scatter.scm
|
||||
gnucash/report/html-style-info.scm
|
||||
gnucash/report/html-style-sheet.scm
|
||||
gnucash/report/html-table.scm
|
||||
@ -458,7 +453,6 @@ gnucash/report/html-utilities.scm
|
||||
gnucash/report/options-utilities.scm
|
||||
gnucash/report/report-core.scm
|
||||
gnucash/report/report-register-hooks.scm
|
||||
gnucash/report/reports/aging.scm
|
||||
gnucash/report/reports/cash-flow-calc.scm
|
||||
gnucash/report/reports/example/average-balance.scm
|
||||
gnucash/report/reports/example/daily-reports.scm
|
||||
@ -492,17 +486,13 @@ gnucash/report/reports/standard/ifrs-cost-basis.scm
|
||||
gnucash/report/reports/standard/income-gst-statement.scm
|
||||
gnucash/report/reports/standard/income-statement.scm
|
||||
gnucash/report/reports/standard/invoice.scm
|
||||
gnucash/report/reports/standard/job-report.scm
|
||||
gnucash/report/reports/standard/lot-viewer.scm
|
||||
gnucash/report/reports/standard/net-charts.scm
|
||||
gnucash/report/reports/standard/new-aging.scm
|
||||
gnucash/report/reports/standard/new-owner-report.scm
|
||||
gnucash/report/reports/standard/owner-report.scm
|
||||
gnucash/report/reports/standard/payables.scm
|
||||
gnucash/report/reports/standard/portfolio.scm
|
||||
gnucash/report/reports/standard/price-scatter.scm
|
||||
gnucash/report/reports/standard/receipt.scm
|
||||
gnucash/report/reports/standard/receivables.scm
|
||||
gnucash/report/reports/standard/reconcile-report.scm
|
||||
gnucash/report/reports/standard/register.scm
|
||||
gnucash/report/reports/standard/taxinvoice.scm
|
||||
|
||||
Loading…
Reference in New Issue
Block a user