Dramatic improvements to account completion speeds.

4 files changed, 236 insertions, 248 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)
 
diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el
index fdbd8966..086c4c32 100644
--- a/lisp/ldg-mode.el
+++ b/lisp/ldg-mode.el
@@ -41,31 +41,31 @@
 
 (defun ledger-read-account-with-prompt (prompt)
   (let* ((context (ledger-context-at-point))
-	 (default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
-			   (eq (ledger-context-current-field context) 'account))
-		      (regexp-quote (ledger-context-field-value context 'account))
-		      nil)))
+				 (default (if (and (eq (ledger-context-line-type context) 'acct-transaction)
+													 (eq (ledger-context-current-field context) 'account))
+											(regexp-quote (ledger-context-field-value context 'account))
+											nil)))
     (ledger-read-string-with-default prompt default)))
 
 (defun ledger-read-string-with-default (prompt default)
   "Return user supplied string after PROMPT, or DEFAULT."
   (read-string (concat prompt
-		       (if default
-			   (concat " (" default "): ")
-			   ": "))
-	       nil 'ledger-minibuffer-history default))
+											 (if default
+													 (concat " (" default "): ")
+													 ": "))
+							 nil 'ledger-minibuffer-history default))
 
 (defun ledger-display-balance-at-point ()
   "Display the cleared-or-pending balance.
 And calculate the target-delta of the account being reconciled."
   (interactive)
   (let* ((account (ledger-read-account-with-prompt "Account balance to show"))
-	 (buffer (current-buffer))
-	 (balance (with-temp-buffer
-		    (ledger-exec-ledger buffer (current-buffer) "cleared" account)
-				(if (> (buffer-size) 0)
-						(buffer-substring-no-properties (point-min) (1- (point-max)))
-						(concat account " is empty.")))))
+				 (buffer (current-buffer))
+				 (balance (with-temp-buffer
+										(ledger-exec-ledger buffer (current-buffer) "cleared" account)
+										(if (> (buffer-size) 0)
+												(buffer-substring-no-properties (point-min) (1- (point-max)))
+												(concat account " is empty.")))))
     (when balance
       (message balance))))
 
@@ -96,117 +96,117 @@ Can indent, complete or align depending on context."
 (defun ledger-insert-effective-date ()
   (interactive)
   (let ((context (car (ledger-context-at-point)))
-	(date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist)))))
-   (cond ((eq 'xact context)
-	  (beginning-of-line)
-	  (insert date-string "="))
-	 ((eq 'acct-transaction context)
-	  (end-of-line)
-	  (insert "  ; [=" date-string "]")))))
+				(date-string (format-time-string (cdr (assoc "date-format" ledger-environment-alist)))))
+		(cond ((eq 'xact context)
+					 (beginning-of-line)
+					 (insert date-string "="))
+					((eq 'acct-transaction context)
+					 (end-of-line)
+					 (insert "  ; [=" date-string "]")))))
 
 ;;;###autoload
 (define-derived-mode ledger-mode text-mode "Ledger"
-    "A mode for editing ledger data files."
-    (ledger-check-version)
-    (ledger-post-setup)
-
-    (set (make-local-variable 'comment-start) " ; ")
-    (set (make-local-variable 'comment-end) "")
-    (set (make-local-variable 'indent-tabs-mode) nil)
-
-    (if (boundp 'font-lock-defaults)
-	(set (make-local-variable 'font-lock-defaults)
-	     '(ledger-font-lock-keywords nil t)))
-    (setq font-lock-extend-region-functions
-          (list #'font-lock-extend-region-wholelines))
-    (setq font-lock-multiline nil)
-
-    (set (make-local-variable 'pcomplete-parse-arguments-function)
-	 'ledger-parse-arguments)
-    (set (make-local-variable 'pcomplete-command-completion-function)
-	 'ledger-complete-at-point)
-    (set (make-local-variable 'pcomplete-termination-string) "")
-
-    (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
-    (add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
-    (make-variable-buffer-local 'highlight-overlay)
-
-    (ledger-init-load-init-file)
-
-    (set (make-local-variable 'indent-region-function) 'ledger-post-align-postings)
-
-    (let ((map (current-local-map)))
-      (define-key map [(control ?c) (control ?a)] 'ledger-add-transaction)
-      (define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount)
-      (define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
-      (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction)
-      (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction)
-      (define-key map [(control ?c) (control ?f)] 'ledger-occur)
-      (define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point)
-      (define-key map [(control ?c) (control ?m)] 'ledger-set-month)
-      (define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
-      (define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
-      (define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date)
-      (define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming)
-      (define-key map [(control ?c) (control ?y)] 'ledger-set-year)
-      (define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point)
-      (define-key map [(control ?c) (control ?l)] 'ledger-display-ledger-stats)
-
-      (define-key map [tab] 'ledger-magic-tab)
-			(define-key map [(control tab)] 'ledger-post-align-xact)
-      (define-key map [(control ?i)] 'ledger-magic-tab)
-      (define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
-      (define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
-
-      (define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
-      (define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
-      (define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
-      (define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
-      (define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
-      (define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
-
-      (define-key map [(meta ?p)] 'ledger-post-prev-xact)
-      (define-key map [(meta ?n)] 'ledger-post-next-xact)
-
-      (define-key map [menu-bar] (make-sparse-keymap "ldg-menu"))
-      (define-key map [menu-bar ldg-menu] (cons "Ledger" map))
-
-      (define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works))
-      (define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works))
-      (define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works))
-      (define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works))
-      (define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works))
-      (define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works))
-      (define-key map [sep5] '(menu-item "--"))
-      (define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works))
-      (define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works))
-      (define-key map [cust] '(menu-item "Customize Ledger Mode"  (lambda ()
-								    (interactive)
-								    (customize-group 'ledger))))
-      (define-key map [sep1] '("--"))
-      (define-key map [effective-date] '(menu-item "Set effective date" ledger-insert-effective-date))
-      (define-key map [sort-end] '(menu-item "Mark Sort End" ledger-sort-insert-end-mark))
-      (define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark))
-      (define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer))
-      (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
-			(define-key map [align-xact] '(menu-item "Align Xact" ledger-post-align-xact))
-      (define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active))
-      (define-key map [sep2] '(menu-item "--"))
-      (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction-at-point))
-      (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current))
-      (define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction))
-      (define-key map [sep4] '(menu-item "--"))
-      (define-key map [recon-account] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
-      (define-key map [check-balance] '(menu-item "Check Balance" ledger-display-balance-at-point :enable ledger-works))
-      (define-key map [sep6] '(menu-item "--"))
-      (define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
-      (define-key map [sep] '(menu-item "--"))
-      (define-key map [delete-xact] '(menu-item "Delete Transaction" ledger-delete-current-transaction))
-      (define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-xact))
-      (define-key map [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works))
-      (define-key map [sep3] '(menu-item "--"))
-      (define-key map [stats] '(menu-item "Ledger Statistics" ledger-display-ledger-stats :enable ledger-works))
-      (define-key map [fold-buffer] '(menu-item "Narrow to REGEX" ledger-occur))))
+	"A mode for editing ledger data files."
+	(ledger-check-version)
+	(ledger-post-setup)
+
+	(set (make-local-variable 'comment-start) " ; ")
+	(set (make-local-variable 'comment-end) "")
+	(set (make-local-variable 'indent-tabs-mode) nil)
+
+	(if (boundp 'font-lock-defaults)
+			(set (make-local-variable 'font-lock-defaults)
+					 '(ledger-font-lock-keywords nil t)))
+	(setq font-lock-extend-region-functions
+				(list #'font-lock-extend-region-wholelines))
+	(setq font-lock-multiline nil)
+
+	(set (make-local-variable 'pcomplete-parse-arguments-function)
+			 'ledger-parse-arguments)
+	(set (make-local-variable 'pcomplete-command-completion-function)
+			 'ledger-complete-at-point)
+	(set (make-local-variable 'pcomplete-termination-string) "")
+
+	(add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
+	(add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
+	(make-variable-buffer-local 'highlight-overlay)
+
+	(ledger-init-load-init-file)
+
+	(set (make-local-variable 'indent-region-function) 'ledger-post-align-postings)
+
+	(let ((map (current-local-map)))
+		(define-key map [(control ?c) (control ?a)] 'ledger-add-transaction)
+		(define-key map [(control ?c) (control ?b)] 'ledger-post-edit-amount)
+		(define-key map [(control ?c) (control ?c)] 'ledger-toggle-current)
+		(define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction)
+		(define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction)
+		(define-key map [(control ?c) (control ?f)] 'ledger-occur)
+		(define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point)
+		(define-key map [(control ?c) (control ?m)] 'ledger-set-month)
+		(define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
+		(define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
+		(define-key map [(control ?c) (control ?t)] 'ledger-insert-effective-date)
+		(define-key map [(control ?c) (control ?u)] 'ledger-schedule-upcoming)
+		(define-key map [(control ?c) (control ?y)] 'ledger-set-year)
+		(define-key map [(control ?c) (control ?p)] 'ledger-display-balance-at-point)
+		(define-key map [(control ?c) (control ?l)] 'ledger-display-ledger-stats)
+
+		(define-key map [tab] 'ledger-magic-tab)
+		(define-key map [(control tab)] 'ledger-post-align-xact)
+		(define-key map [(control ?i)] 'ledger-magic-tab)
+		(define-key map [(control ?c) tab] 'ledger-fully-complete-xact)
+		(define-key map [(control ?c) (control ?i)] 'ledger-fully-complete-xact)
+
+		(define-key map [(control ?c) (control ?o) (control ?a)] 'ledger-report-redo)
+		(define-key map [(control ?c) (control ?o) (control ?e)] 'ledger-report-edit)
+		(define-key map [(control ?c) (control ?o) (control ?g)] 'ledger-report-goto)
+		(define-key map [(control ?c) (control ?o) (control ?k)] 'ledger-report-kill)
+		(define-key map [(control ?c) (control ?o) (control ?r)] 'ledger-report)
+		(define-key map [(control ?c) (control ?o) (control ?s)] 'ledger-report-save)
+
+		(define-key map [(meta ?p)] 'ledger-post-prev-xact)
+		(define-key map [(meta ?n)] 'ledger-post-next-xact)
+
+		(define-key map [menu-bar] (make-sparse-keymap "ldg-menu"))
+		(define-key map [menu-bar ldg-menu] (cons "Ledger" map))
+
+		(define-key map [report-kill] '(menu-item "Kill Report" ledger-report-kill :enable ledger-works))
+		(define-key map [report-edit] '(menu-item "Edit Report" ledger-report-edit :enable ledger-works))
+		(define-key map [report-save] '(menu-item "Save Report" ledger-report-save :enable ledger-works))
+		(define-key map [report-rrun] '(menu-item "Re-run Report" ledger-report-redo :enable ledger-works))
+		(define-key map [report-goto] '(menu-item "Goto Report" ledger-report-goto :enable ledger-works))
+		(define-key map [report-run] '(menu-item "Run Report" ledger-report :enable ledger-works))
+		(define-key map [sep5] '(menu-item "--"))
+		(define-key map [set-month] '(menu-item "Set Month" ledger-set-month :enable ledger-works))
+		(define-key map [set-year] '(menu-item "Set Year" ledger-set-year :enable ledger-works))
+		(define-key map [cust] '(menu-item "Customize Ledger Mode"  (lambda ()
+																																	(interactive)
+																																	(customize-group 'ledger))))
+		(define-key map [sep1] '("--"))
+		(define-key map [effective-date] '(menu-item "Set effective date" ledger-insert-effective-date))
+		(define-key map [sort-end] '(menu-item "Mark Sort End" ledger-sort-insert-end-mark))
+		(define-key map [sort-start] '(menu-item "Mark Sort Beginning" ledger-sort-insert-start-mark))
+		(define-key map [sort-buff] '(menu-item "Sort Buffer" ledger-sort-buffer))
+		(define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
+		(define-key map [align-xact] '(menu-item "Align Xact" ledger-post-align-xact))
+		(define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active))
+		(define-key map [sep2] '(menu-item "--"))
+		(define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction-at-point))
+		(define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current))
+		(define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction))
+		(define-key map [sep4] '(menu-item "--"))
+		(define-key map [recon-account] '(menu-item "Reconcile Account" ledger-reconcile :enable ledger-works))
+		(define-key map [check-balance] '(menu-item "Check Balance" ledger-display-balance-at-point :enable ledger-works))
+		(define-key map [sep6] '(menu-item "--"))
+		(define-key map [edit-amount] '(menu-item "Calc on Amount" ledger-post-edit-amount))
+		(define-key map [sep] '(menu-item "--"))
+		(define-key map [delete-xact] '(menu-item "Delete Transaction" ledger-delete-current-transaction))
+		(define-key map [cmp-xact] '(menu-item "Complete Transaction" ledger-fully-complete-xact))
+		(define-key map [add-xact] '(menu-item "Add Transaction (ledger xact)" ledger-add-transaction :enable ledger-works))
+		(define-key map [sep3] '(menu-item "--"))
+		(define-key map [stats] '(menu-item "Ledger Statistics" ledger-display-ledger-stats :enable ledger-works))
+		(define-key map [fold-buffer] '(menu-item "Narrow to REGEX" ledger-occur))))
 
 
 
diff --git a/lisp/ldg-occur.el b/lisp/ldg-occur.el
index 3ae1ea17..451ad1a7 100644
--- a/lisp/ldg-occur.el
+++ b/lisp/ldg-occur.el
@@ -38,8 +38,8 @@
 (make-variable-buffer-local 'ledger-occur-use-face-shown)
 
 
-(defvar ledger-occur-mode nil 
-"name of the minor mode, shown in the mode-line")
+(defvar ledger-occur-mode nil
+	"name of the minor mode, shown in the mode-line")
 
 (make-variable-buffer-local 'ledger-occur-mode)
 
@@ -49,16 +49,11 @@
 
 (defvar ledger-occur-history nil
   "History of previously searched expressions for the prompt.")
-;;(make-variable-buffer-local 'ledger-occur-history)
 
 (defvar ledger-occur-last-match nil
   "Last match found.")
 (make-variable-buffer-local 'ledger-occur-last-match)
 
-(defvar ledger-occur-overlay-list nil
-  "A list of currently active overlays to the ledger buffer.")
-(make-variable-buffer-local 'ledger-occur-overlay-list)
-
 (defun ledger-occur-remove-all-overlays ()
   "Remove all overlays from the ledger buffer."
   (interactive)
@@ -70,21 +65,19 @@
 When REGEX is nil, unhide everything, and remove higlight"
   (set-buffer buffer)
   (setq ledger-occur-mode
-	(if (or (null regex)
-		(zerop (length regex)))
-	    nil
-	    (concat " Ledger-Narrowed: " regex)))
+				(if (or (null regex)
+								(zerop (length regex)))
+						nil
+						(concat " Ledger-Narrowed: " regex)))
   (force-mode-line-update)
   (ledger-occur-remove-overlays)
-  (if ledger-occur-mode
-      (let* ((buffer-matches (ledger-occur-find-matches regex))
-	     (ovl-bounds (ledger-occur-create-xact-overlay-bounds buffer-matches)))
-	(setq ledger-occur-overlay-list
-	      (append (ledger-occur-create-xact-overlays ovl-bounds)
-		      (ledger-occur-create-narrowed-overlays buffer-matches)))
-	(setq ledger-occur-last-match regex)
-	(if (get-buffer-window buffer)
-	    (select-window (get-buffer-window buffer)))))
+  (when ledger-occur-mode
+		(ledger-occur-create-overlays
+		 (ledger-occur-compress-matches
+			(ledger-occur-find-matches regex)))
+		(setq ledger-occur-last-match regex)
+		(if (get-buffer-window buffer)
+				(select-window (get-buffer-window buffer))))
   (recenter))
 
 (defun ledger-occur (regex)
@@ -96,8 +89,8 @@ When REGEX is nil, unhide everything, and remove higlight"
   (interactive
    (if ledger-occur-mode
        (list nil)
-       (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ") 
-			  nil 'ledger-occur-history (ledger-occur-prompt)))))
+       (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
+													nil 'ledger-occur-history (ledger-occur-prompt)))))
   (ledger-occur-mode regex (current-buffer)))
 
 (defun ledger-occur-prompt ()
@@ -115,41 +108,32 @@ When REGEX is nil, unhide everything, and remove higlight"
                (if (= (line-number-at-pos pos1)
                       (line-number-at-pos pos2))
                    (buffer-substring-no-properties pos1 pos2)))
-	     (current-word))))
+						 (current-word))))
     prompt))
 
-(defun ledger-occur-create-narrowed-overlays(buffer-matches)
-  (if buffer-matches
-      (let ((overlays
-             (let ((prev-end (point-min)))
-               (mapcar (lambda (match)
-                         (prog1
-			     (make-overlay prev-end (car match)
-					   (current-buffer) t nil)
-                           (setq prev-end (1+ (cadr match)))))
-                       buffer-matches))))
-        (mapcar (lambda (ovl)
-                  (overlay-put ovl ledger-occur-overlay-property-name t)
-                  (overlay-put ovl 'invisible t))
-                (push  (make-overlay (cadr (car(last buffer-matches)))
-                                     (point-max)
-                                     (current-buffer) t nil) overlays)))))
-
-
-(defun ledger-occur-create-xact-overlays (ovl-bounds)
-  "Create the overlay for the visible transactions.
+
+(defun ledger-occur-make-visible-overlay (beg end)
+	(let ((ovl (make-overlay beg end (current-buffer))))
+				(overlay-put ovl ledger-occur-overlay-property-name t)
+				(overlay-put ovl 'face 'ledger-occur-xact-face)))
+
+(defun ledger-occur-make-invisible-overlay (beg end)
+	(let ((ovl (make-overlay beg end (current-buffer))))
+				(overlay-put ovl ledger-occur-overlay-property-name t)
+				(overlay-put ovl 'invisible t)))
+
+(defun ledger-occur-create-overlays (ovl-bounds)
+  "Create the overlays for the visible transactions.
 Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
-  (let ((overlays
-         (mapcar (lambda (bnd)
-                   (make-overlay (car bnd)
-				 (cadr bnd)
-				 (current-buffer) t nil))
-                 ovl-bounds)))
-    (mapcar (lambda (ovl)
-	      (overlay-put ovl ledger-occur-overlay-property-name t)
-	      (if ledger-occur-use-face-shown
-		  (overlay-put ovl 'face 'ledger-occur-xact-face )))
-            overlays)))
+	(let* ((beg (caar ovl-bounds))
+				 (end (cadar ovl-bounds)))
+		(ledger-occur-make-invisible-overlay (point-min) (1- beg))
+		(dolist (visible (cdr ovl-bounds))
+			(ledger-occur-make-visible-overlay beg end)
+			(ledger-occur-make-invisible-overlay (1+ end) (1- (car visible)))
+			(setq beg (car visible))
+			(setq end (cadr visible)))
+		(ledger-occur-make-invisible-overlay (1+ end) (point-max))))
 
 (defun ledger-occur-quit-buffer (buffer)
   "Quits hidings transaction in the given BUFFER.
@@ -164,45 +148,44 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
   "Remove the transaction hiding overlays."
   (interactive)
   (remove-overlays (point-min)
-		   (point-max) ledger-occur-overlay-property-name t)
+									 (point-max) ledger-occur-overlay-property-name t)
   (setq ledger-occur-overlay-list nil))
 
-
-(defun ledger-occur-create-xact-overlay-bounds (buffer-matches)
-  "Use BUFFER-MATCHES to produce the overlay for the visible transactions."
-  (let ((prev-end (point-min))
-        (overlays (list)))
-    (when buffer-matches
-      (mapc (lambda (line)
-	      (push (list (car line) (cadr line)) overlays)
-	      (setq prev-end (cadr line)))
-	    buffer-matches)
-      (setq overlays (nreverse overlays)))))
-
-
 (defun ledger-occur-find-matches (regex)
-  "Return a list of 2-number tuples describing the beginning and start of transactions meeting REGEX."
+  "Return a list of 2-number tuples describing the beginning and end of transactions meeting REGEX."
   (save-excursion
     (goto-char (point-min))
     ;; Set initial values for variables
-    (let (curpoint 
-	  endpoint
-	  (lines (list)))
+    (let (curpoint
+					endpoint
+					(lines (list)))
       ;; Search loop
       (while (not (eobp))
         (setq curpoint (point))
         ;; if something found
         (when (setq endpoint (re-search-forward regex nil 'end))
           (save-excursion
-	    (let ((bounds (ledger-find-xact-extents (match-beginning 0))))
-	      (push bounds lines)
-	      (setq curpoint (cadr bounds)))) ;; move to the end of
-	                                      ;; the xact, no need to
-	                                      ;; search inside it more
+						(let ((bounds (ledger-find-xact-extents (match-beginning 0))))
+							(push bounds lines)
+							(setq curpoint (cadr bounds)))) ;; move to the end of
+					;; the xact, no need to
+					;; search inside it more
           (goto-char curpoint))
         (forward-line 1))
       (setq lines (nreverse lines)))))
 
+(defun ledger-occur-compress-matches (buffer-matches)
+	"identify sequential xacts to reduce number of overlays required"
+	(let ((points (list))
+				(current-beginning (caar buffer-matches))
+				(current-end (cadar buffer-matches)))
+		(dolist (match (cdr buffer-matches))
+			(if (< (- (car match) current-end) 2)
+					(setq current-end (cadr match))
+					(push (list current-beginning current-end) points)
+					(setq current-beginning (car match))
+					(setq current-end (cadr match))))
+		(nreverse (push (list current-beginning current-end) points))))
 
 (provide 'ldg-occur)
 
diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el
index 487a2449..ab875579 100644
--- a/lisp/ldg-regex.el
+++ b/lisp/ldg-regex.el
@@ -70,6 +70,9 @@
 (defconst ledger-account-any-status-regex
 	"^[ \t]+\\([*!]\\s-+\\)?\\([[(]?.+?\\)\\(\t\\|\n\\| [ \t]\\)")
 
+(defun ledger-account-any-status-with-seed-regex (seed)
+	(concat "^[ \t]+\\([*!]\\s-+\\)?\\([[(]?" seed ".+?\\)\\(\t\\|\n\\| [ \t]\\)"))
+
 (defconst ledger-account-pending-regex
   "\\(^[ \t]+\\)\\(!\\s-*.*?\\)\\(  \\|\t\\|$\\)")