Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 09:14:18 +00:00
Code Issues Projects Releases Packages Wiki Activity

delsel.el: Improve the overlay for text replacement

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

5
etc/NEWS
View file

@ -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
---

95
lisp/delsel.el
View file

@ -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:

13
lisp/emacs-lisp/cursor-sensor.el
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))
;; 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)))