emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master d497b8c 02/40: speed up company-etags


From: Dmitry Gutov
Subject: [elpa] master d497b8c 02/40: speed up company-etags
Date: Thu, 2 Jan 2020 18:56:59 -0500 (EST)

branch: master
commit d497b8c4b4d825c83d2ae6aabe0c0d05b0f3cc93
Author: Chen Bin <address@hidden>
Commit: Chen Bin <address@hidden>

    speed up company-etags
---
 company-etags.el | 232 ++++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 222 insertions(+), 10 deletions(-)

diff --git a/company-etags.el b/company-etags.el
index d0c27c9..adfad8d 100644
--- a/company-etags.el
+++ b/company-etags.el
@@ -45,6 +45,12 @@ buffer automatically."
   :type 'boolean
   :package-version '(company . "0.7.3"))
 
+(defcustom company-etags-support-ctags-only nil
+  "Nil to support tags file created by both etags and ctags.
+Non-nil to support tags file created only by ctags.
+Please note nil slows down tags file loading time."
+  :type 'boolean)
+
 (defcustom company-etags-everywhere nil
   "Non-nil to offer completions in comments and strings.
 Set it to t or to a list of major modes."
@@ -54,17 +60,42 @@ Set it to t or to a list of major modes."
                          (symbol :tag "Major mode")))
   :package-version '(company . "0.9.0"))
 
+(defcustom company-etags-check-tags-file-interval 30
+  "The interval (seconds) to check tags file.
+Default value is 30 seconds."
+  :type 'integer)
+
+
+(defcustom company-etags-tags-file-name "TAGS"
+  "The name of tags file."
+  :type 'string)
+
 (defvar company-etags-modes '(prog-mode c-mode objc-mode c++-mode java-mode
                               jde-mode pascal-mode perl-mode python-mode))
 
 (defvar-local company-etags-buffer-table 'unknown)
 
+(defvar company-etags-tags-file-caches nil
+  "The cached tags files.")
+
+(defvar company-etags-cached-candidates nil
+  "The cached candidates searched with certain prefix.
+It's like (prefix . candidates).")
+
+(defconst company-etags-fast-pattern
+  "\177\\([^\177\001\n]+\\)\001"
+  "Pattern to extract tag name created by Ctags only.")
+
+(defconst company-etags-slow-pattern
+  "\\([^\f\t\n\r()=,; ]*\\)[\f\t\n\r()=,; ]*\177\\\(?:\\([^\n\001]+\\)\001\\)?"
+  "Pattern to extract tag name created by Ctags/Etags.")
+
 (defun company-etags-find-table ()
   (let ((file (expand-file-name
-               "TAGS"
+               company-etags-tags-file-name
                (locate-dominating-file (or buffer-file-name
                                            default-directory)
-                                       "TAGS"))))
+                                       company-etags-tags-file-name))))
     (when (and file (file-regular-p file))
       (list file))))
 
@@ -74,15 +105,196 @@ Set it to t or to a list of major modes."
           (setq company-etags-buffer-table (company-etags-find-table))
         company-etags-buffer-table)))
 
