|
|
|
|
@ -26,8 +26,15 @@
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(use-modules (srfi srfi-13))
|
|
|
|
|
(use-modules (ice-9 match))
|
|
|
|
|
(use-modules (gnucash string))
|
|
|
|
|
|
|
|
|
|
(define (n- n) (gnc-numeric-neg n))
|
|
|
|
|
(define (nsub a b) (gnc-numeric-sub a b 0 GNC-DENOM-LCD))
|
|
|
|
|
(define (n+ a b) (gnc-numeric-add a b 0 GNC-DENOM-LCD))
|
|
|
|
|
(define (n* a b) (gnc-numeric-mul a b 0 GNC-DENOM-REDUCE))
|
|
|
|
|
(define (n/ a b) (gnc-numeric-div a b 0 GNC-DENOM-REDUCE))
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
;; qif-import:find-or-make-acct
|
|
|
|
|
;;
|
|
|
|
|
@ -464,12 +471,7 @@
|
|
|
|
|
(qif-memo #f)
|
|
|
|
|
(qif-date (qif-xtn:date qif-xtn))
|
|
|
|
|
(qif-from-acct (qif-xtn:from-acct qif-xtn))
|
|
|
|
|
(qif-cleared (qif-xtn:cleared qif-xtn))
|
|
|
|
|
(n- (lambda (n) (gnc-numeric-neg n)))
|
|
|
|
|
(nsub (lambda (a b) (gnc-numeric-sub a b 0 GNC-DENOM-LCD)))
|
|
|
|
|
(n+ (lambda (a b) (gnc-numeric-add a b 0 GNC-DENOM-LCD)))
|
|
|
|
|
(n* (lambda (a b) (gnc-numeric-mul a b 0 GNC-DENOM-REDUCE)))
|
|
|
|
|
(n/ (lambda (a b) (gnc-numeric-div a b 0 GNC-DENOM-REDUCE))))
|
|
|
|
|
(qif-cleared (qif-xtn:cleared qif-xtn)))
|
|
|
|
|
|
|
|
|
|
;; Set properties of the whole transaction.
|
|
|
|
|
|
|
|
|
|
@ -513,12 +515,10 @@
|
|
|
|
|
;; Look for the transaction status (QIF "C" line). When it exists, apply
|
|
|
|
|
;; the cleared (c) or reconciled (y) status to the split. Otherwise, apply
|
|
|
|
|
;; user preference.
|
|
|
|
|
(if (eq? qif-cleared 'cleared)
|
|
|
|
|
(xaccSplitSetReconcile gnc-near-split #\c)
|
|
|
|
|
(if (eq? qif-cleared 'reconciled)
|
|
|
|
|
(xaccSplitSetReconcile gnc-near-split #\y)
|
|
|
|
|
;; Apply user preference by default.
|
|
|
|
|
(xaccSplitSetReconcile gnc-near-split transaction-status-pref)))
|
|
|
|
|
(case qif-cleared
|
|
|
|
|
((cleared) (xaccSplitSetReconcile gnc-near-split #\c))
|
|
|
|
|
((reconciled) (xaccSplitSetReconcile gnc-near-split #\y))
|
|
|
|
|
(else (xaccSplitSetReconcile gnc-near-split transaction-status-pref)))
|
|
|
|
|
|
|
|
|
|
(if (not qif-security)
|
|
|
|
|
(begin
|
|
|
|
|
@ -585,21 +585,17 @@
|
|
|
|
|
(hash-ref qif-memo-map qif-memo)))
|
|
|
|
|
(and (string? memo)
|
|
|
|
|
(not (string=? memo ""))
|
|
|
|
|
(hash-ref qif-memo-map memo))))
|
|
|
|
|
(if (not far-acct-info)
|
|
|
|
|
(set! far-acct-info
|
|
|
|
|
(hash-ref qif-memo-map
|
|
|
|
|
(default-unspec-acct))))))
|
|
|
|
|
(hash-ref qif-memo-map memo))))))
|
|
|
|
|
|
|
|
|
|
(set! far-acct-name (qif-map-entry:gnc-name far-acct-info))
|
|
|
|
|
(set! far-acct-name (if far-acct-info
|
|
|
|
|
(qif-map-entry:gnc-name far-acct-info)
|
|
|
|
|
(default-unspec-acct)))
|
|
|
|
|
(set! far-acct (hash-ref gnc-acct-hash far-acct-name))
|
|
|
|
|
|
|
|
|
|
;; set the reconcile status.
|
|
|
|
|
(let ((cleared (qif-split:matching-cleared qif-split)))
|
|
|
|
|
(if (eq? 'cleared cleared)
|
|
|
|
|
(xaccSplitSetReconcile gnc-far-split #\c))
|
|
|
|
|
(if (eq? 'reconciled cleared)
|
|
|
|
|
(xaccSplitSetReconcile gnc-far-split #\y)))
|
|
|
|
|
(case (qif-split:matching-cleared qif-split)
|
|
|
|
|
((cleared) (xaccSplitSetReconcile gnc-far-split #\c))
|
|
|
|
|
((reconciled) (xaccSplitSetReconcile gnc-far-split #\y)))
|
|
|
|
|
|
|
|
|
|
;; finally, plug the split into the account
|
|
|
|
|
(xaccSplitSetAccount gnc-far-split far-acct)
|
|
|
|
|
@ -762,12 +758,9 @@
|
|
|
|
|
(xaccSplitSetValue gnc-near-split (n- split-amt))
|
|
|
|
|
(xaccSplitSetValue gnc-far-split split-amt))))
|
|
|
|
|
|
|
|
|
|
(let ((cleared (qif-split:matching-cleared
|
|
|
|
|
(car (qif-xtn:splits qif-xtn)))))
|
|
|
|
|
(if (eq? 'cleared cleared)
|
|
|
|
|
(xaccSplitSetReconcile gnc-far-split #\c))
|
|
|
|
|
(if (eq? 'reconciled cleared)
|
|
|
|
|
(xaccSplitSetReconcile gnc-far-split #\y)))
|
|
|
|
|
(case (qif-split:matching-cleared (car (qif-xtn:splits qif-xtn)))
|
|
|
|
|
((cleared) (xaccSplitSetReconcile gnc-far-split #\c))
|
|
|
|
|
((reconciled) (xaccSplitSetReconcile gnc-far-split #\y)))
|
|
|
|
|
|
|
|
|
|
(if qif-commission-acct
|
|
|
|
|
(let* ((commission-acct-info
|
|
|
|
|
@ -842,12 +835,7 @@
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
|
|
(define (qif-import:mark-some-splits splits xtn candidate-xtns errorproc)
|
|
|
|
|
(let* ((n- (lambda (n) (gnc-numeric-neg n)))
|
|
|
|
|
(nsub (lambda (a b) (gnc-numeric-sub a b 0 GNC-DENOM-LCD)))
|
|
|
|
|
(n+ (lambda (a b) (gnc-numeric-add a b 0 GNC-DENOM-LCD)))
|
|
|
|
|
(n* (lambda (a b) (gnc-numeric-mul a b 0 GNC-DENOM-REDUCE)))
|
|
|
|
|
(n/ (lambda (a b) (gnc-numeric-div a b 0 GNC-DENOM-REDUCE)))
|
|
|
|
|
(split (car splits))
|
|
|
|
|
(let* ((split (car splits))
|
|
|
|
|
(near-acct-name #f)
|
|
|
|
|
(far-acct-name #f)
|
|
|
|
|
(date (qif-xtn:date xtn))
|
|
|
|
|
@ -957,19 +945,9 @@
|
|
|
|
|
(this-group-amt (gnc-numeric-zero))
|
|
|
|
|
(how #f)
|
|
|
|
|
(date-matches
|
|
|
|
|
(let ((self-date (qif-xtn:date xtn)))
|
|
|
|
|
(and (pair? self-date)
|
|
|
|
|
(pair? date)
|
|
|
|
|
(eq? (length self-date) 3)
|
|
|
|
|
(eq? (length date) 3)
|
|
|
|
|
(= (car self-date) (car date))
|
|
|
|
|
(= (cadr self-date) (cadr date))
|
|
|
|
|
(= (caddr self-date) (caddr date)))))
|
|
|
|
|
(n- (lambda (n) (gnc-numeric-neg n)))
|
|
|
|
|
(nsub (lambda (a b) (gnc-numeric-sub a b 0 GNC-DENOM-LCD)))
|
|
|
|
|
(n+ (lambda (a b) (gnc-numeric-add a b 0 GNC-DENOM-LCD)))
|
|
|
|
|
(n* (lambda (a b) (gnc-numeric-mul a b 0 GNC-DENOM-REDUCE)))
|
|
|
|
|
(n/ (lambda (a b) (gnc-numeric-div a b 0 GNC-DENOM-REDUCE))))
|
|
|
|
|
(match (cons date (qif-xtn:date xtn))
|
|
|
|
|
(((a b c) . (a b c)) #t)
|
|
|
|
|
(_ #f))))
|
|
|
|
|
|
|
|
|
|
(if date-matches
|
|
|
|
|
(begin
|
|
|
|
|
@ -1230,6 +1208,20 @@
|
|
|
|
|
(if all-marked
|
|
|
|
|
(qif-xtn:set-mark! xtn #t))))
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
;; gnc:account-tree-get-transactions
|
|
|
|
|
;;
|
|
|
|
|
;; Given an account tree, this procedure returns a list of all
|
|
|
|
|
;; transactions whose splits only use accounts in the tree.
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
(define (gnc:account-tree-get-transactions root)
|
|
|
|
|
(let ((accounts (gnc-account-get-descendants-sorted root)))
|
|
|
|
|
(let ((q (qof-query-create-for-splits)))
|
|
|
|
|
(qof-query-set-book q (gnc-account-get-book root))
|
|
|
|
|
(xaccQueryAddAccountMatch q accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND)
|
|
|
|
|
(let ((xtns (xaccQueryGetTransactions q QUERY-TXN-MATCH-ALL)))
|
|
|
|
|
(qof-query-destroy q)
|
|
|
|
|
xtns))))
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
;; qif-import:qif-to-gnc-undo
|
|
|
|
|
|