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 + + * 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 * 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 + + * 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 * 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")