Implement more efficient completion algorithm. Thanks Thierry! Also remove multi-comment font-locking for performance reasons.

3 files changed, 38 insertions, 61 deletions

diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el
index e3820924..2faef5df 100644
--- a/lisp/ldg-complete.el
+++ b/lisp/ldg-complete.el
@@ -69,31 +69,36 @@
 						     ;; to the list
     (pcomplete-uniqify-list (nreverse payees-list))))
 
+
 (defun ledger-find-accounts-in-buffer ()
-  "Search through buffer and build tree of accounts.
-Return tree structure"
-  (let ((origin (point))
-	(account-tree (list t))
-	(account-elements nil))
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward
-              ledger-account-or-metadata-regex nil t)
-        (unless (and (>= origin (match-beginning 0))
-                     (< origin (match-end 0)))
+	(interactive)
+	(let ((origin (point))
+				accounts
+				(account-tree (list t))
+				(account-elements nil))
+		(save-excursion
+			(goto-char (point-min))
+
+			(dolist (account
+								(delete-dups
+								 (progn
+									 (while (re-search-forward ledger-account-or-metadata-regex nil t)
+										 (unless (between origin (match-beginning 0) (match-end 0))
+											 (setq accounts (cons (match-string-no-properties 2) accounts))))
+									 accounts)))
+				(let ((root account-tree))
           (setq account-elements
-		(split-string
-		 (match-string-no-properties 2) ":"))
-          (let ((root account-tree))
-	    (while account-elements
-	      (let ((xact (assoc (car account-elements) root)))
-		(if xact
-                    (setq root (cdr xact))
-		    (setq xact (cons (car account-elements) (list t)))
-		    (nconc root (list xact))
-		    (setq root (cdr xact))))
-              (setq account-elements (cdr account-elements)))))))
-    account-tree))
+								(split-string
+								 account ":"))
+					(while account-elements
+						(let ((xact (assoc (car account-elements) root)))
+							(if xact
+									(setq root (cdr xact))
+									(setq xact (cons (car account-elements) (list t)))
+									(nconc root (list xact))
+									(setq root (cdr xact))))
+						(setq account-elements (cdr account-elements))))))
+		account-tree))
 
 (defun ledger-find-metadata-in-buffer ()
   "Search through buffer and build list of metadata.
@@ -177,7 +182,7 @@ Does not use ledger xact"
 	;; Search backward for a matching payee
         (when (re-search-backward
                (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.*"
-                       (regexp-quote name) ".*\\)" ) nil t) 
+                       (regexp-quote name) ".*\\)" ) nil t)
 	  (setq rest-of-name (match-string 3))
           ;; Start copying the postings
 	  (forward-line)
diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el
index fc0b7813..ab0a3317 100644
--- a/lisp/ldg-fonts.el
+++ b/lisp/ldg-fonts.el
@@ -111,54 +111,27 @@
 
 
 (defvar ledger-font-lock-keywords
-  `( ;; (,ledger-other-entries-regex 1 
+  `( ;; (,ledger-other-entries-regex 1
      ;; 				  ledger-font-other-face)
      (,ledger-comment-regex 0
 			    'ledger-font-comment-face)
      (,ledger-multiline-comment-regex 0 'ledger-font-comment-face)
-     (,ledger-payee-pending-regex 2 
+     (,ledger-payee-pending-regex 2
 				  'ledger-font-payee-pending-face) ; Works
-     (,ledger-payee-cleared-regex 2 
+     (,ledger-payee-cleared-regex 2
  				  'ledger-font-payee-cleared-face) ; Works
-     (,ledger-payee-uncleared-regex 2 
+     (,ledger-payee-uncleared-regex 2
  				    'ledger-font-payee-uncleared-face) ; Works
-     (,ledger-account-cleared-regex 2 
+     (,ledger-account-cleared-regex 2
  	      			    'ledger-font-posting-account-cleared-face) ; Works
-     (,ledger-account-pending-regex 2 
+     (,ledger-account-pending-regex 2
  	      			    'ledger-font-posting-account-pending-face) ; Works
-     (,ledger-account-any-status-regex 2 
+     (,ledger-account-any-status-regex 2
 				       'ledger-font-posting-account-face) ; Works
-     (,ledger-other-entries-regex 1 
+     (,ledger-other-entries-regex 1
 				  'ledger-font-other-face))
   "Expressions to highlight in Ledger mode.")
 
-(defun ledger-extend-region-multiline-comment ()
-  "Adjusts the variables font-lock-beg and font-lock-end if they
-  fall within a multiline comment.  Returns non-nil if an
-  adjustment is made."
-  (let (beg end)
-    ;; fix beg
-    (save-excursion
-     (goto-char font-lock-beg)
-     (end-of-line)
-     (when (re-search-backward ledger-multiline-comment-start-regex nil t)
-       (setq beg (point))
-       (re-search-forward ledger-multiline-comment-regex nil t)
-       (if (and (>= (point) font-lock-beg)
-                (/= beg font-lock-beg))
-           (setq font-lock-beg beg)
-         (setq beg nil))))
-    ;; fix end
-    (save-excursion
-      (goto-char font-lock-end)
-      (end-of-line)
-      (when (re-search-backward ledger-multiline-comment-start-regex nil t)
-        (re-search-forward ledger-multiline-comment-regex nil t)
-        (setq end (point))
-        (if (> end font-lock-end)
-            (setq font-lock-end end)
-          (setq end nil))))
-    (or beg end)))
 
 (provide 'ldg-fonts)
 
diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el
index c2e87d8e..75b842e2 100644
--- a/lisp/ldg-mode.el
+++ b/lisp/ldg-mode.el
@@ -124,8 +124,7 @@ Can indent, complete or align depending on context."
 	(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
-                #'ledger-extend-region-multiline-comment))
+          (list #'font-lock-extend-region-wholelines))
     (setq font-lock-multiline nil)
 
     (set (make-local-variable 'pcomplete-parse-arguments-function)