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