align.el 54 KB

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