(smerge-refine-subst): Pass "-d" to diff.
[bpt/emacs.git] / lisp / smerge-mode.el
CommitLineData
3dac25a9
SM
1;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts
2
0d30b337 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003,
d7a0267c 4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
3dac25a9 5
cc1eecfd 6;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
9700a45f 7;; Keywords: tools revision-control merge diff3 cvs conflict
3dac25a9
SM
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
b4aa6026 13;; the Free Software Foundation; either version 3, or (at your option)
3dac25a9
SM
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
3dac25a9
SM
25
26;;; Commentary:
27
28;; Provides a lightweight alternative to emerge/ediff.
29;; To use it, simply add to your .emacs the following lines:
30;;
31;; (autoload 'smerge-mode "smerge-mode" nil t)
32;;
33;; you can even have it turned on automatically with the following
34;; piece of code in your .emacs:
35;;
36;; (defun sm-try-smerge ()
37;; (save-excursion
38;; (goto-char (point-min))
39;; (when (re-search-forward "^<<<<<<< " nil t)
40;; (smerge-mode 1))))
1a4914f3 41;; (add-hook 'find-file-hook 'sm-try-smerge t)
3dac25a9 42
f97e9a8a
SM
43;;; Todo:
44
45;; - if requested, ask the user whether he wants to call ediff right away
46
3dac25a9
SM
47;;; Code:
48
49(eval-when-compile (require 'cl))
50
51
7f84c46e
RS
52;;; The real definition comes later.
53(defvar smerge-mode)
54
3dac25a9 55(defgroup smerge ()
48d59eda 56 "Minor mode to highlight and resolve diff3 conflicts."
3dac25a9
SM
57 :group 'tools
58 :prefix "smerge-")
59
814838df 60(defcustom smerge-diff-buffer-name "*vc-diff*"
3dac25a9
SM
61 "Buffer name to use for displaying diffs."
62 :group 'smerge
63 :type '(choice
64 (const "*vc-diff*")
65 (const "*cvs-diff*")
66 (const "*smerge-diff*")
67 string))
68
69(defcustom smerge-diff-switches
a7b77977
DL
70 (append '("-d" "-b")
71 (if (listp diff-switches) diff-switches (list diff-switches)))
48d59eda 72 "A list of strings specifying switches to be passed to diff.
3dac25a9
SM
73Used in `smerge-diff-base-mine' and related functions."
74 :group 'smerge
75 :type '(repeat string))
76
f97e9a8a 77(defcustom smerge-auto-leave t
48d59eda 78 "Non-nil means to leave `smerge-mode' when the last conflict is resolved."
f97e9a8a
SM
79 :group 'smerge
80 :type 'boolean)
81
2daf4bc6
SM
82(defcustom smerge-auto-refine t
83 "Automatically highlight changes in detail as the user visits conflicts."
97546017 84 :group 'smerge
2daf4bc6
SM
85 :type 'boolean)
86
e8bfdf82 87(defface smerge-mine
ea81d57e
DN
88 '((((min-colors 88) (background light))
89 (:foreground "blue1"))
90 (((background light))
b25f5aec 91 (:foreground "blue"))
ea81d57e
DN
92 (((min-colors 88) (background dark))
93 (:foreground "cyan1"))
b25f5aec
MB
94 (((background dark))
95 (:foreground "cyan")))
3dac25a9
SM
96 "Face for your code."
97 :group 'smerge)
e8bfdf82
MB
98;; backward-compatibility alias
99(put 'smerge-mine-face 'face-alias 'smerge-mine)
100(defvar smerge-mine-face 'smerge-mine)
3dac25a9 101
e8bfdf82 102(defface smerge-other
b25f5aec
MB
103 '((((background light))
104 (:foreground "darkgreen"))
105 (((background dark))
106 (:foreground "lightgreen")))
3dac25a9
SM
107 "Face for the other code."
108 :group 'smerge)
e8bfdf82
MB
109;; backward-compatibility alias
110(put 'smerge-other-face 'face-alias 'smerge-other)
111(defvar smerge-other-face 'smerge-other)
3dac25a9 112
e8bfdf82 113(defface smerge-base
ea81d57e
DN
114 '((((min-colors 88) (background light))
115 (:foreground "red1"))
116 (((background light))
b25f5aec
MB
117 (:foreground "red"))
118 (((background dark))
119 (:foreground "orange")))
3dac25a9
SM
120 "Face for the base code."
121 :group 'smerge)
e8bfdf82
MB
122;; backward-compatibility alias
123(put 'smerge-base-face 'face-alias 'smerge-base)
124(defvar smerge-base-face 'smerge-base)
3dac25a9 125
e8bfdf82 126(defface smerge-markers
b25f5aec
MB
127 '((((background light))
128 (:background "grey85"))
129 (((background dark))
130 (:background "grey30")))
3dac25a9
SM
131 "Face for the conflict markers."
132 :group 'smerge)
e8bfdf82
MB
133;; backward-compatibility alias
134(put 'smerge-markers-face 'face-alias 'smerge-markers)
135(defvar smerge-markers-face 'smerge-markers)
3dac25a9 136
41796d09
SM
137(defface smerge-refined-change
138 '((t :background "yellow"))
a6022f15
JB
139 "Face used for char-based changes shown by `smerge-refine'."
140 :group 'smerge)
41796d09 141
f97e9a8a 142(easy-mmode-defmap smerge-basic-map
0e86b6b0 143 `(("n" . smerge-next)
3dac25a9 144 ("p" . smerge-prev)
a48402c9 145 ("r" . smerge-resolve)
3dac25a9
SM
146 ("a" . smerge-keep-all)
147 ("b" . smerge-keep-base)
148 ("o" . smerge-keep-other)
149 ("m" . smerge-keep-mine)
150 ("E" . smerge-ediff)
48d59eda 151 ("C" . smerge-combine-with-next)
41796d09 152 ("R" . smerge-refine)
3dac25a9 153 ("\C-m" . smerge-keep-current)
0e86b6b0
SM
154 ("=" . ,(make-sparse-keymap "Diff"))
155 ("=<" "base-mine" . smerge-diff-base-mine)
156 ("=>" "base-other" . smerge-diff-base-other)
157 ("==" "mine-other" . smerge-diff-mine-other))
3dac25a9 158 "The base keymap for `smerge-mode'.")
3dac25a9 159
0e86b6b0 160(defcustom smerge-command-prefix "\C-c^"
3dac25a9
SM
161 "Prefix for `smerge-mode' commands."
162 :group 'smerge
0e86b6b0 163 :type '(choice (string "\e") (string "\C-c^") (string "") string))
3dac25a9 164
f97e9a8a
SM
165(easy-mmode-defmap smerge-mode-map
166 `((,smerge-command-prefix . ,smerge-basic-map))
3dac25a9
SM
167 "Keymap for `smerge-mode'.")
168
7d85a64e
SM
169(defvar smerge-check-cache nil)
170(make-variable-buffer-local 'smerge-check-cache)
171(defun smerge-check (n)
172 (condition-case nil
173 (let ((state (cons (point) (buffer-modified-tick))))
174 (unless (equal (cdr smerge-check-cache) state)
175 (smerge-match-conflict)
176 (setq smerge-check-cache (cons (match-data) state)))
177 (nth (* 2 n) (car smerge-check-cache)))
178 (error nil)))
179
3dac25a9
SM
180(easy-menu-define smerge-mode-menu smerge-mode-map
181 "Menu for `smerge-mode'."
182 '("SMerge"
43e764c9 183 ["Next" smerge-next :help "Go to next conflict"]
394bd1ca 184 ["Previous" smerge-prev :help "Go to previous conflict"]
7d85a64e
SM
185 "--"
186 ["Keep All" smerge-keep-all :help "Keep all three versions"
187 :active (smerge-check 1)]
188 ["Keep Current" smerge-keep-current :help "Use current (at point) version"
189 :active (and (smerge-check 1) (> (smerge-get-current) 0))]
190 "--"
191 ["Revert to Base" smerge-keep-base :help "Revert to base version"
192 :active (smerge-check 2)]
193 ["Keep Other" smerge-keep-other :help "Keep `other' version"
194 :active (smerge-check 3)]
195 ["Keep Yours" smerge-keep-mine :help "Keep your version"
196 :active (smerge-check 1)]
43e764c9
DL
197 "--"
198 ["Diff Base/Mine" smerge-diff-base-mine
7d85a64e
SM
199 :help "Diff `base' and `mine' for current conflict"
200 :active (smerge-check 2)]
43e764c9 201 ["Diff Base/Other" smerge-diff-base-other
7d85a64e
SM
202 :help "Diff `base' and `other' for current conflict"
203 :active (smerge-check 2)]
43e764c9 204 ["Diff Mine/Other" smerge-diff-mine-other
7d85a64e
SM
205 :help "Diff `mine' and `other' for current conflict"
206 :active (smerge-check 1)]
43e764c9
DL
207 "--"
208 ["Invoke Ediff" smerge-ediff
7d85a64e
SM
209 :help "Use Ediff to resolve the conflicts"
210 :active (smerge-check 1)]
211 ["Auto Resolve" smerge-resolve
5bd8d87b
SM
212 :help "Try auto-resolution heuristics"
213 :active (smerge-check 1)]
7d85a64e
SM
214 ["Combine" smerge-combine-with-next
215 :help "Combine current conflict with next"
216 :active (smerge-check 1)]
3dac25a9
SM
217 ))
218
11ece56b
MY
219(easy-menu-define smerge-context-menu nil
220 "Context menu for mine area in `smerge-mode'."
221 '(nil
222 ["Keep Current" smerge-keep-current :help "Use current (at point) version"]
223 ["Kill Current" smerge-kill-current :help "Remove current (at point) version"]
224 ["Keep All" smerge-keep-all :help "Keep all three versions"]
225 "---"
226 ["More..." (popup-menu smerge-mode-menu) :help "Show full SMerge mode menu"]
227 ))
228
3dac25a9
SM
229(defconst smerge-font-lock-keywords
230 '((smerge-find-conflict
f0c1adab 231 (1 smerge-mine-face prepend t)
3dac25a9
SM
232 (2 smerge-base-face prepend t)
233 (3 smerge-other-face prepend t)
0e86b6b0 234 ;; FIXME: `keep' doesn't work right with syntactic fontification.
3dac25a9
SM
235 (0 smerge-markers-face keep)
236 (4 nil t t)
237 (5 nil t t)))
238 "Font lock patterns for `smerge-mode'.")
239
240(defconst smerge-begin-re "^<<<<<<< \\(.*\\)\n")
241(defconst smerge-end-re "^>>>>>>> .*\n")
242(defconst smerge-base-re "^||||||| .*\n")
243(defconst smerge-other-re "^=======\n")
244
245(defvar smerge-conflict-style nil
246 "Keep track of which style of conflict is in use.
247Can be nil if the style is undecided, or else:
248- `diff3-E'
249- `diff3-A'")
250
251;; Compiler pacifiers
8f6cea29
DL
252(defvar font-lock-mode)
253(defvar font-lock-keywords)
3dac25a9
SM
254
255;;;;
256;;;; Actual code
257;;;;
258
f97e9a8a 259;; Define smerge-next and smerge-prev
2daf4bc6
SM
260(easy-mmode-define-navigation smerge smerge-begin-re "conflict" nil nil
261 (if smerge-auto-refine
262 (condition-case nil (smerge-refine) (error nil))))
3dac25a9
SM
263
264(defconst smerge-match-names ["conflict" "mine" "base" "other"])
265
266(defun smerge-ensure-match (n)
267 (unless (match-end n)
376166e6 268 (error "No `%s'" (aref smerge-match-names n))))
3dac25a9 269
f97e9a8a
SM
270(defun smerge-auto-leave ()
271 (when (and smerge-auto-leave
272 (save-excursion (goto-char (point-min))
273 (not (re-search-forward smerge-begin-re nil t))))
48d59eda
SM
274 (when (and (listp buffer-undo-list) smerge-mode)
275 (push (list 'apply 'smerge-mode 1) buffer-undo-list))
f97e9a8a 276 (smerge-mode -1)))
f1180544 277
f97e9a8a 278
3dac25a9 279(defun smerge-keep-all ()
5bd8d87b 280 "Concatenate all versions."
3dac25a9
SM
281 (interactive)
282 (smerge-match-conflict)
5bd8d87b
SM
283 (let ((mb2 (or (match-beginning 2) (point-max)))
284 (me2 (or (match-end 2) (point-min))))
285 (delete-region (match-end 3) (match-end 0))
286 (delete-region (max me2 (match-end 1)) (match-beginning 3))
287 (if (and (match-end 2) (/= (match-end 1) (match-end 3)))
288 (delete-region (match-end 1) (match-beginning 2)))
289 (delete-region (match-beginning 0) (min (match-beginning 1) mb2))
290 (smerge-auto-leave)))
291
292(defun smerge-keep-n (n)
41796d09 293 (smerge-remove-props (match-beginning 0) (match-end 0))
5bd8d87b
SM
294 ;; We used to use replace-match, but that did not preserve markers so well.
295 (delete-region (match-end n) (match-end 0))
296 (delete-region (match-beginning 0) (match-beginning n)))
3dac25a9 297
814838df
SM
298(defun smerge-combine-with-next ()
299 "Combine the current conflict with the next one."
300 (interactive)
301 (smerge-match-conflict)
302 (let ((ends nil))
303 (dolist (i '(3 2 1 0))
304 (push (if (match-end i) (copy-marker (match-end i) t)) ends))
305 (setq ends (apply 'vector ends))
306 (goto-char (aref ends 0))
307 (if (not (re-search-forward smerge-begin-re nil t))
308 (error "No next conflict")
309 (smerge-match-conflict)
310 (let ((match-data (mapcar (lambda (m) (if m (copy-marker m)))
311 (match-data))))
312 ;; First copy the in-between text in each alternative.
313 (dolist (i '(1 2 3))
314 (when (aref ends i)
315 (goto-char (aref ends i))
316 (insert-buffer-substring (current-buffer)
317 (aref ends 0) (car match-data))))
318 (delete-region (aref ends 0) (car match-data))
319 ;; Then move the second conflict's alternatives into the first.
320 (dolist (i '(1 2 3))
321 (set-match-data match-data)
322 (when (and (aref ends i) (match-end i))
323 (goto-char (aref ends i))
324 (insert-buffer-substring (current-buffer)
325 (match-beginning i) (match-end i))))
326 (delete-region (car match-data) (cadr match-data))
327 ;; Free the markers.
328 (dolist (m match-data) (if m (move-marker m nil)))
329 (mapc (lambda (m) (if m (move-marker m nil))) ends)))))
330
a48402c9
SM
331(defvar smerge-resolve-function
332 (lambda () (error "Don't know how to resolve"))
333 "Mode-specific merge function.
de689511
SM
334The function is called with zero or one argument (non-nil if the resolution
335function should only apply safe heuristics) and with the match data set
a48402c9 336according to `smerge-match-conflict'.")
48d59eda 337(add-to-list 'debug-ignored-errors "Don't know how to resolve")
a48402c9 338
11ece56b
MY
339(defvar smerge-text-properties
340 `(help-echo "merge conflict: mouse-3 shows a menu"
341 ;; mouse-face highlight
342 keymap (keymap (down-mouse-3 . smerge-popup-context-menu))))
343
41796d09
SM
344(defun smerge-remove-props (beg end)
345 (remove-overlays beg end 'smerge 'refine)
91773964
SM
346 (remove-overlays beg end 'smerge 'conflict)
347 ;; Now that we use overlays rather than text-properties, this function
348 ;; does not cause refontification any more. It can be seen very clearly
349 ;; in buffers where jit-lock-contextually is not t, in which case deleting
350 ;; the "<<<<<<< foobar" leading line leaves the rest of the conflict
351 ;; highlighted as if it were still a valid conflict. Note that in many
352 ;; important cases (such as the previous example) we're actually called
353 ;; during font-locking so inhibit-modification-hooks is non-nil, so we
354 ;; can't just modify the buffer and expect font-lock to be triggered as in:
355 ;; (put-text-property beg end 'smerge-force-highlighting nil)
0778a62f
SM
356 (let ((modified (buffer-modified-p)))
357 (remove-text-properties beg end '(fontified nil))
358 (restore-buffer-modified-p modified)))
11ece56b
MY
359
360(defun smerge-popup-context-menu (event)
361 "Pop up the Smerge mode context menu under mouse."
362 (interactive "e")
363 (if (and smerge-mode
65114860 364 (save-excursion (posn-set-point (event-end event)) (smerge-check 1)))
11ece56b 365 (progn
65114860 366 (posn-set-point (event-end event))
5bd8d87b
SM
367 (smerge-match-conflict)
368 (let ((i (smerge-get-current))
369 o)
370 (if (<= i 0)
371 ;; Out of range
372 (popup-menu smerge-mode-menu)
373 ;; Install overlay.
3b0af402 374 (setq o (make-overlay (match-beginning i) (match-end i)))
5bd8d87b
SM
375 (unwind-protect
376 (progn
377 (overlay-put o 'face 'highlight)
378 (sit-for 0) ;Display the new highlighting.
379 (popup-menu smerge-context-menu))
380 ;; Delete overlay.
381 (delete-overlay o)))))
11ece56b
MY
382 ;; There's no conflict at point, the text-props are just obsolete.
383 (save-excursion
384 (let ((beg (re-search-backward smerge-end-re nil t))
5bd8d87b
SM
385 (end (re-search-forward smerge-begin-re nil t)))
386 (smerge-remove-props (or beg (point-min)) (or end (point-max)))
387 (push event unread-command-events)))))
11ece56b 388
de689511 389(defun smerge-resolve (&optional safe)
a48402c9
SM
390 "Resolve the conflict at point intelligently.
391This relies on mode-specific knowledge and thus only works in
392some major modes. Uses `smerge-resolve-function' to do the actual work."
393 (interactive)
394 (smerge-match-conflict)
f57b45cf 395 (smerge-remove-props (match-beginning 0) (match-end 0))
5bd8d87b
SM
396 (cond
397 ;; Trivial diff3 -A non-conflicts.
398 ((and (eq (match-end 1) (match-end 3))
399 (eq (match-beginning 1) (match-beginning 3)))
5bd8d87b 400 (smerge-keep-n 3))
48d59eda
SM
401 ;; Mode-specific conflict resolution.
402 ((condition-case nil
403 (atomic-change-group
de689511
SM
404 (if safe
405 (funcall smerge-resolve-function safe)
406 (funcall smerge-resolve-function))
407 t)
48d59eda
SM
408 (error nil))
409 ;; Nothing to do: the resolution function has done it already.
410 nil)
411 ;; FIXME: Add "if [ diff -b MINE OTHER ]; then select OTHER; fi"
5bd8d87b
SM
412 ((and (match-end 2)
413 ;; FIXME: Add "diff -b BASE MINE | patch OTHER".
414 ;; FIXME: Add "diff -b BASE OTHER | patch MINE".
415 nil)
416 )
417 ((and (not (match-end 2))
418 ;; FIXME: Add "diff -b"-based refinement.
419 nil)
420 )
421 (t
48d59eda 422 (error "Don't know how to resolve")))
a48402c9
SM
423 (smerge-auto-leave))
424
de689511
SM
425(defun smerge-resolve-all ()
426 "Perform automatic resolution on all conflicts."
427 (interactive)
428 (save-excursion
429 (goto-char (point-min))
430 (while (re-search-forward smerge-begin-re nil t)
431 (condition-case nil
432 (progn
433 (smerge-match-conflict)
434 (smerge-resolve 'safe))
435 (error nil)))))
436
437(defun smerge-batch-resolve ()
438 ;; command-line-args-left is what is left of the command line.
439 (if (not noninteractive)
440 (error "`smerge-batch-resolve' is to be used only with -batch"))
441 (while command-line-args-left
442 (let ((file (pop command-line-args-left)))
2daf4bc6
SM
443 (if (string-match "\\.rej\\'" file)
444 ;; .rej files should never contain diff3 markers, on the other hand,
445 ;; in Arch, .rej files are sometimes used to indicate that the
446 ;; main file has diff3 markers. So you can pass **/*.rej and
447 ;; it will DTRT.
448 (setq file (substring file 0 (match-beginning 0))))
de689511
SM
449 (message "Resolving conflicts in %s..." file)
450 (when (file-readable-p file)
451 (with-current-buffer (find-file-noselect file)
452 (smerge-resolve-all)
453 (save-buffer)
454 (kill-buffer (current-buffer)))))))
455
3dac25a9
SM
456(defun smerge-keep-base ()
457 "Revert to the base version."
458 (interactive)
459 (smerge-match-conflict)
460 (smerge-ensure-match 2)
5bd8d87b 461 (smerge-keep-n 2)
f97e9a8a 462 (smerge-auto-leave))
3dac25a9
SM
463
464(defun smerge-keep-other ()
465 "Use \"other\" version."
466 (interactive)
467 (smerge-match-conflict)
468 ;;(smerge-ensure-match 3)
5bd8d87b 469 (smerge-keep-n 3)
f97e9a8a 470 (smerge-auto-leave))
3dac25a9
SM
471
472(defun smerge-keep-mine ()
473 "Keep your version."
474 (interactive)
475 (smerge-match-conflict)
476 ;;(smerge-ensure-match 1)
5bd8d87b 477 (smerge-keep-n 1)
f97e9a8a 478 (smerge-auto-leave))
3dac25a9 479
7d85a64e 480(defun smerge-get-current ()
3dac25a9
SM
481 (let ((i 3))
482 (while (or (not (match-end i))
483 (< (point) (match-beginning i))
484 (>= (point) (match-end i)))
485 (decf i))
7d85a64e
SM
486 i))
487
488(defun smerge-keep-current ()
489 "Use the current (under the cursor) version."
490 (interactive)
491 (smerge-match-conflict)
492 (let ((i (smerge-get-current)))
3dac25a9 493 (if (<= i 0) (error "Not inside a version")
5bd8d87b 494 (smerge-keep-n i)
f97e9a8a 495 (smerge-auto-leave))))
3dac25a9 496
11ece56b
MY
497(defun smerge-kill-current ()
498 "Remove the current (under the cursor) version."
499 (interactive)
500 (smerge-match-conflict)
501 (let ((i (smerge-get-current)))
502 (if (<= i 0) (error "Not inside a version")
5bd8d87b
SM
503 (let ((left nil))
504 (dolist (n '(3 2 1))
505 (if (and (match-end n) (/= (match-end n) (match-end i)))
506 (push n left)))
507 (if (and (cdr left)
508 (/= (match-end (car left)) (match-end (cadr left))))
509 (ding) ;We don't know how to do that.
510 (smerge-keep-n (car left))
511 (smerge-auto-leave))))))
11ece56b 512
3dac25a9
SM
513(defun smerge-diff-base-mine ()
514 "Diff 'base' and 'mine' version in current conflict region."
515 (interactive)
516 (smerge-diff 2 1))
517
518(defun smerge-diff-base-other ()
519 "Diff 'base' and 'other' version in current conflict region."
520 (interactive)
521 (smerge-diff 2 3))
522
523(defun smerge-diff-mine-other ()
524 "Diff 'mine' and 'other' version in current conflict region."
525 (interactive)
526 (smerge-diff 1 3))
527
528(defun smerge-match-conflict ()
529 "Get info about the conflict. Puts the info in the `match-data'.
530The submatches contain:
531 0: the whole conflict.
532 1: your code.
533 2: the base code.
534 3: other code.
535An error is raised if not inside a conflict."
536 (save-excursion
537 (condition-case nil
538 (let* ((orig-point (point))
539
540 (_ (forward-line 1))
541 (_ (re-search-backward smerge-begin-re))
542
543 (start (match-beginning 0))
544 (mine-start (match-end 0))
a48402c9 545 (filename (or (match-string 1) ""))
3dac25a9
SM
546
547 (_ (re-search-forward smerge-end-re))
548 (_ (assert (< orig-point (match-end 0))))
f1180544 549
3dac25a9
SM
550 (other-end (match-beginning 0))
551 (end (match-end 0))
552
553 (_ (re-search-backward smerge-other-re start))
554
555 (mine-end (match-beginning 0))
556 (other-start (match-end 0))
557
558 base-start base-end)
559
560 ;; handle the various conflict styles
561 (cond
9f0c286d
SM
562 ((save-excursion
563 (goto-char mine-start)
2a3d70d4 564 (re-search-forward smerge-begin-re end t))
9f0c286d
SM
565 ;; There's a nested conflict and we're after the the beginning
566 ;; of the outer one but before the beginning of the inner one.
48d59eda
SM
567 ;; Of course, maybe this is not a nested conflict but in that
568 ;; case it can only be something nastier that we don't know how
569 ;; to handle, so may as well arbitrarily decide to treat it as
570 ;; a nested conflict. --Stef
9f0c286d
SM
571 (error "There is a nested conflict"))
572
3dac25a9
SM
573 ((re-search-backward smerge-base-re start t)
574 ;; a 3-parts conflict
575 (set (make-local-variable 'smerge-conflict-style) 'diff3-A)
576 (setq base-end mine-end)
577 (setq mine-end (match-beginning 0))
578 (setq base-start (match-end 0)))
579
11ece56b
MY
580 ((string= filename (file-name-nondirectory
581 (or buffer-file-name "")))
582 ;; a 2-parts conflict
583 (set (make-local-variable 'smerge-conflict-style) 'diff3-E))
584
585 ((and (not base-start)
586 (or (eq smerge-conflict-style 'diff3-A)
587 (equal filename "ANCESTOR")
588 (string-match "\\`[.0-9]+\\'" filename)))
589 ;; a same-diff conflict
590 (setq base-start mine-start)
591 (setq base-end mine-end)
592 (setq mine-start other-start)
593 (setq mine-end other-end)))
594
3dac25a9
SM
595 (store-match-data (list start end
596 mine-start mine-end
597 base-start base-end
598 other-start other-end
599 (when base-start (1- base-start)) base-start
600 (1- other-start) other-start))
601 t)
e29f823e 602 (search-failed (error "Point not in conflict region")))))
3dac25a9 603
0778a62f
SM
604(add-to-list 'debug-ignored-errors "Point not in conflict region")
605
48d59eda
SM
606(defun smerge-conflict-overlay (pos)
607 "Return the conflict overlay at POS if any."
608 (let ((ols (overlays-at pos))
609 conflict)
610 (dolist (ol ols)
611 (if (and (eq (overlay-get ol 'smerge) 'conflict)
612 (> (overlay-end ol) pos))
613 (setq conflict ol)))
614 conflict))
615
3dac25a9
SM
616(defun smerge-find-conflict (&optional limit)
617 "Find and match a conflict region. Intended as a font-lock MATCHER.
618The submatches are the same as in `smerge-match-conflict'.
48d59eda
SM
619Returns non-nil if a match is found between point and LIMIT.
620Point is moved to the end of the conflict."
621 (let ((found nil)
622 (pos (point))
623 conflict)
624 ;; First check to see if point is already inside a conflict, using
625 ;; the conflict overlays.
626 (while (and (not found) (setq conflict (smerge-conflict-overlay pos)))
627 ;; Check the overlay's validity and kill it if it's out of date.
628 (condition-case nil
629 (progn
630 (goto-char (overlay-start conflict))
631 (smerge-match-conflict)
632 (goto-char (match-end 0))
633 (if (<= (point) pos)
634 (error "Matching backward!")
635 (setq found t)))
636 (error (smerge-remove-props
637 (overlay-start conflict) (overlay-end conflict))
638 (goto-char pos))))
639 ;; If we're not already inside a conflict, look for the next conflict
640 ;; and add/update its overlay.
641 (while (and (not found) (re-search-forward smerge-begin-re limit t))
642 (condition-case nil
643 (progn
644 (smerge-match-conflict)
645 (goto-char (match-end 0))
646 (let ((conflict (smerge-conflict-overlay (1- (point)))))
647 (if conflict
648 ;; Update its location, just in case it got messed up.
649 (move-overlay conflict (match-beginning 0) (match-end 0))
650 (setq conflict (make-overlay (match-beginning 0) (match-end 0)
651 nil 'front-advance nil))
652 (overlay-put conflict 'evaporate t)
653 (overlay-put conflict 'smerge 'conflict)
654 (let ((props smerge-text-properties))
655 (while props
656 (overlay-put conflict (pop props) (pop props))))))
657 (setq found t))
658 (error nil)))
659 found))
3dac25a9 660
cd62539f
SM
661;;; Refined change highlighting
662
663(defvar smerge-refine-forward-function 'smerge-refine-forward
664 "Function used to determine an \"atomic\" element.
665You can set it to `forward-char' to get char-level granularity.
666Its behavior has mainly two restrictions:
667- if this function encounters a newline, it's important that it stops right
668 after the newline.
669 This only matters if `smerge-refine-ignore-whitespace' is nil.
670- it needs to be unaffected by changes performed by the `preproc' argument
671 to `smerge-refine-subst'.
672 This only matters if `smerge-refine-weight-hack' is nil.")
673
674(defvar smerge-refine-ignore-whitespace t
675 "If non-nil,Indicate that smerge-refine should try to ignore change in whitespace.")
676
677(defvar smerge-refine-weight-hack t
678 "If non-nil, pass to diff as many lines as there are chars in the region.
679I.e. each atomic element (e.g. word) will be copied as many times (on different
680lines) as it has chars. This has 2 advantages:
681- if `diff' tries to minimize the number *lines* (rather than chars)
682 added/removed, this adjust the weights so that adding/removing long
683 symbols is considered correspondingly more costly.
684- `smerge-refine-forward-function' only needs to be called when chopping up
685 the regions, and `forward-char' can be used afterwards.
686It has the following disadvantages:
687- cannot use `diff -w' because the weighting causes added spaces in a line
688 to be represented as added copies of some line, so `diff -w' can't do the
689 right thing any more.
690- may in degenerate cases take a 1KB input region and turn it into a 1MB
691 file to pass to diff.")
692
693(defun smerge-refine-forward (n)
694 (let ((case-fold-search nil)
695 (re "[[:upper:]]?[[:lower:]]+\\|[[:upper:]]+\\|[[:digit:]]+\\|.\\|\n"))
696 (when (and smerge-refine-ignore-whitespace
697 ;; smerge-refine-weight-hack causes additional spaces to
698 ;; appear as additional lines as well, so even if diff ignore
699 ;; whitespace changes, it'll report added/removed lines :-(
700 (not smerge-refine-weight-hack))
701 (setq re (concat "[ \t]*\\(?:" re "\\)")))
702 (dotimes (i n)
703 (unless (looking-at re) (error "Smerge refine internal error"))
704 (goto-char (match-end 0)))))
705
9f2e22a0
SM
706(defun smerge-refine-chopup-region (beg end file &optional preproc)
707 "Chopup the region into small elements, one per line.
708Save the result into FILE.
709If non-nil, PREPROC is called with no argument in a buffer that contains
710a copy of the text, just before chopping it up. It can be used to replace
711chars to try and eliminate some spurious differences."
cd62539f
SM
712 ;; We used to chop up char-by-char rather than word-by-word like ediff
713 ;; does. It had the benefit of simplicity and very fine results, but it
714 ;; often suffered from problem that diff would find correlations where
715 ;; there aren't any, so the resulting "change" didn't make much sense.
716 ;; You can still get this behavior by setting
717 ;; `smerge-refine-forward-function' to `forward-char'.
41796d09
SM
718 (let ((buf (current-buffer)))
719 (with-temp-buffer
720 (insert-buffer-substring buf beg end)
9f2e22a0 721 (when preproc (goto-char (point-min)) (funcall preproc))
cd62539f
SM
722 (when smerge-refine-ignore-whitespace
723 ;; It doesn't make much of a difference for diff-fine-highlight
724 ;; because we still have the _/+/</>/! prefix anyway. Can still be
725 ;; useful in other circumstances.
726 (subst-char-in-region (point-min) (point-max) ?\n ?\s))
41796d09
SM
727 (goto-char (point-min))
728 (while (not (eobp))
cd62539f
SM
729 (funcall smerge-refine-forward-function 1)
730 (let ((s (if (prog2 (forward-char -1) (bolp) (forward-char 1))
731 nil
732 (buffer-substring (line-beginning-position) (point)))))
733 ;; We add \n after each char except after \n, so we get
734 ;; one line per text char, where each line contains
735 ;; just one char, except for \n chars which are
736 ;; represented by the empty line.
737 (unless (eq (char-before) ?\n) (insert ?\n))
738 ;; HACK ALERT!!
739 (if smerge-refine-weight-hack
740 (dotimes (i (1- (length s))) (insert s "\n")))))
741 (unless (bolp) (error "Smerge refine internal error"))
41796d09
SM
742 (let ((coding-system-for-write 'emacs-mule))
743 (write-region (point-min) (point-max) file nil 'nomessage)))))
744
9f2e22a0 745(defun smerge-refine-highlight-change (buf beg match-num1 match-num2 props)
cd62539f
SM
746 (with-current-buffer buf
747 (goto-char beg)
748 (let* ((startline (- (string-to-number match-num1) 1))
749 (beg (progn (funcall (if smerge-refine-weight-hack
750 'forward-char
751 smerge-refine-forward-function)
752 startline)
753 (point)))
754 (end (progn (funcall (if smerge-refine-weight-hack
755 'forward-char
756 smerge-refine-forward-function)
757 (if match-num2
758 (- (string-to-number match-num2)
759 startline)
760 1))
761 (point))))
762 (when smerge-refine-ignore-whitespace
763 (skip-chars-backward " \t\n" beg) (setq end (point))
764 (goto-char beg)
765 (skip-chars-forward " \t\n" end) (setq beg (point)))
766 (when (> end beg)
767 (let ((ol (make-overlay
768 beg end nil
769 ;; Make them tend to shrink rather than spread when editing.
770 'front-advance nil)))
771 (overlay-put ol 'evaporate t)
772 (dolist (x props) (overlay-put ol (car x) (cdr x)))
773 ol)))))
9f2e22a0
SM
774
775(defun smerge-refine-subst (beg1 end1 beg2 end2 props &optional preproc)
776 "Show fine differences in the two regions BEG1..END1 and BEG2..END2.
777PROPS is an alist of properties to put (via overlays) on the changes.
778If non-nil, PREPROC is called with no argument in a buffer that contains
779a copy of a region, just before preparing it to for `diff'. It can be used to
780replace chars to try and eliminate some spurious differences."
781 (let* ((buf (current-buffer))
cd62539f 782 (pos (point))
9f2e22a0
SM
783 (file1 (make-temp-file "diff1"))
784 (file2 (make-temp-file "diff2")))
41796d09 785 ;; Chop up regions into smaller elements and save into files.
9f2e22a0
SM
786 (smerge-refine-chopup-region beg1 end1 file1 preproc)
787 (smerge-refine-chopup-region beg2 end2 file2 preproc)
41796d09
SM
788
789 ;; Call diff on those files.
790 (unwind-protect
791 (with-temp-buffer
792 (let ((coding-system-for-read 'emacs-mule))
cd62539f
SM
793 (call-process diff-command nil t nil
794 (if (and smerge-refine-ignore-whitespace
795 (not smerge-refine-weight-hack))
f56f00fa
SM
796 ;; Pass -a so diff treats it as a text file even
797 ;; if it contains \0 and such.
798 ;; Pass -d so as to get the smallest change, but
799 ;; also and more importantly because otherwise it
800 ;; may happen that diff doesn't behave like
801 ;; smerge-refine-weight-hack expects it to.
802 ;; See http://thread.gmane.org/gmane.emacs.devel/82685.
803 "-awd" "-ad")
cd62539f 804 file1 file2))
41796d09
SM
805 ;; Process diff's output.
806 (goto-char (point-min))
cd62539f
SM
807 (let ((last1 nil)
808 (last2 nil))
809 (while (not (eobp))
810 (if (not (looking-at "\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?\\([acd]\\)\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?$"))
811 (error "Unexpected patch hunk header: %s"
812 (buffer-substring (point) (line-end-position))))
813 (let ((op (char-after (match-beginning 3)))
814 (m1 (match-string 1))
815 (m2 (match-string 2))
816 (m4 (match-string 4))
817 (m5 (match-string 5)))
41796d09 818 (when (memq op '(?d ?c))
cd62539f
SM
819 (setq last1
820 (smerge-refine-highlight-change buf beg1 m1 m2 props)))
41796d09 821 (when (memq op '(?a ?c))
cd62539f
SM
822 (setq last2
823 (smerge-refine-highlight-change buf beg2 m4 m5 props))))
41796d09
SM
824 (forward-line 1) ;Skip hunk header.
825 (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
cd62539f
SM
826 (goto-char (match-beginning 0))))
827 ;; (assert (or (null last1) (< (overlay-start last1) end1)))
828 ;; (assert (or (null last2) (< (overlay-start last2) end2)))
829 (if smerge-refine-weight-hack
830 (progn
831 ;; (assert (or (null last1) (<= (overlay-end last1) end1)))
832 ;; (assert (or (null last2) (<= (overlay-end last2) end2)))
833 )
834 ;; smerge-refine-forward-function when calling in chopup may
835 ;; have stopped because it bumped into EOB whereas in
836 ;; smerge-refine-weight-hack it may go a bit further.
837 (if (and last1 (> (overlay-end last1) end1))
838 (move-overlay last1 (overlay-start last1) end1))
839 (if (and last2 (> (overlay-end last2) end2))
840 (move-overlay last2 (overlay-start last2) end2))
841 )))
842 (goto-char pos)
41796d09
SM
843 (delete-file file1)
844 (delete-file file2))))
845
9f2e22a0
SM
846(defun smerge-refine ()
847 "Highlight the parts of the conflict that are different."
848 (interactive)
849 ;; FIXME: make it work with 3-way conflicts.
850 (smerge-match-conflict)
851 (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine)
852 (smerge-ensure-match 1)
853 (smerge-ensure-match 3)
854 (smerge-refine-subst (match-beginning 1) (match-end 1)
855 (match-beginning 3) (match-end 3)
856 '((smerge . refine)
857 (face . smerge-refined-change))))
858
3dac25a9
SM
859(defun smerge-diff (n1 n2)
860 (smerge-match-conflict)
861 (smerge-ensure-match n1)
862 (smerge-ensure-match n2)
863 (let ((name1 (aref smerge-match-names n1))
864 (name2 (aref smerge-match-names n2))
e29f823e
SM
865 ;; Read them before the match-data gets clobbered.
866 (beg1 (match-beginning n1))
867 (end1 (match-end n1))
868 (beg2 (match-beginning n2))
869 (end2 (match-end n2))
3dac25a9 870 (file1 (make-temp-file "smerge1"))
d73aed13
SM
871 (file2 (make-temp-file "smerge2"))
872 (dir default-directory)
48d59eda
SM
873 (file (if buffer-file-name (file-relative-name buffer-file-name)))
874 ;; We would want to use `emacs-mule-unix' for read&write, but we
875 ;; bump into problems with the coding-system used by diff to write
876 ;; the file names and the time stamps in the header.
877 ;; `buffer-file-coding-system' is not always correct either, but if
878 ;; the OS/user uses only one coding-system, then it works.
e29f823e 879 (coding-system-for-read buffer-file-coding-system))
814838df
SM
880 (write-region beg1 end1 file1 nil 'nomessage)
881 (write-region beg2 end2 file2 nil 'nomessage)
3dac25a9
SM
882 (unwind-protect
883 (with-current-buffer (get-buffer-create smerge-diff-buffer-name)
d73aed13 884 (setq default-directory dir)
3dac25a9
SM
885 (let ((inhibit-read-only t))
886 (erase-buffer)
814838df
SM
887 (let ((status
888 (apply 'call-process diff-command nil t nil
889 (append smerge-diff-switches
890 (list "-L" (concat name1 "/" file)
891 "-L" (concat name2 "/" file)
892 file1 file2)))))
893 (if (eq status 0) (insert "No differences found.\n"))))
3dac25a9
SM
894 (goto-char (point-min))
895 (diff-mode)
896 (display-buffer (current-buffer) t))
897 (delete-file file1)
898 (delete-file file2))))
899
814838df
SM
900;; compiler pacifiers
901(defvar smerge-ediff-windows)
902(defvar smerge-ediff-buf)
903(defvar ediff-buffer-A)
904(defvar ediff-buffer-B)
905(defvar ediff-buffer-C)
48d59eda
SM
906(defvar ediff-ancestor-buffer)
907(defvar ediff-quit-hook)
3dac25a9 908
a1038ca0 909;;;###autoload
15092da1
SM
910(defun smerge-ediff (&optional name-mine name-other name-base)
911 "Invoke ediff to resolve the conflicts.
912NAME-MINE, NAME-OTHER, and NAME-BASE, if non-nil, are used for the
913buffer names."
3dac25a9
SM
914 (interactive)
915 (let* ((buf (current-buffer))
916 (mode major-mode)
917 ;;(ediff-default-variant 'default-B)
918 (config (current-window-configuration))
919 (filename (file-name-nondirectory buffer-file-name))
15092da1
SM
920 (mine (generate-new-buffer
921 (or name-mine (concat "*" filename " MINE*"))))
922 (other (generate-new-buffer
923 (or name-other (concat "*" filename " OTHER*"))))
3dac25a9
SM
924 base)
925 (with-current-buffer mine
926 (buffer-disable-undo)
927 (insert-buffer-substring buf)
928 (goto-char (point-min))
929 (while (smerge-find-conflict)
930 (when (match-beginning 2) (setq base t))
5bd8d87b 931 (smerge-keep-n 1))
3dac25a9
SM
932 (buffer-enable-undo)
933 (set-buffer-modified-p nil)
934 (funcall mode))
935
936 (with-current-buffer other
937 (buffer-disable-undo)
938 (insert-buffer-substring buf)
939 (goto-char (point-min))
940 (while (smerge-find-conflict)
5bd8d87b 941 (smerge-keep-n 3))
3dac25a9
SM
942 (buffer-enable-undo)
943 (set-buffer-modified-p nil)
944 (funcall mode))
f1180544 945
3dac25a9 946 (when base
15092da1
SM
947 (setq base (generate-new-buffer
948 (or name-base (concat "*" filename " BASE*"))))
3dac25a9
SM
949 (with-current-buffer base
950 (buffer-disable-undo)
951 (insert-buffer-substring buf)
952 (goto-char (point-min))
953 (while (smerge-find-conflict)
5bd8d87b
SM
954 (if (match-end 2)
955 (smerge-keep-n 2)
956 (delete-region (match-beginning 0) (match-end 0))))
3dac25a9
SM
957 (buffer-enable-undo)
958 (set-buffer-modified-p nil)
959 (funcall mode)))
f1180544 960
3dac25a9
SM
961 ;; the rest of the code is inspired from vc.el
962 ;; Fire up ediff.
963 (set-buffer
964 (if base
965 (ediff-merge-buffers-with-ancestor mine other base)
966 ;; nil 'ediff-merge-revisions-with-ancestor buffer-file-name)
967 (ediff-merge-buffers mine other)))
968 ;; nil 'ediff-merge-revisions buffer-file-name)))
f1180544 969
3dac25a9
SM
970 ;; Ediff is now set up, and we are in the control buffer.
971 ;; Do a few further adjustments and take precautions for exit.
972 (set (make-local-variable 'smerge-ediff-windows) config)
973 (set (make-local-variable 'smerge-ediff-buf) buf)
974 (set (make-local-variable 'ediff-quit-hook)
975 (lambda ()
976 (let ((buffer-A ediff-buffer-A)
977 (buffer-B ediff-buffer-B)
978 (buffer-C ediff-buffer-C)
979 (buffer-Ancestor ediff-ancestor-buffer)
980 (buf smerge-ediff-buf)
981 (windows smerge-ediff-windows))
982 (ediff-cleanup-mess)
983 (with-current-buffer buf
984 (erase-buffer)
a34ed813 985 (insert-buffer-substring buffer-C)
3dac25a9
SM
986 (kill-buffer buffer-A)
987 (kill-buffer buffer-B)
988 (kill-buffer buffer-C)
989 (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor))
990 (set-window-configuration windows)
991 (message "Conflict resolution finished; you may save the buffer")))))
992 (message "Please resolve conflicts now; exit ediff when done")))
993
994
de689511
SM
995(defconst smerge-parsep-re
996 (concat smerge-begin-re "\\|" smerge-end-re "\\|"
997 smerge-base-re "\\|" smerge-other-re "\\|"))
998
3dac25a9
SM
999;;;###autoload
1000(define-minor-mode smerge-mode
1001 "Minor mode to simplify editing output from the diff3 program.
1002\\{smerge-mode-map}"
c06dbb8f 1003 :group 'smerge :lighter " SMerge"
0304b9c7 1004 (when (and (boundp 'font-lock-mode) font-lock-mode)
3dac25a9
SM
1005 (save-excursion
1006 (if smerge-mode
1007 (font-lock-add-keywords nil smerge-font-lock-keywords 'append)
1008 (font-lock-remove-keywords nil smerge-font-lock-keywords))
1009 (goto-char (point-min))
1010 (while (smerge-find-conflict)
6eabfb26 1011 (save-excursion
48d59eda 1012 (font-lock-fontify-region (match-beginning 0) (match-end 0) nil)))))
de689511
SM
1013 (if (string-match (regexp-quote smerge-parsep-re) paragraph-separate)
1014 (unless smerge-mode
1015 (set (make-local-variable 'paragraph-separate)
1016 (replace-match "" t t paragraph-separate)))
1017 (when smerge-mode
1018 (set (make-local-variable 'paragraph-separate)
1019 (concat smerge-parsep-re paragraph-separate))))
48d59eda
SM
1020 (unless smerge-mode
1021 (smerge-remove-props (point-min) (point-max))))
3dac25a9
SM
1022
1023
1024(provide 'smerge-mode)
ab5796a9 1025
9f0c286d 1026;; arch-tag: 605c8d1e-e43d-4943-a6f3-1bcc4333e690
3dac25a9 1027;;; smerge-mode.el ends here