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