1 ;; gobject-align.el --- GObject-style alignment -*- lexical-binding: t; -*-
2 ;; Copyright (C) 2016 Daiki Ueno <ueno@gnu.org>
4 ;; Author: Daiki Ueno <ueno@gnu.org>
5 ;; Keywords: GObject, C, coding style
7 ;; This file is not part of GNU Emacs.
9 ;; This program is free software: you can redistribute it and/or
10 ;; modify it under the terms of the GNU General Public License as
11 ;; published by the Free Software Foundation, either version 3 of the
12 ;; License, or (at your option) any later version.
14 ;; This program is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program. If not, see
21 ;; <http://www.gnu.org/licenses/>.
28 (defvar gobject-align-max-column 80)
30 (defvar gobject-align-identifier-start-column nil)
31 (make-variable-buffer-local 'gobject-align-identifier-start-column)
33 (defvar gobject-align-arglist-start-column nil)
34 (make-variable-buffer-local 'gobject-align-arglist-start-column)
36 (defvar gobject-align-arglist-identifier-start-column nil)
37 (make-variable-buffer-local 'gobject-align-arglist-identifier-start-column)
39 (cl-defstruct (gobject-align--argument
41 (:constructor gobject-align--make-argument (type-start
47 (type-start nil :read-only t)
48 (type-end nil :read-only t)
49 (identifier-start nil :read-only t)
50 (identifier-end nil :read-only t))
52 (defun gobject-align--marker-column (marker)
57 (defun gobject-align--indent-to-column (column)
58 ;; Prefer 'char **foo' than 'char ** foo'
59 (when (looking-back "\*+" nil t)
60 (setq column (- column (- (match-end 0) (match-beginning 0))))
61 (goto-char (match-beginning 0)))
62 (let (indent-tabs-mode)
63 (indent-to-column column)))
65 (defun gobject-align--argument-type-width (arg)
66 (- (gobject-align--marker-column (gobject-align--argument-type-end arg))
67 (gobject-align--marker-column (gobject-align--argument-type-start arg))))
69 (defun gobject-align--arglist-identifier-start-column (arglist start-column)
70 (let ((column start-column)
72 (dolist (argument arglist)
73 (setq argument-column (+ start-column
74 (gobject-align--argument-type-width argument)))
75 (when (gobject-align--argument-identifier-start argument)
77 (goto-char (gobject-align--argument-identifier-start argument))
78 (when (eq (preceding-char) ? )
79 (setq argument-column (1+ argument-column)))))
80 (when (> argument-column column)
81 (setq column argument-column)))
84 (defun gobject-align--argument-identifier-width (argument)
85 (if (gobject-align--argument-identifier-start argument)
86 (- (gobject-align--marker-column
87 (gobject-align--argument-identifier-end argument))
88 (gobject-align--marker-column
89 (gobject-align--argument-identifier-start argument)))
92 (defun gobject-align--arglist-identifier-width (arglist)
95 (dolist (argument arglist)
96 (setq argument-width (gobject-align--argument-identifier-width argument))
97 (when (> argument-width width)
98 (setq width argument-width)))
101 (defun gobject-align--normalize-arglist (beg end)
104 (narrow-to-region beg end)
105 (goto-char (point-min))
106 (while (re-search-forward "\\s-+" nil t)
108 (goto-char (point-min))
109 (while (re-search-forward "\\s-*," nil t)
110 (replace-match ",\n"))
111 (goto-char (point-min))
112 (delete-trailing-whitespace)
113 ;; Remove whitespace at the beginning of line
114 (goto-char (point-min))
115 (while (re-search-forward "^\\s-+" nil t)
117 ;; Remove empty lines
118 (goto-char (point-min))
119 (delete-matching-lines "^$"))))
121 (defun gobject-align--parse-arglist (beg end)
124 (narrow-to-region beg end)
132 (goto-char (point-max))
134 (c-backward-syntactic-ws)
135 (setq identifier-end (point-marker))
136 ;; Array argument, such as 'int a[]'
137 (if (eq (preceding-char) ?\])
140 (setq identifier-start (point-marker))
141 (c-backward-syntactic-ws)
142 (if (or (bobp) (eq (preceding-char) ?,))
143 ;; Identifier is omitted, or '...'.
144 (setq type-start identifier-start
145 type-end identifier-end
148 (setq type-end (point-marker)
149 last-token-start type-end)
150 (while (and (not (bobp))
153 (unless (eq (setq c (char-after)) ?,)
154 (setq last-token-start (point-marker)))))
155 (c-backward-syntactic-ws))
156 (setq type-start last-token-start))
157 (push (gobject-align--make-argument type-start type-end
158 identifier-start identifier-end)
163 (defun gobject-align-at-point (&optional identifier-start-column)
164 "Reformat argument list at point, aligning argument to the right end."
167 (let* (start-column arglist)
168 (cl-destructuring-bind (beg end)
169 (gobject-align--arglist-region-at-point (point))
171 (setq start-column (current-column))
173 (narrow-to-region beg end)
174 (setq arglist (gobject-align--parse-arglist (point-min) (point-max)))
175 (gobject-align--normalize-arglist (point-min) (point-max))
176 (unless identifier-start-column
177 (setq identifier-start-column
178 (gobject-align--arglist-identifier-start-column arglist 0)))
179 (dolist (argument arglist)
180 (goto-char (gobject-align--argument-type-start argument))
181 (let ((column (if (bobp) 0 start-column)))
183 (gobject-align--indent-to-column start-column))
184 (when (gobject-align--argument-identifier-start argument)
185 (setq column (+ column identifier-start-column))
186 (goto-char (gobject-align--argument-identifier-start argument))
187 (gobject-align--indent-to-column column)))))))))
189 (cl-defstruct (gobject-align--decl
191 (:constructor gobject-align--make-decl (start
200 (start nil :read-only t)
201 (end nil :read-only t)
202 (identifier-start nil :read-only t)
203 (identifier-end nil :read-only t)
204 (arglist-start nil :read-only t)
205 (arglist-end nil :read-only t)
206 (arglist nil :read-only t))
208 (defun gobject-align--decls-identifier-start-column (decls start-column)
209 (let ((column start-column)
212 (setq decl-column (+ start-column
213 (gobject-align--marker-column
214 (gobject-align--decl-identifier-start decl))))
215 (when (and (<= decl-column gobject-align-max-column)
216 (> decl-column column))
217 (setq column decl-column)))
220 (defun gobject-align--decl-identifier-width (decl)
221 (- (gobject-align--marker-column
222 (gobject-align--decl-identifier-end decl))
223 (gobject-align--marker-column
224 (gobject-align--decl-identifier-start decl))))
226 (defun gobject-align--decls-arglist-start-column (decls start-column)
227 (let ((column start-column)
230 (+ (gobject-align--decls-arglist-identifier-start-column decls 0)
231 (gobject-align--decls-arglist-identifier-width decls)
234 (setq decl-column (+ start-column
235 (gobject-align--decl-identifier-width decl)))
236 (when (and (<= (+ decl-column arglist-width)
237 gobject-align-max-column)
238 (> decl-column column))
239 (setq column decl-column)))
242 (defun gobject-align--decls-arglist-identifier-width (decls)
246 (setq decl-width (gobject-align--arglist-identifier-width
247 (gobject-align--decl-arglist decl)))
248 (when (> decl-width width)
249 (setq width decl-width)))
252 (defun gobject-align--decls-arglist-identifier-start-column (decls start-column)
253 (let ((column start-column)
256 (setq decl-column (gobject-align--arglist-identifier-start-column
257 (gobject-align--decl-arglist decl)
259 ;; FIXME: should wrap lines inside argument list?
260 (when (> decl-column column)
261 (setq column decl-column)))
264 (defun gobject-align--parse-decl (beg end)
265 ;; Parse at most one func declaration found in BEG END.
268 (narrow-to-region beg end)
273 (goto-char (point-min))
274 (c-forward-syntactic-ws)
276 "typedef\\|#\\|G_DECLARE_\\(?:\\(?:FINAL\\|DECLARATIVE\\)_TYPE\\|INTERFACE\\)")
277 (while (and (not (eobp))
278 (not (eq (char-after) ?\()))
280 (c-forward-syntactic-ws))
281 (when (eq (char-after) ?\()
282 (setq arglist-start (point-marker))
283 (c-backward-syntactic-ws)
284 (setq identifier-end (point-marker))
286 (setq identifier-start (point-marker))
287 (goto-char arglist-start)
289 (setq arglist-end (point-marker))
290 (gobject-align--make-decl beg end
291 identifier-start identifier-end
292 arglist-start arglist-end
293 (gobject-align--parse-arglist
295 (1- arglist-end)))))))))
297 (defun gobject-align--normalize-decl (beg end)
300 (narrow-to-region beg end)
301 (goto-char (point-min))
302 (while (re-search-forward "\n" (1- (point-max)) t)
304 (goto-char (point-min))
305 (while (re-search-forward "\\s-+" nil t)
306 (replace-match " ")))))
308 (defun gobject-align--arglist-region-at-point (point)
312 (c-beginning-of-statement-1)
313 (c-backward-syntactic-ws)
314 (unless (eq ?\( (preceding-char))
315 (error "No containing argument list"))
321 (error "No closing parenthesis")))
323 (list start (point)))))
326 (defun gobject-align-set-column (symbol)
327 "Set alignment column of SYMBOL."
329 (let ((symbol-name (completing-read "Symbol to change: "
332 "arglist-identifier-start")
334 (list (intern (format "gobject-align-%s-column" symbol-name)))))
335 (set symbol (current-column)))
337 (defun gobject-align--scan-decls (beg end)
340 (narrow-to-region beg end)
341 (goto-char (point-min))
344 (let (decl-start decl-end decl)
345 (c-forward-syntactic-ws)
346 (setq decl-start (point-marker))
348 (setq decl-end (point-marker))
349 (setq decl (gobject-align--parse-decl decl-start decl-end))
354 (defun gobject-align--guess-columns (beg end)
355 (let ((buffer (current-buffer))
358 (insert-buffer-substring-no-properties buffer beg end)
360 (setq decls (gobject-align--scan-decls (point-min) (point-max)))
362 (gobject-align--normalize-decl (gobject-align--decl-start decl)
363 (gobject-align--decl-end decl)))
364 (let* ((identifier-start-column
365 (gobject-align--decls-identifier-start-column
367 (arglist-start-column
368 (gobject-align--decls-arglist-start-column
369 decls identifier-start-column))
370 (arglist-identifier-start-column
371 (gobject-align--decls-arglist-identifier-start-column
372 decls arglist-start-column)))
374 "identifier-start: %d, arglist-start: %d, arglist-identifier-start: %d"
375 identifier-start-column
377 arglist-identifier-start-column)
378 (list (cons 'identifier-start-column
379 identifier-start-column)
380 (cons 'arglist-start-column
381 arglist-start-column)
382 (cons 'arglist-identifier-start-column
383 arglist-identifier-start-column))))))
386 (defun gobject-align-guess-columns (beg end)
387 "Guess the alignment rule from the function declarations in BEG and END"
389 (let ((columns (gobject-align--guess-columns beg end)))
390 (setq gobject-align-identifier-start-column
391 (cdr (assq 'identifier-start-column columns))
392 gobject-align-arglist-start-column
393 (cdr (assq 'arglist-start-column columns))
394 gobject-align-arglist-identifier-start-column
395 (cdr (assq 'arglist-identifier-start-column columns)))))
398 (defun gobject-align-region (beg end)
399 "Reformat function declarations in the region between BEG and END."
404 (narrow-to-region beg end)
405 (unless (and gobject-align-identifier-start-column
406 gobject-align-arglist-start-column
407 gobject-align-arglist-identifier-start-column)
408 (let ((columns (gobject-align--guess-columns beg end)))
409 (unless gobject-align-identifier-start-column
410 (setq gobject-align-identifier-start-column
411 (cdr (assq 'identifier-start-column columns))))
412 (unless gobject-align-arglist-start-column
413 (setq gobject-align-arglist-start-column
414 (cdr (assq 'arglist-start-column columns))))
415 (unless gobject-align-arglist-identifier-start-column
416 (setq gobject-align-arglist-identifier-start-column
417 (cdr (assq 'arglist-identifier-start-column columns))))))
418 (setq decls (gobject-align--scan-decls beg end))
420 (gobject-align--normalize-decl (gobject-align--decl-start decl)
421 (gobject-align--decl-end decl)))
423 (goto-char (gobject-align--decl-identifier-start decl))
424 (gobject-align--indent-to-column
425 gobject-align-identifier-start-column)
426 (goto-char (gobject-align--decl-identifier-end decl))
427 (when (> (current-column) gobject-align-arglist-start-column)
429 (goto-char (gobject-align--decl-arglist-start decl))
430 (gobject-align--indent-to-column
431 gobject-align-arglist-start-column)
433 (gobject-align-at-point
434 (- gobject-align-arglist-identifier-start-column
435 gobject-align-arglist-start-column)))))))
437 (provide 'gobject-align)
439 ;;; gobject-align.el ends here