cgit.sxemacs.org Git - packages/blob - xemacs-packages/edit-utils/align.el

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