company-dabbrev--search-buffer: Speed up

[gnu-emacs-elpa] / company-files.el

diff --git a/company-files.el b/company-files.el
index 5a77699da4b624abeacd6588e3d8622fb51700b1..c19d3d6cbd86569d8c0676e009c4152c0fc271be 100644 (file)
--- a/company-files.el
+++ b/company-files.el
@@ -1,6 +1,6 @@
-;;; company-files.el --- company-mode completion back-end for file paths
+;;; company-files.el --- company-mode completion backend for file paths

 
 

-;; Copyright (C) 2009-2011, 2014  Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2014-2015  Free Software Foundation, Inc.

 
 ;; Author: Nikolaj Schumacher
 
 
 ;; Author: Nikolaj Schumacher
 


@@ -30,9 +30,12 @@
 
 (defun company-files--directory-files (dir prefix)
   (ignore-errors
 
 (defun company-files--directory-files (dir prefix)
   (ignore-errors

-    (if (equal prefix "")
-        (directory-files dir nil "\\`[^.]\\|\\`.[^.]")
-      (file-name-all-completions prefix dir))))
+    ;; Don't use directory-files. It produces directories without trailing /.
+    (let ((comp (sort (file-name-all-completions prefix dir)
+                      (lambda (s1 s2) (string-lessp (downcase s1) (downcase s2))))))
+      (if (equal prefix "")
+          (delete "../" (delete "./" comp))
+        comp))))

 
 (defvar company-files--regexps
   (let* ((root (if (eq system-type 'windows-nt)
 
 (defvar company-files--regexps
   (let* ((root (if (eq system-type 'windows-nt)


@@ -50,39 +53,57 @@
     (and (cl-dolist (regexp company-files--regexps)
            (when (setq file (company-grab-line regexp 1))
              (cl-return file)))
     (and (cl-dolist (regexp company-files--regexps)
            (when (setq file (company-grab-line regexp 1))
              (cl-return file)))

+         (company-files--connected-p file)

          (setq dir (file-name-directory file))
          (not (string-match "//" dir))
          (file-exists-p dir)
          (setq dir (file-name-directory file))
          (not (string-match "//" dir))
          (file-exists-p dir)

-         (file-name-all-completions (file-name-nondirectory file) dir)

          file)))
 
          file)))
 

+(defun company-files--connected-p (file)
+  (or (not (file-remote-p file))
+      (file-remote-p file nil t)))
+
+(defun company-files--trailing-slash-p (file)
+  ;; `file-directory-p' is very expensive on remotes. We are relying on
+  ;; `file-name-all-completions' returning directories with trailing / instead.
+  (let ((len (length file)))
+    (and (> len 0) (eq (aref file (1- len)) ?/))))
+

 (defvar company-files--completion-cache nil)
 
 (defun company-files--complete (prefix)
   (let* ((dir (file-name-directory prefix))
 (defvar company-files--completion-cache nil)
 
 (defun company-files--complete (prefix)
   (let* ((dir (file-name-directory prefix))

-         (key (cons (expand-file-name dir)
-                    (nth 5 (file-attributes dir))))

          (file (file-name-nondirectory prefix))
          (file (file-name-nondirectory prefix))

-         candidates directories)
-    (unless (equal key (car company-files--completion-cache))
-      (dolist (file (company-files--directory-files dir file))
-        (setq file (concat dir file))
-        (push file candidates)
-        (when (file-directory-p file)
-          (push file directories)))
-      (dolist (directory (reverse directories))
-        ;; Add one level of children.
-        (dolist (child (company-files--directory-files directory ""))
-          (push (concat directory
-                        (unless (eq (aref directory (1- (length directory))) ?/) "/")
-                        child) candidates)))
-      (setq company-files--completion-cache (cons key (nreverse candidates))))
+         (key (list file
+                    (expand-file-name dir)
+                    (nth 5 (file-attributes dir))))
+         (completion-ignore-case read-file-name-completion-ignore-case))
+    (unless (company-file--keys-match-p key (car company-files--completion-cache))
+      (let* ((candidates (mapcar (lambda (f) (concat dir f))
+                                 (company-files--directory-files dir file)))
+             (directories (unless (file-remote-p dir)
+                            (cl-remove-if-not (lambda (f)
+                                                (and (company-files--trailing-slash-p f)
+                                                     (not (file-remote-p f))
+                                                     (company-files--connected-p f)))
+                                              candidates)))
+             (children (and directories
+                            (cl-mapcan (lambda (d)
+                                         (mapcar (lambda (c) (concat d c))
+                                                 (company-files--directory-files d "")))
+                                       directories))))
+        (setq company-files--completion-cache
+              (cons key (append candidates children)))))

     (all-completions prefix
                      (cdr company-files--completion-cache))))
 
     (all-completions prefix
                      (cdr company-files--completion-cache))))
 

+(defun company-file--keys-match-p (new old)
+  (and (equal (cdr old) (cdr new))
+       (string-prefix-p (car old) (car new))))
+

 ;;;###autoload
 (defun company-files (command &optional arg &rest ignored)
 ;;;###autoload
 (defun company-files (command &optional arg &rest ignored)

-  "`company-mode' completion back-end existing file names.
+  "`company-mode' completion backend existing file names.

 Completions works for proper absolute and relative files paths.
 File paths with spaces are only supported inside strings."
   (interactive (list 'interactive))
 Completions works for proper absolute and relative files paths.
 File paths with spaces are only supported inside strings."
   (interactive (list 'interactive))


@@ -92,6 +113,8 @@ File paths with spaces are only supported inside strings."
     (candidates (company-files--complete arg))
     (location (cons (dired-noselect
                      (file-name-directory (directory-file-name arg))) 1))
     (candidates (company-files--complete arg))
     (location (cons (dired-noselect
                      (file-name-directory (directory-file-name arg))) 1))

+    (post-completion (when (company-files--trailing-slash-p arg)
+                       (delete-char -1)))

     (sorted t)
     (no-cache t)))
 
     (sorted t)
     (no-cache t)))