| commit | author | age | ||
| 5cb5f7 | 1 | ;;; company-clang.el --- company-mode completion backend for Clang -*- lexical-binding: t -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2009, 2011, 2013-2017 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Author: Nikolaj Schumacher | |
| 6 | ||
| 7 | ;; This file is part of GNU Emacs. | |
| 8 | ||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
| 10 | ;; it under the terms of the GNU General Public License as published by | |
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 12 | ;; (at your option) any later version. | |
| 13 | ||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 17 | ;; GNU General Public License for more details. | |
| 18 | ||
| 19 | ;; You should have received a copy of the GNU General Public License | |
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
| 21 | ||
| 22 | ||
| 23 | ;;; Commentary: | |
| 24 | ;; | |
| 25 | ||
| 26 | ;;; Code: | |
| 27 | ||
| 28 | (require 'company) | |
| 29 | (require 'company-template) | |
| 30 | (require 'cl-lib) | |
| 31 | ||
| 32 | (defgroup company-clang nil | |
| 33 | "Completion backend for Clang." | |
| 34 | :group 'company) | |
| 35 | ||
| 36 | (defcustom company-clang-executable | |
| 37 | (executable-find "clang") | |
| 38 | "Location of clang executable." | |
| 39 | :type 'file) | |
| 40 | ||
| 41 | (defcustom company-clang-begin-after-member-access t | |
| 42 | "When non-nil, automatic completion will start whenever the current | |
| 43 | symbol is preceded by \".\", \"->\" or \"::\", ignoring | |
| 44 | `company-minimum-prefix-length'. | |
| 45 | ||
| 46 | If `company-begin-commands' is a list, it should include `c-electric-lt-gt' | |
| 47 | and `c-electric-colon', for automatic completion right after \">\" and | |
| 48 | \":\"." | |
| 49 | :type 'boolean) | |
| 50 | ||
| 51 | (defcustom company-clang-arguments nil | |
| 52 | "Additional arguments to pass to clang when completing. | |
| 53 | Prefix files (-include ...) can be selected with `company-clang-set-prefix' | |
| 54 | or automatically through a custom `company-clang-prefix-guesser'." | |
| 55 | :type '(repeat (string :tag "Argument"))) | |
| 56 | ||
| 57 | (defcustom company-clang-prefix-guesser 'company-clang-guess-prefix | |
| 58 | "A function to determine the prefix file for the current buffer." | |
| 59 | :type '(function :tag "Guesser function" nil)) | |
| 60 | ||
| 61 | (defvar company-clang-modes '(c-mode c++-mode objc-mode) | |
| 62 | "Major modes which clang may complete.") | |
| 63 | ||
| 64 | (defcustom company-clang-insert-arguments t | |
| 65 | "When non-nil, insert function arguments as a template after completion." | |
| 66 | :type 'boolean | |
| 67 | :package-version '(company . "0.8.0")) | |
| 68 | ||
| 69 | ;; prefix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 70 | ||
| 71 | (defvar company-clang--prefix nil) | |
| 72 | ||
| 73 | (defsubst company-clang--guess-pch-file (file) | |
| 74 | (let ((dir (directory-file-name (file-name-directory file)))) | |
| 75 | (when (equal (file-name-nondirectory dir) "Classes") | |
| 76 | (setq dir (file-name-directory dir))) | |
| 77 | (car (directory-files dir t "\\([^.]h\\|[^h]\\).pch\\'" t)))) | |
| 78 | ||
| 79 | (defsubst company-clang--file-substring (file beg end) | |
| 80 | (with-temp-buffer | |
| 81 | (insert-file-contents-literally file nil beg end) | |
| 82 | (buffer-string))) | |
| 83 | ||
| 84 | (defun company-clang-guess-prefix () | |
| 85 | "Try to guess the prefix file for the current buffer." | |
| 86 | ;; Prefixes seem to be called .pch. Pre-compiled headers do, too. | |
| 87 | ;; So we look at the magic number to rule them out. | |
| 88 | (let* ((file (company-clang--guess-pch-file buffer-file-name)) | |
| 89 | (magic-number (and file (company-clang--file-substring file 0 4)))) | |
| 90 | (unless (member magic-number '("CPCH" "gpch")) | |
| 91 | file))) | |
| 92 | ||
| 93 | (defun company-clang-set-prefix (&optional prefix) | |
| 94 | "Use PREFIX as a prefix (-include ...) file for clang completion." | |
| 95 | (interactive (let ((def (funcall company-clang-prefix-guesser))) | |
| 96 | (unless (stringp def) | |
| 97 | (setq def default-directory)) | |
| 98 | (list (read-file-name "Prefix file: " | |
| 99 | (when def (file-name-directory def)) | |
| 100 | def t (when def (file-name-nondirectory def)))))) | |
| 101 | ;; TODO: pre-compile? | |
| 102 | (setq company-clang--prefix (and (stringp prefix) | |
| 103 | (file-regular-p prefix) | |
| 104 | prefix))) | |
| 105 | ||
| 106 | ;; Clean-up on exit. | |
| 107 | (add-hook 'kill-emacs-hook 'company-clang-set-prefix) | |
| 108 | ||
| 109 | ;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 110 | ||
| 111 | ;; TODO: Handle Pattern (syntactic hints would be neat). | |
| 112 | ;; Do we ever see OVERLOAD (or OVERRIDE)? | |
| 113 | (defconst company-clang--completion-pattern | |
| 114 | "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\)\\(?: : \\(.*\\)$\\)?$") | |
| 115 | ||
| 116 | (defconst company-clang--error-buffer-name "*clang-error*") | |
| 117 | ||
| 118 | (defun company-clang--lang-option () | |
| 119 | (if (eq major-mode 'objc-mode) | |
| 120 | (if (string= "m" (file-name-extension buffer-file-name)) | |
| 121 | "objective-c" "objective-c++") | |
| 122 | (substring (symbol-name major-mode) 0 -5))) | |
| 123 | ||
| 124 | (defun company-clang--parse-output (prefix _objc) | |
| 125 | (goto-char (point-min)) | |
| 126 | (let ((pattern (format company-clang--completion-pattern | |
| 127 | (regexp-quote prefix))) | |
| 128 | (case-fold-search nil) | |
| 129 | lines match) | |
| 130 | (while (re-search-forward pattern nil t) | |
| 131 | (setq match (match-string-no-properties 1)) | |
| 132 | (unless (equal match "Pattern") | |
| 133 | (save-match-data | |
| 134 | (when (string-match ":" match) | |
| 135 | (setq match (substring match 0 (match-beginning 0))))) | |
| 136 | (let ((meta (match-string-no-properties 2))) | |
| 137 | (when (and meta (not (string= match meta))) | |
| 138 | (put-text-property 0 1 'meta | |
| 139 | (company-clang--strip-formatting meta) | |
| 140 | match))) | |
| 141 | (push match lines))) | |
| 142 | lines)) | |
| 143 | ||
| 144 | (defun company-clang--meta (candidate) | |
| 145 | (get-text-property 0 'meta candidate)) | |
| 146 | ||
| 147 | (defun company-clang--annotation (candidate) | |
| 148 | (let ((ann (company-clang--annotation-1 candidate))) | |
| 149 | (if (not (and ann (string-prefix-p "(*)" ann))) | |
| 150 | ann | |
| 151 | (with-temp-buffer | |
| 152 | (insert ann) | |
| 153 | (search-backward ")") | |
| 154 | (let ((pt (1+ (point)))) | |
| 155 | (re-search-forward ".\\_>" nil t) | |
| 156 | (delete-region pt (point))) | |
| 157 | (buffer-string))))) | |
| 158 | ||
| 159 | (defun company-clang--annotation-1 (candidate) | |
| 160 | (let ((meta (company-clang--meta candidate))) | |
| 161 | (cond | |
| 162 | ((null meta) nil) | |
| 163 | ((string-match "[^:]:[^:]" meta) | |
| 164 | (substring meta (1+ (match-beginning 0)))) | |
| 165 | ((string-match "(anonymous)" meta) nil) | |
| 166 | ((string-match "\\((.*)[ a-z]*\\'\\)" meta) | |
| 167 | (let ((paren (match-beginning 1))) | |
| 168 | (if (not (eq (aref meta (1- paren)) ?>)) | |
| 169 | (match-string 1 meta) | |
| 170 | (with-temp-buffer | |
| 171 | (insert meta) | |
| 172 | (goto-char paren) | |
| 173 | (substring meta (1- (search-backward "<")))))))))) | |
| 174 | ||
| 175 | (defun company-clang--strip-formatting (text) | |
| 176 | (replace-regexp-in-string | |
| 177 | "#]" " " | |
| 178 | (replace-regexp-in-string "[<{[]#\\|#[>}]" "" text t) | |
| 179 | t)) | |
| 180 | ||
| 181 | (defun company-clang--handle-error (res args) | |
| 182 | (goto-char (point-min)) | |
| 183 | (let* ((buf (get-buffer-create company-clang--error-buffer-name)) | |
| 184 | (cmd (concat company-clang-executable " " (mapconcat 'identity args " "))) | |
| 185 | (pattern (format company-clang--completion-pattern "")) | |
| 186 | (message-truncate-lines t) | |
| 187 | (err (if (re-search-forward pattern nil t) | |
| 188 | (buffer-substring-no-properties (point-min) | |
| 189 | (1- (match-beginning 0))) | |
| 190 | ;; Warn the user more aggressively if no match was found. | |
| 191 | (message "clang failed with error %d: %s" res cmd) | |
| 192 | (buffer-string)))) | |
| 193 | ||
| 194 | (with-current-buffer buf | |
| 195 | (let ((inhibit-read-only t)) | |
| 196 | (erase-buffer) | |
| 197 | (insert (current-time-string) | |
| 198 | (format "\nclang failed with error %d:\n" res) | |
| 199 | cmd "\n\n") | |
| 200 | (insert err) | |
| 201 | (setq buffer-read-only t) | |
| 202 | (goto-char (point-min)))))) | |
| 203 | ||
| 204 | (defun company-clang--start-process (prefix callback &rest args) | |
| 205 | (let* ((objc (derived-mode-p 'objc-mode)) | |
| 206 | (buf (get-buffer-create "*clang-output*")) | |
| 207 | ;; Looks unnecessary in Emacs 25.1 and later. | |
| 208 | (process-adaptive-read-buffering nil) | |
| 209 | (existing-process (get-buffer-process buf))) | |
| 210 | (when existing-process | |
| 211 | (kill-process existing-process)) | |
| 212 | (with-current-buffer buf | |
| 213 | (erase-buffer) | |
| 214 | (setq buffer-undo-list t)) | |
| 215 | (let* ((process-connection-type nil) | |
| 216 | (process (apply #'start-file-process "company-clang" buf | |
| 217 | company-clang-executable args))) | |
| 218 | (set-process-sentinel | |
| 219 | process | |
| 220 | (lambda (proc status) | |
| 221 | (unless (string-match-p "hangup\\|killed" status) | |
| 222 | (funcall | |
| 223 | callback | |
| 224 | (let ((res (process-exit-status proc))) | |
| 225 | (with-current-buffer buf | |
| 226 | (unless (eq 0 res) | |
| 227 | (company-clang--handle-error res args)) | |
| 228 | ;; Still try to get any useful input. | |
| 229 | (company-clang--parse-output prefix objc))))))) | |
| 230 | (unless (company-clang--auto-save-p) | |
| 231 | (send-region process (point-min) (point-max)) | |
| 232 | (send-string process "\n") | |
| 233 | (process-send-eof process))))) | |
| 234 | ||
| 235 | (defsubst company-clang--build-location (pos) | |
| 236 | (save-excursion | |
| 237 | (goto-char pos) | |
| 238 | (format "%s:%d:%d" | |
| 239 | (if (company-clang--auto-save-p) buffer-file-name "-") | |
| 240 | (line-number-at-pos) | |
| 241 | (1+ (length | |
| 242 | (encode-coding-region | |
| 243 | (line-beginning-position) | |
| 244 | (point) | |
| 245 | 'utf-8 | |
| 246 | t)))))) | |
| 247 | ||
| 248 | (defsubst company-clang--build-complete-args (pos) | |
| 249 | (append '("-fsyntax-only" "-Xclang" "-code-completion-macros") | |
| 250 | (unless (company-clang--auto-save-p) | |
| 251 | (list "-x" (company-clang--lang-option))) | |
| 252 | company-clang-arguments | |
| 253 | (when (stringp company-clang--prefix) | |
| 254 | (list "-include" (expand-file-name company-clang--prefix))) | |
| 255 | (list "-Xclang" (format "-code-completion-at=%s" | |
| 256 | (company-clang--build-location pos))) | |
| 257 | (list (if (company-clang--auto-save-p) buffer-file-name "-")))) | |
| 258 | ||
| 259 | (defun company-clang--candidates (prefix callback) | |
| 260 | (and (company-clang--auto-save-p) | |
| 261 | (buffer-modified-p) | |
| 262 | (basic-save-buffer)) | |
| 263 | (when (null company-clang--prefix) | |
| 264 | (company-clang-set-prefix (or (funcall company-clang-prefix-guesser) | |
| 265 | 'none))) | |
| 266 | (apply 'company-clang--start-process | |
| 267 | prefix | |
| 268 | callback | |
| 269 | (company-clang--build-complete-args | |
| 270 | (if (company-clang--check-version 4.0 9.0) | |
| 271 | (point) | |
| 272 | (- (point) (length prefix)))))) | |
| 273 | ||
| 274 | (defun company-clang--prefix () | |
| 275 | (if company-clang-begin-after-member-access | |
| 276 | (company-grab-symbol-cons "\\.\\|->\\|::" 2) | |
| 277 | (company-grab-symbol))) | |
| 278 | ||
| 279 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 280 | ||
| 281 | (defconst company-clang-required-version 1.1) | |
| 282 | ||
| 283 | (defvar company-clang--version nil) | |
| 284 | ||
| 285 | (defun company-clang--auto-save-p () | |
| 286 | (not | |
| 287 | (company-clang--check-version 2.9 3.1))) | |
| 288 | ||
| 289 | (defun company-clang--check-version (min apple-min) | |
| 290 | (pcase company-clang--version | |
| 291 | (`(apple . ,ver) (>= ver apple-min)) | |
| 292 | (`(normal . ,ver) (>= ver min)) | |
| 293 | (_ (error "pcase-exhaustive is not in Emacs 24.3!")))) | |
| 294 | ||
| 295 | (defsubst company-clang-version () | |
| 296 | "Return the version of `company-clang-executable'." | |
| 297 | (with-temp-buffer | |
| 298 | (call-process company-clang-executable nil t nil "--version") | |
| 299 | (goto-char (point-min)) | |
| 300 | (if (re-search-forward "\\(clang\\|Apple LLVM\\) version \\([0-9.]+\\)" nil t) | |
| 301 | (cons | |
| 302 | (if (equal (match-string-no-properties 1) "Apple LLVM") | |
| 303 | 'apple | |
| 304 | 'normal) | |
| 305 | (string-to-number (match-string-no-properties 2))) | |
| 306 | 0))) | |
| 307 | ||
| 308 | (defun company-clang (command &optional arg &rest ignored) | |
| 309 | "`company-mode' completion backend for Clang. | |
| 310 | Clang is a parser for C and ObjC. Clang version 1.1 or newer is required. | |
| 311 | ||
| 312 | Additional command line arguments can be specified in | |
| 313 | `company-clang-arguments'. Prefix files (-include ...) can be selected | |
| 314 | with `company-clang-set-prefix' or automatically through a custom | |
| 315 | `company-clang-prefix-guesser'. | |
| 316 | ||
| 317 | With Clang versions before 2.9, we have to save the buffer before | |
| 318 | performing completion. With Clang 2.9 and later, buffer contents are | |
| 319 | passed via standard input." | |
| 320 | (interactive (list 'interactive)) | |
| 321 | (cl-case command | |
| 322 | (interactive (company-begin-backend 'company-clang)) | |
| 323 | (init (when (memq major-mode company-clang-modes) | |
| 324 | (unless company-clang-executable | |
| 325 | (error "Company found no clang executable")) | |
| 326 | (setq company-clang--version (company-clang-version)) | |
| 327 | (unless (company-clang--check-version | |
| 328 | company-clang-required-version | |
| 329 | company-clang-required-version) | |
| 330 | (error "Company requires clang version %s" | |
| 331 | company-clang-required-version)))) | |
| 332 | (prefix (and (memq major-mode company-clang-modes) | |
| 333 | buffer-file-name | |
| 334 | company-clang-executable | |
| 335 | (not (company-in-string-or-comment)) | |
| 336 | (or (company-clang--prefix) 'stop))) | |
| 337 | (candidates (cons :async | |
| 338 | (lambda (cb) (company-clang--candidates arg cb)))) | |
| 339 | (meta (company-clang--meta arg)) | |
| 340 | (annotation (company-clang--annotation arg)) | |
| 341 | (post-completion (let ((anno (company-clang--annotation arg))) | |
| 342 | (when (and company-clang-insert-arguments anno) | |
| 343 | (insert anno) | |
| 344 | (if (string-match "\\`:[^:]" anno) | |
| 345 | (company-template-objc-templatify anno) | |
| 346 | (company-template-c-like-templatify | |
| 347 | (concat arg anno)))))))) | |
| 348 | ||
| 349 | (provide 'company-clang) | |
| 350 | ;;; company-clang.el ends here | |
