Change algorithm used to adjust positions for undo in region
* simple.el (undo-make-selective-list): New algorithm fixes incorrectness of position adjustments when undoing in region. (Bug#17235) (undo-elt-crosses-region): Make obsolete. (undo-adjust-elt, undo-adjust-beg-end, undo-adjust-pos): New functions to adjust positions using undo-deltas. * automated/undo-tests.el (undo-test-region-deletion): New test to demonstrate bug#17235. (undo-test-region-example): New test to verify example given in comments for undo-make-selective-list. Fixes: debbugs:17325
This commit is contained in:
parent
17a873c585
commit
4807c7eb90
4 changed files with 259 additions and 84 deletions
|
@ -1,3 +1,10 @@
|
|||
2014-05-01 Barry O'Reilly <gundaetiapo@gmail.com>
|
||||
|
||||
* automated/undo-tests.el (undo-test-region-deletion): New test to
|
||||
demonstrate bug#17235.
|
||||
(undo-test-region-example): New test to verify example given in
|
||||
comments for undo-make-selective-list.
|
||||
|
||||
2014-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): Only highlight past
|
||||
|
|
252
lisp/simple.el
252
lisp/simple.el
|
@ -2365,91 +2365,112 @@ 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)))
|
||||
|
||||
;; The positions given in elements of the undo list are the positions
|
||||
;; as of the time that element was recorded to undo history. In
|
||||
;; general, subsequent buffer edits render those positions invalid in
|
||||
;; the current buffer, unless adjusted according to the intervening
|
||||
;; undo elements.
|
||||
;;
|
||||
;; Undo in region is a use case that requires adjustments to undo
|
||||
;; elements. It must adjust positions of elements in the region based
|
||||
;; on newer elements not in the region so as they may be correctly
|
||||
;; applied in the current buffer. undo-make-selective-list
|
||||
;; accomplishes this with its undo-deltas list of adjustments. An
|
||||
;; example undo history from oldest to newest:
|
||||
;;
|
||||
;; buf pos:
|
||||
;; 123456789 buffer-undo-list undo-deltas
|
||||
;; --------- ---------------- -----------
|
||||
;; aaa (1 . 4) (1 . -3)
|
||||
;; aaba (3 . 4) N/A (in region)
|
||||
;; ccaaba (1 . 3) (1 . -2)
|
||||
;; ccaabaddd (7 . 10) (7 . -3)
|
||||
;; ccaabdd ("ad" . 6) (6 . 2)
|
||||
;; ccaabaddd (6 . 8) (6 . -2)
|
||||
;; | |<-- region: "caab", from 2 to 6
|
||||
;;
|
||||
;; When the user starts a run of undos in region,
|
||||
;; undo-make-selective-list is called to create the full list of in
|
||||
;; region elements. Each element is adjusted forward chronologically
|
||||
;; through undo-deltas to determine if it is in the region.
|
||||
;;
|
||||
;; In the above example, the insertion of "b" is (3 . 4) in the
|
||||
;; buffer-undo-list. The undo-delta (1 . -2) causes (3 . 4) to become
|
||||
;; (5 . 6). The next three undo-deltas cause no adjustment, so (5
|
||||
;; . 6) is assessed as in the region and placed in the selective list.
|
||||
;; Notably, the end of region itself adjusts from "2 to 6" to "2 to 5"
|
||||
;; due to the selected element. The "b" insertion is the only element
|
||||
;; fully in the region, so in this example undo-make-selective-list
|
||||
;; returns (nil (5 . 6)).
|
||||
;;
|
||||
;; The adjustment of the (7 . 10) insertion of "ddd" shows an edge
|
||||
;; case. It is adjusted through the undo-deltas: ((6 . 2) (6 . -2)).
|
||||
;; Normally an undo-delta of (6 . 2) would cause positions after 6 to
|
||||
;; adjust by 2. However, they shouldn't adjust to less than 6, so (7
|
||||
;; . 10) adjusts to (6 . 8) due to the first undo delta.
|
||||
;;
|
||||
;; More interesting is how to adjust the "ddd" insertion due to the
|
||||
;; next undo-delta: (6 . -2), corresponding to reinsertion of "ad".
|
||||
;; If the reinsertion was a manual retyping of "ad", then the total
|
||||
;; adjustment should be (7 . 10) -> (6 . 8) -> (8 . 10). However, if
|
||||
;; the reinsertion was due to undo, one might expect the first "d"
|
||||
;; character would again be a part of the "ddd" text, meaning its
|
||||
;; total adjustment would be (7 . 10) -> (6 . 8) -> (7 . 10).
|
||||
;;
|
||||
;; undo-make-selective-list assumes in this situation that "ad" was a
|
||||
;; new edit, even if it was inserted because of an undo.
|
||||
;; Consequently, if the user undos in region "8 to 10" of the
|
||||
;; "ccaabaddd" buffer, they could be surprised that it becomes
|
||||
;; "ccaabad", as though the first "d" became detached from the
|
||||
;; original "ddd" insertion. This quirk is a FIXME.
|
||||
|
||||
(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
|
||||
the elements inside this region, and discard those outside this region.
|
||||
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))
|
||||
some-rejected
|
||||
undo-elt temp-undo-list delta)
|
||||
(while undo-list-copy
|
||||
(setq undo-elt (car undo-list-copy))
|
||||
(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))
|
||||
;; 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
|
||||
(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)))
|
||||
The elements come from `buffer-undo-list', but we keep only the
|
||||
elements inside this region, and discard those outside this
|
||||
region. The elements' positions are adjusted so as the returned
|
||||
list can be applied to the current buffer."
|
||||
(let ((ulist buffer-undo-list)
|
||||
;; A list of position adjusted undo elements in the region.
|
||||
(selective-list (list nil))
|
||||
;; A list of undo-deltas for out of region undo elements.
|
||||
undo-deltas
|
||||
undo-elt)
|
||||
(while ulist
|
||||
(setq undo-elt (car ulist))
|
||||
(cond
|
||||
((null undo-elt)
|
||||
;; Don't put two nils together in the list
|
||||
(when (car selective-list)
|
||||
(push nil selective-list)))
|
||||
((and (consp undo-elt) (eq (car undo-elt) t))
|
||||
;; This is a "was unmodified" element. Keep it
|
||||
;; if we have kept everything thus far.
|
||||
(when (not undo-deltas)
|
||||
(push undo-elt selective-list)))
|
||||
;; Skip over marker adjustments, instead relying
|
||||
;; on finding them after (TEXT . POS) elements
|
||||
((markerp (car-safe undo-elt))
|
||||
nil)
|
||||
(t
|
||||
(let ((adjusted-undo-elt (undo-adjust-elt undo-elt
|
||||
undo-deltas)))
|
||||
(if (undo-elt-in-region adjusted-undo-elt start end)
|
||||
(progn
|
||||
(setq end (+ end (cdr (undo-delta adjusted-undo-elt))))
|
||||
(push adjusted-undo-elt selective-list)
|
||||
;; Keep (MARKER . ADJUSTMENT) if their (TEXT . POS) was
|
||||
;; kept. primitive-undo may discard them later.
|
||||
(when (and (stringp (car-safe adjusted-undo-elt))
|
||||
(integerp (cdr-safe adjusted-undo-elt)))
|
||||
(let ((list-i (cdr ulist)))
|
||||
(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)
|
||||
(setq temp-undo-list (cdr undo-list-copy))
|
||||
(setq delta (undo-delta undo-elt))
|
||||
|
||||
(when (/= (cdr delta) 0)
|
||||
(let ((position (car delta))
|
||||
(offset (cdr delta)))
|
||||
|
||||
;; Loop down the earlier events adjusting their buffer
|
||||
;; positions to reflect the fact that a change to the buffer
|
||||
;; isn't being undone. We only need to process those element
|
||||
;; types which undo-elt-in-region will return as being in
|
||||
;; the region since only those types can ever get into the
|
||||
;; output
|
||||
|
||||
(while temp-undo-list
|
||||
(setq undo-elt (car temp-undo-list))
|
||||
(cond ((integerp undo-elt)
|
||||
(if (>= undo-elt position)
|
||||
(setcar temp-undo-list (- undo-elt offset))))
|
||||
((atom undo-elt) nil)
|
||||
((stringp (car undo-elt))
|
||||
;; (TEXT . POSITION)
|
||||
(let ((text-pos (abs (cdr undo-elt)))
|
||||
(point-at-end (< (cdr undo-elt) 0 )))
|
||||
(if (>= text-pos position)
|
||||
(setcdr undo-elt (* (if point-at-end -1 1)
|
||||
(- text-pos offset))))))
|
||||
((integerp (car undo-elt))
|
||||
;; (BEGIN . END)
|
||||
(when (>= (car undo-elt) position)
|
||||
(setcar undo-elt (- (car undo-elt) offset))
|
||||
(setcdr undo-elt (- (cdr undo-elt) offset))))
|
||||
((null (car undo-elt))
|
||||
;; (nil PROPERTY VALUE BEG . END)
|
||||
(let ((tail (nthcdr 3 undo-elt)))
|
||||
(when (>= (car tail) position)
|
||||
(setcar tail (- (car tail) offset))
|
||||
(setcdr tail (- (cdr tail) offset))))))
|
||||
(setq temp-undo-list (cdr temp-undo-list))))))))
|
||||
(setq undo-list-copy (cdr undo-list-copy)))
|
||||
(nreverse undo-list)))
|
||||
(push (pop list-i) selective-list)))))
|
||||
(let ((delta (undo-delta undo-elt)))
|
||||
(when (/= 0 (cdr delta))
|
||||
(push delta undo-deltas)))))))
|
||||
(pop ulist))
|
||||
(nreverse selective-list)))
|
||||
|
||||
(defun undo-elt-in-region (undo-elt start end)
|
||||
"Determine whether UNDO-ELT falls inside the region START ... END.
|
||||
|
@ -2497,6 +2518,73 @@ is not *inside* the region START...END."
|
|||
;; (BEGIN . END)
|
||||
(and (< (car undo-elt) end)
|
||||
(> (cdr undo-elt) start)))))
|
||||
(make-obsolete 'undo-elt-crosses-region nil "24.5")
|
||||
|
||||
(defun undo-adjust-elt (elt deltas)
|
||||
"Return adjustment of undo element ELT by the undo DELTAS
|
||||
list."
|
||||
(pcase elt
|
||||
;; POSITION
|
||||
((pred integerp)
|
||||
(undo-adjust-pos elt deltas))
|
||||
;; (BEG . END)
|
||||
(`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
|
||||
(undo-adjust-beg-end beg end deltas))
|
||||
;; (TEXT . POSITION)
|
||||
(`(,(and text (pred stringp)) . ,(and pos (pred integerp)))
|
||||
(cons text (* (if (< pos 0) -1 1)
|
||||
(undo-adjust-pos (abs pos) deltas))))
|
||||
;; (nil PROPERTY VALUE BEG . END)
|
||||
(`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
|
||||
`(nil ,prop ,val . ,(undo-adjust-beg-end beg end deltas)))
|
||||
;; (apply DELTA START END FUN . ARGS)
|
||||
;; FIXME
|
||||
;; All others return same elt
|
||||
(_ elt)))
|
||||
|
||||
;; (BEG . END) can adjust to the same positions, commonly when an
|
||||
;; insertion was undone and they are out of region, for example:
|
||||
;;
|
||||
;; buf pos:
|
||||
;; 123456789 buffer-undo-list undo-deltas
|
||||
;; --------- ---------------- -----------
|
||||
;; [...]
|
||||
;; abbaa (2 . 4) (2 . -2)
|
||||
;; aaa ("bb" . 2) (2 . 2)
|
||||
;; [...]
|
||||
;;
|
||||
;; "bb" insertion (2 . 4) adjusts to (2 . 2) because of the subsequent
|
||||
;; undo. Further adjustments to such an element should be the same as
|
||||
;; for (TEXT . POSITION) elements. The options are:
|
||||
;;
|
||||
;; 1: POSITION adjusts using <= (use-< nil), resulting in behavior
|
||||
;; analogous to marker insertion-type t.
|
||||
;;
|
||||
;; 2: POSITION adjusts using <, resulting in behavior analogous to
|
||||
;; marker insertion-type nil.
|
||||
;;
|
||||
;; There was no strong reason to prefer one or the other, except that
|
||||
;; the first is more consistent with prior undo in region behavior.
|
||||
(defun undo-adjust-beg-end (beg end deltas)
|
||||
"Return cons of adjustments to BEG and END by the undo DELTAS
|
||||
list."
|
||||
(let ((adj-beg (undo-adjust-pos beg deltas)))
|
||||
;; Note: option 2 above would be like (cons (min ...) adj-end)
|
||||
(cons adj-beg
|
||||
(max adj-beg (undo-adjust-pos end deltas t)))))
|
||||
|
||||
(defun undo-adjust-pos (pos deltas &optional use-<)
|
||||
"Return adjustment of POS by the undo DELTAS list, comparing
|
||||
with < or <= based on USE-<."
|
||||
(dolist (d deltas pos)
|
||||
(when (if use-<
|
||||
(< (car d) pos)
|
||||
(<= (car d) pos))
|
||||
(setq pos
|
||||
;; Don't allow pos to become less than the undo-delta
|
||||
;; position. This edge case is described in the overview
|
||||
;; comments.
|
||||
(max (car d) (- pos (cdr d)))))))
|
||||
|
||||
;; Return the first affected buffer position and the delta for an undo element
|
||||
;; delta is defined as the change in subsequent buffer positions if we *did*
|
||||
|
|
|
@ -1,3 +1,12 @@
|
|||
2014-05-01 Barry O'Reilly <gundaetiapo@gmail.com>
|
||||
|
||||
* simple.el (undo-make-selective-list): New algorithm fixes
|
||||
incorrectness of position adjustments when undoing in region.
|
||||
(Bug#17235)
|
||||
(undo-elt-crosses-region): Make obsolete.
|
||||
(undo-adjust-elt, undo-adjust-beg-end, undo-adjust-pos): New
|
||||
functions to adjust positions using undo-deltas.
|
||||
|
||||
2014-04-25 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* automated/tramp-tests.el (top):
|
||||
|
|
|
@ -226,7 +226,7 @@
|
|||
(should-not (buffer-modified-p))))
|
||||
(delete-file tempfile))))
|
||||
|
||||
(ert-deftest undo-test-in-region-not-most-recent ()
|
||||
(ert-deftest undo-test-region-not-most-recent ()
|
||||
"Test undo in region of an edit not the most recent."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
|
@ -247,7 +247,78 @@
|
|||
(should (string= (buffer-string)
|
||||
"11131"))))
|
||||
|
||||
(ert-deftest undo-test-in-region-eob ()
|
||||
(ert-deftest undo-test-region-deletion ()
|
||||
"Test undoing a deletion to demonstrate bug 17235."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
(transient-mark-mode 1)
|
||||
(insert "12345")
|
||||
(search-backward "4")
|
||||
(undo-boundary)
|
||||
(delete-forward-char 1)
|
||||
(search-backward "1")
|
||||
(undo-boundary)
|
||||
(insert "xxxx")
|
||||
(undo-boundary)
|
||||
(insert "yy")
|
||||
(search-forward "35")
|
||||
(undo-boundary)
|
||||
;; Select "35"
|
||||
(push-mark (point) t t)
|
||||
(setq mark-active t)
|
||||
(forward-char -2)
|
||||
(undo) ; Expect "4" to come back
|
||||
(should (string= (buffer-string)
|
||||
"xxxxyy12345"))))
|
||||
|
||||
(ert-deftest undo-test-region-example ()
|
||||
"The same example test case described in comments for
|
||||
undo-make-selective-list."
|
||||
;; buf pos:
|
||||
;; 123456789 buffer-undo-list undo-deltas
|
||||
;; --------- ---------------- -----------
|
||||
;; aaa (1 . 4) (1 . -3)
|
||||
;; aaba (3 . 4) N/A (in region)
|
||||
;; ccaaba (1 . 3) (1 . -2)
|
||||
;; ccaabaddd (7 . 10) (7 . -3)
|
||||
;; ccaabdd ("ad" . 6) (6 . 2)
|
||||
;; ccaabaddd (6 . 8) (6 . -2)
|
||||
;; | |<-- region: "caab", from 2 to 6
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
(transient-mark-mode 1)
|
||||
(insert "aaa")
|
||||
(goto-char 3)
|
||||
(undo-boundary)
|
||||
(insert "b")
|
||||
(goto-char 1)
|
||||
(undo-boundary)
|
||||
(insert "cc")
|
||||
(goto-char 7)
|
||||
(undo-boundary)
|
||||
(insert "ddd")
|
||||
(search-backward "ad")
|
||||
(undo-boundary)
|
||||
(delete-forward-char 2)
|
||||
(undo-boundary)
|
||||
;; Select "dd"
|
||||
(push-mark (point) t t)
|
||||
(setq mark-active t)
|
||||
(goto-char (point-max))
|
||||
(undo)
|
||||
(undo-boundary)
|
||||
(should (string= (buffer-string)
|
||||
"ccaabaddd"))
|
||||
;; Select "caab"
|
||||
(push-mark 2 t t)
|
||||
(setq mark-active t)
|
||||
(goto-char 6)
|
||||
(undo)
|
||||
(undo-boundary)
|
||||
(should (string= (buffer-string)
|
||||
"ccaaaddd"))))
|
||||
|
||||
(ert-deftest undo-test-region-eob ()
|
||||
"Test undo in region of a deletion at EOB, demonstrating bug 16411."
|
||||
(with-temp-buffer
|
||||
(buffer-enable-undo)
|
||||
|
|
Loading…
Add table
Reference in a new issue