delsel.el: Improve the overlay for text replacement

* lisp/delsel.el (delete-selection-replacement-face): Delete var.
(delete-selection-replacement): New face, to replace it.
(delsel--replace-overlay, delsel--replace-text): Delete vars and ...
(delete-selection--replacement-text): ...use this single var instead.
(delete-selection--replacement-cursor): New function.
(delete-active-region): Use it with `cursor-sensor-mode` to avoid the
overlay lingering too long.
(delete-selection--replacement-text): New function extracted from
`delete-selection-repeat-replace-region`, with adjustments to account
for the above changes.
(delete-selection-repeat-replace-region): Use it.

* lisp/emacs-lisp/cursor-sensor.el (cursor-sensor--detect): Do use
`get-pos-property` when it works.  Fix the `missing-p` subfunction
so as not to get fooled by a missing property at END.
This commit is contained in:
Stefan Monnier 2026-02-14 13:11:50 -05:00
parent 38760d4ba7
commit f4a1c00656
3 changed files with 67 additions and 46 deletions

View file

@ -995,6 +995,11 @@ of the modified region.
* Changes in Specialized Modes and Packages in Emacs 31.1 * Changes in Specialized Modes and Packages in Emacs 31.1
** Delete-selection mode
*** New face 'delete-selection-replacement' for the replacement text
This comes with a change to how we track what is considered "the
replacement text", which should be more robust now, and is made
more clear by the highlighting.
** Editorconfig ** Editorconfig
--- ---

View file

