From f4a1c006569fd62e35e7c14a7b386b02b220effb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 14 Feb 2026 13:11:50 -0500 Subject: [PATCH] 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. --- etc/NEWS | 5 ++ lisp/delsel.el | 95 ++++++++++++++++++-------------- lisp/emacs-lisp/cursor-sensor.el | 13 +++-- 3 files changed, 67 insertions(+), 46 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 2239ce27377..0dd15ad18c3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -995,6 +995,11 @@ of the modified region. * 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 --- diff --git a/lisp/delsel.el b/lisp/delsel.el index f00f4843073..991092f792e 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -68,16 +68,12 @@ Value must be the register (key) to use." (character :tag "Register (Key)")) :group 'editing-basics) -(defcustom delete-selection-replacement-face 'highlight - "If non-nil, active region replacement text is shown in this face. +(defface delete-selection-replacement + '((t :inherit highlight)) + "Show the active region replacement text in this face. The highlighted text is the text that will be inserted by the `delete-selection-repeat-replace-region' command." - :type 'face - :group 'editing-basics - :set (lambda (symbol value) - (set-default symbol value) - (if delsel--replace-overlay - (overlay-put delsel--replace-overlay 'face value)))) + :group 'editing-basics) (defcustom delete-selection-temporary-region nil "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. ))) -(defvar delsel--replace-overlay nil) ;overlay -(defvar delsel--replace-text nil) ;text from overlay +(defvar delete-selection--replacement-text nil + "Can be a string or an overlay.") ;;;###autoload (defun delete-active-region (&optional killp) @@ -145,17 +141,50 @@ the active region is killed instead of deleted." (delete-selection-save-to-register (set-register delete-selection-save-to-register (funcall region-extract-function t)) - (if delsel--replace-overlay - (move-overlay delsel--replace-overlay (point) (point) (current-buffer)) - (setq delsel--replace-overlay - (make-overlay (point) (point) (current-buffer) nil t)) - (if delete-selection-replacement-face - (overlay-put delsel--replace-overlay 'face - delete-selection-replacement-face))) - (setq delsel--replace-text nil)) + (if (overlayp delete-selection--replacement-text) + (move-overlay delete-selection--replacement-text + (point) (point) (current-buffer)) + (setq delete-selection--replacement-text + (make-overlay (point) (point) nil nil t)) + (overlay-put delete-selection--replacement-text 'face + 'delete-selection-replacement)) + ;; 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 (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) "Repeat replacing text of highlighted region with typed text. 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)))) (if (not (and old-text (> (length old-text) 0))) (message "No known previous replacement") - ;; If this is the first use after overwriting regions, - ;; find the replacement text by looking at the undo list. - (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) - delsel--replace-text - (search-forward old-text nil t)) - (replace-match delsel--replace-text nil t) - (setq count (1- count))) - (message "Cannot locate replacement text"))))) + (let ((string (delete-selection--replacement-text))) + (if string + (while (and (> count 0) + string + (search-forward old-text nil t)) + (replace-match string nil t) + (setq count (1- count))) + (message "Cannot locate replacement text")))))) (defun delete-selection-helper (type) "Delete selection according to TYPE: diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el index 2562bfa30fb..cd672ba68c9 100644 --- a/lisp/emacs-lisp/cursor-sensor.el +++ b/lisp/emacs-lisp/cursor-sensor.el @@ -155,10 +155,11 @@ By convention, this is a list of symbols where each symbol stands for the (let* ((point (window-point window)) ;; It's often desirable to make the ;; 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. ;; 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) (get-char-property (1- point) '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." (let ((pos start) (missing nil)) - (while (< pos end) - (setq pos (next-single-char-property-change - pos 'cursor-sensor-functions - nil end)) + (while (< (setq pos (next-single-char-property-change + pos 'cursor-sensor-functions + nil end)) + end) (unless (memq f (get-char-property pos 'cursor-sensor-functions)) (setq missing t)))