(smerge-refine-exchange-point): New command

* lisp/vc/smerge-mode.el (smerge--refine-highlight-change):
Allow empty region and always create an overlay.  Also, remember any
adjustment we applied the overlay's boundaries.
(smerge-refine-regions): Always create two overlays per hunk and "connect"
them via `smerge--refine-other`.
(smerge-refine-exchange-point): New command.

(cherry picked from commit 18ebbba6c422617a16cc36082a8ba871b5bfce2c)

diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index b7c9b0f8723980160704055834355ba07b6f4abd..f64a91a79c146bb72ad662970a69d13c5fbabba9 100644 (file)
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -501,6 +501,8 @@ This relies on mode-specific knowledge and thus only works in some
 major modes.  Uses `smerge-resolve-function' to do the actual work."
   (interactive)
   (smerge-match-conflict)
+  ;; FIXME: This ends up removing the refinement-highlighting when no
+  ;; resolution is performed.
   (smerge-remove-props (match-beginning 0) (match-end 0))
   (let ((md (match-data))
        (m0b (match-beginning 0))
@@ -522,13 +524,12 @@ major modes.  Uses `smerge-resolve-function' to do the actual work."
                  (eq (match-beginning 1) (match-beginning 3)))
             (smerge-keep-n 3))
            ;; Mode-specific conflict resolution.
-           ((condition-case nil
-                (atomic-change-group
-                  (if safe
-                      (funcall smerge-resolve-function safe)
-                    (funcall smerge-resolve-function))
-                  t)
-              (error nil))
+           ((ignore-errors
+              (atomic-change-group
+                (if safe
+                    (funcall smerge-resolve-function safe)
+                  (funcall smerge-resolve-function))
+                t))
             ;; Nothing to do: the resolution function has done it already.
             nil)
            ;; Non-conflict.
@@ -649,11 +650,9 @@ major modes.  Uses `smerge-resolve-function' to do the actual work."
   (save-excursion
     (goto-char (point-min))
     (while (re-search-forward smerge-begin-re nil t)
-      (condition-case nil
-          (progn
-            (smerge-match-conflict)
-            (smerge-resolve 'safe))
-        (error nil)))))
+      (with-demoted-errors "%S"
+        (smerge-match-conflict)
+        (smerge-resolve 'safe)))))
 
 (defun smerge-batch-resolve ()
   ;; command-line-args-left is what is left of the command line.
@@ -1034,25 +1033,62 @@ chars to try and eliminate some spurious differences."
                                   smerge-refine-forward-function)
                                 startline)
                        (point)))
-           (end (progn (funcall (if smerge-refine-weight-hack
-                                    #'forward-char
-                                  smerge-refine-forward-function)
-                          (if match-num2
-                              (- (string-to-number match-num2)
-                                 startline)
-                            1))
-                       (point))))
-      (when smerge-refine-ignore-whitespace
-        (skip-chars-backward " \t\n" beg) (setq end (point))
-        (goto-char beg)
-        (skip-chars-forward " \t\n" end)  (setq beg (point)))
-      (when (> end beg)
+           (end (if (eq t match-num2) beg
+                  (funcall (if smerge-refine-weight-hack
+                               #'forward-char
+                             smerge-refine-forward-function)
+                           (if match-num2
+                               (- (string-to-number match-num2)
+                                  startline)
+                             1))
+                  (point))))
+      (cl-assert (<= beg end))
+      (when (and (eq t match-num2) (not (eolp)))
+        ;; FIXME: No idea where this off-by-one comes from, nor why it's only
+        ;; within lines.
+        (setq beg (1+ beg))
+        (setq end (1+ end))
+        (goto-char end))
+      (let ((olbeg beg)
+            (olend end))
+        (cond
+         ((> end beg)
+          (when smerge-refine-ignore-whitespace
+            (let* ((newend (progn (skip-chars-backward " \t\n" beg) (point)))
+                   (newbeg (progn (goto-char beg)
+                                  (skip-chars-forward " \t\n" newend) (point))))
+              (unless (= newend newbeg)
+                (push `(smerge--refine-adjust ,(- newbeg beg) . ,(- end newend))
+                      props)
+                (setq olend newend)
+                (setq olbeg newbeg)))))
+         (t
+          (cl-assert (= end beg))
+          ;; If BEG=END, we have nothing to highlight, but we still want
+          ;; to create an overlay that we can find with char properties,
+          ;; so as to keep track of the position where a text was
+          ;; inserted/deleted, so make it span at a char.
+          (push (cond
+                 ((< beg (point-max))
+                  (setq olend (1+ beg))
+                  '(smerge--refine-adjust 0 . -1))
+                 (t (cl-assert (< (point-min) end))
+                    (setq olbeg (1- end))
+                    '(smerge--refine-adjust -1 . 0)))
+                props)))
+
         (let ((ol (make-overlay
-                   beg end nil
+                   olbeg olend nil
                    ;; Make them tend to shrink rather than spread when editing.
                    'front-advance nil)))
+          ;; (overlay-put ol 'smerge--debug
+          ;;                 (list match-num1 match-num2 startline))
           (overlay-put ol 'evaporate t)
-          (dolist (x props) (overlay-put ol (car x) (cdr x)))
+          (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))))
           ol)))))
 
 ;;;###autoload
