diff --git a/gnucash/import-export/qif-imp/CMakeLists.txt b/gnucash/import-export/qif-imp/CMakeLists.txt index cacd62f28a..94812b26c8 100644 --- a/gnucash/import-export/qif-imp/CMakeLists.txt +++ b/gnucash/import-export/qif-imp/CMakeLists.txt @@ -51,7 +51,6 @@ set (qif_import_SCHEME qif-to-gnc.scm qif-utils.scm qif-import.scm # yes, included in both SETs - simple-obj.scm ) set(qif_import_SCHEME_2 diff --git a/gnucash/import-export/qif-imp/qif-utils.scm b/gnucash/import-export/qif-imp/qif-utils.scm index 9c4359697a..25e1e7a339 100644 --- a/gnucash/import-export/qif-imp/qif-utils.scm +++ b/gnucash/import-export/qif-imp/qif-utils.scm @@ -29,29 +29,6 @@ (define qif-import:paused #f) (define qif-import:canceled #f) -(define (string-remove-trailing-space str) - (issue-deprecation-warning "string-remove-trailing-space - use string-trim-right") - (string-trim-right str)) - -(define (string-remove-leading-space str) - (issue-deprecation-warning "string-remove-leading-space - use string-trim") - (string-trim str)) - -(define (string-remove-char str char) - (issue-deprecation-warning "string-remove-char - use gnc:string-delete-chars") - (gnc:string-delete-chars s (list char))) - -(define (string-replace-char! str old new) - (issue-deprecation-warning "string-replace-char! - use gnc:string-replace-char") - (gnc:string-replace-char str old new)) - -(define (string-to-canonical-symbol str) - (issue-deprecation-warning "string-to-canonical-symbol - inline instead") - (string->symbol - (string-downcase - (string-remove-leading-space - (string-remove-trailing-space str))))) - (define (qif-import:log progress-dialog proc str) (if progress-dialog (gnc-progress-dialog-append-log progress-dialog (string-append str "\n")) diff --git a/gnucash/import-export/qif-imp/simple-obj.scm b/gnucash/import-export/qif-imp/simple-obj.scm deleted file mode 100644 index 9e502fa112..0000000000 --- a/gnucash/import-export/qif-imp/simple-obj.scm +++ /dev/null @@ -1,86 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; simple-obj.scm -;;; rudimentary "class" system for straight Scheme -;;; -;;; Bill Gribble 20 Feb 2000 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; this is an extremely rudimentary object system. Each object is a -;; cons cell, where the car is a symbol with the class name and the -;; cdr is a vector of the slots. -;; -;; the "class object" is an instance of simple-class which just has -;; the name of the class and an alist of slot names to vector indices -;; as its slots. -;; -;; by convention, I name class objects (defined with make-simple-class) -;; with class-smybol 'class-name. For example, -;; -;; (define (make-simple-class 'test-class '(slot-1 slot-2))) -;; (define t (make-simple-obj )) -;; t ==> (test-class . #(#f #f)) - -;; the 'simple-class' class. -(define (make-simple-class class-symbol slot-names) - (issue-deprecation-warning "make-simple-class is deprecated. use make-record-type.") - (make-record-type (symbol->string class-symbol) slot-names)) - -(define (simple-obj-getter class slot) - (issue-deprecation-warning "simple-obj-getter is deprecated. use record-accessor.") - (record-accessor class slot)) - -(define (simple-obj-setter class slot) - (issue-deprecation-warning "simple-obj-setter is deprecated. use record-modifier.") - (record-modifier class slot)) - -(define (simple-obj-print obj) - (issue-deprecation-warning "simple-obj-print is deprecated. use write.") - (write obj)) - -(define (simple-obj-to-list obj) - (issue-deprecation-warning "simple-obj-to-list is deprecated. use record-type->list in qif-guess-map.scm") - (let ((retval '())) - (for-each - (lambda (slot) - (let ((thunk (record-accessor (record-type-descriptor obj) slot))) - (set! retval (cons (thunk obj) retval)))) - (record-type-fields (record-type-descriptor obj))) - (reverse retval))) - -(define (simple-obj-from-list list type) - (issue-deprecation-warning "simple-obj-from-list-obj is deprecated. use list->record-type in qif-guess-map.scm") - (let ((retval (make-simple-obj type))) - (for-each - (lambda (slot) - (let ((thunk (record-modifier type slot))) - (thunk retval (car list))) - (set! list (cdr list))) - (record-type-fields type)) - retval)) - - -(define (make-simple-obj class) - (issue-deprecation-warning "make-simple-obj is deprecated. use construct in qif-objects.scm") - (let ((ctor (record-constructor class)) - (field-defaults - (map (lambda (v) #f) (record-type-fields class)))) - (apply ctor field-defaults))) - diff --git a/gnucash/report/commodity-utilities.scm b/gnucash/report/commodity-utilities.scm index bb12560f25..c7892c2b5e 100644 --- a/gnucash/report/commodity-utilities.scm +++ b/gnucash/report/commodity-utilities.scm @@ -850,29 +850,6 @@ GNC-RND-ROUND)) (foreign 'format gnc:make-gnc-monetary #f)))))) -;; As above, but adds only the commodities of other stocks and -;; mutual-funds. Returns a commodity-collector, (not a ) -;; which (still) may have several different commodities in it -- if -;; there have been different *currencies*, not only stocks. -(define (gnc:sum-collector-stocks foreign domestic exchange-fn) - (issue-deprecation-warning - "gnc:sum-collector-stocks is never used in code.") - (and foreign - (let ((balance (gnc:make-commodity-collector))) - (foreign - 'format - (lambda (curr val) - (if (gnc-commodity-equiv domestic curr) - (balance 'add domestic val) - (if (gnc-commodity-is-currency curr) - (balance 'add curr val) - (balance 'add domestic - (gnc:gnc-monetary-amount - (exchange-fn (gnc:make-gnc-monetary curr val) - domestic)))))) - #f) - balance))) - (define (gnc:uniform-commodity? amt report-commodity) ;; function to see if the commodity-collector amt ;; contains any foreign commodities diff --git a/gnucash/report/html-acct-table.scm b/gnucash/report/html-acct-table.scm index c0fff8db35..2512e54725 100644 --- a/gnucash/report/html-acct-table.scm +++ b/gnucash/report/html-acct-table.scm @@ -498,12 +498,6 @@ (use-modules (srfi srfi-2)) (use-modules (srfi srfi-9)) -;; this is to work around a bug in the HTML export sytmem -;; which causes COLSPAN= attributes not to be exported (!!) -(define gnc:colspans-are-working-right - ;; should be deprecated - #f) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; class ;; utility class for generating account tables @@ -911,10 +905,6 @@ (define (gnc:html-acct-table-num-rows acct-table) (gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table))) -(define (gnc:html-acct-table-num-cols acct-table) - (issue-deprecation-warning "gnc:html-acct-table-num-cols is unused.") - (- (gnc:html-table-num-columns (gnc:_html-acct-table-matrix_ acct-table)) 1)) - (define (gnc:html-acct-table-get-cell acct-table row col) ;; we'll only ever store one object in an html-table-cell ;; returns the first object stored in that cell @@ -938,50 +928,6 @@ (define (gnc:html-acct-table-set-row-env! acct-table row env) (gnc:html-acct-table-set-cell! acct-table row -1 env)) -(define (gnc:html-acct-table-append-row! acct-table newrow) - (issue-deprecation-warning "gnc:html-acct-table-append-row! is unused.") - (gnc:html-table-append-row! - (gnc:_html-acct-table-matrix_ acct-table) - (map - (lambda (x) (gnc:make-html-table-cell (list x))) - newrow))) - -(define (gnc:html-acct-table-prepend-row! acct-table newrow) - (issue-deprecation-warning "gnc:html-acct-table-prepend-row! is unused.") - (gnc:html-table-prepend-row! - (gnc:_html-acct-table-matrix_ acct-table) - (map - (lambda (x) (gnc:make-html-table-cell (list x))) - newrow))) - -(define (gnc:html-acct-table-append-col! acct-table newcol) - (issue-deprecation-warning "gnc:html-acct-table-append-col! is unused.") - (gnc:html-table-append-col! - (gnc:_html-acct-table-matrix_ acct-table) - (map - (lambda (x) (gnc:make-html-table-cell (list x))) - newcol))) - -(define (gnc:html-acct-table-prepend-col! acct-table newrow) - (issue-deprecation-warning "gnc:html-acct-table-prepend-col! is unused.") - (gnc:html-table-prepend-col! - (gnc:_html-acct-table-matrix_ acct-table) - (map - (lambda (x) (gnc:make-html-table-cell (list x))) - newcol))) - -(define (gnc:html-acct-table-remove-last-row! acct-table) - (issue-deprecation-warning "gnc:html-acct-table-remove-last-row! is unused.") - (gnc:html-table-remove-last-row! (gnc:_html-acct-table-matrix_ acct-table))) - -(define (gnc:html-acct-table-render acct-table doc) - ;; this will be used if we ever decide to let the utility object - ;; render a document by calling thunks registered in the row-envs... - ;; but, for now, this (optional) feature is left unimplemented... - (issue-deprecation-warning "gnc:html-acct-table-render is unused.") - #f - ) - ;; ;; Here are some standard functions to help process gnc:html-acct-tables. ;; @@ -1208,47 +1154,5 @@ ) -(define (gnc:second-html-build-acct-table - start-date end-date - tree-depth show-subaccts? accounts - start-percent delta-percent - show-col-headers? - show-total? get-total-fn - total-name group-types? show-parent-balance? show-parent-total? - show-other-curr? report-commodity exchange-fn show-zero-entries?) - ;; THIS NEW FUNCTION DOES NOT IMPLEMENT SOME FEATURES OF THE OLD ONE - ;; of these options: start-percent/delta-percent, the balance column - ;; header, show-total?/get-total-fn/total-name, and group-types? are - ;; presently unimplemented. many of these functions are better left - ;; to the renderer, anyway. but if you *really* need them, you may - ;; still use gnc:first-html-build-acct-table. - (issue-deprecation-warning - "gnc:second-html-build-acct-table is unused. use gnc:html-build-acct-table.") - (let* ((env (list - (list 'start-date start-date) - (list 'end-date end-date) - (list 'display-tree-depth tree-depth) - ;;(list 'progress-start-percent start-percent) - ;;(list 'progress-length-percent delta-percent) - (list 'column-header show-col-headers?) - (list 'parent-account-subtotal-mode show-parent-total?) - (list 'report-commodity report-commodity) - (list 'exchange-fn exchange-fn) - (list 'zero-balance-display-mode - (if show-zero-entries? - 'show-balance - 'omit-balance)) - )) - (html-table (gnc:make-html-table)) - (acct-table (gnc:make-html-acct-table/env/accts env accounts)) - (params (list - (list 'parent-account-balance-mode - (if show-parent-balance? 'immediate-bal)) - )) - ) - (gnc:html-table-add-account-balances html-table acct-table params) - html-table - )) - ;; END diff --git a/gnucash/report/html-table.scm b/gnucash/report/html-table.scm index 7d6d5c7625..38a24104b0 100644 --- a/gnucash/report/html-table.scm +++ b/gnucash/report/html-table.scm @@ -553,46 +553,6 @@ remaining-elements) #f)))) -(define (gnc:html-table-prepend-column! table newcol) - ;; returns a pair, the car of which is the prepending of newcol - ;; and existing-data, and the cdr is the remaining elements of newcol - (define (prepend-to-element newcol existing-data length-to-append) - (if (= length-to-append 0) - (cons '() newcol) - (let* - ((current-new (car newcol)) - (current-existing (car existing-data)) - (rest-new (cdr newcol)) - (rest-existing (cdr existing-data)) - (rest-result (prepend-to-element rest-new rest-existing - (- length-to-append 1)))) - (cons - (cons (cons current-new current-existing) (car rest-result)) - (cdr rest-result))))) - (issue-deprecation-warning "gnc:html-table-prepend-column! is unused.") - (let* ((existing-data (reverse (gnc:html-table-data table))) - (existing-length (length existing-data)) - (newcol-length (length newcol))) - (if (<= newcol-length existing-length) - (gnc:html-table-set-data! - table - (reverse (car (prepend-to-element - newcol - existing-data - newcol-length)))) - (let* ((temp-result (prepend-to-element - newcol - existing-data - existing-length)) - (joined-table-data (car temp-result)) - (remaining-elements (cdr temp-result))) - ;; Invariant maintained - table data in reverse order - (gnc:html-table-set-data! table (reverse joined-table-data)) - (for-each - (lambda (element) - (gnc:html-table-append-row! table (list element))) - remaining-elements) - #f)))) ;; ;; It would be nice to have table row/col/cell accessor functions in here. diff --git a/gnucash/report/html-utilities.scm b/gnucash/report/html-utilities.scm index dac1e1da7f..4769a1fa3c 100644 --- a/gnucash/report/html-utilities.scm +++ b/gnucash/report/html-utilities.scm @@ -214,570 +214,6 @@ (define (gnc:html-table-append-ruler! table colspan) (gnc:html-table-append-ruler/at! table 0 colspan)) -(define (gnc:html-table-append-ruler/markup! table markup colspan) - (issue-deprecation-warning - "gnc:html-table-append-ruler/markup! is unused.") - (gnc:html-table-append-ruler/at/markup! table markup 0 colspan)) - -;; Creates a table cell with some text in it. The cell will be created -;; with the colspan 'colspan' (the rowspan==1), the content 'content' -;; and in boldface if 'boldface?' is true. 'content' may be #f, or a -;; string, or a object. Returns a -;; object. -(define (gnc:html-acct-table-cell colspan content boldface?) - ;; instead of html-markup-b, just use the corresponding html-table-styles. - (define default-style "text-cell") - (define boldface-style "total-label-cell") - (issue-deprecation-warning - "gnc:html-acct-table-cell is unused.") - (gnc:make-html-table-cell/size/markup - 1 colspan - (if boldface? boldface-style default-style) - content)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; function for account table without foreign commodities - -;; Adds one row to the table. current-depth determines the number -;; of empty cells, my-name is the html-object to be displayed as -;; name, my-balance is a gnc-monetary to be displayed in the -;; balance column, and if reverse-balance? is #t the balance will -;; be displayed with the sign reversed. -(define (gnc:html-acct-table-row-helper! - table tree-depth - current-depth my-name my-balance - reverse-balance? row-style boldface? group-header-line?) - (issue-deprecation-warning - "gnc:html-acct-table-row-helper! is unused.") - (gnc:html-table-append-row/markup! - table - row-style - (append - ;; left half of the table - (gnc:html-make-empty-cells (- current-depth 1)) - (list (gnc:html-acct-table-cell (+ 1 (- tree-depth current-depth)) - my-name boldface?)) - ;; right half of the table - (gnc:html-make-empty-cells - (- tree-depth (+ current-depth (if group-header-line? 1 0)))) - ;; the account balance - (list (and my-balance - (gnc:make-html-table-cell/markup - "number-cell" - (gnc:make-html-text - ((if boldface? gnc:html-markup-b identity) - ((if reverse-balance? gnc:monetary-neg identity) - my-balance)))))) - (gnc:html-make-empty-cells (- current-depth - (if group-header-line? 0 1)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; function for account table with foreign commodities visible - -;; Adds all appropriate rows to the table which belong to one -;; balance, i.e. one row for each commodity. (Note: Multiple -;; commodities come e.g. from subaccounts with different -;; commodities.) my-name (a html-object) is the name to be printed -;; in the appropriate name column. my-commodity (a -;; ) is the "natural" balance of the current -;; account. balance (a commodity-collector) is the balance to be -;; printed. If reverse-balance? == #t then the balances' signs get -;; reversed. -;; DM: If you trace this function through gnc:html-build-acct-table, -;; my-commodity always ends up being report-commodity. -(define (gnc:html-acct-table-comm-row-helper! - table tree-depth report-commodity exchange-fn - current-depth my-name my-commodity balance - reverse-balance? is-stock-account? main-row-style other-rows-style - boldface? group-header-line?) - (issue-deprecation-warning - "gnc:html-acct-table-comm-row-helper! is unused.") - (let ((already-printed #f)) - ;; Adds one row to the table. my-name is the html-object - ;; displayed in the name column; foreign-balance is the - ;; for the foreign column or #f if to be left - ;; empty; domestic-balance is the for the - ;; domestic column. - (define (commodity-row-helper! - my-name foreign-balance domestic-balance row-style) - (gnc:html-table-append-row/markup! - table - row-style - (append - ;; left third of the table - (gnc:html-make-empty-cells (- current-depth 1)) - (list (gnc:html-acct-table-cell (+ 1 (- tree-depth current-depth)) - my-name boldface?)) - ;; right two-thirds of the table - (gnc:html-make-empty-cells - (* 2 (- tree-depth (+ current-depth (if group-header-line? 1 0))))) - (if boldface? - (list - (and foreign-balance - (gnc:make-html-table-cell/markup - "number-cell" - (gnc:make-html-text (gnc:html-markup-b foreign-balance)))) - (and - domestic-balance - (gnc:make-html-table-cell/markup - "number-cell" - (gnc:make-html-text (gnc:html-markup-b domestic-balance))))) - (list - (and foreign-balance - (gnc:make-html-table-cell/markup - "number-cell" - foreign-balance)) - (and domestic-balance - (gnc:make-html-table-cell/markup - "number-cell" - domestic-balance)))) - (gnc:html-make-empty-cells (* 2 (- current-depth - (if group-header-line? 0 1))))))) - - ;;;;;;;;;; - ;; the first row for each account: shows the name and the - ;; balance in the report-commodity - (if (and (not is-stock-account?) - ;; FIXME: need to check whether we really have only one - ;; foreign currency if is-stock-account==#t. - (gnc-commodity-equiv my-commodity report-commodity)) - ;; usual case: the account balance in terms of report - ;; commodity - (commodity-row-helper! - my-name #f - (and balance - (balance 'getmonetary report-commodity reverse-balance?)) - main-row-style) - ;; Special case for stock-accounts: then the foreign commodity - ;; gets displayed in this line rather then the following lines - ;; (loop below). Is also used if is-stock-account? is true. - (let ((my-balance - (and balance - (balance 'getmonetary my-commodity reverse-balance?)))) - (set! already-printed my-commodity) - (commodity-row-helper! - my-name - my-balance - (exchange-fn my-balance report-commodity) - main-row-style))) - - ;; The additional rows: show no name, but the foreign currency - ;; balance and its corresponding value in the - ;; report-currency. One row for each non-report-currency. - (if (and balance (not is-stock-account?)) - (balance - 'format - (lambda (curr val) - (if (or (gnc-commodity-equiv curr report-commodity) - (and already-printed - (gnc-commodity-equiv curr already-printed))) - '() - (let ((bal - (if reverse-balance? - (gnc:monetary-neg (gnc:make-gnc-monetary curr val)) - (gnc:make-gnc-monetary curr val)))) - (commodity-row-helper! - ;; print no account name - (gnc:html-make-empty-cell) - ;; print the account balance in the respective - ;; commodity - bal - (exchange-fn bal report-commodity) - other-rows-style)))) - #f)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; gnc:html-build-acct-table -;; -;; Builds and returns a tree-(hierarchy-)shaped table as a html-table -;; object. -;; -;; Arguments by topic: -;; -;; Reporting period -- start-date, end-date -;; -;; Selected accounts -- tree-depth, show-subaccts?, accounts -;; -;; Foreign currency -- show-other-curr?, report-commodity, -;; exchange-fn -;; -;; Output fine-tuning -- show-col-headers?, show-total? (with -;; total-name, get-total-fn), group-types?, -;; show-parent-balance?, show-parent-total? -;; -;; Feedback while building -- start-percent, delta-percent -;; -;; Note: The returned table object will have 2*tree-depth columns if -;; show-other-curr?==#f, else it will have 3*tree-depth columns. -;; -;; Arguments in detail: -;; -;; start-date: Start date of reporting period. If #f, -;; everything till end-date will be considered. -;; -;; end-date: End date of reporting period. -;; -;; tree-depth, show-subaccounts?, -;; accounts: An account is shown if ( tree-depth is large enough AND [ -;; it is a member in accounts OR { show-subaccounts? == #t AND any of -;; the parents is member in accounts. }]) Note that the accounts shown -;; are totally independent from the calculated balance and vice -;; versa. -;; -;; show-col-headers?: show column headings "Account" and -;; "Balance" -;; -;; show-total?: If #f, no total sum is shown. -;; -;; # get-total-fn: The function to calculate the total -;; sum, e.g. gnc:accounts-get-comm-total-{profit,assets}. -;; -;; total-name: The name to show in the total sum line. -;; -;; group-types?: Specify whether to group the accounts -;; according to their types and show a subtotal for each group. -;; -;; show-parent-balance?: Specify whether to show balances of -;; non-leaf accounts separately. -;; -;; show-parent-total?: Whether to show a line with the label -;; e.g. "Total My-Assets" and the subtotal for this account and its -;; children. -;; -;; show-other-curr?, report-commodity, -;; # exchange-fn: The rightmost column always shows -;; balances in the currency report-commodity. If those balances happen -;; to be in another currency, they will get converted to the -;; report-commodity by means of the exchange-fn which e.g. came from -;; gnc:make-exchange-function. If show-other-curr? == #t, the -;; non-report-currencies will additionally be displayed in the -;; second-rightmost column. -;; -;; start-percent, delta-percent: Fill in the [start:start+delta] -;; section of the progress bar while running this function. -;; - -(define (gnc:first-html-build-acct-table . args) - (issue-deprecation-warning - "gnc:first-html-build-acct-table is deprecated. use gnc:html-build-acct-table.") - (apply gnc:html-build-acct-table args)) - -(define (gnc:html-build-acct-table - start-date end-date - tree-depth show-subaccts? accounts - start-percent delta-percent - show-col-headers? - show-total? get-total-fn - total-name group-types? show-parent-balance? show-parent-total? - show-other-curr? report-commodity exchange-fn show-zero-entries?) - (issue-deprecation-warning - "gnc:html-build-acct-table is unused.") - (let ((table (gnc:make-html-table)) - (work-to-do 0) - (work-done 0) - (topl-accounts (gnc-account-get-children-sorted - (gnc-get-current-root-account)))) - - ;; The following functions are defined inside build-acct-table - ;; to avoid passing tons of arguments which are constant anyway - ;; inside this function. - - ;; If start-date == #f then balance-at-date will be used (for - ;; balance reports), otherwise balance-interval (for profit and - ;; loss reports). This function takes only the current account - ;; into consideration, i.e. none of the subaccounts are included - ;; in the balance. Returns a commodity-collector. - (define (my-get-balance-nosub account) - (if start-date - (gnc:account-get-comm-balance-interval - account start-date end-date #f) - (gnc:account-get-comm-balance-at-date - account end-date #f))) - - ;; Additional function that includes the subaccounts as - ;; well. Note: It is necessary to define this here (instead of - ;; changing an argument for account-get-balance) because the - ;; use-acct? query is needed. - (define (my-get-balance account) - ;; this-collector for storing the result - (let ((this-collector (my-get-balance-nosub account))) - (for-each - (lambda (x) (if x - (this-collector 'merge x #f))) - (gnc:account-map-descendants - (lambda (a) - ;; Important: Calculate the balance if and only if the - ;; account a is shown, i.e. (use-acct? a) == #t. - (and (use-acct? a) - (my-get-balance-nosub a))) - account)) - this-collector)) - - ;; Use this account in the account hierarchy? Check against the - ;; account selection and, if not selected, show-subaccts?==#t and - ;; any parent was selected. (Maybe the other way around is more - ;; effective?) - (define (use-acct? a) - (or (member a accounts) - (and show-subaccts? - (let ((parent (gnc-account-get-parent a))) - (and parent - (use-acct? parent)))))) - - ;; Show this account? Only if nonzero amount or appropriate - ;; preference. - (define (show-acct? a) - (and (or show-zero-entries? - (not (gnc-commodity-collector-allzero? - (my-get-balance a)))) - (use-acct? a))) - - ;; sort an account list. Currently this uses only the account-code - ;; field, but anyone feel free to add more options to this. - (define (sort-fn accts) - (sort accts - (lambda (a b) - (string) (export gnc:html-acct-table?) (export gnc:_make-html-acct-table_) @@ -521,25 +513,16 @@ (export gnc:_html-acct-table-set-env!_) (export gnc:html-acct-table-add-accounts!) (export gnc:html-acct-table-num-rows) -(export gnc:html-acct-table-num-cols) (export gnc:html-acct-table-get-row) (export gnc:html-acct-table-get-cell) (export gnc:html-acct-table-set-cell!) (export gnc:html-acct-table-get-row-env) (export gnc:html-acct-table-set-row-env!) -(export gnc:html-acct-table-append-row!) -(export gnc:html-acct-table-prepend-row!) -(export gnc:html-acct-table-append-col!) -(export gnc:html-acct-table-prepend-col!) -(export gnc:html-acct-table-remove-last-row!) -(export gnc:html-acct-table-render) (export gnc:account-code-less-p) (export gnc:account-name-less-p) (export gnc:account-path-less-p) -;;(export gnc:identity) (export gnc:html-table-add-labeled-amount-line!) (export gnc:html-table-add-account-balances) -(export gnc:second-html-build-acct-table) (export gnc-commodity-table) (export gnc:uniform-commodity?) @@ -633,7 +616,6 @@ (export gnc:html-table-set-cell!) (export gnc:html-table-set-cell/tag!) (export gnc:html-table-append-column!) -(export gnc:html-table-prepend-column!) (export gnc:html-table-render) ;; html-anytag.scm @@ -699,9 +681,7 @@ (export gnc:accounts-get-commodities) (export gnc:get-current-account-tree-depth) (export gnc:accounts-and-all-descendants) -(export gnc:acccounts-get-all-subaccounts) ;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:account-get-balances-at-dates) diff --git a/gnucash/report/reports/standard/general-journal.scm b/gnucash/report/reports/standard/general-journal.scm index 1573f8f935..791e70b756 100644 --- a/gnucash/report/reports/standard/general-journal.scm +++ b/gnucash/report/reports/standard/general-journal.scm @@ -27,7 +27,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-module (gnucash reports standard general-journal)) -(export gnc:make-general-journal-report) (use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) @@ -38,12 +37,6 @@ (define regrptname (N_ "Register")) (define regrptguid "22104e02654c4adba844ee75a3f8d173") -;; report constructor - -(define (gnc:make-general-journal-report) - (issue-deprecation-warning "gnc:make-general-journal-report is unused.") - (let* ((regrpt (gnc:make-report regrptguid))) - regrpt)) ;; options generator diff --git a/gnucash/report/reports/standard/general-ledger.scm b/gnucash/report/reports/standard/general-ledger.scm index 2f86c930f4..1c6db3f71b 100644 --- a/gnucash/report/reports/standard/general-ledger.scm +++ b/gnucash/report/reports/standard/general-ledger.scm @@ -30,7 +30,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-module (gnucash reports standard general-ledger)) -(export gnc:make-general-ledger-report) ;deprecated (use-modules (gnucash utilities)) (use-modules (gnucash gnc-module)) (use-modules (gnucash gettext)) @@ -42,12 +41,6 @@ (define xactrptname "Transaction Report") -;; report constructor - -(define (gnc:make-general-ledger-report) - (issue-deprecation-warning "gnc:make-general-ledger-report is unused") - (let* ((xactrpt (gnc:make-report xactrptguid))) - xactrpt)) ;; options generator diff --git a/gnucash/report/reports/standard/invoice.scm b/gnucash/report/reports/standard/invoice.scm index 88bf178bdc..aec6eca231 100644 --- a/gnucash/report/reports/standard/invoice.scm +++ b/gnucash/report/reports/standard/invoice.scm @@ -927,20 +927,3 @@ for styling the invoice. Please see the exported report for the CSS class names. 'renderer reg-renderer 'in-menu? #t) -(define (gnc:easy-invoice-report-create-internal invoice) - (issue-deprecation-warning - "gnc:easy-invoice-report-create-internal is unused") - (let* ((options (gnc:make-report-options easy-invoice-guid)) - (invoice-op (gnc:lookup-option options gnc:pagename-general gnc:optname-invoice-number))) - (gnc:option-set-value invoice-op invoice) - (gnc:make-report easy-invoice-guid options))) -(export gnc:easy-invoice-report-create-internal) - -(define (gnc:fancy-invoice-report-create-internal invoice) - (issue-deprecation-warning - "gnc:fancy-invoice-report-create-internal is unused") - (let* ((options (gnc:make-report-options fancy-invoice-guid)) - (invoice-op (gnc:lookup-option options gnc:pagename-general gnc:optname-invoice-number))) - (gnc:option-set-value invoice-op invoice) - (gnc:make-report fancy-invoice-guid options))) -(export gnc:fancy-invoice-report-create-internal) diff --git a/gnucash/report/test/test-report-utilities.scm b/gnucash/report/test/test-report-utilities.scm index cdba448e38..9a5d71be7f 100644 --- a/gnucash/report/test/test-report-utilities.scm +++ b/gnucash/report/test/test-report-utilities.scm @@ -487,13 +487,6 @@ 5 (gnc:get-current-account-tree-depth)) - (test-equal "gnc:acccounts-get-all-subaccounts" - (list (account-lookup "Fuel") - (account-lookup "GBP Savings")) - (gnc:acccounts-get-all-subaccounts - (list (account-lookup "Expenses") - (account-lookup "GBP Bank")))) - (test-equal "gnc:accounts-and-all-descendants" (list (account-lookup "GBP Bank") (account-lookup "GBP Savings") diff --git a/libgnucash/app-utils/app-utils.scm b/libgnucash/app-utils/app-utils.scm index 1f47907b14..0b73c0378a 100644 --- a/libgnucash/app-utils/app-utils.scm +++ b/libgnucash/app-utils/app-utils.scm @@ -203,8 +203,6 @@ (export incdate) (export decdate) (export incdate) -(export gnc:time64-le-date) -(export gnc:time64-ge-date) (export gnc:make-date-interval-list) (export gnc:make-date-list) (export SecDelta) @@ -226,12 +224,7 @@ (export gnc:reldate-get-string) (export gnc:reldate-get-desc) (export gnc:reldate-get-fn) -(export gnc:make-reldate-hash) ;deprecate -(export gnc:reldate-string-db) ;deprecate -(export gnc:relative-date-values) ;deprecate -(export gnc:relative-date-hash) ;deprecate (export gnc:get-absolute-from-relative-date) -(export gnc:get-relative-date-strings) ;deprecate (export gnc:get-relative-date-string) (export gnc:get-relative-date-desc) (export gnc:get-start-cal-year) diff --git a/libgnucash/app-utils/business-options.scm b/libgnucash/app-utils/business-options.scm index 7b89c1c58f..a04d3d4ae7 100644 --- a/libgnucash/app-utils/business-options.scm +++ b/libgnucash/app-utils/business-options.scm @@ -86,197 +86,6 @@ ;; Internally, values are always a guid. Externally, both guids and ;; customer pointers may be used to set the value of the option. The ;; option always returns a single customer pointer. - -(define (gnc:make-customer-option - section - name - sort-tag - documentation-string - default-getter - value-validator) - - (define (convert-to-guid item) - (if (string? item) - item - (gncCustomerReturnGUID item))) - - (define (convert-to-customer item) - (if (string? item) - (gncCustomerLookupFlip item (gnc-get-current-book)) - item)) - (issue-deprecation-warning - "gnc:make-customer-option is unused.") - - (let* ((option (convert-to-guid (default-getter))) - (option-set #f) - (getter (lambda () (convert-to-customer - (if option-set - option - (default-getter))))) - (value->string (lambda () - (string-append - "'" (gnc:value->string (if option-set option #f))))) - (validator - (if (not value-validator) - (lambda (customer) (list #t customer)) - (lambda (customer) - (value-validator (convert-to-customer customer)))))) - (gnc:make-option - section name sort-tag 'customer documentation-string getter - (lambda (customer) - (if (null? customer) (set! customer (default-getter))) - (set! customer (convert-to-customer customer)) - (let* ((result (validator customer)) - (valid (car result)) - (value (cadr result))) - (if valid - (begin - (set! option (convert-to-guid value)) - (set! option-set #t)) - (gnc:error "Illegal customer value set")))) - (lambda () (convert-to-customer (default-getter))) - (gnc:restore-form-generator value->string) - (lambda (b p) (qof-book-set-option b option p)) - (lambda (b p) - (let ((v (qof-book-get-option b p))) - (if (and v (string? v)) - (begin - (set! option v) - (set! option-set #t))))) - validator - #f #f #f #f))) - -;; Internally, values are always a guid. Externally, both guids and -;; vendor pointers may be used to set the value of the option. The -;; option always returns a single vendor pointer. - -(define (gnc:make-vendor-option - section - name - sort-tag - documentation-string - default-getter - value-validator) - - (define (convert-to-guid item) - (if (string? item) - item - (gncVendorReturnGUID item))) - - (define (convert-to-vendor item) - (if (string? item) - (gncVendorLookupFlip item (gnc-get-current-book)) - item)) - - (issue-deprecation-warning - "gnc:make-vendor-option is unused.") - - (let* ((option (convert-to-guid (default-getter))) - (option-set #f) - (getter (lambda () (convert-to-vendor - (if option-set - option - (default-getter))))) - (value->string (lambda () - (string-append - "'" (gnc:value->string (if option-set option #f))))) - (validator - (if (not value-validator) - (lambda (vendor) (list #t vendor)) - (lambda (vendor) - (value-validator (convert-to-vendor vendor)))))) - (gnc:make-option - section name sort-tag 'vendor documentation-string getter - (lambda (vendor) - (if (null? vendor) (set! vendor (default-getter))) - (set! vendor (convert-to-vendor vendor)) - (let* ((result (validator vendor)) - (valid (car result)) - (value (cadr result))) - (if valid - (begin - (set! option (convert-to-guid value)) - (set! option-set #t)) - (gnc:error "Illegal vendor value set")))) - (lambda () (convert-to-vendor (default-getter))) - (gnc:restore-form-generator value->string) - (lambda (b p) (qof-book-set-option b option p)) - (lambda (b p) - (let ((v (qof-book-get-option b p))) - (if (and v (string? v)) - (begin - (set! option v) - (set! option-set #t))))) - validator - #f #f #f #f))) - -;; Internally, values are always a guid. Externally, both guids and -;; employee pointers may be used to set the value of the option. The -;; option always returns a single employee pointer. - -(define (gnc:make-employee-option - section - name - sort-tag - documentation-string - default-getter - value-validator) - - (define (convert-to-guid item) - (if (string? item) - item - (gncEmployeeReturnGUID item))) - - (define (convert-to-employee item) - (if (string? item) - (gncEmployeeLookupFlip item (gnc-get-current-book)) - item)) - (issue-deprecation-warning - "gnc:make-employee-option is unused.") - - (let* ((option (convert-to-guid (default-getter))) - (option-set #f) - (getter (lambda () (convert-to-employee - (if option-set - option - (default-getter))))) - (value->string (lambda () - (string-append - "'" (gnc:value->string (if option-set option #f))))) - (validator - (if (not value-validator) - (lambda (employee) (list #t employee)) - (lambda (employee) - (value-validator (convert-to-employee employee)))))) - (gnc:make-option - section name sort-tag 'employee documentation-string getter - (lambda (employee) - (if (null? employee) (set! employee (default-getter))) - (set! employee (convert-to-employee employee)) - (let* ((result (validator employee)) - (valid (car result)) - (value (cadr result))) - (if valid - (begin - (set! option (convert-to-guid value)) - (set! option-set #t)) - (gnc:error "Illegal employee value set")))) - (lambda () (convert-to-employee (default-getter))) - (gnc:restore-form-generator value->string) - (lambda (b p) (qof-book-set-option b option p)) - (lambda (b p) - (let ((v (qof-book-get-option b p))) - (if (and v (string? v)) - (begin - (set! option v) - (set! option-set #t))))) - validator - #f #f #f #f))) - -;; Internally, values are always a type/guid pair. Externally, both -;; type/guid pairs and owner pointers may be used to set the value of -;; the option. The option always returns a single owner pointer. - (define (gnc:make-owner-option section name @@ -504,9 +313,6 @@ option)) (export gnc:make-invoice-option) -(export gnc:make-customer-option) -(export gnc:make-vendor-option) -(export gnc:make-employee-option) (export gnc:make-owner-option) (export gnc:make-taxtable-option) (export gnc:make-counter-option) diff --git a/libgnucash/app-utils/date-utilities.scm b/libgnucash/app-utils/date-utilities.scm index 4ecdb9311c..bc6907bc9a 100644 --- a/libgnucash/app-utils/date-utilities.scm +++ b/libgnucash/app-utils/date-utilities.scm @@ -206,17 +206,6 @@ (define (decdate adate delta) (moddate - adate delta )) (define (incdate adate delta) (moddate + adate delta )) -;; date-granularity comparison functions. - -(define (gnc:time64-le-date t1 t2) - (issue-deprecation-warning "gnc:time64-le-date is unused") - (<= (time64CanonicalDayTime t1) - (time64CanonicalDayTime t2))) - -(define (gnc:time64-ge-date t1 t2) - (issue-deprecation-warning "gnc:time64-ge-date is unused") - (gnc:time64-le-date t2 t1)) - ;; returns #t if adding 1 to mday causes a month change. (define (end-month? date) (let ((nextdate (gnc-localtime date))) @@ -425,21 +414,8 @@ (define (gnc:reldate-get-desc x) (vector-ref x 2)) (define (gnc:reldate-get-fn x) (vector-ref x 3)) -(define (gnc:make-reldate-hash hash reldate-list) - (issue-deprecation-warning "gnc:make-reldate-hash is deprecated.") - (map (lambda (reldate) (hash-set! - hash - (gnc:reldate-get-symbol reldate) - reldate)) - reldate-list)) - -;; the following two variables will be inlined and can be deprecated -(define gnc:reldate-string-db (gnc:make-string-database)) ;deprecate -(define gnc:relative-date-values '()) ;deprecate - ;; the globally available hash of reldates (hash-key = reldate -;; symbols, hash-value = a vector, reldate data). aim to deprecate it -;; being exported. +;; symbols, hash-value = a vector, reldate data). (define gnc:relative-date-hash (make-hash-table)) (define (gnc:get-absolute-from-relative-date date-symbol) @@ -455,13 +431,6 @@ Defaulting to today.")) (gnc:gui-warn conmsg uimsg) (current-time))))) -(define (gnc:get-relative-date-strings date-symbol) - (issue-deprecation-warning "gnc:get-relative-date-strings is unused.") - (let ((rel-date-info (hash-ref gnc:relative-date-hash date-symbol))) - - (cons (gnc:reldate-get-string rel-date-info) - (gnc:relate-get-desc rel-date-info)))) - (define (gnc:get-relative-date-string date-symbol) ;; used in options.scm (let ((rel-date-info (hash-ref gnc:relative-date-hash date-symbol))) diff --git a/libgnucash/engine/business-core.scm b/libgnucash/engine/business-core.scm index be87243849..ed06f2332a 100644 --- a/libgnucash/engine/business-core.scm +++ b/libgnucash/engine/business-core.scm @@ -94,12 +94,6 @@ (gnc:owner-get-owner-id (gncJobGetOwner (gncOwnerGetJob owner)))) (else "")))) -(define (gnc:entry-type-percent-p type-val) - (issue-deprecation-warning - "gnc:entry-type-percent-p is deprecated.") - (let ((type type-val)) - (equal? type GNC-AMT-TYPE-PERCENT))) - ;; this function aims to find a split's owner. various splits are ;; supported: (1) any splits in the invoice posted transaction, in ;; APAR or income/expense accounts (2) any splits from invoice's @@ -130,5 +124,4 @@ (export gnc:owner-get-address-dep) (export gnc:owner-get-name-and-address-dep) (export gnc:owner-get-owner-id) -(export gnc:entry-type-percent-p) (export gnc:owner-from-split) diff --git a/po/POTFILES.in b/po/POTFILES.in index cebc9dd8eb..d161eb21d1 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -366,7 +366,6 @@ gnucash/import-export/qif-imp/qif-objects.scm gnucash/import-export/qif-imp/qif-parse.scm gnucash/import-export/qif-imp/qif-to-gnc.scm gnucash/import-export/qif-imp/qif-utils.scm -gnucash/import-export/qif-imp/simple-obj.scm gnucash/import-export/qif-imp/string.scm gnucash/python/gncmod-python.c gnucash/register/ledger-core/gncEntryLedger.c