mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Remove deprecated functions
This commit is contained in:
Christopher Lam
parent
594388b765
commit
0f6ad8263b
@ -51,7 +51,6 @@ set (qif_import_SCHEME
|
|||||||
qif-to-gnc.scm
|
qif-to-gnc.scm
|
||||||
qif-utils.scm
|
qif-utils.scm
|
||||||
qif-import.scm # yes, included in both SETs
|
qif-import.scm # yes, included in both SETs
|
||||||
simple-obj.scm
|
|
||||||
)
|
)
|
||||||
|
|
||||||
set(qif_import_SCHEME_2
|
set(qif_import_SCHEME_2
|
||||||
|
|||||||
@ -29,29 +29,6 @@
|
|||||||
(define qif-import:paused #f)
|
(define qif-import:paused #f)
|
||||||
(define qif-import:canceled #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)
|
(define (qif-import:log progress-dialog proc str)
|
||||||
(if progress-dialog
|
(if progress-dialog
|
||||||
(gnc-progress-dialog-append-log progress-dialog (string-append str "\n"))
|
(gnc-progress-dialog-append-log progress-dialog (string-append str "\n"))
|
||||||
|
|||||||
@ -1,86 +0,0 @@
|
|||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; simple-obj.scm
|
|
||||||
;;; rudimentary "class" system for straight Scheme
|
|
||||||
;;;
|
|
||||||
;;; Bill Gribble <grib@billgribble.com> 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)
|
|
||||||
;; <class-name> with class-smybol 'class-name. For example,
|
|
||||||
;;
|
|
||||||
;; (define <test-class> (make-simple-class 'test-class '(slot-1 slot-2)))
|
|
||||||
;; (define t (make-simple-obj <test-class>))
|
|
||||||
;; 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)))
|
|
||||||
|
|
||||||
@ -850,29 +850,6 @@
|
|||||||
GNC-RND-ROUND))
|
GNC-RND-ROUND))
|
||||||
(foreign 'format gnc:make-gnc-monetary #f))))))
|
(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 <gnc:monetary>)
|
|
||||||
;; 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)
|
(define (gnc:uniform-commodity? amt report-commodity)
|
||||||
;; function to see if the commodity-collector amt
|
;; function to see if the commodity-collector amt
|
||||||
;; contains any foreign commodities
|
;; contains any foreign commodities
|
||||||
|
|||||||
@ -498,12 +498,6 @@
|
|||||||
(use-modules (srfi srfi-2))
|
(use-modules (srfi srfi-2))
|
||||||
(use-modules (srfi srfi-9))
|
(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)
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; <html-acct-table> class
|
;; <html-acct-table> class
|
||||||
;; utility class for generating account tables
|
;; utility class for generating account tables
|
||||||
@ -911,10 +905,6 @@
|
|||||||
(define (gnc:html-acct-table-num-rows acct-table)
|
(define (gnc:html-acct-table-num-rows acct-table)
|
||||||
(gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ 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)
|
(define (gnc:html-acct-table-get-cell acct-table row col)
|
||||||
;; we'll only ever store one object in an html-table-cell
|
;; we'll only ever store one object in an html-table-cell
|
||||||
;; returns the first object stored in that 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)
|
(define (gnc:html-acct-table-set-row-env! acct-table row env)
|
||||||
(gnc:html-acct-table-set-cell! acct-table row -1 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.
|
;; 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
|
;; END
|
||||||
|
|
||||||
|
|||||||
@ -553,46 +553,6 @@
|
|||||||
remaining-elements)
|
remaining-elements)
|
||||||
#f))))
|
#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.
|
;; It would be nice to have table row/col/cell accessor functions in here.
|
||||||
|
|||||||
@ -214,570 +214,6 @@
|
|||||||
(define (gnc:html-table-append-ruler! table colspan)
|
(define (gnc:html-table-append-ruler! table colspan)
|
||||||
(gnc:html-table-append-ruler/at! table 0 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 <html-text> object. Returns a <html-table-cell>
|
|
||||||
;; 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
|
|
||||||
;; <gnc:commodity*>) 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
|
|
||||||
;; <gnc-monetary> for the foreign column or #f if to be left
|
|
||||||
;; empty; domestic-balance is the <gnc-monetary> 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:
|
|
||||||
;;
|
|
||||||
;; <gnc:time-pair> start-date: Start date of reporting period. If #f,
|
|
||||||
;; everything till end-date will be considered.
|
|
||||||
;;
|
|
||||||
;; <gnc:time-pair> end-date: End date of reporting period.
|
|
||||||
;;
|
|
||||||
;; <int> tree-depth, <bool> show-subaccounts?, <gnc:list-of-account*>
|
|
||||||
;; 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.
|
|
||||||
;;
|
|
||||||
;; <bool> show-col-headers?: show column headings "Account" and
|
|
||||||
;; "Balance"
|
|
||||||
;;
|
|
||||||
;; <bool> show-total?: If #f, no total sum is shown.
|
|
||||||
;;
|
|
||||||
;; #<procedure ...> get-total-fn: The function to calculate the total
|
|
||||||
;; sum, e.g. gnc:accounts-get-comm-total-{profit,assets}.
|
|
||||||
;;
|
|
||||||
;; <chars> total-name: The name to show in the total sum line.
|
|
||||||
;;
|
|
||||||
;; <bool> group-types?: Specify whether to group the accounts
|
|
||||||
;; according to their types and show a subtotal for each group.
|
|
||||||
;;
|
|
||||||
;; <bool> show-parent-balance?: Specify whether to show balances of
|
|
||||||
;; non-leaf accounts separately.
|
|
||||||
;;
|
|
||||||
;; <bool> 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.
|
|
||||||
;;
|
|
||||||
;; <bool> show-other-curr?, <gnc:commodity*> report-commodity,
|
|
||||||
;; #<procedure ...> 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.
|
|
||||||
;;
|
|
||||||
;; <int> 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<? (xaccAccountGetCode a)
|
|
||||||
(xaccAccountGetCode b)))))
|
|
||||||
|
|
||||||
;; Remove the last appended row iff *all* its fields are empty
|
|
||||||
;; (==#f) or have an html-table-cell which in turn is empty
|
|
||||||
;; (resulting from the add-group! function above). Note: This
|
|
||||||
;; depends on the structure of html-table-data, i.e. if those are
|
|
||||||
;; changed then this might break.
|
|
||||||
(define (remove-last-empty-row)
|
|
||||||
(if (and (not (null? (gnc:html-table-data table)))
|
|
||||||
(not (or-map
|
|
||||||
(lambda (e)
|
|
||||||
(if (gnc:html-table-cell? e)
|
|
||||||
(car (gnc:html-table-cell-data e))
|
|
||||||
e))
|
|
||||||
(car (gnc:html-table-data table)))))
|
|
||||||
(gnc:html-table-remove-last-row! table)))
|
|
||||||
|
|
||||||
;; Wrapper for gnc:html-acct-table-row-helper!
|
|
||||||
(define (add-row-helper!
|
|
||||||
current-depth my-name my-balance
|
|
||||||
reverse-balance? row-style boldface? group-header-line?)
|
|
||||||
(gnc:html-acct-table-row-helper!
|
|
||||||
table tree-depth
|
|
||||||
current-depth my-name my-balance
|
|
||||||
reverse-balance? row-style boldface? group-header-line?))
|
|
||||||
|
|
||||||
;; Wrapper
|
|
||||||
(define (add-commodity-rows!
|
|
||||||
current-depth my-name my-commodity balance
|
|
||||||
reverse-balance? is-stock-account?
|
|
||||||
main-row-style other-rows-style boldface? group-header-line?)
|
|
||||||
(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?))
|
|
||||||
|
|
||||||
;; Adds all appropriate rows to the table which belong to one
|
|
||||||
;; account. Uses the above helper function, i.e. here the
|
|
||||||
;; necessary values only are "extracted" from the account.
|
|
||||||
(define (add-account-rows! acct current-depth alternate-row?)
|
|
||||||
(let ((row-style (if alternate-row? "alternate-row" "normal-row")))
|
|
||||||
(if show-other-curr?
|
|
||||||
(add-commodity-rows! current-depth
|
|
||||||
(gnc:html-account-anchor acct)
|
|
||||||
(xaccAccountGetCommodity acct)
|
|
||||||
(my-get-balance acct)
|
|
||||||
(gnc-reverse-balance acct)
|
|
||||||
(gnc:account-has-shares? acct)
|
|
||||||
row-style row-style
|
|
||||||
#f #f)
|
|
||||||
(add-row-helper!
|
|
||||||
current-depth
|
|
||||||
(gnc:html-account-anchor acct)
|
|
||||||
(gnc:sum-collector-commodity (my-get-balance acct)
|
|
||||||
report-commodity exchange-fn)
|
|
||||||
(gnc-reverse-balance acct)
|
|
||||||
row-style
|
|
||||||
#f #f))))
|
|
||||||
|
|
||||||
;; Generalization of add-account-rows! for a subtotal or for the
|
|
||||||
;; total balance.
|
|
||||||
(define (add-subtotal-row!
|
|
||||||
current-depth subtotal-name balance
|
|
||||||
row-style boldface? group-header-line?)
|
|
||||||
(if show-other-curr?
|
|
||||||
(add-commodity-rows! current-depth subtotal-name
|
|
||||||
report-commodity
|
|
||||||
(gnc:sum-collector-stocks
|
|
||||||
balance report-commodity exchange-fn)
|
|
||||||
#f #f row-style row-style
|
|
||||||
boldface? group-header-line?)
|
|
||||||
;; Show no other currencies. Therefore just calculate
|
|
||||||
;; one total via sum-collector-commodity and show it.
|
|
||||||
(add-row-helper! current-depth subtotal-name
|
|
||||||
(gnc:sum-collector-commodity
|
|
||||||
balance report-commodity exchange-fn)
|
|
||||||
#f
|
|
||||||
row-style
|
|
||||||
boldface? group-header-line?)))
|
|
||||||
|
|
||||||
(define (count-accounts! current-depth accnts)
|
|
||||||
(if (<= current-depth tree-depth)
|
|
||||||
(let ((sum 0))
|
|
||||||
(for-each
|
|
||||||
(lambda (acct)
|
|
||||||
(let ((subaccts (filter
|
|
||||||
use-acct?
|
|
||||||
(gnc-account-get-children acct))))
|
|
||||||
(set! sum (+ sum 1))
|
|
||||||
(if (or (= current-depth tree-depth) (null? subaccts))
|
|
||||||
sum
|
|
||||||
(set! sum (+ sum (count-accounts! (+ 1 current-depth) subaccts))))))
|
|
||||||
accnts)
|
|
||||||
sum)
|
|
||||||
0))
|
|
||||||
|
|
||||||
;; This prints *all* the rows that belong to one group: the title
|
|
||||||
;; row, the subaccount tree, and the Total row with the balance of
|
|
||||||
;; the subaccounts. groupname may be a string or a html-text
|
|
||||||
;; object. subaccounts is a list of accounts. thisbalance is the
|
|
||||||
;; balance of this group, or it may be #f, in which case the
|
|
||||||
;; balance is calculated from the subaccounts list.
|
|
||||||
(define (add-group! current-depth groupname subaccounts
|
|
||||||
thisbalance group-total-line?)
|
|
||||||
(let ((heading-style (if (= current-depth 1)
|
|
||||||
"primary-subheading"
|
|
||||||
"secondary-subheading")))
|
|
||||||
|
|
||||||
;; first the group name
|
|
||||||
(add-subtotal-row! current-depth groupname
|
|
||||||
(and show-parent-balance? thisbalance)
|
|
||||||
heading-style
|
|
||||||
(not (and show-parent-balance? thisbalance)) #t)
|
|
||||||
;; then all the subaccounts
|
|
||||||
(traverse-accounts! subaccounts (+ 1 current-depth))
|
|
||||||
;; and now the "total" row
|
|
||||||
(if group-total-line?
|
|
||||||
(begin
|
|
||||||
(remove-last-empty-row) ;; FIXME: do this here or not?
|
|
||||||
(add-subtotal-row!
|
|
||||||
current-depth
|
|
||||||
(let ((total-text (gnc:make-html-text (_ "Total") " ")))
|
|
||||||
(if (gnc:html-text? groupname)
|
|
||||||
(apply gnc:html-text-append!
|
|
||||||
total-text
|
|
||||||
(gnc:html-text-body groupname))
|
|
||||||
(gnc:html-text-append! total-text groupname))
|
|
||||||
total-text)
|
|
||||||
;; Calculate the balance, including the subbalances.
|
|
||||||
;; A subbalance is only calculated if no thisbalance was
|
|
||||||
;; given. (Because any "thisbalance" calculation already
|
|
||||||
;; includes the appropriate subaccounts.)
|
|
||||||
(let ((subbalance (gnc:accounts-get-balance-helper
|
|
||||||
subaccounts my-get-balance
|
|
||||||
gnc-reverse-balance)))
|
|
||||||
(if thisbalance
|
|
||||||
(subbalance 'merge thisbalance #f))
|
|
||||||
subbalance)
|
|
||||||
heading-style
|
|
||||||
#t #f)))))
|
|
||||||
;; and an empty line
|
|
||||||
; (add-subtotal-row! current-depth #f #f heading-style #f #f)))))
|
|
||||||
|
|
||||||
;; Adds rows to the table. Therefore it goes through the list of
|
|
||||||
;; accounts, runs add-account-rows! on each account. If
|
|
||||||
;; tree-depth and current-depth require, it will recursively call
|
|
||||||
;; itself on the list of children accounts.
|
|
||||||
(define (traverse-accounts! accnts current-depth)
|
|
||||||
(let ((alternate #f))
|
|
||||||
(if (<= current-depth tree-depth)
|
|
||||||
(for-each
|
|
||||||
(lambda (acct)
|
|
||||||
(let ((subaccts (filter
|
|
||||||
use-acct?
|
|
||||||
(gnc-account-get-children acct))))
|
|
||||||
(set! work-done (+ 1 work-done))
|
|
||||||
(if start-percent
|
|
||||||
(gnc:report-percent-done
|
|
||||||
(+ start-percent (* delta-percent (/ work-done work-to-do)))))
|
|
||||||
(if (or (= current-depth tree-depth) (null? subaccts))
|
|
||||||
(begin
|
|
||||||
(if (show-acct? acct)
|
|
||||||
(add-account-rows! acct current-depth alternate))
|
|
||||||
(set! alternate (not alternate)))
|
|
||||||
(add-group! current-depth
|
|
||||||
(gnc:html-account-anchor acct)
|
|
||||||
subaccts
|
|
||||||
(gnc:accounts-get-balance-helper
|
|
||||||
(list acct) my-get-balance-nosub
|
|
||||||
gnc-reverse-balance)
|
|
||||||
show-parent-total?))))
|
|
||||||
(sort-fn accnts)))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;; start the recursive account processing
|
|
||||||
(set! work-to-do (count-accounts!
|
|
||||||
(if group-types? 2 1)
|
|
||||||
(filter use-acct? topl-accounts)))
|
|
||||||
(if group-types?
|
|
||||||
;; Print a subtotal for each group.
|
|
||||||
(for-each
|
|
||||||
(lambda (accts)
|
|
||||||
(if (and (not (null? accts)) (not (null? (cdr accts))))
|
|
||||||
(add-group! 1
|
|
||||||
(gnc:account-get-type-string-plural (car accts))
|
|
||||||
(cdr accts) #f #t)))
|
|
||||||
(gnc:decompose-accountlist (lset-intersection
|
|
||||||
equal? accounts topl-accounts)))
|
|
||||||
;; No extra grouping.
|
|
||||||
;; FIXME: go through accounts even if not
|
|
||||||
;; shown, because the children might be shown.
|
|
||||||
(traverse-accounts! (filter use-acct? topl-accounts) 1))
|
|
||||||
|
|
||||||
(remove-last-empty-row)
|
|
||||||
|
|
||||||
;; Show the total sum.
|
|
||||||
(if show-total?
|
|
||||||
(begin
|
|
||||||
(gnc:html-table-append-ruler/markup!
|
|
||||||
table "grand-total" (* (if show-other-curr? 3 2) tree-depth))
|
|
||||||
(add-subtotal-row!
|
|
||||||
1 total-name
|
|
||||||
(get-total-fn (filter use-acct? topl-accounts) my-get-balance)
|
|
||||||
"grand-total"
|
|
||||||
#t #f)))
|
|
||||||
|
|
||||||
;; set default alignment to right, and override for the name
|
|
||||||
;; columns
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "td"
|
|
||||||
'attribute '("align" "right")
|
|
||||||
'attribute '("valign" "top"))
|
|
||||||
|
|
||||||
(gnc:html-table-set-style!
|
|
||||||
table "th"
|
|
||||||
'attribute '("align" "center")
|
|
||||||
'attribute '("valign" "top"))
|
|
||||||
|
|
||||||
;; set some column headers
|
|
||||||
(if show-col-headers?
|
|
||||||
(gnc:html-table-set-col-headers!
|
|
||||||
table
|
|
||||||
(list (gnc:make-html-table-header-cell/size
|
|
||||||
1 tree-depth (_ "Account name"))
|
|
||||||
(gnc:make-html-table-header-cell/size
|
|
||||||
1 (if show-other-curr?
|
|
||||||
(* 2 tree-depth)
|
|
||||||
tree-depth)
|
|
||||||
(_ "Balance")))))
|
|
||||||
|
|
||||||
;; No extra alignment here because that's already done in
|
|
||||||
;; html-acct-table-cell.
|
|
||||||
|
|
||||||
table))
|
|
||||||
|
|
||||||
|
|
||||||
;; Create a html-table of all exchange rates. The report-commodity is
|
;; Create a html-table of all exchange rates. The report-commodity is
|
||||||
;; 'common-commodity', the exchange rates are given through the
|
;; 'common-commodity', the exchange rates are given through the
|
||||||
;; function 'exchange-fn' and the 'accounts' determine which
|
;; function 'exchange-fn' and the 'accounts' determine which
|
||||||
|
|||||||
@ -135,13 +135,6 @@
|
|||||||
(let ((root (gnc-get-current-root-account)))
|
(let ((root (gnc-get-current-root-account)))
|
||||||
(gnc-account-get-tree-depth root)))
|
(gnc-account-get-tree-depth root)))
|
||||||
|
|
||||||
|
|
||||||
;; Get all children of this list of accounts.
|
|
||||||
(define (gnc:acccounts-get-all-subaccounts accountlist)
|
|
||||||
(issue-deprecation-warning "gnc:acccounts-get-all-subaccounts is unused.")
|
|
||||||
(append-map gnc-account-get-descendants-sorted
|
|
||||||
accountlist))
|
|
||||||
|
|
||||||
;; Return accountslist *and* their descendant accounts
|
;; Return accountslist *and* their descendant accounts
|
||||||
(define (gnc:accounts-and-all-descendants accountslist)
|
(define (gnc:accounts-and-all-descendants accountslist)
|
||||||
(sort-and-delete-duplicates
|
(sort-and-delete-duplicates
|
||||||
|
|||||||
@ -61,7 +61,6 @@
|
|||||||
(export gnc:case-exchange-fn)
|
(export gnc:case-exchange-fn)
|
||||||
(export gnc:case-exchange-time-fn)
|
(export gnc:case-exchange-time-fn)
|
||||||
(export gnc:sum-collector-commodity)
|
(export gnc:sum-collector-commodity)
|
||||||
(export gnc:sum-collector-stocks)
|
|
||||||
|
|
||||||
;; options-utilities.scm
|
;; options-utilities.scm
|
||||||
|
|
||||||
@ -103,12 +102,6 @@
|
|||||||
(export gnc:owner-report-text)
|
(export gnc:owner-report-text)
|
||||||
(export gnc:assign-colors)
|
(export gnc:assign-colors)
|
||||||
(export gnc:html-table-append-ruler!)
|
(export gnc:html-table-append-ruler!)
|
||||||
(export gnc:html-table-append-ruler/markup!)
|
|
||||||
(export gnc:html-acct-table-cell) ;deprecated
|
|
||||||
(export gnc:html-acct-table-row-helper! )
|
|
||||||
(export gnc:html-acct-table-comm-row-helper!)
|
|
||||||
(export gnc:html-build-acct-table)
|
|
||||||
(export gnc:first-html-build-acct-table)
|
|
||||||
(export gnc:html-make-exchangerates)
|
(export gnc:html-make-exchangerates)
|
||||||
(export gnc:html-render-options-changed)
|
(export gnc:html-render-options-changed)
|
||||||
(export gnc:html-make-generic-warning)
|
(export gnc:html-make-generic-warning)
|
||||||
@ -508,7 +501,6 @@
|
|||||||
|
|
||||||
;; html-acct-table.scm
|
;; html-acct-table.scm
|
||||||
|
|
||||||
(export gnc:colspans-are-working-right)
|
|
||||||
(export <html-acct-table>)
|
(export <html-acct-table>)
|
||||||
(export gnc:html-acct-table?)
|
(export gnc:html-acct-table?)
|
||||||
(export gnc:_make-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-set-env!_)
|
||||||
(export gnc:html-acct-table-add-accounts!)
|
(export gnc:html-acct-table-add-accounts!)
|
||||||
(export gnc:html-acct-table-num-rows)
|
(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-row)
|
||||||
(export gnc:html-acct-table-get-cell)
|
(export gnc:html-acct-table-get-cell)
|
||||||
(export gnc:html-acct-table-set-cell!)
|
(export gnc:html-acct-table-set-cell!)
|
||||||
(export gnc:html-acct-table-get-row-env)
|
(export gnc:html-acct-table-get-row-env)
|
||||||
(export gnc:html-acct-table-set-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-code-less-p)
|
||||||
(export gnc:account-name-less-p)
|
(export gnc:account-name-less-p)
|
||||||
(export gnc:account-path-less-p)
|
(export gnc:account-path-less-p)
|
||||||
;;(export gnc:identity)
|
|
||||||
(export gnc:html-table-add-labeled-amount-line!)
|
(export gnc:html-table-add-labeled-amount-line!)
|
||||||
(export gnc:html-table-add-account-balances)
|
(export gnc:html-table-add-account-balances)
|
||||||
(export gnc:second-html-build-acct-table)
|
|
||||||
(export gnc-commodity-table)
|
(export gnc-commodity-table)
|
||||||
(export gnc:uniform-commodity?)
|
(export gnc:uniform-commodity?)
|
||||||
|
|
||||||
@ -633,7 +616,6 @@
|
|||||||
(export gnc:html-table-set-cell!)
|
(export gnc:html-table-set-cell!)
|
||||||
(export gnc:html-table-set-cell/tag!)
|
(export gnc:html-table-set-cell/tag!)
|
||||||
(export gnc:html-table-append-column!)
|
(export gnc:html-table-append-column!)
|
||||||
(export gnc:html-table-prepend-column!)
|
|
||||||
(export gnc:html-table-render)
|
(export gnc:html-table-render)
|
||||||
|
|
||||||
;; html-anytag.scm
|
;; html-anytag.scm
|
||||||
@ -699,9 +681,7 @@
|
|||||||
(export gnc:accounts-get-commodities)
|
(export gnc:accounts-get-commodities)
|
||||||
(export gnc:get-current-account-tree-depth)
|
(export gnc:get-current-account-tree-depth)
|
||||||
(export gnc:accounts-and-all-descendants)
|
(export gnc:accounts-and-all-descendants)
|
||||||
(export gnc:acccounts-get-all-subaccounts) ;deprecated
|
|
||||||
(export gnc:make-value-collector)
|
(export gnc:make-value-collector)
|
||||||
(export gnc:make-number-collector) ;deprecated
|
|
||||||
(export gnc:make-commodity-collector)
|
(export gnc:make-commodity-collector)
|
||||||
(export gnc:commodity-collector-get-negated)
|
(export gnc:commodity-collector-get-negated)
|
||||||
(export gnc:account-get-balances-at-dates)
|
(export gnc:account-get-balances-at-dates)
|
||||||
|
|||||||
@ -27,7 +27,6 @@
|
|||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define-module (gnucash reports standard general-journal))
|
(define-module (gnucash reports standard general-journal))
|
||||||
(export gnc:make-general-journal-report)
|
|
||||||
(use-modules (gnucash utilities))
|
(use-modules (gnucash utilities))
|
||||||
(use-modules (gnucash gnc-module))
|
(use-modules (gnucash gnc-module))
|
||||||
(use-modules (gnucash gettext))
|
(use-modules (gnucash gettext))
|
||||||
@ -38,12 +37,6 @@
|
|||||||
(define regrptname (N_ "Register"))
|
(define regrptname (N_ "Register"))
|
||||||
(define regrptguid "22104e02654c4adba844ee75a3f8d173")
|
(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
|
;; options generator
|
||||||
|
|
||||||
|
|||||||
@ -30,7 +30,6 @@
|
|||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define-module (gnucash reports standard general-ledger))
|
(define-module (gnucash reports standard general-ledger))
|
||||||
(export gnc:make-general-ledger-report) ;deprecated
|
|
||||||
(use-modules (gnucash utilities))
|
(use-modules (gnucash utilities))
|
||||||
(use-modules (gnucash gnc-module))
|
(use-modules (gnucash gnc-module))
|
||||||
(use-modules (gnucash gettext))
|
(use-modules (gnucash gettext))
|
||||||
@ -42,12 +41,6 @@
|
|||||||
(define xactrptname "Transaction Report")
|
(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
|
;; options generator
|
||||||
|
|
||||||
|
|||||||
@ -927,20 +927,3 @@ for styling the invoice. Please see the exported report for the CSS class names.
|
|||||||
'renderer reg-renderer
|
'renderer reg-renderer
|
||||||
'in-menu? #t)
|
'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)
|
|
||||||
|
|||||||
@ -487,13 +487,6 @@
|
|||||||
5
|
5
|
||||||
(gnc:get-current-account-tree-depth))
|
(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"
|
(test-equal "gnc:accounts-and-all-descendants"
|
||||||
(list (account-lookup "GBP Bank")
|
(list (account-lookup "GBP Bank")
|
||||||
(account-lookup "GBP Savings")
|
(account-lookup "GBP Savings")
|
||||||
|
|||||||
@ -203,8 +203,6 @@
|
|||||||
(export incdate)
|
(export incdate)
|
||||||
(export decdate)
|
(export decdate)
|
||||||
(export incdate)
|
(export incdate)
|
||||||
(export gnc:time64-le-date)
|
|
||||||
(export gnc:time64-ge-date)
|
|
||||||
(export gnc:make-date-interval-list)
|
(export gnc:make-date-interval-list)
|
||||||
(export gnc:make-date-list)
|
(export gnc:make-date-list)
|
||||||
(export SecDelta)
|
(export SecDelta)
|
||||||
@ -226,12 +224,7 @@
|
|||||||
(export gnc:reldate-get-string)
|
(export gnc:reldate-get-string)
|
||||||
(export gnc:reldate-get-desc)
|
(export gnc:reldate-get-desc)
|
||||||
(export gnc:reldate-get-fn)
|
(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-absolute-from-relative-date)
|
||||||
(export gnc:get-relative-date-strings) ;deprecate
|
|
||||||
(export gnc:get-relative-date-string)
|
(export gnc:get-relative-date-string)
|
||||||
(export gnc:get-relative-date-desc)
|
(export gnc:get-relative-date-desc)
|
||||||
(export gnc:get-start-cal-year)
|
(export gnc:get-start-cal-year)
|
||||||
|
|||||||
@ -86,197 +86,6 @@
|
|||||||
;; Internally, values are always a guid. Externally, both guids and
|
;; Internally, values are always a guid. Externally, both guids and
|
||||||
;; customer pointers may be used to set the value of the option. The
|
;; customer pointers may be used to set the value of the option. The
|
||||||
;; option always returns a single customer pointer.
|
;; 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
|
(define (gnc:make-owner-option
|
||||||
section
|
section
|
||||||
name
|
name
|
||||||
@ -504,9 +313,6 @@
|
|||||||
option))
|
option))
|
||||||
|
|
||||||
(export gnc:make-invoice-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-owner-option)
|
||||||
(export gnc:make-taxtable-option)
|
(export gnc:make-taxtable-option)
|
||||||
(export gnc:make-counter-option)
|
(export gnc:make-counter-option)
|
||||||
|
|||||||
@ -206,17 +206,6 @@
|
|||||||
(define (decdate adate delta) (moddate - adate delta ))
|
(define (decdate adate delta) (moddate - adate delta ))
|
||||||
(define (incdate 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.
|
;; returns #t if adding 1 to mday causes a month change.
|
||||||
(define (end-month? date)
|
(define (end-month? date)
|
||||||
(let ((nextdate (gnc-localtime date)))
|
(let ((nextdate (gnc-localtime date)))
|
||||||
@ -425,21 +414,8 @@
|
|||||||
(define (gnc:reldate-get-desc x) (vector-ref x 2))
|
(define (gnc:reldate-get-desc x) (vector-ref x 2))
|
||||||
(define (gnc:reldate-get-fn x) (vector-ref x 3))
|
(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
|
;; the globally available hash of reldates (hash-key = reldate
|
||||||
;; symbols, hash-value = a vector, reldate data). aim to deprecate it
|
;; symbols, hash-value = a vector, reldate data).
|
||||||
;; being exported.
|
|
||||||
(define gnc:relative-date-hash (make-hash-table))
|
(define gnc:relative-date-hash (make-hash-table))
|
||||||
|
|
||||||
(define (gnc:get-absolute-from-relative-date date-symbol)
|
(define (gnc:get-absolute-from-relative-date date-symbol)
|
||||||
@ -455,13 +431,6 @@ Defaulting to today."))
|
|||||||
(gnc:gui-warn conmsg uimsg)
|
(gnc:gui-warn conmsg uimsg)
|
||||||
(current-time)))))
|
(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)
|
(define (gnc:get-relative-date-string date-symbol)
|
||||||
;; used in options.scm
|
;; used in options.scm
|
||||||
(let ((rel-date-info (hash-ref gnc:relative-date-hash date-symbol)))
|
(let ((rel-date-info (hash-ref gnc:relative-date-hash date-symbol)))
|
||||||
|
|||||||
@ -94,12 +94,6 @@
|
|||||||
(gnc:owner-get-owner-id (gncJobGetOwner (gncOwnerGetJob owner))))
|
(gnc:owner-get-owner-id (gncJobGetOwner (gncOwnerGetJob owner))))
|
||||||
(else ""))))
|
(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
|
;; this function aims to find a split's owner. various splits are
|
||||||
;; supported: (1) any splits in the invoice posted transaction, in
|
;; supported: (1) any splits in the invoice posted transaction, in
|
||||||
;; APAR or income/expense accounts (2) any splits from invoice's
|
;; 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-address-dep)
|
||||||
(export gnc:owner-get-name-and-address-dep)
|
(export gnc:owner-get-name-and-address-dep)
|
||||||
(export gnc:owner-get-owner-id)
|
(export gnc:owner-get-owner-id)
|
||||||
(export gnc:entry-type-percent-p)
|
|
||||||
(export gnc:owner-from-split)
|
(export gnc:owner-from-split)
|
||||||
|
|||||||
@ -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-parse.scm
|
||||||
gnucash/import-export/qif-imp/qif-to-gnc.scm
|
gnucash/import-export/qif-imp/qif-to-gnc.scm
|
||||||
gnucash/import-export/qif-imp/qif-utils.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/import-export/qif-imp/string.scm
|
||||||
gnucash/python/gncmod-python.c
|
gnucash/python/gncmod-python.c
|
||||||
gnucash/register/ledger-core/gncEntryLedger.c
|
gnucash/register/ledger-core/gncEntryLedger.c
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user