1;;; clang-format.el --- Format code using clang-format  -*- lexical-binding: t; -*-
2
3;; Keywords: tools, c
4;; Package-Requires: ((cl-lib "0.3"))
5;; SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6
7;;; Commentary:
8
9;; This package allows to filter code through clang-format to fix its formatting.
10;; clang-format is a tool that formats C/C++/Obj-C code according to a set of
11;; style options, see <http://clang.llvm.org/docs/ClangFormatStyleOptions.html>.
12;; Note that clang-format 3.4 or newer is required.
13
14;; clang-format.el is available via MELPA and can be installed via
15;;
16;;   M-x package-install clang-format
17;;
18;; when ("melpa" . "http://melpa.org/packages/") is included in
19;; `package-archives'.  Alternatively, ensure the directory of this
20;; file is in your `load-path' and add
21;;
22;;   (require 'clang-format)
23;;
24;; to your .emacs configuration.
25
26;; You may also want to bind `clang-format-region' to a key:
27;;
28;;   (global-set-key [C-M-tab] 'clang-format-region)
29
30;;; Code:
31
32(require 'cl-lib)
33(require 'xml)
34
35(defgroup clang-format nil
36  "Format code using clang-format."
37  :group 'tools)
38
39(defcustom clang-format-executable
40  (or (executable-find "clang-format")
41      "clang-format")
42  "Location of the clang-format executable.
43
44A string containing the name or the full path of the executable."
45  :group 'clang-format
46  :type '(file :must-match t)
47  :risky t)
48
49(defcustom clang-format-style nil
50  "Style argument to pass to clang-format.
51
52By default clang-format will load the style configuration from
53a file named .clang-format located in one of the parent directories
54of the buffer."
55  :group 'clang-format
56  :type '(choice (string) (const nil))
57  :safe #'stringp)
58(make-variable-buffer-local 'clang-format-style)
59
60(defcustom clang-format-fallback-style "none"
61  "Fallback style to pass to clang-format.
62
63This style will be used if clang-format-style is set to \"file\"
64and no .clang-format is found in the directory of the buffer or
65one of parent directories. Set to \"none\" to disable formatting
66in such buffers."
67  :group 'clang-format
68  :type 'string
69  :safe #'stringp)
70(make-variable-buffer-local 'clang-format-fallback-style)
71
72(defun clang-format--extract (xml-node)
73  "Extract replacements and cursor information from XML-NODE."
74  (unless (and (listp xml-node) (eq (xml-node-name xml-node) 'replacements))
75    (error "Expected <replacements> node"))
76  (let ((nodes (xml-node-children xml-node))
77        (incomplete-format (xml-get-attribute xml-node 'incomplete_format))
78        replacements
79        cursor)
80    (dolist (node nodes)
81      (when (listp node)
82        (let* ((children (xml-node-children node))
83               (text (car children)))
84          (cl-case (xml-node-name node)
85            ('replacement
86             (let* ((offset (xml-get-attribute-or-nil node 'offset))
87                    (length (xml-get-attribute-or-nil node 'length)))
88               (when (or (null offset) (null length))
89                 (error "<replacement> node does not have offset and length attributes"))
90               (when (cdr children)
91                 (error "More than one child node in <replacement> node"))
92
93               (setq offset (string-to-number offset))
94               (setq length (string-to-number length))
95               (push (list offset length text) replacements)))
96            ('cursor
97             (setq cursor (string-to-number text)))))))
98
99    ;; Sort by decreasing offset, length.
100    (setq replacements (sort (delq nil replacements)
101                             (lambda (a b)
102                               (or (> (car a) (car b))
103                                   (and (= (car a) (car b))
104                                        (> (cadr a) (cadr b)))))))
105
106    (list replacements cursor (string= incomplete-format "true"))))
107
108(defun clang-format--replace (offset length &optional text)
109  "Replace the region defined by OFFSET and LENGTH with TEXT.
110OFFSET and LENGTH are measured in bytes, not characters.  OFFSET
111is a zero-based file offset, assuming ‘utf-8-unix’ coding."
112  (let ((start (clang-format--filepos-to-bufferpos offset 'exact 'utf-8-unix))
113        (end (clang-format--filepos-to-bufferpos (+ offset length) 'exact
114                                                 'utf-8-unix)))
115    (goto-char start)
116    (delete-region start end)
117    (when text
118      (insert text))))
119
120;; ‘bufferpos-to-filepos’ and ‘filepos-to-bufferpos’ are new in Emacs 25.1.
121;; Provide fallbacks for older versions.
122(defalias 'clang-format--bufferpos-to-filepos
123  (if (fboundp 'bufferpos-to-filepos)
124      'bufferpos-to-filepos
125    (lambda (position &optional _quality _coding-system)
126      (1- (position-bytes position)))))
127
128(defalias 'clang-format--filepos-to-bufferpos
129  (if (fboundp 'filepos-to-bufferpos)
130      'filepos-to-bufferpos
131    (lambda (byte &optional _quality _coding-system)
132      (byte-to-position (1+ byte)))))
133
134;;;###autoload
135(defun clang-format-region (start end &optional style assume-file-name)
136  "Use clang-format to format the code between START and END according to STYLE.
137If called interactively uses the region or the current statement if there is no
138no active region. If no STYLE is given uses `clang-format-style'. Use
139ASSUME-FILE-NAME to locate a style config file, if no ASSUME-FILE-NAME is given
140uses the function `buffer-file-name'."
141  (interactive
142   (if (use-region-p)
143       (list (region-beginning) (region-end))
144     (list (point) (point))))
145
146  (unless style
147    (setq style clang-format-style))
148
149  (unless assume-file-name
150    (setq assume-file-name (buffer-file-name (buffer-base-buffer))))
151
152  (let ((file-start (clang-format--bufferpos-to-filepos start 'approximate
153                                                        'utf-8-unix))
154        (file-end (clang-format--bufferpos-to-filepos end 'approximate
155                                                      'utf-8-unix))
156        (cursor (clang-format--bufferpos-to-filepos (point) 'exact 'utf-8-unix))
157        (temp-buffer (generate-new-buffer " *clang-format-temp*"))
158        (temp-file (make-temp-file "clang-format"))
159        ;; Output is XML, which is always UTF-8.  Input encoding should match
160        ;; the encoding used to convert between buffer and file positions,
161        ;; otherwise the offsets calculated above are off.  For simplicity, we
162        ;; always use ‘utf-8-unix’ and ignore the buffer coding system.
163        (default-process-coding-system '(utf-8-unix . utf-8-unix)))
164    (unwind-protect
165        (let ((status (apply #'call-process-region
166                             nil nil clang-format-executable
167                             nil `(,temp-buffer ,temp-file) nil
168                             `("-output-replacements-xml"
169                               ;; Guard against a nil assume-file-name.
170                               ;; If the clang-format option -assume-filename
171                               ;; is given a blank string it will crash as per
172                               ;; the following bug report
173                               ;; https://bugs.llvm.org/show_bug.cgi?id=34667
174                               ,@(and assume-file-name
175                                      (list "-assume-filename" assume-file-name))
176                               ,@(and style (list "-style" style))
177                               "-fallback-style" ,clang-format-fallback-style
178                               "-offset" ,(number-to-string file-start)
179                               "-length" ,(number-to-string (- file-end file-start))
180                               "-cursor" ,(number-to-string cursor))))
181              (stderr (with-temp-buffer
182                        (unless (zerop (cadr (insert-file-contents temp-file)))
183                          (insert ": "))
184                        (buffer-substring-no-properties
185                         (point-min) (line-end-position)))))
186          (cond
187           ((stringp status)
188            (error "(clang-format killed by signal %s%s)" status stderr))
189           ((not (zerop status))
190            (error "(clang-format failed with code %d%s)" status stderr)))
191
192          (cl-destructuring-bind (replacements cursor incomplete-format)
193              (with-current-buffer temp-buffer
194                (clang-format--extract (car (xml-parse-region))))
195            (save-excursion
196              (dolist (rpl replacements)
197                (apply #'clang-format--replace rpl)))
198            (when cursor
199              (goto-char (clang-format--filepos-to-bufferpos cursor 'exact
200                                                             'utf-8-unix)))
201            (if incomplete-format
202                (message "(clang-format: incomplete (syntax errors)%s)" stderr)
203              (message "(clang-format: success%s)" stderr))))
204      (delete-file temp-file)
205      (when (buffer-name temp-buffer) (kill-buffer temp-buffer)))))
206
207;;;###autoload
208(defun clang-format-buffer (&optional style assume-file-name)
209  "Use clang-format to format the current buffer according to STYLE.
210If no STYLE is given uses `clang-format-style'. Use ASSUME-FILE-NAME
211to locate a style config file. If no ASSUME-FILE-NAME is given uses
212the function `buffer-file-name'."
213  (interactive)
214  (clang-format-region (point-min) (point-max) style assume-file-name))
215
216;;;###autoload
217(defalias 'clang-format 'clang-format-region)
218
219(provide 'clang-format)
220;;; clang-format.el ends here
221