150
|
1 ;;; clang-include-fixer.el --- Emacs integration of the clang include fixer -*- lexical-binding: t; -*-
|
|
2
|
|
3 ;; Keywords: tools, c
|
|
4 ;; Package-Requires: ((cl-lib "0.5") (json "1.2") (let-alist "1.0.4"))
|
|
5
|
|
6 ;;; Commentary:
|
|
7
|
|
8 ;; This package allows Emacs users to invoke the 'clang-include-fixer' within
|
|
9 ;; Emacs. 'clang-include-fixer' provides an automated way of adding #include
|
|
10 ;; directives for missing symbols in one translation unit, see
|
|
11 ;; <http://clang.llvm.org/extra/clang-include-fixer.html>.
|
|
12
|
|
13 ;;; Code:
|
|
14
|
|
15 (require 'cl-lib)
|
|
16 (require 'json)
|
|
17 (require 'let-alist)
|
|
18
|
|
19 (defgroup clang-include-fixer nil
|
|
20 "Clang-based include fixer."
|
|
21 :group 'tools)
|
|
22
|
|
23 (defvar clang-include-fixer-add-include-hook nil
|
|
24 "A hook that will be called for every added include.
|
|
25 The first argument is the filename of the include, the second argument is
|
|
26 non-nil if the include is a system-header.")
|
|
27
|
|
28 (defcustom clang-include-fixer-executable
|
|
29 "clang-include-fixer"
|
|
30 "Location of the clang-include-fixer executable.
|
|
31
|
|
32 A string containing the name or the full path of the executable."
|
|
33 :group 'clang-include-fixer
|
|
34 :type '(file :must-match t)
|
|
35 :risky t)
|
|
36
|
|
37 (defcustom clang-include-fixer-input-format
|
|
38 'yaml
|
|
39 "Input format for clang-include-fixer.
|
|
40 This string is passed as -db argument to
|
|
41 `clang-include-fixer-executable'."
|
|
42 :group 'clang-include-fixer
|
|
43 :type '(radio
|
|
44 (const :tag "Hard-coded mapping" :fixed)
|
|
45 (const :tag "YAML" yaml)
|
|
46 (symbol :tag "Other"))
|
|
47 :risky t)
|
|
48
|
|
49 (defcustom clang-include-fixer-init-string
|
|
50 ""
|
|
51 "Database initialization string for clang-include-fixer.
|
|
52 This string is passed as -input argument to
|
|
53 `clang-include-fixer-executable'."
|
|
54 :group 'clang-include-fixer
|
|
55 :type 'string
|
|
56 :risky t)
|
|
57
|
|
58 (defface clang-include-fixer-highlight '((t :background "green"))
|
|
59 "Used for highlighting the symbol for which a header file is being added.")
|
|
60
|
|
61 ;;;###autoload
|
|
62 (defun clang-include-fixer ()
|
|
63 "Invoke the Include Fixer to insert missing C++ headers."
|
|
64 (interactive)
|
|
65 (message (concat "Calling the include fixer. "
|
|
66 "This might take some seconds. Please wait."))
|
|
67 (clang-include-fixer--start #'clang-include-fixer--add-header
|
|
68 "-output-headers"))
|
|
69
|
|
70 ;;;###autoload
|
|
71 (defun clang-include-fixer-at-point ()
|
|
72 "Invoke the Clang include fixer for the symbol at point."
|
|
73 (interactive)
|
|
74 (let ((symbol (clang-include-fixer--symbol-at-point)))
|
|
75 (unless symbol
|
|
76 (user-error "No symbol at current location"))
|
|
77 (clang-include-fixer-from-symbol symbol)))
|
|
78
|
|
79 ;;;###autoload
|
|
80 (defun clang-include-fixer-from-symbol (symbol)
|
|
81 "Invoke the Clang include fixer for the SYMBOL.
|
|
82 When called interactively, prompts the user for a symbol."
|
|
83 (interactive
|
|
84 (list (read-string "Symbol: " (clang-include-fixer--symbol-at-point))))
|
|
85 (clang-include-fixer--start #'clang-include-fixer--add-header
|
|
86 (format "-query-symbol=%s" symbol)))
|
|
87
|
|
88 (defun clang-include-fixer--start (callback &rest args)
|
|
89 "Asynchronously start clang-include-fixer with parameters ARGS.
|
|
90 The current file name is passed after ARGS as last argument. If
|
|
91 the call was successful the returned result is stored in a
|
|
92 temporary buffer, and CALLBACK is called with the temporary
|
|
93 buffer as only argument."
|
|
94 (unless buffer-file-name
|
|
95 (user-error "clang-include-fixer works only in buffers that visit a file"))
|
|
96 (let ((process (if (and (fboundp 'make-process)
|
|
97 ;; ‘make-process’ doesn’t support remote files
|
|
98 ;; (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28691).
|
|
99 (not (find-file-name-handler default-directory
|
|
100 'start-file-process)))
|
|
101 ;; Prefer using ‘make-process’ if possible, because
|
|
102 ;; ‘start-process’ doesn’t allow us to separate the
|
|
103 ;; standard error from the output.
|
|
104 (clang-include-fixer--make-process callback args)
|
|
105 (clang-include-fixer--start-process callback args))))
|
|
106 (save-restriction
|
|
107 (widen)
|
|
108 (process-send-region process (point-min) (point-max)))
|
|
109 (process-send-eof process))
|
|
110 nil)
|
|
111
|
|
112 (defun clang-include-fixer--make-process (callback args)
|
|
113 "Start a new clang-include-fixer process using `make-process'.
|
|
114 CALLBACK is called after the process finishes successfully; it is
|
|
115 called with a single argument, the buffer where standard output
|
|
116 has been inserted. ARGS is a list of additional command line
|
|
117 arguments. Return the new process object."
|
|
118 (let ((stdin (current-buffer))
|
|
119 (stdout (generate-new-buffer "*clang-include-fixer output*"))
|
|
120 (stderr (generate-new-buffer "*clang-include-fixer errors*")))
|
|
121 (make-process :name "clang-include-fixer"
|
|
122 :buffer stdout
|
|
123 :command (clang-include-fixer--command args)
|
|
124 :coding 'utf-8-unix
|
|
125 :noquery t
|
|
126 :connection-type 'pipe
|
|
127 :sentinel (clang-include-fixer--sentinel stdin stdout stderr
|
|
128 callback)
|
|
129 :stderr stderr)))
|
|
130
|
|
131 (defun clang-include-fixer--start-process (callback args)
|
|
132 "Start a new clang-include-fixer process using `start-file-process'.
|
|
133 CALLBACK is called after the process finishes successfully; it is
|
|
134 called with a single argument, the buffer where standard output
|
|
135 has been inserted. ARGS is a list of additional command line
|
|
136 arguments. Return the new process object."
|
|
137 (let* ((stdin (current-buffer))
|
|
138 (stdout (generate-new-buffer "*clang-include-fixer output*"))
|
|
139 (process-connection-type nil)
|
|
140 (process (apply #'start-file-process "clang-include-fixer" stdout
|
|
141 (clang-include-fixer--command args))))
|
|
142 (set-process-coding-system process 'utf-8-unix 'utf-8-unix)
|
|
143 (set-process-query-on-exit-flag process nil)
|
|
144 (set-process-sentinel process
|
|
145 (clang-include-fixer--sentinel stdin stdout nil
|
|
146 callback))
|
|
147 process))
|
|
148
|
|
149 (defun clang-include-fixer--command (args)
|
|
150 "Return the clang-include-fixer command line.
|
|
151 Returns a list; the first element is the binary to
|
|
152 execute (`clang-include-fixer-executable'), and the remaining
|
|
153 elements are the command line arguments. Adds proper arguments
|
|
154 for `clang-include-fixer-input-format' and
|
|
155 `clang-include-fixer-init-string'. Appends the current buffer's
|
|
156 file name; prepends ARGS directly in front of it."
|
|
157 (cl-check-type args list)
|
|
158 `(,clang-include-fixer-executable
|
|
159 ,(format "-db=%s" clang-include-fixer-input-format)
|
|
160 ,(format "-input=%s" clang-include-fixer-init-string)
|
|
161 "-stdin"
|
|
162 ,@args
|
|
163 ,(clang-include-fixer--file-local-name buffer-file-name)))
|
|
164
|
|
165 (defun clang-include-fixer--sentinel (stdin stdout stderr callback)
|
|
166 "Return a process sentinel for clang-include-fixer processes.
|
|
167 STDIN, STDOUT, and STDERR are buffers for the standard streams;
|
|
168 only STDERR may be nil. CALLBACK is called in the case of
|
|
169 success; it is called with a single argument, STDOUT. On
|
|
170 failure, a buffer containing the error output is displayed."
|
|
171 (cl-check-type stdin buffer-live)
|
|
172 (cl-check-type stdout buffer-live)
|
|
173 (cl-check-type stderr (or null buffer-live))
|
|
174 (cl-check-type callback function)
|
|
175 (lambda (process event)
|
|
176 (cl-check-type process process)
|
|
177 (cl-check-type event string)
|
|
178 (unwind-protect
|
|
179 (if (string-equal event "finished\n")
|
|
180 (progn
|
|
181 (when stderr (kill-buffer stderr))
|
|
182 (with-current-buffer stdin
|
|
183 (funcall callback stdout))
|
|
184 (kill-buffer stdout))
|
|
185 (when stderr (kill-buffer stdout))
|
|
186 (message "clang-include-fixer failed")
|
|
187 (with-current-buffer (or stderr stdout)
|
|
188 (insert "\nProcess " (process-name process)
|
|
189 ?\s event))
|
|
190 (display-buffer (or stderr stdout))))
|
|
191 nil))
|
|
192
|
|
193 (defun clang-include-fixer--replace-buffer (stdout)
|
|
194 "Replace current buffer by content of STDOUT."
|
|
195 (cl-check-type stdout buffer-live)
|
|
196 (barf-if-buffer-read-only)
|
|
197 (cond ((fboundp 'replace-buffer-contents) (replace-buffer-contents stdout))
|
|
198 ((clang-include-fixer--insert-line stdout (current-buffer)))
|
|
199 (t (erase-buffer) (insert-buffer-substring stdout)))
|
|
200 (message "Fix applied")
|
|
201 nil)
|
|
202
|
|
203 (defun clang-include-fixer--insert-line (from to)
|
|
204 "Insert a single missing line from the buffer FROM into TO.
|
|
205 FROM and TO must be buffers. If the contents of FROM and TO are
|
|
206 equal, do nothing and return non-nil. If FROM contains a single
|
|
207 line missing from TO, insert that line into TO so that the buffer
|
|
208 contents are equal and return non-nil. Otherwise, do nothing and
|
|
209 return nil. Buffer restrictions are ignored."
|
|
210 (cl-check-type from buffer-live)
|
|
211 (cl-check-type to buffer-live)
|
|
212 (with-current-buffer from
|
|
213 (save-excursion
|
|
214 (save-restriction
|
|
215 (widen)
|
|
216 (with-current-buffer to
|
|
217 (save-excursion
|
|
218 (save-restriction
|
|
219 (widen)
|
|
220 ;; Search for the first buffer difference.
|
|
221 (let ((chars (abs (compare-buffer-substrings to nil nil from nil nil))))
|
|
222 (if (zerop chars)
|
|
223 ;; Buffer contents are equal, nothing to do.
|
|
224 t
|
|
225 (goto-char chars)
|
|
226 ;; We might have ended up in the middle of a line if the
|
|
227 ;; current line partially matches. In this case we would
|
|
228 ;; have to insert more than a line. Move to the beginning of
|
|
229 ;; the line to avoid this situation.
|
|
230 (beginning-of-line)
|
|
231 (with-current-buffer from
|
|
232 (goto-char chars)
|
|
233 (beginning-of-line)
|
|
234 (let ((from-begin (point))
|
|
235 (from-end (progn (forward-line) (point)))
|
|
236 (to-point (with-current-buffer to (point))))
|
|
237 ;; Search for another buffer difference after the line in
|
|
238 ;; question. If there is none, we can proceed.
|
|
239 (when (zerop (compare-buffer-substrings from from-end nil
|
|
240 to to-point nil))
|
|
241 (with-current-buffer to
|
|
242 (insert-buffer-substring from from-begin from-end))
|
|
243 t))))))))))))
|
|
244
|
|
245 (defun clang-include-fixer--add-header (stdout)
|
|
246 "Analyse the result of clang-include-fixer stored in STDOUT.
|
|
247 Add a missing header if there is any. If there are multiple
|
|
248 possible headers the user can select one of them to be included.
|
|
249 Temporarily highlight the affected symbols. Asynchronously call
|
|
250 clang-include-fixer to insert the selected header."
|
|
251 (cl-check-type stdout buffer-live)
|
|
252 (let ((context (clang-include-fixer--parse-json stdout)))
|
|
253 (let-alist context
|
|
254 (cond
|
|
255 ((null .QuerySymbolInfos)
|
|
256 (message "The file is fine, no need to add a header."))
|
|
257 ((null .HeaderInfos)
|
|
258 (message "Couldn't find header for '%s'"
|
|
259 (let-alist (car .QuerySymbolInfos) .RawIdentifier)))
|
|
260 (t
|
|
261 ;; Users may C-g in prompts, make sure the process sentinel
|
|
262 ;; behaves correctly.
|
|
263 (with-local-quit
|
|
264 ;; Replace the HeaderInfos list by a single header selected by
|
|
265 ;; the user.
|
|
266 (clang-include-fixer--select-header context)
|
|
267 ;; Call clang-include-fixer again to insert the selected header.
|
|
268 (clang-include-fixer--start
|
|
269 (let ((old-tick (buffer-chars-modified-tick)))
|
|
270 (lambda (stdout)
|
|
271 (when (/= old-tick (buffer-chars-modified-tick))
|
|
272 ;; Replacing the buffer now would undo the user’s changes.
|
|
273 (user-error (concat "The buffer has been changed "
|
|
274 "before the header could be inserted")))
|
|
275 (clang-include-fixer--replace-buffer stdout)
|
|
276 (let-alist context
|
|
277 (let-alist (car .HeaderInfos)
|
|
278 (with-local-quit
|
|
279 (run-hook-with-args 'clang-include-fixer-add-include-hook
|
|
280 (substring .Header 1 -1)
|
|
281 (string= (substring .Header 0 1) "<")))))))
|
|
282 (format "-insert-header=%s"
|
|
283 (clang-include-fixer--encode-json context))))))))
|
|
284 nil)
|
|
285
|
|
286 (defun clang-include-fixer--select-header (context)
|
|
287 "Prompt the user for a header if necessary.
|
|
288 CONTEXT must be a clang-include-fixer context object in
|
|
289 association list format. If it contains more than one HeaderInfo
|
|
290 element, prompt the user to select one of the headers. CONTEXT
|
|
291 is modified to include only the selected element."
|
|
292 (cl-check-type context cons)
|
|
293 (let-alist context
|
|
294 (if (cdr .HeaderInfos)
|
|
295 (clang-include-fixer--prompt-for-header context)
|
|
296 (message "Only one include is missing: %s"
|
|
297 (let-alist (car .HeaderInfos) .Header))))
|
|
298 nil)
|
|
299
|
|
300 (defvar clang-include-fixer--history nil
|
|
301 "History for `clang-include-fixer--prompt-for-header'.")
|
|
302
|
|
303 (defun clang-include-fixer--prompt-for-header (context)
|
|
304 "Prompt the user for a single header.
|
|
305 The choices are taken from the HeaderInfo elements in CONTEXT.
|
|
306 They are replaced by the single element selected by the user."
|
|
307 (let-alist context
|
|
308 (let ((symbol (clang-include-fixer--symbol-name .QuerySymbolInfos))
|
|
309 ;; Add temporary highlighting so that the user knows which
|
|
310 ;; symbols the current session is about.
|
|
311 (overlays (remove nil
|
|
312 (mapcar #'clang-include-fixer--highlight .QuerySymbolInfos))))
|
|
313 (unwind-protect
|
|
314 (save-excursion
|
|
315 ;; While prompting, go to the closest overlay so that the user sees
|
|
316 ;; some context.
|
|
317 (when overlays
|
|
318 (goto-char (clang-include-fixer--closest-overlay overlays)))
|
|
319 (cl-flet ((header (info) (let-alist info .Header)))
|
|
320 ;; The header-infos is already sorted by clang-include-fixer.
|
|
321 (let* ((headers (mapcar #'header .HeaderInfos))
|
|
322 (header (completing-read
|
|
323 (clang-include-fixer--format-message
|
|
324 "Select include for '%s': " symbol)
|
|
325 headers nil :require-match nil
|
|
326 'clang-include-fixer--history
|
|
327 ;; Specify a default to prevent the behavior
|
|
328 ;; described in
|
|
329 ;; https://github.com/DarwinAwardWinner/ido-completing-read-plus#why-does-ret-sometimes-not-select-the-first-completion-on-the-list--why-is-there-an-empty-entry-at-the-beginning-of-the-completion-list--what-happened-to-old-style-default-selection.
|
|
330 (car headers)))
|
|
331 (info (cl-find header .HeaderInfos :key #'header :test #'string=)))
|
|
332 (unless info (user-error "No header selected"))
|
|
333 (setcar .HeaderInfos info)
|
|
334 (setcdr .HeaderInfos nil))))
|
|
335 (mapc #'delete-overlay overlays)))))
|
|
336
|
|
337 (defun clang-include-fixer--symbol-name (symbol-infos)
|
|
338 "Return the unique symbol name in SYMBOL-INFOS.
|
|
339 Raise a signal if the symbol name is not unique."
|
|
340 (let ((symbols (delete-dups (mapcar (lambda (info)
|
|
341 (let-alist info .RawIdentifier))
|
|
342 symbol-infos))))
|
|
343 (when (cdr symbols)
|
|
344 (error "Multiple symbols %s returned" symbols))
|
|
345 (car symbols)))
|
|
346
|
|
347 (defun clang-include-fixer--highlight (symbol-info)
|
|
348 "Add an overlay to highlight SYMBOL-INFO, if it points to a non-empty range.
|
|
349 Return the overlay object, or nil."
|
|
350 (let-alist symbol-info
|
|
351 (unless (zerop .Range.Length)
|
|
352 (let ((overlay (make-overlay
|
|
353 (clang-include-fixer--filepos-to-bufferpos
|
|
354 .Range.Offset 'approximate)
|
|
355 (clang-include-fixer--filepos-to-bufferpos
|
|
356 (+ .Range.Offset .Range.Length) 'approximate))))
|
|
357 (overlay-put overlay 'face 'clang-include-fixer-highlight)
|
|
358 overlay))))
|
|
359
|
|
360 (defun clang-include-fixer--closest-overlay (overlays)
|
|
361 "Return the start of the overlay in OVERLAYS that is closest to point."
|
|
362 (cl-check-type overlays cons)
|
|
363 (let ((point (point))
|
|
364 acc)
|
|
365 (dolist (overlay overlays acc)
|
|
366 (let ((start (overlay-start overlay)))
|
|
367 (when (or (null acc) (< (abs (- point start)) (abs (- point acc))))
|
|
368 (setq acc start))))))
|
|
369
|
|
370 (defun clang-include-fixer--parse-json (buffer)
|
|
371 "Parse a JSON response from clang-include-fixer in BUFFER.
|
|
372 Return the JSON object as an association list."
|
|
373 (with-current-buffer buffer
|
|
374 (save-excursion
|
|
375 (goto-char (point-min))
|
|
376 (let ((json-object-type 'alist)
|
|
377 (json-array-type 'list)
|
|
378 (json-key-type 'symbol)
|
|
379 (json-false :json-false)
|
|
380 (json-null nil)
|
|
381 (json-pre-element-read-function nil)
|
|
382 (json-post-element-read-function nil))
|
|
383 (json-read)))))
|
|
384
|
|
385 (defun clang-include-fixer--encode-json (object)
|
|
386 "Return the JSON representation of OBJECT as a string."
|
|
387 (let ((json-encoding-separator ",")
|
|
388 (json-encoding-default-indentation " ")
|
|
389 (json-encoding-pretty-print nil)
|
|
390 (json-encoding-lisp-style-closings nil)
|
|
391 (json-encoding-object-sort-predicate nil))
|
|
392 (json-encode object)))
|
|
393
|
|
394 (defun clang-include-fixer--symbol-at-point ()
|
|
395 "Return the qualified symbol at point.
|
|
396 If there is no symbol at point, return nil."
|
|
397 ;; Let ‘bounds-of-thing-at-point’ to do the hard work and deal with edge
|
|
398 ;; cases.
|
|
399 (let ((bounds (bounds-of-thing-at-point 'symbol)))
|
|
400 (when bounds
|
|
401 (let ((beg (car bounds))
|
|
402 (end (cdr bounds)))
|
|
403 (save-excursion
|
|
404 ;; Extend the symbol range to the left. Skip over namespace
|
|
405 ;; delimiters and parent namespace names.
|
|
406 (goto-char beg)
|
|
407 (while (and (clang-include-fixer--skip-double-colon-backward)
|
|
408 (skip-syntax-backward "w_")))
|
|
409 ;; Skip over one more namespace delimiter, for absolute names.
|
|
410 (clang-include-fixer--skip-double-colon-backward)
|
|
411 (setq beg (point))
|
|
412 ;; Extend the symbol range to the right. Skip over namespace
|
|
413 ;; delimiters and child namespace names.
|
|
414 (goto-char end)
|
|
415 (while (and (clang-include-fixer--skip-double-colon-forward)
|
|
416 (skip-syntax-forward "w_")))
|
|
417 (setq end (point)))
|
|
418 (buffer-substring-no-properties beg end)))))
|
|
419
|
|
420 (defun clang-include-fixer--skip-double-colon-forward ()
|
|
421 "Skip a double colon.
|
|
422 When the next two characters are '::', skip them and return
|
|
423 non-nil. Otherwise return nil."
|
|
424 (let ((end (+ (point) 2)))
|
|
425 (when (and (<= end (point-max))
|
|
426 (string-equal (buffer-substring-no-properties (point) end) "::"))
|
|
427 (goto-char end)
|
|
428 t)))
|
|
429
|
|
430 (defun clang-include-fixer--skip-double-colon-backward ()
|
|
431 "Skip a double colon.
|
|
432 When the previous two characters are '::', skip them and return
|
|
433 non-nil. Otherwise return nil."
|
|
434 (let ((beg (- (point) 2)))
|
|
435 (when (and (>= beg (point-min))
|
|
436 (string-equal (buffer-substring-no-properties beg (point)) "::"))
|
|
437 (goto-char beg)
|
|
438 t)))
|
|
439
|
|
440 ;; ‘filepos-to-bufferpos’ is new in Emacs 25.1. Provide a fallback for older
|
|
441 ;; versions.
|
|
442 (defalias 'clang-include-fixer--filepos-to-bufferpos
|
|
443 (if (fboundp 'filepos-to-bufferpos)
|
|
444 'filepos-to-bufferpos
|
|
445 (lambda (byte &optional _quality _coding-system)
|
|
446 (byte-to-position (1+ byte)))))
|
|
447
|
|
448 ;; ‘format-message’ is new in Emacs 25.1. Provide a fallback for older
|
|
449 ;; versions.
|
|
450 (defalias 'clang-include-fixer--format-message
|
|
451 (if (fboundp 'format-message) 'format-message 'format))
|
|
452
|
|
453 ;; ‘file-local-name’ is new in Emacs 26.1. Provide a fallback for older
|
|
454 ;; versions.
|
|
455 (defalias 'clang-include-fixer--file-local-name
|
|
456 (if (fboundp 'file-local-name) #'file-local-name
|
|
457 (lambda (file) (or (file-remote-p file 'localname) file))))
|
|
458
|
|
459 (provide 'clang-include-fixer)
|
|
460 ;;; clang-include-fixer.el ends here
|