gnucash master: Remove guile functions that were marked as deprecated in gnucash the 3.x series
Geert Janssens
gjanssens at code.gnucash.org
Wed Jun 12 11:01:08 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/30ac2cf2 (commit)
from https://github.com/Gnucash/gnucash/commit/30696479 (commit)
commit 30ac2cf266aaa76e6e26eb009c8660c8469337f3
Author: Geert Janssens <geert at kobaltwit.be>
Date: Sat Jun 8 14:09:40 2019 +0200
Remove guile functions that were marked as deprecated in gnucash the 3.x series
diff --git a/gnucash/report/report-system/CMakeLists.txt b/gnucash/report/report-system/CMakeLists.txt
index 1d69dc32e..293e1926a 100644
--- a/gnucash/report/report-system/CMakeLists.txt
+++ b/gnucash/report/report-system/CMakeLists.txt
@@ -50,15 +50,7 @@ set (report_system_SCHEME
eguile-html-utilities.scm
)
-set (report_system_SCHEME_2a
- collectors.scm
-)
-
-set (report_system_SCHEME_2b
- report-collectors.scm
-)
-
-set (report_system_SCHEME_3
+set (report_system_SCHEME_2
commodity-utilities.scm
html-acct-table.scm
html-chart.scm
@@ -97,34 +89,19 @@ gnc_add_scheme_targets(scm-report-system-1
FALSE
)
-gnc_add_scheme_targets(scm-report-system-2a
- "${report_system_SCHEME_2a}"
- "gnucash/report/report-system"
- scm-report-system-1
- FALSE
-)
-
-gnc_add_scheme_targets(scm-report-system-2b
- "${report_system_SCHEME_2b}"
- "gnucash/report/report-system"
- scm-report-system-2a
- FALSE
-)
-
-gnc_add_scheme_targets(scm-report-system-3
- "${report_system_SCHEME_3}"
+gnc_add_scheme_targets(scm-report-system-2
+ "${report_system_SCHEME_2}"
""
- scm-report-system-2b
+ scm-report-system-1
FALSE
)
-add_custom_target(scm-report-system ALL DEPENDS scm-report-system-3)
+add_custom_target(scm-report-system ALL DEPENDS scm-report-system-2)
set_local_dist(report_system_DIST_local CMakeLists.txt
report-system.i
${report_system_HEADERS} ${report_system_SOURCES}
${report_system_SCHEME} ${report_system_SCHEME_1}
- ${report_system_SCHEME_2a} ${report_system_SCHEME_2b}
- ${report_system_SCHEME_3})
+ ${report_system_SCHEME_2})
set(report_system_DIST ${report_system_DIST_local} ${test_report_system_DIST} PARENT_SCOPE)
diff --git a/gnucash/report/report-system/collectors.scm b/gnucash/report/report-system/collectors.scm
deleted file mode 100644
index 1731c0e8f..000000000
--- a/gnucash/report/report-system/collectors.scm
+++ /dev/null
@@ -1,351 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, contact:
-;;
-;; Free Software Foundation Voice: +1-617-542-5942
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash report report-system collectors))
-
-(issue-deprecation-warning
- "(gnucash report report-system collectors) is deprecated.")
-
-(use-modules (srfi srfi-1))
-
-(export make-filter)
-(export filter-satisfies)
-(export filter-id)
-(export assert-filter)
-(export make-equal-filter)
-(export make-predicate-filter)
-
-(export make-collector)
-(export collector-accumulate-from)
-(export collector-count-from)
-(export collector-into-list)
-(export collector-per-property)
-(export collector-filtered-list)
-(export collector-split)
-(export make-mapper-collector)
-(export make-list-collector)
-(export collector-from-slotset)
-(export labelled-collector-from-slotset)
-(export collector-add)
-(export collector-end)
-(export assert-collector)
-(export collector-add-all)
-(export collector-where)
-(export collector-reformat)
-(export collector-print)
-(export collector-do)
-(export function-state->collector)
-(export make-eq-set-collector)
-(export make-extreme-collector)
-
-(export make-slotset)
-(export slotset?)
-(export slotset-slots)
-(export slotset-slot)
-(export hashmap->slotset)
-(export alist->slotset)
-(export slotset-check)
-(export slotset-map-input)
-
-(export binary-search-lt)
-
-;; Filters
-(define (make-filter id predicate)
- (list 'filter id predicate))
-
-(define (filter? filter)
- (eq? (car filter) 'filter))
-
-(define (assert-filter filter)
- (if (filter? filter) #t
- (throw (list "not a filter" filter))))
-
-(define (filter-satisfies filter object)
- (assert-filter filter)
- (let ((predicate (third filter)))
- (predicate object)))
-
-(define (filter-id filter)
- (assert-filter filter)
- (second filter))
-
-(define (make-predicate-filter id predicate)
- (make-filter id predicate))
-
-
-(define (make-equal-filter x)
- (make-filter x
- (lambda (value)
- (equal? x value))))
-
-;;
-;; SlotSet
-;;
-
-(define (make-slotset value->slot slots)
- (if (not (procedure? value->slot))
- (throw 'not-a-procedure value->slot))
- (if (not (pair? slots))
- (throw 'not-a-list slots))
- (list 'slotset value->slot slots))
-
-(define (slotset? slotset)
- (eq? (car slotset) 'slotset))
-
-(define (assert-slotset slotset)
- (if (slotset? slotset) #t
- (throw (list "not a slotset" slotset))))
-
-(define (slotset-slots slotset)
- (assert-slotset slotset)
- (third slotset))
-
-(define (slotset-slot slotset value)
- (assert-slotset slotset)
- ((second slotset) value))
-
-(define (slotset-map-input mapfn orig-slotset)
- (let ((orig-slotset-slot (second orig-slotset))
- (orig-slotset-slots (third orig-slotset)))
- (make-slotset (lambda (v) (orig-slotset-slot (mapfn v)))
- orig-slotset-slots)))
-
-(define (hashmap->slotset hashmap)
- (make-slotset (lambda (v)
- (hash-ref hashmap v))
- (hashmap->list (lambda (key value) value) hashmap)))
-
-(define (alist->slotset alist)
- (make-slotset (lambda (v) (assoc-ref alist v))
- (hash-map->list (lambda (key value) key)
- (fold (lambda (val h)
- (hash-set! h val val)
- h)
- (make-hash-table)
- (map cdr alist)))))
-
-(define (slotset-check slotset)
- (assert-slotset slotset)
- (make-slotset (lambda (value)
- (let ((result (slotset-slot value)))
- (if (member result (third slotset))
- (throw (list 'slotset-to-non-value))
- result)))
- (third slotset)))
-;;
-;; Collectors
-;;
-
-(define (make-collector f1 f2)
- (list 'collector f1 f2))
-
-(define (collector-add collector value)
- (assert-collector collector)
- (let ((result ((second collector) value)))
- (assert-collector result)
- result))
-
-(define (collector-end collector)
- (assert-collector collector)
- (let ((fn (third collector)))
- (fn)))
-
-(define (collector-print stream name collector)
- (make-collector (lambda (value) (format stream "(add ~a ~a)\n" name value)
- (collector-print stream name (collector-add collector value)))
- (lambda () (let ((result (collector-end collector)))
- (format stream "(result ~a ~a)\n" name result)
- result))))
-
-
-(define (collector? collector)
- (and (list? collector)
- (eq? (car collector) 'collector)))
-
-(define (assert-collector collector)
- (if (collector? collector) #t
- (throw 'error (list "not a collector" collector))))
-
-(define (collector-add-all collector values)
- (if (null-list? values) (collector-end collector)
- (collector-add-all (collector-add collector (car values))
- (cdr values))))
-
-(define (collector-accumulate-from total)
- (make-collector (lambda (x) (collector-accumulate-from (+ total x)))
- (lambda () total)))
-
-(define (collector-count-from total)
- (make-collector (lambda (x) (collector-count-from (+ total 1)))
- (lambda () total)))
-
-(define (collector-into-list)
- (define (collect-into l)
- (make-collector (lambda (x) (collect-into (cons x l)))
- (lambda () (reverse! l))))
- (collect-into '()))
-
-(define (collector-per-property items make-property-filter make-per-property-collector)
- (let ((collectors (map (lambda (item)
- (cons (make-property-filter item)
- (make-per-property-collector item)))
- items)))
- (collector-filtered-list collectors)))
-
-(define (collector-filtered-list filter-collector-pairs)
- (define (mapfn sublist value)
- (let ((pair (car sublist))
- (rest (cdr sublist)))
- (if (filter-satisfies (car pair) value)
- (cons (cons (car pair) (collector-add (cdr pair) value))
- rest)
- (cons pair (mapfn rest value)))))
- (make-collector
- (lambda (value)
- (collector-filtered-list (mapfn filter-collector-pairs value)))
- (lambda () (map (lambda (pair)
- (cons (filter-id (car pair))
- (collector-end (cdr pair))))
- filter-collector-pairs))))
-
-;; Breaks a sequence of items into a list of collectors by property
-
-(define (collector-split prop-fn make-per-split-collector)
- (let ((list '()))
- (define collector (make-collector (lambda (value)
- (let* ((prop (prop-fn value))
- (elt (assoc prop list)))
- (if elt
- (begin
- (set-cdr! elt (collector-add (cdr elt) value))
- collector)
- (begin (set! list (cons (cons prop
- (collector-add (make-per-split-collector prop)
- value))
- list))
- collector))))
- (lambda ()
- (map (lambda (pair) (cons (car pair)
- (collector-end (cdr pair))))
- list))))
- collector))
-
-(define (make-eq-set-collector list)
- (define collector (make-collector
- (lambda (value)
- (if (memq value list) collector
- (make-eq-set-collector (cons value list))))
- (lambda () list)))
- collector)
-
-(define (make-extreme-collector ordering current)
- (define collector (make-collector (lambda (value)
- (if (ordering value current)
- (make-extreme-collector ordering value)
- collector))
- (lambda () current)))
- collector)
-
-
-(define (collector-where pred collector)
- (define new-collector
- (make-collector (lambda (value)
- (if (pred value)
- (begin ;(format #t "accept ~a\n" value)
- (collector-where pred
- (collector-add collector value)))
- new-collector))
- (lambda () (collector-end collector))))
- new-collector)
-
-(define (make-mapper-collector mapfn collector)
- (make-collector (lambda (value)
- (make-mapper-collector mapfn (collector-add collector (mapfn value))))
- (lambda () (collector-end collector))))
-
-(define (collector-reformat formatter collector)
- (make-collector (lambda (value)
- (collector-reformat formatter (collector-add collector value)))
- (lambda () (formatter (collector-end collector)))))
-
-
-(define (make-list-collector collectors)
- (make-collector (lambda (value)
- (make-list-collector (map (lambda (inner-collector)
- (collector-add inner-collector value))
- collectors)))
- (lambda () (map collector-end collectors))))
-
-
-(define (collector-from-slotset slotset slot-collector)
- (define (make-table)
- (let ((valuemap (make-hash-table)))
- (for-each (lambda (slot)
- (hash-set! valuemap slot (slot-collector slot)))
- (slotset-slots slotset))
- valuemap))
- (let ((valuemap (make-table)))
- (define collector
- (make-collector (lambda (value)
- (let* ((slot (slotset-slot slotset value)))
- (hash-set! valuemap slot
- (collector-add (hash-ref valuemap slot)
- value)))
- collector)
- (lambda () (map (lambda (slot)
- (collector-end (hash-ref valuemap slot)))
- (slotset-slots slotset)))))
- collector))
-
-(define (labelled-collector-from-slotset slotset slot-collector)
- (collector-from-slotset slotset
- (lambda (slot)
- (collector-reformat (lambda (result)
- (cons slot result))
- (slot-collector slot)))))
-
-
-(define (function-state->collector fn state)
- (make-collector (lambda (value)
- (let ((next (fn value state)))
- (function-state->collector fn next)))
- (lambda ()
- state)))
-
-(define (collector-do collector . other-collectors)
- (collector-reformat (lambda (final)
- (car final))
- (make-list-collector (cons collector other-collectors))))
-
-
-;; Binary search. Returns highest index with content less than or
-;; equal to the supplied value.
-
-(define (binary-search-lt <= val vec)
- (and (not (zero? (vector-length vec)))
- (let loop ((low 0)
- (high (1- (vector-length vec))))
- (let* ((midpoint (ceiling (/ (+ low high) 2)))
- (midvalue (vector-ref vec midpoint)))
- (if (= low high)
- (and (<= midvalue val)
- low)
- (if (<= midvalue val)
- (loop midpoint high)
- (loop low (1- midpoint))))))))
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index 65c203259..a68247814 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -76,13 +76,6 @@
;; Functions to create some list of prices from data in transactions.
-;; Helper for warnings below.
-(define (gnc-commodity-numeric->string commodity numeric)
- (issue-deprecation-warning "gnc-commodity-numeric->string deprecated. \
-construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
- (gnc:monetary->string
- (gnc:make-gnc-monetary commodity numeric)))
-
;; Helper for exchange below
(define (gnc:exchange-by-euro-numeric
foreign-commodity foreign-numeric domestic date)
@@ -266,31 +259,6 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
(loop result
(cdr commodity-splits))))))))
-;; Get the instantaneous prices for all commodities in
-;; 'commodity-list', i.e. the same thing as get-commodity-inst-prices
-;; but extended to a commodity-list. Returns an alist. Each pair
-;; consists of the foreign-currency and the appropriate list from
-;; gnc:get-commodity-inst-prices, see there.
-(define (gnc:get-commoditylist-inst-prices
- commodity-list report-currency end-date
- start-percent delta-percent)
- (issue-deprecation-warning
- "gnc:get-commoditylist-inst-prices is deprecated.")
- (let ((currency-accounts
- (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
- (work-to-do (length commodity-list)))
- (map
- (lambda (c work-done)
- (if start-percent
- (gnc:report-percent-done
- (+ start-percent (* delta-percent (/ work-done work-to-do)))))
- (cons c
- (gnc:get-commodity-inst-prices
- currency-accounts end-date c report-currency)))
- commodity-list
- (iota work-to-do))))
-
-
;; Find the price in 'pricelist' that's nearest to 'date'. The
;; pricelist comes from
;; e.g. gnc:get-commodity-totalavg-prices. Returns a <gnc-numeric> or,
@@ -704,50 +672,6 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
(* (gnc:gnc-monetary-amount foreign) (cadr pair))
0)))))))
-;; Helper for the gnc:exchange-by-pricalist* below. Exchange the
-;; <gnc:monetary> 'foreign' into the <gnc:commodity*> 'domestic' by
-;; the <gnc:numeric> 'price-value'. Returns a <gnc:monetary>.
-(define (gnc:exchange-by-pricevalue-helper
- foreign domestic price-value)
- (issue-deprecation-warning
- "gnc:exchange-by-pricevalue-helper is deprecated. please inline function.")
- (and (gnc:gnc-monetary? foreign)
- (gnc:make-gnc-monetary
- domestic
- (if price-value
- (* (gnc:gnc-monetary-amount foreign)
- price-value)
- (begin
- (warn "gnc:exchange-by-pricevalue-helper: No price found for "
- (gnc:monetary->string foreign) " into "
- (gnc:monetary->string
- (gnc:make-gnc-monetary domestic 0)))
- 0)))))
-
-;; Helper for gnc:exchange-by-pricedb-* below. 'price' gets tested for
-;; #f here, and gets unref'd here too. Exchange the <gnc:monetary>
-;; 'foreign' into the <gnc:commodity*> 'domestic' by the <gnc:Price>
-;; 'price'. Returns a <gnc:monetary>.
-(define (gnc:exchange-by-pricedb-helper
- foreign domestic price)
- (issue-deprecation-warning
- "gnc:exchange-by-pricedb-helper is deprecated.")
- (and (gnc:gnc-monetary? foreign)
- (gnc:make-gnc-monetary
- domestic
- (if price
- (let ((result
- (* (gnc:gnc-monetary-amount foreign)
- (gnc-price-get-value price))))
- (gnc-price-unref price)
- result)
- (begin
- (warn "gnc:exchange-by-pricedb-helper: No price found for "
- (gnc:monetary->string foreign) " into "
- (gnc:monetary->string
- (gnc:make-gnc-monetary domestic 0)))
- 0)))))
-
;; This is another ready-to-use function for calculation of exchange
;; rates. (Note that this is already the function itself. It doesn't
;; return a function as opposed to make-exchange-function.) It takes
@@ -876,18 +800,6 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
(lambda (foreign domestic date)
(gnc:exchange-by-pricealist-nearest
pricealist foreign domestic date))))
- ;; actual-transactions isn't used, at least not as a value passed to this
- ;; function. price-scatter.scm does use it but calls
- ;; gnc:get-commodity-inst-prices directly.
- ((actual-transactions) (let ((pricealist
- (gnc:get-commoditylist-inst-prices
- commodity-list report-currency to-date-tp
- start-percent delta-percent)))
- (issue-deprecation-warning
- "this path is never reached in code.")
- (lambda (foreign domestic date)
- (gnc:exchange-by-pricealist-nearest
- pricealist foreign domestic date))))
((pricedb-latest) (lambda (foreign domestic date)
(gnc:exchange-by-pricedb-latest foreign domestic)))
((pricedb-nearest) gnc:exchange-by-pricedb-nearest)
@@ -961,18 +873,6 @@ construct with gnc:make-gnc-monetary and gnc:monetary->string instead.")
#f)
balance)))
-(define (gnc-commodity-collector-commodity-count collector)
- (issue-deprecation-warning
- "gnc-commodity-collector-commodity-count is deprecated. please inline.")
- (length (collector 'format (lambda (comm amt) comm) #f)))
-
-(define (gnc-commodity-collector-contains-commodity? collector commodity)
- (issue-deprecation-warning
- "gnc-commodity-collector-contains-commodity? is deprecated. please inline.")
- (member commodity
- (collector 'format (lambda (comm amt) comm) #f)
- gnc-commodity-equiv))
-
(define (gnc:uniform-commodity? amt report-commodity)
;; function to see if the commodity-collector amt
;; contains any foreign commodities
diff --git a/gnucash/report/report-system/options-utilities.scm b/gnucash/report/report-system/options-utilities.scm
index 43d8bbb25..29a7840d8 100644
--- a/gnucash/report/report-system/options-utilities.scm
+++ b/gnucash/report/report-system/options-utilities.scm
@@ -118,28 +118,6 @@
default-accounts
#f #t)))
-;; The single checkbox whether to include the sub-account balances
-;; into the other balances.
-(define (gnc:options-add-include-subaccounts!
- options pagename optname sort-tag)
- (issue-deprecation-warning "gnc:options-add-include-subaccounts! is deprecated.")
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- pagename optname
- sort-tag (N_ "Include sub-account balances in printed balance?") #t)))
-
-;; The single checkbox whether to group the accounts into main
-;; categories and ahow a subtotal for those.
-(define (gnc:options-add-group-accounts!
- options pagename optname sort-tag default?)
- (issue-deprecation-warning "gnc:options-add-group-accounts! is deprecated.")
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- pagename optname
- sort-tag (N_ "Group the accounts in main categories?") default?)))
-
;; To let the user select a currency for the report.
(define (gnc:options-add-currency!
options pagename name-report-currency sort-tag)
@@ -151,22 +129,6 @@
(N_ "Select the currency to display the values of this report in.")
(gnc-default-report-currency))))
-;; These are common options for the selection of the report's
-;; currency/commodity.
-(define (gnc:options-add-currency-selection!
- options pagename
- name-show-foreign name-report-currency sort-tag)
- (issue-deprecation-warning "gnc:options-add-currency-selection! is deprecated.")
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- pagename name-show-foreign
- (string-append sort-tag "a")
- (N_ "Display the account's foreign currency amount?") #f))
-
- (gnc:options-add-currency! options pagename name-report-currency
- (string-append sort-tag "b")))
-
;; A multichoice option for the source of prices
(define (gnc:options-add-price-source!
options pagename optname sort-tag default)
diff --git a/gnucash/report/report-system/report-collectors.scm b/gnucash/report/report-system/report-collectors.scm
deleted file mode 100644
index 90375c551..000000000
--- a/gnucash/report/report-system/report-collectors.scm
+++ /dev/null
@@ -1,231 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, contact:
-;;
-;; Free Software Foundation Voice: +1-617-542-5942
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash report report-system report-collectors))
-
-(issue-deprecation-warning
- "(gnucash report report-system report-collectors) is deprecated.")
-
-(use-modules (gnucash gnc-module))
-(gnc:module-load "gnucash/report/report-system" 0)
-
-(use-modules (ice-9 format))
-(use-modules (srfi srfi-1))
-
-(use-modules (gnucash utilities))
-(use-modules (gnucash report report-system))
-(use-modules (gnucash app-utils))
-(use-modules (gnucash engine))
-(use-modules (gnucash report report-system collectors))
-
-(export account-destination-alist)
-(export category-by-account-report)
-(export category-by-account-report-work)
-(export category-by-account-report-do-work)
-(export make-gnc-collector-collector)
-
-(export splits-up-to)
-(export split->commodity)
-
-(define (split->commodity split)
- (xaccAccountGetCommodity (xaccSplitGetAccount split)))
-
-(define (split->date split)
- (xaccTransGetDate (xaccSplitGetParent split)))
-
-(define (split->account split)
- (xaccSplitGetAccount split))
-
-(define (split-closing? split)
- (xaccTransGetIsClosingTxn (xaccSplitGetParent split)))
-
-(define (splits-up-to accounts startdate enddate)
- (gnc:account-get-trans-type-splits-interval accounts #f
- startdate
- enddate))
-
-(define (make-gnc-collector-collector)
- (let ((gnc-collector (gnc:make-commodity-collector)))
- (define collector
- (make-collector (lambda (split)
- (let* ((shares (xaccSplitGetAmount split))
- (acct-comm (split->commodity split)))
- (gnc-collector 'add acct-comm shares)
- collector))
- (lambda () gnc-collector)))
- collector))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Plan:
-;; We create reports via collectors - effectively per account, per date stores of values.
-;; Values are held as report-system/collector objects (sorry about the name reuse..),
-;; which can then be evaluated by a collector-reformat step.
-;;
-;; For a given report, we want to retrieve relevant transactions once
-;; (this is the splits-up-to function), and then push the transactions
-;; into a collector structure. This way there's no O(n^2) or worse
-;; complexity.
-
-(define (build-account-collector account-destination-alist
- per-account-collector)
- (let ((slotset (slotset-map-input split->account
- (alist->slotset account-destination-alist))))
- (collector-from-slotset slotset per-account-collector)))
-
-(define (build-date-collector dates per-date-collector)
- (let* ((date-vector (list->vector dates))
- (slotset (make-slotset (lambda (split)
- (let* ((date (split->date split))
- (interval-index (binary-search-lt (lambda (pair date)
- (or (not (car pair))
- (<= (car pair) date)))
- date
- date-vector))
- (interval (vector-ref date-vector interval-index)))
- interval))
- dates)))
- (collector-from-slotset slotset per-date-collector)))
-
-(define (build-category-by-account-collector account-destination-alist dates cell-accumulator result-collector)
- (build-account-collector account-destination-alist
- (lambda (account)
- (collector-reformat (lambda (result)
- (list account (result-collector account result)))
- (build-date-collector dates
- (lambda (date)
- (cell-accumulator account date)))))))
-
-(define (category-by-account-report do-intervals? datepairs account-alist
- split-collector result-collector progress-range)
- (let* ((work (category-by-account-report-work do-intervals? datepairs
- account-alist split-collector result-collector))
- (splits-fn (car work))
- (collector (cdr work))
- (splits (splits-fn)))
- (collector-add-all (collector-do collector
- (progress-collector (length splits) progress-range))
- splits)))
-
-(define (category-by-account-report-do-work work progress-range)
- (let* ((splits-fn (car work))
- (collector (cdr work))
- (splits (splits-fn)))
- (collector-add-all (collector-do collector
- (progress-collector (length splits) progress-range))
- splits)))
-
-;; Decide how to run the given report (but don't actually do any work)
-
-(define (category-by-account-report-work do-intervals? dates account-alist
- split-collector result-collector)
- (let* ((dateinfo (if do-intervals?
- (category-report-dates-intervals dates)
- (category-report-dates-accumulate dates)))
- (processed-dates (third dateinfo))
- (splits-fn (lambda () (category-report-splits dateinfo account-alist)))
- (collector (collector-where (lambda (split) (not (split-closing? split)))
- (build-category-by-account-collector account-alist
- processed-dates split-collector
- result-collector))))
- (cons splits-fn collector)))
-
-(define (category-report-splits dateinfo account-alist)
- (let ((min-date (first dateinfo))
- (max-date (second dateinfo)))
- (splits-up-to (map car account-alist) min-date max-date)))
-
-(define (category-report-dates-intervals dates)
- (let* ((min-date (apply min (map first dates)))
- (max-date (apply max (map second dates))))
- (list min-date max-date dates)))
-
-(define (category-report-dates-accumulate dates)
- (let* ((min-date #f)
- (max-date (apply max dates))
- (datepairs (reverse! (cdr (fold (lambda (next acc)
- (let ((prev (car acc))
- (pairs-so-far (cdr acc)))
- (cons next (cons (list prev next) pairs-so-far))))
- (cons min-date '()) dates)))))
- (list min-date max-date datepairs)))
-
-
-
-(define (progress-collector size range)
- (let* ((from (car range))
- (to (cdr range))
- (width (- to from)))
- (define (count->percentage count)
- (+ (* width (/ count size)) from))
- (function-state->collector (lambda (value state)
- (let ((last (floor (count->percentage (- state 1))))
- (next (floor (count->percentage state))))
- (if (not (= last next))
- (gnc:report-percent-done (+ (* width (/ state size)) from)))
- (+ state 1)))
- 0)))
-
-(define (gnc-account-child-accounts-recursive account)
- (define (helper account initial)
- (fold (lambda (child-account accumulator)
- (append (helper child-account (list child-account))
- accumulator))
- initial
- (gnc-account-get-children account)))
- (helper account '()))
-
-(define (traverse-accounts tree-depth show-acct? account-types)
- (define (inner-traverse-accounts current-depth accounts)
- (if (< current-depth tree-depth)
- (let ((res '()))
- (for-each
- (lambda (a)
- (begin
- (if (show-acct? a)
- (set! res
- (cons (cons a a) res)))
- (set! res (append
- (inner-traverse-accounts
- (+ 1 current-depth)
- (gnc-account-get-children a))
- res))))
- accounts)
- res)
- ;; else (i.e. current-depth == tree-depth)
- (fold (lambda (account acc)
- (let ((child-accounts (gnc-account-child-accounts-recursive account)))
- (append (map (lambda (child-account)
- (cons child-account account))
- child-accounts)
- (list (cons account account))
- acc)))
- '()
- (filter show-acct? accounts))))
- (let* ((topl-accounts (gnc:filter-accountlist-type
- account-types
- (gnc-account-get-children-sorted
- (gnc-get-current-root-account))))
- (account-head-list (inner-traverse-accounts 1 topl-accounts)))
- account-head-list))
-
-(define (account-destination-alist accounts account-types tree-depth)
- (define (show-acct? a)
- (member a accounts))
- (traverse-accounts tree-depth show-acct? account-types))
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index 2ecd48f5a..ee122b434 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -41,12 +41,10 @@
(export gnc:get-match-commodity-splits)
(export gnc:get-match-commodity-splits-sorted)
(export gnc:get-all-commodity-splits )
-(export gnc-commodity-numeric->string)
(export gnc:exchange-by-euro-numeric)
(export gnc:get-commodity-totalavg-prices)
(export gnc:get-commoditylist-totalavg-prices)
(export gnc:get-commodity-inst-prices)
-(export gnc:get-commoditylist-inst-prices)
(export gnc:pricelist-price-find-nearest)
(export gnc:pricealist-lookup-nearest-in-time)
(export gnc:resolve-unknown-comm)
@@ -57,8 +55,6 @@
(export gnc:exchange-by-euro)
(export gnc:exchange-if-same)
(export gnc:make-exchange-function)
-(export gnc:exchange-by-pricevalue-helper) ;deprecated
-(export gnc:exchange-by-pricedb-helper)
(export gnc:exchange-by-pricedb-latest )
(export gnc:exchange-by-pricedb-nearest)
(export gnc:exchange-by-pricealist-nearest)
@@ -66,7 +62,6 @@
(export gnc:case-exchange-time-fn)
(export gnc:sum-collector-commodity)
(export gnc:sum-collector-stocks)
-(export gnc-commodity-collector-contains-commodity?) ;deprecated
;; options-utilities.scm
@@ -75,10 +70,7 @@
(export gnc:options-add-interval-choice!)
(export gnc:options-add-account-levels!)
(export gnc:options-add-account-selection!)
-(export gnc:options-add-include-subaccounts!) ;deprecated
-(export gnc:options-add-group-accounts!) ;deprecated
(export gnc:options-add-currency!)
-(export gnc:options-add-currency-selection!) ;deprecated
(export gnc:options-add-price-source!)
(export gnc:options-add-plot-size!)
(export gnc:options-add-marker-choice!)
@@ -206,14 +198,6 @@
(export gnc:report-embedded-list)
(export gnc:report-template-is-custom/template-guid?)
(export gnc:is-custom-report-type)
-;; Legacy : the following 3 functions are only needed to
-;; load a saved-reports file version 2.0
-(export gnc:report-template-new-options/name)
-(export gnc:report-template-menu-name/name)
-(export gnc:report-template-renderer/name)
-;; Legacy: this function is needed only to restore
-;; a open report when loading a book last saved in GnuCash 2.2
-(export gnc:restore-report)
;; html-barchart.scm
@@ -705,7 +689,6 @@
(export list-ref-safe)
(export list-set-safe!)
-(export gnc-commodity-value->string)
(export gnc:monetary->string)
(export gnc:account-has-shares?)
(export gnc:account-is-stock?)
@@ -716,15 +699,10 @@
(export gnc:accounts-get-commodities)
(export gnc:get-current-account-tree-depth)
(export gnc:acccounts-get-all-subaccounts)
-(export gnc:make-stats-collector) ;deprecated
-(export gnc:make-drcr-collector) ;deprecated
(export gnc:make-value-collector)
(export gnc:make-number-collector) ;deprecated
(export gnc:make-commodity-collector)
(export gnc:commodity-collector-get-negated)
-(export gnc:commodity-collectorlist-get-merged) ;deprecated
-(export gnc-commodity-collector-commodity-count)
-(export gnc:account-get-balance-at-date)
(export gnc:account-get-balances-at-dates)
(export gnc:account-get-comm-balance-at-date)
(export gnc:account-get-comm-value-interval)
@@ -753,10 +731,7 @@
(export gnc:monetaries-add)
(export gnc:account-get-trans-type-balance-interval)
(export gnc:account-get-trans-type-balance-interval-with-closing)
-(export gnc:account-get-total-flow) ;deprecated
-(export gnc:account-get-pos-trans-total-interval)
(export gnc:account-get-trans-type-splits-interval)
-(export gnc:double-col) ;deprecated
(export gnc:budget-get-start-date)
(export gnc:budget-get-end-date)
(export gnc:budget-account-get-net)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index e37ce42e2..690dda731 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -36,14 +36,6 @@
(set! l (append! l filler)))))
l)
-;; pair is a list of one gnc:commodity and one gnc:numeric
-;; value. Deprecated -- use <gnc-monetary> instead.
-(define (gnc-commodity-value->string pair)
- (issue-deprecation-warning "gnc-commodity-value->string deprecated. \
-construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
- (xaccPrintAmount
- (cadr pair) (gnc-commodity-print-info (car pair) #t)))
-
;; Just for convenience. But in reports you should rather stick to the
;; style-info mechanism and simple plug the <gnc-monetary> into the
;; html-renderer.
@@ -176,71 +168,6 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
;; I might just go for the record-and-function-set way. <rlb> cstim:
;; yes. I think that would still be faster.
-(define (gnc:make-stats-collector)
- (issue-deprecation-warning
- "gnc:make-stats-collector is obsolete. use srfi-1 functions instead.")
- (let ((value 0)
- (totalitems 0)
- (maximum -inf.0)
- (minimum +inf.0))
- (let ((adder (lambda (amount)
- (when (number? amount)
- (set! value (+ amount value))
- (if (> amount maximum) (set! maximum amount))
- (if (< amount minimum) (set! minimum amount))
- (set! totalitems (1+ totalitems)))))
- (getnumitems (lambda () totalitems))
- (gettotal (lambda () value))
- (getaverage (lambda () (/ value totalitems)))
- (getmax (lambda () maximum))
- (getmin (lambda () minimum))
- (reset-all (lambda ()
- (set! value 0)
- (set! maximum -inf.0)
- (set! minimum +inf.0)
- (set! totalitems 0))))
- (lambda (action value)
- (case action
- ((add) (adder value))
- ((total) (gettotal))
- ((average) (getaverage))
- ((numitems) (getnumitems))
- ((getmax) (getmax))
- ((getmin) (getmin))
- ((reset) (reset-all))
- (else (gnc:warn "bad stats-collector action: " action)))))))
-
-(define (gnc:make-drcr-collector)
- (issue-deprecation-warning
- "gnc:make-drcr-collector is obsolete. use srfi-1 functions instead.")
- (let ;;; values
- ((debits 0)
- (credits 0)
- (totalitems 0))
- (let ;;; Functions to manipulate values
- ((adder (lambda (amount)
- (if (> 0 amount)
- (set! credits (- credits amount))
- (set! debits (+ debits amount)))
- (set! totalitems (+ 1 totalitems))))
- (getdebits (lambda () debits))
- (getcredits (lambda () credits))
- (setdebits (lambda (amount)
- (set! debits amount)))
- (getitems (lambda () totalitems))
- (reset-all (lambda ()
- (set! credits 0)
- (set! debits 0)
- (set! totalitems 0))))
- (lambda (action value) ;;; Dispatch function
- (case action
- ((add) (adder value))
- ((debits) (getdebits))
- ((credits) (getcredits))
- ((items) (getitems))
- ((reset) (reset-all))
- (else (gnc:warn "bad dr-cr-collector action: " action)))))))
-
;; This is a collector of values -- works similar to the stats-collector but
;; has much less overhead. It is used by the currency-collector (see below).
(define (gnc:make-value-collector)
@@ -371,13 +298,6 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(negated 'minusmerge collector #f)
negated))
-(define (gnc:commodity-collectorlist-get-merged collectorlist)
- (issue-deprecation-warning
- "gnc:commodity-collectorlist-get-merged is now deprecated.")
- (let ((merged (gnc:make-commodity-collector)))
- (for-each (lambda (collector) (merged 'merge collector #f)) collectorlist)
- merged))
-
;; Returns zero if all entries in this collector are zero.
(define (gnc-commodity-collector-allzero? collector)
(every zero?
@@ -405,29 +325,6 @@ construct gnc:make-gnc-monetary and use gnc:monetary->string instead.")
(car list-of-monetaries)
(throw "gnc:monetary+ expects 1 currency " (gnc:strify monetaries)))))
-;; get the account balance at the specified date. if include-children?
-;; is true, the balances of all children (not just direct children)
-;; are included in the calculation.
-;; I think this (gnc:account-get-balance-at-date) is flawed in sub-acct handling.
-;; Consider account structure:
-;; Assets [USD] - bal=$0
-;; Bank [USD] - bal=$100
-;; Broker [USD] - bal=$200
-;; Cash [USD] - bal=$800
-;; Funds [FUND] - bal=3 FUND @ $1000 each = $3000
-;; - Calling (gnc:account-get-balance-at-date BANK TODAY #f) returns 100
-;; - Calling (gnc:account-get-balance-at-date BROKER TODAY #f) returns 200
-;; - Calling (gnc:account-get-balance-at-date BROKER TODAY #t) returns 1000
-;; this is because although it counts all subaccounts bal $200 + $800 + 3FUND,
-;; it retrieves the parent account commodity USD $1000 only.
-;; It needs to be deprecated.
-(define (gnc:account-get-balance-at-date account date include-children?)
- (issue-deprecation-warning "this gnc:account-get-balance-at-date function is \
-flawed. see report-utilities.scm. please update reports.")
- (let ((collector (gnc:account-get-comm-balance-at-date
- account date include-children?)))
- (cadr (collector 'getpair (xaccAccountGetCommodity account) #f))))
-
;; this function will scan through the account splitlist, building
;; a list of balances along the way at dates specified in dates-list.
;; in: account
@@ -733,93 +630,6 @@ flawed. see report-utilities.scm. please update reports.")
account-list type start-date end-date))
total))
-;; Filters the splits from the source to the target accounts
-;; returns a commodity collector
-;; does NOT do currency exchanges
-(define (gnc:account-get-total-flow direction target-account-list from-date to-date)
- (issue-deprecation-warning
- "(gnc:account-get-total-flow) is deprecated.")
- (let ((total-flow (gnc:make-commodity-collector)))
- (for-each
- (lambda (target-account)
- (for-each
- (lambda (target-account-split)
- (let* ((transaction (xaccSplitGetParent target-account-split))
- (split-value (xaccSplitGetAmount target-account-split)))
- (if (and (<= from-date (xaccTransGetDate transaction) to-date)
- (or (and (eq? direction 'in)
- (positive? split-value))
- (and (eq? direction 'out)
- (negative? split-value))))
- (total-flow 'add (xaccTransGetCurrency transaction) split-value))))
- (xaccAccountGetSplitList target-account)))
- target-account-list)
- total-flow))
-
-;; similar, but only counts transactions with non-negative shares and
-;; *ignores* any closing entries
-(define (gnc:account-get-pos-trans-total-interval
- account-list type start-date end-date)
- (issue-deprecation-warning
- "(gnc:account-get-pos-trans-total-interval) is deprecated.")
- (let* ((str-query (qof-query-create-for-splits))
- (sign-query (qof-query-create-for-splits))
- (total-query #f)
- (splits #f)
- (get-val (lambda (alist key)
- (let ((lst (assoc-ref alist key)))
- (if lst (car lst) lst))))
- (matchstr (get-val type 'str))
- (case-sens (if (get-val type 'cased) #t #f))
- (regexp (if (get-val type 'regexp) #t #f))
- (pos? (if (get-val type 'positive) #t #f))
- (total (gnc:make-commodity-collector))
- )
- (qof-query-set-book str-query (gnc-get-current-book))
- (qof-query-set-book sign-query (gnc-get-current-book))
- (gnc:query-set-match-non-voids-only! str-query (gnc-get-current-book))
- (gnc:query-set-match-non-voids-only! sign-query (gnc-get-current-book))
- (xaccQueryAddAccountMatch str-query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
- (xaccQueryAddAccountMatch sign-query account-list QOF-GUID-MATCH-ANY QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT
- str-query
- (and start-date #t) (if start-date start-date 0)
- (and end-date #t) (if end-date end-date 0)
- QOF-QUERY-AND)
- (xaccQueryAddDateMatchTT
- sign-query
- (and start-date #t) (if start-date start-date 0)
- (and end-date #t) (if end-date end-date 0)
- QOF-QUERY-AND)
- (xaccQueryAddDescriptionMatch
- str-query matchstr case-sens regexp QOF-COMPARE-CONTAINS QOF-QUERY-AND)
- (set! total-query
- ;; this is a tad inefficient, but its a simple way to accomplish
- ;; description match inversion...
- (if pos?
- (qof-query-merge-in-place sign-query str-query QOF-QUERY-AND)
- (let ((inv-query (qof-query-invert str-query)))
- (qof-query-merge-in-place
- sign-query inv-query QOF-QUERY-AND)
- qof-query-destroy inv-query)))
- (qof-query-destroy str-query)
-
- (set! splits (qof-query-run total-query))
- (map (lambda (split)
- (let* ((shares (xaccSplitGetAmount split))
- (acct-comm (xaccAccountGetCommodity
- (xaccSplitGetAccount split)))
- )
- (or (gnc-numeric-negative-p shares)
- (total 'add acct-comm shares)
- )
- )
- )
- splits
- )
- (qof-query-destroy total-query)
- total))
-
;; Return the splits that match an account list, date range, and (optionally) type
;; where type is defined as an alist like:
;; '((str "match me") (cased #f) (regexp #f) (closing #f))
@@ -862,50 +672,6 @@ flawed. see report-utilities.scm. please update reports.")
(qof-query-destroy query)
splits))))
-;; the following function is only used in trial-balance. best move it
-;; back there, and deprecate this exported function.
-(define (gnc:double-col
- req signed-balance report-commodity exchange-fn show-comm?)
- (issue-deprecation-warning
- "(gnc:double-col) is deprecated.")
- (let* ((sum (and signed-balance
- (gnc:sum-collector-commodity
- signed-balance
- report-commodity
- exchange-fn)))
- (amt (and sum (gnc:gnc-monetary-amount sum)))
- (neg? (and amt (gnc-numeric-negative-p amt)))
- (bal (if neg?
- (let ((bal (gnc:make-commodity-collector)))
- (bal 'minusmerge signed-balance #f)
- bal)
- signed-balance))
- (bal-sum (gnc:sum-collector-commodity
- bal
- report-commodity
- exchange-fn))
- (balance
- (if (gnc:uniform-commodity? bal report-commodity)
- (if (gnc-numeric-zero-p amt) #f bal-sum)
- (if show-comm?
- (gnc-commodity-table bal report-commodity exchange-fn)
- bal-sum)
- ))
- )
- (car (assoc-ref
- (list
- (list 'entry balance)
- (list 'debit (if neg? #f balance))
- (list 'credit (if neg? balance #f))
- (list 'zero-q (if neg? #f (if balance #f #t)))
- (list 'debit-q (if neg? #f (if balance #t #f)))
- (list 'credit-q (if neg? #t #f))
- )
- req
- ))
- )
- )
-
;; Returns the start date of the first period (period 0) of the budget.
(define (gnc:budget-get-start-date budget)
(gnc-budget-get-period-start-date budget 0))
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index bcb387b55..41ed9ab7e 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -91,8 +91,6 @@
;; define strings centrally to ease code clarity
(define rpterr-dupe
(_ "One of your reports has a report-guid that is a duplicate. Please check the report system, especially your saved reports, for a report with this report-guid: "))
-(define rpterr-upgraded
- (_ "The GnuCash report system has been upgraded. Your old saved reports have been transferred into a new format. If you experience trouble with saved reports, please contact the GnuCash development team."))
(define rpterr-guid1 (_ "Wrong report definition: "))
(define rpterr-guid2 (_ " Report is missing a GUID."))
(define rptwarn-legacy
@@ -138,47 +136,9 @@ not found.")))
(if (hash-ref *gnc:_report-templates_* report-guid)
(gui-error (string-append rpterr-dupe report-guid))
(hash-set! *gnc:_report-templates_* report-guid report-rec)))
-
- (report-name
- ;; we've got an old style report with no report-guid
- (issue-deprecation-warning
- "old report definition without guid is deprecated.")
-
- ;; give it an arbitrary one
- (set! report-guid (guid-new-return))
- (gnc:report-template-set-report-guid! report-rec report-guid)
-
- ;; we also need to give it a parent-type, so that it will
- ;; restore from the open state properly we'll key that from the
- ;; only known good way to tie back to the original report -- the
- ;; renderer
- (hash-for-each
- (lambda (id rec)
- (if (and (equal? (gnc:report-template-renderer rec)
- (gnc:report-template-renderer report-rec))
- (not (gnc:report-template-parent-type rec)))
- (begin
- (gnc:warn "gnc:define-report: setting parent-type of " report-name
- " to " (gnc:report-template-report-guid rec))
- (gnc:report-template-set-parent-type!
- report-rec (gnc:report-template-report-guid rec))
- (gnc:debug "done setting, is now "
- (gnc:report-template-parent-type report-rec)))))
- *gnc:_report-templates_*)
-
- (cond
- ((gnc:report-template-parent-type report-rec)
- ;; re-save this old-style report in the new format
- (gnc:report-template-save-to-savefile report-rec)
- (gnc:debug "complete saving " report-name " in new format")
- (unless gnc:old-style-report-warned
- (set! gnc:old-style-report-warned #t)
- (gui-error rpterr-upgraded)
- (hash-set! *gnc:_report-templates_* report-guid report-rec)))
-
- (else
- ;;there is no parent found -> this is an inital faulty report definition
- (gui-error (string-append rpterr-guid1 report-name rpterr-guid2))))))))
+ (else
+ ;;reports without guid are no longer supported
+ (gui-error (string-append rpterr-guid1 report-name rpterr-guid2))))))
(define gnc:report-template-version
(record-accessor <report-template> 'version))
@@ -817,80 +777,3 @@ not found.")))
(gnc:debug "Renaming report " template-guid)
(gnc:report-template-set-name templ new-name)
(gnc:save-all-reports))))
-
-;; Legacy functions
-;;;;;;;;;;;;;;;;;;;
-
-;; Legacy : the following 3 functions are only needed to
-;; load a saved-reports file version 2.0
-
-(define (gnc:report-template-new-options/name template-name)
- (issue-deprecation-warning
- "gnc:report-template-new-options/name is deprecated.")
- (let ((templ #f))
- (hash-for-each
- (lambda (id rec)
- (if (equal? template-name (gnc:report-template-name rec))
- (set! templ (hash-ref *gnc:_report-templates_* id))))
- *gnc:_report-templates_*)
- (and templ
- (gnc:report-template-new-options templ))))
-
-(define (gnc:report-template-menu-name/name template-name)
- (issue-deprecation-warning
- "gnc:report-template-menu-name/name is deprecated.")
- (let ((templ #f))
- (hash-for-each
- (lambda (id rec)
- (if (equal? template-name (gnc:report-template-name rec))
- (set! templ (hash-ref *gnc:_report-templates_* id))))
- *gnc:_report-templates_*)
- (and templ
- (or (gnc:report-template-menu-name templ)
- (gnc:report-template-name templ)))))
-
-(define (gnc:report-template-renderer/name template-name)
- (issue-deprecation-warning
- "gnc:report-template-renderer/name is deprecated.")
- (let ((templ #f))
- (hash-for-each
- (lambda (id rec)
- (if (equal? template-name (gnc:report-template-name rec))
- (set! templ (hash-ref *gnc:_report-templates_* id))))
- *gnc:_report-templates_*)
- (and templ
- (gnc:report-template-renderer templ))))
-
-;; Used internally only to convert a report template name into a corresponding guid
-;; Note that this may fail if several reports exist with the same name
-(define (gnc:report-template-name-to-id template-name)
- (issue-deprecation-warning
- "gnc:report-template-name-to-id is deprecated.")
- (let ((template-id #f))
- (hash-for-each
- (lambda (id rec)
- (if (equal? template-name (gnc:report-template-name rec))
- (set! template-id id)))
- *gnc:_report-templates_*)
- template-id))
-
-;; Legacy: this function is needed only to restore
-;; a saved report when loading a book last saved in GnuCash 2.2
-(define gnc:restore-report
- (let ((first-warn? #t))
- (lambda (id template-name options)
- (issue-deprecation-warning
- "gnc:restore-report is deprecated.")
- (cond
- (options
- (let* ((constructor (record-constructor <report>))
- (template-id (gnc:report-template-name-to-id template-name))
- (report (constructor template-id id options #t #t #f #f "")))
- ;; Warn user (one time) we're attempting to restore old style reports
- (when first-warn?
- (set! first-warn? #f)
- (gui-warning rptwarn-legacy))
- (gnc-report-add report)))
- (else
- (gui-error-missing-template template-name)
- #f)))))
diff --git a/gnucash/report/report-system/test/CMakeLists.txt b/gnucash/report/report-system/test/CMakeLists.txt
index 23ff7d9b3..b38527dc8 100644
--- a/gnucash/report/report-system/test/CMakeLists.txt
+++ b/gnucash/report/report-system/test/CMakeLists.txt
@@ -32,7 +32,7 @@ set(GUILE_DEPENDS
scm-engine
scm-test-engine
scm-scm
- scm-report-system-3
+ scm-report-system
scm-test-report-system
)
gnc_add_scheme_tests("${scm_test_report_system_SOURCES}")
diff --git a/gnucash/report/report-system/test/test-report-system.scm b/gnucash/report/report-system/test/test-report-system.scm
index ffdf32622..a2a9d1511 100644
--- a/gnucash/report/report-system/test/test-report-system.scm
+++ b/gnucash/report/report-system/test/test-report-system.scm
@@ -36,11 +36,13 @@
;; -----------------------------------------------------------------------
(define (test-check2)
- ;; this tests deprecated features
- (display "\n*** Missing GUID detection:\n")
+ ; the parent type is set to test unique report names later on
+ (display "\n*** Duplicate name, parent type of pre-existing report:\n")
(gnc:define-report 'version "1"
- 'name "Test Report Template")
- (test-equal "2 reports defined, with 1 autogenerated guid"
+ 'name "Test Report Template"
+ 'report-guid "54c2fc051af64a08ba2334c2e9179e25"
+ 'parent-type "54c2fc051af64a08ba2334c2e9179e23")
+ (test-equal "2 reports defined, with same report name"
2
(length (gnc:all-report-template-guids))))
diff --git a/gnucash/report/report-system/test/test-report-utilities.scm b/gnucash/report/report-system/test/test-report-utilities.scm
index 314e7258a..2a3dad8ea 100644
--- a/gnucash/report/report-system/test/test-report-utilities.scm
+++ b/gnucash/report/report-system/test/test-report-utilities.scm
@@ -22,7 +22,6 @@
(test-commodity-collector)
(test-get-account-balances)
(test-monetary-adders)
- (test-make-stats-collector)
(test-end "report-utilities"))
(define (NDayDelta t64 n)
@@ -199,12 +198,6 @@
(collector->list
(gnc:commodity-collector-get-negated coll-A)))
- ;; deprecated:
- (test-equal "gnc:commodity-collectorlist-get-merged"
- '(("USD" . 25) ("GBP" . 0))
- (collector->list
- (gnc:commodity-collectorlist-get-merged (list coll-A coll-B))))
-
(test-equal "gnc-commodity-collector-allzero? #f"
#f
(gnc-commodity-collector-allzero? coll-A))
@@ -296,16 +289,6 @@
(bank (account-lookup "Bank"))
(gbp-bank (account-lookup "GBP Bank")))
- ;; deprecated:
- (test-equal "gnc:account-get-balance-at-date 1/1/2001 incl children"
- 2301
- (gnc:account-get-balance-at-date asset (gnc-dmy2time64 01 01 2001) #t))
-
- ;; deprecated:
- (test-equal "gnc:account-get-balance-at-date 1/1/2001 excl children"
- 15
- (gnc:account-get-balance-at-date asset (gnc-dmy2time64 01 01 2001) #f))
-
(test-equal "gnc:account-get-comm-balance-at-date 1/1/2001 incl children"
'(("GBP" . 608) ("USD" . 2301))
(collector->list
@@ -505,50 +488,3 @@
"gnc:monetary+ with >1 currency fails"
#t
(gnc:monetary+ usd10 usd10 eur8))))
-
-(define (test-make-stats-collector)
- (test-begin "gnc:make-stats-collector")
- (let ((s (gnc:make-stats-collector)))
- (test-equal "initial s is 0"
- 0
- (s 'total #f))
-
- (s 'add 5)
- (test-equal "s+=5 is 5"
- 5
- (s 'total #f))
-
- (s 'add 9)
- (test-equal "s+=9 is 14"
- 14
- (s 'total #f))
-
- (test-equal "avg(s) is 7"
- 7
- (s 'average #f))
-
- (s 'add 1E12)
- (s 'add -1E13)
-
- (test-equal "max(s) is now 1E12"
- 1E12
- (s 'getmax #f))
-
- (test-equal "min(s) is now -1E13"
- -1E13
- (s 'getmin #f))
-
- (s 'add 9E12)
- (test-equal "newavg(s) is 2.8"
- 2.8
- (s 'average #f))
-
- (test-equal "num(s) is 5"
- 5
- (s 'numitems #f))
-
- (s 'reset #f)
- (test-equal "after reset num(s) is 0"
- 0
- (s 'numitems #f)))
- (test-end "gnc:make-stats-collector"))
diff --git a/libgnucash/app-utils/CMakeLists.txt b/libgnucash/app-utils/CMakeLists.txt
index fd156c8fd..d5627e0dc 100644
--- a/libgnucash/app-utils/CMakeLists.txt
+++ b/libgnucash/app-utils/CMakeLists.txt
@@ -156,7 +156,6 @@ set (app_utils_SCHEME_2
)
set (app_utils_SCHEME_1
- hooks.scm
business-options.scm
c-interface.scm
date-utilities.scm
diff --git a/libgnucash/app-utils/app-utils.scm b/libgnucash/app-utils/app-utils.scm
index 325ec507e..3dab4eee2 100644
--- a/libgnucash/app-utils/app-utils.scm
+++ b/libgnucash/app-utils/app-utils.scm
@@ -148,7 +148,6 @@
(export gnc:options-get-default-section)
(export gnc:options-copy-values)
(export gnc:send-options)
-(export gnc:save-options)
(define (gnc:option-get-value book category key)
;;Access an option directly
@@ -264,11 +263,6 @@
(export gnc:get-start-next-year)
(export gnc:get-three-months-ahead)
-;; hooks
-(export gnc:hook-run-danglers) ;; from hooks.scm- deprecated
-(re-export gnc-hook-add-scm-dangler)
-(re-export HOOK-REPORT)
-
;; simple-obj
(export make-simple-class)
(export simple-obj-getter)
@@ -283,7 +277,6 @@
(load-from-path "c-interface")
(load-from-path "options")
-(load-from-path "hooks")
(load-from-path "prefs")
(load-from-path "date-utilities")
(load-from-path "simple-obj")
diff --git a/libgnucash/app-utils/hooks.scm b/libgnucash/app-utils/hooks.scm
deleted file mode 100644
index 96ac43f37..000000000
--- a/libgnucash/app-utils/hooks.scm
+++ /dev/null
@@ -1,23 +0,0 @@
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, contact:
-;;
-;; Free Software Foundation Voice: +1-617-542-5942
-;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
-;; Boston, MA 02110-1301, USA gnu at gnu.org
-
-(define (gnc:hook-run-danglers hook . args)
- (issue-deprecation-warning "gnc:hook-run-danglers is now deprecated.")
- (if (null? args)
- (set! args '())
- (set! args (car args)))
- (gnc-hook-run hook args))
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index 7c1622566..978391690 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -1987,19 +1987,6 @@ the option '~a'."))
(gnc-option-db-register-option db_handle option))
options))
-(define (gnc:save-options options options-string file header truncate?)
- (issue-deprecation-warning
- "gnc:save-options is deprecated.")
- (let ((code (gnc:generate-restore-forms options options-string))
- (port (false-if-exception
- (if truncate?
- (open file (logior O_WRONLY O_CREAT O_TRUNC))
- (open file (logior O_WRONLY O_CREAT O_APPEND))))))
- (if port (begin
- (display header port)
- (display code port)
- (close port)))))
-
(define (gnc:options-make-end-date! options pagename optname sort-tag info)
(gnc:register-option
options
diff --git a/libgnucash/engine/engine-utilities.scm b/libgnucash/engine/engine-utilities.scm
index 6341a9974..939e65ba2 100644
--- a/libgnucash/engine/engine-utilities.scm
+++ b/libgnucash/engine/engine-utilities.scm
@@ -36,42 +36,6 @@
(map thunk children)))
;; account related functions
-;; is account in list of accounts?
-(define (account-same? a1 a2)
- (issue-deprecation-warning "account-same? is deprecated. use equal? instead.")
- (or (eq? a1 a2)
- (string=? (gncAccountGetGUID a1) (gncAccountGetGUID a2))))
-
-(define account-in-list?
- (lambda (account accounts)
- (issue-deprecation-warning "account-in-list? is deprecated. use member instead.")
- (cond
- ((null? accounts) #f)
- ((account-same? (car accounts) account) #t)
- (else (account-in-list? account (cdr accounts))))))
-
-;; Optimized version of account-in-list if we know
-;; the list in advance.
-(define (account-in-list-pred accounts)
- (define (my-assoc str alist)
- (find (lambda (pair) (account-same? str (car pair))) alist))
- (define (my-hash acc size)
- (remainder (string-hash (gncAccountGetGUID acc)) size))
- (issue-deprecation-warning "account-in-list-pred is deprecated.")
- (let ((hash-table (make-hash-table)))
- (for-each (lambda (acc) (hashx-set! my-hash my-assoc hash-table acc #t))
- accounts)
- (lambda (account)
- (hashx-ref my-hash my-assoc hash-table account))))
-
-(define account-in-alist
- (lambda (account alist)
- (issue-deprecation-warning "account-in-alist is deprecated. use assoc instead.")
- (cond
- ((null? alist) #f)
- ((account-same? (caar alist) account) (car alist))
- (else (account-in-alist account (cdr alist))))))
-
;; helper for sorting of account list
(define (account-full-name<? a b)
(string<? (gnc-account-get-full-name a) (gnc-account-get-full-name b)))
@@ -83,54 +47,3 @@
(let ((acct-depth (gnc-account-get-current-depth acct)))
(+ acct-depth (- (gnc-account-get-tree-depth acct) 1))))
accounts)))
-
-(define (account-assoc acc alist)
- (issue-deprecation-warning "account-assoc is deprecated. use assoc instead.")
- (find (lambda (pair) (account-same? acc (car pair))) alist))
-
-(define (account-hash acc size)
- (issue-deprecation-warning "account-hash is deprecated. internal function.")
- (remainder (string-hash (gncAccountGetGUID acc)) size))
-
-(define (account-hashtable-ref table account)
- (issue-deprecation-warning "account-hashtable-ref is deprecated. \
-use assoc-ref instead..")
- (hashx-ref account-hash account-assoc table account))
-
-(define (account-hashtable-set! table account value)
- (issue-deprecation-warning "account-hashtable-set! is deprecated. \
-use assoc-set! instead.")
- (hashx-set! account-hash account-assoc table account value))
-
-;; Splits
-(export split-same?) ;deprecated
-(export split-in-list?) ;deprecated
-(define (split-same? s1 s2)
- (issue-deprecation-warning "split-same? is deprecated. use equal? instead.")
- (or (eq? s1 s2)
- (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2))))
-(define split-in-list?
- (lambda (split splits)
- (issue-deprecation-warning "split-in-list? is deprecated. use member instead.")
- (cond
- ((null? splits) #f)
- ((split-same? (car splits) split) #t)
- (else (split-in-list? split (cdr splits))))))
-(define (split-assoc split alist)
- (issue-deprecation-warning "split-assoc is deprecated. use assoc instead")
- (find (lambda (pair) (split-same? (cdr split) (cdr (car pair)))) alist))
-(define (split-hash split size)
- (issue-deprecation-warning "split-hash is deprecated. \
-internal function -- no srfi-1 equivalent")
- (remainder (car split) size))
-(define (split-hashtable-ref table split)
- (issue-deprecation-warning "split-hashtable-ref is deprecated. \
-use assoc-ref instead.")
- (hashx-ref split-hash split-assoc table
- (cons (string-hash (gncSplitGetGUID split)) split)))
-(define (split-hashtable-set! table split value)
- (issue-deprecation-warning "split-hashtable-set! is deprecated. \
-use assoc-set! instead")
- (hashx-set! split-hash split-assoc table
- (cons (string-hash (gncSplitGetGUID split)) split) value))
-
diff --git a/libgnucash/engine/engine.scm b/libgnucash/engine/engine.scm
index d6cb780cf..7776910c6 100644
--- a/libgnucash/engine/engine.scm
+++ b/libgnucash/engine/engine.scm
@@ -63,19 +63,8 @@
(export gnc:account-map-descendants)
(export gnc:account-map-children)
-(export account-same?) ;deprecated
-(export account-in-list?) ;deprecated
-(export account-in-list-pred) ;deprecated
-(export account-in-alist) ;deprecated
(export account-full-name<?)
(export accounts-get-children-depth)
-(export account-hashtable-ref) ;deprecated
-(export account-hashtable-set!) ;deprecated
-
-(export split-same?) ;deprecated
-(export split-in-list?) ;deprecated
-(export split-hashtable-ref) ;deprecated
-(export split-hashtable-set!) ;deprecated
(export gnc:split-structure)
(export gnc:make-split-scm)
diff --git a/libgnucash/engine/test/CMakeLists.txt b/libgnucash/engine/test/CMakeLists.txt
index 21dd7a0bd..b3b307dbb 100644
--- a/libgnucash/engine/test/CMakeLists.txt
+++ b/libgnucash/engine/test/CMakeLists.txt
@@ -219,9 +219,7 @@ gnc_add_test_with_guile(test-scm-query test-scm-query.cpp ENGINE_TEST_INCLUDE_DI
set(engine_test_SCHEME
- test-account.scm
test-create-account.scm
- test-split.scm
)
#list(APPEND engine_test_SCHEME test-scm-query-import.scm) Fails
@@ -313,11 +311,9 @@ set(test_engine_SOURCES_DIST
)
set(test_engine_SCHEME_DIST
- test-account.scm
test-create-account.scm
test-engine-extras.scm
test-scm-query-import.scm
- test-split.scm
)
set(test_engine_EXTRA_DIST
diff --git a/libgnucash/engine/test/test-account.scm b/libgnucash/engine/test/test-account.scm
deleted file mode 100644
index 81b36cf86..000000000
--- a/libgnucash/engine/test/test-account.scm
+++ /dev/null
@@ -1,52 +0,0 @@
-(use-modules (gnucash gnc-module))
-
-(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-
-(use-modules (gnucash engine))
-
-(use-modules (tests test-engine-extras))
-
-;; this test suite tests deprecated functions.
-
-(define (run-test)
- (test test-account-same?)
- (test test-account-in-list?)
- (test test-account-in-alist?)
- (test test-account-list-predicate))
-
-(define (test-account-same?)
- (let* ((env (create-test-env))
- (account-alist (env-create-test-accounts env))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist))))
- (and (account-same? bank-account bank-account)
- (not (account-same? bank-account expense-account)))))
-
-(define (test-account-in-alist?)
- (let* ((env (create-test-env))
- (account-alist (env-create-test-accounts env))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist))))
- (let ((alist (list (cons bank-account "Bank") (cons expense-account "Expenses"))))
- (and (account-in-alist bank-account alist)
- (account-in-alist expense-account alist)
- (not (account-in-alist wallet-account alist))))))
-
-(define (test-account-in-list?)
- (test-account-list-predicate-generic
- (lambda (accounts) (lambda (account) (account-in-list? account accounts)))))
-
-(define (test-account-list-predicate)
- (test-account-list-predicate-generic account-in-list-pred))
-
-(define (test-account-list-predicate-generic predicate)
- (let* ((env (create-test-env))
- (account-alist (env-create-test-accounts env))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (other-account (cdr (assoc "Other" account-alist)))
- (bank-or-wallet? (predicate (list bank-account wallet-account))))
- (and (bank-or-wallet? bank-account)
- (bank-or-wallet? wallet-account)
- (not (bank-or-wallet? other-account)))))
diff --git a/libgnucash/engine/test/test-split.scm b/libgnucash/engine/test/test-split.scm
deleted file mode 100644
index dd10dcb36..000000000
--- a/libgnucash/engine/test/test-split.scm
+++ /dev/null
@@ -1,29 +0,0 @@
-(use-modules (gnucash gnc-module))
-(use-modules (srfi srfi-1))
-
-(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-
-(use-modules (gnucash engine))
-(use-modules (tests test-engine-extras))
-(use-modules (gnucash app-utils))
-
-(define (run-test)
- (test test-split-in-list?))
-
-(define (test-split-in-list?)
- ;; this test suite tests deprecated functions.
- (let* ((env (create-test-env))
- (today (current-time))
- (account-alist (env-create-test-accounts env))
- (bank-account (cdr (assoc "Bank" account-alist)))
- (expense-account (cdr (assoc "Expenses" account-alist)))
- (wallet-account (cdr (assoc "Wallet" account-alist)))
- (tx1 (env-create-transaction env today bank-account wallet-account 20/1))
- (tx2 (env-create-transaction env today bank-account expense-account 10/1))
- (splits-tx1 (xaccTransGetSplitList tx1))
- (splits-tx2 (xaccTransGetSplitList tx2)))
- (and (split-in-list? (first splits-tx1) splits-tx1)
- (split-in-list? (second splits-tx1) splits-tx1)
- (not (split-in-list? (first splits-tx1) splits-tx2))
- (not (split-in-list? (second splits-tx1) splits-tx2))
- (not (split-in-list? (first splits-tx1) '())))))
diff --git a/po/POTFILES.in b/po/POTFILES.in
index 11677eb23..d74c507ea 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -469,7 +469,6 @@ gnucash/report/reports/standard/view-column.scm
gnucash/report/reports/support/balsheet-eg.eguile.scm
gnucash/report/reports/support/receipt.eguile.scm
gnucash/report/reports/support/taxinvoice.eguile.scm
-gnucash/report/report-system/collectors.scm
gnucash/report/report-system/commodity-utilities.scm
gnucash/report/report-system/eguile-gnc.scm
gnucash/report/report-system/eguile-html-utilities.scm
@@ -491,7 +490,6 @@ gnucash/report/report-system/html-table.scm
gnucash/report/report-system/html-text.scm
gnucash/report/report-system/html-utilities.scm
gnucash/report/report-system/options-utilities.scm
-gnucash/report/report-system/report-collectors.scm
gnucash/report/report-system/report-register-hooks.scm
gnucash/report/report-system/report.scm
gnucash/report/report-system/report-system.scm
@@ -536,7 +534,6 @@ libgnucash/app-utils/gnc-sx-instance-model.c
libgnucash/app-utils/gnc-ui-balances.c
libgnucash/app-utils/gnc-ui-util.c
libgnucash/app-utils/guile-util.c
-libgnucash/app-utils/hooks.scm
libgnucash/app-utils/options.scm
libgnucash/app-utils/option-util.c
libgnucash/app-utils/prefs.scm
Summary of changes:
gnucash/report/report-system/CMakeLists.txt | 35 +-
gnucash/report/report-system/collectors.scm | 351 ---------------------
.../report/report-system/commodity-utilities.scm | 100 ------
gnucash/report/report-system/options-utilities.scm | 38 ---
gnucash/report/report-system/report-collectors.scm | 231 --------------
gnucash/report/report-system/report-system.scm | 25 --
gnucash/report/report-system/report-utilities.scm | 234 --------------
gnucash/report/report-system/report.scm | 123 +-------
gnucash/report/report-system/test/CMakeLists.txt | 2 +-
.../report-system/test/test-report-system.scm | 10 +-
.../report-system/test/test-report-utilities.scm | 64 ----
libgnucash/app-utils/CMakeLists.txt | 1 -
libgnucash/app-utils/app-utils.scm | 7 -
libgnucash/app-utils/hooks.scm | 23 --
libgnucash/app-utils/options.scm | 13 -
libgnucash/engine/engine-utilities.scm | 87 -----
libgnucash/engine/engine.scm | 11 -
libgnucash/engine/test/CMakeLists.txt | 4 -
libgnucash/engine/test/test-account.scm | 52 ---
libgnucash/engine/test/test-split.scm | 29 --
po/POTFILES.in | 3 -
21 files changed, 16 insertions(+), 1427 deletions(-)
delete mode 100644 gnucash/report/report-system/collectors.scm
delete mode 100644 gnucash/report/report-system/report-collectors.scm
delete mode 100644 libgnucash/app-utils/hooks.scm
delete mode 100644 libgnucash/engine/test/test-account.scm
delete mode 100644 libgnucash/engine/test/test-split.scm
More information about the gnucash-changes
mailing list