company-clang.el (16862B)
1 ;;; company-clang.el --- company-mode completion backend for Clang -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2009-2011, 2013-2023 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 <https://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, start automatic completion after member access operators. 43 44 Automatic completion starts whenever the current symbol is preceded by 45 \".\", \"->\" or \"::\", ignoring `company-minimum-prefix-length'. 46 47 If `company-begin-commands' is a list, it should include `c-electric-lt-gt' 48 and `c-electric-colon', for automatic completion right after \">\" and 49 \":\"." 50 :type 'boolean) 51 52 (defcustom company-clang-use-compile-flags-txt nil 53 "When non-nil, use flags from compile_flags.txt if present. 54 55 The lines from that files will be appended to `company-clang-arguments'. 56 57 And if such file is found, Clang is called from the directory containing 58 it. That allows the flags use relative file names within the project." 59 :type 'boolean 60 :safe 'booleanp) 61 62 (defcustom company-clang-arguments nil 63 "A list of additional arguments to pass to clang when completing. 64 Prefix files (-include ...) can be selected with `company-clang-set-prefix' 65 or automatically through a custom `company-clang-prefix-guesser'." 66 :type '(repeat (string :tag "Argument"))) 67 68 (defcustom company-clang-prefix-guesser 'company-clang-guess-prefix 69 "A function to determine the prefix file for the current buffer." 70 :type '(function :tag "Guesser function" nil)) 71 72 (defvar company-clang-modes '(c-mode c++-mode objc-mode) 73 "Major modes which clang may complete.") 74 75 (defcustom company-clang-insert-arguments t 76 "When non-nil, insert function arguments as a template after completion." 77 :type 'boolean 78 :package-version '(company . "0.8.0")) 79 80 ;; prefix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 81 82 (defvar company-clang--prefix nil) 83 84 (defsubst company-clang--guess-pch-file (file) 85 (let ((dir (directory-file-name (file-name-directory file)))) 86 (when (equal (file-name-nondirectory dir) "Classes") 87 (setq dir (file-name-directory dir))) 88 (car (directory-files dir t "\\([^.]h\\|[^h]\\).pch\\'" t)))) 89 90 (defsubst company-clang--file-substring (file beg end) 91 (with-temp-buffer 92 (insert-file-contents-literally file nil beg end) 93 (buffer-string))) 94 95 (defun company-clang-guess-prefix () 96 "Try to guess the prefix file for the current buffer." 97 ;; Prefixes seem to be called .pch. Pre-compiled headers do, too. 98 ;; So we look at the magic number to rule them out. 99 (let* ((file (company-clang--guess-pch-file buffer-file-name)) 100 (magic-number (and file (company-clang--file-substring file 0 4)))) 101 (unless (member magic-number '("CPCH" "gpch")) 102 file))) 103 104 (defun company-clang-set-prefix (&optional prefix) 105 "Use PREFIX as a prefix (-include ...) file for clang completion." 106 (interactive (let ((def (funcall company-clang-prefix-guesser))) 107 (unless (stringp def) 108 (setq def default-directory)) 109 (list (read-file-name "Prefix file: " 110 (when def (file-name-directory def)) 111 def t (when def (file-name-nondirectory def)))))) 112 ;; TODO: pre-compile? 113 (setq company-clang--prefix (and (stringp prefix) 114 (file-regular-p prefix) 115 prefix))) 116 117 ;; Clean-up on exit. 118 (add-hook 'kill-emacs-hook 'company-clang-set-prefix) 119 120 ;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 121 122 ;; Do we ever see OVERLOAD (or OVERRIDE)? 123 (defconst company-clang--completion-pattern 124 "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\|Pattern\\)\\(?:\\(?: (InBase)\\)? : \\(.*\\)$\\)?$") 125 126 (defconst company-clang--error-buffer-name "*clang-error*") 127 128 (defun company-clang--lang-option () 129 (if (eq major-mode 'objc-mode) 130 (if (string= "m" (file-name-extension buffer-file-name)) 131 "objective-c" "objective-c++") 132 (substring (symbol-name major-mode) 0 -5))) 133 134 (defun company-clang--parse-output (prefix _objc) 135 (goto-char (point-min)) 136 (let ((pattern (format company-clang--completion-pattern 137 (regexp-quote prefix))) 138 (case-fold-search nil) 139 (results (make-hash-table :test 'equal :size (/ (point-max) 100))) 140 lines) 141 (while (re-search-forward pattern nil t) 142 (let ((match (match-string-no-properties 1)) 143 (meta (match-string-no-properties 2))) 144 (when (equal match "Pattern") 145 (setq match (company-clang--pattern-to-match meta))) 146 (when (string-match ":" match) 147 (setq match (substring match 0 (match-beginning 0)))) 148 ;; Avoiding duplicates: 149 ;; https://github.com/company-mode/company-mode/issues/841 150 (cond 151 ;; Either meta != completion (not a macro) 152 ((not (equal match meta)) 153 (puthash match meta results)) 154 ;; Or it's the first time we see this completion 155 ((eq (gethash match results 'none) 'none) 156 (puthash match nil results))))) 157 (maphash 158 (lambda (match meta) 159 (when meta 160 (put-text-property 0 1 'meta (company-clang--strip-formatting meta) match)) 161 (push match lines)) 162 results) 163 lines)) 164 165 (defun company-clang--pattern-to-match (pat) 166 (let ((start 0) 167 (end nil)) 168 (when (string-match "#]" pat) 169 (setq start (match-end 0))) 170 (when (string-match "[ \(]<#" pat start) 171 (setq end (match-beginning 0))) 172 (substring pat start end))) 173 174 (defun company-clang--meta (candidate) 175 (get-text-property 0 'meta candidate)) 176 177 (defun company-clang--annotation (candidate) 178 (let ((ann (company-clang--annotation-1 candidate))) 179 (if (not (and ann (string-prefix-p "(*)" ann))) 180 ann 181 (with-temp-buffer 182 (insert ann) 183 (search-backward ")") 184 (let ((pt (1+ (point)))) 185 (re-search-forward ".\\_>" nil t) 186 (delete-region pt (point))) 187 (buffer-string))))) 188 189 ;; TODO: Parse the original formatting here, rather than guess. 190 ;; Strip it every time in the `meta' handler instead. 191 (defun company-clang--annotation-1 (candidate) 192 (let ((meta (company-clang--meta candidate))) 193 (cond 194 ((null meta) nil) 195 ((string-match "[^:]:[^:]" meta) 196 (substring meta (1+ (match-beginning 0)))) 197 ((string-match "(anonymous)" meta) nil) 198 ((string-match "\\((.*)[ a-z]*\\'\\)" meta) 199 (let ((paren (match-beginning 1))) 200 (if (not (eq (aref meta (1- paren)) ?>)) 201 (match-string 1 meta) 202 (with-temp-buffer 203 (insert meta) 204 (goto-char paren) 205 (substring meta (1- (search-backward "<")))))))))) 206 207 (defun company-clang--strip-formatting (text) 208 (replace-regexp-in-string 209 "#]" " " 210 (replace-regexp-in-string "[<{[]#\\|#[>}]" "" text t) 211 t)) 212 213 (defun company-clang--handle-error (res args) 214 (goto-char (point-min)) 215 (let* ((buf (get-buffer-create company-clang--error-buffer-name)) 216 (cmd (concat company-clang-executable " " (mapconcat 'identity args " "))) 217 (pattern (format company-clang--completion-pattern "")) 218 (message-truncate-lines t) 219 (err (if (and (re-search-forward pattern nil t) 220 ;; Something in the Windows build? 221 ;; Looks like Clang doesn't always include the error text 222 ;; before completions (even if exited with error). 223 (> (match-beginning 0) (point-min))) 224 (buffer-substring-no-properties (point-min) 225 (1- (match-beginning 0))) 226 ;; Warn the user more aggressively if no match was found. 227 (message "clang failed with error %d: %s" res cmd) 228 (buffer-string)))) 229 230 (with-current-buffer buf 231 (let ((inhibit-read-only t)) 232 (erase-buffer) 233 (insert (current-time-string) 234 (format "\nclang failed with error %d:\n" res) 235 cmd "\n\n") 236 (insert err) 237 (setq buffer-read-only t) 238 (goto-char (point-min)))))) 239 240 (defun company-clang--start-process (prefix callback &rest args) 241 (let* ((objc (derived-mode-p 'objc-mode)) 242 (buf (get-buffer-create "*clang-output*")) 243 ;; Looks unnecessary in Emacs 25.1 and later. 244 ;; (Inconclusive, needs more testing): 245 ;; https://github.com/company-mode/company-mode/pull/288#issuecomment-72491808 246 (process-adaptive-read-buffering nil) 247 (existing-process (get-buffer-process buf))) 248 (when existing-process 249 (kill-process existing-process)) 250 (with-current-buffer buf 251 (erase-buffer) 252 (setq buffer-undo-list t)) 253 (let* ((process-connection-type nil) 254 (process (apply #'start-file-process "company-clang" buf 255 company-clang-executable args))) 256 (set-process-sentinel 257 process 258 (lambda (proc status) 259 (unless (string-match-p "hangup\\|killed" status) 260 (funcall 261 callback 262 (let ((res (process-exit-status proc))) 263 (with-current-buffer buf 264 (unless (eq 0 res) 265 (company-clang--handle-error res args)) 266 ;; Still try to get any useful input. 267 (company-clang--parse-output prefix objc))))))) 268 (unless (company-clang--auto-save-p) 269 (send-region process (point-min) (point-max)) 270 (send-string process "\n") 271 (process-send-eof process))))) 272 273 (defsubst company-clang--build-location (pos) 274 (save-excursion 275 (goto-char pos) 276 (format "%s:%d:%d" 277 (if (company-clang--auto-save-p) buffer-file-name "-") 278 (line-number-at-pos) 279 (1+ (length 280 (encode-coding-region 281 (line-beginning-position) 282 (point) 283 'utf-8 284 t)))))) 285 286 (defsubst company-clang--build-complete-args (pos) 287 (append '("-fsyntax-only" "-Xclang" "-code-completion-macros") 288 (unless (company-clang--auto-save-p) 289 (list "-x" (company-clang--lang-option))) 290 (company-clang--arguments) 291 (when (stringp company-clang--prefix) 292 (list "-include" (expand-file-name company-clang--prefix))) 293 (list "-Xclang" (format "-code-completion-at=%s" 294 (company-clang--build-location pos))) 295 (list (if (company-clang--auto-save-p) buffer-file-name "-")))) 296 297 (defun company-clang--arguments () 298 (let ((fname "compile_flags.txt") 299 (args company-clang-arguments) 300 current-dir-rel) 301 (when company-clang-use-compile-flags-txt 302 (let ((dir (locate-dominating-file default-directory fname))) 303 (when dir 304 (setq current-dir-rel (file-relative-name default-directory dir)) 305 (setq default-directory dir) 306 (with-temp-buffer 307 (insert-file-contents fname) 308 (setq args 309 (append 310 args 311 (split-string (buffer-substring-no-properties 312 (point-min) (point-max)) 313 "[\n\r]+" 314 t 315 "[ \t]+")))) 316 (unless (equal current-dir-rel "./") 317 (push (format "-I%s" current-dir-rel) args))))) 318 args)) 319 320 (defun company-clang--candidates (prefix callback) 321 (and (company-clang--auto-save-p) 322 (buffer-modified-p) 323 (basic-save-buffer)) 324 (when (null company-clang--prefix) 325 (company-clang-set-prefix (or (funcall company-clang-prefix-guesser) 326 'none))) 327 (let ((default-directory default-directory)) 328 (apply 'company-clang--start-process 329 prefix 330 callback 331 (company-clang--build-complete-args 332 (if (company-clang--check-version 4.0 9.0) 333 (point) 334 (- (point) (length prefix))))))) 335 336 (defun company-clang--prefix () 337 (if company-clang-begin-after-member-access 338 (company-grab-symbol-cons "\\.\\|->\\|::" 2) 339 (company-grab-symbol))) 340 341 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 342 343 (defconst company-clang-required-version 1.1) 344 345 (defvar company-clang--version nil) 346 347 (defun company-clang--auto-save-p () 348 (not 349 (company-clang--check-version 2.9 3.1))) 350 351 (defun company-clang--check-version (min apple-min) 352 (pcase-exhaustive company-clang--version 353 (`(apple . ,ver) (>= ver apple-min)) 354 (`(normal . ,ver) (>= ver min)))) 355 356 (defsubst company-clang-version () 357 "Return the version of `company-clang-executable'." 358 (with-temp-buffer 359 (call-process company-clang-executable nil t nil "--version") 360 (goto-char (point-min)) 361 (if (re-search-forward 362 "\\(clang\\|Apple LLVM\\|bcc32x\\|bcc64\\) version \\([0-9.]+\\)" nil t) 363 (cons 364 (if (equal (match-string-no-properties 1) "Apple LLVM") 365 'apple 366 'normal) 367 (string-to-number (match-string-no-properties 2))) 368 0))) 369 370 (defun company-clang (command &optional arg &rest _ignored) 371 "`company-mode' completion backend for Clang. 372 Clang is a parser for C and ObjC. Clang version 1.1 or newer is required. 373 374 Additional command line arguments can be specified in 375 `company-clang-arguments'. Prefix files (-include ...) can be selected 376 with `company-clang-set-prefix' or automatically through a custom 377 `company-clang-prefix-guesser'. 378 379 With Clang versions before 2.9, we have to save the buffer before 380 performing completion. With Clang 2.9 and later, buffer contents are 381 passed via standard input." 382 (interactive (list 'interactive)) 383 (cl-case command 384 (interactive (company-begin-backend 'company-clang)) 385 (init (when (memq major-mode company-clang-modes) 386 (unless company-clang-executable 387 (error "Company found no clang executable")) 388 (setq company-clang--version (company-clang-version)) 389 (unless (company-clang--check-version 390 company-clang-required-version 391 company-clang-required-version) 392 (error "Company requires clang version %s" 393 company-clang-required-version)))) 394 (prefix (and (memq major-mode company-clang-modes) 395 buffer-file-name 396 company-clang-executable 397 (not (company-in-string-or-comment)) 398 (or (company-clang--prefix) 'stop))) 399 (candidates (cons :async 400 (lambda (cb) (company-clang--candidates arg cb)))) 401 (meta (company-clang--meta arg)) 402 (kind (company-clang--kind arg)) 403 (annotation (company-clang--annotation arg)) 404 (post-completion (let ((anno (company-clang--annotation arg))) 405 (when (and company-clang-insert-arguments anno) 406 (insert anno) 407 (if (string-match "\\`:[^:]" anno) 408 (company-template-objc-templatify anno) 409 (company-template-c-like-templatify 410 (concat arg anno)))))))) 411 412 (defun company-clang--kind (arg) 413 ;; XXX: Not very precise. 414 ;; E.g. it will say that an arg-less ObjC method is a variable (perhaps we 415 ;; could look around for brackets, etc, if there any actual users who's 416 ;; bothered by it). 417 ;; And we can't distinguish between local vars and struct fields. 418 ;; Or between keywords and macros. 419 (let ((meta (company-clang--meta arg))) 420 (cond 421 ((null meta) 'keyword) 422 ((string-match "(" meta) 423 (if (string-match-p (format "\\`%s *\\'" (regexp-quote arg)) 424 (substring meta 0 (match-beginning 0))) 425 'keyword ; Also macro, actually (no return type). 426 'function)) 427 (t 'variable)))) 428 429 (provide 'company-clang) 430 ;;; company-clang.el ends here