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