mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
83d14e1c1c
It is split into - /libgnucash (for the non-gui bits) - /gnucash (for the gui) - /common (misc source files used by both) - /bindings (currently only holds python bindings) This is the first step in restructuring the code. It will need much more fine tuning later on.
288 lines
11 KiB
Scheme
288 lines
11 KiB
Scheme
;; engine-interface.scm -- support for working with the GnuCash
|
|
;; engine data structures
|
|
;; Copyright (C) 2000 Dave Peticolas <dave@krondo.com>
|
|
;;
|
|
;; This program is free software; you can redistribute it and/or
|
|
;; modify it under the terms of the GNU General Public License as
|
|
;; published by the Free Software Foundation; either version 2 of
|
|
;; the License, or (at your option) any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; if not, contact:
|
|
;;
|
|
;; Free Software Foundation Voice: +1-617-542-5942
|
|
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
|
|
;; Boston, MA 02110-1301, USA gnu@gnu.org
|
|
|
|
;; This defines a scheme representation of splits.
|
|
(define gnc:split-structure
|
|
(make-record-type
|
|
"gnc:split-structure"
|
|
'(split-guid account-guid transaction-guid memo action
|
|
reconcile-state reconciled-date amount value)))
|
|
|
|
;; constructor
|
|
(define gnc:make-split-scm
|
|
(record-constructor gnc:split-structure))
|
|
|
|
;; type predicate
|
|
(define gnc:split-scm?
|
|
(record-predicate gnc:split-structure))
|
|
|
|
;; accessors
|
|
(define gnc:split-scm-get-split-guid
|
|
(record-accessor gnc:split-structure 'split-guid))
|
|
|
|
(define gnc:split-scm-get-account-guid
|
|
(record-accessor gnc:split-structure 'account-guid))
|
|
|
|
(define gnc:split-scm-get-transaction-guid
|
|
(record-accessor gnc:split-structure 'transaction-guid))
|
|
|
|
(define gnc:split-scm-get-memo
|
|
(record-accessor gnc:split-structure 'memo))
|
|
|
|
(define gnc:split-scm-get-action
|
|
(record-accessor gnc:split-structure 'action))
|
|
|
|
(define gnc:split-scm-get-reconcile-state
|
|
(record-accessor gnc:split-structure 'reconcile-state))
|
|
|
|
(define gnc:split-scm-get-reconciled-date
|
|
(record-accessor gnc:split-structure 'reconciled-date))
|
|
|
|
(define gnc:split-scm-get-amount
|
|
(record-accessor gnc:split-structure 'amount))
|
|
|
|
(define gnc:split-scm-get-value
|
|
(record-accessor gnc:split-structure 'value))
|
|
|
|
;; modifiers
|
|
(define gnc:split-scm-set-split-guid
|
|
(record-modifier gnc:split-structure 'split-guid))
|
|
|
|
(define gnc:split-scm-set-account-guid
|
|
(record-modifier gnc:split-structure 'account-guid))
|
|
|
|
(define gnc:split-scm-set-transaction-guid
|
|
(record-modifier gnc:split-structure 'transaction-guid))
|
|
|
|
(define gnc:split-scm-set-memo
|
|
(record-modifier gnc:split-structure 'memo))
|
|
|
|
(define gnc:split-scm-set-action
|
|
(record-modifier gnc:split-structure 'action))
|
|
|
|
(define gnc:split-scm-set-reconcile-state
|
|
(record-modifier gnc:split-structure 'reconcile-state))
|
|
|
|
(define gnc:split-scm-set-reconciled-date
|
|
(record-modifier gnc:split-structure 'reconciled-date))
|
|
|
|
(define gnc:split-scm-set-amount
|
|
(record-modifier gnc:split-structure 'amount))
|
|
|
|
(define gnc:split-scm-set-value
|
|
(record-modifier gnc:split-structure 'value))
|
|
|
|
;; This function take a C split and returns a representation
|
|
;; of it as a split-structure. Assumes the transaction is open
|
|
;; for editing.
|
|
(define (gnc:split->split-scm split use-cut-semantics?)
|
|
(gnc:make-split-scm
|
|
(gncSplitGetGUID split)
|
|
(gncAccountGetGUID (xaccSplitGetAccount split))
|
|
(gncTransGetGUID (xaccSplitGetParent split))
|
|
(xaccSplitGetMemo split)
|
|
(xaccSplitGetAction split)
|
|
(xaccSplitGetReconcile split)
|
|
(gnc-split-get-date-reconciled split)
|
|
(xaccSplitGetAmount split)
|
|
(xaccSplitGetValue split)))
|
|
|
|
;; Copy a scheme representation of a split onto a C split.
|
|
;; If possible, insert the C split into the account of the
|
|
;; scheme split. Not all values are copied. The reconcile
|
|
;; status and date are not copied. The C split's guid is,
|
|
;; of course, unchanged.
|
|
(define (gnc:split-scm-onto-split split-scm split book)
|
|
(if (null? split)
|
|
#f
|
|
(begin
|
|
(let ((memo (gnc:split-scm-get-memo split-scm))
|
|
(action (gnc:split-scm-get-action split-scm))
|
|
(amount (gnc:split-scm-get-amount split-scm))
|
|
(value (gnc:split-scm-get-value split-scm)))
|
|
(if memo (xaccSplitSetMemo split memo))
|
|
(if action (xaccSplitSetAction split action))
|
|
(if amount (xaccSplitSetAmount split amount))
|
|
(if value (xaccSplitSetValue split value)))
|
|
(let ((account (xaccAccountLookup
|
|
(gnc:split-scm-get-account-guid split-scm)
|
|
book)))
|
|
(if (not (null? account))
|
|
(begin
|
|
(xaccAccountBeginEdit account)
|
|
(xaccSplitSetAccount split account)
|
|
(xaccAccountCommitEdit account)))))))
|
|
|
|
;; Defines a scheme representation of a transaction.
|
|
(define gnc:transaction-structure
|
|
(make-record-type
|
|
"gnc:transaction-structure"
|
|
'(transaction-guid currency date-entered date-posted
|
|
num description notes split-scms)))
|
|
|
|
;; constructor
|
|
(define gnc:make-transaction-scm
|
|
(record-constructor gnc:transaction-structure))
|
|
|
|
;; type predicate
|
|
(define gnc:transaction-scm?
|
|
(record-predicate gnc:transaction-structure))
|
|
|
|
;; accessors
|
|
(define gnc:transaction-scm-get-transaction-guid
|
|
(record-accessor gnc:transaction-structure 'transaction-guid))
|
|
|
|
(define gnc:transaction-scm-get-currency
|
|
(record-accessor gnc:transaction-structure 'currency))
|
|
|
|
(define gnc:transaction-scm-get-date-entered
|
|
(record-accessor gnc:transaction-structure 'date-entered))
|
|
|
|
(define gnc:transaction-scm-get-date-posted
|
|
(record-accessor gnc:transaction-structure 'date-posted))
|
|
|
|
(define gnc:transaction-scm-get-num
|
|
(record-accessor gnc:transaction-structure 'num))
|
|
|
|
(define gnc:transaction-scm-get-description
|
|
(record-accessor gnc:transaction-structure 'description))
|
|
|
|
(define gnc:transaction-scm-get-notes
|
|
(record-accessor gnc:transaction-structure 'notes))
|
|
|
|
(define gnc:transaction-scm-get-split-scms
|
|
(record-accessor gnc:transaction-structure 'split-scms))
|
|
|
|
(define (gnc:transaction-scm-get-split-scm trans-scm index)
|
|
(let ((split-scms (gnc:transaction-scm-get-split-scms trans-scm)))
|
|
(cond ((< index 0) #f)
|
|
((not (pair? split-scms)) #f)
|
|
((>= index (length split-scms)) #f)
|
|
(else (list-ref split-scms index)))))
|
|
|
|
(define (gnc:transaction-scm-get-other-split-scm trans-scm split-scm)
|
|
(let ((split-scms (gnc:transaction-scm-get-split-scms trans-scm)))
|
|
(cond ((not (= (length split-scms) 2)) #f)
|
|
((eq? split-scm (car split-scms)) (cadr split-scms))
|
|
(else (car split-scms)))))
|
|
|
|
;; modifiers
|
|
(define gnc:transaction-scm-set-transaction-guid
|
|
(record-modifier gnc:transaction-structure 'transaction-guid))
|
|
|
|
(define gnc:transaction-scm-set-currency
|
|
(record-modifier gnc:transaction-structure 'currency))
|
|
|
|
(define gnc:transaction-scm-set-date-entered
|
|
(record-modifier gnc:transaction-structure 'date-entered))
|
|
|
|
(define gnc:transaction-scm-set-date-posted
|
|
(record-modifier gnc:transaction-structure 'date-posted))
|
|
|
|
(define gnc:transaction-scm-set-num
|
|
(record-modifier gnc:transaction-structure 'num))
|
|
|
|
(define gnc:transaction-scm-set-description
|
|
(record-modifier gnc:transaction-structure 'description))
|
|
|
|
(define gnc:transaction-scm-set-notes
|
|
(record-modifier gnc:transaction-structure 'notes))
|
|
|
|
(define gnc:transaction-scm-set-split-scms
|
|
(record-modifier gnc:transaction-structure 'split-scms))
|
|
|
|
(define (gnc:transaction-scm-append-split-scm trans-scm split-scm)
|
|
(let ((split-scms (gnc:transaction-scm-get-split-scms trans-scm)))
|
|
(gnc:transaction-scm-set-split-scms
|
|
trans-scm (append split-scms (list split-scm)))))
|
|
|
|
;; This function takes a C transaction and returns
|
|
;; a representation of it as a transaction-structure.
|
|
(define (gnc:transaction->transaction-scm trans use-cut-semantics?)
|
|
(define (trans-splits i)
|
|
(let ((split (xaccTransGetSplit trans i)))
|
|
(if (null? split)
|
|
'()
|
|
(cons (gnc:split->split-scm split use-cut-semantics?)
|
|
(trans-splits (+ i 1))))))
|
|
(gnc:make-transaction-scm
|
|
(gncTransGetGUID trans)
|
|
(xaccTransGetCurrency trans)
|
|
(gnc-transaction-get-date-entered trans)
|
|
(if use-cut-semantics?
|
|
(gnc-transaction-get-date-posted trans)
|
|
#f)
|
|
(if use-cut-semantics?
|
|
(xaccTransGetNum trans)
|
|
#f)
|
|
(xaccTransGetDescription trans)
|
|
(xaccTransGetNotes trans)
|
|
(trans-splits 0)))
|
|
|
|
;; Copy a scheme representation of a transaction onto a C transaction.
|
|
;; guid-mapping must be an alist, mapping guids to guids. This list is
|
|
;; used to use alternate account guids when creating splits.
|
|
(define (gnc:transaction-scm-onto-transaction trans-scm trans guid-mapping
|
|
commit? book)
|
|
(if (null? trans)
|
|
#f
|
|
(begin
|
|
;; open the transaction for editing
|
|
(if (not (xaccTransIsOpen trans))
|
|
(xaccTransBeginEdit trans))
|
|
|
|
;; copy in the transaction values
|
|
(let ((currency (gnc:transaction-scm-get-currency trans-scm))
|
|
(description (gnc:transaction-scm-get-description trans-scm))
|
|
(num (gnc:transaction-scm-get-num trans-scm))
|
|
(notes (gnc:transaction-scm-get-notes trans-scm))
|
|
(date-posted (gnc:transaction-scm-get-date-posted trans-scm)))
|
|
(if currency (xaccTransSetCurrency trans currency))
|
|
(if description (xaccTransSetDescription trans description))
|
|
(if num (xaccTransSetNum trans num))
|
|
(if notes (xaccTransSetNotes trans notes))
|
|
(if date-posted (gnc-transaction-set-date
|
|
trans date-posted)))
|
|
|
|
;; strip off the old splits
|
|
(for-each (lambda (split)
|
|
(xaccSplitDestroy split))
|
|
(xaccTransGetSplitList trans))
|
|
|
|
;; and put on the new ones! Please note they go in the *same*
|
|
;; order as in the original transaction. This is important.
|
|
(for-each
|
|
(lambda (split-scm)
|
|
(let* ((new-split (xaccMallocSplit book))
|
|
(old-guid (gnc:split-scm-get-account-guid split-scm))
|
|
(new-guid (assoc-ref guid-mapping old-guid)))
|
|
(if (not new-guid)
|
|
(set! new-guid old-guid))
|
|
(gnc:split-scm-set-account-guid split-scm new-guid)
|
|
(gnc:split-scm-onto-split split-scm new-split book)
|
|
(gnc:split-scm-set-account-guid split-scm old-guid)
|
|
(xaccSplitSetParent new-split trans)))
|
|
(gnc:transaction-scm-get-split-scms trans-scm))
|
|
|
|
;; close the transaction
|
|
(if commit?
|
|
(xaccTransCommitEdit trans)))))
|