[elpa] master 6025006 08/23: Add company-files-exclusions

[Dmitry Gutov]

branch: master
commit 602500611192ef5df8a72ae6340ada7775dd19ad
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Add company-files-exclusions
    
    Closes #522.
---
 NEWS.md             |    1 +
 company-files.el    |   27 ++++++++++++++++++++++++++-
 company-tests.el    |    5 ++++-
 company.el          |   12 +++++++++++-
 test/files-tests.el |   43 +++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 85 insertions(+), 3 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index ff53d8f..ea04f48 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,7 @@
 
 ## Next
 
+* New variable `company-files-exclusions`.
 * `company-next-page` and `company-previous-page` adhere to
   `company-selection-wrap-around` docstring more closely and only wrap around
   when the selection is at the start of the end of the list.
diff --git a/company-files.el b/company-files.el
index c19d3d6..23c4ec3 100644
--- a/company-files.el
+++ b/company-files.el
@@ -1,4 +1,4 @@
-;;; company-files.el --- company-mode completion backend for file paths
+;;; company-files.el --- company-mode completion backend for file names
 
 ;; Copyright (C) 2009-2011, 2014-2015  Free Software Foundation, Inc.
 
@@ -28,15 +28,40 @@
 (require 'company)
 (require 'cl-lib)
 
+(defgroup company-files nil
+  "Completion backend for file names."
+  :group 'company)
+
+(defcustom company-files-exclusions nil
+  "File name extensions and directory names to ignore.
+The values should use the same format as `completion-ignored-extensions'."
+  :type '(const string)
+  :package-version '(company . "0.9.1"))
+
 (defun company-files--directory-files (dir prefix)
   (ignore-errors
     ;; 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))))))
+      (when company-files-exclusions
+        (setq comp (company-files--exclusions-filtered comp)))
       (if (equal prefix "")
           (delete "../" (delete "./" comp))
         comp))))
 
+(defun company-files--exclusions-filtered (completions)
+  (let* ((dir-exclusions (cl-delete-if-not #'company-files--trailing-slash-p
+                                           company-files-exclusions))
+         (file-exclusions (cl-set-difference company-files-exclusions
+                                             dir-exclusions)))
+    (cl-loop for c in completions
+             unless (if (company-files--trailing-slash-p c)
+                        (member c dir-exclusions)
+                      (cl-find-if (lambda (exclusion)
+                                    (string-suffix-p exclusion c))
+                                  file-exclusions))
+             collect c)))
+
 (defvar company-files--regexps
   (let* ((root (if (eq system-type 'windows-nt)
                    "[a-zA-Z]:/"
diff --git a/company-tests.el b/company-tests.el
index f0d669d..5f7a852 100644
--- a/company-tests.el
+++ b/company-tests.el
@@ -1,6 +1,6 @@
 ;;; company-tests.el --- company-mode test helpers  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2011, 2013-2014  Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2013-2016  Free Software Foundation, Inc.
 
 ;; Author: Dmitry Gutov
 
@@ -21,6 +21,9 @@
 
 (require 'company)
 
+(defvar company-dir (file-name-directory (or load-file-name
+                                             buffer-file-name)))
+
 (defun company--column (&optional pos)
   (car (company--col-row pos)))
 
diff --git a/company.el b/company.el
index 70bd5b4..1721005 100644
--- a/company.el
+++ b/company.el
@@ -83,7 +83,17 @@ buffer-local wherever it is set."
       (declare (debug defvar) (doc-string 3))
       `(progn
          (defvar ,var ,val ,docstring)
-         (make-variable-buffer-local ',var)))))
+         (make-variable-buffer-local ',var))))
+
+  (unless (fboundp 'string-suffix-p)
+    (defun string-suffix-p (suffix string  &optional ignore-case)
+      "Return non-nil if SUFFIX is a suffix of STRING.
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences."
+      (let ((start-pos (- (length string) (length suffix))))
+        (and (>= start-pos 0)
+             (eq t (compare-strings suffix nil nil
+                                    string start-pos nil ignore-case)))))))
 
 (defgroup company nil
   "Extensible inline text completion mechanism"
diff --git a/test/files-tests.el b/test/files-tests.el
new file mode 100644
index 0000000..d45a652
--- /dev/null
+++ b/test/files-tests.el
@@ -0,0 +1,43 @@
+;;; filtes-tests.el --- company-mode tests  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2016  Free Software Foundation, Inc.
+
+;; Author: Dmitry Gutov
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+(require 'company-tests)
+(require 'company-files)
+
+(ert-deftest company-files-candidates-normal ()
+  (let (company-files--completion-cache)
+    (should (member (expand-file-name "test/" company-dir)
+                    (company-files 'candidates
+                                   company-dir)))))
+
+(ert-deftest company-files-candidates-excluding-dir ()
+  (let ((company-files-exclusions '("test/"))
+        company-files--completion-cache)
+    (should-not (member (expand-file-name "test/" company-dir)
+                        (company-files 'candidates
+                                       company-dir)))))
+
+(ert-deftest company-files-candidates-excluding-files ()
+  (let ((company-files-exclusions '(".el"))
+        company-files--completion-cache)
+    (should-not (member (expand-file-name "company.el" company-dir)
+                        (company-files 'candidates
+                                       company-dir)))))