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