[#464] Optimisation and fixes in `company-files`

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

diff --git a/company-files.el b/company-files.el
index 5a77699da4b624abeacd6588e3d8622fb51700b1..f90f3d02b233a7956a6821fa2047c356bb833f8c 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,11 @@
 
 (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 (file-name-all-completions prefix dir)))
+      (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 +52,58 @@
     (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 (sort (append children candidates)
+                              #'string-lessp)))))

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