462 lines · plain
1;;; clang-include-fixer.el --- Emacs integration of the clang include fixer -*- lexical-binding: t; -*-2 3;; Version: 0.1.04;; Keywords: tools, c5;; Package-Requires: ((cl-lib "0.5") (json "1.2") (let-alist "1.0.4"))6 7;;; Commentary:8 9;; This package allows Emacs users to invoke the 'clang-include-fixer' within10;; Emacs. 'clang-include-fixer' provides an automated way of adding #include11;; directives for missing symbols in one translation unit, see12;; <http://clang.llvm.org/extra/clang-include-fixer.html>.13 14;;; Code:15 16(require 'cl-lib)17(require 'json)18(require 'let-alist)19 20(defgroup clang-include-fixer nil21 "Clang-based include fixer."22 :group 'tools)23 24(defvar clang-include-fixer-add-include-hook nil25 "A hook that will be called for every added include.26The first argument is the filename of the include, the second argument is27non-nil if the include is a system-header.")28 29(defcustom clang-include-fixer-executable30 "clang-include-fixer"31 "Location of the clang-include-fixer executable.32 33A string containing the name or the full path of the executable."34 :group 'clang-include-fixer35 :type '(file :must-match t)36 :risky t)37 38(defcustom clang-include-fixer-input-format39 'yaml40 "Input format for clang-include-fixer.41This string is passed as -db argument to42`clang-include-fixer-executable'."43 :group 'clang-include-fixer44 :type '(radio45 (const :tag "Hard-coded mapping" :fixed)46 (const :tag "YAML" yaml)47 (symbol :tag "Other"))48 :risky t)49 50(defcustom clang-include-fixer-init-string51 ""52 "Database initialization string for clang-include-fixer.53This string is passed as -input argument to54`clang-include-fixer-executable'."55 :group 'clang-include-fixer56 :type 'string57 :risky t)58 59(defface clang-include-fixer-highlight '((t :background "green"))60 "Used for highlighting the symbol for which a header file is being added.")61 62;;;###autoload63(defun clang-include-fixer ()64 "Invoke the Include Fixer to insert missing C++ headers."65 (interactive)66 (message (concat "Calling the include fixer. "67 "This might take some seconds. Please wait."))68 (clang-include-fixer--start #'clang-include-fixer--add-header69 "-output-headers"))70 71;;;###autoload72(defun clang-include-fixer-at-point ()73 "Invoke the Clang include fixer for the symbol at point."74 (interactive)75 (let ((symbol (clang-include-fixer--symbol-at-point)))76 (unless symbol77 (user-error "No symbol at current location"))78 (clang-include-fixer-from-symbol symbol)))79 80;;;###autoload81(defun clang-include-fixer-from-symbol (symbol)82 "Invoke the Clang include fixer for the SYMBOL.83When called interactively, prompts the user for a symbol."84 (interactive85 (list (read-string "Symbol: " (clang-include-fixer--symbol-at-point))))86 (clang-include-fixer--start #'clang-include-fixer--add-header87 (format "-query-symbol=%s" symbol)))88 89(defun clang-include-fixer--start (callback &rest args)90 "Asynchronously start clang-include-fixer with parameters ARGS.91The current file name is passed after ARGS as last argument. If92the call was successful the returned result is stored in a93temporary buffer, and CALLBACK is called with the temporary94buffer as only argument."95 (unless buffer-file-name96 (user-error "clang-include-fixer works only in buffers that visit a file"))97 (let ((process (if (and (fboundp 'make-process)98 ;; ‘make-process’ doesn’t support remote files99 ;; (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28691).100 (not (find-file-name-handler default-directory101 'start-file-process)))102 ;; Prefer using ‘make-process’ if possible, because103 ;; ‘start-process’ doesn’t allow us to separate the104 ;; standard error from the output.105 (clang-include-fixer--make-process callback args)106 (clang-include-fixer--start-process callback args))))107 (save-restriction108 (widen)109 (process-send-region process (point-min) (point-max)))110 (process-send-eof process))111 nil)112 113(defun clang-include-fixer--make-process (callback args)114 "Start a new clang-include-fixer process using `make-process'.115CALLBACK is called after the process finishes successfully; it is116called with a single argument, the buffer where standard output117has been inserted. ARGS is a list of additional command line118arguments. Return the new process object."119 (let ((stdin (current-buffer))120 (stdout (generate-new-buffer "*clang-include-fixer output*"))121 (stderr (generate-new-buffer "*clang-include-fixer errors*")))122 (make-process :name "clang-include-fixer"123 :buffer stdout124 :command (clang-include-fixer--command args)125 :coding 'utf-8-unix126 :noquery t127 :connection-type 'pipe128 :sentinel (clang-include-fixer--sentinel stdin stdout stderr129 callback)130 :stderr stderr)))131 132(defun clang-include-fixer--start-process (callback args)133 "Start a new clang-include-fixer process using `start-file-process'.134CALLBACK is called after the process finishes successfully; it is135called with a single argument, the buffer where standard output136has been inserted. ARGS is a list of additional command line137arguments. Return the new process object."138 (let* ((stdin (current-buffer))139 (stdout (generate-new-buffer "*clang-include-fixer output*"))140 (process-connection-type nil)141 (process (apply #'start-file-process "clang-include-fixer" stdout142 (clang-include-fixer--command args))))143 (set-process-coding-system process 'utf-8-unix 'utf-8-unix)144 (set-process-query-on-exit-flag process nil)145 (set-process-sentinel process146 (clang-include-fixer--sentinel stdin stdout nil147 callback))148 process))149 150(defun clang-include-fixer--command (args)151 "Return the clang-include-fixer command line.152Returns a list; the first element is the binary to153execute (`clang-include-fixer-executable'), and the remaining154elements are the command line arguments. Adds proper arguments155for `clang-include-fixer-input-format' and156`clang-include-fixer-init-string'. Appends the current buffer's157file name; prepends ARGS directly in front of it."158 (cl-check-type args list)159 `(,clang-include-fixer-executable160 ,(format "-db=%s" clang-include-fixer-input-format)161 ,(format "-input=%s" clang-include-fixer-init-string)162 "-stdin"163 ,@args164 ,(clang-include-fixer--file-local-name buffer-file-name)))165 166(defun clang-include-fixer--sentinel (stdin stdout stderr callback)167 "Return a process sentinel for clang-include-fixer processes.168STDIN, STDOUT, and STDERR are buffers for the standard streams;169only STDERR may be nil. CALLBACK is called in the case of170success; it is called with a single argument, STDOUT. On171failure, a buffer containing the error output is displayed."172 (cl-check-type stdin buffer)173 (cl-check-type stdout buffer)174 (cl-check-type stderr (or null buffer))175 (cl-check-type callback function)176 (lambda (process event)177 (cl-check-type process process)178 (cl-check-type event string)179 (unwind-protect180 (if (string-equal event "finished\n")181 (progn182 (when stderr (kill-buffer stderr))183 (with-current-buffer stdin184 (funcall callback stdout))185 (kill-buffer stdout))186 (when stderr (kill-buffer stdout))187 (message "clang-include-fixer failed")188 (with-current-buffer (or stderr stdout)189 (insert "\nProcess " (process-name process)190 ?\s event))191 (display-buffer (or stderr stdout))))192 nil))193 194(defun clang-include-fixer--replace-buffer (stdout)195 "Replace current buffer by content of STDOUT."196 (cl-check-type stdout buffer)197 (barf-if-buffer-read-only)198 (cond ((fboundp 'replace-buffer-contents) (replace-buffer-contents stdout))199 ((clang-include-fixer--insert-line stdout (current-buffer)))200 (t (erase-buffer) (insert-buffer-substring stdout)))201 (message "Fix applied")202 nil)203 204(defun clang-include-fixer--insert-line (from to)205 "Insert a single missing line from the buffer FROM into TO.206FROM and TO must be buffers. If the contents of FROM and TO are207equal, do nothing and return non-nil. If FROM contains a single208line missing from TO, insert that line into TO so that the buffer209contents are equal and return non-nil. Otherwise, do nothing and210return nil. Buffer restrictions are ignored."211 (cl-check-type from buffer)212 (cl-check-type to buffer)213 (with-current-buffer from214 (save-excursion215 (save-restriction216 (widen)217 (with-current-buffer to218 (save-excursion219 (save-restriction220 (widen)221 ;; Search for the first buffer difference.222 (let ((chars (abs (compare-buffer-substrings to nil nil from nil nil))))223 (if (zerop chars)224 ;; Buffer contents are equal, nothing to do.225 t226 (goto-char chars)227 ;; We might have ended up in the middle of a line if the228 ;; current line partially matches. In this case we would229 ;; have to insert more than a line. Move to the beginning of230 ;; the line to avoid this situation.231 (beginning-of-line)232 (with-current-buffer from233 (goto-char chars)234 (beginning-of-line)235 (let ((from-begin (point))236 (from-end (progn (forward-line) (point)))237 (to-point (with-current-buffer to (point))))238 ;; Search for another buffer difference after the line in239 ;; question. If there is none, we can proceed.240 (when (zerop (compare-buffer-substrings from from-end nil241 to to-point nil))242 (with-current-buffer to243 (insert-buffer-substring from from-begin from-end))244 t))))))))))))245 246(defun clang-include-fixer--add-header (stdout)247 "Analyse the result of clang-include-fixer stored in STDOUT.248Add a missing header if there is any. If there are multiple249possible headers the user can select one of them to be included.250Temporarily highlight the affected symbols. Asynchronously call251clang-include-fixer to insert the selected header."252 (cl-check-type stdout buffer-live)253 (let ((context (clang-include-fixer--parse-json stdout)))254 (let-alist context255 (cond256 ((null .QuerySymbolInfos)257 (message "The file is fine, no need to add a header."))258 ((null .HeaderInfos)259 (message "Couldn't find header for '%s'"260 (let-alist (car .QuerySymbolInfos) .RawIdentifier)))261 (t262 ;; Users may C-g in prompts, make sure the process sentinel263 ;; behaves correctly.264 (with-local-quit265 ;; Replace the HeaderInfos list by a single header selected by266 ;; the user.267 (clang-include-fixer--select-header context)268 ;; Call clang-include-fixer again to insert the selected header.269 (clang-include-fixer--start270 (let ((old-tick (buffer-chars-modified-tick)))271 (lambda (stdout)272 (when (/= old-tick (buffer-chars-modified-tick))273 ;; Replacing the buffer now would undo the user’s changes.274 (user-error (concat "The buffer has been changed "275 "before the header could be inserted")))276 (clang-include-fixer--replace-buffer stdout)277 (let-alist context278 (let-alist (car .HeaderInfos)279 (with-local-quit280 (run-hook-with-args 'clang-include-fixer-add-include-hook281 (substring .Header 1 -1)282 (string= (substring .Header 0 1) "<")))))))283 (format "-insert-header=%s"284 (clang-include-fixer--encode-json context))))))))285 nil)286 287(defun clang-include-fixer--select-header (context)288 "Prompt the user for a header if necessary.289CONTEXT must be a clang-include-fixer context object in290association list format. If it contains more than one HeaderInfo291element, prompt the user to select one of the headers. CONTEXT292is modified to include only the selected element."293 (cl-check-type context cons)294 (let-alist context295 (if (cdr .HeaderInfos)296 (clang-include-fixer--prompt-for-header context)297 (message "Only one include is missing: %s"298 (let-alist (car .HeaderInfos) .Header))))299 nil)300 301(defvar clang-include-fixer--history nil302 "History for `clang-include-fixer--prompt-for-header'.")303 304(defun clang-include-fixer--prompt-for-header (context)305 "Prompt the user for a single header.306The choices are taken from the HeaderInfo elements in CONTEXT.307They are replaced by the single element selected by the user."308 (let-alist context309 (let ((symbol (clang-include-fixer--symbol-name .QuerySymbolInfos))310 ;; Add temporary highlighting so that the user knows which311 ;; symbols the current session is about.312 (overlays (remove nil313 (mapcar #'clang-include-fixer--highlight .QuerySymbolInfos))))314 (unwind-protect315 (save-excursion316 ;; While prompting, go to the closest overlay so that the user sees317 ;; some context.318 (when overlays319 (goto-char (clang-include-fixer--closest-overlay overlays)))320 (cl-flet ((header (info) (let-alist info .Header)))321 ;; The header-infos is already sorted by clang-include-fixer.322 (let* ((headers (mapcar #'header .HeaderInfos))323 (header (completing-read324 (clang-include-fixer--format-message325 "Select include for '%s': " symbol)326 headers nil :require-match nil327 'clang-include-fixer--history328 ;; Specify a default to prevent the behavior329 ;; described in330 ;; 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.331 (car headers)))332 (info (cl-find header .HeaderInfos :key #'header :test #'string=)))333 (unless info (user-error "No header selected"))334 (setcar .HeaderInfos info)335 (setcdr .HeaderInfos nil))))336 (mapc #'delete-overlay overlays)))))337 338(defun clang-include-fixer--symbol-name (symbol-infos)339 "Return the unique symbol name in SYMBOL-INFOS.340Raise a signal if the symbol name is not unique."341 (let ((symbols (delete-dups (mapcar (lambda (info)342 (let-alist info .RawIdentifier))343 symbol-infos))))344 (when (cdr symbols)345 (error "Multiple symbols %s returned" symbols))346 (car symbols)))347 348(defun clang-include-fixer--highlight (symbol-info)349 "Add an overlay to highlight SYMBOL-INFO, if it points to a non-empty range.350Return the overlay object, or nil."351 (let-alist symbol-info352 (unless (zerop .Range.Length)353 (let ((overlay (make-overlay354 (clang-include-fixer--filepos-to-bufferpos355 .Range.Offset 'approximate)356 (clang-include-fixer--filepos-to-bufferpos357 (+ .Range.Offset .Range.Length) 'approximate))))358 (overlay-put overlay 'face 'clang-include-fixer-highlight)359 overlay))))360 361(defun clang-include-fixer--closest-overlay (overlays)362 "Return the start of the overlay in OVERLAYS that is closest to point."363 (cl-check-type overlays cons)364 (let ((point (point))365 acc)366 (dolist (overlay overlays acc)367 (let ((start (overlay-start overlay)))368 (when (or (null acc) (< (abs (- point start)) (abs (- point acc))))369 (setq acc start))))))370 371(defun clang-include-fixer--parse-json (buffer)372 "Parse a JSON response from clang-include-fixer in BUFFER.373Return the JSON object as an association list."374 (with-current-buffer buffer375 (save-excursion376 (goto-char (point-min))377 (let ((json-object-type 'alist)378 (json-array-type 'list)379 (json-key-type 'symbol)380 (json-false :json-false)381 (json-null nil)382 (json-pre-element-read-function nil)383 (json-post-element-read-function nil))384 (json-read)))))385 386(defun clang-include-fixer--encode-json (object)387 "Return the JSON representation of OBJECT as a string."388 (let ((json-encoding-separator ",")389 (json-encoding-default-indentation " ")390 (json-encoding-pretty-print nil)391 (json-encoding-lisp-style-closings nil)392 (json-encoding-object-sort-predicate nil))393 (json-encode object)))394 395(defun clang-include-fixer--symbol-at-point ()396 "Return the qualified symbol at point.397If there is no symbol at point, return nil."398 ;; Let ‘bounds-of-thing-at-point’ to do the hard work and deal with edge399 ;; cases.400 (let ((bounds (bounds-of-thing-at-point 'symbol)))401 (when bounds402 (let ((beg (car bounds))403 (end (cdr bounds)))404 (save-excursion405 ;; Extend the symbol range to the left. Skip over namespace406 ;; delimiters and parent namespace names.407 (goto-char beg)408 (while (and (clang-include-fixer--skip-double-colon-backward)409 (skip-syntax-backward "w_")))410 ;; Skip over one more namespace delimiter, for absolute names.411 (clang-include-fixer--skip-double-colon-backward)412 (setq beg (point))413 ;; Extend the symbol range to the right. Skip over namespace414 ;; delimiters and child namespace names.415 (goto-char end)416 (while (and (clang-include-fixer--skip-double-colon-forward)417 (skip-syntax-forward "w_")))418 (setq end (point)))419 (buffer-substring-no-properties beg end)))))420 421(defun clang-include-fixer--skip-double-colon-forward ()422 "Skip a double colon.423When the next two characters are '::', skip them and return424non-nil. Otherwise return nil."425 (let ((end (+ (point) 2)))426 (when (and (<= end (point-max))427 (string-equal (buffer-substring-no-properties (point) end) "::"))428 (goto-char end)429 t)))430 431(defun clang-include-fixer--skip-double-colon-backward ()432 "Skip a double colon.433When the previous two characters are '::', skip them and return434non-nil. Otherwise return nil."435 (let ((beg (- (point) 2)))436 (when (and (>= beg (point-min))437 (string-equal (buffer-substring-no-properties beg (point)) "::"))438 (goto-char beg)439 t)))440 441;; ‘filepos-to-bufferpos’ is new in Emacs 25.1. Provide a fallback for older442;; versions.443(defalias 'clang-include-fixer--filepos-to-bufferpos444 (if (fboundp 'filepos-to-bufferpos)445 'filepos-to-bufferpos446 (lambda (byte &optional _quality _coding-system)447 (byte-to-position (1+ byte)))))448 449;; ‘format-message’ is new in Emacs 25.1. Provide a fallback for older450;; versions.451(defalias 'clang-include-fixer--format-message452 (if (fboundp 'format-message) 'format-message 'format))453 454;; ‘file-local-name’ is new in Emacs 26.1. Provide a fallback for older455;; versions.456(defalias 'clang-include-fixer--file-local-name457 (if (fboundp 'file-local-name) #'file-local-name458 (lambda (file) (or (file-remote-p file 'localname) file))))459 460(provide 'clang-include-fixer)461;;; clang-include-fixer.el ends here462