>> What makes more sense to me is that the old value of mark-marker is
>> pushed onto the rings, then a new marker object is created to
>> become the value of mark-marker. Then the marker adjustment records
>> would reference the right markers. Effectively this means the mark
>> would follow the advice of the Elisp manual excerpt above.
> That sounds right. I don't have time to really understand the ins
> and outs, but if you can write an ERT test case for it, we could
> install the change.
At the end is a patch to implement this. I wrote the marker-tests to
make sure I didn't break anything too badly, they pass with or without
the rest of the patch. The new undo-test-mark-adjustment implements
the recipe of this bug report. It fails with current trunk and passes
with the patch.
Of the original symptoms of this bug report, the patch solves:
>> Strangely, the selection mark at BOL moves forward three chars
but not:
>> * Unexpectedly, "aaa" is not reinserted back into the buffer
> is due to the selection mark and another marker occupying their own
> change group in the filtered pending-undo-list, and that change
> group is chosen for the first undo in region.
The selection mark is no longer "in the way" on the pending-undo-list,
but the another marker still is. It only is when the recipe is carried
out manually apparently, because the marker is not there when the
recipe is carried out in the undo-test-mark-adjustment. IOW, the ERT
test passes the same test case that fails when carried out manually.
Debugging the C sources, I find the offending marker in the
pending-undo-list is first created at the following C and Lisp
backtraces:
Obtained 31 stack frames.
./src/emacs [0x52c2b4]
./src/emacs(Fmake_overlay+0xf2) [0x526062]
./src/emacs(Ffuncall+0x371) [0x5729c1]
./src/emacs(exec_byte_code+0x3a5) [0x5a42e5]
./src/emacs(Ffuncall+0x20c) [0x57285c]
./src/emacs(exec_byte_code+0x3a5) [0x5a42e5]
./src/emacs(Ffuncall+0x20c) [0x57285c]
./src/emacs(exec_byte_code+0x3a5) [0x5a42e5]
./src/emacs(Ffuncall+0x20c) [0x57285c]
./src/emacs(eval_sub+0x6a8) [0x572118]
./src/emacs(internal_lisp_condition_case+0x21b) [0x574cbb]
./src/emacs(exec_byte_code+0x12fa) [0x5a523a]
./src/emacs(Ffuncall+0x20c) [0x57285c]
./src/emacs(Fapply+0x2c7) [0x572fe7]
./src/emacs(Ffuncall+0x422) [0x572a72]
./src/emacs(exec_byte_code+0x3a5) [0x5a42e5]
./src/emacs(Ffuncall+0x20c) [0x57285c]
./src/emacs(internal_condition_case_n+0xfe) [0x5713ce]
./src/emacs(safe_call+0x138) [0x463298]
./src/emacs [0x4814f4]
./src/emacs(read_char+0x965) [0x50f3b5]
./src/emacs [0x510bad]
./src/emacs(command_loop_1+0x27e) [0x51267e]
./src/emacs(internal_condition_case+0xda) [0x57101a]
./src/emacs [0x5097ca]
./src/emacs(internal_catch+0xd8) [0x570ef8]
./src/emacs(recursive_edit_1+0x120) [0x508d00]
./src/emacs(Frecursive_edit+0xc7) [0x50a687]
./src/emacs(main+0x8ed) [0x5016ad]
/lib64/libc.so.6(__libc_start_main+0xf4) [0x31cf01d994]
./src/emacs [0x43b369]
make-overlay(192 193)
#[1028 "Ã! Ã\!ÂÃÃ#ÂÃÃ
Ã#ÂÂÂÃ!p=Â4Ã!=Â4Ã!=Â;Ãp$ÂÂ" [redisplay-unhighlight-region-function overlayp make-overlay overlay-put window face region overlay-buffer overlay-start overlay-end move-overlay] 9 "
(fn START END WINDOW ROL)"](192 193 #<window 3 on *scratch*> nil)
redisplay--update-region-highlight(#<window 3 on *scratch*>)
#[0 "âÂ
Ãà !Ââ<ÂÃÃ
ÃÂÃ#  Â\"ÃÃâ\"Âà Â
)à âÂÂ
SÂ@ÂÃ =Â>Â=ÂEÃ!ÂÂL
ÃÃ\"!ÂA¶ÂÂ+²Â" [((#<window 3 on *scratch*>)) highlight-nonselected-windows redisplay-unhighlight-region-function redisplay--update-region-highlight selected-window window-list-1 nil t mapc window-minibuffer-p minibuffer-selected-window window-parameter internal-region-overlay] 7 "
(fn)"]()
funcall(#[0 "âÂ
Ãà !Ââ<ÂÃÃ
ÃÂÃ#  Â\"ÃÃâ\"Âà Â
)à âÂÂ
SÂ@ÂÃ =Â>Â=ÂEÃ!ÂÂL
ÃÃ\"!ÂA¶ÂÂ+²Â" [((#<window 3 on *scratch*>)) highlight-nonselected-windows redisplay-unhighlight-region-function redisplay--update-region-highlight selected-window window-list-1 nil t mapc window-minibuffer-p minibuffer-selected-window window-parameter internal-region-overlay] 7 "
(fn)"])
redisplay--update-region-highlights((#<window 3 on *scratch*>))
apply(redisplay--update-region-highlights (#<window 3 on *scratch*>))
#[128 "ÃÃ\"ÂÃÃ\"Â" [apply redisplay--update-region-highlights ignore nil] 4 nil nil]((#<window 3 on *scratch*>))
redisplay_internal\ \(C\ function\)()
Following the redisplay code indicated, it looks like the same overlay
object is reused for subsequent region selections. If so, the
explanation is similar as for the mark: the marker of the
internal-region-overlay is the same under eq when "bbb" is selected
and deleted as when the line formerly containing "aaa" is selected
followed by undo in region. The marker adjustment is incorrectly found
because the marker moved, and consequently the "aaa" undo record is
not found. Would the solution be analogous as for the mark: make a new
overlay for each new region selection?
Finally, here's the patch that fixes this problem wrt the mark:
diff --git a/lisp/simple.el b/lisp/simple.el
index f9447b1..5b7970c 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4399,11 +4399,11 @@ If NO-TMM is non-nil, leave `transient-mark-mode' alone."
(setq transient-mark-mode 'lambda))
(run-hooks 'activate-mark-hook)))
-(defun set-mark (pos)
- "Set this buffer's mark to POS. Don't use this function!
-That is to say, don't use this function unless you want
-the user to see that the mark has moved, and you want the previous
-mark position to be lost.
+(defun set-mark (pos-or-marker)
+ "Set this buffer's mark to POS-OR-MARKER. Don't use this
+function! That is to say, don't use this function unless you
+want the user to see that the mark has moved, and you want the
+previous mark position to be lost.
Normally, when a new mark is set, the old one should go on the stack.
This is why most applications should use `push-mark', not `set-mark'.
@@ -4415,9 +4415,10 @@ To remember a location for internal use in the Lisp program,
store it in a Lisp variable. Example:
(let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
-
- (set-marker (mark-marker) pos (current-buffer))
- (if pos
+ (if (markerp pos-or-marker)
+ (setq mark pos-or-marker)
+ (set-marker (mark-marker) pos-or-marker (current-buffer)))
+ (if pos-or-marker
(activate-mark 'no-tmm)
;; Normally we never clear mark-active except in Transient Mark mode.
;; But when we actually clear out the mark value too, we must
@@ -4639,10 +4640,12 @@ purposes. See the documentation of `set-mark' for more information.
In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil."
(unless (null (mark t))
- (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
+ (push (mark-marker) mark-ring)
(when (> (length mark-ring) mark-ring-max)
- (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
+ ;; Remove from mark-ring. Note that marker may be in
+ ;; global-mark-ring, so don't point it nowhere.
(setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
+ (set-mark (copy-marker (mark-marker)))
(set-marker (mark-marker) (or location (point)) (current-buffer))
;; Now push the mark on the global mark ring.
(if (and global-mark-ring
@@ -4650,9 +4653,8 @@ In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil."
;; The last global mark pushed was in this same buffer.
;; Don't push another one.
nil
- (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
+ (push (mark-marker) global-mark-ring)
(when (> (length global-mark-ring) global-mark-ring-max)
- (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
(setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))
(or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark set"))
@@ -4664,11 +4666,9 @@ In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil."
"Pop off mark ring into the buffer's actual mark.
Does not set point. Does nothing if mark ring is empty."
(when mark-ring
- (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
- (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
- (move-marker (car mark-ring) nil)
- (if (null (mark t)) (ding))
- (setq mark-ring (cdr mark-ring)))
+ (setq mark-ring (nconc mark-ring (list (mark-marker))))
+ (set-mark (pop mark-ring))
+ (if (null (mark t)) (ding)))
(deactivate-mark))
(define-obsolete-function-alias
diff --git a/src/buffer.c b/src/buffer.c
index 90c1542..d811515 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5161,6 +5161,7 @@ init_buffer_once (void)
bset_abbrev_table (&buffer_defaults, Qnil);
bset_display_table (&buffer_defaults, Qnil);
bset_undo_list (&buffer_defaults, Qnil);
+ bset_mark (&buffer_defaults, Qnil);
bset_mark_active (&buffer_defaults, Qnil);
bset_file_format (&buffer_defaults, Qnil);
bset_auto_save_file_format (&buffer_defaults, Qt);
@@ -5219,6 +5220,7 @@ init_buffer_once (void)
bset_major_mode (&buffer_local_flags, make_number (-1));
bset_mode_name (&buffer_local_flags, make_number (-1));
bset_undo_list (&buffer_local_flags, make_number (-1));
+ bset_mark (&buffer_local_flags, make_number (-1));
bset_mark_active (&buffer_local_flags, make_number (-1));
bset_point_before_scroll (&buffer_local_flags, make_number (-1));
bset_file_truename (&buffer_local_flags, make_number (-1));
@@ -6124,6 +6126,9 @@ the changes between two undo boundaries as a single step to be undone.
If the value of the variable is t, undo information is not recorded. */);
+ DEFVAR_PER_BUFFER ("mark", &BVAR (current_buffer, mark), Qnil,
+ doc: /* The buffer's mark. */);
+
DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
doc: /* Non-nil means the mark and region are currently active in this buffer. */);
diff --git a/test/automated/marker-tests.el b/test/automated/marker-tests.el
new file mode 100644
index 0000000..87ebf82
--- /dev/null
+++ b/test/automated/marker-tests.el
@@ -0,0 +1,59 @@
+;;; marker-tests.el --- tests for common markers such as the mark -*- lexical-binding:t -*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <
http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(ert-deftest marker-tests-mark-rings ()
+ (let ((buf1 (generate-new-buffer "buf1"))
+ (buf2 (generate-new-buffer "buf2")))
+ (set-buffer buf1)
+ (insert "abcdefg")
+ (push-mark 1)
+ (goto-char 2)
+ (push-mark)
+ (set-buffer buf2)
+ (insert "ABCDEFG")
+ (push-mark)
+ (set-buffer buf1)
+ (pop-global-mark)
+ (should (eq (current-buffer) (marker-buffer (mark-marker))))
+ (should (eq (current-buffer) buf2))
+ (goto-char 3)
+ (pop-mark) ; Shouldn't go anywhere, mark-ring empty
+ (should (= 3 (point)))
+ (pop-global-mark)
+ (should (eq (current-buffer) buf1))
+ (push-mark 4)
+ (should (= 4 (mark t)))
+ (goto-char 5)
+ (exchange-point-and-mark)
+ (should (= 4 (point)))
+ (should (= 5 (marker-position (mark-marker))))
+ (pop-mark)
+ (should (= 2 (mark t)))
+ (pop-mark)
+ (should (= 1 (mark t)))
+ (should (= 4 (point)))
+ (should (eq (current-buffer) buf1))))
+
+;;; marker-tests.el ends here
+
+
diff --git a/test/automated/undo-tests.el b/test/automated/undo-tests.el
index 8a963f1..a4ed95e 100644
--- a/test/automated/undo-tests.el
+++ b/test/automated/undo-tests.el
@@ -268,6 +268,46 @@
(should (string= (buffer-string)
"This sentence corrupted?aaa"))))
+(ert-deftest undo-test-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")