emacs/gnu.emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2026-09-10 07:46:51 -04:00
Code Issues Actions Packages Projects Releases Wiki Activity

Make handling of partially selected undo items customizable

Browse source 
Introduce a variable undo-partially-in-region-policy,
that can have one of the values:
  - partial-ignore
  - partial-stop
  - partial-expand

Ignoring partially selected items seems like a bug, but the other two
choices break existing tests.

* lisp/simple.el (undo-partially-in-region-policy): New variable.
(undo-make-selective-list): Implement the different policies.
(undo--region): New helper.
* test/src/undo-tests.el (undo-test-region-example)
(undo-tests-selective-apply-3, undo-tests-selective-apply-4): Amend for
the different policies.
* test/lisp/simple-tests.el (simple-tests--undo-apply): Ditto.
This commit is contained in:
Helmut Eller 2026-08-18 09:17:11 +02:00
parent 4fa4a8dde1
commit 1273c1759e
3 changed files with 88 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
lisp/simple.el
View file

@ -3818,6 +3818,12 @@ 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)))
(defcustom undo-partially-in-region-policy 'partial-ignore
"Policy for undo items that are only partially selected."
:type '(choice (const partial-ignore)
(const partial-stop)
(const partial-expand)))
;; 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
@ -3912,7 +3918,7 @@ list can be applied to the current buffer."
(let ((adjusted-undo-elt (undo-adjust-elt undo-elt
undo-deltas)))
(cl-ecase (undo-elt-in-region adjusted-undo-elt start end
'partial)
undo-partially-in-region-policy)
((t)
(setq end (+ end (cdr (undo-delta adjusted-undo-elt))))
(push adjusted-undo-elt selective-list)
@ -3922,17 +3928,30 @@ list can be applied to the current buffer."
(integerp (cdr-safe adjusted-undo-elt)))
(let ((list-i (cdr ulist)))
(while (markerp (car-safe (car list-i)))
(push (pop list-i) selective-list)))))
((nil)
(push (pop list-i) selective-list))))
)
((nil partial-ignore)
(let ((delta (undo-delta undo-elt)))
(when (/= 0 (cdr delta))
(push delta undo-deltas))))
(partial
(partial-stop
;; Stop searching for more applicable elements, because we
;; aren't sure whether subsequent elements depend on the
;; changes caused by this one; in particular for 'apply
;; entries.
(setq ulist nil))))))
(setq ulist nil))
(partial-expand
(let* ((region (undo--region adjusted-undo-elt))
(rstart (car region))
(rend (cdr region)))
(setq start (min start rstart))
(setq end (max end rend)))
(push adjusted-undo-elt selective-list)
(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)))
(push (pop list-i) selective-list)))))))))
(pop ulist))
(nreverse selective-list)))
@ -4100,6 +4119,27 @@ with < or <= based on USE-<."
'(0 . 0)))
'(0 . 0)))
(defun undo--region (undo-elt)
(pcase-exhaustive undo-elt
((and `(,beg . ,end) (guard (and (natnump beg) (natnump end))))
undo-elt)
((or (and `(,text . ,pos) (guard (and (stringp text) (integerp pos))))
(and pos (pred natnump)))
(let ((p (abs pos)))
(cons p p)))
((or `(t . _)
(and `(apply ,fun-name) (guard (symbolp fun-name))))
t)
((or `(nil _ _ ,beg . ,end)
(and `(apply ,delta ,beg ,end . ,_)
(guard (and (integerp delta) (natnump beg))))
(and `(apply ,delta (,beg . ,end) . ,_)
(guard (and (integerp delta) (natnump beg)))))
(cons beg end))
((or (and `(,m . ,_) (guard (markerp m)))
`nil)
nil)))
;;; Default undo-boundary addition
;;
;; This section adds a new undo-boundary at either after a command is

12
test/lisp/simple-tests.el
View file

@ -591,8 +591,16 @@ See bug#35036."
(goto-char midbeg)
(set-mark midend)
(setq last-command 'something-else) ;Not `undo', so we start a new run.
(undo '(4))
(should (equal (buffer-substring midbeg midend) "midmid")))
(cl-ecase undo-partially-in-region-policy
(partial-ignore
(undo '(4))
(should (equal (buffer-substring midbeg midend) "midmid")))
(partial-stop
(should-error (undo '(4)) :type 'user-error)
(should (equal (buffer-substring midbeg midend) "mid\nmid")))
(partial-expand
(undo '(4))
(should (equal (buffer-substring midbeg midend) "mid\nmid")))))
;; (progn
;; (goto-char (point-min))
;; ;; FIXME: `comment-region-default' puts a too conservative boundary

44
test/src/undo-tests.el
View file

@ -315,10 +315,19 @@ undo-make-selective-list."
(push-mark 2 t t)
(setq mark-active t)
(goto-char 6)
(undo)
(undo-boundary)
(should (string= (buffer-string)
"ccaaaddd"))))
(cl-ecase undo-partially-in-region-policy
(partial-ignore
(undo)
(should (string= (buffer-string)
"ccaaaddd")))
(partial-stop
(should-error (undo) :type 'user-error)
(should (string= (buffer-string)
"ccaabaddd")))
(partial-expand
(undo)
(should (string= (buffer-string)
"aabaddd"))))))
(ert-deftest undo-test-region-eob ()
"Test undo in region of a deletion at EOB, demonstrating bug 16411."
@ -668,8 +677,16 @@ Demonstrates bug 25599."
(undo-boundary)
;; select "B"
(undo-tests--mark-region 2 3)
(should-error (undo) :type 'user-error)
(should (equal (buffer-string) "aBDe"))))
(cl-ecase undo-partially-in-region-policy
(partial-ignore
(undo)
(should (equal (buffer-string) "aBcDe")))
(partial-stop
(should-error (undo) :type 'user-error)
(should (equal (buffer-string) "aBDe")))
(partial-expand
(undo)
(should (equal (buffer-string) "abcde"))))))
(ert-deftest undo-tests-selective-apply-4 ()
"Test partially selected \"undo-insert\" (BEG . END) entries."
@ -688,11 +705,16 @@ Demonstrates bug 25599."
(undo-tests--mark-region 3 5)
(should (equal buffer-undo-list
'(nil (2 . 4) ("34" . 3) 6 nil (1 . 6) (t . 0))))
;; The entry (2 . 4) "undo-insert" is ignored because it is only
;; partially covered by the region (3 . 5). Older entries are still
;; undone. Not sure if this is a bug or a feature.
(undo)
(should (equal (buffer-string) "1ab2345"))))
(cl-ecase undo-partially-in-region-policy
(partial-ignore
(undo)
(should (equal (buffer-string) "1ab2345")))
(partial-stop
(should-error (undo) :type 'user-error)
(should (equal (buffer-string) "1ab25")))
(partial-expand
(undo)
(should (equal (buffer-string) "12345"))))))
(provide 'undo-tests)
;;; undo-tests.el ends here