]> code.delx.au - gnu-emacs/blob - lisp/smerge-mode.el
(enum event_kind) [MAC_OS]: Update comment for MAC_APPLE_EVENT.
[gnu-emacs] / lisp / smerge-mode.el
1 ;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts
2
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003,
4 ;; 2004, 2005, 2006 Free Software Foundation, Inc.
5
6 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
7 ;; Keywords: tools revision-control merge diff3 cvs conflict
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
13 ;; the Free Software Foundation; either version 2, or (at your option)
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
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
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))))
41 ;; (add-hook 'find-file-hook 'sm-try-smerge t)
42
43 ;;; Todo:
44
45 ;; - if requested, ask the user whether he wants to call ediff right away
46
47 ;;; Code:
48
49 (eval-when-compile (require 'cl))
50
51
52 ;;; The real definition comes later.
53 (defvar smerge-mode)
54
55 (defgroup smerge ()
56 "Minor mode to highlight and resolve diff3 conflicts."
57 :group 'tools
58 :prefix "smerge-")
59
60 (defcustom smerge-diff-buffer-name "*vc-diff*"
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
70 (append '("-d" "-b")
71 (if (listp diff-switches) diff-switches (list diff-switches)))
72 "A list of strings specifying switches to be passed to diff.
73 Used in `smerge-diff-base-mine' and related functions."
74 :group 'smerge
75 :type '(repeat string))
76
77 (defcustom smerge-auto-leave t
78 "Non-nil means to leave `smerge-mode' when the last conflict is resolved."
79 :group 'smerge
80 :type 'boolean)
81
82 (defface smerge-mine
83 '((((min-colors 88) (background light))
84 (:foreground "blue1"))
85 (((background light))
86 (:foreground "blue"))
87 (((min-colors 88) (background dark))
88 (:foreground "cyan1"))
89 (((background dark))
90 (:foreground "cyan")))
91 "Face for your code."
92 :group 'smerge)
93 ;; backward-compatibility alias
94 (put 'smerge-mine-face 'face-alias 'smerge-mine)
95 (defvar smerge-mine-face 'smerge-mine)
96
97 (defface smerge-other
98 '((((background light))
99 (:foreground "darkgreen"))
100 (((background dark))
101 (:foreground "lightgreen")))
102 "Face for the other code."
103 :group 'smerge)
104 ;; backward-compatibility alias
105 (put 'smerge-other-face 'face-alias 'smerge-other)
106 (defvar smerge-other-face 'smerge-other)
107
108 (defface smerge-base
109 '((((min-colors 88) (background light))
110 (:foreground "red1"))
111 (((background light))
112 (:foreground "red"))
113 (((background dark))
114 (:foreground "orange")))
115 "Face for the base code."
116 :group 'smerge)
117 ;; backward-compatibility alias
118 (put 'smerge-base-face 'face-alias 'smerge-base)
119 (defvar smerge-base-face 'smerge-base)
120
121 (defface smerge-markers
122 '((((background light))
123 (:background "grey85"))
124 (((background dark))
125 (:background "grey30")))
126 "Face for the conflict markers."
127 :group 'smerge)
128 ;; backward-compatibility alias
129 (put 'smerge-markers-face 'face-alias 'smerge-markers)
130 (defvar smerge-markers-face 'smerge-markers)
131
132 (defface smerge-refined-change
133 '((t :background "yellow"))
134 "Face used for char-based changes shown by `smerge-refine'."
135 :group 'smerge)
136
137 (easy-mmode-defmap smerge-basic-map
138 `(("n" . smerge-next)
139 ("p" . smerge-prev)
140 ("r" . smerge-resolve)
141 ("a" . smerge-keep-all)
142 ("b" . smerge-keep-base)
143 ("o" . smerge-keep-other)
144 ("m" . smerge-keep-mine)
145 ("E" . smerge-ediff)
146 ("C" . smerge-combine-with-next)
147 ("R" . smerge-refine)
148 ("\C-m" . smerge-keep-current)
149 ("=" . ,(make-sparse-keymap "Diff"))
150 ("=<" "base-mine" . smerge-diff-base-mine)
151 ("=>" "base-other" . smerge-diff-base-other)
152 ("==" "mine-other" . smerge-diff-mine-other))
153 "The base keymap for `smerge-mode'.")
154
155 (defcustom smerge-command-prefix "\C-c^"
156 "Prefix for `smerge-mode' commands."
157 :group 'smerge
158 :type '(choice (string "\e") (string "\C-c^") (string "") string))
159
160 (easy-mmode-defmap smerge-mode-map
161 `((,smerge-command-prefix . ,smerge-basic-map))
162 "Keymap for `smerge-mode'.")
163
164 (defvar smerge-check-cache nil)
165 (make-variable-buffer-local 'smerge-check-cache)
166 (defun smerge-check (n)
167 (condition-case nil
168 (let ((state (cons (point) (buffer-modified-tick))))
169 (unless (equal (cdr smerge-check-cache) state)
170 (smerge-match-conflict)
171 (setq smerge-check-cache (cons (match-data) state)))
172 (nth (* 2 n) (car smerge-check-cache)))
173 (error nil)))
174
175 (easy-menu-define smerge-mode-menu smerge-mode-map
176 "Menu for `smerge-mode'."
177 '("SMerge"
178 ["Next" smerge-next :help "Go to next conflict"]
179 ["Previous" smerge-prev :help "Go to previous conflict"]
180 "--"
181 ["Keep All" smerge-keep-all :help "Keep all three versions"
182 :active (smerge-check 1)]
183 ["Keep Current" smerge-keep-current :help "Use current (at point) version"
184 :active (and (smerge-check 1) (> (smerge-get-current) 0))]
185 "--"
186 ["Revert to Base" smerge-keep-base :help "Revert to base version"
187 :active (smerge-check 2)]
188 ["Keep Other" smerge-keep-other :help "Keep `other' version"
189 :active (smerge-check 3)]
190 ["Keep Yours" smerge-keep-mine :help "Keep your version"
191 :active (smerge-check 1)]
192 "--"
193 ["Diff Base/Mine" smerge-diff-base-mine
194 :help "Diff `base' and `mine' for current conflict"
195 :active (smerge-check 2)]
196 ["Diff Base/Other" smerge-diff-base-other
197 :help "Diff `base' and `other' for current conflict"
198 :active (smerge-check 2)]
199 ["Diff Mine/Other" smerge-diff-mine-other
200 :help "Diff `mine' and `other' for current conflict"
201 :active (smerge-check 1)]
202 "--"
203 ["Invoke Ediff" smerge-ediff
204 :help "Use Ediff to resolve the conflicts"
205 :active (smerge-check 1)]
206 ["Auto Resolve" smerge-resolve
207 :help "Try auto-resolution heuristics"
208 :active (smerge-check 1)]
209 ["Combine" smerge-combine-with-next
210 :help "Combine current conflict with next"
211 :active (smerge-check 1)]
212 ))
213
214 (easy-menu-define smerge-context-menu nil
215 "Context menu for mine area in `smerge-mode'."
216 '(nil
217 ["Keep Current" smerge-keep-current :help "Use current (at point) version"]
218 ["Kill Current" smerge-kill-current :help "Remove current (at point) version"]
219 ["Keep All" smerge-keep-all :help "Keep all three versions"]
220 "---"
221 ["More..." (popup-menu smerge-mode-menu) :help "Show full SMerge mode menu"]
222 ))
223
224 (defconst smerge-font-lock-keywords
225 '((smerge-find-conflict
226 (1 smerge-mine-face prepend t)
227 (2 smerge-base-face prepend t)
228 (3 smerge-other-face prepend t)
229 ;; FIXME: `keep' doesn't work right with syntactic fontification.
230 (0 smerge-markers-face keep)
231 (4 nil t t)
232 (5 nil t t)))
233 "Font lock patterns for `smerge-mode'.")
234
235 (defconst smerge-begin-re "^<<<<<<< \\(.*\\)\n")
236 (defconst smerge-end-re "^>>>>>>> .*\n")
237 (defconst smerge-base-re "^||||||| .*\n")
238 (defconst smerge-other-re "^=======\n")
239
240 (defvar smerge-conflict-style nil
241 "Keep track of which style of conflict is in use.
242 Can be nil if the style is undecided, or else:
243 - `diff3-E'
244 - `diff3-A'")
245
246 ;; Compiler pacifiers
247 (defvar font-lock-mode)
248 (defvar font-lock-keywords)
249
250 ;;;;
251 ;;;; Actual code
252 ;;;;
253
254 ;; Define smerge-next and smerge-prev
255 (easy-mmode-define-navigation smerge smerge-begin-re "conflict")
256
257 (defconst smerge-match-names ["conflict" "mine" "base" "other"])
258
259 (defun smerge-ensure-match (n)
260 (unless (match-end n)
261 (error "No `%s'" (aref smerge-match-names n))))
262
263 (defun smerge-auto-leave ()
264 (when (and smerge-auto-leave
265 (save-excursion (goto-char (point-min))
266 (not (re-search-forward smerge-begin-re nil t))))
267 (when (and (listp buffer-undo-list) smerge-mode)
268 (push (list 'apply 'smerge-mode 1) buffer-undo-list))
269 (smerge-mode -1)))
270
271
272 (defun smerge-keep-all ()
273 "Concatenate all versions."
274 (interactive)
275 (smerge-match-conflict)
276 (let ((mb2 (or (match-beginning 2) (point-max)))
277 (me2 (or (match-end 2) (point-min))))
278 (delete-region (match-end 3) (match-end 0))
279 (delete-region (max me2 (match-end 1)) (match-beginning 3))
280 (if (and (match-end 2) (/= (match-end 1) (match-end 3)))
281 (delete-region (match-end 1) (match-beginning 2)))
282 (delete-region (match-beginning 0) (min (match-beginning 1) mb2))
283 (smerge-auto-leave)))
284
285 (defun smerge-keep-n (n)
286 (smerge-remove-props (match-beginning 0) (match-end 0))
287 ;; We used to use replace-match, but that did not preserve markers so well.
288 (delete-region (match-end n) (match-end 0))
289 (delete-region (match-beginning 0) (match-beginning n)))
290
291 (defun smerge-combine-with-next ()
292 "Combine the current conflict with the next one."
293 (interactive)
294 (smerge-match-conflict)
295 (let ((ends nil))
296 (dolist (i '(3 2 1 0))
297 (push (if (match-end i) (copy-marker (match-end i) t)) ends))
298 (setq ends (apply 'vector ends))
299 (goto-char (aref ends 0))
300 (if (not (re-search-forward smerge-begin-re nil t))
301 (error "No next conflict")
302 (smerge-match-conflict)
303 (let ((match-data (mapcar (lambda (m) (if m (copy-marker m)))
304 (match-data))))
305 ;; First copy the in-between text in each alternative.
306 (dolist (i '(1 2 3))
307 (when (aref ends i)
308 (goto-char (aref ends i))
309 (insert-buffer-substring (current-buffer)
310 (aref ends 0) (car match-data))))
311 (delete-region (aref ends 0) (car match-data))
312 ;; Then move the second conflict's alternatives into the first.
313 (dolist (i '(1 2 3))
314 (set-match-data match-data)
315 (when (and (aref ends i) (match-end i))
316 (goto-char (aref ends i))
317 (insert-buffer-substring (current-buffer)
318 (match-beginning i) (match-end i))))
319 (delete-region (car match-data) (cadr match-data))
320 ;; Free the markers.
321 (dolist (m match-data) (if m (move-marker m nil)))
322 (mapc (lambda (m) (if m (move-marker m nil))) ends)))))
323
324 (defvar smerge-resolve-function
325 (lambda () (error "Don't know how to resolve"))
326 "Mode-specific merge function.
327 The function is called with no argument and with the match data set
328 according to `smerge-match-conflict'.")
329 (add-to-list 'debug-ignored-errors "Don't know how to resolve")
330
331 (defvar smerge-text-properties
332 `(help-echo "merge conflict: mouse-3 shows a menu"
333 ;; mouse-face highlight
334 keymap (keymap (down-mouse-3 . smerge-popup-context-menu))))
335
336 (defun smerge-remove-props (beg end)
337 (remove-overlays beg end 'smerge 'refine)
338 (remove-overlays beg end 'smerge 'conflict)
339 ;; Now that we use overlays rather than text-properties, this function
340 ;; does not cause refontification any more. It can be seen very clearly
341 ;; in buffers where jit-lock-contextually is not t, in which case deleting
342 ;; the "<<<<<<< foobar" leading line leaves the rest of the conflict
343 ;; highlighted as if it were still a valid conflict. Note that in many
344 ;; important cases (such as the previous example) we're actually called
345 ;; during font-locking so inhibit-modification-hooks is non-nil, so we
346 ;; can't just modify the buffer and expect font-lock to be triggered as in:
347 ;; (put-text-property beg end 'smerge-force-highlighting nil)
348 (remove-text-properties beg end '(fontified nil)))
349
350 (defun smerge-popup-context-menu (event)
351 "Pop up the Smerge mode context menu under mouse."
352 (interactive "e")
353 (if (and smerge-mode
354 (save-excursion (posn-set-point (event-end event)) (smerge-check 1)))
355 (progn
356 (posn-set-point (event-end event))
357 (smerge-match-conflict)
358 (let ((i (smerge-get-current))
359 o)
360 (if (<= i 0)
361 ;; Out of range
362 (popup-menu smerge-mode-menu)
363 ;; Install overlay.
364 (setq o (make-overlay (match-beginning i) (match-end i)))
365 (unwind-protect
366 (progn
367 (overlay-put o 'face 'highlight)
368 (sit-for 0) ;Display the new highlighting.
369 (popup-menu smerge-context-menu))
370 ;; Delete overlay.
371 (delete-overlay o)))))
372 ;; There's no conflict at point, the text-props are just obsolete.
373 (save-excursion
374 (let ((beg (re-search-backward smerge-end-re nil t))
375 (end (re-search-forward smerge-begin-re nil t)))
376 (smerge-remove-props (or beg (point-min)) (or end (point-max)))
377 (push event unread-command-events)))))
378
379 (defun smerge-resolve ()
380 "Resolve the conflict at point intelligently.
381 This relies on mode-specific knowledge and thus only works in
382 some major modes. Uses `smerge-resolve-function' to do the actual work."
383 (interactive)
384 (smerge-match-conflict)
385 (smerge-remove-props (match-beginning 0) (match-end 0))
386 (cond
387 ;; Trivial diff3 -A non-conflicts.
388 ((and (eq (match-end 1) (match-end 3))
389 (eq (match-beginning 1) (match-beginning 3)))
390 (smerge-keep-n 3))
391 ;; Mode-specific conflict resolution.
392 ((condition-case nil
393 (atomic-change-group
394 (funcall smerge-resolve-function)
395 t)
396 (error nil))
397 ;; Nothing to do: the resolution function has done it already.
398 nil)
399 ;; FIXME: Add "if [ diff -b MINE OTHER ]; then select OTHER; fi"
400 ((and (match-end 2)
401 ;; FIXME: Add "diff -b BASE MINE | patch OTHER".
402 ;; FIXME: Add "diff -b BASE OTHER | patch MINE".
403 nil)
404 )
405 ((and (not (match-end 2))
406 ;; FIXME: Add "diff -b"-based refinement.
407 nil)
408 )
409 (t
410 (error "Don't know how to resolve")))
411 (smerge-auto-leave))
412
413 (defun smerge-keep-base ()
414 "Revert to the base version."
415 (interactive)
416 (smerge-match-conflict)
417 (smerge-ensure-match 2)
418 (smerge-keep-n 2)
419 (smerge-auto-leave))
420
421 (defun smerge-keep-other ()
422 "Use \"other\" version."
423 (interactive)
424 (smerge-match-conflict)
425 ;;(smerge-ensure-match 3)
426 (smerge-keep-n 3)
427 (smerge-auto-leave))
428
429 (defun smerge-keep-mine ()
430 "Keep your version."
431 (interactive)
432 (smerge-match-conflict)
433 ;;(smerge-ensure-match 1)
434 (smerge-keep-n 1)
435 (smerge-auto-leave))
436
437 (defun smerge-get-current ()
438 (let ((i 3))
439 (while (or (not (match-end i))
440 (< (point) (match-beginning i))
441 (>= (point) (match-end i)))
442 (decf i))
443 i))
444
445 (defun smerge-keep-current ()
446 "Use the current (under the cursor) version."
447 (interactive)
448 (smerge-match-conflict)
449 (let ((i (smerge-get-current)))
450 (if (<= i 0) (error "Not inside a version")
451 (smerge-keep-n i)
452 (smerge-auto-leave))))
453
454 (defun smerge-kill-current ()
455 "Remove the current (under the cursor) version."
456 (interactive)
457 (smerge-match-conflict)
458 (let ((i (smerge-get-current)))
459 (if (<= i 0) (error "Not inside a version")
460 (let ((left nil))
461 (dolist (n '(3 2 1))
462 (if (and (match-end n) (/= (match-end n) (match-end i)))
463 (push n left)))
464 (if (and (cdr left)
465 (/= (match-end (car left)) (match-end (cadr left))))
466 (ding) ;We don't know how to do that.
467 (smerge-keep-n (car left))
468 (smerge-auto-leave))))))
469
470 (defun smerge-diff-base-mine ()
471 "Diff 'base' and 'mine' version in current conflict region."
472 (interactive)
473 (smerge-diff 2 1))
474
475 (defun smerge-diff-base-other ()
476 "Diff 'base' and 'other' version in current conflict region."
477 (interactive)
478 (smerge-diff 2 3))
479
480 (defun smerge-diff-mine-other ()
481 "Diff 'mine' and 'other' version in current conflict region."
482 (interactive)
483 (smerge-diff 1 3))
484
485 (defun smerge-match-conflict ()
486 "Get info about the conflict. Puts the info in the `match-data'.
487 The submatches contain:
488 0: the whole conflict.
489 1: your code.
490 2: the base code.
491 3: other code.
492 An error is raised if not inside a conflict."
493 (save-excursion
494 (condition-case nil
495 (let* ((orig-point (point))
496
497 (_ (forward-line 1))
498 (_ (re-search-backward smerge-begin-re))
499
500 (start (match-beginning 0))
501 (mine-start (match-end 0))
502 (filename (or (match-string 1) ""))
503
504 (_ (re-search-forward smerge-end-re))
505 (_ (assert (< orig-point (match-end 0))))
506
507 (other-end (match-beginning 0))
508 (end (match-end 0))
509
510 (_ (re-search-backward smerge-other-re start))
511
512 (mine-end (match-beginning 0))
513 (other-start (match-end 0))
514
515 base-start base-end)
516
517 ;; handle the various conflict styles
518 (cond
519 ((save-excursion
520 (goto-char mine-start)
521 (re-search-forward smerge-begin-re end t))
522 ;; There's a nested conflict and we're after the the beginning
523 ;; of the outer one but before the beginning of the inner one.
524 ;; Of course, maybe this is not a nested conflict but in that
525 ;; case it can only be something nastier that we don't know how
526 ;; to handle, so may as well arbitrarily decide to treat it as
527 ;; a nested conflict. --Stef
528 (error "There is a nested conflict"))
529
530 ((re-search-backward smerge-base-re start t)
531 ;; a 3-parts conflict
532 (set (make-local-variable 'smerge-conflict-style) 'diff3-A)
533 (setq base-end mine-end)
534 (setq mine-end (match-beginning 0))
535 (setq base-start (match-end 0)))
536
537 ((string= filename (file-name-nondirectory
538 (or buffer-file-name "")))
539 ;; a 2-parts conflict
540 (set (make-local-variable 'smerge-conflict-style) 'diff3-E))
541
542 ((and (not base-start)
543 (or (eq smerge-conflict-style 'diff3-A)
544 (equal filename "ANCESTOR")
545 (string-match "\\`[.0-9]+\\'" filename)))
546 ;; a same-diff conflict
547 (setq base-start mine-start)
548 (setq base-end mine-end)
549 (setq mine-start other-start)
550 (setq mine-end other-end)))
551
552 (store-match-data (list start end
553 mine-start mine-end
554 base-start base-end
555 other-start other-end
556 (when base-start (1- base-start)) base-start
557 (1- other-start) other-start))
558 t)
559 (search-failed (error "Point not in conflict region")))))
560
561 (defun smerge-conflict-overlay (pos)
562 "Return the conflict overlay at POS if any."
563 (let ((ols (overlays-at pos))
564 conflict)
565 (dolist (ol ols)
566 (if (and (eq (overlay-get ol 'smerge) 'conflict)
567 (> (overlay-end ol) pos))
568 (setq conflict ol)))
569 conflict))
570
571 (defun smerge-find-conflict (&optional limit)
572 "Find and match a conflict region. Intended as a font-lock MATCHER.
573 The submatches are the same as in `smerge-match-conflict'.
574 Returns non-nil if a match is found between point and LIMIT.
575 Point is moved to the end of the conflict."
576 (let ((found nil)
577 (pos (point))
578 conflict)
579 ;; First check to see if point is already inside a conflict, using
580 ;; the conflict overlays.
581 (while (and (not found) (setq conflict (smerge-conflict-overlay pos)))
582 ;; Check the overlay's validity and kill it if it's out of date.
583 (condition-case nil
584 (progn
585 (goto-char (overlay-start conflict))
586 (smerge-match-conflict)
587 (goto-char (match-end 0))
588 (if (<= (point) pos)
589 (error "Matching backward!")
590 (setq found t)))
591 (error (smerge-remove-props
592 (overlay-start conflict) (overlay-end conflict))
593 (goto-char pos))))
594 ;; If we're not already inside a conflict, look for the next conflict
595 ;; and add/update its overlay.
596 (while (and (not found) (re-search-forward smerge-begin-re limit t))
597 (condition-case nil
598 (progn
599 (smerge-match-conflict)
600 (goto-char (match-end 0))
601 (let ((conflict (smerge-conflict-overlay (1- (point)))))
602 (if conflict
603 ;; Update its location, just in case it got messed up.
604 (move-overlay conflict (match-beginning 0) (match-end 0))
605 (setq conflict (make-overlay (match-beginning 0) (match-end 0)
606 nil 'front-advance nil))
607 (overlay-put conflict 'evaporate t)
608 (overlay-put conflict 'smerge 'conflict)
609 (let ((props smerge-text-properties))
610 (while props
611 (overlay-put conflict (pop props) (pop props))))))
612 (setq found t))
613 (error nil)))
614 found))
615
616 (defun smerge-refine-chopup-region (beg end file)
617 "Chopup the region into small elements, one per line."
618 ;; ediff chops up into words, where the definition of a word is
619 ;; customizable. Instead we here keep only one char per line.
620 ;; The advantages are that there's nothing to configure, that we get very
621 ;; fine results, and that it's trivial to map the line numbers in the
622 ;; output of diff back into buffer positions. The disadvantage is that it
623 ;; can take more time to compute the diff and that the result is sometimes
624 ;; too fine. I'm not too concerned about the slowdown because conflicts
625 ;; are usually significantly smaller than the whole file. As for the
626 ;; problem of too-fine-refinement, I have found it to be unimportant
627 ;; especially when you consider the cases where the fine-grain is just
628 ;; what you want.
629 (let ((buf (current-buffer)))
630 (with-temp-buffer
631 (insert-buffer-substring buf beg end)
632 (goto-char (point-min))
633 (while (not (eobp))
634 (forward-char 1)
635 (unless (eq (char-before) ?\n) (insert ?\n)))
636 (let ((coding-system-for-write 'emacs-mule))
637 (write-region (point-min) (point-max) file nil 'nomessage)))))
638
639 (defun smerge-refine-highlight-change (buf beg match-num1 match-num2)
640 (let* ((startline (string-to-number (match-string match-num1)))
641 (ol (make-overlay
642 (+ beg startline -1)
643 (+ beg (if (match-end match-num2)
644 (string-to-number (match-string match-num2))
645 startline))
646 buf
647 'front-advance nil)))
648 (overlay-put ol 'smerge 'refine)
649 (overlay-put ol 'evaporate t)
650 (overlay-put ol 'face 'smerge-refined-change)))
651
652
653 (defun smerge-refine ()
654 "Highlight the parts of the conflict that are different."
655 (interactive)
656 ;; FIXME: make it work with 3-way conflicts.
657 (smerge-match-conflict)
658 (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine)
659 (smerge-ensure-match 1)
660 (smerge-ensure-match 3)
661 (let ((buf (current-buffer))
662 ;; Read them before the match-data gets clobbered.
663 (beg1 (match-beginning 1)) (end1 (match-end 1))
664 (beg2 (match-beginning 3)) (end2 (match-end 3))
665 (file1 (make-temp-file "smerge1"))
666 (file2 (make-temp-file "smerge2")))
667
668 ;; Chop up regions into smaller elements and save into files.
669 (smerge-refine-chopup-region beg1 end1 file1)
670 (smerge-refine-chopup-region beg2 end2 file2)
671
672 ;; Call diff on those files.
673 (unwind-protect
674 (with-temp-buffer
675 (let ((coding-system-for-read 'emacs-mule))
676 (call-process diff-command nil t nil file1 file2))
677 ;; Process diff's output.
678 (goto-char (point-min))
679 (while (not (eobp))
680 (if (not (looking-at "\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?\\([acd]\\)\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?$"))
681 (error "Unexpected patch hunk header: %s"
682 (buffer-substring (point) (line-end-position)))
683 (let ((op (char-after (match-beginning 3))))
684 (when (memq op '(?d ?c))
685 (smerge-refine-highlight-change buf beg1 1 2))
686 (when (memq op '(?a ?c))
687 (smerge-refine-highlight-change buf beg2 4 5)))
688 (forward-line 1) ;Skip hunk header.
689 (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
690 (goto-char (match-beginning 0))))))
691 (delete-file file1)
692 (delete-file file2))))
693
694 (defun smerge-diff (n1 n2)
695 (smerge-match-conflict)
696 (smerge-ensure-match n1)
697 (smerge-ensure-match n2)
698 (let ((name1 (aref smerge-match-names n1))
699 (name2 (aref smerge-match-names n2))
700 ;; Read them before the match-data gets clobbered.
701 (beg1 (match-beginning n1))
702 (end1 (match-end n1))
703 (beg2 (match-beginning n2))
704 (end2 (match-end n2))
705 (file1 (make-temp-file "smerge1"))
706 (file2 (make-temp-file "smerge2"))
707 (dir default-directory)
708 (file (if buffer-file-name (file-relative-name buffer-file-name)))
709 ;; We would want to use `emacs-mule-unix' for read&write, but we
710 ;; bump into problems with the coding-system used by diff to write
711 ;; the file names and the time stamps in the header.
712 ;; `buffer-file-coding-system' is not always correct either, but if
713 ;; the OS/user uses only one coding-system, then it works.
714 (coding-system-for-read buffer-file-coding-system))
715 (write-region beg1 end1 file1 nil 'nomessage)
716 (write-region beg2 end2 file2 nil 'nomessage)
717 (unwind-protect
718 (with-current-buffer (get-buffer-create smerge-diff-buffer-name)
719 (setq default-directory dir)
720 (let ((inhibit-read-only t))
721 (erase-buffer)
722 (let ((status
723 (apply 'call-process diff-command nil t nil
724 (append smerge-diff-switches
725 (list "-L" (concat name1 "/" file)
726 "-L" (concat name2 "/" file)
727 file1 file2)))))
728 (if (eq status 0) (insert "No differences found.\n"))))
729 (goto-char (point-min))
730 (diff-mode)
731 (display-buffer (current-buffer) t))
732 (delete-file file1)
733 (delete-file file2))))
734
735 ;; compiler pacifiers
736 (defvar smerge-ediff-windows)
737 (defvar smerge-ediff-buf)
738 (defvar ediff-buffer-A)
739 (defvar ediff-buffer-B)
740 (defvar ediff-buffer-C)
741 (defvar ediff-ancestor-buffer)
742 (defvar ediff-quit-hook)
743
744 ;;;###autoload
745 (defun smerge-ediff (&optional name-mine name-other name-base)
746 "Invoke ediff to resolve the conflicts.
747 NAME-MINE, NAME-OTHER, and NAME-BASE, if non-nil, are used for the
748 buffer names."
749 (interactive)
750 (let* ((buf (current-buffer))
751 (mode major-mode)
752 ;;(ediff-default-variant 'default-B)
753 (config (current-window-configuration))
754 (filename (file-name-nondirectory buffer-file-name))
755 (mine (generate-new-buffer
756 (or name-mine (concat "*" filename " MINE*"))))
757 (other (generate-new-buffer
758 (or name-other (concat "*" filename " OTHER*"))))
759 base)
760 (with-current-buffer mine
761 (buffer-disable-undo)
762 (insert-buffer-substring buf)
763 (goto-char (point-min))
764 (while (smerge-find-conflict)
765 (when (match-beginning 2) (setq base t))
766 (smerge-keep-n 1))
767 (buffer-enable-undo)
768 (set-buffer-modified-p nil)
769 (funcall mode))
770
771 (with-current-buffer other
772 (buffer-disable-undo)
773 (insert-buffer-substring buf)
774 (goto-char (point-min))
775 (while (smerge-find-conflict)
776 (smerge-keep-n 3))
777 (buffer-enable-undo)
778 (set-buffer-modified-p nil)
779 (funcall mode))
780
781 (when base
782 (setq base (generate-new-buffer
783 (or name-base (concat "*" filename " BASE*"))))
784 (with-current-buffer base
785 (buffer-disable-undo)
786 (insert-buffer-substring buf)
787 (goto-char (point-min))
788 (while (smerge-find-conflict)
789 (if (match-end 2)
790 (smerge-keep-n 2)
791 (delete-region (match-beginning 0) (match-end 0))))
792 (buffer-enable-undo)
793 (set-buffer-modified-p nil)
794 (funcall mode)))
795
796 ;; the rest of the code is inspired from vc.el
797 ;; Fire up ediff.
798 (set-buffer
799 (if base
800 (ediff-merge-buffers-with-ancestor mine other base)
801 ;; nil 'ediff-merge-revisions-with-ancestor buffer-file-name)
802 (ediff-merge-buffers mine other)))
803 ;; nil 'ediff-merge-revisions buffer-file-name)))
804
805 ;; Ediff is now set up, and we are in the control buffer.
806 ;; Do a few further adjustments and take precautions for exit.
807 (set (make-local-variable 'smerge-ediff-windows) config)
808 (set (make-local-variable 'smerge-ediff-buf) buf)
809 (set (make-local-variable 'ediff-quit-hook)
810 (lambda ()
811 (let ((buffer-A ediff-buffer-A)
812 (buffer-B ediff-buffer-B)
813 (buffer-C ediff-buffer-C)
814 (buffer-Ancestor ediff-ancestor-buffer)
815 (buf smerge-ediff-buf)
816 (windows smerge-ediff-windows))
817 (ediff-cleanup-mess)
818 (with-current-buffer buf
819 (erase-buffer)
820 (insert-buffer-substring buffer-C)
821 (kill-buffer buffer-A)
822 (kill-buffer buffer-B)
823 (kill-buffer buffer-C)
824 (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor))
825 (set-window-configuration windows)
826 (message "Conflict resolution finished; you may save the buffer")))))
827 (message "Please resolve conflicts now; exit ediff when done")))
828
829
830 ;;;###autoload
831 (define-minor-mode smerge-mode
832 "Minor mode to simplify editing output from the diff3 program.
833 \\{smerge-mode-map}"
834 :group 'smerge :lighter " SMerge"
835 (when (and (boundp 'font-lock-mode) font-lock-mode)
836 (save-excursion
837 (if smerge-mode
838 (font-lock-add-keywords nil smerge-font-lock-keywords 'append)
839 (font-lock-remove-keywords nil smerge-font-lock-keywords))
840 (goto-char (point-min))
841 (while (smerge-find-conflict)
842 (save-excursion
843 (font-lock-fontify-region (match-beginning 0) (match-end 0) nil)))))
844 (unless smerge-mode
845 (smerge-remove-props (point-min) (point-max))))
846
847
848 (provide 'smerge-mode)
849
850 ;; arch-tag: 605c8d1e-e43d-4943-a6f3-1bcc4333e690
851 ;;; smerge-mode.el ends here