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