mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 76bbd07de7add0f9d13c6914f158d19630fe2f62
commit | author | age
5cb5f7 1 ;;; company-c-headers.el --- Company mode backend for C/C++ header files  -*- lexical-binding: t -*-
C 2
3 ;; Copyright (C) 2014 Alastair Rankine
4
5 ;; Author: Alastair Rankine <alastair@girtby.net>
6 ;; Keywords: development company
7 ;; Package-Version: 20180814.1730
8 ;; Package-Requires: ((emacs "24.1") (company "0.8"))
9
10 ;; This file is not part of GNU Emacs.
11
12 ;; This file is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; This file is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;; This library enables the completion of C/C++ header file names using Company.
28 ;;
29 ;; To initialize it, just add it to `company-backends':
30 ;;
31 ;; (add-to-list 'company-backends 'company-c-headers)
32 ;;
33 ;; When you type an #include declaration within a supported major mode (see
34 ;; `company-c-headers-modes'), company-c-headers will search for header files
35 ;; within predefined search paths.  company-c-headers can search "system" and
36 ;; "user" paths, depending on the type of #include declaration you type.
37 ;;
38 ;; You will probably want to customize the `company-c-headers-path-user' and
39 ;; `company-c-headers-path-system' variables for your specific needs.
40
41 ;;; Code:
42
43 (require 'company)
44 (require 'rx)
45 (require 'cl)
46 (require 'cl-lib)
47
48 (defgroup company-c-headers nil
49   "Completion back-end for C/C++ header files."
50   :group 'company)
51
52 (defcustom company-c-headers-path-system
53   '("/usr/include/" "/usr/local/include/")
54   "List of paths to search for system (i.e. angle-bracket
55 delimited) header files.  Alternatively, a function can be
56 supplied which returns the path list."
57   :type '(choice (repeat directory)
58                  function)
59   )
60
61 (defcustom company-c-headers-path-user
62   '(".")
63   "List of paths to search for user (i.e. double-quote delimited)
64 header files.  Alternatively, a function can be supplied which
65 returns the path list.  Note that paths in
66 `company-c-headers-path-system' are implicitly appended."
67   :type '(choice (repeat directory)
68                  function)
69   )
70
71 (defvar company-c-headers-include-declaration
72   (rx
73    line-start
74    "#" (zero-or-more blank) (or "include" "import")
75    (one-or-more blank)
76    (submatch
77     (in "<\"")
78     (zero-or-more (not (in ">\""))))
79    )
80   "Prefix matching C/C++/ObjC include directives.")
81
82 (defvar company-c-headers-modes
83   `(
84     (c-mode     . ,(rx ".h" line-end))
85     (c++-mode   . ,(rx (or (: line-start (one-or-more (in "A-Za-z0-9_")))
86                            (or ".h" ".hpp" ".hxx" ".hh"))
87                        line-end))
88     (objc-mode  . ,(rx ".h" line-end))
89     )
90   "Assoc list of supported major modes and associated header file names.")
91
92 (defun call-if-function (path)
93   "If PATH is bound to a function, return the result of calling it.
94 Otherwise just return the value."
95   (if (functionp path)
96       (funcall path)
97     path))
98
99 (defun company-c-headers--candidates-for (prefix dir)
100   "Return a list of candidates for PREFIX in directory DIR.
101 Filters on the appropriate regex for the current major mode."
102   (let* ((delim (substring prefix 0 1))
103          (fileprefix (substring prefix 1))
104          (prefixdir (file-name-directory fileprefix))
105          (subdir (and prefixdir (concat (file-name-as-directory dir) prefixdir)))
106          (hdrs (cdr (assoc major-mode company-c-headers-modes)))
107          candidates)
108
109     ;; If we need to complete inside a subdirectory, use that
110     (when (and subdir (file-directory-p subdir))
111       (setq dir subdir)
112       (setq fileprefix (file-name-nondirectory fileprefix))
113       (setq delim (concat delim prefixdir))
114       )
115
116     ;; Using a list of completions for this directory, remove those that a) don't match the
117     ;; headers regexp, and b) are not directories (except for "." and ".." which ARE removed)
118     (setq candidates (cl-remove-if
119                       (lambda (F) (and (not (string-match-p hdrs F))
120                                        (or (cl-member (directory-file-name F) '("." "..") :test 'equal)
121                                            (not (file-directory-p (concat (file-name-as-directory dir) F))))))
122                       (file-name-all-completions fileprefix dir)))
123
124     ;; We want to see candidates in alphabetical order per directory
125     (setq candidates (sort candidates #'string<))
126
127     ;; Add the delimiter and metadata
128     (mapcar (lambda (C) (propertize (concat delim C) 'directory dir)) candidates)
129     ))
130
131 (defun company-c-headers--candidates (prefix)
132   "Return candidates for PREFIX."
133   (let ((p (if (equal (aref prefix 0) ?\")
134                (call-if-function company-c-headers-path-user)
135              (call-if-function company-c-headers-path-system)))
136         (next (when (equal (aref prefix 0) ?\")
137                 (call-if-function company-c-headers-path-system)))
138         candidates)
139     (while p
140       (when (file-directory-p (car p))
141         (setq candidates (append candidates (company-c-headers--candidates-for prefix (car p)))))
142
143       (setq p (or (cdr p)
144                   (let ((tmp next))
145                     (setq next nil)
146                     tmp)))
147       )
148     (remove-duplicates candidates :test 'equal)
149     ))
150
151 (defun company-c-headers--meta (candidate)
152   "Return the metadata associated with CANDIDATE.  Currently just the directory."
153   (get-text-property 0 'directory candidate))
154
155 (defun company-c-headers--location (candidate)
156   "Return the location associated with CANDIDATE."
157   (cons (concat (file-name-as-directory (get-text-property 0 'directory candidate))
158                 (file-name-nondirectory (substring candidate 1)))
159         1))
160
161 ;;;###autoload
162 (defun company-c-headers (command &optional arg &rest ignored)
163   "Company backend for C/C++ header files."
164   (interactive (list 'interactive))
165   (pcase command
166     (`interactive (company-begin-backend 'company-c-headers))
167     (`prefix
168      (when (and (assoc major-mode company-c-headers-modes)
169                 (looking-back company-c-headers-include-declaration (line-beginning-position)))
170        (match-string-no-properties 1)))
171     (`sorted t)
172     (`candidates (company-c-headers--candidates arg))
173     (`meta (company-c-headers--meta arg))
174     (`location (company-c-headers--location arg))
175     (`post-completion
176      (when (looking-back company-c-headers-include-declaration (line-beginning-position))
177        (let ((matched (match-string-no-properties 1)))
178          (if (string= matched (file-name-as-directory matched))
179              ;; This is a directory, setting `this-command' to a `self-insert-command'
180              ;; tricks company to automatically trigger completion again for the
181              ;; directory files.
182              ;; See https://github.com/company-mode/company-mode/issues/143
183              (setq this-command 'self-insert-command)
184            ;; It's not a directory, add a terminating delimiter.
185            ;; If pre-existing terminating delimiter already exists,
186            ;; move cursor to end of line.
187            (pcase (aref matched 0)
188              (?\" (if (looking-at "\"") (end-of-line) (insert "\"")))
189              (?<  (if (looking-at ">") (end-of-line) (insert ">"))))))))
190     ))
191
192 (provide 'company-c-headers)
193
194 ;;; company-c-headers.el ends here