Bill Gribble's qif patch.

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2459 57a11ea4-9604-0410-9ed3-97b8803252fd

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.

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))))

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)))

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)))))))
+          split (qif-split:category other-split))))))))
-  ;; merge split fields 
-  (write xtn) (newline)
-  )
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;