Dramatic improvements to account completion speeds.

lisp/ldg-complete.el

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

lisp/ldg-occur.el

@@ -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)
@@ -76,15 +71,13 @@ When REGEX is nil, unhide everything, and remove higlight"
 						(concat " Ledger-Narrowed: " regex)))
   (force-mode-line-update)
   (ledger-occur-remove-overlays)
-  (if ledger-occur-mode
+  (when ledger-occur-mode
-      (let* ((buffer-matches (ledger-occur-find-matches regex))
+		(ledger-occur-create-overlays
-	     (ovl-bounds (ledger-occur-create-xact-overlay-bounds buffer-matches)))
+		 (ledger-occur-compress-matches
-	(setq ledger-occur-overlay-list
+			(ledger-occur-find-matches regex)))
-	      (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)))))
+				(select-window (get-buffer-window buffer))))
   (recenter))
 
 (defun ledger-occur (regex)
@@ -118,38 +111,29 @@ When REGEX is nil, unhide everything, and remove higlight"
 						 (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-make-visible-overlay (beg end)
-(defun ledger-occur-create-xact-overlays (ovl-bounds)
+	(let ((ovl (make-overlay beg end (current-buffer))))
-  "Create the overlay 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)))
+
+(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* ((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.
@@ -167,21 +151,8 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
 									 (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
@@ -203,6 +174,18 @@ Used for coordinating `ledger-occur' with other buffers, like reconcile."
         (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)
 

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\\|$\\)")