diff --git a/src/scm/qif-import/qif-dialog-utils.scm b/src/scm/qif-import/qif-dialog-utils.scm index 8e4566ef1f..25e3c842c3 100644 --- a/src/scm/qif-import/qif-dialog-utils.scm +++ b/src/scm/qif-import/qif-dialog-utils.scm @@ -29,6 +29,10 @@ (define (default-equity-account) "Retained Earnings") +(define (default-commission-acct brokerage) + (string-append "Commissions:" brokerage)) + + ;; the account-display is a 3-columned list of accounts in the QIF ;; import dialog (the "Account" page of the notebook). Column 1 is ;; the account name in the QIF file, column 2 is the number of QIF @@ -203,6 +207,25 @@ (append (qif-import:guess-acct qif-account qif-account-types gnc-acct-info) + (list 1 xtn)))))) + + ;; if there's a commission, reference the + ;; commission account + (if (qif-xtn:commission xtn) + (begin + (set! qif-account + (default-commission-acct from-acct)) + (set! entry + (hash-ref acct-hash qif-account)) + (if entry + (list-set! entry 4 + (+ 1 (list-ref entry 4))) + (hash-set! acct-hash + qif-account + (append (qif-import:guess-acct + qif-account + (list GNC-EXPENSE-TYPE) + gnc-acct-info) (list 1 xtn))))))) ;; non-stock transactions. these are a bit easier. diff --git a/src/scm/qif-import/qif-file.scm b/src/scm/qif-import/qif-file.scm index 4b477c92a1..5da61062e6 100644 --- a/src/scm/qif-import/qif-file.scm +++ b/src/scm/qif-import/qif-file.scm @@ -401,12 +401,14 @@ qif-cat:tax-class qif-cat:set-tax-class! qif-parse:check-number-format '(decimal comma) qif-parse:parse-number/format (qif-file:cats self) + qif-parse:print-number set-error) (check-and-parse-field qif-cat:budget-amt qif-cat:set-budget-amt! qif-parse:check-number-format '(decimal comma) qif-parse:parse-number/format (qif-file:cats self) + qif-parse:print-number set-error) ;; fields of accounts @@ -414,12 +416,14 @@ qif-acct:limit qif-acct:set-limit! qif-parse:check-number-format '(decimal comma) qif-parse:parse-number/format (qif-file:accounts self) + qif-parse:print-number set-error) (check-and-parse-field qif-acct:budget qif-acct:set-budget! qif-parse:check-number-format '(decimal comma) qif-parse:parse-number/format (qif-file:accounts self) + qif-parse:print-number set-error) (parse-field @@ -433,6 +437,7 @@ qif-parse:check-date-format '(m-d-y d-m-y y-m-d y-d-m) qif-parse:parse-date/format (qif-file:xtns self) + qif-parse:print-date set-error) (parse-field @@ -447,18 +452,21 @@ qif-xtn:share-price qif-xtn:set-share-price! qif-parse:check-number-format '(decimal comma) qif-parse:parse-number/format (qif-file:xtns self) + qif-parse:print-number set-error) (check-and-parse-field qif-xtn:num-shares qif-xtn:set-num-shares! qif-parse:check-number-format '(decimal comma) qif-parse:parse-number/format (qif-file:xtns self) + qif-parse:print-number set-error) (check-and-parse-field qif-xtn:commission qif-xtn:set-commission! qif-parse:check-number-format '(decimal comma) qif-parse:parse-number/format (qif-file:xtns self) + qif-parse:print-number set-error) ;; this one's a little tricky... it checks and sets all the @@ -467,6 +475,7 @@ qif-xtn:split-amounts qif-xtn:set-split-amounts! qif-parse:check-number-formats '(decimal comma) qif-parse:parse-numbers/format (qif-file:xtns self) + qif-parse:print-numbers set-error) (begin @@ -508,7 +517,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (check-and-parse-field getter setter checker - formats parser objects errormsg) + formats parser objects printer errormsg) ;; first find the right format for the field (let ((do-parsing #f) (retval #t) @@ -544,7 +553,8 @@ ;; just ignore the format ambiguity. Otherwise, it's really an ;; error. ATM since there's no way to correct the error let's ;; just leave it be. - (all-formats-equivalent? getter parser formats objects errormsg) + (all-formats-equivalent? getter parser formats objects printer + errormsg) (set! format (car formats))) (#t (set! format (car formats)))) @@ -569,7 +579,8 @@ objects)) retval)) -(define (all-formats-equivalent? getter parser formats objects errormsg) +(define (all-formats-equivalent? getter parser formats objects + printer errormsg) (let ((all-ok #t)) (let obj-loop ((objlist objects)) (let* ((unparsed (getter (car objlist))) @@ -586,9 +597,10 @@ (errormsg (list "Parse ambiguity : between formats " formats "\nValue " unparsed " could be " - parsed " or " this-parsed + (printer parsed) " or " + (printer this-parsed) "\nand no evidence exists to distinguish." - "\nUsing " parsed ". " + "\nUsing " (printer parsed) ". " "\nSee help for more info.")))))) (cdr formats)))) (if (and all-ok (not (null? (cdr objlist)))) diff --git a/src/scm/qif-import/qif-parse.scm b/src/scm/qif-import/qif-parse.scm index 9df1b6eec2..81b7dc896f 100644 --- a/src/scm/qif-import/qif-parse.scm +++ b/src/scm/qif-import/qif-parse.scm @@ -504,3 +504,22 @@ amt-strings))) (if all-ok parsed #f))) +(define (qif-parse:print-date date-list) + (let ((tm (localtime (current-time)))) + (set-tm:mday tm (car date-list)) + (set-tm:mon tm (- (cadr date-list) 1)) + (set-tm:year tm (- (caddr date-list) 1900)) + (strftime "%a %B %d %Y" tm))) + +(define (qif-parse:print-number num) + (with-output-to-string + (lambda () + (write num)))) + +(define (qif-parse:print-numbers num) + (with-output-to-string + (lambda () + (write num)))) + +(define (qif-parse:print-acct-type t) + (symbol->string (gnc:account-type->symbol t))) \ No newline at end of file diff --git a/src/scm/qif-import/qif-to-gnc.scm b/src/scm/qif-import/qif-to-gnc.scm index fe157f3c84..66ad18098c 100644 --- a/src/scm/qif-import/qif-to-gnc.scm +++ b/src/scm/qif-import/qif-to-gnc.scm @@ -128,40 +128,6 @@ (gnc:insert-subaccount parent-acct new-acct) (gnc:group-insert-account acct-group new-acct)) - -; (begin -; (if make-new-acct -; (begin -; (gnc:account-set-name new-acct gnc-name) -; (if (and gnc-type -; (eq? GNC-EQUITY-TYPE gnc-type) -; (qif-xtn? qif-info) -; (qif-xtn:qif-security-name qif-info)) -; ;; this is the special case of the -; ;; "retained holdings" equity account -; (begin -; (gnc:account-set-currency -; new-acct (qif-xtn:security-name qif-info)) -; (set! set-security #f)) -; (begin -; (gnc:account-set-currency new-acct -; default-currency) -; (set! set-security #t))) - -; (cond ((and (qif-acct? qif-info) -; (qif-acct:description qif-info)) -; (gnc:account-set-description -; new-acct (qif-acct:description qif-info))) -; ((and (qif-cat? qif-info) -; (qif-cat:description qif-info)) -; (gnc:account-set-description -; new-acct (qif-cat:description qif-info))) -; ((string? qif-info) -; (gnc:account-set-description -; new-acct qif-info))) -; (if gnc-type (gnc:account-set-type new-acct gnc-type)))) - -; (gnc:account-commit-edit new-acct) (hash-set! gnc-acct-hash gnc-name new-acct) new-acct)))) @@ -418,9 +384,13 @@ (qif-accts #f) (qif-near-acct #f) (qif-far-acct #f) + (qif-commission-acct #f) (far-acct-info #f) (far-acct-name #f) (far-acct #f) + (commission-acct #f) + (commission-amt (qif-xtn:commission qif-xtn)) + (commission-split #f) (defer-share-price #f) (gnc-far-split (gnc:split-create))) @@ -435,12 +405,13 @@ (display "splits in stock transaction!") (newline))) (set! qif-accts - (qif-split:accounts-affected (qif-xtn:splits qif-xtn) + (qif-split:accounts-affected (car (qif-xtn:splits qif-xtn)) qif-xtn)) (set! qif-near-acct (car qif-accts)) (set! qif-far-acct (cadr qif-accts)) - + (set! qif-commission-acct (caddr qif-accts)) + ;; translate the QIF account names into Gnucash accounts (if (and qif-near-acct qif-far-acct) (begin @@ -526,6 +497,21 @@ (if (or (eq? 'cleared cleared) (eq? 'reconciled cleared)) (gnc:split-set-reconcile gnc-far-split #\c))) + + (if qif-commission-acct + (let* ((commission-acct-info + (or (hash-ref qif-acct-map qif-commission-acct) + (hash-ref qif-cat-map qif-commission-acct))) + (commission-acct-name + (list-ref commission-acct-info 1))) + (set! commission-acct + (hash-ref gnc-acct-hash commission-acct-name)))) + + (if (and commission-amt commission-acct) + (begin + (set! commission-split (gnc:split-create)) + (gnc:split-set-base-value commission-split commission-amt + currency))) (if (and qif-near-acct qif-far-acct) (begin @@ -535,6 +521,12 @@ (gnc:transaction-append-split gnc-xtn gnc-far-split) (gnc:account-insert-split far-acct gnc-far-split) + (if commission-split + (begin + (gnc:transaction-append-split gnc-xtn commission-split) + (gnc:account-insert-split commission-acct + commission-split))) + ;; now find the share price if we need to ;; (shrsin and shrsout xtns) (if defer-share-price @@ -542,6 +534,7 @@ ;; return the modified transaction (though it's ignored). gnc-xtn)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; qif-import:mark-matching-xtns ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -677,6 +670,7 @@ (define (qif-split:accounts-affected split xtn) (let ((near-acct-name #f) (far-acct-name #f) + (commission-acct-name #f) (security (qif-xtn:security-name xtn)) (action (qif-xtn:action xtn)) (from-acct (qif-xtn:from-acct xtn))) @@ -729,9 +723,14 @@ (default-dividend-acct from-acct security))) ((shrsin shrsout) (set! far-acct-name - (default-equity-holding security)))))) + (default-equity-holding security)))) + + ;; the commission account, if it exists + (if (qif-xtn:commission xtn) + (set! commission-acct-name + (default-commission-acct from-acct))))) - (list near-acct-name far-acct-name))) + (list near-acct-name far-acct-name commission-acct-name))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -782,10 +781,7 @@ (qif-split:set-category-is-account?! split (qif-split:category-is-account? other-split)) (qif-split:set-category-private! - split (qif-split:category other-split))))))) - ;; merge split fields - (write xtn) (newline) - ) + split (qif-split:category other-split)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;