annotate clang-tools-extra/clang-include-fixer/tool/clang-include-fixer.el @ 160:dbfec6499728

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