merge from trunk

2 files changed, 203 insertions, 211 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d8c4797434e..8e33b30f697 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-20  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * align.el: Use lexical-binding.
+        (align-region): Simplify accordingly.
+
 2013-08-20  Michael Albinus  <michael.albinus@gmx.de>
 
         * minibuffer.el (completion--sifn-requote): Bind `non-essential'.
diff --git a/lisp/align.el b/lisp/align.el
index 3d2ca192245..6f55ac9faf1 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1,4 +1,4 @@
-;;; align.el --- align text to a specific column, by regexp
+;;; align.el --- align text to a specific column, by regexp -*- lexical-binding:t -*-
 
 ;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
 
@@ -1325,7 +1325,7 @@ aligner would have dealt with are."
         (unless (or (and modes (not (memq major-mode
                                           (eval (cdr modes)))))
                     (and run-if (not (funcall (cdr run-if)))))
-          (let* ((current-case-fold case-fold-search)
+          (let* ((case-fold-search case-fold-search)
                  (case-fold (assq 'case-fold rule))
                  (regexp  (cdr (assq 'regexp rule)))
                  (regfunc (and (functionp regexp) regexp))
@@ -1403,215 +1403,202 @@ aligner would have dealt with are."
               ;; reports back that the region is ok, then align it.
               (when (or (not func)
                         (funcall func beg end rule))
-                (unwind-protect
-                    (let (rule-beg exclude-areas)
-                      ;; determine first of all where the exclusions
-                      ;; lie in this region
-                      (when exclude-rules
-                        ;; guard against a problem with recursion and
-                        ;; dynamic binding vs. lexical binding, since
-                        ;; the call to `align-region' below will
-                        ;; re-enter this function, and rebind
-                        ;; `exclude-areas'
-                        (set (setq exclude-areas
-                                   (make-symbol "align-exclude-areas"))
-                             nil)
-                        (align-region
-                         beg end 'entire
-                         exclude-rules nil
-                         `(lambda (b e mode)
-                            (or (and mode (listp mode))
-                                (set (quote ,exclude-areas)
-                                     (cons (cons b e)
-                                           ,exclude-areas)))))
-                        (setq exclude-areas
-                              (sort (symbol-value exclude-areas)
-                                    (function
-                                     (lambda (l r)
-                                       (>= (car l) (car r)))))))
-
-                      ;; set `case-fold-search' according to the
-                      ;; (optional) `case-fold' property
-                      (and case-fold
-                           (setq case-fold-search (cdr case-fold)))
-
-                      ;; while we can find the rule in the alignment
-                      ;; region..
-                      (while (and (< (point) end-mark)
-                                  (setq search-start (point))
-                                  (if regfunc
-                                      (funcall regfunc end-mark nil)
-                                    (re-search-forward regexp
-                                                       end-mark t)))
-
-                        ;; give the user some indication of where we
-                        ;; are, if it's a very large region being
-                        ;; aligned
-                        (if report
-                            (let ((symbol (car rule)))
-                              (if (and symbol (symbolp symbol))
-                                  (message
-                                   "Aligning `%s' (rule %d of %d) %d%%..."
-                                   (symbol-name symbol) rule-index rule-count
-                                   (/ (* (- (point) real-beg) 100)
-                                      (- end-mark real-beg)))
-                                (message
-                                 "Aligning %d%%..."
-                                 (/ (* (- (point) real-beg) 100)
-                                    (- end-mark real-beg))))))
-
-                        ;; if the search ended us on the beginning of
-                        ;; the next line, move back to the end of the
-                        ;; previous line.
-                        (if (and (bolp) (> (point) search-start))
-                            (forward-char -1))
-
-                        ;; lookup the `group' attribute the first time
-                        ;; that we need it
-                        (unless group-c
-                          (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))
-                                spacing-c t))
-
-                        (unless tab-stop-c
-                          (setq tab-stop
-                                (let ((rule-ts (assq 'tab-stop rule)))
-                                  (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
-                        (when (> (point) eol)
-                          (setq same nil)
-                          (align--set-marker eol (line-end-position)))
-
-                        ;; lookup the `repeat' attribute the first time
-                        (or repeat-c
-                            (setq repeat (cdr (assq 'repeat rule))
-                                  repeat-c t))
-
-                        ;; lookup the `valid' attribute the first time
-                        (or valid-c
-                            (setq valid (assq 'valid rule)
-                                  valid-c t))
-
-                        ;; remember the beginning position of this rule
-                        ;; match, and save the match-data, since either
-                        ;; the `valid' form, or the code that searches for
-                        ;; section separation, might alter it
-                        (setq rule-beg (match-beginning first)
-                              save-match-data (match-data))
-
-                        (or rule-beg
-                            (error "No match for subexpression %s" first))
-
-                        ;; unless the `valid' attribute is set, and tells
-                        ;; us that the rule is not valid at this point in
-                        ;; the code..
-                        (unless (and valid (not (funcall (cdr valid))))
-
-                          ;; look to see if this match begins a new
-                          ;; section.  If so, we should align what we've
-                          ;; collected so far, and then begin collecting
-                          ;; anew for the next alignment section
-                          (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)
-
-                          ;; check whether the region to be aligned
-                          ;; straddles an exclusion area
-                          (let ((excls exclude-areas))
-                            (setq exclude-p nil)
-                            (while excls
-                              (if (and (< (match-beginning (car groups))
-                                          (cdar excls))
-                                       (> (match-end (car (last groups)))
-                                          (caar excls)))
-                                  (setq exclude-p t
-                                        excls nil)
-                                (setq excls (cdr excls)))))
-
-                          ;; go through the parenthesis groups
-                          ;; matching whitespace to be contracted or
-                          ;; expanded (or possibly justified, if the
-                          ;; `justify' attribute was set)
-                          (unless exclude-p
-                            (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))
-                                (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
-                            ;; anymore on this one
-                            (if (and (not repeat) (not (bolp)))
-                                (forward-line))
-
-                            ;; if the search did not change point,
-                            ;; move forward to avoid an infinite loop
-                            (if (= (point) search-start)
-                                (forward-char)))))
-
-                      ;; when they are no more matches for this rule,
-                      ;; align whatever was left over
-                      (if regions
-                          (align-regions regions align-props rule func)))
-
-                  (setq case-fold-search current-case-fold)))))))
+                (let (rule-beg exclude-areas)
+                  ;; determine first of all where the exclusions
+                  ;; lie in this region
+                  (when exclude-rules
+                    (align-region
+                     beg end 'entire
+                     exclude-rules nil
+                     (lambda (b e mode)
+                       (or (and mode (listp mode))
+                           (setq exclude-areas
+                                 (cons (cons b e)
+                                       exclude-areas)))))
+                    (setq exclude-areas
+                          (nreverse
+                           (sort exclude-areas #'car-less-than-car))))
+
+                  ;; set `case-fold-search' according to the
+                  ;; (optional) `case-fold' property
+                  (and case-fold
+                       (setq case-fold-search (cdr case-fold)))
+
+                  ;; while we can find the rule in the alignment
+                  ;; region..
+                  (while (and (< (point) end-mark)
+                              (setq search-start (point))
+                              (if regfunc
+                                  (funcall regfunc end-mark nil)
+                                (re-search-forward regexp
+                                                   end-mark t)))
+
+                    ;; give the user some indication of where we
+                    ;; are, if it's a very large region being
+                    ;; aligned
+                    (if report
+                        (let ((symbol (car rule)))
+                          (if (and symbol (symbolp symbol))
+                              (message
+                               "Aligning `%s' (rule %d of %d) %d%%..."
+                               (symbol-name symbol) rule-index rule-count
+                               (/ (* (- (point) real-beg) 100)
+                                  (- end-mark real-beg)))
+                            (message
+                             "Aligning %d%%..."
+                             (/ (* (- (point) real-beg) 100)
+                                (- end-mark real-beg))))))
+
+                    ;; if the search ended us on the beginning of
+                    ;; the next line, move back to the end of the
+                    ;; previous line.
+                    (if (and (bolp) (> (point) search-start))
+                        (forward-char -1))
+
+                    ;; lookup the `group' attribute the first time
+                    ;; that we need it
+                    (unless group-c
+                      (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))
+                            spacing-c t))
+
+                    (unless tab-stop-c
+                      (setq tab-stop
+                            (let ((rule-ts (assq 'tab-stop rule)))
+                              (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
+                    (when (> (point) eol)
+                      (setq same nil)
+                      (align--set-marker eol (line-end-position)))
+
+                    ;; lookup the `repeat' attribute the first time
+                    (or repeat-c
+                        (setq repeat (cdr (assq 'repeat rule))
+                              repeat-c t))
+
+                    ;; lookup the `valid' attribute the first time
+                    (or valid-c
+                        (setq valid (assq 'valid rule)
+                              valid-c t))
+
+                    ;; remember the beginning position of this rule
+                    ;; match, and save the match-data, since either
+                    ;; the `valid' form, or the code that searches for
+                    ;; section separation, might alter it
+                    (setq rule-beg (match-beginning first)
+                          save-match-data (match-data))
+
+                    (or rule-beg
+                        (error "No match for subexpression %s" first))
+
+                    ;; unless the `valid' attribute is set, and tells
+                    ;; us that the rule is not valid at this point in
+                    ;; the code..
+                    (unless (and valid (not (funcall (cdr valid))))
+
+                      ;; look to see if this match begins a new
+                      ;; section.  If so, we should align what we've
+                      ;; collected so far, and then begin collecting
+                      ;; anew for the next alignment section
+                      (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)
+
+                      ;; check whether the region to be aligned
+                      ;; straddles an exclusion area
+                      (let ((excls exclude-areas))
+                        (setq exclude-p nil)
+                        (while excls
+                          (if (and (< (match-beginning (car groups))
+                                      (cdar excls))
+                                   (> (match-end (car (last groups)))
+                                      (caar excls)))
+                              (setq exclude-p t
+                                    excls nil)
+                            (setq excls (cdr excls)))))
+
+                      ;; go through the parenthesis groups
+                      ;; matching whitespace to be contracted or
+                      ;; expanded (or possibly justified, if the
+                      ;; `justify' attribute was set)
+                      (unless exclude-p
+                        (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))
+                            (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
+                        ;; anymore on this one
+                        (if (and (not repeat) (not (bolp)))
+                            (forward-line))
+
+                        ;; if the search did not change point,
+                        ;; move forward to avoid an infinite loop
+                        (if (= (point) search-start)
+                            (forward-char)))))
+
+                  ;; when they are no more matches for this rule,
+                  ;; align whatever was left over
+                  (if regions
+                      (align-regions regions align-props rule func))))))))
       (setq rules (cdr rules)
             rule-index (1+ rule-index)))
     ;; This function can use a lot of temporary markers, so instead of