]> git.eshelyaron.com Git - emacs.git/commitdiff
* lisp/align.el: Use lexical-binding.
authorStefan Monnier <monnier@iro.umontreal.ca>
Tue, 20 Aug 2013 22:13:29 +0000 (18:13 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Tue, 20 Aug 2013 22:13:29 +0000 (18:13 -0400)
(align-region): Simplify accordingly.

lisp/ChangeLog
lisp/align.el

index d8c4797434e69499c8595e543936f4722c45bcd9..8e33b30f6978aaea4e1c72c4783d1bd80f2e5f90 100644 (file)
@@ -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'.
index 3d2ca192245ce5bd7d2153229b047c8f074b42be..6f55ac9faf17ae1a9a41d595c5bce9366ffa7a4e 100644 (file)
@@ -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