1;;; clang-include-fixer.el --- Emacs integration of the clang include fixer -*- lexical-binding: t; -*- 2 3;; Version: 0.1.0 4;; Keywords: tools, c 5;; 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' within 10;; Emacs. 'clang-include-fixer' provides an automated way of adding #include 11;; directives for missing symbols in one translation unit, see 12;; <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 nil 21 "Clang-based include fixer." 22 :group 'tools) 23 24(defvar clang-include-fixer-add-include-hook nil 25 "A hook that will be called for every added include. 26The first argument is the filename of the include, the second argument is 27non-nil if the include is a system-header.") 28 29(defcustom clang-include-fixer-executable 30 "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-fixer 35 :type '(file :must-match t) 36 :risky t) 37 38(defcustom clang-include-fixer-input-format 39 'yaml 40 "Input format for clang-include-fixer. 41This string is passed as -db argument to 42`clang-include-fixer-executable'." 43 :group 'clang-include-fixer 44 :type '(radio 45 (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-string 51 "" 52 "Database initialization string for clang-include-fixer. 53This string is passed as -input argument to 54`clang-include-fixer-executable'." 55 :group 'clang-include-fixer 56 :type 'string 57 :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;;;###autoload 63(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-header 69 "-output-headers")) 70 71;;;###autoload 72(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 symbol 77 (user-error "No symbol at current location")) 78 (clang-include-fixer-from-symbol symbol))) 79 80;;;###autoload 81(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 (interactive 85 (list (read-string "Symbol: " (clang-include-fixer--symbol-at-point)))) 86 (clang-include-fixer--start #'clang-include-fixer--add-header 87 (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. If 92the call was successful the returned result is stored in a 93temporary buffer, and CALLBACK is called with the temporary 94buffer as only argument." 95 (unless buffer-file-name 96 (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 files 99 ;; (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28691). 100 (not (find-file-name-handler default-directory 101 'start-file-process))) 102 ;; Prefer using ‘make-process’ if possible, because 103 ;; ‘start-process’ doesn’t allow us to separate the 104 ;; standard error from the output. 105 (clang-include-fixer--make-process callback args) 106 (clang-include-fixer--start-process callback args)))) 107 (save-restriction 108 (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 is 116called with a single argument, the buffer where standard output 117has been inserted. ARGS is a list of additional command line 118arguments. 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 stdout 124 :command (clang-include-fixer--command args) 125 :coding 'utf-8-unix 126 :noquery t 127 :connection-type 'pipe 128 :sentinel (clang-include-fixer--sentinel stdin stdout stderr 129 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 is 135called with a single argument, the buffer where standard output 136has been inserted. ARGS is a list of additional command line 137arguments. 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" stdout 142 (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 process 146 (clang-include-fixer--sentinel stdin stdout nil 147 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 to 153execute (`clang-include-fixer-executable'), and the remaining 154elements are the command line arguments. Adds proper arguments 155for `clang-include-fixer-input-format' and 156`clang-include-fixer-init-string'. Appends the current buffer's 157file name; prepends ARGS directly in front of it." 158 (cl-check-type args list) 159 `(,clang-include-fixer-executable 160 ,(format "-db=%s" clang-include-fixer-input-format) 161 ,(format "-input=%s" clang-include-fixer-init-string) 162 "-stdin" 163 ,@args 164 ,(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 of 170success; it is called with a single argument, STDOUT. On 171failure, 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-protect 180 (if (string-equal event "finished\n") 181 (progn 182 (when stderr (kill-buffer stderr)) 183 (with-current-buffer stdin 184 (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 are 207equal, do nothing and return non-nil. If FROM contains a single 208line missing from TO, insert that line into TO so that the buffer 209contents are equal and return non-nil. Otherwise, do nothing and 210return nil. Buffer restrictions are ignored." 211 (cl-check-type from buffer) 212 (cl-check-type to buffer) 213 (with-current-buffer from 214 (save-excursion 215 (save-restriction 216 (widen) 217 (with-current-buffer to 218 (save-excursion 219 (save-restriction 220 (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 t 226 (goto-char chars) 227 ;; We might have ended up in the middle of a line if the 228 ;; current line partially matches. In this case we would 229 ;; have to insert more than a line. Move to the beginning of 230 ;; the line to avoid this situation. 231 (beginning-of-line) 232 (with-current-buffer from 233 (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 in 239 ;; question. If there is none, we can proceed. 240 (when (zerop (compare-buffer-substrings from from-end nil 241 to to-point nil)) 242 (with-current-buffer to 243 (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 multiple 249possible headers the user can select one of them to be included. 250Temporarily highlight the affected symbols. Asynchronously call 251clang-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 context 255 (cond 256 ((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 (t 262 ;; Users may C-g in prompts, make sure the process sentinel 263 ;; behaves correctly. 264 (with-local-quit 265 ;; Replace the HeaderInfos list by a single header selected by 266 ;; the user. 267 (clang-include-fixer--select-header context) 268 ;; Call clang-include-fixer again to insert the selected header. 269 (clang-include-fixer--start 270 (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 context 278 (let-alist (car .HeaderInfos) 279 (with-local-quit 280 (run-hook-with-args 'clang-include-fixer-add-include-hook 281 (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 in 290association list format. If it contains more than one HeaderInfo 291element, prompt the user to select one of the headers. CONTEXT 292is modified to include only the selected element." 293 (cl-check-type context cons) 294 (let-alist context 295 (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 nil 302 "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 context 309 (let ((symbol (clang-include-fixer--symbol-name .QuerySymbolInfos)) 310 ;; Add temporary highlighting so that the user knows which 311 ;; symbols the current session is about. 312 (overlays (remove nil 313 (mapcar #'clang-include-fixer--highlight .QuerySymbolInfos)))) 314 (unwind-protect 315 (save-excursion 316 ;; While prompting, go to the closest overlay so that the user sees 317 ;; some context. 318 (when overlays 319 (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-read 324 (clang-include-fixer--format-message 325 "Select include for '%s': " symbol) 326 headers nil :require-match nil 327 'clang-include-fixer--history 328 ;; Specify a default to prevent the behavior 329 ;; described in 330 ;; 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-info 352 (unless (zerop .Range.Length) 353 (let ((overlay (make-overlay 354 (clang-include-fixer--filepos-to-bufferpos 355 .Range.Offset 'approximate) 356 (clang-include-fixer--filepos-to-bufferpos 357 (+ .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 buffer 375 (save-excursion 376 (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 edge 399 ;; cases. 400 (let ((bounds (bounds-of-thing-at-point 'symbol))) 401 (when bounds 402 (let ((beg (car bounds)) 403 (end (cdr bounds))) 404 (save-excursion 405 ;; Extend the symbol range to the left. Skip over namespace 406 ;; 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 namespace 414 ;; 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 return 424non-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 return 434non-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 older 442;; versions. 443(defalias 'clang-include-fixer--filepos-to-bufferpos 444 (if (fboundp 'filepos-to-bufferpos) 445 'filepos-to-bufferpos 446 (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 older 450;; versions. 451(defalias 'clang-include-fixer--format-message 452 (if (fboundp 'format-message) 'format-message 'format)) 453 454;; ‘file-local-name’ is new in Emacs 26.1. Provide a fallback for older 455;; versions. 456(defalias 'clang-include-fixer--file-local-name 457 (if (fboundp 'file-local-name) #'file-local-name 458 (lambda (file) (or (file-remote-p file 'localname) file)))) 459 460(provide 'clang-include-fixer) 461;;; clang-include-fixer.el ends here 462