From: Stefan Monnier Date: Sat, 15 Feb 2025 04:28:52 +0000 (-0500) Subject: (smerge-refine-exchange-point): New command X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1754305a28ad9a49ab9372daeb862fa98f8d1596;p=emacs.git (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 b7c9b0f8723..f64a91a79c1 100644 --- 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