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