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