X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/a7a4ba681cf99afbd94077554f0161a7e37f0400..9b89556880e326ec3391cfda2a87eada101eaaae:/company-files.el diff --git a/company-files.el b/company-files.el index e44b4f5bd..c19d3d6cb 100644 --- a/company-files.el +++ b/company-files.el @@ -1,4 +1,4 @@ -;;; 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-2015 Free Software Foundation, Inc. @@ -30,9 +30,12 @@ (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) @@ -50,37 +53,47 @@ (and (cl-dolist (regexp company-files--regexps) (when (setq file (company-grab-line regexp 1)) (cl-return file))) - (or (not (file-remote-p file)) - (file-remote-p file nil t)) + (company-files--connected-p file) (setq dir (file-name-directory file)) (not (string-match "//" dir)) (file-exists-p dir) - (file-name-all-completions (file-name-nondirectory file) dir) 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)) - (key (list (file-name-nondirectory prefix) + (file (file-name-nondirectory prefix)) + (key (list file (expand-file-name dir) (nth 5 (file-attributes dir)))) - (file (file-name-nondirectory prefix)) - (completion-ignore-case read-file-name-completion-ignore-case) - candidates directories) + (completion-ignore-case read-file-name-completion-ignore-case)) (unless (company-file--keys-match-p 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)))) + (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)))) @@ -90,7 +103,7 @@ ;;;###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)) @@ -100,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)) + (post-completion (when (company-files--trailing-slash-p arg) + (delete-char -1))) (sorted t) (no-cache t)))