diff --git a/gnucash/report/report-system/CMakeLists.txt b/gnucash/report/report-system/CMakeLists.txt index 1d69dc32e2..293e1926ae 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" +gnc_add_scheme_targets(scm-report-system-2 + "${report_system_SCHEME_2}" + "" 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}" - "" - scm-report-system-2b - 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 1731c0e8ff..0000000000 --- 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@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 65c2032591..a682478147 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 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 -;; 'foreign' into the 'domestic' by -;; the 'price-value'. Returns a . -(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 -;; 'foreign' into the 'domestic' by the -;; 'price'. Returns a . -(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 43d8bbb255..29a7840d81 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 90375c551c..0000000000 --- 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@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 2ecd48f5ad..ee122b4348 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 e37ce42e27..690dda731b 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 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 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. 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 bcb387b551..41ed9ab7e8 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 '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 )) - (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 23ff7d9b3b..b38527dc8d 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 ffdf326229..a2a9d1511f 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 314e7258af..2a3dad8ea2 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 fd156c8fda..d5627e0dc2 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 325ec507e8..3dab4eee29 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 96ac43f37d..0000000000 --- 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@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 7c16225662..9783916907 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 6341a9974a..939e65ba26 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