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

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