;;; align.el --- align text to a specific column, by regexp
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: FSF
;; align-?-modes variables (for example, `align-dq-string-modes'), use
;; `add-to-list', or some similar function which checks first to see
;; if the value is already there. Since the user may customize that
-;; mode list, and then write your mode name into their .emacs file,
+;; mode list, and then write your mode name into their init file,
;; causing the symbol already to be present the next time they load
;; your package.
;; simple algorithm that understand only basic regular expressions.
;; Parts of the code were broken up and included in vhdl-mode.el
;; around this time. After several comments from users, and a need to
-;; find a more robust, performant algorithm, 2.0 was born in late
+;; find a more robust, higher performing algorithm, 2.0 was born in late
;; 1998. Many different approaches were taken (mostly due to the
;; complexity of TeX tables), but finally a scheme was discovered
;; which worked fairly well for most common usage cases. Development
(gocol col) cur)
(when area
(if func
- (funcall func (car area) (cdr area) change)
+ (funcall func
+ (marker-position (car area))
+ (marker-position (cdr area))
+ change)
(if (not (and justify
(consp (cdr area))))
(goto-char (cdr area))
(car props) (cdr props)))))))))))
(setq areas (cdr areas))))))
+(defmacro align--set-marker (marker-var pos &optional type)
+ "If MARKER-VAR is a marker, move it to position POS.
+Otherwise, create a new marker at position POS, with type TYPE."
+ `(if (markerp ,marker-var)
+ (move-marker ,marker-var ,pos)
+ (setq ,marker-var (copy-marker ,pos ,type))))
+
(defun align-region (beg end separate rules exclude-rules
&optional func)
"Align a region based on a given set of alignment rules.
(report (and (not func) align-large-region beg end
(>= (- end beg) align-large-region)))
(rule-index 1)
- (rule-count (length rules)))
+ (rule-count (length rules))
+ markers)
(if (and align-indent-before-aligning real-beg end-mark)
(indent-region real-beg end-mark nil))
(while rules
(thissep (if rulesep (cdr rulesep) separate))
same (eol 0)
search-start
- group group-c
+ groups group-c
spacing spacing-c
tab-stop tab-stop-c
repeat repeat-c
valid valid-c
first
regions index
- last-point b e
+ last-point
save-match-data
exclude-p
align-props)
(if (not here)
(goto-char end))
(forward-line)
- (setq end (point)
- end-mark (copy-marker end t))
+ (setq end (point))
+ (align--set-marker end-mark end t)
(goto-char beg)))
;; If we have a region to align, and `func' is set and
(when (or (not func)
(funcall func beg end rule))
(unwind-protect
- (let (exclude-areas)
+ (let (rule-beg exclude-areas)
;; determine first of all where the exclusions
;; lie in this region
(when exclude-rules
;; lookup the `group' attribute the first time
;; that we need it
(unless group-c
- (setq group (or (cdr (assq 'group rule)) 1))
- (if (listp group)
- (setq first (car group))
- (setq first group group (list group)))
- (setq group-c t))
+ (setq groups (or (cdr (assq 'group rule)) 1))
+ (unless (listp groups)
+ (setq groups (list groups)))
+ (setq first (car groups)))
(unless spacing-c
(setq spacing (cdr (assq 'spacing rule))
(unless tab-stop-c
(setq tab-stop
(let ((rule-ts (assq 'tab-stop rule)))
- (if rule-ts
- (cdr rule-ts)
- (if (symbolp align-to-tab-stop)
- (symbol-value align-to-tab-stop)
- align-to-tab-stop)))
+ (cond (rule-ts
+ (cdr rule-ts))
+ ((symbolp align-to-tab-stop)
+ (symbol-value align-to-tab-stop))
+ (t
+ align-to-tab-stop)))
tab-stop-c t))
;; test whether we have found a match on the same
;; line as a previous match
- (if (> (point) eol)
- (setq same nil
- eol (save-excursion
- (end-of-line)
- (point-marker))))
+ (when (> (point) eol)
+ (setq same nil)
+ (align--set-marker eol (line-end-position)))
;; lookup the `repeat' attribute the first time
(or repeat-c
;; match, and save the match-data, since either
;; the `valid' form, or the code that searches for
;; section separation, might alter it
- (setq b (match-beginning first)
+ (setq rule-beg (match-beginning first)
save-match-data (match-data))
;; unless the `valid' attribute is set, and tells
;; section. If so, we should align what we've
;; collected so far, and then begin collecting
;; anew for the next alignment section
- (if (and last-point
- (align-new-section-p last-point b
- thissep))
- (progn
- (align-regions regions align-props
- rule func)
- (setq last-point (copy-marker b t)
- regions nil
- align-props nil))
- (setq last-point (copy-marker b t)))
+ (when (and last-point
+ (align-new-section-p last-point rule-beg
+ thissep))
+ (align-regions regions align-props rule func)
+ (setq regions nil)
+ (setq align-props nil))
+ (align--set-marker last-point rule-beg t)
;; restore the match data
(set-match-data save-match-data)
(let ((excls exclude-areas))
(setq exclude-p nil)
(while excls
- (if (and (< (match-beginning (car group))
+ (if (and (< (match-beginning (car groups))
(cdar excls))
- (> (match-end (car (last group)))
+ (> (match-end (car (last groups)))
(caar excls)))
(setq exclude-p t
excls nil)
(setq excls (cdr excls)))))
- ;; go through the list of parenthesis groups
- ;; matching whitespace text to be
- ;; contracted/expanded (or possibly
- ;; justified, if the `justify' attribute was
- ;; set)
+ ;; go through the parenthesis groups
+ ;; matching whitespace to be contracted or
+ ;; expanded (or possibly justified, if the
+ ;; `justify' attribute was set)
(unless exclude-p
- (let ((g group))
- (while g
-
- ;; we have to use markers, since
- ;; `align-areas' may modify the buffer
- (setq b (copy-marker
- (match-beginning (car g)) t)
- e (copy-marker (match-end (car g)) t))
-
- ;; record this text region for alignment
+ (dolist (g groups)
+ ;; We must use markers, since
+ ;; `align-areas' may modify the buffer.
+ ;; Avoid polluting the markers.
+ (let* ((group-beg (copy-marker
+ (match-beginning g) t))
+ (group-end (copy-marker
+ (match-end g) t))
+ (region (cons group-beg group-end))
+ (props (cons (if (listp spacing)
+ (car spacing)
+ spacing)
+ (if (listp tab-stop)
+ (car tab-stop)
+ tab-stop))))
+ (push group-beg markers)
+ (push group-end markers)
(setq index (if same (1+ index) 0))
- (let ((region (cons b e))
- (props (cons
- (if (listp spacing)
- (car spacing)
- spacing)
- (if (listp tab-stop)
- (car tab-stop)
- tab-stop))))
- (if (nth index regions)
- (setcar (nthcdr index regions)
- (cons region
- (nth index regions)))
- (if regions
- (progn
- (nconc regions
- (list (list region)))
- (nconc align-props (list props)))
- (setq regions
- (list (list region)))
- (setq align-props (list props)))))
-
- ;; if any further rule matches are
- ;; found before `eol', then they are
- ;; on the same line as this one; this
- ;; can only happen if the `repeat'
- ;; attribute is non-nil
- (if (listp spacing)
- (setq spacing (cdr spacing)))
- (if (listp tab-stop)
- (setq tab-stop (cdr tab-stop)))
- (setq same t g (cdr g))))
+ (cond
+ ((nth index regions)
+ (setcar (nthcdr index regions)
+ (cons region
+ (nth index regions))))
+ (regions
+ (nconc regions
+ (list (list region)))
+ (nconc align-props (list props)))
+ (t
+ (setq regions
+ (list (list region)))
+ (setq align-props (list props)))))
+ ;; If any further rule matches are found
+ ;; before `eol', they are on the same
+ ;; line as this one; this can only
+ ;; happen if the `repeat' attribute is
+ ;; non-nil.
+ (if (listp spacing)
+ (setq spacing (cdr spacing)))
+ (if (listp tab-stop)
+ (setq tab-stop (cdr tab-stop)))
+ (setq same t))
;; if `repeat' has not been set, move to
;; the next line; don't bother searching
(setq case-fold-search current-case-fold)))))))
(setq rules (cdr rules)
rule-index (1+ rule-index)))
+ ;; This function can use a lot of temporary markers, so instead of
+ ;; waiting for the next GC we delete them immediately (Bug#10047).
+ (set-marker end-mark nil)
+ (dolist (m markers)
+ (set-marker m nil))
(if report
(message "Aligning...done"))))