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

   1 ;;; gobject-align.el --- GObject C code alignment
   2 ;; Copyright (C) 2010,2011 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 'regexp-opt)
  27
  28 (defvar gobject-align-whitespace
  29   " \f\t\n\r\v")
  30
  31 (defvar gobject-align-max-line-width 80)
  32
  33 (defun gobject-align--make-arg (type-start type-end arg-name-start arg-name-end)
  34   (vector type-start type-end arg-name-start arg-name-end))
  35
  36 (defun gobject-align--arg-type-start (arg)
  37   (aref arg 0))
  38
  39 (defun gobject-align--arg-arg-name-start (arg)
  40   (aref arg 2))
  41
  42 (defun gobject-align--arg-type-width (arg)
  43   (- (gobject-align--arg-arg-name-start arg)
  44      (gobject-align--arg-type-start arg)))
  45
  46 (defun gobject-align--arglist-type-column-width (arglist)
  47   (let ((width 0)
  48         length)
  49     (while arglist
  50       (setq length (gobject-align--arg-type-width (car arglist)))
  51       (if (> length width)
  52           (setq width length))
  53       (setq arglist (cdr arglist)))
  54     width))
  55
  56 (defun gobject-align--arglist-arg-name-column-width (arglist)
  57   (let ((width 0)
  58         length)
  59     (while arglist
  60       (setq length (- (aref (car arglist) 3) ;arg-name-end
  61                       (gobject-align--arg-arg-name-start (car arglist))))
  62       (if (> length width)
  63           (setq width length))
  64       (setq arglist (cdr arglist)))
  65     width))
  66
  67 (defun gobject-align--parse-arglist (beg end)
  68   (save-excursion
  69     (save-restriction
  70       (narrow-to-region beg end)
  71       (let (type-start
  72             type-end
  73             arg-name-start
  74             arg-name-end
  75             arg
  76             arglist
  77             point)
  78         (goto-char (point-min))
  79         (while (and (not (eobp))
  80                     (setq type-start (point-marker))
  81                     (if (prog1 (re-search-forward
  82                                 (concat
  83                                  "["
  84                                  (regexp-quote gobject-align-whitespace)
  85                                  "]*,["
  86                                  (regexp-quote gobject-align-whitespace)
  87                                  "]*")
  88                                 nil 'noerror)
  89                           (setq point (point)))
  90                         (goto-char (match-beginning 0))
  91                       (goto-char (point-max))))
  92           (setq arg-name-end (point-marker))
  93           (c-backward-token-1)
  94           (setq arg-name-start (point-marker))
  95           (skip-chars-backward (concat gobject-align-whitespace "*"))
  96           (setq type-end (point-marker))
  97           (setq arg (gobject-align--make-arg type-start type-end
  98                                              arg-name-start arg-name-end)
  99                 arglist (cons arg arglist))
 100           (goto-char point))
 101         arglist))))
 102
 103 (defun gobject-align--make-func-decl (type-start type-end
 104                                                  func-name-start func-name-end
 105                                                  arglist-start arglist-end
 106                                                  func-decl-end
 107                                                  arglist)
 108   (vector type-start type-end func-name-start func-name-end
 109           arglist-start arglist-end func-decl-end arglist))
 110
 111 (defun gobject-align--func-decl-start (func-decl)
 112   (aref func-decl 0))
 113
 114 (defun gobject-align--func-decl-func-name-start (func-decl)
 115   (aref func-decl 2))
 116
 117 (defun gobject-align--func-decl-func-name-end (func-decl)
 118   (aref func-decl 3))
 119
 120 (defun gobject-align--func-decl-arglist-start (func-decl)
 121   (aref func-decl 4))
 122
 123 (defun gobject-align--func-decl-arglist-end (func-decl)
 124   (aref func-decl 5))
 125
 126 (defun gobject-align--func-decl-end (func-decl)
 127   (aref func-decl 6))
 128
 129 (defun gobject-align--func-decl-arglist (func-decl)
 130   (aref func-decl 7))
 131
 132 (defun gobject-align--func-decl-type-width (func-decl)
 133   (- (gobject-align--func-decl-func-name-start func-decl)
 134      (gobject-align--func-decl-start func-decl)))
 135
 136 (defun gobject-align--func-decl-func-name-width (func-decl)
 137   (- (gobject-align--func-decl-arglist-start func-decl)
 138      (gobject-align--func-decl-func-name-start func-decl)))
 139
 140 (defun gobject-align--func-decls-type-column-width (func-decls)
 141   (let ((width 0)
 142         length)
 143     (while func-decls
 144       (setq length (gobject-align--func-decl-type-width (car func-decls)))
 145       (if (> length width)
 146           (setq width length))
 147       (setq func-decls (cdr func-decls)))
 148     width))
 149
 150 (defun gobject-align--func-decls-func-name-column-width (func-decls
 151                                                          start-column
 152                                                          arglist-column-width)
 153   (let ((width 0)
 154         length)
 155     (while func-decls
 156       (setq length (gobject-align--func-decl-func-name-width (car func-decls)))
 157
 158       (if (and (<= (+ start-column
 159                       length
 160                       arglist-column-width)
 161                    gobject-align-max-line-width)
 162                (> length width))
 163           (setq width length))
 164       (setq func-decls (cdr func-decls)))
 165     width))
 166
 167 (defun gobject-align--func-decls-arglist-type-column-width (func-decls)
 168   (let ((width 0)
 169         arglist-type-column-width)
 170     (while func-decls
 171       (setq arglist-type-column-width
 172             (gobject-align--arglist-type-column-width
 173              (gobject-align--func-decl-arglist (car func-decls))))
 174       (if (> arglist-type-column-width width)
 175           (setq width arglist-type-column-width))
 176       (setq func-decls (cdr func-decls)))
 177     width))
 178
 179 (defun gobject-align--func-decls-arglist-arg-name-column-width (func-decls)
 180   (let ((width 0)
 181         arglist-arg-name-column-width)
 182     (while func-decls
 183       (setq arglist-arg-name-column-width
 184             (gobject-align--arglist-arg-name-column-width
 185              (gobject-align--func-decl-arglist (car func-decls))))
 186       (if (> arglist-arg-name-column-width width)
 187           (setq width arglist-arg-name-column-width))
 188       (setq func-decls (cdr func-decls)))
 189     width))
 190
 191 (defun gobject-align--parse-func-decl (beg end)
 192   ;; Parse one func-decl in BEG END.  BEG and END must point to the
 193   ;; beginning/end of the func-decl.
 194   (save-excursion
 195     (save-restriction
 196       (narrow-to-region beg end)
 197       (goto-char (point-max))
 198       (let (arglist-start
 199             arglist-end
 200             func-name-start
 201             func-name-end)
 202         ;; foo *bar (baz a) G_GNUC_CONST;
 203         ;;                              ^
 204         (unless (looking-back (concat "["
 205                                       (regexp-quote gobject-align-whitespace)
 206                                       "]*\\(?:[A-Z_]*\\>["
 207                                       (regexp-quote gobject-align-whitespace)
 208                                       "]*\\)*["
 209                                       (regexp-quote gobject-align-whitespace)
 210                                       "]*;["
 211                                       (regexp-quote gobject-align-whitespace)
 212                                       "]*")
 213                               nil
 214                               t)
 215           (error "No func-decl at point"))
 216         (goto-char (match-beginning 0))
 217         ;; foo *bar (baz a) G_GNUC_CONST;
 218         ;;                ^
 219         (unless (eq (char-before) ?\))
 220           (error "No arglist at point"))
 221         (setq arglist-end (point-marker))
 222         (c-backward-sexp)               ;skip arglist
 223         ;; foo *bar (baz a) G_GNUC_CONST;
 224         ;;          ^
 225         (setq arglist-start (point-marker))
 226         (skip-chars-backward gobject-align-whitespace)
 227         ;; foo *bar (baz a) G_GNUC_CONST;
 228         ;;        ^
 229         (setq func-name-end (point-marker))
 230         ;;(c-backward-token-2)
 231         (c-backward-sexp)               ;may be either an identifier
 232                                         ;or a pointer
 233         ;; foo *bar (baz a) G_GNUC_CONST;
 234         ;;      ^
 235         (setq func-name-start (point-marker))
 236         (skip-chars-backward (concat gobject-align-whitespace "*"))
 237         ;; foo *bar (baz a) G_GNUC_CONST;
 238         ;;   ^
 239         (gobject-align--make-func-decl (point-min-marker) (point-marker)
 240                                        func-name-start func-name-end
 241                                        arglist-start arglist-end
 242                                        (point-max-marker)
 243                                        (gobject-align--parse-arglist
 244                                         (1+ arglist-start)
 245                                         (1- arglist-end)))))))
 246
 247 (defun gobject-align--normalize-arglist (beg end)
 248   (save-excursion
 249     (save-restriction
 250       (narrow-to-region beg end)
 251       (goto-char (point-min))
 252       (while (re-search-forward (concat "["
 253                                         (regexp-quote gobject-align-whitespace)
 254                                         "]+")
 255                                 nil t)
 256         (replace-match " "))
 257       (goto-char (point-min))
 258       (while (re-search-forward " *, *" nil t)
 259         (replace-match ",\n")))))
 260
 261 (defun gobject-align--normalize-func-decl (beg end)
 262   (save-excursion
 263     (save-restriction
 264       (narrow-to-region beg end)
 265       (goto-char (point-min))
 266       (while (re-search-forward (concat "["
 267                                         (regexp-quote gobject-align-whitespace)
 268                                         "]+")
 269                                 nil t)
 270         (replace-match " ")))))
 271
 272 (defun gobject-align--indent-identifier-to-column (column)
 273   (when (looking-back "\*+" nil t)
 274     (setq column (- column (- (match-end 0) (match-beginning 0))))
 275     (goto-char (match-beginning 0)))
 276   (let (indent-tabs-mode)
 277     (indent-to-column column)))
 278
 279 (defun gobject-align--expand-region-to-arglist-extent (beg end)
 280   (setq beg (save-excursion
 281               (goto-char beg)
 282               (c-beginning-of-decl-1)
 283               (point))
 284         end (save-excursion
 285               (goto-char end)
 286               (c-end-of-decl-1)
 287               (point)))
 288   (unless (and (eq (char-before beg) ?\()
 289                (eq (char-after end) ?\)))
 290     (error "No arglist around point"))
 291   (list beg end))
 292
 293 (defun gobject-align-arglist-region (beg end &optional type-column-width)
 294   "Reformat argument list in the region between BEG and END.
 295 It applies proper alignment rule."
 296   (interactive (apply #'gobject-align--expand-region-to-arglist-extent
 297                       (if (region-active-p)
 298                           (list (region-beginning) (region-end))
 299                         (list (point) (point)))))
 300   (save-excursion
 301     (let ((indent-level (progn (goto-char beg) (current-column)))
 302           arg
 303           arglist
 304           column)
 305       (save-restriction
 306         (narrow-to-region beg end)
 307         (setq arglist (gobject-align--parse-arglist (point-min) (point-max)))
 308         ;; This may move markers in arglist.
 309         (gobject-align--normalize-arglist (point-min) (point-max))
 310         (unless type-column-width
 311           (setq type-column-width (gobject-align--arglist-type-column-width
 312                                    arglist)))
 313         (while arglist
 314           (setq arg (car arglist))
 315           (goto-char (gobject-align--arg-type-start arg))
 316           (if (bobp)
 317               (setq column 0)
 318             (setq column indent-level))
 319           (gobject-align--indent-identifier-to-column column)
 320           ;; Don't indent for no-arg-name arg.
 321           (unless (= (gobject-align--arg-type-start arg)
 322                      (gobject-align--arg-arg-name-start arg))
 323             (setq column (+ column type-column-width))
 324             (goto-char (gobject-align--arg-arg-name-start arg))
 325             (gobject-align--indent-identifier-to-column column))
 326           (setq arglist (cdr arglist)))))))
 327
 328 (defun gobject-align-func-decls-region (beg end)
 329   "Reformat function declarations in the region between BEG and END.
 330 It applies proper alignment rule."
 331   (interactive "r")
 332   (save-excursion
 333     (let ((indent-level (save-excursion
 334                           (goto-char beg)
 335                           (skip-chars-forward gobject-align-whitespace)
 336                           (current-column)))
 337           func-decl-end
 338           func-decl
 339           func-decls
 340           pointer
 341           func-name-width
 342           type-column-width
 343           func-name-column-width
 344           arglist-type-column-width
 345           arglist-arg-name-column-width
 346           arglist-column-width
 347           column)
 348       (save-restriction
 349         (narrow-to-region beg end)
 350         (goto-char (point-min))
 351         (while (search-forward ";" nil t)
 352           ;; XXX: Should skip non-func-decl statements.
 353           (setq func-decl-end (point-marker))
 354           (c-beginning-of-statement-1)
 355           (setq func-decl (gobject-align--parse-func-decl (point-marker)
 356                                                           func-decl-end)
 357                 func-decls (cons func-decl func-decls))
 358           (goto-char func-decl-end))
 359         ;; This may move markers in func-decls.
 360         (setq pointer func-decls)
 361         (while pointer
 362           (setq func-decl (car pointer))
 363           (gobject-align--normalize-func-decl
 364            (gobject-align--func-decl-start func-decl)
 365            (gobject-align--func-decl-end func-decl))
 366           (setq pointer (cdr pointer)))
 367         (setq type-column-width
 368               (gobject-align--func-decls-type-column-width func-decls)
 369               arglist-type-column-width
 370               (gobject-align--func-decls-arglist-type-column-width func-decls)
 371               arglist-arg-name-column-width
 372               (gobject-align--func-decls-arglist-arg-name-column-width
 373                func-decls)
 374               arglist-column-width
 375               (+ arglist-type-column-width
 376                  arglist-arg-name-column-width
 377                  3)                     ;(length "();")
 378               func-name-column-width
 379               (gobject-align--func-decls-func-name-column-width
 380                func-decls
 381                (+ indent-level
 382                   type-column-width)
 383                arglist-column-width))
 384         (setq pointer func-decls)
 385         (while pointer
 386           (setq func-decl (car pointer))
 387           (goto-char (gobject-align--func-decl-start func-decl))
 388           (setq column indent-level)
 389           (gobject-align--indent-identifier-to-column column)
 390           ;; Align type column.
 391           (setq func-name-width
 392                 (- (gobject-align--func-decl-func-name-end func-decl)
 393                    (gobject-align--func-decl-func-name-start func-decl)))
 394           (if (> (+ column type-column-width func-name-width)
 395                  gobject-align-max-line-width)
 396               (setq column
 397                     (+ column
 398                        (gobject-align--func-decl-type-width func-decl)))
 399             (setq column (+ column type-column-width)))
 400           (goto-char (gobject-align--func-decl-func-name-start func-decl))
 401           (gobject-align--indent-identifier-to-column column)
 402           ;; Align func-name column.
 403           (when (> (- (gobject-align--func-decl-func-name-end func-decl)
 404                       (point))
 405                    func-name-column-width)
 406             (goto-char (gobject-align--func-decl-func-name-end func-decl))
 407             (insert "\n")
 408             (setq column (+ indent-level type-column-width)))
 409           (setq column (+ column func-name-column-width))
 410           (goto-char (gobject-align--func-decl-arglist-start func-decl))
 411           (gobject-align--indent-identifier-to-column column)
 412           ;; Align arglist.
 413           (gobject-align-arglist-region
 414            (1+ (point-marker))
 415            (1- (gobject-align--func-decl-arglist-end
 416                 func-decl))
 417            arglist-type-column-width)
 418           (setq pointer (cdr pointer)))))))
 419
 420 (provide 'gobject-align)
 421
 422 ;;; gobject-align.el ends here