bug#16818: Acknowledgement (Undo in region after markers in undo history relocated)

[Barry OReilly <gundaetiapo@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 206 bytes --]

> The primitive-undo fix should be safe enough for 24.4, so if you
> want to code this up and install it, feel free.

I have attached the patch for this, which I'll install if nothing
comes up from review.

[-- Attachment #1.2: Type: text/html, Size: 258 bytes --]

[-- Attachment #2: undo-skip-markers.diff --]
[-- Type: text/plain, Size: 16365 bytes --]

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a1ee5bb..a53f5d6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2014-03-13  Barry O'Reilly  <gundaetiapo@gmail.com>
+
+	* simple.el (primitive-undo): When adjusting a marker, check that
+	its position is still valid.  (Bug#16818)
+	(undo-make-selective-list): Determine whether a marker adjustment
+	is in the region based on whether the deletion that recorded it in
+	undo history is in the region.  Remove variable adjusted-markers,
+	which was unused and only non nil during undo-make-selective-list.
+	(undo-elt-in-region): New optional argument MARKER-VALIDITY-POS.
+
 2014-03-13  Dmitry Gutov  <dgutov@yandex.ru>
 
 	* progmodes/ruby-mode.el (ruby-font-lock-keywords): Fontify
diff --git a/lisp/simple.el b/lisp/simple.el
index 881a633..a72cf8b 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2229,85 +2229,90 @@ Return what remains of the list."
         (did-apply nil)
         (next nil))
     (while (> arg 0)
-      (while (setq next (pop list))     ;Exit inner loop at undo boundary.
-        ;; Handle an integer by setting point to that value.
-        (pcase next
-          ((pred integerp) (goto-char next))
-          ;; Element (t . TIME) records previous modtime.
-          ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
-          ;; UNKNOWN_MODTIME_NSECS.
-          (`(t . ,time)
-           ;; If this records an obsolete save
-           ;; (not matching the actual disk file)
-           ;; then don't mark unmodified.
-           (when (or (equal time (visited-file-modtime))
-                     (and (consp time)
-                          (equal (list (car time) (cdr time))
-                                 (visited-file-modtime))))
-             (when (fboundp 'unlock-buffer)
-               (unlock-buffer))
-             (set-buffer-modified-p nil)))
-          ;; Element (nil PROP VAL BEG . END) is property change.
-          (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
-           (when (or (> (point-min) beg) (< (point-max) end))
-             (error "Changes to be undone are outside visible portion of buffer"))
-           (put-text-property beg end prop val))
-          ;; Element (BEG . END) means range was inserted.
-          (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
-           ;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp)))
-           ;; Ideally: `(,(pred integerp beg) . ,(pred integerp end))
-           (when (or (> (point-min) beg) (< (point-max) end))
-             (error "Changes to be undone are outside visible portion of buffer"))
-           ;; Set point first thing, so that undoing this undo
-           ;; does not send point back to where it is now.
-           (goto-char beg)
-           (delete-region beg end))
-          ;; Element (apply FUN . ARGS) means call FUN to undo.
-          (`(apply . ,fun-args)
-           (let ((currbuff (current-buffer)))
-             (if (integerp (car fun-args))
-                 ;; Long format: (apply DELTA START END FUN . ARGS).
-                 (pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args)
-                              (start-mark (copy-marker start nil))
-                              (end-mark (copy-marker end t)))
-                   (when (or (> (point-min) start) (< (point-max) end))
-                     (error "Changes to be undone are outside visible portion of buffer"))
-                   (apply fun args) ;; Use `save-current-buffer'?
-                   ;; Check that the function did what the entry
-                   ;; said it would do.
-                   (unless (and (= start start-mark)
-                                (= (+ delta end) end-mark))
-                     (error "Changes to be undone by function different than announced"))
-                   (set-marker start-mark nil)
-                   (set-marker end-mark nil))
-               (apply fun-args))
-             (unless (eq currbuff (current-buffer))
-               (error "Undo function switched buffer"))
-             (setq did-apply t)))
-          ;; Element (STRING . POS) means STRING was deleted.
-          (`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
-           (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)))
-          ;; (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))))
-          (_ (error "Unrecognized entry in undo list %S" next))))
+      (let (del-pos)
+        (while (setq next (pop list))     ;Exit inner loop at undo boundary.
+          ;; Handle an integer by setting point to that value.
+          (pcase next
+            ((pred integerp) (goto-char next))
+            ;; Element (t . TIME) records previous modtime.
+            ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
+            ;; UNKNOWN_MODTIME_NSECS.
+            (`(t . ,time)
+             ;; If this records an obsolete save
+             ;; (not matching the actual disk file)
+             ;; then don't mark unmodified.
+             (when (or (equal time (visited-file-modtime))
+                       (and (consp time)
+                            (equal (list (car time) (cdr time))
+                                   (visited-file-modtime))))
+               (when (fboundp 'unlock-buffer)
+                 (unlock-buffer))
+               (set-buffer-modified-p nil)))
+            ;; Element (nil PROP VAL BEG . END) is property change.
+            (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
+             (when (or (> (point-min) beg) (< (point-max) end))
+               (error "Changes to be undone are outside visible portion of buffer"))
+             (put-text-property beg end prop val))
+            ;; Element (BEG . END) means range was inserted.
+            (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
+             ;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp)))
+             ;; Ideally: `(,(pred integerp beg) . ,(pred integerp end))
+             (when (or (> (point-min) beg) (< (point-max) end))
+               (error "Changes to be undone are outside visible portion of buffer"))
+             ;; Set point first thing, so that undoing this undo
+             ;; does not send point back to where it is now.
+             (goto-char beg)
+             (delete-region beg end))
+            ;; Element (apply FUN . ARGS) means call FUN to undo.
+            (`(apply . ,fun-args)
+             (let ((currbuff (current-buffer)))
+               (if (integerp (car fun-args))
+                   ;; Long format: (apply DELTA START END FUN . ARGS).
+                   (pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args)
+                                (start-mark (copy-marker start nil))
+                                (end-mark (copy-marker end t)))
+                     (when (or (> (point-min) start) (< (point-max) end))
+                       (error "Changes to be undone are outside visible portion of buffer"))
+                     (apply fun args) ;; Use `save-current-buffer'?
+                     ;; Check that the function did what the entry
+                     ;; said it would do.
+                     (unless (and (= start start-mark)
+                                  (= (+ delta end) end-mark))
+                       (error "Changes to be undone by function different than announced"))
+                     (set-marker start-mark nil)
+                     (set-marker end-mark nil))
+                 (apply fun-args))
+               (unless (eq currbuff (current-buffer))
+                 (error "Undo function switched buffer"))
+               (setq did-apply t)))
+            ;; Element (STRING . POS) means STRING was deleted.
+            (`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
+             (when (let ((apos (abs pos)))
+                     (or (< apos (point-min)) (> apos (point-max))))
+               (error "Changes to be undone are outside visible portion of buffer"))
+             (setq del-pos pos)
+             (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)))
+            ;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
+            (`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
+             (when (and del-pos
+                        (integerp (marker-position marker))
+                        (= del-pos marker)
+                        (marker-buffer marker))
+               (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,
     ;; so the test in `undo' for continuing an undo series
@@ -2341,8 +2346,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,18 +2354,30 @@ 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
+        ;; The position of a deletion record (TEXT . POSITION) of the
+        ;; current change group.
+        ;;
+        ;; This is used to check that marker adjustmenets are in the
+        ;; region.  Bug 16818 describes why the marker's position is
+        ;; not suitable.
+        del-pos
 	some-rejected
 	undo-elt temp-undo-list delta)
     (while undo-list-copy
       (setq undo-elt (car undo-list-copy))
+      ;; Update del-pos
+      (if undo-elt
+          (when (and (consp undo-elt) (stringp (car undo-elt)))
+            (setq del-pos (cdr undo-elt)))
+        ;; Undo boundary means new change group, so unset del-pos
+        (setq del-pos nil))
       (let ((keep-this
 	     (cond ((and (consp undo-elt) (eq (car undo-elt) t))
 		    ;; This is a "was unmodified" element.
 		    ;; Keep it if we have kept everything thus far.
 		    (not some-rejected))
 		   (t
-		    (undo-elt-in-region undo-elt start end)))))
+		    (undo-elt-in-region undo-elt start end del-pos)))))
 	(if keep-this
 	    (progn
 	      (setq end (+ end (cdr (undo-delta undo-elt))))
@@ -2415,9 +2430,13 @@ we stop and ignore all further elements."
       (setq undo-list-copy (cdr undo-list-copy)))
     (nreverse undo-list)))
 
