Undo in region after markers in undo history relocated

* simple.el (primitive-undo): Only process marker adjustments
validated against their corresponding (TEXT . POS).  Issue warning
for lone marker adjustments in undo history.  (Bug#16818)
(undo-make-selective-list): Add marker adjustments to selective
undo list based on whether their corresponding (TEXT . POS) is in
the region.  Remove variable adjusted-markers, which was unused
and only non nil during undo-make-selective-list.
(undo-elt-in-region): Return nil when passed a marker adjustment
and explain in function doc.

Have (MARKER . ADJUSTMENT) undo records always be immediately
after their corresponding (TEXT . POS) record in undo list.
(Bug#16818)
* lisp.h (record-delete): New arg record_markers.
(record_marker_adjustment): No longer needed outside undo.c.
* insdel.c (adjust_markers_for_delete): Move calculation of marker
adjustments to undo.c's record_marker_adjustments.  Note that
fileio.c's decide_coding_unwind is another caller to
adjust_markers_for_delete.  Because it has undo list bound to t,
it does not rely on adjust_markers_for_delete to record marker
adjustments.
(del_range_2): Swap call to record_delete and
adjust_markers_for_delete so as undo marker adjustments are
recorded before current deletion's adjustments, as before.
(adjust_after_replace):
(replace_range): Pass value for new record_markers arg to
delete_record.
* undo.c (record_marker_adjustment): Renamed to
record_marker_adjustments and made static.
(record_delete): Check record_markers arg and call
record_marker_adjustments.
(record_change): Pass value for new record_markers arg to
delete_record.
(record_point): at_boundary calculation no longer needs to account
for marker adjustments.

* undo-tests.el (undo-test-marker-adjustment-nominal):
(undo-test-region-t-marker): New tests of marker adjustments.
(undo-test-marker-adjustment-moved):
(undo-test-region-mark-adjustment): New tests to demonstrate
bug#16818, which fail without the fix.

* markers.texi (Moving Marker Positions): The 2014-03-02 doc
change mentioning undo's inability to handle relocated markers no
longer applies.  See bug#16818.
* text.texi (Undo): Expand documentation of (TEXT . POS) and
(MARKER . ADJUSTMENT) undo elements.

2 files changed, 71 insertions, 34 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 667b85729d7..b34a0b8bd7e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2014-03-24  Barry O'Reilly  <gundaetiapo@gmail.com>
+
+        * simple.el (primitive-undo): Only process marker adjustments
+        validated against their corresponding (TEXT . POS).  Issue warning
+        for lone marker adjustments in undo history.  (Bug#16818)
+        (undo-make-selective-list): Add marker adjustments to selective
+        undo list based on whether their corresponding (TEXT . POS) is in
+        the region.  Remove variable adjusted-markers, which was unused
+        and only non nil during undo-make-selective-list.
+        (undo-elt-in-region): Return nil when passed a marker adjustment
+        and explain in function doc.
+
 2014-03-24  Dmitry Gutov  <dgutov@yandex.ru>
 
         * emacs-lisp/package.el (package--add-to-archive-contents):
diff --git a/lisp/simple.el b/lisp/simple.el
index c8350005acc..7be1f1f6399 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2289,24 +2289,41 @@ Return what remains of the list."
            (when (let ((apos (abs pos)))
                    (or (< apos (point-min)) (> apos (point-max))))
              (error "Changes to be undone are outside visible portion of buffer"))
-           (if (< pos 0)
-               (progn
-                 (goto-char (- pos))
-                 (insert string))
-             (goto-char pos)
-             ;; Now that we record marker adjustments
-             ;; (caused by deletion) for undo,
-             ;; we should always insert after markers,
-             ;; so that undoing the marker adjustments
-             ;; put the markers back in the right place.
-             (insert string)
-             (goto-char pos)))
+           (let (valid-marker-adjustments)
+             ;; Check that marker adjustments which were recorded
+             ;; with the (STRING . POS) record are still valid, ie
+             ;; the markers haven't moved.  We check their validity
+             ;; before reinserting the string so as we don't need to
+             ;; mind marker insertion-type.
+             (while (and (markerp (car-safe (car list)))
+                         (integerp (cdr-safe (car list))))
+               (let* ((marker-adj (pop list))
+                      (m (car marker-adj)))
+                 (and (eq (marker-buffer m) (current-buffer))
+                      (= pos m)
+                      (push marker-adj valid-marker-adjustments))))
+             ;; Insert string and adjust point
+             (if (< pos 0)
+                 (progn
+                   (goto-char (- pos))
+                   (insert string))
+               (goto-char pos)
+               (insert string)
+               (goto-char pos))
+             ;; Adjust the valid marker adjustments
+             (dolist (adj valid-marker-adjustments)
+               (set-marker (car adj)
+                           (- (car adj) (cdr adj))))))
           ;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
           (`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
-           (when (marker-buffer marker)
-             (set-marker marker
-                         (- marker offset)
-                         (marker-buffer marker))))
+           (warn "Encountered %S entry in undo list with no matching (TEXT . POS) entry"
+                 next)
+           ;; Even though these elements are not expected in the undo
+           ;; list, adjust them to be conservative for the 24.4
+           ;; release.  (Bug#16818)
+           (set-marker marker
+                       (- marker offset)
+                       (marker-buffer marker)))
           (_ (error "Unrecognized entry in undo list %S" next))))
       (setq arg (1- arg)))
     ;; Make sure an apply entry produces at least one undo entry,
@@ -2341,8 +2358,6 @@ are ignored.  If BEG and END are nil, all undo elements are used."
             (undo-make-selective-list (min beg end) (max beg end))
           buffer-undo-list)))
 
-(defvar undo-adjusted-markers)
-
 (defun undo-make-selective-list (start end)
   "Return a list of undo elements for the region START to END.
 The elements come from `buffer-undo-list', but we keep only
@@ -2351,7 +2366,6 @@ If we find an element that crosses an edge of this region,
 we stop and ignore all further elements."
   (let ((undo-list-copy (undo-copy-list buffer-undo-list))
         (undo-list (list nil))
-        undo-adjusted-markers
         some-rejected
         undo-elt temp-undo-list delta)
     (while undo-list-copy
@@ -2361,15 +2375,30 @@ we stop and ignore all further elements."
                     ;; This is a "was unmodified" element.
                     ;; Keep it if we have kept everything thus far.
                     (not some-rejected))
+                   ;; Skip over marker adjustments, instead relying on
+                   ;; finding them after (TEXT . POS) elements
+                   ((markerp (car-safe undo-elt))
+                    nil)
                    (t
                     (undo-elt-in-region undo-elt start end)))))
         (if keep-this
             (progn
               (setq end (+ end (cdr (undo-delta undo-elt))))
               ;; Don't put two nils together in the list
-              (if (not (and (eq (car undo-list) nil)
-                            (eq undo-elt nil)))
-                  (setq undo-list (cons undo-elt undo-list))))
+              (when (not (and (eq (car undo-list) nil)
+                              (eq undo-elt nil)))
+                (setq undo-list (cons undo-elt undo-list))
+                ;; If (TEXT . POS), "keep" its subsequent (MARKER
+                ;; . ADJUSTMENT) whose markers haven't moved.
+                (when (and (stringp (car-safe undo-elt))
+                           (integerp (cdr-safe undo-elt)))
+                  (let ((list-i (cdr undo-list-copy)))
+                    (while (markerp (car-safe (car list-i)))
+                      (let* ((adj-elt (pop list-i))
+                             (m (car adj-elt)))
+                        (and (eq (marker-buffer m) (current-buffer))
+                             (= (cdr undo-elt) m)
+                             (push adj-elt undo-list))))))))
           (if (undo-elt-crosses-region undo-elt start end)
               (setq undo-list-copy nil)
             (setq some-rejected t)
@@ -2417,7 +2446,12 @@ we stop and ignore all further elements."
 
 (defun undo-elt-in-region (undo-elt start end)
   "Determine whether UNDO-ELT falls inside the region START ... END.
-If it crosses the edge, we return nil."
+If it crosses the edge, we return nil.
+
+Generally this function is not useful for determining
+whether (MARKER . ADJUSTMENT) undo elements are in the region,
+because markers can be arbitrarily relocated.  Instead, pass the
+marker adjustment's corresponding (TEXT . POS) element."
   (cond ((integerp undo-elt)
          (and (>= undo-elt start)
               (<= undo-elt end)))
@@ -2430,17 +2464,8 @@ If it crosses the edge, we return nil."
          (and (>= (abs (cdr undo-elt)) start)
               (<= (abs (cdr undo-elt)) end)))
         ((and (consp undo-elt) (markerp (car undo-elt)))
-         ;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
-         ;; See if MARKER is inside the region.
-         (let ((alist-elt (assq (car undo-elt) undo-adjusted-markers)))
-           (unless alist-elt
-             (setq alist-elt (cons (car undo-elt)
-                                   (marker-position (car undo-elt))))
-             (setq undo-adjusted-markers
-                   (cons alist-elt undo-adjusted-markers)))
-           (and (cdr alist-elt)
-                (>= (cdr alist-elt) start)
-                (<= (cdr alist-elt) end))))
+         ;; (MARKER . ADJUSTMENT)
+         (<= start (car undo-elt) end))
         ((null (car undo-elt))
          ;; (nil PROPERTY VALUE BEG . END)
          (let ((tail (nthcdr 3 undo-elt)))