-;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts
+;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc, tools, revision control, merge, diff3, cvs, conflict
(eval-when-compile (require 'cl))
(require 'diff-mode) ;For diff-auto-refine-mode.
-
+(require 'newcomment)
;;; The real definition comes later.
(defvar smerge-mode)
: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")))
+ '((((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."
:group 'smerge)
(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")))
+ '((((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."
:group 'smerge)
(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")))
+ '((((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."
:group 'smerge)
(define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1")
(defvar smerge-markers-face 'smerge-markers)
(defface smerge-refined-change
- '((t :background "yellow"))
+ '((t nil))
"Face used for char-based changes shown by `smerge-refine'."
:group 'smerge)
+(defface smerge-refined-removed
+ '((default
+ :inherit smerge-refined-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffaaaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222")
+ (t :inverse-video t))
+ "Face used for removed characters shown by `smerge-refine'."
+ :group 'smerge
+ :version "24.2")
+
+(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'."
+ :group 'smerge
+ :version "24.2")
+
(easy-mmode-defmap smerge-basic-map
`(("n" . smerge-next)
("p" . smerge-prev)
))))
(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"
(setq othertext
(if (null otherlines) ""
(let ((pos (point)))
- (dotimes (i otherlines) (delete-char 2) (forward-line 1))
+ (dotimes (_i otherlines) (delete-char 2) (forward-line 1))
(buffer-substring pos (point)))))
(with-current-buffer textbuf
(forward-line (- startline line))
(insert ">>>>>>> " name3 "\n")
(setq line endline))))))))
+(defconst smerge-resolve--normalize-re "[\n\t][ \t\n]*\\| [ \t\n]+")
+
+(defun smerge-resolve--extract-comment (beg end)
+ "Extract the text within the comments that span BEG..END."
+ (save-excursion
+ (let ((comments ())
+ combeg)
+ (goto-char beg)
+ (while (and (< (point) end)
+ (setq combeg (comment-search-forward end t)))
+ (let ((beg (point)))
+ (goto-char combeg)
+ (comment-forward 1)
+ (save-excursion
+ (comment-enter-backward)
+ (push " " comments)
+ (push (buffer-substring-no-properties beg (point)) comments))))
+ (push " " comments)
+ (with-temp-buffer
+ (apply #'insert (nreverse comments))
+ (goto-char (point-min))
+ (while (re-search-forward smerge-resolve--normalize-re
+ nil t)
+ (replace-match " "))
+ (buffer-string)))))
+
+(defun smerge-resolve--normalize (beg end)
+ (replace-regexp-in-string
+ smerge-resolve--normalize-re " "
+ (concat " " (buffer-substring-no-properties beg end) " ")))
+
(defun smerge-resolve (&optional safe)
"Resolve the conflict at point intelligently.
This relies on mode-specific knowledge and thus only works in some
(m2e (match-end 2))
(m3e (match-end 3))
(buf (generate-new-buffer " *smerge*"))
- m b o)
+ m b o
+ choice)
(unwind-protect
(progn
(cond
(with-current-buffer buf
(zerop (call-process-region
(point-min) (point-max) "patch" t nil nil
- "-r" "/dev/null" "--no-backup-if-mismatch"
+ "-r" null-device "--no-backup-if-mismatch"
"-fl" o))))
(save-restriction
(narrow-to-region m0b m0e)
(with-current-buffer buf
(zerop (call-process-region
(point-min) (point-max) "patch" t nil nil
- "-r" "/dev/null" "--no-backup-if-mismatch"
+ "-r" null-device "--no-backup-if-mismatch"
"-fl" m))))
(save-restriction
(narrow-to-region m0b m0e)
(smerge-remove-props m0b m0e)
(insert-file-contents m nil nil nil t)))
+ ;; If the conflict is only made of comments, and one of the two
+ ;; changes is only rearranging spaces (e.g. reflowing text) while
+ ;; the other is a real change, drop the space-rearrangement.
+ ((and m2e
+ (comment-only-p m1b m1e)
+ (comment-only-p m2b m2e)
+ (comment-only-p m3b m3e)
+ (let ((t1 (smerge-resolve--extract-comment m1b m1e))
+ (t2 (smerge-resolve--extract-comment m2b m2e))
+ (t3 (smerge-resolve--extract-comment m3b m3e)))
+ (cond
+ ((and (equal t1 t2) (not (equal t2 t3)))
+ (setq choice 3))
+ ((and (not (equal t1 t2)) (equal t2 t3))
+ (setq choice 1)))))
+ (set-match-data md)
+ (smerge-keep-n choice))
+ ;; Idem, when the conflict is contained within a single comment.
+ ((save-excursion
+ (and m2e
+ (nth 4 (syntax-ppss m0b))
+ ;; If there's a conflict earlier in the file,
+ ;; syntax-ppss is not reliable.
+ (not (re-search-backward smerge-begin-re nil t))
+ (progn (goto-char (nth 8 (syntax-ppss m0b)))
+ (forward-comment 1)
+ (> (point) m0e))
+ (let ((t1 (smerge-resolve--normalize m1b m1e))
+ (t2 (smerge-resolve--normalize m2b m2e))
+ (t3 (smerge-resolve--normalize m3b m3e)))
+ (cond
+ ((and (equal t1 t2) (not (equal t2 t3)))
+ (setq choice 3))
+ ((and (not (equal t1 t2)) (equal t2 t3))
+ (setq choice 1))))))
+ (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))
(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."
;; whitespace changes, it'll report added/removed lines :-(
(not smerge-refine-weight-hack))
(setq re (concat "[ \t]*\\(?:" re "\\)")))
- (dotimes (i n)
+ (dotimes (_i n)
(unless (looking-at re) (error "Smerge refine internal error"))
(goto-char (match-end 0)))))
(unless (eq (char-before) ?\n) (insert ?\n))
;; HACK ALERT!!
(if smerge-refine-weight-hack
- (dotimes (i (1- (length s))) (insert s "\n")))))
+ (dotimes (_i (1- (length s))) (insert s "\n")))))
(unless (bolp) (error "Smerge refine internal error"))
(let ((coding-system-for-write 'emacs-mule))
(write-region (point-min) (point-max) file nil 'nomessage)))))
(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."
(let* ((buf (current-buffer))
(pos (point))
+ deactivate-mark ; The code does not modify any visible buffer.
(file1 (make-temp-file "diff1"))
(file2 (make-temp-file "diff2")))
;; Chop up regions into smaller elements and save into files.
(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))))
(setq part (cond ((null (match-end 2)) 2)
((eq (match-end 1) (match-end 3)) 1)
((integerp part) part)
+ ;; If one of the parts is empty, any refinement using
+ ;; it will be trivial and uninteresting.
+ ((eq (match-end 1) (match-beginning 1)) 1)
+ ((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-diff (n1 n2)
(smerge-match-conflict)
;;;###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)
(provide 'smerge-mode)
-;; arch-tag: 605c8d1e-e43d-4943-a6f3-1bcc4333e690
;;; smerge-mode.el ends here
HCoop / bpt / emacs.git / blobdiff