+(defmacro company-etags-push-tagname (tagname tagname-dict)
+  "Push TAGNAME into TAGNAME-DICT."
+  `(let* ((c (elt ,tagname 0)))
+    (cond
+     ((or (and (>= c ?a) (<= c ?z))
+          (and (>= c ?A) (<= c ?Z))
+          (eq c ?$)
+          (eq c ?#)
+          (eq c ?@)
+          (eq c ?%)
+          (eq c ?_)
+          (eq c ?!)
+          (eq c ?*)
+          (eq c ?&)
+          (and (>= c ?0) (<= c ?9)))
+      (push ,tagname (gethash c ,tagname-dict)))
+     (t
+      (push ,tagname (gethash ?' ,tagname-dict))))))
+
+(defun company-etags-extract-tagnames (text)
+  "Extract tag names from TEXT."
+  (let* ((start 0)
+         (tagname-dict (make-hash-table))
+         (i 0))
+
+    ;; initialize hashtable whose key is from a...z and A...Z
+    (while (< i 26)
+      ;; make sure the hash value is not nil
+      (puthash (+ ?a i) '() tagname-dict)
+      (puthash (+ ?A i) '() tagname-dict)
+      (setq i (1+ i)))
+
+    ;; initialize hashtable whose key is from 0...9
+    (setq i 0)
+    (while (< i 10)
+      ;; make sure the hash value is not nil
+      (puthash (+ ?0 i) '() tagname-dict)
+      (setq i (1+ i)))
+    ;; other key used as the first character of variable name
+    (puthash ?$ '() tagname-dict)
+    (puthash ?_ '() tagname-dict)
+    (puthash ?# '() tagname-dict)
+    (puthash ?& '() tagname-dict)
+    (puthash ?@ '() tagname-dict)
+    (puthash ?! '() tagname-dict)
+    (puthash ?* '() tagname-dict)
+    (puthash ?% '() tagname-dict)
+    ;; rubbish bin
+    (puthash ?' '() tagname-dict)
+
+    ;; Code inside the loop should be optimized.
+    ;; Please avoid calling lisp function inside the loop.
+    (cond
+     (company-etags-support-ctags-only
+      ;; fast algorithm, support explicit tags name only
+      (while (string-match company-etags-fast-pattern text start)
+        (company-etags-push-tagname (substring text (match-beginning 1) 
(match-end 1))
+                                    tagname-dict)
+        (setq start (+ 4 (match-end 0)))))
+     (t
+      ;; slow algorithm, need support both explicit and implicit tags name
+      (while (string-match company-etags-slow-pattern text start)
+        (cond
+         ((match-beginning 2)
+          ;; There is an explicit tag name.
+          (company-etags-push-tagname (substring text (match-beginning 2) 
(match-end 2))
+                                      tagname-dict))
+         (t
+          ;; No explicit tag name.  Backtrack a little,
+          ;; and look for the implicit one.
+          (company-etags-push-tagname (substring text (match-beginning 1) 
(match-end 1))
+                                      tagname-dict)))
+        (setq start (+ 4 (match-end 0))))))
+
+    tagname-dict))
+
+(defun company-etags-append-new-tagname-dict (new-tagnames file-info)
+  "Append NEW-TAGNAMES to FILE-INFO."
+  (dolist (tagname new-tagnames)
+    (company-etags-push-tagname tagname (plist-get file-info :tagname-dict))))
+
+(defun company-etags-all-completions (prefix tagname-dict)
+  "Search for partial matches to PREFIX in TAGNAME-DICT."
+  (let* ((c (elt prefix 0))
+         (arr (gethash c tagname-dict (gethash ?' tagname-dict))))
+    (all-completions prefix arr)))
+
+(defun company-etags-load-tags-file (file &optional force no-diff-prog)
+  "Load tags from FILE.
+If FORCE is t, file is read without check item in 
`company-etags-tags-file-caches'.
+If NO-DIFF-PROG is t, do NOT use diff on tags file.
+This function return t if any tag file is reloaded."
+  (let* (raw-content
+         (file-info (and company-etags-tags-file-caches
+                         (gethash file company-etags-tags-file-caches)))
+         (use-diff (and (not no-diff-prog) file-info (executable-find 
diff-command)))
+         tagname-dict
+         reloaded)
+    (when (or force
+              (not file-info)
+              (and
+               ;; time to expire cache from tags file
+               (> (- (float-time (current-time))
+                     (plist-get file-info :timestamp))
+                  company-etags-check-tags-file-interval)
+               ;; When generating new tags file, file size could be
+               ;; temporarily smaller than cached file size.
+               ;; Don't reload tags file until new tags file is bigger.
+               (> (nth 7 (file-attributes file))
+                  (plist-get file-info :filesize))))
+
+      ;; Read file content
+      (setq reloaded t)
+      (message "Loading %s ..." file)
+      (cond
+       (use-diff
+        ;; actually don't change raw-content attached to file-info
+        (setq raw-content (plist-get file-info :raw-content))
+
+        ;; use diff to find the new tags
+        (let* ((tmp-file (make-temp-file "company-etags-diff"))
+               (cmd (format "%s -ab %s %s" diff-command tmp-file file)))
+          ;; create old tags file
+          (with-temp-buffer
+            (insert (plist-get file-info :raw-content))
+            (write-region (point-min) (point-max) tmp-file nil :silent))
+          ;; compare old and new tags file, extract tag names from diff output 
which
+          ;; should be merged with old tag names
+          (setq tagname-dict (company-etags-append-new-tagname-dict 
(company-etags-extract-tagnames (shell-command-to-string cmd))
+                                                      file-info))
+          ;; clean up
+          (delete-file tmp-file)))
+       (t
+        (setq raw-content (with-temp-buffer
+                            (insert-file-contents file)
+                            (buffer-string)))
+        ;; collect all tag names
+        (setq tagname-dict (company-etags-extract-tagnames raw-content))))
+
+      ;; initialize hash table if needed
+      (unless company-etags-tags-file-caches
+        (set 'company-etags-tags-file-caches (make-hash-table :test #'equal)))
+
+      ;; finalize tags file info
+      (puthash file
+               (list :raw-content raw-content
+                     :tagname-dict tagname-dict
+                     :timestamp (float-time (current-time))
+                     :filesize (nth 7 (file-attributes file)))
+               company-etags-tags-file-caches)
+      (message "%s is loaded." file))
+    reloaded))
+
 (defun company-etags--candidates (prefix)
-  (let ((tags-table-list (company-etags-buffer-table))
-        (tags-file-name tags-file-name)
-        (completion-ignore-case company-etags-ignore-case))
-    (and (or tags-file-name tags-table-list)
-         (fboundp 'tags-completion-table)
-         (save-excursion
-           (visit-tags-table-buffer)
-           (all-completions prefix (tags-completion-table))))))
+  "Get candidate with PREFIX."
+  (when (and prefix (> (length prefix) 0))
+    (let* ((file (and tags-file-name (file-truename tags-file-name)))
+           (completion-ignore-case company-etags-ignore-case)
+           (all-tags-files (mapcar (lambda (f)
+                                     (file-truename f))
+                                   (delete-dups (append (if file (list file))
+                                                        
(company-etags-buffer-table)))))
+           rlt)
+
+      ;; load tags files, maybe
+      (dolist (f all-tags-files)
+        (when (and f (file-exists-p f))
+          (when (company-etags-load-tags-file f)
+            ;; clear cached candidates if any tags file is reloaded
+            (setq company-etags-cached-candidates nil))))
+
+      (cond
+       ;; re-use cached candidates
+       ((and company-etags-cached-candidates
+             (>= (length prefix) (length (car 
company-etags-cached-candidates)))
+             (string= (substring prefix 0 (length (car 
company-etags-cached-candidates)))
+                      (car company-etags-cached-candidates)))
+        (setq rlt (all-completions prefix (cdr 
company-etags-cached-candidates))))
+
+       ;; search candidates through tags files
+       (t
+        (dolist (f all-tags-files)
+          (let* ((cache (gethash f company-etags-tags-file-caches))
+                 (tagname-dict (plist-get cache :tagname-dict)))
+            (when tagname-dict
+              (setq rlt (append rlt (company-etags-all-completions prefix 
tagname-dict))))))
+        (setq company-etags-cached-candidates (cons prefix rlt))))
+
+      ;; cleanup
+      (if rlt (delete-dups rlt)))))
 
 ;;;###autoload
 (defun company-etags (command &optional arg &rest ignored)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]