Package: emacs;
Reported by: Stefan Monnier <monnier <at> iro.umontreal.ca>
Date: Mon, 16 Jun 2025 11:12:01 UTC
Severity: normal
Tags: patch
Done: Stefan Monnier <monnier <at> iro.umontreal.ca>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: 78806 <at> debbugs.gnu.org Subject: bug#78806: [PATCH] (smerge-refine-region): Add support for a virtual "other cursor" Date: Sat, 21 Jun 2025 00:01:50 -0400
[Message part 1 (text/plain, inline)]
> I'm thinking of adding a global `smerge-refine-shadow-cursor-mode` minor
> mode to enable this feature and am thinking of enabling it by default.
I made it a defcustom instead. See new patch below.
AFAIC, it's ready for `master`.
Stefan
[0001-smerge-refine-shadow-cursor-New-variable-and-face-bu.patch (text/x-diff, inline)]
From 8675aa101c9ed1a4add85b6445917b9c8a3b4697 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier <at> iro.umontreal.ca>
Date: Mon, 16 Jun 2025 07:05:11 -0400
Subject: [PATCH] (smerge-refine-shadow-cursor): New variable and face
(bug#78806)
* lisp/vc/smerge-mode.el (smerge-refine-shadow-cursor): New variable
and face.
(smerge-refine-regions): Add `cursor-sensor-functions` property
to the covering overlays.
(smerge--refine-at-right-margin-p, smerge--refine-shadow-cursor):
New functions.
(smerge--refine-other-pos): New function, extracted from
`smerge-refine-exchange-point`.
(smerge-refine-exchange-point): Use it.
(smerge--refine-highlight-change): Add thin
highlighted space for insertion/deletion positions.
* lisp/emacs-lisp/cursor-sensor.el (cursor-sensor--detect):
Run functions for `moved` events. Demote errors.
(cursor-sensor-mode): Adjust docstring accordingly.
* doc/lispref/text.texi (Special Properties) <cursor-sensor-functions>:
Mention the new `moved` direction.
---
doc/lispref/text.texi | 11 ++-
etc/NEWS | 13 +++-
lisp/emacs-lisp/cursor-sensor.el | 126 ++++++++++++++++---------------
lisp/vc/smerge-mode.el | 122 +++++++++++++++++++++++-------
4 files changed, 181 insertions(+), 91 deletions(-)
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 75b2b1c3d60..a23033f2ab0 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3986,10 +3986,13 @@ Special Properties
This special property records a list of functions that react to cursor
motion. Each function in the list is called, just before redisplay,
with 3 arguments: the affected window, the previous known position of
-the cursor, and one of the symbols @code{entered} or @code{left},
-depending on whether the cursor is entering the text that has this
-property or leaving it. The functions are called only when the minor
-mode @code{cursor-sensor-mode} is turned on.
+the cursor, and a symbol indicating the direction of the movement.
+The movement can be @code{entered} or @code{left}, depending on whether
+the cursor is entering the text that has this property or leaving it, or
+@code{moved} when the cursor moved within that text.
+Other values for the direction should be ignored.
+The functions are called only when the minor mode
+@code{cursor-sensor-mode} is turned on.
When the variable @code{cursor-sensor-inhibit} is non-@code{nil}, the
@code{cursor-sensor-functions} property is ignored.
diff --git a/etc/NEWS b/etc/NEWS
index e3c5f56216f..eefada996e6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -912,7 +912,8 @@ are discarded, which matches the behavior of physical terminals and other
terminal emulators. Control sequences and escape sequences are still processed
correctly regardless of margin position.
-** Smerge
+---
+** SMerge
*** New command 'smerge-extend' extends a conflict over surrounding lines.
@@ -921,6 +922,16 @@ When used inside a refined chunk, it jumps to the matching position in
the "other" side of the refinement: if you're in the new text, it jumps
to the corresponding position in the old text and vice versa.
+*** New variable 'smerge-refine-shadow-cursor'.
+A "shadow cursor" is now drawn when point is inside a refined diff or
+refined conflict area, that corresponds to point's position in
+the other side of the diff or conflict, i.e. the position to which
+'smerge-refine-exchange-point' would jump.
+
+** Cursor-Sensor mode
++++
+*** New direction 'moved' used when the cursor moved within the active area.
+
** Image Dired
*** 'image-dired-show-all-from-dir' takes the same first argument as 'dired'.
diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el
index b0ace3ce8f0..87bc73e06b0 100644
--- a/lisp/emacs-lisp/cursor-sensor.el
+++ b/lisp/emacs-lisp/cursor-sensor.el
@@ -141,63 +141,70 @@ cursor-intangible-mode
;;; Detect cursor movement.
(defun cursor-sensor--detect (&optional window)
- (with-current-buffer (window-buffer window)
- (unless cursor-sensor-inhibit
- (let* ((point (window-point window))
- ;; It's often desirable to make the
- ;; cursor-sensor-functions property non-sticky on both
- ;; ends, but that means get-pos-property might never
- ;; see it.
- (new (or (get-char-property point 'cursor-sensor-functions)
- (unless (<= (point-min) point)
- (get-char-property (1- point)
- 'cursor-sensor-functions))))
- (old (window-parameter window 'cursor-sensor--last-state))
- (oldposmark (car old))
- (oldpos (or (if oldposmark (marker-position oldposmark))
- (point-min)))
- (start (min oldpos point))
- (end (max oldpos point)))
- (unless (or (null old) (eq (marker-buffer oldposmark) (current-buffer)))
- ;; `window' does not display the same buffer any more!
- (setcdr old nil))
- (if (or (and (null new) (null (cdr old)))
- (and (eq new (cdr old))
- (eq (next-single-char-property-change
- start 'cursor-sensor-functions nil end)
- end)))
- ;; Clearly nothing to do.
- nil
- ;; Maybe something to do. Let's see exactly what needs to run.
- (let* ((missing-p
- (lambda (f)
- "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))
- (unless (memq f (get-char-property
- pos 'cursor-sensor-functions))
- (setq missing t)))
- missing)))
- (window (selected-window)))
- (dolist (f (cdr old))
- (unless (and (memq f new) (not (funcall missing-p f)))
- (funcall f window oldpos 'left)))
- (dolist (f new)
- (unless (and (memq f (cdr old)) (not (funcall missing-p f)))
- (funcall f window oldpos 'entered)))))
-
- ;; Remember current state for next time.
- ;; Re-read cursor-sensor-functions since the functions may have moved
- ;; window-point!
- (if old
- (progn (move-marker (car old) point)
- (setcdr old new))
- (set-window-parameter window 'cursor-sensor--last-state
- (cons (copy-marker point) new)))))))
+ (with-demoted-errors "cursor-sensor--detect: %S"
+ (with-current-buffer (window-buffer window)
+ (unless cursor-sensor-inhibit
+ (let* ((point (window-point window))
+ ;; It's often desirable to make the
+ ;; cursor-sensor-functions property non-sticky on both
+ ;; ends, but that means get-pos-property might never
+ ;; see it.
+ ;; FIXME: Should we combine properties from the various
+ ;; covering overlays?
+ (new (or (get-char-property point 'cursor-sensor-functions)
+ (unless (<= (point-min) point)
+ (get-char-property (1- point)
+ 'cursor-sensor-functions))))
+ (old (window-parameter window 'cursor-sensor--last-state))
+ (oldposmark (car old))
+ (oldpos (or (if oldposmark (marker-position oldposmark))
+ (point-min)))
+ (start (min oldpos point))
+ (end (max oldpos point)))
+ (unless (or (null old)
+ (eq (marker-buffer oldposmark) (current-buffer)))
+ ;; `window' does not display the same buffer any more!
+ (setcdr old nil))
+ (if (or (and (null new) (null (cdr old)))
+ ;; (and (eq new (cdr old))
+ ;; (eq (next-single-char-property-change
+ ;; start 'cursor-sensor-functions nil end)
+ ;; end))
+ )
+ ;; Clearly nothing to do.
+ nil
+ ;; Maybe something to do. Let's see exactly what needs to run.
+ (let* ((missing-p
+ (lambda (f)
+ "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))
+ (unless (memq f (get-char-property
+ pos 'cursor-sensor-functions))
+ (setq missing t)))
+ missing)))
+ (window (selected-window)))
+ (dolist (f (cdr old))
+ (unless (and (memq f new) (not (funcall missing-p f)))
+ (funcall f window oldpos 'left)))
+ (dolist (f new)
+ (funcall f window oldpos
+ (if (or (not (memq f (cdr old))) (funcall missing-p f))
+ 'entered
+ 'moved)))))
+
+ ;; Remember current state for next time.
+ ;; Re-read cursor-sensor-functions since the functions may have moved
+ ;; window-point!
+ (if old
+ (progn (move-marker (car old) point)
+ (setcdr old new))
+ (set-window-parameter window 'cursor-sensor--last-state
+ (cons (copy-marker point) new))))))))
;;;###autoload
(define-minor-mode cursor-sensor-mode
@@ -205,8 +212,9 @@ cursor-sensor-mode
This property should hold a list of functions which react to the motion
of the cursor. They're called with three arguments (WINDOW OLDPOS DIR)
where WINDOW is the affected window, OLDPOS is the last known position of
-the cursor and DIR can be `entered' or `left' depending on whether the cursor
-is entering the area covered by the text-property property or leaving it."
+the cursor and DIR can be `entered', `left', or `moved' depending on whether
+the cursor is entering the area covered by the text-property property,
+leaving it, or just moving inside of it."
:global nil
(cond
(cursor-sensor-mode
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index d1b27f6763b..73b1a61469d 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1089,12 +1089,25 @@ smerge--refine-highlight-change
;; (list match-num1 match-num2 startline))
(overlay-put ol 'evaporate t)
(dolist (x props)
- (when (or (> end beg)
- ;; Don't highlight the char we cover artificially.
- (not (memq (car-safe x) '(face font-lock-face))))
- (overlay-put ol (car x) (cdr x))))
+ (if (or (> end beg)
+ (not (memq (car-safe x) '(face font-lock-face))))
+ (overlay-put ol (car x) (cdr x))
+ ;; Don't highlight the char we cover artificially.
+ (overlay-put ol (if (= beg olbeg) 'before-string 'after-string)
+ (propertize
+ " " (car-safe x) (cdr-safe x)
+ 'display '(space :width 0.5)))))
ol)))))
+(defcustom smerge-refine-shadow-cursor t
+ "If non-nil, display a shadow cursor on the other side of smerge refined regions."
+ :type 'boolean
+ :version "31.1")
+
+(defface smerge-refine-shadow-cursor
+ '((t :box (:line-width (-2 . -2))))
+ "Face used to highlight the shadow cursor.")
+
;;;###autoload
(defun smerge-refine-regions (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)
"Show fine differences in the two regions BEG1..END1 and BEG2..END2.
@@ -1124,7 +1137,11 @@ smerge-refine-regions
(ol2 (make-overlay beg2 end2 nil
;; Make it shrink rather than spread when editing.
'front-advance nil))
- (common-props '((evaporate . t) (smerge--refine-region . t))))
+ (common-props '((evaporate . t) (smerge--refine-region . t)
+ (cursor-sensor-functions
+ smerge--refine-shadow-cursor))))
+ (when smerge-refine-shadow-cursor
+ (cursor-sensor-mode 1))
(dolist (prop (or props-a props-c))
(when (and (not (memq (car prop) '(face font-lock-face)))
(member prop (or props-r props-c))
@@ -1215,6 +1232,55 @@ smerge-refine-regions
(define-obsolete-function-alias 'smerge-refine-subst
#'smerge-refine-regions "26.1")
+(defun smerge--refine-at-right-margin-p (pos window)
+ ;; FIXME: `posn-at-point' seems to be costly/slow.
+ (when-let* ((posn (posn-at-point pos window))
+ (xy (nth 2 posn))
+ (x (car-safe xy))
+ (_ (numberp x)))
+ (> (+ x (with-selected-window window (string-pixel-width " ")))
+ (car (window-text-pixel-size window)))))
+
+(defun smerge--refine-shadow-cursor (window _oldpos dir)
+ (let ((ol (window-parameter window 'smerge--refine-shadow-cursor)))
+ (if (not (and smerge-refine-shadow-cursor
+ (memq dir '(entered moved))))
+ (if ol (delete-overlay ol))
+ (with-current-buffer (window-buffer window)
+ (let* ((cursor (window-point window))
+ (other-beg (ignore-errors (smerge--refine-other-pos cursor))))
+ (if (not other-beg)
+ (if ol (delete-overlay ol))
+ (let ((other-end (min (point-max) (1+ other-beg))))
+ ;; If other-beg/end covers a "wide" char like TAB or LF, the
+ ;; resulting shadow cursor doesn't look like a cursor, so try
+ ;; and convert it to a before-string space.
+ (when (or (and (eq ?\n (char-after other-beg))
+ (not (smerge--refine-at-right-margin-p
+ other-beg window)))
+ (and (eq ?\t (char-after other-beg))
+ ;; FIXME: `posn-at-point' seems to be costly/slow.
+ (when-let* ((posn (posn-at-point other-beg window))
+ (xy (nth 2 posn))
+ (x (car-safe xy))
+ (_ (numberp x)))
+ (< (1+ (% x tab-width)) tab-width))))
+ (setq other-end other-beg))
+ ;; FIXME: Doesn't obey `cursor-in-non-selected-windows'.
+ (if ol (move-overlay ol other-beg other-end)
+ (setq ol (make-overlay other-beg other-end nil t nil))
+ (setf (window-parameter window 'smerge--refine-shadow-cursor)
+ ol)
+ (overlay-put ol 'window window)
+ (overlay-put ol 'face 'smerge-refine-shadow-cursor))
+ ;; When the shadow cursor needs to be at EOB (or TAB or EOL),
+ ;; "draw" it as a pseudo space character.
+ (overlay-put ol 'before-string
+ (when (= other-beg other-end)
+ (eval-when-compile
+ (propertize
+ " " 'face 'smerge-refine-shadow-cursor)))))))))))
+
(defun smerge-refine (&optional part)
"Highlight the words of the conflict that are different.
For 3-way conflicts, highlights only two of the three parts.
@@ -1265,56 +1331,58 @@ smerge-refine
(unless smerge-use-changed-face
'((smerge . refine) (font-lock-face . smerge-refined-added))))))
-(defun smerge-refine-exchange-point ()
- "Go to the matching position in the other chunk."
- (interactive)
+(defun smerge--refine-other-pos (pos)
(let* ((covering-ol
- (let ((ols (overlays-at (point))))
+ (let ((ols (overlays-at pos)))
(while (and ols (not (overlay-get (car ols)
'smerge--refine-region)))
(pop ols))
(or (car ols)
(user-error "Not inside a refined region"))))
(ref-pos
- (if (or (get-char-property (point) 'smerge--refine-other)
- (get-char-property (1- (point)) 'smerge--refine-other))
- (point)
+ (if (or (get-char-property pos 'smerge--refine-other)
+ (get-char-property (1- pos) 'smerge--refine-other))
+ pos
(let ((next (next-single-char-property-change
- (point) 'smerge--refine-other nil
+ pos 'smerge--refine-other nil
(overlay-end covering-ol)))
(prev (previous-single-char-property-change
- (point) 'smerge--refine-other nil
+ pos 'smerge--refine-other nil
(overlay-start covering-ol))))
(cond
((and (> prev (overlay-start covering-ol))
(or (>= next (overlay-end covering-ol))
- (> (- next (point)) (- (point) prev))))
+ (> (- next pos) (- pos prev))))
prev)
((< next (overlay-end covering-ol)) next)
(t (user-error "No \"other\" position info found"))))))
(boundary
(cond
- ((< ref-pos (point))
+ ((< ref-pos pos)
(let ((adjust (get-char-property (1- ref-pos)
'smerge--refine-adjust)))
- (min (point) (+ ref-pos (or (cdr adjust) 0)))))
- ((> ref-pos (point))
+ (min pos (+ ref-pos (or (cdr adjust) 0)))))
+ ((> ref-pos pos)
(let ((adjust (get-char-property ref-pos 'smerge--refine-adjust)))
- (max (point) (- ref-pos (or (car adjust) 0)))))
+ (max pos (- ref-pos (or (car adjust) 0)))))
(t ref-pos)))
(other-forw (get-char-property ref-pos 'smerge--refine-other))
(other-back (get-char-property (1- ref-pos) 'smerge--refine-other))
(other (or other-forw other-back))
- (dist (- boundary (point))))
+ (dist (- boundary pos)))
(if (not (overlay-start other))
(user-error "The \"other\" position has vanished")
- (goto-char
- (- (if other-forw
- (- (overlay-start other)
- (or (car (overlay-get other 'smerge--refine-adjust)) 0))
- (+ (overlay-end other)
- (or (cdr (overlay-get other 'smerge--refine-adjust)) 0)))
- dist)))))
+ (- (if other-forw
+ (- (overlay-start other)
+ (or (car (overlay-get other 'smerge--refine-adjust)) 0))
+ (+ (overlay-end other)
+ (or (cdr (overlay-get other 'smerge--refine-adjust)) 0)))
+ dist))))
+
+(defun smerge-refine-exchange-point ()
+ "Go to the matching position in the other chunk."
+ (interactive)
+ (goto-char (smerge--refine-other-pos (point))))
(defun smerge-swap ()
;; FIXME: Extend for diff3 to allow swapping the middle end as well.
--
2.39.5
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.