@ -68,16 +68,12 @@ Value must be the register (key) to use."
(character :tag "Register (Key)")) (character :tag "Register (Key)"))
:group 'editing-basics) :group 'editing-basics)
(defcustom delete-selection-replacement-face 'highlight (defface delete-selection-replacement
"If non-nil, active region replacement text is shown in this face. '((t :inherit highlight))
"Show the active region replacement text in this face.
The highlighted text is the text that will be inserted by The highlighted text is the text that will be inserted by
the `delete-selection-repeat-replace-region' command." the `delete-selection-repeat-replace-region' command."
:type 'face :group 'editing-basics)
:group 'editing-basics
:set (lambda (symbol value)
(set-default symbol value)
(if delsel--replace-overlay
(overlay-put delsel--replace-overlay 'face value))))
(defcustom delete-selection-temporary-region nil (defcustom delete-selection-temporary-region nil
"Whether to delete only temporary regions. "Whether to delete only temporary regions.
@ -128,8 +124,8 @@ For compatibility with features and packages that are aware of
(setq-default delete-selection-mode nil) ; But keep it globally disabled. (setq-default delete-selection-mode nil) ; But keep it globally disabled.
))) )))
(defvar delsel--replace-overlay nil) ;overlay (defvar delete-selection--replacement-text nil
(defvar delsel--replace-text nil) ;text from overlay "Can be a string or an overlay.")
;;;###autoload ;;;###autoload
(defun delete-active-region (&optional killp) (defun delete-active-region (&optional killp)
@ -145,17 +141,50 @@ the active region is killed instead of deleted."
(delete-selection-save-to-register (delete-selection-save-to-register
(set-register delete-selection-save-to-register (set-register delete-selection-save-to-register
(funcall region-extract-function t)) (funcall region-extract-function t))
(if delsel--replace-overlay (if (overlayp delete-selection--replacement-text)
(move-overlay delsel--replace-overlay (point) (point) (current-buffer)) (move-overlay delete-selection--replacement-text
(setq delsel--replace-overlay (point) (point) (current-buffer))
(make-overlay (point) (point) (current-buffer) nil t)) (setq delete-selection--replacement-text
(if delete-selection-replacement-face (make-overlay (point) (point) nil nil t))
(overlay-put delsel--replace-overlay 'face (overlay-put delete-selection--replacement-text 'face
delete-selection-replacement-face))) 'delete-selection-replacement))
(setq delsel--replace-text nil)) ;; Make sure the overlay doesn't linger indefinitely.
(overlay-put delete-selection--replacement-text
'cursor-sensor-functions
(list #'delete-selection--replacement-cursor))
(unless (bound-and-true-p cursor-sensor-mode) (cursor-sensor-mode 1)))
(t (t
(funcall region-extract-function 'delete-only)))) (funcall region-extract-function 'delete-only))))
(defun delete-selection--replacement-cursor (_window _oldpos dir)
(when (and (overlayp delete-selection--replacement-text)
(eq dir 'left))
;; The replacement is considered done: Delete the overlay and store
;; its contents.
;; FIXME: Maybe we should briefly flash the highlighting?
(delete-selection--replacement-text)))
(defun delete-selection--replacement-text ()
;; If this is the first use after overwriting regions,
;; find the replacement text by looking at the overlay.
(when (overlayp delete-selection--replacement-text)
(if (null (overlay-buffer delete-selection--replacement-text))
(setq delete-selection--replacement-text nil)
(with-current-buffer (overlay-buffer delete-selection--replacement-text)
(let ((s (overlay-start delete-selection--replacement-text))
(e (overlay-end delete-selection--replacement-text)))
(delete-overlay delete-selection--replacement-text)
(if (= s e)
(setq delete-selection--replacement-text nil)
(setq delete-selection--replacement-text
(filter-buffer-substring s e))
(set-text-properties
0 (length delete-selection--replacement-text)
nil delete-selection--replacement-text))))))
(cl-assert (or (null delete-selection--replacement-text)
(stringp delete-selection--replacement-text)))
delete-selection--replacement-text)
(defun delete-selection-repeat-replace-region (arg) (defun delete-selection-repeat-replace-region (arg)
"Repeat replacing text of highlighted region with typed text. "Repeat replacing text of highlighted region with typed text.
Search for the next stretch of text identical to the region last replaced Search for the next stretch of text identical to the region last replaced
@ -169,28 +198,14 @@ Just `\\[universal-argument]' means repeat until the end of the buffer's accessi
(prefix-numeric-value current-prefix-arg)))) (prefix-numeric-value current-prefix-arg))))
(if (not (and old-text (> (length old-text) 0))) (if (not (and old-text (> (length old-text) 0)))
(message "No known previous replacement") (message "No known previous replacement")
;; If this is the first use after overwriting regions, (let ((string (delete-selection--replacement-text)))
;; find the replacement text by looking at the undo list. (if string
(when (and (null delsel--replace-text)
delsel--replace-overlay
(buffer-live-p (overlay-buffer delsel--replace-overlay)))
(with-current-buffer (overlay-buffer delsel--replace-overlay)
(let ((s (overlay-start delsel--replace-overlay))
(e (overlay-end delsel--replace-overlay)))
(when (/= s e)
(setq delsel--replace-text
(filter-buffer-substring s e))
(set-text-properties
0 (length delsel--replace-text)
nil delsel--replace-text))))
(delete-overlay delsel--replace-overlay))
(if delsel--replace-text
(while (and (> count 0) (while (and (> count 0)
delsel--replace-text string
(search-forward old-text nil t)) (search-forward old-text nil t))
(replace-match delsel--replace-text nil t) (replace-match string nil t)
(setq count (1- count))) (setq count (1- count)))
(message "Cannot locate replacement text"))))) (message "Cannot locate replacement text"))))))
(defun delete-selection-helper (type) (defun delete-selection-helper (type)
"Delete selection according to TYPE: "Delete selection according to TYPE:

View file

@ -155,10 +155,11 @@ By convention, this is a list of symbols where each symbol stands for the
(let* ((point (window-point window)) (let* ((point (window-point window))
;; It's often desirable to make the ;; It's often desirable to make the
;; cursor-sensor-functions property non-sticky on both ;; cursor-sensor-functions property non-sticky on both
;; ends, so we can't use `get-pos-property' because it ;; ends, so we can't use just `get-pos-property' because it
;; might never see it. ;; might never see it.
;; FIXME: Combine properties from covering overlays? ;; FIXME: Combine properties from covering overlays?
(new (or (get-char-property point 'cursor-sensor-functions) (new (or (get-pos-property point 'cursor-sensor-functions)
(get-char-property point 'cursor-sensor-functions)
(unless (<= (point-min) point) (unless (<= (point-min) point)
(get-char-property (1- point) (get-char-property (1- point)
'cursor-sensor-functions)))) 'cursor-sensor-functions))))
@ -181,10 +182,10 @@ By convention, this is a list of symbols where each symbol stands for the
"Non-nil if F is missing somewhere between START and END." "Non-nil if F is missing somewhere between START and END."
(let ((pos start) (let ((pos start)
(missing nil)) (missing nil))
(while (< pos end) (while (< (setq pos (next-single-char-property-change
(setq pos (next-single-char-property-change
pos 'cursor-sensor-functions pos 'cursor-sensor-functions
nil end)) nil end))
end)
(unless (memq f (get-char-property (unless (memq f (get-char-property
pos 'cursor-sensor-functions)) pos 'cursor-sensor-functions))
(setq missing t))) (setq missing t)))