-(defun undo-elt-in-region (undo-elt start end)
+(defun undo-elt-in-region (undo-elt start end &optional marker-validity-pos)
   "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.
+
+If undo-elt is a (MARKER . ADJUSTMENT) record, either
+MARKER-VALIDITY-POS (if specified) or the marker's position is
+used to determine whether it is in the region."
   (cond ((integerp undo-elt)
 	 (and (>= undo-elt start)
 	      (<= undo-elt end)))
@@ -2430,17 +2449,9 @@ 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)
+         (let ((mpos (or marker-validity-pos (marker-position (car undo-elt)))))
+           (and (integerp mpos) (<= start mpos end))))
 	((null (car undo-elt))
 	 ;; (nil PROPERTY VALUE BEG . END)
 	 (let ((tail (nthcdr 3 undo-elt)))
diff --git a/test/ChangeLog b/test/ChangeLog
index c87022c..e7ee14e 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,11 @@
+2014-03-13  Barry O'Reilly  <gundaetiapo@gmail.com>
+
+	* undo-tests.el (undo-test-marker-adjustment-nominal): New test of
+	marker adjustments.
+	(undo-test-marker-adjustment-moved):
+	(undo-test-region-mark-adjustment): Two new test to demonstrate
+	bug#16818.
+
 2014-03-07  Michael Albinus  <michael.albinus@gmx.de>
 
 	* automated/tramp-tests.el (tramp-copy-size-limit): Declare.
diff --git a/test/automated/undo-tests.el b/test/automated/undo-tests.el
index 8a963f1..a348549 100644
--- a/test/automated/undo-tests.el
+++ b/test/automated/undo-tests.el
@@ -268,6 +268,80 @@
     (should (string= (buffer-string)
                      "This sentence corrupted?aaa"))))
 
+(ert-deftest undo-test-marker-adjustment-nominal ()
+  "Test nominal behavior of marker adjustments."
+  (with-temp-buffer
+    (buffer-enable-undo)
+    (insert "abcdefg")
+    (undo-boundary)
+    (let ((m (make-marker)))
+      (set-marker m 2 (current-buffer))
+      (goto-char (point-min))
+      (delete-forward-char 3)
+      (undo-boundary)
+      (should (= (point-min) (marker-position m)))
+      (undo)
+      (undo-boundary)
+      (should (= 2 (marker-position m))))))
+
+(ert-deftest undo-test-marker-adjustment-moved ()
+  "Test marker adjustment behavior when the marker moves.
+Demonstrates bug 16818."
+  (with-temp-buffer
+    (buffer-enable-undo)
+    (insert "abcdefghijk")
+    (undo-boundary)
+    (let ((m (make-marker)))
+      (set-marker m 2 (current-buffer)) ; m at b
+      (goto-char (point-min))
+      (delete-forward-char 3) ; m at d
+      (undo-boundary)
+      (set-marker m 4) ; m at g
+      (undo)
+      (undo-boundary)
+      ;; m still at g, but shifted 3 because deletion undone
+      (should (= 7 (marker-position m))))))
+
+(ert-deftest undo-test-region-mark-adjustment ()
+  "Test that the mark's marker adjustment in undo history doesn't
+obstruct undo in region from finding the correct change group.
+Demonstrates bug 16818."
+  (with-temp-buffer
+    (buffer-enable-undo)
+    (transient-mark-mode 1)
+    (insert "First line\n")
+    (insert "Second line\n")
+    (undo-boundary)
+
+    (goto-char (point-min))
+    (insert "aaa")
+    (undo-boundary)
+
+    (undo)
+    (undo-boundary)
+
+    (goto-char (point-max))
+    (insert "bbb")
+    (undo-boundary)
+
+    (push-mark (point) t t)
+    (setq mark-active t)
+    (goto-char (- (point) 3))
+    (delete-forward-char 1)
+    (undo-boundary)
+
+    (insert "bbb")
+    (undo-boundary)
+
+    (goto-char (point-min))
+    (push-mark (point) t t)
+    (setq mark-active t)
+    (goto-char (+ (point) 3))
+    (undo)
+    (undo-boundary)
+
+    (should (string= (buffer-string) "aaaFirst line\nSecond line\nbbb"))))
+
 (defun undo-test-all (&optional interactive)
   "Run all tests for \\[undo]."
   (interactive "p")