Rewrite Eshell tests using ERT

[bpt/emacs.git] / lisp / align.el

diff --git a/lisp/align.el b/lisp/align.el
index 83e27da..1b62042 100644 (file)
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1,6 +1,6 @@
 ;;; align.el --- align text to a specific column, by regexp
 
 ;;; 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
 
 ;; Author: John Wiegley <johnw@gnu.org>
 ;; 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
 ;; 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.
 
 ;; 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
 ;; 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
 ;; 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))))
 
             (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."
   "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)
         (justify (cdr (assq 'justify rule)))
         (col (or fixed 0))
         (width 0)

-        ecol change look)
+        ecol change)

 
     ;; Determine the alignment column.
     (let ((a areas))
 
     ;; 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
              (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))
              (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))))))
 
                                         (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.
 (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)
 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)
        (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
     (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
                 (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
                 spacing spacing-c
                 tab-stop tab-stop-c
                 repeat repeat-c
                 valid valid-c

-                pos-list first
+                first

                 regions index
                 regions index

-                last-point b e
+                last-point

                 save-match-data
                 exclude-p
                 align-props)
                 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)
                  (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
                  (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
              (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
                      ;; 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
                        ;; 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 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)))
                        (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
                                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
 
                        ;; 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
                        ;; 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
                              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
                          ;; 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)
 
                          ;; 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
                          (let ((excls exclude-areas))
                            (setq exclude-p nil)
                            (while excls

-                             (if (and (< (match-beginning (car group))
+                             (if (and (< (match-beginning (car groups))

                                          (cdar excls))
                                          (cdar excls))

-                                      (> (match-end (car (last group)))
+                                      (> (match-end (car (last groups)))

                                          (caar excls)))
                                  (setq exclude-p t
                                        excls nil)
                                (setq excls (cdr excls)))))
 
                                          (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
                          (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))
                                (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
 
                            ;; 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)))
                  (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"))))
 
     (if report
        (message "Aligning...done"))))