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

Chizi123
2018-11-18 21067e7cbe6d7a0f65ff5c317a96b5c337b0b3d8
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