Subject: bug#78806: closed (Re: bug#78806: [PATCH] (smerge-refine-region): Add support for a virtual "other cursor")

From: [email-masked] (GNU bug Tracking System)
Date: Mon, 23 Jun 2025 04:05:02 +0000

Your bug report

#78806: [PATCH] (smerge-refine-region): Add support for a virtual "other cursor"

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
78806: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=78806
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#78806: [PATCH] (smerge-refine-region): Add support for a virtual "other cursor"
From: Stefan Monnier <[email-masked]>
To: Eli Zaretskii <[email-masked]>
Cc: [email-masked]
Date: Mon, 23 Jun 2025 00:04:06 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

Thanks, pushed with the suggested improvements,

        Stefan

Subject: [PATCH] (smerge-refine-region): Add support for a virtual "other cursor"
From: Stefan Monnier <[email-masked]>
To: [email-masked]
Date: Mon, 16 Jun 2025 07:11:24 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

Tags: patch

The patch below adds support to `smerge-refine-region` for keeping
a kind of "virtual cursor" that shows the "corresponding" point in the
other part of a diff.  I.e. it shows where
`smerge-refine-exchange-point` would jump.

The patch is somewhat incomplete in that it works only after the user
explicitly calls `M-x cursor-sensor-mode RET` (and it lacks a NEWS entry).

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.

Comments, objections?

        Stefan

 In GNU Emacs 31.0.50 (build 1, i686-pc-linux-gnu, GTK+ Version 3.24.49,
 cairo version 1.18.4) of 2025-06-06 built on asado
Repository revision: 8c3dd116ce3e4ef235618502512045d47a3f0329
Repository branch: work
Windowing system distributor 'The X.Org Foundation', version 11.0.12101016
System Description: Debian GNU/Linux 13 (trixie)

Configured using:
 'configure -C --enable-checking --enable-check-lisp-object-type --with-modules --with-cairo --with-tiff=ifavailable
 'CFLAGS=-Wall -g3 -Og -Wno-pointer-sign'
 PKG_CONFIG_PATH=/home/monnier/lib/pkgconfig'

>From e049fa40680526d7f225bf2fc37059975bbf805c Mon Sep 17 00:00:00 2001
From: Stefan Monnier <[email-masked]>
Date: Mon, 16 Jun 2025 07:05:11 -0400
Subject: [PATCH] (smerge-refine-region): Add support for a virtual "other
 cursor"

* lisp/vc/smerge-mode.el (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.
---
 lisp/emacs-lisp/cursor-sensor.el | 126 ++++++++++++++++---------------
 lisp/vc/smerge-mode.el           | 110 ++++++++++++++++++++-------
 2 files changed, 150 insertions(+), 86 deletions(-)

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..1cc2e57a6b3 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1089,10 +1089,14 @@ 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)))))
 
 ;;;###autoload
@@ -1124,7 +1128,9 @@ 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))))
       (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 +1221,54 @@ 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 (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)
+                ;; FIXME: `region', really?
+                (overlay-put ol 'face 'region))
+              ;; 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
+                           (if (= other-beg other-end)
+                               (eval-when-compile
+                                 (propertize " " 'face 'region)))))))))))
+
 (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 +1319,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.47.2