X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1fb072d1dff954c21d4805196df62c8eeead301c..2b34df4ebc935a834a77b930b35c4a42f7236440:/lisp/smerge-mode.el diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el index e3484bb0a4..95efbc513f 100644 --- a/lisp/smerge-mode.el +++ b/lisp/smerge-mode.el @@ -1,17 +1,17 @@ ;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: tools revision-control merge diff3 cvs conflict ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -47,6 +45,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(require 'diff-mode) ;For diff-auto-refine-mode. ;;; The real definition comes later. @@ -90,8 +89,7 @@ Used in `smerge-diff-base-mine' and related functions." (:foreground "cyan"))) "Face for your code." :group 'smerge) -;; backward-compatibility alias -(put 'smerge-mine-face 'face-alias 'smerge-mine) +(define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1") (defvar smerge-mine-face 'smerge-mine) (defface smerge-other @@ -101,8 +99,7 @@ Used in `smerge-diff-base-mine' and related functions." (:foreground "lightgreen"))) "Face for the other code." :group 'smerge) -;; backward-compatibility alias -(put 'smerge-other-face 'face-alias 'smerge-other) +(define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1") (defvar smerge-other-face 'smerge-other) (defface smerge-base @@ -114,8 +111,7 @@ Used in `smerge-diff-base-mine' and related functions." (:foreground "orange"))) "Face for the base code." :group 'smerge) -;; backward-compatibility alias -(put 'smerge-base-face 'face-alias 'smerge-base) +(define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1") (defvar smerge-base-face 'smerge-base) (defface smerge-markers @@ -125,8 +121,7 @@ Used in `smerge-diff-base-mine' and related functions." (:background "grey30"))) "Face for the conflict markers." :group 'smerge) -;; backward-compatibility alias -(put 'smerge-markers-face 'face-alias 'smerge-markers) +(define-obsolete-face-alias 'smerge-markers-face 'smerge-markers "22.1") (defvar smerge-markers-face 'smerge-markers) (defface smerge-refined-change @@ -155,7 +150,10 @@ Used in `smerge-diff-base-mine' and related functions." (defcustom smerge-command-prefix "\C-c^" "Prefix for `smerge-mode' commands." :group 'smerge - :type '(choice (string "\e") (string "\C-c^") (string "") string)) + :type '(choice (const :tag "ESC" "\e") + (const :tag "C-c ^" "\C-c^" ) + (const :tag "none" "") + string)) (easy-mmode-defmap smerge-mode-map `((,smerge-command-prefix . ,smerge-basic-map)) @@ -252,7 +250,9 @@ Can be nil if the style is undecided, or else: ;;;; ;; Define smerge-next and smerge-prev -(easy-mmode-define-navigation smerge smerge-begin-re "conflict") +(easy-mmode-define-navigation smerge smerge-begin-re "conflict" nil nil + (if diff-auto-refine-mode + (condition-case nil (smerge-refine) (error nil)))) (defconst smerge-match-names ["conflict" "mine" "base" "other"]) @@ -290,6 +290,8 @@ Can be nil if the style is undecided, or else: (defun smerge-combine-with-next () "Combine the current conflict with the next one." + ;; `smerge-auto-combine' relies on the finish position (at the beginning + ;; of the closing marker). (interactive) (smerge-match-conflict) (let ((ends nil)) @@ -321,6 +323,25 @@ Can be nil if the style is undecided, or else: (dolist (m match-data) (if m (move-marker m nil))) (mapc (lambda (m) (if m (move-marker m nil))) ends))))) +(defvar smerge-auto-combine-max-separation 2 + "Max number of lines between conflicts that should be combined.") + +(defun smerge-auto-combine () + "Automatically combine conflicts that are near each other." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (smerge-find-conflict) + ;; 2 is 1 (default) + 1 (the begin markers). + (while (save-excursion + (smerge-find-conflict + (line-beginning-position + (+ 2 smerge-auto-combine-max-separation)))) + (forward-line -1) ;Go back inside the conflict. + (smerge-combine-with-next) + (forward-line 1) ;Move past the end of the conflict. + )))) + (defvar smerge-resolve-function (lambda () (error "Don't know how to resolve")) "Mode-specific merge function. @@ -346,9 +367,8 @@ according to `smerge-match-conflict'.") ;; during font-locking so inhibit-modification-hooks is non-nil, so we ;; can't just modify the buffer and expect font-lock to be triggered as in: ;; (put-text-property beg end 'smerge-force-highlighting nil) - (let ((modified (buffer-modified-p))) - (remove-text-properties beg end '(fontified nil)) - (restore-buffer-modified-p modified))) + (with-silent-modifications + (remove-text-properties beg end '(fontified nil)))) (defun smerge-popup-context-menu (event) "Pop up the Smerge mode context menu under mouse." @@ -379,6 +399,62 @@ according to `smerge-match-conflict'.") (smerge-remove-props (or beg (point-min)) (or end (point-max))) (push event unread-command-events))))) +(defun smerge-apply-resolution-patch (buf m0b m0e m3b m3e &optional m2b) + "Replace the conflict with a bunch of subconflicts. +BUF contains a plain diff between match-1 and match-3." + (let ((line 1) + (textbuf (current-buffer)) + (name1 (progn (goto-char m0b) + (buffer-substring (+ (point) 8) (line-end-position)))) + (name2 (when m2b (goto-char m2b) (forward-line -1) + (buffer-substring (+ (point) 8) (line-end-position)))) + (name3 (progn (goto-char m0e) (forward-line -1) + (buffer-substring (+ (point) 8) (line-end-position))))) + (smerge-remove-props m0b m0e) + (delete-region m3e m0e) + (delete-region m0b m3b) + (setq m3b m0b) + (setq m3e (- m3e (- m3b m0b))) + (goto-char m3b) + (with-current-buffer buf + (goto-char (point-min)) + (while (not (eobp)) + (if (not (looking-at "\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?\\([acd]\\)\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?$")) + (error "Unexpected patch hunk header: %s" + (buffer-substring (point) (line-end-position))) + (let* ((op (char-after (match-beginning 3))) + (startline (+ (string-to-number (match-string 1)) + ;; No clue why this is the way it is, but line + ;; numbers seem to be off-by-one for `a' ops. + (if (eq op ?a) 1 0))) + (endline (if (eq op ?a) startline + (1+ (if (match-end 2) + (string-to-number (match-string 2)) + startline)))) + (lines (- endline startline)) + (otherlines (cond + ((eq op ?d) nil) + ((null (match-end 5)) 1) + (t (- (string-to-number (match-string 5)) + (string-to-number (match-string 4)) -1)))) + othertext) + (forward-line 1) ;Skip header. + (forward-line lines) ;Skip deleted text. + (if (eq op ?c) (forward-line 1)) ;Skip separator. + (setq othertext + (if (null otherlines) "" + (let ((pos (point))) + (dotimes (i otherlines) (delete-char 2) (forward-line 1)) + (buffer-substring pos (point))))) + (with-current-buffer textbuf + (forward-line (- startline line)) + (insert "<<<<<<< " name1 "\n" othertext + (if name2 (concat "||||||| " name2 "\n") "") + "=======\n") + (forward-line lines) + (insert ">>>>>>> " name3 "\n") + (setq line endline)))))))) + (defun smerge-resolve (&optional safe) "Resolve the conflict at point intelligently. This relies on mode-specific knowledge and thus only works in @@ -386,33 +462,107 @@ some major modes. Uses `smerge-resolve-function' to do the actual work." (interactive) (smerge-match-conflict) (smerge-remove-props (match-beginning 0) (match-end 0)) - (cond - ;; Trivial diff3 -A non-conflicts. - ((and (eq (match-end 1) (match-end 3)) - (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)) - ;; Nothing to do: the resolution function has done it already. - nil) - ;; FIXME: Add "if [ diff -b MINE OTHER ]; then select OTHER; fi" - ((and (match-end 2) - ;; FIXME: Add "diff -b BASE MINE | patch OTHER". - ;; FIXME: Add "diff -b BASE OTHER | patch MINE". - nil) - ) - ((and (not (match-end 2)) - ;; FIXME: Add "diff -b"-based refinement. - nil) - ) - (t - (error "Don't know how to resolve"))) + (let ((md (match-data)) + (m0b (match-beginning 0)) + (m1b (match-beginning 1)) + (m2b (match-beginning 2)) + (m3b (match-beginning 3)) + (m0e (match-end 0)) + (m1e (match-end 1)) + (m2e (match-end 2)) + (m3e (match-end 3)) + (buf (generate-new-buffer " *smerge*")) + m b o) + (unwind-protect + (progn + (cond + ;; Trivial diff3 -A non-conflicts. + ((and (eq (match-end 1) (match-end 3)) + (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)) + ;; Nothing to do: the resolution function has done it already. + nil) + ;; Non-conflict. + ((and (eq m1e m3e) (eq m1b m3b)) + (set-match-data md) (smerge-keep-n 3)) + ;; Refine a 2-way conflict using "diff -b". + ;; In case of a 3-way conflict with an empty base + ;; (i.e. 2 conflicting additions), we do the same, presuming + ;; that the 2 additions should be somehow merged rather + ;; than concatenated. + ((let ((lines (count-lines m3b m3e))) + (setq m (make-temp-file "smm")) + (write-region m1b m1e m nil 'silent) + (setq o (make-temp-file "smo")) + (write-region m3b m3e o nil 'silent) + (not (or (eq m1b m1e) (eq m3b m3e) + (and (not (zerop (call-process diff-command + nil buf nil "-b" o m))) + ;; TODO: We don't know how to do the refinement + ;; if there's a non-empty ancestor and m1 and m3 + ;; aren't just plain equal. + m2b (not (eq m2b m2e))) + (with-current-buffer buf + (goto-char (point-min)) + ;; Make sure there's some refinement. + (looking-at + (concat "1," (number-to-string lines) "c")))))) + (smerge-apply-resolution-patch buf m0b m0e m3b m3e m2b)) + ;; "Mere whitespace changes" conflicts. + ((when m2e + (setq b (make-temp-file "smb")) + (write-region m2b m2e b nil 'silent) + (with-current-buffer buf (erase-buffer)) + ;; Only minor whitespace changes made locally. + ;; BEWARE: pass "-c" 'cause the output is reused in the next test. + (zerop (call-process diff-command nil buf nil "-bc" b m))) + (set-match-data md) + (smerge-keep-n 3)) + ;; Try "diff -b BASE MINE | patch OTHER". + ((when (and (not safe) m2e b + ;; If the BASE is empty, this would just concatenate + ;; the two, which is rarely right. + (not (eq m2b m2e))) + ;; BEWARE: we're using here the patch of the previous test. + (with-current-buffer buf + (zerop (call-process-region + (point-min) (point-max) "patch" t nil nil + "-r" "/dev/null" "--no-backup-if-mismatch" + "-fl" o)))) + (save-restriction + (narrow-to-region m0b m0e) + (smerge-remove-props m0b m0e) + (insert-file-contents o nil nil nil t))) + ;; Try "diff -b BASE OTHER | patch MINE". + ((when (and (not safe) m2e b + ;; If the BASE is empty, this would just concatenate + ;; the two, which is rarely right. + (not (eq m2b m2e))) + (write-region m3b m3e o nil 'silent) + (call-process diff-command nil buf nil "-bc" b o) + (with-current-buffer buf + (zerop (call-process-region + (point-min) (point-max) "patch" t nil nil + "-r" "/dev/null" "--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))) + (t + (error "Don't know how to resolve")))) + (if (buffer-name buf) (kill-buffer buf)) + (if m (delete-file m)) + (if b (delete-file b)) + (if o (delete-file o)))) (smerge-auto-leave)) (defun smerge-resolve-all () @@ -433,6 +583,12 @@ some major modes. Uses `smerge-resolve-function' to do the actual work." (error "`smerge-batch-resolve' is to be used only with -batch")) (while command-line-args-left (let ((file (pop command-line-args-left))) + (if (string-match "\\.rej\\'" file) + ;; .rej files should never contain diff3 markers, on the other hand, + ;; in Arch, .rej files are sometimes used to indicate that the + ;; main file has diff3 markers. So you can pass **/*.rej and + ;; it will DTRT. + (setq file (substring file 0 (match-beginning 0)))) (message "Resolving conflicts in %s..." file) (when (file-readable-p file) (with-current-buffer (find-file-noselect file) @@ -549,7 +705,7 @@ An error is raised if not inside a conflict." ((save-excursion (goto-char mine-start) (re-search-forward smerge-begin-re end t)) - ;; There's a nested conflict and we're after the the beginning + ;; There's a nested conflict and we're after the beginning ;; of the outer one but before the beginning of the inner one. ;; Of course, maybe this is not a nested conflict but in that ;; case it can only be something nastier that we don't know how @@ -645,86 +801,228 @@ Point is moved to the end of the conflict." (error nil))) found)) -(defun smerge-refine-chopup-region (beg end file) - "Chopup the region into small elements, one per line." - ;; ediff chops up into words, where the definition of a word is - ;; customizable. Instead we here keep only one char per line. - ;; The advantages are that there's nothing to configure, that we get very - ;; fine results, and that it's trivial to map the line numbers in the - ;; output of diff back into buffer positions. The disadvantage is that it - ;; can take more time to compute the diff and that the result is sometimes - ;; too fine. I'm not too concerned about the slowdown because conflicts - ;; are usually significantly smaller than the whole file. As for the - ;; problem of too-fine-refinement, I have found it to be unimportant - ;; especially when you consider the cases where the fine-grain is just - ;; what you want. +;;; Refined change highlighting + +(defvar smerge-refine-forward-function 'smerge-refine-forward + "Function used to determine an \"atomic\" element. +You can set it to `forward-char' to get char-level granularity. +Its behavior has mainly two restrictions: +- if this function encounters a newline, it's important that it stops right + after the newline. + This only matters if `smerge-refine-ignore-whitespace' is nil. +- it needs to be unaffected by changes performed by the `preproc' argument + to `smerge-refine-subst'. + This only matters if `smerge-refine-weight-hack' is nil.") + +(defvar smerge-refine-ignore-whitespace t + "If non-nil,Indicate that smerge-refine should try to ignore change in whitespace.") + +(defvar smerge-refine-weight-hack t + "If non-nil, pass to diff as many lines as there are chars in the region. +I.e. each atomic element (e.g. word) will be copied as many times (on different +lines) as it has chars. This has 2 advantages: +- if `diff' tries to minimize the number *lines* (rather than chars) + added/removed, this adjust the weights so that adding/removing long + symbols is considered correspondingly more costly. +- `smerge-refine-forward-function' only needs to be called when chopping up + the regions, and `forward-char' can be used afterwards. +It has the following disadvantages: +- cannot use `diff -w' because the weighting causes added spaces in a line + to be represented as added copies of some line, so `diff -w' can't do the + right thing any more. +- may in degenerate cases take a 1KB input region and turn it into a 1MB + file to pass to diff.") + +(defun smerge-refine-forward (n) + (let ((case-fold-search nil) + (re "[[:upper:]]?[[:lower:]]+\\|[[:upper:]]+\\|[[:digit:]]+\\|.\\|\n")) + (when (and smerge-refine-ignore-whitespace + ;; smerge-refine-weight-hack causes additional spaces to + ;; appear as additional lines as well, so even if diff ignore + ;; whitespace changes, it'll report added/removed lines :-( + (not smerge-refine-weight-hack)) + (setq re (concat "[ \t]*\\(?:" re "\\)"))) + (dotimes (i n) + (unless (looking-at re) (error "Smerge refine internal error")) + (goto-char (match-end 0))))) + +(defun smerge-refine-chopup-region (beg end file &optional preproc) + "Chopup the region into small elements, one per line. +Save the result into FILE. +If non-nil, PREPROC is called with no argument in a buffer that contains +a copy of the text, just before chopping it up. It can be used to replace +chars to try and eliminate some spurious differences." + ;; We used to chop up char-by-char rather than word-by-word like ediff + ;; does. It had the benefit of simplicity and very fine results, but it + ;; often suffered from problem that diff would find correlations where + ;; there aren't any, so the resulting "change" didn't make much sense. + ;; You can still get this behavior by setting + ;; `smerge-refine-forward-function' to `forward-char'. (let ((buf (current-buffer))) (with-temp-buffer (insert-buffer-substring buf beg end) + (when preproc (goto-char (point-min)) (funcall preproc)) + (when smerge-refine-ignore-whitespace + ;; It doesn't make much of a difference for diff-fine-highlight + ;; because we still have the _/+//! prefix anyway. Can still be + ;; useful in other circumstances. + (subst-char-in-region (point-min) (point-max) ?\n ?\s)) (goto-char (point-min)) (while (not (eobp)) - (forward-char 1) - (unless (eq (char-before) ?\n) (insert ?\n))) + (funcall smerge-refine-forward-function 1) + (let ((s (if (prog2 (forward-char -1) (bolp) (forward-char 1)) + nil + (buffer-substring (line-beginning-position) (point))))) + ;; We add \n after each char except after \n, so we get + ;; one line per text char, where each line contains + ;; just one char, except for \n chars which are + ;; represented by the empty line. + (unless (eq (char-before) ?\n) (insert ?\n)) + ;; HACK ALERT!! + (if smerge-refine-weight-hack + (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))))) -(defun smerge-refine-highlight-change (buf beg match-num1 match-num2) - (let* ((startline (string-to-number (match-string match-num1))) - (ol (make-overlay - (+ beg startline -1) - (+ beg (if (match-end match-num2) - (string-to-number (match-string match-num2)) - startline)) - buf - 'front-advance nil))) - (overlay-put ol 'smerge 'refine) - (overlay-put ol 'evaporate t) - (overlay-put ol 'face 'smerge-refined-change))) - - -(defun smerge-refine () - "Highlight the parts of the conflict that are different." - (interactive) - ;; FIXME: make it work with 3-way conflicts. - (smerge-match-conflict) - (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine) - (smerge-ensure-match 1) - (smerge-ensure-match 3) - (let ((buf (current-buffer)) - ;; Read them before the match-data gets clobbered. - (beg1 (match-beginning 1)) (end1 (match-end 1)) - (beg2 (match-beginning 3)) (end2 (match-end 3)) - (file1 (make-temp-file "smerge1")) - (file2 (make-temp-file "smerge2"))) - +(defun smerge-refine-highlight-change (buf beg match-num1 match-num2 props) + (with-current-buffer buf + (goto-char beg) + (let* ((startline (- (string-to-number match-num1) 1)) + (beg (progn (funcall (if smerge-refine-weight-hack + 'forward-char + 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) + (let ((ol (make-overlay + beg end nil + ;; Make them tend to shrink rather than spread when editing. + 'front-advance nil))) + (overlay-put ol 'evaporate t) + (dolist (x props) (overlay-put ol (car x) (cdr x))) + ol))))) + +(defun smerge-refine-subst (beg1 end1 beg2 end2 props &optional preproc) + "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. +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)) + (file1 (make-temp-file "diff1")) + (file2 (make-temp-file "diff2"))) ;; Chop up regions into smaller elements and save into files. - (smerge-refine-chopup-region beg1 end1 file1) - (smerge-refine-chopup-region beg2 end2 file2) + (smerge-refine-chopup-region beg1 end1 file1 preproc) + (smerge-refine-chopup-region beg2 end2 file2 preproc) ;; Call diff on those files. (unwind-protect (with-temp-buffer (let ((coding-system-for-read 'emacs-mule)) - ;; Don't forget -a to make sure diff treats it as a text file - ;; even if it contains \0 and such. - (call-process diff-command nil t nil "-a" file1 file2)) + (call-process diff-command nil t nil + (if (and smerge-refine-ignore-whitespace + (not smerge-refine-weight-hack)) + ;; Pass -a so diff treats it as a text file even + ;; if it contains \0 and such. + ;; Pass -d so as to get the smallest change, but + ;; also and more importantly because otherwise it + ;; may happen that diff doesn't behave like + ;; smerge-refine-weight-hack expects it to. + ;; See http://thread.gmane.org/gmane.emacs.devel/82685. + "-awd" "-ad") + file1 file2)) ;; Process diff's output. (goto-char (point-min)) - (while (not (eobp)) - (if (not (looking-at "\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?\\([acd]\\)\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?$")) - (error "Unexpected patch hunk header: %s" - (buffer-substring (point) (line-end-position))) - (let ((op (char-after (match-beginning 3)))) + (let ((last1 nil) + (last2 nil)) + (while (not (eobp)) + (if (not (looking-at "\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?\\([acd]\\)\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?$")) + (error "Unexpected patch hunk header: %s" + (buffer-substring (point) (line-end-position)))) + (let ((op (char-after (match-beginning 3))) + (m1 (match-string 1)) + (m2 (match-string 2)) + (m4 (match-string 4)) + (m5 (match-string 5))) (when (memq op '(?d ?c)) - (smerge-refine-highlight-change buf beg1 1 2)) + (setq last1 + (smerge-refine-highlight-change buf beg1 m1 m2 props))) (when (memq op '(?a ?c)) - (smerge-refine-highlight-change buf beg2 4 5))) + (setq last2 + (smerge-refine-highlight-change buf beg2 m4 m5 props)))) (forward-line 1) ;Skip hunk header. (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body. - (goto-char (match-beginning 0)))))) + (goto-char (match-beginning 0)))) + ;; (assert (or (null last1) (< (overlay-start last1) end1))) + ;; (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))) + ) + ;; smerge-refine-forward-function when calling in chopup may + ;; have stopped because it bumped into EOB whereas in + ;; smerge-refine-weight-hack it may go a bit further. + (if (and last1 (> (overlay-end last1) end1)) + (move-overlay last1 (overlay-start last1) end1)) + (if (and last2 (> (overlay-end last2) end2)) + (move-overlay last2 (overlay-start last2) end2)) + ))) + (goto-char pos) (delete-file file1) (delete-file file2)))) +(defun smerge-refine (&optional part) + "Highlight the words of the conflict that are different. +For 3-way conflicts, highlights only 2 of the 3 parts. +A numeric argument PART can be used to specify which 2 parts; +repeating the command will highlight other 2 parts." + (interactive + (if (integerp current-prefix-arg) (list current-prefix-arg) + (smerge-match-conflict) + (let* ((prop (get-text-property (match-beginning 0) 'smerge-refine-part)) + (part (if (and (consp prop) + (eq (buffer-chars-modified-tick) (car prop))) + (cdr prop)))) + ;; If already highlighted, cycle. + (list (if (integerp part) (1+ (mod part 3))))))) + + (if (and (integerp part) (or (< part 1) (> part 3))) + (error "No conflict part nb %s" part)) + (smerge-match-conflict) + (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine) + ;; Ignore `part' if not applicable, and default it if not provided. + (setq part (cond ((null (match-end 2)) 2) + ((eq (match-end 1) (match-end 3)) 1) + ((integerp part) part) + (t 2))) + (let ((n1 (if (eq part 1) 2 1)) + (n2 (if (eq part 3) 2 3))) + (smerge-ensure-match n1) + (smerge-ensure-match n2) + (with-silent-modifications + (put-text-property (match-beginning 0) (1+ (match-beginning 0)) + 'smerge-refine-part + (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))))) + (defun smerge-diff (n1 n2) (smerge-match-conflict) (smerge-ensure-match n1) @@ -774,6 +1072,7 @@ Point is moved to the end of the conflict." (defvar ediff-buffer-C) (defvar ediff-ancestor-buffer) (defvar ediff-quit-hook) +(declare-function ediff-cleanup-mess "ediff-util" nil) ;;;###autoload (defun smerge-ediff (&optional name-mine name-other name-base) @@ -860,6 +1159,32 @@ buffer names." (message "Conflict resolution finished; you may save the buffer"))))) (message "Please resolve conflicts now; exit ediff when done"))) +(defun smerge-makeup-conflict (pt1 pt2 pt3 &optional pt4) + "Insert diff3 markers to make a new conflict. +Uses point and mark for 2 of the relevant positions and previous marks +for the other ones. +By default, makes up a 2-way conflict, +with a \\[universal-argument] prefix, makes up a 3-way conflict." + (interactive + (list (point) + (mark) + (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))) '>=) + (goto-char pt1) (beginning-of-line) + (insert ">>>>>>> OTHER\n") + (goto-char pt2) (beginning-of-line) + (insert "=======\n") + (goto-char pt3) (beginning-of-line) + (when pt4 + (insert "||||||| BASE\n") + (goto-char pt4) (beginning-of-line)) + (insert "<<<<<<< MINE\n")) + (if smerge-mode nil (smerge-mode 1)) + (smerge-refine)) + (defconst smerge-parsep-re (concat smerge-begin-re "\\|" smerge-end-re "\\|" @@ -889,6 +1214,16 @@ buffer names." (unless smerge-mode (smerge-remove-props (point-min) (point-max)))) +;;;###autoload +(defun smerge-start-session () + "Turn on `smerge-mode' and move point to first conflict marker. +If no conflict maker is found, turn off `smerge-mode'." + (interactive) + (smerge-mode 1) + (condition-case nil + (unless (looking-at smerge-begin-re) + (smerge-next)) + (error (smerge-auto-leave)))) (provide 'smerge-mode)