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

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