;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc, tools, revision control, merge, diff3, cvs, conflict
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'diff-mode) ;For diff-auto-refine-mode.
(require 'newcomment)
(defcustom smerge-diff-buffer-name "*vc-diff*"
"Buffer name to use for displaying diffs."
- :group 'smerge
:type '(choice
(const "*vc-diff*")
(const "*cvs-diff*")
(if (listp diff-switches) diff-switches (list diff-switches)))
"A list of strings specifying switches to be passed to diff.
Used in `smerge-diff-base-mine' and related functions."
- :group 'smerge
:type '(repeat string))
(defcustom smerge-auto-leave t
"Non-nil means to leave `smerge-mode' when the last conflict is resolved."
- :group 'smerge
:type 'boolean)
(defface smerge-mine
- '((((min-colors 88) (background light))
- (:foreground "blue1"))
- (((background light))
- (:foreground "blue"))
- (((min-colors 88) (background dark))
- (:foreground "cyan1"))
- (((background dark))
- (:foreground "cyan")))
- "Face for your code."
- :group 'smerge)
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffdddd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#553333")
+ (((class color))
+ :foreground "red"))
+ "Face for your code.")
(define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1")
(defvar smerge-mine-face 'smerge-mine)
(defface smerge-other
- '((((background light))
- (:foreground "darkgreen"))
- (((background dark))
- (:foreground "lightgreen")))
- "Face for the other code."
- :group 'smerge)
+ '((((class color) (min-colors 88) (background light))
+ :background "#ddffdd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#335533")
+ (((class color))
+ :foreground "green"))
+ "Face for the other code.")
(define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1")
(defvar smerge-other-face 'smerge-other)
(defface smerge-base
- '((((min-colors 88) (background light))
- (:foreground "red1"))
- (((background light))
- (:foreground "red"))
- (((background dark))
- (:foreground "orange")))
- "Face for the base code."
- :group 'smerge)
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#888833")
+ (((class color))
+ :foreground "yellow"))
+ "Face for the base code.")
(define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1")
(defvar smerge-base-face 'smerge-base)
(:background "grey85"))
(((background dark))
(:background "grey30")))
- "Face for the conflict markers."
- :group 'smerge)
+ "Face for the conflict markers.")
(define-obsolete-face-alias 'smerge-markers-face 'smerge-markers "22.1")
(defvar smerge-markers-face 'smerge-markers)
-(defface smerge-refined-change
- '((t :background "yellow"))
- "Face used for char-based changes shown by `smerge-refine'."
- :group 'smerge)
+(defface smerge-refined-changed
+ '((t nil))
+ "Face used for char-based changes shown by `smerge-refine'.")
+(define-obsolete-face-alias 'smerge-refined-change 'smerge-refined-changed "24.5")
+
+(defface smerge-refined-removed
+ '((default
+ :inherit smerge-refined-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffbbbb")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222")
+ (t :inverse-video t))
+ "Face used for removed characters shown by `smerge-refine'."
+ :version "24.3")
+
+(defface smerge-refined-added
+ '((default
+ :inherit smerge-refined-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#aaffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#22aa22")
+ (t :inverse-video t))
+ "Face used for added characters shown by `smerge-refine'."
+ :version "24.3")
(easy-mmode-defmap smerge-basic-map
`(("n" . smerge-next)
(defcustom smerge-command-prefix "\C-c^"
"Prefix for `smerge-mode' commands."
- :group 'smerge
:type '(choice (const :tag "ESC" "\e")
(const :tag "C-c ^" "\C-c^" )
(const :tag "none" "")
"Font lock patterns for `smerge-mode'.")
(defconst smerge-begin-re "^<<<<<<< \\(.*\\)\n")
-(defconst smerge-end-re "^>>>>>>> .*\n")
-(defconst smerge-base-re "^||||||| .*\n")
+(defconst smerge-end-re "^>>>>>>> \\(.*\\)\n")
+(defconst smerge-base-re "^||||||| \\(.*\\)\n")
(defconst smerge-other-re "^=======\n")
(defvar smerge-conflict-style nil
))))
(defvar smerge-resolve-function
- (lambda () (error "Don't know how to resolve"))
+ (lambda () (user-error "Don't know how to resolve"))
"Mode-specific merge function.
The function is called with zero or one argument (non-nil if the resolution
function should only apply safe heuristics) and with the match data set
according to `smerge-match-conflict'.")
-(add-to-list 'debug-ignored-errors "Don't know how to resolve")
(defvar smerge-text-properties
`(help-echo "merge conflict: mouse-3 shows a menu"
(set-match-data md)
(smerge-keep-n choice))
(t
- (error "Don't know how to resolve"))))
+ (user-error "Don't know how to resolve"))))
(if (buffer-name buf) (kill-buffer buf))
(if m (delete-file m))
(if b (delete-file b))
(while (or (not (match-end i))
(< (point) (match-beginning i))
(>= (point) (match-end i)))
- (decf i))
+ (cl-decf i))
i))
(defun smerge-keep-current ()
(smerge-auto-leave))))))
(defun smerge-diff-base-mine ()
- "Diff 'base' and 'mine' version in current conflict region."
+ "Diff `base' and `mine' version in current conflict region."
(interactive)
(smerge-diff 2 1))
(defun smerge-diff-base-other ()
- "Diff 'base' and 'other' version in current conflict region."
+ "Diff `base' and `other' version in current conflict region."
(interactive)
(smerge-diff 2 3))
(defun smerge-diff-mine-other ()
- "Diff 'mine' and 'other' version in current conflict region."
+ "Diff `mine' and `other' version in current conflict region."
(interactive)
(smerge-diff 1 3))
(filename (or (match-string 1) ""))
(_ (re-search-forward smerge-end-re))
- (_ (assert (< orig-point (match-end 0))))
+ (_ (cl-assert (< orig-point (match-end 0))))
(other-end (match-beginning 0))
(end (match-end 0))
(when base-start (1- base-start)) base-start
(1- other-start) other-start))
t)
- (search-failed (error "Point not in conflict region")))))
-
-(add-to-list 'debug-ignored-errors "Point not in conflict region")
+ (search-failed (user-error "Point not in conflict region")))))
(defun smerge-conflict-overlay (pos)
"Return the conflict overlay at POS if any."
(dolist (x props) (overlay-put ol (car x) (cdr x)))
ol)))))
-(defun smerge-refine-subst (beg1 end1 beg2 end2 props &optional preproc)
+(defun smerge-refine-subst (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)
"Show fine differences in the two regions BEG1..END1 and BEG2..END2.
-PROPS is an alist of properties to put (via overlays) on the changes.
+PROPS-C is an alist of properties to put (via overlays) on the changes.
+PROPS-R is an alist of properties to put on removed characters.
+PROPS-A is an alist of properties to put on added characters.
+If PROPS-R and PROPS-A are nil, put PROPS-C on all changes.
+If PROPS-C is nil, but PROPS-R and PROPS-A are non-nil,
+put PROPS-A on added characters, PROPS-R on removed characters.
+If PROPS-C, PROPS-R and PROPS-A are non-nil, put PROPS-C on changed characters,
+PROPS-A on added characters, and PROPS-R on removed characters.
+
If non-nil, PREPROC is called with no argument in a buffer that contains
a copy of a region, just before preparing it to for `diff'. It can be
used to replace chars to try and eliminate some spurious differences."
(m5 (match-string 5)))
(when (memq op '(?d ?c))
(setq last1
- (smerge-refine-highlight-change buf beg1 m1 m2 props)))
+ (smerge-refine-highlight-change
+ buf 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 buf beg2 m4 m5 props))))
+ (smerge-refine-highlight-change
+ buf beg2 m4 m5
+ ;; Same logic as for removed chars above.
+ (or (and (eq op '?c) props-c) props-a props-c)))))
(forward-line 1) ;Skip hunk header.
(and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
(goto-char (match-beginning 0))))
- ;; (assert (or (null last1) (< (overlay-start last1) end1)))
- ;; (assert (or (null last2) (< (overlay-start last2) end2)))
+ ;; (cl-assert (or (null last1) (< (overlay-start last1) end1)))
+ ;; (cl-assert (or (null last2) (< (overlay-start last2) end2)))
(if smerge-refine-weight-hack
(progn
- ;; (assert (or (null last1) (<= (overlay-end last1) end1)))
- ;; (assert (or (null last2) (<= (overlay-end last2) end2)))
+ ;; (cl-assert (or (null last1) (<= (overlay-end last1) end1)))
+ ;; (cl-assert (or (null last2) (<= (overlay-end last2) end2)))
)
;; smerge-refine-forward-function when calling in chopup may
;; have stopped because it bumped into EOB whereas in
((eq (match-end 3) (match-beginning 3)) 3)
(t 2)))
(let ((n1 (if (eq part 1) 2 1))
- (n2 (if (eq part 3) 2 3)))
+ (n2 (if (eq part 3) 2 3))
+ (smerge-use-changed-face
+ (and (face-differs-from-default-p 'smerge-refined-change)
+ (not (face-equal 'smerge-refined-change 'smerge-refined-added))
+ (not (face-equal 'smerge-refined-change 'smerge-refined-removed)))))
(smerge-ensure-match n1)
(smerge-ensure-match n2)
(with-silent-modifications
(cons (buffer-chars-modified-tick) part)))
(smerge-refine-subst (match-beginning n1) (match-end n1)
(match-beginning n2) (match-end n2)
- '((smerge . refine)
- (face . smerge-refined-change)))))
+ (if smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-change)))
+ nil
+ (unless smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-removed)))
+ (unless smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-added))))))
+
+(defun smerge-swap ()
+ "Swap the \"Mine\" and the \"Other\" chunks.
+Can be used before things like `smerge-keep-all' or `smerge-resolve' where the
+ordering can have some subtle influence on the result, such as preferring the
+spacing of the \"Other\" chunk."
+ (interactive)
+ (smerge-match-conflict)
+ (goto-char (match-beginning 3))
+ (let ((txt3 (delete-and-extract-region (point) (match-end 3))))
+ (insert (delete-and-extract-region (match-beginning 1) (match-end 1)))
+ (goto-char (match-beginning 1))
+ (insert txt3)))
(defun smerge-diff (n1 n2)
(smerge-match-conflict)
(defvar ediff-quit-hook)
(declare-function ediff-cleanup-mess "ediff-util" nil)
+(defun smerge--get-marker (regexp default)
+ (save-excursion
+ (goto-char (point-min))
+ (if (and (search-forward-regexp regexp nil t)
+ (> (match-end 1) (match-beginning 1)))
+ (concat default "=" (match-string-no-properties 1))
+ default)))
+
;;;###autoload
(defun smerge-ediff (&optional name-mine name-other name-base)
"Invoke ediff to resolve the conflicts.
(mode major-mode)
;;(ediff-default-variant 'default-B)
(config (current-window-configuration))
- (filename (file-name-nondirectory buffer-file-name))
+ (filename (file-name-nondirectory (or buffer-file-name "-")))
(mine (generate-new-buffer
- (or name-mine (concat "*" filename " MINE*"))))
+ (or name-mine
+ (concat "*" filename " "
+ (smerge--get-marker smerge-begin-re "MINE")
+ "*"))))
(other (generate-new-buffer
- (or name-other (concat "*" filename " OTHER*"))))
+ (or name-other
+ (concat "*" filename " "
+ (smerge--get-marker smerge-end-re "OTHER")
+ "*"))))
base)
(with-current-buffer mine
(buffer-disable-undo)
(when base
(setq base (generate-new-buffer
- (or name-base (concat "*" filename " BASE*"))))
+ (or name-base
+ (concat "*" filename " "
+ (smerge--get-marker smerge-base-re "BASE")
+ "*"))))
(with-current-buffer base
(buffer-disable-undo)
(insert-buffer-substring buf)
(progn (pop-mark) (mark))
(when current-prefix-arg (pop-mark) (mark))))
;; Start from the end so as to avoid problems with pos-changes.
- (destructuring-bind (pt1 pt2 pt3 &optional pt4)
- (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=)
+ (pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4)
+ (sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=)))
(goto-char pt1) (beginning-of-line)
(insert ">>>>>>> OTHER\n")
(goto-char pt2) (beginning-of-line)
;;;###autoload
(define-minor-mode smerge-mode
"Minor mode to simplify editing output from the diff3 program.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
\\{smerge-mode-map}"
:group 'smerge :lighter " SMerge"
(when (and (boundp 'font-lock-mode) font-lock-mode)