X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/84eb0351d8be4811897c8cf62a69757ff5d14001..d20e6e9093f74ce2e435a3dac948df200e767405:/lisp/align.el diff --git a/lisp/align.el b/lisp/align.el index 83e27daece..1b62042be7 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -1,6 +1,6 @@ ;;; 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 ;; Maintainer: FSF @@ -74,7 +74,7 @@ ;; 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. @@ -109,7 +109,7 @@ ;; 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 @@ -1106,7 +1106,7 @@ documentation for `align-region-separate' for more details." (setq seps (cdr seps)))) yes)))) -(defun align-adjust-col-for-rule (column rule spacing tab-stop) +(defun align-adjust-col-for-rule (column _rule spacing tab-stop) "Adjust COLUMN according to the given RULE. SPACING specifies how much spacing to use. TAB-STOP specifies whether SPACING refers to tab-stop boundaries." @@ -1161,7 +1161,7 @@ have been aligned. No changes will be made to the buffer." (justify (cdr (assq 'justify rule))) (col (or fixed 0)) (width 0) - ecol change look) + ecol change) ;; Determine the alignment column. (let ((a areas)) @@ -1201,7 +1201,10 @@ have been aligned. No changes will be made to the buffer." (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)) @@ -1246,6 +1249,13 @@ have been aligned. No changes will be made to the buffer." (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. @@ -1285,11 +1295,11 @@ purpose where you might want to know where the regions that the aligner would have dealt with are." (let ((end-mark (and end (copy-marker end t))) (real-beg beg) - (real-end end) (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 @@ -1309,14 +1319,14 @@ aligner would have dealt with are." (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 - pos-list first + first regions index - last-point b e + last-point save-match-data exclude-p align-props) @@ -1371,8 +1381,8 @@ aligner would have dealt with are." (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 @@ -1380,7 +1390,7 @@ aligner would have dealt with are." (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 @@ -1445,11 +1455,10 @@ aligner would have dealt with are." ;; 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)) @@ -1458,20 +1467,19 @@ aligner would have dealt with are." (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 @@ -1487,7 +1495,7 @@ aligner would have dealt with are." ;; 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 @@ -1499,16 +1507,13 @@ aligner would have dealt with are." ;; 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) @@ -1518,62 +1523,60 @@ aligner would have dealt with are." (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 @@ -1594,6 +1597,11 @@ aligner would have dealt with are." (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"))))