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