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