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 (decl)
300 (narrow-to-region (gobject-align--decl-identifier-start decl)
301 (gobject-align--decl-arglist-end decl))
302 (goto-char (point-min))
303 (while (re-search-forward "\n" nil t)
304 (replace-match " ")))
306 (narrow-to-region (gobject-align--decl-start decl)
307 (gobject-align--decl-end decl))
308 (goto-char (point-min))
309 (while (re-search-forward "\\s-+" nil t)
310 (replace-match " ")))))
312 (defun gobject-align--arglist-region-at-point (point)
316 (c-beginning-of-statement-1)
317 (c-backward-syntactic-ws)
318 (unless (eq ?\( (preceding-char))
319 (error "No containing argument list"))
325 (error "No closing parenthesis")))
327 (list start (point)))))
330 (defun gobject-align-set-column (symbol)
331 "Set alignment column of SYMBOL."
333 (let ((symbol-name (completing-read "Symbol to change: "
336 "arglist-identifier-start")
338 (list (intern (format "gobject-align-%s-column" symbol-name)))))
339 (set symbol (current-column)))
341 (defun gobject-align--scan-decls (beg end)
344 (narrow-to-region beg end)
345 (goto-char (point-min))
348 (let (decl-start decl-end decl)
349 (c-forward-syntactic-ws)
350 (setq decl-start (point-marker))
352 (setq decl-end (point-marker))
353 (setq decl (gobject-align--parse-decl decl-start decl-end))
358 (defun gobject-align--guess-columns (beg end)
359 (let ((buffer (current-buffer))
362 (insert-buffer-substring-no-properties buffer beg end)
364 (setq decls (gobject-align--scan-decls (point-min) (point-max)))
365 (mapc #'gobject-align--normalize-decl decls)
366 (let* ((identifier-start-column
367 (gobject-align--decls-identifier-start-column
369 (arglist-start-column
370 (gobject-align--decls-arglist-start-column
371 decls identifier-start-column))
372 (arglist-identifier-start-column
373 (gobject-align--decls-arglist-identifier-start-column
374 decls (+ (length "(") arglist-start-column))))
376 "identifier-start: %d, arglist-start: %d, arglist-identifier-start: %d"
377 identifier-start-column
379 arglist-identifier-start-column)
380 (list (cons 'identifier-start-column
381 identifier-start-column)
382 (cons 'arglist-start-column
383 arglist-start-column)
384 (cons 'arglist-identifier-start-column
385 arglist-identifier-start-column))))))
388 (defun gobject-align-guess-columns (beg end)
389 "Guess the alignment rule from the function declarations in BEG and END"
391 (let ((columns (gobject-align--guess-columns beg end)))
392 (setq gobject-align-identifier-start-column
393 (cdr (assq 'identifier-start-column columns))
394 gobject-align-arglist-start-column
395 (cdr (assq 'arglist-start-column columns))
396 gobject-align-arglist-identifier-start-column
397 (cdr (assq 'arglist-identifier-start-column columns)))))
400 (defun gobject-align-region (beg end)
401 "Reformat function declarations in the region between BEG and END."
406 (narrow-to-region beg end)
407 (unless (and gobject-align-identifier-start-column
408 gobject-align-arglist-start-column
409 gobject-align-arglist-identifier-start-column)
410 (let ((columns (gobject-align--guess-columns beg end)))
411 (unless gobject-align-identifier-start-column
412 (setq gobject-align-identifier-start-column
413 (cdr (assq 'identifier-start-column columns))))
414 (unless gobject-align-arglist-start-column
415 (setq gobject-align-arglist-start-column
416 (cdr (assq 'arglist-start-column columns))))
417 (unless gobject-align-arglist-identifier-start-column
418 (setq gobject-align-arglist-identifier-start-column
419 (cdr (assq 'arglist-identifier-start-column columns))))))
420 (setq decls (gobject-align--scan-decls beg end))
421 (mapc #'gobject-align--normalize-decl decls)
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
438 (provide 'gobject-align)
440 ;;; gobject-align.el ends here