(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.
This commit is contained in:
Stefan Monnier
parent
8d968c0f22
commit
18ebbba6c4
2 changed files with 133 additions and 42 deletions
5
etc/NEWS
5
etc/NEWS
|
|
@ -434,6 +434,11 @@ default is nil, which retains the old format.
|
|||
|
||||
*** New command 'smerge-extend' extends a conflict over surrounding lines.
|
||||
|
||||
*** New command 'smerge-refine-exchange-point' to jump to the other side.
|
||||
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.
|
||||
|
||||
** Image Dired
|
||||
|
||||
*** 'image-dired-show-all-from-dir' takes the same first argument as 'dired'.
|
||||
|
|
|
|||
|
|
@ -505,6 +505,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))
|
||||
|
|
@ -526,13 +528,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.
|
||||
|
|
@ -653,11 +654,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.
|
||||
|
|
@ -1038,25 +1037,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
|
||||
|
|
@ -1118,20 +1154,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))))
|
||||
|
|
@ -1206,6 +1242,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.
|
||||
|
|
@ -1470,7 +1554,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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue