code.delx.au - gnu-emacs-elpa/blob - packages/gnome-c-style/gnome-c-align.el

   1 ;; gnome-c-align.el --- GNOME-style code alignment -*- lexical-binding: t; -*-
   2 ;; Copyright (C) 2016 Free Software Foundation, Inc.
   3
   4 ;; Author: Daiki Ueno <ueno@gnu.org>
   5 ;; Keywords: GNOME, C, coding style
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Code:
  23
  24 (require 'cc-mode)
  25 (require 'cl-lib)
  26
  27 (defcustom gnome-c-align-max-column 80
  28   "Maximum number of columns per line."
  29   :type '(choice (integer :tag "Columns")
  30                  (const :tag "No wrap"))
  31   :group 'gnome-c-style)
  32
  33 (defvar gnome-c-align-identifier-start-column nil)
  34 (make-variable-buffer-local 'gnome-c-align-identifier-start-column)
  35
  36 (defvar gnome-c-align-arglist-start-column nil)
  37 (make-variable-buffer-local 'gnome-c-align-arglist-start-column)
  38
  39 (defvar gnome-c-align-arglist-identifier-start-column nil)
  40 (make-variable-buffer-local 'gnome-c-align-arglist-identifier-start-column)
  41
  42 (cl-defstruct (gnome-c-align--argument
  43                (:constructor nil)
  44                (:constructor gnome-c-align--make-argument (type-start
  45                                                            type-identifier-end
  46                                                            type-end
  47                                                            identifier-start
  48                                                            identifier-end))
  49                (:copier nil)
  50                (:predicate nil))
  51   (type-start nil :read-only t)
  52   (type-identifier-end nil :read-only t)
  53   (type-end nil :read-only t)
  54   (identifier-start nil :read-only t)
  55   (identifier-end nil :read-only t))
  56
  57 (defun gnome-c-align--marker-column (marker)
  58   (save-excursion
  59     (goto-char marker)
  60     (current-column)))
  61
  62 (defun gnome-c-align--indent-to-column (column)
  63   ;; Prefer 'char **foo' than 'char ** foo'
  64   (when (looking-back "\\*+" nil t)
  65     (setq column (- column (- (match-end 0) (match-beginning 0))))
  66     (goto-char (match-beginning 0)))
  67   ;; FIXME: should respect indent-tabs-mode?
  68   (let (indent-tabs-mode)
  69     (indent-to-column column)))
  70
  71 (defun gnome-c-align--argument-type-width (arg)
  72   (- (gnome-c-align--marker-column (gnome-c-align--argument-type-end arg))
  73      (gnome-c-align--marker-column (gnome-c-align--argument-type-start arg))))
  74
  75 (defun gnome-c-align--argument-type-identifier-width (arg)
  76   (- (gnome-c-align--marker-column
  77       (gnome-c-align--argument-type-identifier-end arg))
  78      (gnome-c-align--marker-column
  79       (gnome-c-align--argument-type-start arg))))
  80
  81 (defun gnome-c-align--arglist-identifier-start-column (arglist start-column)
  82   (let ((max-type-identifier-width
  83          (apply #'max
  84                 0
  85                 (mapcar #'gnome-c-align--argument-type-identifier-width
  86                         arglist)))
  87         (max-extra-width
  88          (apply #'max
  89                 0
  90                 (mapcar
  91                  (lambda (argument)
  92                    (- (gnome-c-align--argument-type-end argument)
  93                       (gnome-c-align--argument-type-identifier-end argument)))
  94                  arglist))))
  95     (+ start-column max-type-identifier-width max-extra-width)))
  96
  97 (defun gnome-c-align--argument-identifier-width (argument)
  98   (if (gnome-c-align--argument-identifier-start argument)
  99       (- (gnome-c-align--marker-column
 100           (gnome-c-align--argument-identifier-end argument))
 101          (gnome-c-align--marker-column
 102           (gnome-c-align--argument-identifier-start argument)))
 103     0))
 104
 105 (defun gnome-c-align--arglist-identifier-width (arglist)
 106   (apply #'max 0 (mapcar #'gnome-c-align--argument-identifier-width arglist)))
 107
 108 (defun gnome-c-align--normalize-arglist-region (arglist beg end)
 109   (save-excursion
 110     (save-restriction
 111       (narrow-to-region beg end)
 112       (goto-char (point-min))
 113       (while (re-search-forward "\\s-+" nil t)
 114         (replace-match " "))
 115       (goto-char (point-min))
 116       (while (re-search-forward "\\s-*," nil t)
 117         (replace-match ",\n"))
 118       (goto-char (point-min))
 119       (delete-trailing-whitespace)
 120       ;; Remove whitespace at the beginning of line
 121       (goto-char (point-min))
 122       (while (re-search-forward "^\\s-+" nil t)
 123         (replace-match ""))
 124       ;; Remove empty lines
 125       (goto-char (point-min))
 126       (delete-matching-lines "^$")
 127       ;; 'int * * * foo' -> 'int ***foo'
 128       (dolist (argument arglist)
 129         (goto-char (gnome-c-align--argument-type-end argument))
 130         (while (re-search-backward
 131                 "\\(\\*+\\)\\s-+"
 132                 (gnome-c-align--argument-type-identifier-end argument)
 133                 t)
 134           (replace-match "\\1"))
 135         (when (gnome-c-align--argument-identifier-start argument)
 136           (goto-char (gnome-c-align--argument-identifier-start argument))
 137           (if (looking-back "\\* " nil)
 138               (delete-char -1)))
 139         (goto-char (gnome-c-align--argument-type-end argument))))))
 140
 141 (defun gnome-c-align--parse-arglist (beg end)
 142   (save-excursion
 143     (save-restriction
 144       (narrow-to-region beg end)
 145       (let (type-start
 146             type-identifier-end
 147             type-end
 148             identifier-start
 149             identifier-end
 150             arglist
 151             last-token-start)
 152         (goto-char (point-max))
 153         (while (not (bobp))
 154           (c-backward-syntactic-ws)
 155           (setq identifier-end (point-marker))
 156           ;; Array argument, such as 'int a[]'
 157           (if (eq (preceding-char) ?\])
 158               (c-backward-sexp))
 159           (c-backward-token-2)
 160           (setq identifier-start (point-marker))
 161           (c-backward-syntactic-ws)
 162           (if (or (bobp) (eq (preceding-char) ?,))
 163               (progn
 164                 ;; Identifier is omitted, or '...'.
 165                 (setq type-start identifier-start
 166                       type-identifier-end identifier-end
 167                       type-end identifier-end
 168                       identifier-start nil
 169                       identifier-end nil)
 170                 (c-backward-token-2))
 171             (setq type-end (point-marker)
 172                   last-token-start type-end)
 173             (while (and (not (bobp))
 174                         (progn
 175                           (c-backward-token-2)
 176                           (unless (eq (char-after) ?,)
 177                             (setq last-token-start (point-marker)))))
 178               (c-backward-syntactic-ws))
 179             (setq type-start last-token-start)
 180             (save-excursion
 181               (goto-char type-end)
 182               (skip-chars-backward "* " type-start)
 183               (c-backward-syntactic-ws)
 184               (setq type-identifier-end (point-marker))))
 185           (push (gnome-c-align--make-argument type-start
 186                                               type-identifier-end
 187                                               type-end
 188                                               identifier-start
 189                                               identifier-end)
 190                 arglist))
 191         arglist))))
 192
 193 ;;;###autoload
 194 (defun gnome-c-align-arglist-at-point (&optional identifier-start-column)
 195   "Reformat argument list at point, aligning argument to the right end."
 196   (interactive)
 197   (save-excursion
 198     (let* (start-column arglist)
 199       (cl-destructuring-bind (beg end)
 200           (gnome-c-align--arglist-region-at-point (point))
 201         (goto-char beg)
 202         (setq start-column (current-column))
 203         (save-restriction
 204           (narrow-to-region beg end)
 205           (setq arglist (gnome-c-align--parse-arglist (point-min) (point-max)))
 206           (gnome-c-align--normalize-arglist-region
 207            arglist (point-min) (point-max))
 208           (unless identifier-start-column
 209             (setq identifier-start-column
 210                   (gnome-c-align--arglist-identifier-start-column arglist 0)))
 211           (dolist (argument arglist)
 212             (goto-char (gnome-c-align--argument-type-start argument))
 213             (let ((column (if (bobp) 0 start-column)))
 214               (when (not (bobp))
 215                 (gnome-c-align--indent-to-column start-column))
 216               (when (gnome-c-align--argument-identifier-start argument)
 217                 (setq column (+ column identifier-start-column))
 218                 (goto-char (gnome-c-align--argument-identifier-start argument))
 219                 (gnome-c-align--indent-to-column column)))))))))
 220
 221 (cl-defstruct (gnome-c-align--decl
 222                (:constructor nil)
 223                (:constructor gnome-c-align--make-decl (start
 224                                                        end
 225                                                        identifier-start
 226                                                        identifier-end
 227                                                        arglist-start
 228                                                        arglist-end
 229                                                        arglist))
 230                (:copier nil)
 231                (:predicate nil))
 232   (start nil :read-only t)
 233   (end nil :read-only t)
 234   (identifier-start nil :read-only t)
 235   (identifier-end nil :read-only t)
 236   (arglist-start nil :read-only t)
 237   (arglist-end nil :read-only t)
 238   (arglist nil :read-only t))
 239
 240 (defun gnome-c-align--decls-identifier-start-column (decls start-column)
 241   (apply #'max
 242          start-column
 243          (delq nil
 244                (mapcar
 245                 (lambda (decl)
 246                   (let ((decl-column
 247                          (+ start-column
 248                             (gnome-c-align--marker-column
 249                              (gnome-c-align--decl-identifier-start decl)))))
 250                     (if (and gnome-c-align-max-column
 251                              (> decl-column gnome-c-align-max-column))
 252                         nil
 253                       decl-column)))
 254                 decls))))
 255
 256 (defun gnome-c-align--decl-identifier-width (decl)
 257   (- (gnome-c-align--marker-column
 258       (gnome-c-align--decl-identifier-end decl))
 259      (gnome-c-align--marker-column
 260       (gnome-c-align--decl-identifier-start decl))))
 261
 262 (defun gnome-c-align--decls-arglist-start-column (decls start-column)
 263   (let ((arglist-width
 264          (+ (gnome-c-align--decls-arglist-identifier-start-column decls 0)
 265             (gnome-c-align--decls-arglist-identifier-width decls)
 266             (length ");"))))
 267     (apply #'max
 268            start-column
 269            (delq nil
 270                  (mapcar
 271                   (lambda (decl)
 272                     (let ((decl-column
 273                            (+ start-column
 274                               (gnome-c-align--decl-identifier-width decl)
 275                               1)))
 276                       (if (and gnome-c-align-max-column
 277                                (> (+ decl-column arglist-width)
 278                                   gnome-c-align-max-column))
 279                           nil
 280                         decl-column)))
 281                   decls)))))
 282
 283 (defun gnome-c-align--decls-arglist-identifier-width (decls)
 284   (apply #'max 0 (mapcar (lambda (decl)
 285                            (gnome-c-align--arglist-identifier-width
 286                             (gnome-c-align--decl-arglist decl)))
 287                          decls)))
 288
 289 (defun gnome-c-align--decls-arglist-identifier-start-column (decls start-column)
 290   (apply #'max 0 (mapcar (lambda (decl)
 291                            ;; FIXME: should wrap lines inside argument list?
 292                            (gnome-c-align--arglist-identifier-start-column
 293                             (gnome-c-align--decl-arglist decl)
 294                             start-column))
 295                          decls)))
 296
 297 (defun gnome-c-align--parse-decl (beg end)
 298   ;; Parse at most one func declaration found in BEG END.
 299   (save-excursion
 300     (save-restriction
 301       (narrow-to-region beg end)
 302       (let (arglist-start
 303             arglist-end
 304             identifier-start
 305             identifier-end
 306             vfunc-p)
 307         (goto-char (point-min))
 308         (c-forward-syntactic-ws)
 309         (unless (looking-at
 310                  "typedef\\|#\\|G_\\(?:DECLARE\\|DEFINE\\)")
 311           (while (and (not (eobp))
 312                       (not (eq (char-after) ?\()))
 313             (c-forward-token-2)
 314             (c-forward-syntactic-ws))
 315           ;; Identifier is vfunc.
 316           (when (looking-at "(\\s-*\\*")
 317             (c-forward-sexp)
 318             (c-forward-syntactic-ws)
 319             (setq vfunc-p t))
 320           (when (eq (char-after) ?\()
 321             (setq arglist-start (point-marker))
 322             (c-backward-syntactic-ws)
 323             (setq identifier-end (point-marker))
 324             (if vfunc-p
 325                 (c-backward-sexp)
 326               (c-backward-token-2))
 327             (setq identifier-start (point-marker))
 328             (goto-char arglist-start)
 329             (c-forward-sexp)
 330             (setq arglist-end (point-marker))
 331             (gnome-c-align--make-decl beg end
 332                                       identifier-start identifier-end
 333                                       arglist-start arglist-end
 334                                       (gnome-c-align--parse-arglist
 335                                        (1+ arglist-start)
 336                                        (1- arglist-end)))))))))
 337
 338 (defun gnome-c-align--normalize-decl (decl)
 339   (save-excursion
 340     ;; Replace newlines with a space
 341     (save-restriction
 342       ;; Ignore lines before identifier-start
 343       (goto-char (gnome-c-align--decl-identifier-start decl))
 344       (beginning-of-line)
 345       (narrow-to-region (point)
 346                         (gnome-c-align--decl-arglist-end decl))
 347       (goto-char (point-min))
 348       (while (re-search-forward "\n" nil t)
 349         (replace-match " ")))
 350     ;; Replace consequent spaces with a space
 351     (save-restriction
 352       ;; Ignore lines before identifier-start
 353       (goto-char (gnome-c-align--decl-identifier-start decl))
 354       (beginning-of-line)
 355       (narrow-to-region (point)
 356                         (gnome-c-align--decl-arglist-end decl))
 357       (goto-char (point-min))
 358       (while (re-search-forward "\\s-+" nil t)
 359         (replace-match " ")))
 360     (goto-char (gnome-c-align--decl-identifier-start decl))
 361     (if (looking-back "\\* " nil)
 362         (delete-char -1))
 363     ;; Normalize the argument list
 364     (gnome-c-align--normalize-arglist-region
 365      (gnome-c-align--decl-arglist decl)
 366      (gnome-c-align--decl-arglist-start decl)
 367      (gnome-c-align--decl-arglist-end decl))))
 368
 369 (defun gnome-c-align--arglist-region-at-point (point)
 370   (save-excursion
 371     (let (start)
 372       (goto-char point)
 373       (c-beginning-of-statement-1)
 374       (c-backward-syntactic-ws)
 375       (unless (eq ?\( (preceding-char))
 376         (error "No containing argument list"))
 377       (setq start (point))
 378       (backward-char)
 379       (condition-case nil
 380           (c-forward-sexp)
 381         (error
 382          (error "No closing parenthesis")))
 383       (backward-char)
 384       (list start (point)))))
 385
 386 ;;;###autoload
 387 (defun gnome-c-align-set-column (symbol)
 388   "Set alignment column of SYMBOL."
 389   (interactive
 390    (let ((symbol-name (completing-read "Symbol to change: "
 391                                        '("identifier-start"
 392                                          "arglist-start"
 393                                          "arglist-identifier-start")
 394                                        nil t)))
 395      (list (intern (format "gnome-c-align-%s-column" symbol-name)))))
 396   (set symbol (current-column)))
 397
 398 (defun gnome-c-align--scan-decls (beg end)
 399   (save-excursion
 400     (save-restriction
 401       (narrow-to-region beg end)
 402       (goto-char (point-min))
 403       (let (decls)
 404         (while (not (eobp))
 405           (let (decl-start decl-end decl)
 406             (c-forward-syntactic-ws)
 407             (setq decl-start (point-marker))
 408             (c-end-of-statement)
 409             (setq decl-end (point-marker))
 410             (setq decl (gnome-c-align--parse-decl decl-start decl-end))
 411             (when decl
 412               (push decl decls))))
 413         decls))))
 414
 415 (defun gnome-c-align--guess-optimal-columns (beg end)
 416   (let ((buffer (current-buffer))
 417         decls)
 418     (with-temp-buffer
 419       (insert-buffer-substring-no-properties buffer beg end)
 420       (c-mode)
 421       (setq decls (gnome-c-align--scan-decls (point-min) (point-max)))
 422       (mapc #'gnome-c-align--normalize-decl decls)
 423       (let* ((identifier-start-column
 424               (gnome-c-align--decls-identifier-start-column
 425                decls 0))
 426              (arglist-start-column
 427               (gnome-c-align--decls-arglist-start-column
 428                decls identifier-start-column))
 429              (arglist-identifier-start-column
 430               (gnome-c-align--decls-arglist-identifier-start-column
 431                decls (+ (length "(") arglist-start-column))))
 432         (list (cons 'identifier-start-column
 433                     identifier-start-column)
 434               (cons 'arglist-start-column
 435                     arglist-start-column)
 436               (cons 'arglist-identifier-start-column
 437                     arglist-identifier-start-column))))))
 438
 439 ;;;###autoload
 440 (defun gnome-c-align-guess-optimal-columns (beg end)
 441   "Compute the optimal alignment rule from the declarations in BEG and END.
 442
 443 This sets `gnome-c-align-identifier-start-column',
 444 `gnome-c-align-arglist-start-column', and
 445 `gnome-c-align-arglist-identifier-start-column'."
 446   (interactive "r")
 447   (let ((columns (gnome-c-align--guess-optimal-columns beg end)))
 448     (setq gnome-c-align-identifier-start-column
 449           (cdr (assq 'identifier-start-column columns))
 450           gnome-c-align-arglist-start-column
 451           (cdr (assq 'arglist-start-column columns))
 452           gnome-c-align-arglist-identifier-start-column
 453           (cdr (assq 'arglist-identifier-start-column columns)))
 454     (message
 455      "identifier-start: %d, arglist-start: %d, arglist-identifier-start: %d"
 456      gnome-c-align-identifier-start-column
 457      gnome-c-align-arglist-start-column
 458      gnome-c-align-arglist-identifier-start-column)))
 459
 460 ;;;###autoload
 461 (defun gnome-c-align-guess-columns (beg end)
 462   "Guess the existing alignment rule from the declarations in BEG and END.
 463
 464 This sets `gnome-c-align-identifier-start-column',
 465 `gnome-c-align-arglist-start-column', and
 466 `gnome-c-align-arglist-identifier-start-column'."
 467   (interactive "r")
 468   (let ((decls (gnome-c-align--scan-decls beg end))
 469         arglist)
 470     (unless decls
 471       (error "No function declaration in the region"))
 472     (setq arglist (gnome-c-align--parse-arglist
 473                    (1+ (gnome-c-align--decl-arglist-start (car decls)))
 474                    (1- (gnome-c-align--decl-arglist-end (car decls)))))
 475     (unless arglist
 476       (error "Empty argument list"))
 477     (unless (gnome-c-align--argument-identifier-start (car arglist))
 478       (error "No identifier in the argument list"))
 479     (setq gnome-c-align-identifier-start-column
 480           (gnome-c-align--marker-column
 481            (gnome-c-align--decl-identifier-start (car decls)))
 482           gnome-c-align-arglist-start-column
 483           (gnome-c-align--marker-column
 484            (gnome-c-align--decl-arglist-start (car decls)))
 485           gnome-c-align-arglist-identifier-start-column
 486           (gnome-c-align--marker-column
 487            (gnome-c-align--argument-identifier-start (car arglist))))
 488     (message
 489      "identifier-start: %d, arglist-start: %d, arglist-identifier-start: %d"
 490      gnome-c-align-identifier-start-column
 491      gnome-c-align-arglist-start-column
 492      gnome-c-align-arglist-identifier-start-column)))
 493
 494 ;;;###autoload
 495 (defun gnome-c-align-decls-region (beg end)
 496   "Reformat function declarations in the region between BEG and END.
 497
 498 The `gnome-c-align-identifier-start-column',
 499 `gnome-c-align-arglist-start-column', and
 500 `gnome-c-align-arglist-identifier-start-column' variables
 501 control the widths.
 502
 503 To set those variables, use \\[gnome-c-align-set-column],
 504 \\[gnome-c-align-guess-columns], or
 505 \\[gnome-c-align-guess-optimal-columns].
 506
 507 If they are not set, this function internally calls
 508 \\[gnome-c-align-guess-optimal-columns] before formatting."
 509   (interactive "r")
 510   (save-excursion
 511     (let (decls)
 512       (save-restriction
 513         (narrow-to-region beg end)
 514         (unless (and gnome-c-align-identifier-start-column
 515                      gnome-c-align-arglist-start-column
 516                      gnome-c-align-arglist-identifier-start-column)
 517           (let ((columns (gnome-c-align--guess-optimal-columns beg end)))
 518             (unless gnome-c-align-identifier-start-column
 519               (setq gnome-c-align-identifier-start-column
 520                     (cdr (assq 'identifier-start-column columns))))
 521             (unless gnome-c-align-arglist-start-column
 522               (setq gnome-c-align-arglist-start-column
 523                     (cdr (assq 'arglist-start-column columns))))
 524             (unless gnome-c-align-arglist-identifier-start-column
 525               (setq gnome-c-align-arglist-identifier-start-column
 526                     (cdr (assq 'arglist-identifier-start-column columns))))))
 527         (setq decls (gnome-c-align--scan-decls beg end))
 528         (dolist (decl decls)
 529           (gnome-c-align--normalize-decl decl)
 530           (goto-char (gnome-c-align--decl-identifier-start decl))
 531           (gnome-c-align--indent-to-column
 532            gnome-c-align-identifier-start-column)
 533           (goto-char (gnome-c-align--decl-identifier-end decl))
 534           (when (>= (current-column) gnome-c-align-arglist-start-column)
 535             (insert "\n"))
 536           (goto-char (gnome-c-align--decl-arglist-start decl))
 537           (gnome-c-align--indent-to-column
 538            gnome-c-align-arglist-start-column)
 539           (forward-char)
 540           (gnome-c-align-arglist-at-point
 541            (- (- gnome-c-align-arglist-identifier-start-column
 542                  (length "("))
 543               gnome-c-align-arglist-start-column)))))))
 544
 545 (provide 'gnome-c-align)
 546
 547 ;;; gnome-c-align.el ends here