code.delx.au - gnu-emacs/blob - lisp/align.el

   1 ;;; align.el --- align text to a specific column, by regexp
   2
   3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
   4 ;;   2005, 2006 Free Software Foundation, Inc.
   5
   6 ;; Author: John Wiegley <johnw@gnu.org>
   7 ;; Keywords: convenience languages lisp
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This mode allows you to align regions in a context-sensitive fashion.
  29 ;; The classic use is to align assignments:
  30 ;;
  31 ;;    int a = 1;
  32 ;;    short foo = 2;
  33 ;;    double blah = 4;
  34 ;;
  35 ;; becomes
  36 ;;
  37 ;;    int    a    = 1;
  38 ;;    short  foo  = 2;
  39 ;;    double blah = 4;
  40
  41 ;;; Usage:
  42
  43 ;; There are several variables which define how certain "categories"
  44 ;; of syntax are to be treated.  These variables go by the name
  45 ;; `align-CATEGORY-modes'.  For example, "c++" is such a category.
  46 ;; There are several rules which apply to c++, but since several other
  47 ;; languages have a syntax similar to c++ (e.g., c, java, etc), these
  48 ;; modes are treated as belonging to the same category.
  49 ;;
  50 ;; If you want to add a new mode under a certain category, just
  51 ;; customize that list, or add the new mode manually.  For example, to
  52 ;; make jde-mode a c++ category mode, use this code in your .emacs
  53 ;; file:
  54 ;;
  55 ;;    (setq align-c++-modes (cons 'jde-mode align-c++-modes))
  56
  57 ;; In some programming modes, it's useful to have the aligner run only
  58 ;; after indentation is performed.  To achieve this, customize or set
  59 ;; the variable `align-indent-before-aligning' to t.
  60
  61 ;;; Module Authors:
  62
  63 ;; In order to incorporate align's functionality into your own
  64 ;; modules, there are only a few steps you have to follow.
  65
  66 ;;  1. Require or load in the align.el library.
  67 ;;
  68 ;;  2. Define your alignment and exclusion rules lists, either
  69 ;;     customizable or not.
  70 ;;
  71 ;;  3. In your mode function, set the variables
  72 ;;     `align-mode-rules-list' and `align-mode-exclude-rules-list'
  73 ;;     to your own rules lists.
  74
  75 ;; If there is any need to add your mode name to one of the
  76 ;; align-?-modes variables (for example, `align-dq-string-modes'), use
  77 ;; `add-to-list', or some similar function which checks first to see
  78 ;; if the value is already there.  Since the user may customize that
  79 ;; mode list, and then write your mode name into their .emacs file,
  80 ;; causing the symbol already to be present the next time they load
  81 ;; your package.
  82
  83 ;; Example:
  84 ;;
  85 ;;   (require 'align)
  86 ;;
  87 ;;   (defcustom my-align-rules-list
  88 ;;     '((my-rule
  89 ;;        (regexp . "Sample")))
  90 ;;     :type align-rules-list-type
  91 ;;     :group 'my-package)
  92 ;;
  93 ;;   (put 'my-align-rules-list 'risky-local-variable t)
  94 ;;
  95 ;;   (add-to-list 'align-dq-string-modes 'my-package-mode)
  96 ;;   (add-to-list 'align-open-comment-modes 'my-package-mode)
  97 ;;
  98 ;;   (defun my-mode ()
  99 ;;      ...
 100 ;;      (setq align-mode-rules-list my-align-rules-list))
 101 ;;
 102 ;; Note that if you need to install your own exclusion rules, then you
 103 ;; will also need to reproduce any double-quoted string, or open
 104 ;; comment exclusion rules that are defined in the standard
 105 ;; `align-exclude-rules-list'.  At the moment there is no convenient
 106 ;; way to mix both mode-local and global rules lists.
 107
 108 ;;; History:
 109
 110 ;; Version 1.0 was created in the earlier part of 1996, using a very
 111 ;; simple algorithm that understand only basic regular expressions.
 112 ;; Parts of the code were broken up and included in vhdl-mode.el
 113 ;; around this time.  After several comments from users, and a need to
 114 ;; find a more robust, performant algorithm, 2.0 was born in late
 115 ;; 1998.  Many different approaches were taken (mostly due to the
 116 ;; complexity of TeX tables), but finally a scheme was discovered
 117 ;; which worked fairly well for most common usage cases.  Development
 118 ;; beyond version 2.8 is not planned, except for problems that users
 119 ;; might encounter.
 120
 121 ;;; Code:
 122
 123 (defgroup align nil
 124   "Align text to a specific column, by regexp."
 125   :version "21.1"
 126   :group 'fill)
 127
 128 ;;; User Variables:
 129
 130 (defcustom align-load-hook nil
 131   "*Hook that gets run after the aligner has been loaded."
 132   :type 'hook
 133   :group 'align)
 134
 135 (defcustom align-indent-before-aligning nil
 136   "*If non-nil, indent the marked region before aligning it."
 137   :type 'boolean
 138   :group 'align)
 139
 140 (defcustom align-default-spacing 1
 141   "*An integer that represents the default amount of padding to use.
 142 If `align-to-tab-stop' is non-nil, this will represent the number of
 143 tab stops to use for alignment, rather than the number of spaces.
 144 Each alignment rule can optionally override both this variable.  See
 145 `align-mode-alist'."
 146   :type 'integer
 147   :group 'align)
 148
 149 (defcustom align-to-tab-stop 'indent-tabs-mode
 150   "*If non-nil, alignments will always fall on a tab boundary.
 151 It may also be a symbol, whose value will be taken."
 152   :type '(choice (const nil) symbol)
 153   :group 'align)
 154
 155 (defcustom align-region-heuristic 500
 156   "*If non-nil, used as a heuristic by `align-current'.
 157 Since each alignment rule can possibly have its own set of alignment
 158 sections (whenever `align-region-separate' is non-nil, and not a
 159 string), this heuristic is used to determine how far before and after
 160 point we should search in looking for a region separator.  Larger
 161 values can mean slower perform in large files, although smaller values
 162 may cause unexpected behavior at times."
 163   :type 'integer
 164   :group 'align)
 165
 166 (defcustom align-highlight-change-face 'highlight
 167   "*The face to highlight with if changes are necessary."
 168   :type 'face
 169   :group 'align)
 170
 171 (defcustom align-highlight-nochange-face 'secondary-selection
 172   "*The face to highlight with if no changes are necessary."
 173   :type 'face
 174   :group 'align)
 175
 176 (defcustom align-large-region 10000
 177   "*If an integer, defines what constitutes a \"large\" region.
 178 If nil,then no messages will ever be printed to the minibuffer."
 179   :type 'integer
 180   :group 'align)
 181
 182 (defcustom align-c++-modes '(c++-mode c-mode java-mode)
 183   "*A list of modes whose syntax resembles C/C++."
 184   :type '(repeat symbol)
 185   :group 'align)
 186
 187 (defcustom align-perl-modes '(perl-mode cperl-mode)
 188   "*A list of modes where perl syntax is to be seen."
 189   :type '(repeat symbol)
 190   :group 'align)
 191
 192 (defcustom align-lisp-modes
 193   '(emacs-lisp-mode lisp-interaction-mode lisp-mode scheme-mode)
 194   "*A list of modes whose syntax resembles Lisp."
 195   :type '(repeat symbol)
 196   :group 'align)
 197
 198 (defcustom align-tex-modes
 199   '(tex-mode plain-tex-mode latex-mode slitex-mode)
 200   "*A list of modes whose syntax resembles TeX (and family)."
 201   :type '(repeat symbol)
 202   :group 'align)
 203
 204 (defcustom align-text-modes '(text-mode outline-mode)
 205   "*A list of modes whose content is plain text."
 206   :type '(repeat symbol)
 207   :group 'align)
 208
 209 (defcustom align-dq-string-modes
 210   (append align-lisp-modes align-c++-modes align-perl-modes
 211           '(python-mode))
 212   "*A list of modes where double quoted strings should be excluded."
 213   :type '(repeat symbol)
 214   :group 'align)
 215
 216 (defcustom align-sq-string-modes
 217   (append align-perl-modes '(python-mode))
 218   "*A list of modes where single quoted strings should be excluded."
 219   :type '(repeat symbol)
 220   :group 'align)
 221
 222 (defcustom align-open-comment-modes
 223   (append align-lisp-modes align-c++-modes align-perl-modes
 224           '(python-mode makefile-mode))
 225   "*A list of modes with a single-line comment syntax.
 226 These are comments as in Lisp, which have a beginning but, end with
 227 the line (i.e., `comment-end' is an empty string)."
 228   :type '(repeat symbol)
 229   :group 'align)
 230
 231 (defcustom align-region-separate "^\\s-*[{}]?\\s-*$"
 232   "*Select the method by which alignment sections will be separated.
 233 If this is a symbol, that symbol's value will be used.
 234
 235 For the sake of clarification, consider the following example, which
 236 will be referred to in the descriptions below.
 237
 238     int alpha = 1; /* one */
 239     double beta = 2.0;
 240     long gamma; /* ten */
 241
 242     unsigned int delta = 1; /* one */
 243     long double epsilon = 3.0;
 244     long long omega; /* ten */
 245
 246 The possible settings for `align-region-separate' are:
 247
 248  `entire'  The entire region being aligned will be considered as a
 249            single alignment section.  Assuming that comments were not
 250            being aligned to a particular column, the example would
 251            become:
 252
 253              int          alpha    = 1;   /* one */
 254              double       beta     = 2.0;
 255              long         gamma;          /* ten */
 256
 257              unsigned int delta    = 1;   /* one */
 258              long double  epsilon;
 259              long long    chi      = 10;  /* ten */
 260
 261  `group'   Each contiguous set of lines where a specific alignment
 262            occurs is considered a section for that alignment rule.
 263            Note that each rule will may have any entirely different
 264            set of section divisions than another.
 265
 266              int    alpha = 1; /* one */
 267              double beta  = 2.0;
 268              long   gamma; /* ten */
 269
 270              unsigned int delta = 1; /* one */
 271              long double  epsilon;
 272              long long    chi = 10; /* ten */
 273
 274  `largest' When contiguous rule sets overlap, the largest section
 275            described will be taken as the alignment section for each
 276            rule touched by that section.
 277
 278              int    alpha = 1;   /* one */
 279              double beta  = 2.0;
 280              long   gamma;       /* ten */
 281
 282              unsigned int delta    = 1;  /* one */
 283              long double  epsilon;
 284              long long    chi      = 10; /* ten */
 285
 286            NOTE: This option is not supported yet, due to algorithmic
 287            issues which haven't been satisfactorily resolved.  There
 288            are ways to do it, but they're both ugly and resource
 289            consumptive.
 290
 291  regexp    A regular expression string which defines the section
 292            divider.  If the mode you're in has a consistent divider
 293            between sections, the behavior will be very similar to
 294            `largest', and faster.  But if the mode does not use clear
 295            separators (for example, if you collapse your braces onto
 296            the preceding statement in C or perl), `largest' is
 297            probably the better alternative.
 298
 299  function  A function that will be passed the beginning and ending
 300            locations of the region in which to look for the section
 301            separator.  At the very beginning of the attempt to align,
 302            both of these parameters will be nil, in which case the
 303            function should return non-nil if it wants each rule to
 304            define its own section, or nil if it wants the largest
 305            section found to be used as the common section for all rules
 306            that occur there.
 307
 308  list      A list of markers within the buffer that represent where
 309            the section dividers lie.  Be certain to use markers!  For
 310            when the aligning begins, the ensuing contract/expanding of
 311            whitespace will throw off any non-marker positions.
 312
 313            This method is intended for use in Lisp programs, and not
 314            by the user."
 315   :type '(choice
 316           (const :tag "Entire region is one section" entire)
 317           (const :tag "Align by contiguous groups" group)
 318 ;         (const largest)
 319           (regexp :tag "Regexp defines section boundaries")
 320           (function :tag "Function defines section boundaries"))
 321   :group 'align)
 322
 323 (put 'align-region-separate 'risky-local-variable t)
 324
 325 (defvar align-rules-list-type
 326   '(repeat
 327     (cons
 328      :tag "Alignment rule"
 329      (symbol :tag "Title")
 330      (cons :tag "Required attributes"
 331            (cons :tag "Regexp"
 332                  (const :tag "(Regular expression to match)" regexp)
 333                  (choice :value "\\(\\s-+\\)" regexp function))
 334            (repeat
 335             :tag "Optional attributes"
 336             (choice
 337              (cons :tag "Repeat"
 338                    (const :tag "(Repeat this rule throughout line)"
 339                           repeat)
 340                    (boolean :value t))
 341              (cons :tag "Paren group"
 342                    (const :tag "(Parenthesis group to use)" group)
 343                    (choice :value 2
 344                            integer (repeat integer)))
 345              (cons :tag "Modes"
 346                    (const :tag "(Modes where this rule applies)" modes)
 347                    (sexp :value (text-mode)))
 348              (cons :tag "Case-fold"
 349                    (const :tag "(Should case be ignored for this rule)"
 350                           case-fold)
 351                    (boolean :value t))
 352              (cons :tag "To Tab Stop"
 353                    (const :tag "(Should rule align to tab stops)"
 354                           tab-stop)
 355                    (boolean :value nil))
 356              (cons :tag "Valid"
 357                    (const :tag "(Return non-nil if rule is valid)"
 358                           valid)
 359                    (function :value t))
 360              (cons :tag "Run If"
 361                    (const :tag "(Return non-nil if rule should run)"
 362                           run-if)
 363                    (function :value t))
 364              (cons :tag "Column"
 365                    (const :tag "(Column to fix alignment at)" column)
 366                    (choice :value comment-column
 367                            integer symbol))
 368              (cons :tag "Spacing"
 369                    (const :tag "(Amount of spacing to use)" spacing)
 370                    (integer :value 1))
 371              (cons :tag "Justify"
 372                    (const :tag "(Should text be right justified)"
 373                           justify)
 374                    (boolean :value t))
 375              ;; make sure this stays up-to-date with any changes
 376              ;; in `align-region-separate'
 377              (cons :tag "Separate"
 378                    (const :tag "(Separation to use for this rule)"
 379                           separate)
 380                    (choice :value "^\\s-*$"
 381                            (const entire)
 382                            (const group)
 383 ;                          (const largest)
 384                            regexp function)))))))
 385   "The `type' form for any `align-rules-list' variable.")
 386
 387 (defcustom align-rules-list
 388   `((lisp-second-arg
 389      (regexp   . "\\(^\\s-+[^( \t\n]\\|(\\(\\S-+\\)\\s-+\\)\\S-+\\(\\s-+\\)")
 390      (group    . 3)
 391      (modes    . align-lisp-modes)
 392      (run-if   . ,(function (lambda () current-prefix-arg))))
 393
 394     (lisp-alist-dot
 395      (regexp   . "\\(\\s-*\\)\\.\\(\\s-*\\)")
 396      (group    . (1 2))
 397      (modes    . align-lisp-modes))
 398
 399     (open-comment
 400      (regexp   . ,(function
 401                    (lambda (end reverse)
 402                      (funcall (if reverse 're-search-backward
 403                                 're-search-forward)
 404                               (concat "[^ \t\n\\\\]"
 405                                       (regexp-quote comment-start)
 406                                       "\\(.+\\)$") end t))))
 407      (modes    . align-open-comment-modes))
 408
 409     (c-macro-definition
 410      (regexp   . "^\\s-*#\\s-*define\\s-+\\S-+\\(\\s-+\\)")
 411      (modes    . align-c++-modes))
 412
 413     (c-variable-declaration
 414      (regexp   . ,(concat "[*&0-9A-Za-z_]>?[&*]*\\(\\s-+[*&]*\\)"
 415                           "[A-Za-z_][0-9A-Za-z:_]*\\s-*\\(\\()\\|"
 416                           "=[^=\n].*\\|(.*)\\|\\(\\[.*\\]\\)*\\)?"
 417                           "\\s-*[;,]\\|)\\s-*$\\)"))
 418      (group    . 1)
 419      (modes    . align-c++-modes)
 420      (justify  . t)
 421      (valid
 422       . ,(function
 423           (lambda ()
 424             (not (or (save-excursion
 425                        (goto-char (match-beginning 1))
 426                        (backward-word 1)
 427                        (looking-at
 428                         "\\(goto\\|return\\|new\\|delete\\|throw\\)"))
 429                      (if (and (boundp 'font-lock-mode) font-lock-mode)
 430                          (eq (get-text-property (point) 'face)
 431                              'font-lock-comment-face)
 432                        (eq (caar (c-guess-basic-syntax)) 'c))))))))
 433
 434     (c-assignment
 435      (regexp   . ,(concat "[^-=!^&*+<>/| \t\n]\\(\\s-*[-=!^&*+<>/|]*\\)"
 436                           "=\\(\\s-*\\)\\([^= \t\n]\\|$\\)"))
 437      (group    . (1 2))
 438      (modes    . align-c++-modes)
 439      (justify  . t)
 440      (tab-stop . nil))
 441
 442     (perl-assignment
 443      (regexp   . ,(concat "[^=!^&*-+<>/| \t\n]\\(\\s-*\\)=[~>]?"
 444                           "\\(\\s-*\\)\\([^>= \t\n]\\|$\\)"))
 445      (group    . (1 2))
 446      (modes    . align-perl-modes)
 447      (tab-stop . nil))
 448
 449     (python-assignment
 450      (regexp   . ,(concat "[^=!<> \t\n]\\(\\s-*\\)="
 451                           "\\(\\s-*\\)\\([^>= \t\n]\\|$\\)"))
 452      (group    . (1 2))
 453      (modes    . '(python-mode))
 454      (tab-stop . nil))
 455
 456     (make-assignment
 457      (regexp   . "^\\s-*\\w+\\(\\s-*\\):?=\\(\\s-*\\)\\([^\t\n \\\\]\\|$\\)")
 458      (group    . (1 2))
 459      (modes    . '(makefile-mode))
 460      (tab-stop . nil))
 461
 462     (c-comma-delimiter
 463      (regexp   . ",\\(\\s-*\\)[^/ \t\n]")
 464      (repeat   . t)
 465      (modes    . align-c++-modes)
 466      (run-if   . ,(function (lambda () current-prefix-arg))))
 467                                         ;      (valid
 468                                         ;       . ,(function
 469                                         ;         (lambda ()
 470                                         ;           (memq (caar (c-guess-basic-syntax))
 471                                         ;                 '(brace-list-intro
 472                                         ;                   brace-list-entry
 473                                         ;                   brace-entry-open))))))
 474
 475     ;; With a prefix argument, comma delimiter will be aligned.  Since
 476     ;; perl-mode doesn't give us enough syntactic information (and we
 477     ;; don't do our own parsing yet), this rule is too destructive to
 478     ;; run normally.
 479     (basic-comma-delimiter
 480      (regexp   . ",\\(\\s-*\\)[^# \t\n]")
 481      (repeat   . t)
 482      (modes    . (append align-perl-modes '(python-mode)))
 483      (run-if   . ,(function (lambda () current-prefix-arg))))
 484
 485     (c++-comment
 486      (regexp   . "\\(\\s-*\\)\\(//.*\\|/\\*.*\\*/\\s-*\\)$")
 487      (modes    . align-c++-modes)
 488      (column   . comment-column)
 489      (valid    . ,(function
 490                    (lambda ()
 491                      (save-excursion
 492                        (goto-char (match-beginning 1))
 493                        (not (bolp)))))))
 494
 495     (c-chain-logic
 496      (regexp   . "\\(\\s-*\\)\\(&&\\|||\\|\\<and\\>\\|\\<or\\>\\)")
 497      (modes    . align-c++-modes)
 498      (valid    . ,(function
 499                    (lambda ()
 500                      (save-excursion
 501                        (goto-char (match-end 2))
 502                        (looking-at "\\s-*\\(/[*/]\\|$\\)"))))))
 503
 504     (perl-chain-logic
 505      (regexp   . "\\(\\s-*\\)\\(&&\\|||\\|\\<and\\>\\|\\<or\\>\\)")
 506      (modes    . align-perl-modes)
 507      (valid    . ,(function
 508                    (lambda ()
 509                      (save-excursion
 510                        (goto-char (match-end 2))
 511                        (looking-at "\\s-*\\(#\\|$\\)"))))))
 512
 513     (python-chain-logic
 514      (regexp   . "\\(\\s-*\\)\\(\\<and\\>\\|\\<or\\>\\)")
 515      (modes    . '(python-mode))
 516      (valid    . ,(function
 517                    (lambda ()
 518                      (save-excursion
 519                        (goto-char (match-end 2))
 520                        (looking-at "\\s-*\\(#\\|$\\|\\\\\\)"))))))
 521
 522     (c-macro-line-continuation
 523      (regexp   . "\\(\\s-*\\)\\\\$")
 524      (modes    . align-c++-modes)
 525      (column   . c-backslash-column))
 526                                         ;      (valid
 527                                         ;       . ,(function
 528                                         ;         (lambda ()
 529                                         ;           (memq (caar (c-guess-basic-syntax))
 530                                         ;                 '(cpp-macro cpp-macro-cont))))))
 531
 532     (basic-line-continuation
 533      (regexp   . "\\(\\s-*\\)\\\\$")
 534      (modes    . '(python-mode makefile-mode)))
 535
 536     (tex-record-separator
 537      (regexp . ,(function
 538                  (lambda (end reverse)
 539                    (align-match-tex-pattern "&" end reverse))))
 540      (group    . (1 2))
 541      (modes    . align-tex-modes)
 542      (repeat   . t))
 543
 544     (tex-tabbing-separator
 545      (regexp   . ,(function
 546                    (lambda (end reverse)
 547                      (align-match-tex-pattern "\\\\[=>]" end reverse))))
 548      (group    . (1 2))
 549      (modes    . align-tex-modes)
 550      (repeat   . t)
 551      (run-if   . ,(function
 552                    (lambda ()
 553                      (eq major-mode 'latex-mode)))))
 554
 555     (tex-record-break
 556      (regexp   . "\\(\\s-*\\)\\\\\\\\")
 557      (modes    . align-tex-modes))
 558
 559     ;; With a numeric prefix argument, or C-u, space delimited text
 560     ;; tables will be aligned.
 561     (text-column
 562      (regexp   . "\\(^\\|\\S-\\)\\([ \t]+\\)\\(\\S-\\|$\\)")
 563      (group    . 2)
 564      (modes    . align-text-modes)
 565      (repeat   . t)
 566      (run-if   . ,(function
 567                    (lambda ()
 568                      (and current-prefix-arg
 569                           (not (eq '- current-prefix-arg)))))))
 570
 571     ;; With a negative prefix argument, lists of dollar figures will
 572     ;; be aligned.
 573     (text-dollar-figure
 574      (regexp   . "\\$?\\(\\s-+[0-9]+\\)\\.")
 575      (modes    . align-text-modes)
 576      (justify  . t)
 577      (run-if   . ,(function
 578                    (lambda ()
 579                      (eq '- current-prefix-arg)))))
 580
 581     (css-declaration
 582      (regexp . "^\\s-*\\w+:\\(\\s-*\\).*;")
 583      (group . (1))
 584      (modes . '(css-mode html-mode))))
 585   "*A list describing all of the available alignment rules.
 586 The format is:
 587
 588    ((TITLE
 589      (ATTRIBUTE . VALUE) ...)
 590     ...)
 591
 592 The following attributes are meaningful:
 593
 594 `regexp'    This required attribute must be either a string describing
 595             a regular expression, or a function (described below).
 596             For every line within the section that this regular
 597             expression matches, the given rule will be applied to that
 598             line.  The exclusion rules denote which part(s) of the
 599             line should not be modified; the alignment rules cause the
 600             identified whitespace group to be contracted/expanded such
 601             that the \"alignment character\" (the character
 602             immediately following the identified parenthesis group),
 603             occurs in the same column for every line within the
 604             alignment section (see `align-region-separate' for a
 605             description of how the region is broken up into alignment
 606             sections).
 607
 608             The `regexp' attribute describes how the text should be
 609             treated.  Within this regexp, there must be at least one
 610             group of characters (typically whitespace) identified by
 611             the special opening and closing parens used in regexp
 612             expressions (`\\\\(' and `\\\\)') (see the Emacs manual on
 613             the syntax of regular expressions for more info).
 614
 615             If `regexp' is a function, it will be called as a
 616             replacement for `re-search-forward'.  This means that it
 617             should return nil if nothing is found to match the rule,
 618             or it should set the match data appropriately, move point
 619             to the end of the match, and return the value of point.
 620
 621 `group'     For exclusion rules, the group identifies the range of
 622             characters that should be ignored.  For alignment rules,
 623             these are the characters that will be deleted/expanded for
 624             the purposes of alignment.  The \"alignment character\" is
 625             always the first character immediately following this
 626             parenthesis group.  This attribute may also be a list of
 627             integer, in which case multiple alignment characters will
 628             be aligned, with the list of integer identifying the
 629             whitespace groups which precede them.  The default for
 630             this attribute is 1.
 631
 632 `modes'     The `modes' attribute, if set, should name a list of
 633             major modes -- or evaluate to such a value -- in which the
 634             rule is valid.  If not set, the rule will apply to all
 635             modes.
 636
 637 `case-fold' If `regexp' is an ordinary regular expression string
 638             containing alphabetic character, sometimes you may want
 639             the search to proceed case-insensitively (for languages
 640             that ignore case, such as pascal for example).  In that
 641             case, set `case-fold' to a non-nil value, and the regular
 642             expression search will ignore case.  If `regexp' is set to
 643             a function, that function must handle the job of ignoring
 644             case by itself.
 645
 646 `tab-stop'  If the `tab-stop' attribute is set, and non-nil, the
 647             alignment character will always fall on a tab stop
 648             (whether it uses tabs to get there or not depends on the
 649             value of `indent-tabs-mode').  If the `tab-stop' attribute
 650             is set to nil, tab stops will never be used.  Otherwise,
 651             the value of `align-to-tab-stop' determines whether or not
 652             to align to a tab stop.  The `tab-stop' attribute may also
 653             be a list of t or nil values, corresponding to the number
 654             of parenthesis groups specified by the `group' attribute.
 655
 656 `repeat'    If the `repeat' attribute is present, and non-nil, the
 657             rule will be applied to the line continuously until no
 658             further matches are found.
 659
 660 `valid'     If the `valid' attribute is set, it will be used to
 661             determine whether the rule should be invoked.  This form
 662             is evaluated after the regular expression match has been
 663             performed, so that it is possible to use the results of
 664             that match to determine whether the alignment should be
 665             performed.  The buffer should not be modified during the
 666             evaluation of this form.
 667
 668 `run-if'    Like `valid', the `run-if' attribute tests whether the
 669             rule should be run at all -- even before any searches are
 670             done to determine if the rule applies to the alignment
 671             region.  This can save time, since `run-if' will only be
 672             run once for each rule.  If it returns nil, the rule will
 673             not be attempted.
 674
 675 `column'    For alignment rules, if the `column' attribute is set --
 676             which must be an integer, or a symbol whose value is an
 677             integer -- it will be used as the column in which to align
 678             the alignment character.  If the text on a particular line
 679             happens to overrun that column, a single space character,
 680             or tab stop (see `align-to-tab-stop') will be added
 681             between the last text character and the alignment
 682             character.
 683
 684 `spacing'   Alignment rules may also override the amount of spacing
 685             that would normally be used by providing a `spacing'
 686             attribute.  This must be an integer, or a list of integers
 687             corresponding to the number of parenthesis groups matched
 688             by the `group' attribute.  If a list of value is used, and
 689             any of those values is nil, `align-default-spacing' will
 690             be used for that subgroup.  See `align-default-spacing'
 691             for more details on spacing, tab stops, and how to
 692             indicate how much spacing should be used.  If TAB-STOP is
 693             present, it will override the value of `align-to-tab-stop'
 694             for that rule.
 695
 696 `justify'   It is possible with `regexp' and `group' to identify a
 697             character group that contains more than just whitespace
 698             characters.  By default, any non-whitespace characters in
 699             that group will also be deleted while aligning the
 700             alignment character.  However, if the `justify' attribute
 701             is set to a non-nil value, only the initial whitespace
 702             characters within that group will be deleted.  This has
 703             the effect of right-justifying the characters that remain,
 704             and can be used for outdenting or just plain old right-
 705             justification.
 706
 707 `separate'  Each rule can define its own section separator, which
 708             describes how to identify the separation of \"sections\"
 709             within the region to be aligned.  Setting the `separate'
 710             attribute overrides the value of `align-region-separate'
 711             (see the documentation of that variable for possible
 712             values), and any separation argument passed to `align'."
 713   :type align-rules-list-type
 714   :group 'align)
 715
 716 (put 'align-rules-list 'risky-local-variable t)
 717
 718 (defvar align-exclude-rules-list-type
 719   '(repeat
 720     (cons
 721      :tag "Exclusion rule"
 722      (symbol :tag "Title")
 723      (cons :tag "Required attributes"
 724            (cons :tag "Regexp"
 725                  (const :tag "(Regular expression to match)" regexp)
 726                  (choice :value "\\(\\s-+\\)" regexp function))
 727            (repeat
 728             :tag "Optional attributes"
 729             (choice
 730              (cons :tag "Repeat"
 731                    (const :tag "(Repeat this rule throughout line)"
 732                           repeat)
 733                    (boolean :value t))
 734              (cons :tag "Paren group"
 735                    (const :tag "(Parenthesis group to use)" group)
 736                    (choice :value 2
 737                            integer (repeat integer)))
 738              (cons :tag "Modes"
 739                    (const :tag "(Modes where this rule applies)" modes)
 740                    (sexp :value (text-mode)))
 741              (cons :tag "Case-fold"
 742                    (const :tag "(Should case be ignored for this rule)"
 743                           case-fold)
 744                    (boolean :value t)))))))
 745   "The `type' form for any `align-exclude-rules-list' variable.")
 746
 747 (defcustom align-exclude-rules-list
 748   `((exc-dq-string
 749      (regexp . "\"\\([^\"\n]+\\)\"")
 750      (repeat . t)
 751      (modes  . align-dq-string-modes))
 752
 753     (exc-sq-string
 754      (regexp . "'\\([^'\n]+\\)'")
 755      (repeat . t)
 756      (modes  . align-sq-string-modes))
 757
 758     (exc-open-comment
 759      (regexp
 760       . ,(function
 761           (lambda (end reverse)
 762             (funcall (if reverse 're-search-backward
 763                        're-search-forward)
 764                      (concat "[^ \t\n\\\\]"
 765                              (regexp-quote comment-start)
 766                              "\\(.+\\)$") end t))))
 767      (modes  . align-open-comment-modes))
 768
 769     (exc-c-comment
 770      (regexp . "/\\*\\(.+\\)\\*/")
 771      (repeat . t)
 772      (modes  . align-c++-modes))
 773
 774     (exc-c-func-params
 775      (regexp . "(\\([^)\n]+\\))")
 776      (repeat . t)
 777      (modes  . align-c++-modes))
 778
 779     (exc-c-macro
 780      (regexp . "^\\s-*#\\s-*\\(if\\w*\\|endif\\)\\(.*\\)$")
 781      (group  . 2)
 782      (modes  . align-c++-modes)))
 783   "*A list describing text that should be excluded from alignment.
 784 See the documentation for `align-rules-list' for more info."
 785   :type align-exclude-rules-list-type
 786   :group 'align)
 787
 788 (put 'align-exclude-rules-list 'risky-local-variable t)
 789
 790 ;;; Internal Variables:
 791
 792 (defvar align-mode-rules-list nil
 793   "Alignment rules specific to the current major mode.
 794 See the variable `align-rules-list' for more details.")
 795
 796 (make-variable-buffer-local 'align-mode-rules-list)
 797
 798 (defvar align-mode-exclude-rules-list nil
 799   "Alignment exclusion rules specific to the current major mode.
 800 See the variable `align-exclude-rules-list' for more details.")
 801
 802 (make-variable-buffer-local 'align-mode-exclude-rules-list)
 803
 804 (defvar align-highlight-overlays nil
 805   "The current overlays highlighting the text matched by a rule.")
 806
 807 ;; Sample extension rule set, for vhdl-mode.  This should properly be
 808 ;; in vhdl-mode.el itself.
 809
 810 (defcustom align-vhdl-rules-list
 811   `((vhdl-declaration
 812      (regexp   . "\\(signal\\|variable\\|constant\\)\\(\\s-+\\)\\S-")
 813      (group    . 2))
 814
 815     (vhdl-case
 816      (regexp   . "\\(others\\|[^ \t\n=<]\\)\\(\\s-*\\)=>\\(\\s-*\\)\\S-")
 817      (group    . (2 3))
 818      (valid
 819       . ,(function
 820           (lambda ()
 821             (not (string= (downcase (match-string 1))
 822                           "others"))))))
 823
 824     (vhdl-colon
 825      (regexp   . "[^ \t\n:]\\(\\s-*\\):\\(\\s-*\\)[^=\n]")
 826      (group    . (1 2)))
 827
 828     (direction
 829      (regexp   . ":\\s-*\\(in\\|out\\|inout\\|buffer\\)\\(\\s-*\\)")
 830      (group    . 2))
 831
 832     (sig-assign
 833      (regexp   . "[^ \t\n=<]\\(\\s-*\\)<=\\(\\s-*\\)\\S-")
 834      (group    . (1 2)))
 835
 836     (var-assign
 837      (regexp   . "[^ \t\n:]\\(\\s-*\\):="))
 838
 839     (use-entity
 840      (regexp   . "\\(\\s-+\\)use\\s-+entity")))
 841   "*Alignment rules for `vhdl-mode'.  See `align-rules-list' for more info."
 842   :type align-rules-list-type
 843   :group 'align)
 844
 845 (put 'align-vhdl-rules-list 'risky-local-variable t)
 846
 847 (defun align-set-vhdl-rules ()
 848   "Setup the `align-mode-rules-list' variable for `vhdl-mode'."
 849   (setq align-mode-rules-list align-vhdl-rules-list))
 850
 851 (add-hook 'vhdl-mode-hook 'align-set-vhdl-rules)
 852
 853 (add-to-list 'align-dq-string-modes 'vhdl-mode)
 854 (add-to-list 'align-open-comment-modes 'vhdl-mode)
 855
 856 ;;; User Functions:
 857
 858 ;;;###autoload
 859 (defun align (beg end &optional separate rules exclude-rules)
 860   "Attempt to align a region based on a set of alignment rules.
 861 BEG and END mark the region.  If BEG and END are specifically set to
 862 nil (this can only be done programmatically), the beginning and end of
 863 the current alignment section will be calculated based on the location
 864 of point, and the value of `align-region-separate' (or possibly each
 865 rule's `separate' attribute).
 866
 867 If SEPARATE is non-nil, it overrides the value of
 868 `align-region-separate' for all rules, except those that have their
 869 `separate' attribute set.
 870
 871 RULES and EXCLUDE-RULES, if either is non-nil, will replace the
 872 default rule lists defined in `align-rules-list' and
 873 `align-exclude-rules-list'.  See `align-rules-list' for more details
 874 on the format of these lists."
 875   (interactive "r")
 876   (let ((separator
 877          (or separate
 878              (if (and (symbolp align-region-separate)
 879                       (boundp align-region-separate))
 880                  (symbol-value align-region-separate)
 881                align-region-separate)
 882              'entire)))
 883     (if (not (or ;(eq separator 'largest)
 884                  (and (functionp separator)
 885                       (not (funcall separator nil nil)))))
 886         (align-region beg end separator
 887                       (or rules align-mode-rules-list align-rules-list)
 888                       (or exclude-rules align-mode-exclude-rules-list
 889                           align-exclude-rules-list))
 890       (let ((sec-first end)
 891             (sec-last beg))
 892         (align-region beg end
 893                       (or exclude-rules
 894                           align-mode-exclude-rules-list
 895                           align-exclude-rules-list) nil
 896                       separator
 897                       (function
 898                        (lambda (b e mode)
 899                          (when (and mode (listp mode))
 900                            (setq sec-first (min sec-first b)
 901                                  sec-last  (max sec-last e))))))
 902         (if (< sec-first sec-last)
 903             (align-region sec-first sec-last 'entire
 904                           (or rules align-mode-rules-list align-rules-list)
 905                           (or exclude-rules align-mode-exclude-rules-list
 906                               align-exclude-rules-list)))))))
 907
 908 ;;;###autoload
 909 (defun align-regexp (beg end regexp &optional group spacing repeat)
 910   "Align the current region using an ad-hoc rule read from the minibuffer.
 911 BEG and END mark the limits of the region.  This function will prompt
 912 for the REGEXP to align with.  If no prefix arg was specified, you
 913 only need to supply the characters to be lined up and any preceding
 914 whitespace is replaced.  If a prefix arg was specified, the full
 915 regexp with parenthesized whitespace should be supplied; it will also
 916 prompt for which parenthesis GROUP within REGEXP to modify, the amount
 917 of SPACING to use, and whether or not to REPEAT the rule throughout
 918 the line.  See `align-rules-list' for more information about these
 919 options.
 920
 921 For example, let's say you had a list of phone numbers, and wanted to
 922 align them so that the opening parentheses would line up:
 923
 924     Fred (123) 456-7890
 925     Alice (123) 456-7890
 926     Mary-Anne (123) 456-7890
 927     Joe (123) 456-7890
 928
 929 There is no predefined rule to handle this, but you could easily do it
 930 using a REGEXP like \"(\". All you would have to do is to mark the
 931 region, call `align-regexp' and type in that regular expression."
 932   (interactive
 933    (append
 934     (list (region-beginning) (region-end))
 935     (if current-prefix-arg
 936         (list (read-string "Complex align using regexp: "
 937                            "\\(\\s-*\\)")
 938               (string-to-number
 939                (read-string
 940                 "Parenthesis group to modify (justify if negative): " "1"))
 941               (string-to-number
 942                (read-string "Amount of spacing (or column if negative): "
 943                             (number-to-string align-default-spacing)))
 944               (y-or-n-p "Repeat throughout line? "))
 945       (list (concat "\\(\\s-*\\)"
 946                     (read-string "Align regexp: "))
 947             1 align-default-spacing nil))))
 948   (let ((rule
 949          (list (list nil (cons 'regexp regexp)
 950                      (cons 'group (abs group))
 951                      (if (< group 0)
 952                          (cons 'justify t)
 953                        (cons 'bogus nil))
 954                      (if (>= spacing 0)
 955                          (cons 'spacing spacing)
 956                        (cons 'column (abs spacing)))
 957                      (cons 'repeat repeat)))))
 958     (align-region beg end 'entire rule nil nil)))
 959
 960 ;;;###autoload
 961 (defun align-entire (beg end &optional rules exclude-rules)
 962   "Align the selected region as if it were one alignment section.
 963 BEG and END mark the extent of the region.  If RULES or EXCLUDE-RULES
 964 is set to a list of rules (see `align-rules-list'), it can be used to
 965 override the default alignment rules that would have been used to
 966 align that section."
 967   (interactive "r")
 968   (align beg end 'entire rules exclude-rules))
 969
 970 ;;;###autoload
 971 (defun align-current (&optional rules exclude-rules)
 972   "Call `align' on the current alignment section.
 973 This function assumes you want to align only the current section, and
 974 so saves you from having to specify the region.  If RULES or
 975 EXCLUDE-RULES is set to a list of rules (see `align-rules-list'), it
 976 can be used to override the default alignment rules that would have
 977 been used to align that section."
 978   (interactive)
 979   (align nil nil nil rules exclude-rules))
 980
 981 ;;;###autoload
 982 (defun align-highlight-rule (beg end title &optional rules exclude-rules)
 983   "Highlight the whitespace which a given rule would have modified.
 984 BEG and END mark the extent of the region.  TITLE identifies the rule
 985 that should be highlighted.  If RULES or EXCLUDE-RULES is set to a
 986 list of rules (see `align-rules-list'), it can be used to override the
 987 default alignment rules that would have been used to identify the text
 988 to be colored."
 989   (interactive
 990    (list (region-beginning) (region-end)
 991          (completing-read
 992           "Title of rule to highlight: "
 993           (mapcar
 994            (function
 995             (lambda (rule)
 996               (list (symbol-name (car rule)))))
 997            (append (or align-mode-rules-list align-rules-list)
 998                    (or align-mode-exclude-rules-list
 999                        align-exclude-rules-list))) nil t)))
1000   (let ((ex-rule (assq (intern title)
1001                        (or align-mode-exclude-rules-list
1002                            align-exclude-rules-list)))
1003         face)
1004     (align-unhighlight-rule)
1005     (align-region
1006      beg end 'entire
1007      (or rules (if ex-rule
1008                    (or exclude-rules align-mode-exclude-rules-list
1009                        align-exclude-rules-list)
1010                  (or align-mode-rules-list align-rules-list)))
1011      (unless ex-rule (or exclude-rules align-mode-exclude-rules-list
1012                          align-exclude-rules-list))
1013      (function
1014       (lambda (b e mode)
1015         (if (and mode (listp mode))
1016             (if (equal (symbol-name (car mode)) title)
1017                 (setq face (cons align-highlight-change-face
1018                                  align-highlight-nochange-face))
1019               (setq face nil))
1020           (when face
1021             (let ((overlay (make-overlay b e)))
1022               (setq align-highlight-overlays
1023                     (cons overlay align-highlight-overlays))
1024               (overlay-put overlay 'face
1025                            (if mode
1026                                (car face)
1027                              (cdr face)))))))))))
1028
1029 ;;;###autoload
1030 (defun align-unhighlight-rule ()
1031   "Remove any highlighting that was added by `align-highlight-rule'."
1032   (interactive)
1033   (while align-highlight-overlays
1034     (delete-overlay (car align-highlight-overlays))
1035     (setq align-highlight-overlays
1036           (cdr align-highlight-overlays))))
1037
1038 ;;;###autoload
1039 (defun align-newline-and-indent ()
1040   "A replacement function for `newline-and-indent', aligning as it goes."
1041   (interactive)
1042   (let ((separate (or (if (and (symbolp align-region-separate)
1043                                (boundp align-region-separate))
1044                           (symbol-value align-region-separate)
1045                         align-region-separate)
1046                       'entire))
1047         (end (point)))
1048     (call-interactively 'newline-and-indent)
1049     (save-excursion
1050       (forward-line -1)
1051       (while (not (or (bobp)
1052                       (align-new-section-p (point) end separate)))
1053         (forward-line -1))
1054       (align (point) end))))
1055
1056 ;;; Internal Functions:
1057
1058 (defun align-match-tex-pattern (regexp end &optional reverse)
1059   "Match REGEXP in TeX mode, counting backslashes appropriately.
1060 END denotes the end of the region to be searched, while REVERSE, if
1061 non-nil, indicates that the search should proceed backward from the
1062 current position."
1063   (let (result)
1064     (while
1065         (and (setq result
1066                    (funcall
1067                     (if reverse 're-search-backward
1068                       're-search-forward)
1069                     (concat "\\(\\s-*\\)" regexp
1070                             "\\(\\s-*\\)") end t))
1071              (let ((pos (match-end 1))
1072                    (count 0))
1073                (while (and (> pos (point-min))
1074                            (eq (char-before pos) ?\\))
1075                  (setq count (1+ count) pos (1- pos)))
1076                (eq (mod count 2) 1))
1077              (goto-char (match-beginning 2))))
1078     result))
1079
1080 (defun align-new-section-p (beg end separator)
1081   "Is there a section divider between BEG and END?
1082 SEPARATOR specifies how to look for the section divider.  See the
1083 documentation for `align-region-separate' for more details."
1084   (cond ((or (not separator)
1085              (eq separator 'entire))
1086          nil)
1087         ((eq separator 'group)
1088          (let ((amount 2))
1089            (save-excursion
1090              (goto-char end)
1091              (if (bolp)
1092                  (setq amount 1)))
1093            (> (count-lines beg end) amount)))
1094         ((stringp separator)
1095          (save-excursion
1096            (goto-char beg)
1097            (re-search-forward separator end t)))
1098         ((functionp separator)
1099          (funcall separator beg end))
1100         ((listp separator)
1101          (let ((seps separator) yes)
1102            (while seps
1103              (if (and (>= (car seps) beg)
1104                       (<= (car seps) end))
1105                  (setq yes t seps nil)
1106              (setq seps (cdr seps))))
1107            yes))))
1108
1109 (defun align-adjust-col-for-rule (column rule spacing tab-stop)
1110   "Adjust COLUMN according to the given RULE.
1111 SPACING specifies how much spacing to use.
1112 TAB-STOP specifies whether SPACING refers to tab-stop boundaries."
1113   (unless spacing
1114     (setq spacing align-default-spacing))
1115   (if (<= spacing 0)
1116       column
1117     (if (not tab-stop)
1118         (+ column spacing)
1119       (let ((stops tab-stop-list))
1120         (while stops
1121           (if (and (> (car stops) column)
1122                    (= (setq spacing (1- spacing)) 0))
1123               (setq column (car stops)
1124                     stops nil)
1125             (setq stops (cdr stops)))))
1126       column)))
1127
1128 (defsubst align-column (pos)
1129   "Given a position in the buffer, state what column it's in.
1130 POS is the position whose column will be taken.  Note that this
1131 function will change the location of point."
1132   (goto-char pos)
1133   (current-column))
1134
1135 (defsubst align-regions (regions props rule func)
1136   "Align the regions specified in REGIONS, a list of cons cells.
1137 PROPS describes formatting features specific to the given regions.
1138 RULE specifies exactly how to perform the alignments.
1139 If FUNC is specified, it will be called with each region that would
1140 have been aligned, rather than modifying the text."
1141   (while regions
1142     (save-excursion
1143       (align-areas (car regions) (car props) rule func))
1144     (setq regions (cdr regions)
1145           props (cdr props))))
1146
1147 (defun align-areas (areas props rule func)
1148   "Given a list of AREAS and formatting PROPS, align according to RULE.
1149 AREAS should be a list of cons cells containing beginning and ending
1150 markers.  This function sweeps through all of the beginning markers,
1151 finds out which one starts in the furthermost column, and then deletes
1152 and inserts text such that all of the ending markers occur in the same
1153 column.
1154
1155 If FUNC is non-nil, it will be called for each text region that would
1156 have been aligned.  No changes will be made to the buffer."
1157   (let* ((column (cdr (assq 'column rule)))
1158          (fixed (if (symbolp column)
1159                     (symbol-value column)
1160                   column))
1161          (justify (cdr (assq 'justify rule)))
1162          (col (or fixed 0))
1163          (width 0)
1164          ecol change look)
1165
1166     ;; Determine the alignment column.
1167     (let ((a areas))
1168       (while a
1169         (unless fixed
1170           (setq col (max col (align-column (caar a)))))
1171         (unless change
1172           (goto-char (cdar a))
1173           (if ecol
1174               (if (/= ecol (current-column))
1175                   (setq change t))
1176             (setq ecol (current-column))))
1177         (when justify
1178           (goto-char (caar a))
1179           (if (and (re-search-forward "\\s-*" (cdar a) t)
1180                    (/= (point) (cdar a)))
1181               (let ((bcol (current-column)))
1182                 (setcdr (car a) (cons (point-marker) (cdar a)))
1183                 (goto-char (cdr (cdar a)))
1184                 (setq width (max width (- (current-column) bcol))))))
1185         (setq a (cdr a))))
1186
1187     (unless fixed
1188       (setq col (+ (align-adjust-col-for-rule
1189                     col rule (car props) (cdr props)) width)))
1190
1191     ;; Make all ending positions to occur in the goal column.  Since
1192     ;; the whitespace to be modified was already deleted by
1193     ;; `align-region', all we have to do here is indent.
1194
1195     (unless change
1196       (setq change (and ecol (/= col ecol))))
1197
1198     (when (or func change)
1199       (while areas
1200         (let ((area (car areas))
1201               (gocol col) cur)
1202           (when area
1203             (if func
1204                 (funcall func (car area) (cdr area) change)
1205               (if (not (and justify
1206                             (consp (cdr area))))
1207                   (goto-char (cdr area))
1208                 (goto-char (cddr area))
1209                 (let ((ecol (current-column)))
1210                   (goto-char (cadr area))
1211                   (setq gocol (- col (- ecol (current-column))))))
1212               (setq cur (current-column))
1213               (cond ((< gocol 0) t)     ; don't do anything
1214                     ((= cur gocol) t)   ; don't need to
1215                     ((< cur gocol)      ; just add space
1216                      ;; FIXME: It is stated above that "...the
1217                      ;;        whitespace to be modified was already
1218                      ;;        deleted by `align-region', all we have
1219                      ;;        to do here is indent."  However, this
1220                      ;;        doesn't seem to be true, so we first
1221                      ;;        delete the whitespace to avoid tabs
1222                      ;;        after spaces.
1223                      (delete-horizontal-space t)
1224                      (indent-to gocol))
1225                     (t
1226                      ;; This code works around an oddity in the
1227                      ;; FORCE argument of `move-to-column', which
1228                      ;; tends to screw up markers if there is any
1229                      ;; tabbing.
1230                      (let ((endcol (align-column
1231                                     (if (and justify
1232                                              (consp (cdr area)))
1233                                         (cadr area)
1234                                       (cdr area))))
1235                            (abuts (<= gocol
1236                                       (align-column (car area)))))
1237                        (if abuts
1238                            (goto-char (car area))
1239                          (move-to-column gocol t))
1240                        (let ((here (point)))
1241                          (move-to-column endcol t)
1242                          (delete-region here (point))
1243                          (if abuts
1244                              (indent-to (align-adjust-col-for-rule
1245                                          (current-column) rule
1246                                          (car props) (cdr props)))))))))))
1247         (setq areas (cdr areas))))))
1248
1249 (defun align-region (beg end separate rules exclude-rules
1250                          &optional func)
1251   "Align a region based on a given set of alignment rules.
1252 BEG and END specify the region to be aligned.  Either may be nil, in
1253 which case the range will stop at the nearest section division (see
1254 `align-region-separate', and `align-region-heuristic' for more
1255 information').
1256
1257 The region will be divided into separate alignment sections based on
1258 the value of SEPARATE.
1259
1260 RULES and EXCLUDE-RULES are a pair of lists describing how to align
1261 the region, and which text areas within it should be excluded from
1262 alignment.  See the `align-rules-list' for more information on the
1263 required format of these two lists.
1264
1265 If FUNC is specified, no text will be modified.  What `align-region'
1266 will do with the rules is to search for the alignment areas, as it
1267 regularly would, taking account for exclusions, and then call FUNC,
1268 first with the beginning and ending of the region to be aligned
1269 according to that rule (this can be different for each rule, if BEG
1270 and END were nil), and then with the beginning and ending of each
1271 text region that the rule would have applied to.
1272
1273 The signature of FUNC should thus be:
1274
1275  (defun my-align-function (beg end mode)
1276    \"If MODE is a rule (a list), return t if BEG to END are to be searched.
1277 Otherwise BEG to END will be a region of text that matches the rule's
1278 definition, and MODE will be non-nil if any changes are necessary.\"
1279    (unless (and mode (listp mode))
1280      (message \"Would have aligned from %d to %d...\" beg end)))
1281
1282 This feature (of passing a FUNC) is used internally to locate the
1283 position of exclusion areas, but could also be used for any other
1284 purpose where you might want to know where the regions that the
1285 aligner would have dealt with are."
1286   (let ((end-mark (and end (copy-marker end t)))
1287         (real-beg beg)
1288         (real-end end)
1289         (report (and (not func) align-large-region beg end
1290                      (>= (- end beg) align-large-region)))
1291         (rule-index 1)
1292         (rule-count (length rules)))
1293     (if (and align-indent-before-aligning real-beg end-mark)
1294         (indent-region real-beg end-mark nil))
1295     (while rules
1296       (let* ((rule (car rules))
1297              (run-if (assq 'run-if rule))
1298              (modes (assq 'modes rule)))
1299         ;; unless the `run-if' form tells us not to, look for the
1300         ;; rule..
1301         (unless (or (and modes (not (memq major-mode
1302                                           (eval (cdr modes)))))
1303                     (and run-if (not (funcall (cdr run-if)))))
1304           (let* ((current-case-fold case-fold-search)
1305                  (case-fold (assq 'case-fold rule))
1306                  (regexp  (cdr (assq 'regexp rule)))
1307                  (regfunc (and (functionp regexp) regexp))
1308                  (rulesep (assq 'separate rule))
1309                  (thissep (if rulesep (cdr rulesep) separate))
1310                  same (eol 0)
1311                  group group-c
1312                  spacing spacing-c
1313                  tab-stop tab-stop-c
1314                  repeat repeat-c
1315                  valid valid-c
1316                  pos-list first
1317                  regions index
1318                  last-point b e
1319                  save-match-data
1320                  exclude-p
1321                  align-props)
1322             (save-excursion
1323               ;; if beg and end were not given, figure out what the
1324               ;; current alignment region should be.  Depending on the
1325               ;; value of `align-region-separate' it's possible for
1326               ;; each rule to have its own definition of what that
1327               ;; current alignment section is.
1328               (if real-beg
1329                   (goto-char beg)
1330                 (if (or (not thissep) (eq thissep 'entire))
1331                     (error "Cannot determine alignment region for '%s'"
1332                            (symbol-name (cdr (assq 'title rule)))))
1333                 (beginning-of-line)
1334                 (while (and (not (eobp))
1335                             (looking-at "^\\s-*$"))
1336                   (forward-line))
1337                 (let* ((here (point))
1338                        (start here))
1339                   (while (and here
1340                               (let ((terminus
1341                                      (and align-region-heuristic
1342                                           (- (point)
1343                                              align-region-heuristic))))
1344                                 (if regfunc
1345                                     (funcall regfunc terminus t)
1346                                   (re-search-backward regexp
1347                                                       terminus t))))
1348                     (if (align-new-section-p (point) here thissep)
1349                         (setq beg here
1350                               here nil)
1351                       (setq here (point))))
1352                   (if (not here)
1353                       (goto-char beg))
1354                   (beginning-of-line)
1355                   (setq beg (point))
1356                   (goto-char start)
1357                   (setq here (point))
1358                   (while (and here
1359                               (let ((terminus
1360                                      (and align-region-heuristic
1361                                           (+ (point)
1362                                              align-region-heuristic))))
1363                                 (if regfunc
1364                                     (funcall regfunc terminus nil)
1365                                   (re-search-forward regexp terminus t))))
1366                     (if (align-new-section-p here (point) thissep)
1367                         (setq end here
1368                               here nil)
1369                       (setq here (point))))
1370                   (if (not here)
1371                       (goto-char end))
1372                   (forward-line)
1373                   (setq end (point)
1374                         end-mark (copy-marker end t))
1375                   (goto-char beg)))
1376
1377               ;; If we have a region to align, and `func' is set and
1378               ;; reports back that the region is ok, then align it.
1379               (when (or (not func)
1380                         (funcall func beg end rule))
1381                 (unwind-protect
1382                     (let (exclude-areas)
1383                       ;; determine first of all where the exclusions
1384                       ;; lie in this region
1385                       (when exclude-rules
1386                         ;; guard against a problem with recursion and
1387                         ;; dynamic binding vs. lexical binding, since
1388                         ;; the call to `align-region' below will
1389                         ;; re-enter this function, and rebind
1390                         ;; `exclude-areas'
1391                         (set (setq exclude-areas
1392                                    (make-symbol "align-exclude-areas"))
1393                              nil)
1394                         (align-region
1395                          beg end 'entire
1396                          exclude-rules nil
1397                          `(lambda (b e mode)
1398                             (or (and mode (listp mode))
1399                                 (set (quote ,exclude-areas)
1400                                      (cons (cons b e)
1401                                            ,exclude-areas)))))
1402                         (setq exclude-areas
1403                               (sort (symbol-value exclude-areas)
1404                                     (function
1405                                      (lambda (l r)
1406                                        (>= (car l) (car r)))))))
1407
1408                       ;; set `case-fold-search' according to the
1409                       ;; (optional) `case-fold' property
1410                       (and case-fold
1411                            (setq case-fold-search (cdr case-fold)))
1412
1413                       ;; while we can find the rule in the alignment
1414                       ;; region..
1415                       (while (and (< (point) end-mark)
1416                                   (if regfunc
1417                                       (funcall regfunc end-mark nil)
1418                                     (re-search-forward regexp
1419                                                        end-mark t)))
1420
1421                         ;; give the user some indication of where we
1422                         ;; are, if it's a very large region being
1423                         ;; aligned
1424                         (if report
1425                             (let ((symbol (car rule)))
1426                               (if (and symbol (symbolp symbol))
1427                                   (message
1428                                    "Aligning `%s' (rule %d of %d) %d%%..."
1429                                    (symbol-name symbol) rule-index rule-count
1430                                    (/ (* (- (point) real-beg) 100)
1431                                       (- end-mark real-beg)))
1432                                 (message
1433                                  "Aligning %d%%..."
1434                                  (/ (* (- (point) real-beg) 100)
1435                                     (- end-mark real-beg))))))
1436
1437                         ;; if the search ended us on the beginning of
1438                         ;; the next line, move back to the end of the
1439                         ;; previous line.
1440                         (if (bolp)
1441                             (forward-char -1))
1442
1443                         ;; lookup the `group' attribute the first time
1444                         ;; that we need it
1445                         (unless group-c
1446                           (setq group (or (cdr (assq 'group rule)) 1))
1447                           (if (listp group)
1448                               (setq first (car group))
1449                             (setq first group group (list group)))
1450                           (setq group-c t))
1451
1452                         (unless spacing-c
1453                           (setq spacing (cdr (assq 'spacing rule))
1454                                 spacing-c t))
1455
1456                         (unless tab-stop-c
1457                           (setq tab-stop
1458                                 (let ((rule-ts (assq 'tab-stop rule)))
1459                                   (if rule-ts
1460                                       (cdr rule-ts)
1461                                     (if (symbolp align-to-tab-stop)
1462                                         (symbol-value align-to-tab-stop)
1463                                       align-to-tab-stop)))
1464                                 tab-stop-c t))
1465
1466                         ;; test whether we have found a match on the same
1467                         ;; line as a previous match
1468                         (if (> (point) eol)
1469                             (setq same nil
1470                                   eol (save-excursion
1471                                         (end-of-line)
1472                                         (point-marker))))
1473
1474                         ;; lookup the `repeat' attribute the first time
1475                         (or repeat-c
1476                             (setq repeat (cdr (assq 'repeat rule))
1477                                   repeat-c t))
1478
1479                         ;; lookup the `valid' attribute the first time
1480                         (or valid-c
1481                             (setq valid (assq 'valid rule)
1482                                   valid-c t))
1483
1484                         ;; remember the beginning position of this rule
1485                         ;; match, and save the match-data, since either
1486                         ;; the `valid' form, or the code that searches for
1487                         ;; section separation, might alter it
1488                         (setq b (match-beginning first)
1489                               save-match-data (match-data))
1490
1491                         ;; unless the `valid' attribute is set, and tells
1492                         ;; us that the rule is not valid at this point in
1493                         ;; the code..
1494                         (unless (and valid (not (funcall (cdr valid))))
1495
1496                           ;; look to see if this match begins a new
1497                           ;; section.  If so, we should align what we've
1498                           ;; collected so far, and then begin collecting
1499                           ;; anew for the next alignment section
1500                           (if (and last-point
1501                                    (align-new-section-p last-point b
1502                                                         thissep))
1503                               (progn
1504                                 (align-regions regions align-props
1505                                                rule func)
1506                                 (setq last-point (copy-marker b t)
1507                                       regions nil
1508                                       align-props nil))
1509                             (setq last-point (copy-marker b t)))
1510
1511                           ;; restore the match data
1512                           (set-match-data save-match-data)
1513
1514                           ;; check whether the region to be aligned
1515                           ;; straddles an exclusion area
1516                           (let ((excls exclude-areas))
1517                             (setq exclude-p nil)
1518                             (while excls
1519                               (if (and (< (match-beginning (car group))
1520                                           (cdar excls))
1521                                        (> (match-end (car (last group)))
1522                                           (caar excls)))
1523                                   (setq exclude-p t
1524                                         excls nil)
1525                                 (setq excls (cdr excls)))))
1526
1527                           ;; go through the list of parenthesis groups
1528                           ;; matching whitespace text to be
1529                           ;; contracted/expanded (or possibly
1530                           ;; justified, if the `justify' attribute was
1531                           ;; set)
1532                           (unless exclude-p
1533                             (let ((g group))
1534                               (while g
1535
1536                                 ;; we have to use markers, since
1537                                 ;; `align-areas' may modify the buffer
1538                                 (setq b (copy-marker
1539                                          (match-beginning (car g)) t)
1540                                       e (copy-marker (match-end (car g)) t))
1541
1542                                 ;; record this text region for alignment
1543                                 (setq index (if same (1+ index) 0))
1544                                 (let ((region (cons b e))
1545                                       (props (cons
1546                                               (if (listp spacing)
1547                                                   (car spacing)
1548                                                 spacing)
1549                                               (if (listp tab-stop)
1550                                                   (car tab-stop)
1551                                                 tab-stop))))
1552                                   (if (nth index regions)
1553                                       (setcar (nthcdr index regions)
1554                                               (cons region
1555                                                     (nth index regions)))
1556                                     (if regions
1557                                         (progn
1558                                           (nconc regions
1559                                                  (list (list region)))
1560                                           (nconc align-props (list props)))
1561                                       (setq regions
1562                                             (list (list region)))
1563                                       (setq align-props (list props)))))
1564
1565                                 ;; if any further rule matches are
1566                                 ;; found before `eol', then they are
1567                                 ;; on the same line as this one; this
1568                                 ;; can only happen if the `repeat'
1569                                 ;; attribute is non-nil
1570                                 (if (listp spacing)
1571                                     (setq spacing (cdr spacing)))
1572                                 (if (listp tab-stop)
1573                                     (setq tab-stop (cdr tab-stop)))
1574                                 (setq same t g (cdr g))))
1575
1576                             ;; if `repeat' has not been set, move to
1577                             ;; the next line; don't bother searching
1578                             ;; anymore on this one
1579                             (if (and (not repeat) (not (bolp)))
1580                                 (forward-line)))))
1581
1582                       ;; when they are no more matches for this rule,
1583                       ;; align whatever was left over
1584                       (if regions
1585                           (align-regions regions align-props rule func)))
1586
1587                   (setq case-fold-search current-case-fold)))))))
1588       (setq rules (cdr rules)
1589             rule-index (1+ rule-index)))
1590
1591     (if report
1592         (message "Aligning...done"))))
1593
1594 ;; Provide:
1595
1596 (provide 'align)
1597
1598 (run-hooks 'align-load-hook)
1599
1600 ;;; arch-tag: ef79cccf-1db8-4888-a8a1-d7ce2d1532f7
1601 ;;; align.el ends here