]> code.delx.au - gnu-emacs/blobdiff - lisp/align.el
* net/tramp.el (tramp-ssh-controlmaster-template): Make it a
[gnu-emacs] / lisp / align.el
index 911200f58adb3e9577661c65d4c5c1446f10b130..1b62042be75745669aefb10d296a55e7b4d56d1a 100644 (file)
@@ -1,7 +1,6 @@
 ;;; align.el --- align text to a specific column, by regexp
 
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <johnw@gnu.org>
 ;; Maintainer: FSF
@@ -75,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.
 
 ;; 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
   "An integer that represents the default amount of padding to use.
 If `align-to-tab-stop' is non-nil, this will represent the number of
 tab stops to use for alignment, rather than the number of spaces.
-Each alignment rule can optionally override both this variable.  See
-`align-mode-alist'."
+Each alignment rule can optionally override both this variable and
+`align-to-tab-stop'.  See `align-rules-list'."
   :type 'integer
   :group 'align)
 
@@ -157,8 +156,8 @@ Since each alignment rule can possibly have its own set of alignment
 sections (whenever `align-region-separate' is non-nil, and not a
 string), this heuristic is used to determine how far before and after
 point we should search in looking for a region separator.  Larger
-values can mean slower perform in large files, although smaller values
-may cause unexpected behavior at times."
+values can mean slower performance in large files, although smaller
+values may cause unexpected behavior at times."
   :type 'integer
   :group 'align)
 
@@ -174,7 +173,7 @@ may cause unexpected behavior at times."
 
 (defcustom align-large-region 10000
   "If an integer, defines what constitutes a \"large\" region.
-If nil,then no messages will ever be printed to the minibuffer."
+If nil, then no messages will ever be printed to the minibuffer."
   :type 'integer
   :group 'align)
 
@@ -184,7 +183,7 @@ If nil,then no messages will ever be printed to the minibuffer."
   :group 'align)
 
 (defcustom align-perl-modes '(perl-mode cperl-mode)
-  "A list of modes where perl syntax is to be seen."
+  "A list of modes where Perl syntax is to be seen."
   :type '(repeat symbol)
   :group 'align)
 
@@ -222,7 +221,7 @@ If nil,then no messages will ever be printed to the minibuffer."
   (append align-lisp-modes align-c++-modes align-perl-modes
          '(python-mode makefile-mode))
   "A list of modes with a single-line comment syntax.
-These are comments as in Lisp, which have a beginning but, end with
+These are comments as in Lisp, which have a beginning, but end with
 the line (i.e., `comment-end' is an empty string)."
   :type '(repeat symbol)
   :group 'align)
@@ -259,8 +258,8 @@ The possible settings for `align-region-separate' are:
 
  `group'   Each contiguous set of lines where a specific alignment
           occurs is considered a section for that alignment rule.
-          Note that each rule will may have any entirely different
-          set of section divisions than another.
+          Note that each rule may have any entirely different set
+           of section divisions than another.
 
             int    alpha = 1; /* one */
             double beta  = 2.0;
@@ -292,7 +291,7 @@ The possible settings for `align-region-separate' are:
           between sections, the behavior will be very similar to
           `largest', and faster.  But if the mode does not use clear
           separators (for example, if you collapse your braces onto
-          the preceding statement in C or perl), `largest' is
+          the preceding statement in C or Perl), `largest' is
           probably the better alternative.
 
  function  A function that will be passed the beginning and ending
@@ -301,8 +300,8 @@ The possible settings for `align-region-separate' are:
           both of these parameters will be nil, in which case the
           function should return non-nil if it wants each rule to
           define its own section, or nil if it wants the largest
-          section found to be used as the common section for all rules
-          that occur there.
+          section found to be used as the common section for all
+          rules that occur there.
 
  list      A list of markers within the buffer that represent where
           the section dividers lie.  Be certain to use markers!  For
@@ -623,8 +622,8 @@ The following attributes are meaningful:
            the purposes of alignment.  The \"alignment character\" is
            always the first character immediately following this
            parenthesis group.  This attribute may also be a list of
-           integer, in which case multiple alignment characters will
-           be aligned, with the list of integer identifying the
+           integers, in which case multiple alignment characters will
+           be aligned, with the list of integers identifying the
            whitespace groups which precede them.  The default for
            this attribute is 1.
 
@@ -636,7 +635,7 @@ The following attributes are meaningful:
 `case-fold' If `regexp' is an ordinary regular expression string
            containing alphabetic character, sometimes you may want
            the search to proceed case-insensitively (for languages
-           that ignore case, such as pascal for example).  In that
+           that ignore case, such as Pascal for example).  In that
            case, set `case-fold' to a non-nil value, and the regular
            expression search will ignore case.  If `regexp' is set to
            a function, that function must handle the job of ignoring
@@ -926,7 +925,7 @@ align them so that the opening parentheses would line up:
     Joe (123) 456-7890
 
 There is no predefined rule to handle this, but you could easily do it
-using a REGEXP like \"(\". All you would have to do is to mark the
+using a REGEXP like \"(\".  All you would have to do is to mark the
 region, call `align-regexp' and type in that regular expression."
   (interactive
    (append
@@ -944,6 +943,8 @@ region, call `align-regexp' and type in that regular expression."
       (list (concat "\\(\\s-*\\)"
                    (read-string "Align regexp: "))
            1 align-default-spacing nil))))
+  (or group (setq group 1))
+  (or spacing (setq spacing align-default-spacing))
   (let ((rule
         (list (list nil (cons 'regexp regexp)
                     (cons 'group (abs group))
@@ -1105,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."
@@ -1160,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))
@@ -1200,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))
@@ -1245,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.
@@ -1284,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
@@ -1307,14 +1318,15 @@ aligner would have dealt with are."
                 (rulesep (assq 'separate rule))
                 (thissep (if rulesep (cdr rulesep) separate))
                 same (eol 0)
-                group group-c
+                search-start
+                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)
@@ -1369,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
@@ -1378,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
@@ -1412,6 +1424,7 @@ aligner would have dealt with are."
                      ;; 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
@@ -1436,17 +1449,16 @@ aligner would have dealt with are."
                        ;; if the search ended us on the beginning of
                        ;; the next line, move back to the end of the
                        ;; previous line.
-                       (if (bolp)
+                       (if (and (bolp) (> (point) search-start))
                            (forward-char -1))
 
                        ;; 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))
@@ -1455,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
@@ -1484,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
@@ -1496,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)
@@ -1515,68 +1523,71 @@ 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
                            ;; anymore on this one
                            (if (and (not repeat) (not (bolp)))
-                               (forward-line)))))
+                               (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
@@ -1586,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"))))
@@ -1596,5 +1612,4 @@ aligner would have dealt with are."
 
 (run-hooks 'align-load-hook)
 
-;; arch-tag: ef79cccf-1db8-4888-a8a1-d7ce2d1532f7
 ;;; align.el ends here