@@ -1114,20 +1150,20 @@ used to replace chars to try and eliminate some spurious differences."
                     (m2 (match-string 2))
                     (m4 (match-string 4))
                     (m5 (match-string 5)))
-                (when (memq op '(?d ?c))
-                  (setq last1
-                        (smerge--refine-highlight-change
-                        beg1 m1 m2
-                        ;; Try to use props-c only for changed chars,
-                        ;; fallback to props-r for changed/removed chars,
-                        ;; but if props-r is nil then fallback to props-c.
-                        (or (and (eq op '?c) props-c) props-r props-c))))
-                (when (memq op '(?a ?c))
-                  (setq last2
-                        (smerge--refine-highlight-change
-                        beg2 m4 m5
-                        ;; Same logic as for removed chars above.
-                        (or (and (eq op '?c) props-c) props-a props-c)))))
+                (setq last1
+                      (smerge--refine-highlight-change
+                      beg1 m1 (if (eq op ?a) t m2)
+                      ;; Try to use props-c only for changed chars,
+                      ;; fallback to props-r for changed/removed chars,
+                      ;; but if props-r is nil then fallback to props-c.
+                      (or (and (eq op '?c) props-c) props-r props-c)))
+                (setq last2
+                      (smerge--refine-highlight-change
+                      beg2 m4 (if (eq op ?d) t m5)
+                      ;; Same logic as for removed chars above.
+                      (or (and (eq op '?c) props-c) props-a props-c))))
+              (overlay-put last1 'smerge--refine-other last2)
+              (overlay-put last2 'smerge--refine-other last1)
               (forward-line 1)                            ;Skip hunk header.
               (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
                    (goto-char (match-beginning 0))))
@@ -1202,6 +1238,54 @@ repeating the command will highlight other two parts."
                         (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)
+  ;; FIXME: Chunks aren't marked in the same way for all users of
+  ;; `smerge-refine-regions' :-(
+  ;; (unless (get-char-property (point) 'smerge)
+  ;;   (error "Not inside a refined chunk"))
+  (let* ((ref-pos
+          (if (or (get-char-property (point) 'smerge--refine-other)
+                  (get-char-property (1- (point)) 'smerge--refine-other))
+              (point)
+            ;; FIXME: Bound the search to the current chunk!
+            (let ((next (next-single-char-property-change
+                         (point) 'smerge--refine-other))
+                  (prev (previous-single-char-property-change
+                         (point) 'smerge--refine-other)))
+              (cond
+               ((and prev
+                     (or (null next)
+                         (> (- next (point)) (- (point) prev))))
+                prev)
+               (t (or next
+                      ;; FIXME: default to the bounds!
+                      (user-error "No \"other\" position info found")))))))
+         (boundary
+          (cond
+           ((< ref-pos (point))
+            (let ((adjust (get-char-property (1- ref-pos)
+                                             'smerge--refine-adjust)))
+              (min (point) (+ ref-pos (or (cdr adjust) 0)))))
+           ((> ref-pos (point))
+            (let ((adjust (get-char-property ref-pos 'smerge--refine-adjust)))
+              (max (point) (- 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))))
+    (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)))))
+
 (defun smerge-swap ()
   ;; FIXME: Extend for diff3 to allow swapping the middle end as well.
   "Swap the \"Upper\" and the \"Lower\" chunks.
@@ -1466,7 +1550,9 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
       (goto-char (point-min))
       (while (smerge-find-conflict)
        (save-excursion
-         (font-lock-fontify-region (match-beginning 0) (match-end 0) nil)))))
+          (with-demoted-errors "%S" ;Those things do happen, occasionally.
+            (font-lock-fontify-region
+             (match-beginning 0) (match-end 0) nil))))))
   (if (string-match (regexp-quote smerge-parsep-re) paragraph-separate)
       (unless smerge-mode
         (setq-local paragraph-separate