Dramatic improvements to account completion speeds.

1 files changed, 51 insertions, 49 deletions

diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el
index 4b8b3beb..1bc7588c 100644
--- a/lisp/ldg-complete.el
+++ b/lisp/ldg-complete.el
@@ -34,8 +34,8 @@
   ;; with pcomplete.  See pcomplete-parse-arguments-function for
   ;; details
   (let* ((begin (save-excursion
-		 (ledger-thing-at-point) ;; leave point at beginning of thing under point
-                 (point)))
+									(ledger-thing-at-point) ;; leave point at beginning of thing under point
+									(point)))
          (end (point))
          begins args)
     ;; to support end of line metadata
@@ -65,8 +65,8 @@
         (unless (and (>= origin (match-beginning 0))
                      (< origin (match-end 0)))
           (setq payees-list (cons (match-string-no-properties 3)
-                                   payees-list)))))  ;; add the payee
-						     ;; to the list
+																	payees-list)))))  ;; add the payee
+		;; to the list
     (pcomplete-uniqify-list (nreverse payees-list))))
 
 
@@ -75,14 +75,16 @@
 	(let ((origin (point))
 				accounts
 				(account-tree (list t))
-				(account-elements nil))
+				(account-elements nil)
+				(seed-regex (ledger-account-any-status-with-seed-regex
+														(regexp-quote (car pcomplete-args)))))
 		(save-excursion
 			(goto-char (point-min))
 
 			(dolist (account
 								(delete-dups
 								 (progn
-									 (while (re-search-forward ledger-account-any-status-regex nil t)
+									 (while (re-search-forward seed-regex nil t)
 										 (unless (between origin (match-beginning 0) (match-end 0))
 											 (setq accounts (cons (match-string-no-properties 2) accounts))))
 									 accounts)))
@@ -127,19 +129,19 @@ Return list."
             (setq prefix (concat prefix (and prefix ":")
                                  (car elements))
                   root (cdr xact))
-          (setq root nil elements nil)))
+						(setq root nil elements nil)))
       (setq elements (cdr elements)))
     (setq root (delete (list (car elements) t) root))
     (and root
          (sort
           (mapcar (function
                    (lambda (x)
-                     (let ((term (if prefix
-                                     (concat prefix ":" (car x))
-                                   (car x))))
-                       (if (> (length (cdr x)) 1)
-                           (concat term ":")
-                         term))))
+										(let ((term (if prefix
+																		(concat prefix ":" (car x))
+																		(car x))))
+											(if (> (length (cdr x)) 1)
+													(concat term ":")
+													term))))
                   (cdr root))
           'string-lessp))))
 
@@ -153,21 +155,21 @@ Return list."
                   (delete
                    (caar (ledger-parse-arguments))
                    (ledger-payees-in-buffer)) ;; this completes against payee names
-                (progn
-                  (let ((text (buffer-substring-no-properties
-                               (line-beginning-position)
-                               (line-end-position))))
-                    (delete-region (line-beginning-position)
-                                   (line-end-position))
-                    (condition-case nil
-                        (ledger-add-transaction text t)
-                      (error nil)))
-                  (forward-line)
-                  (goto-char (line-end-position))
-                  (search-backward ";" (line-beginning-position) t)
-                  (skip-chars-backward " \t0123456789.,")
-                  (throw 'pcompleted t)))
-            (ledger-accounts)))))
+									(progn
+										(let ((text (buffer-substring-no-properties
+																 (line-beginning-position)
+																 (line-end-position))))
+											(delete-region (line-beginning-position)
+																		 (line-end-position))
+											(condition-case nil
+													(ledger-add-transaction text t)
+												(error nil)))
+										(forward-line)
+										(goto-char (line-end-position))
+										(search-backward ";" (line-beginning-position) t)
+										(skip-chars-backward " \t0123456789.,")
+										(throw 'pcompleted t)))
+							(ledger-accounts)))))
 
 (defun ledger-fully-complete-xact ()
   "Completes a transaction if there is another matching payee in the buffer.
@@ -225,30 +227,30 @@ ledger-magic-tab would cycle properly"
               (push (car (last pcomplete-current-completions))
                     pcomplete-current-completions)
               (setcdr (last pcomplete-current-completions 2) nil))
-          (nconc pcomplete-current-completions
-                 (list (car pcomplete-current-completions)))
-          (setq pcomplete-current-completions
-                (cdr pcomplete-current-completions)))
+						(nconc pcomplete-current-completions
+									 (list (car pcomplete-current-completions)))
+						(setq pcomplete-current-completions
+									(cdr pcomplete-current-completions)))
         (pcomplete-insert-entry pcomplete-last-completion-stub
                                 (car pcomplete-current-completions)
                                 nil pcomplete-last-completion-raw))
-    (setq pcomplete-current-completions nil
-          pcomplete-last-completion-raw nil)
-    (catch 'pcompleted
-      (let* ((pcomplete-stub)
-             pcomplete-seen pcomplete-norm-func
-             pcomplete-args pcomplete-last pcomplete-index
-             (pcomplete-autolist pcomplete-autolist)
-             (pcomplete-suffix-list pcomplete-suffix-list)
-             (completions (pcomplete-completions))
-             (result (pcomplete-do-complete pcomplete-stub completions)))
-        (and result
-             (not (eq (car result) 'listed))
-             (cdr result)
-             (pcomplete-insert-entry pcomplete-stub (cdr result)
-                                     (memq (car result)
-                                           '(sole shortest))
-                                     pcomplete-last-completion-raw))))))
+			(setq pcomplete-current-completions nil
+						pcomplete-last-completion-raw nil)
+			(catch 'pcompleted
+				(let* ((pcomplete-stub)
+							 pcomplete-seen pcomplete-norm-func
+							 pcomplete-args pcomplete-last pcomplete-index
+							 (pcomplete-autolist pcomplete-autolist)
+							 (pcomplete-suffix-list pcomplete-suffix-list)
+							 (completions (pcomplete-completions))
+							 (result (pcomplete-do-complete pcomplete-stub completions)))
+					(and result
+							 (not (eq (car result) 'listed))
+							 (cdr result)
+							 (pcomplete-insert-entry pcomplete-stub (cdr result)
+																			 (memq (car result)
+																						 '(sole shortest))
+																			 pcomplete-last-completion-raw))))))
 
 (provide 'ldg-complete)