smerge-mode.el 28.1 KB
Newer Older
1 2
;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts

3 4
;; Copyright (C) 1999, 2000, 2001, 2002, 2003,
;;   2004, 2005 Free Software Foundation, Inc.
5 6

;; Author: Stefan Monnier <monnier@cs.yale.edu>
7
;; Keywords: revision-control merge diff3 cvs conflict
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

;; This file is part of GNU Emacs.

;; 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 2, 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40

;;; Commentary:

;; Provides a lightweight alternative to emerge/ediff.
;; To use it, simply add to your .emacs the following lines:
;;
;;   (autoload 'smerge-mode "smerge-mode" nil t)
;;
;; you can even have it turned on automatically with the following
;; piece of code in your .emacs:
;;
;;   (defun sm-try-smerge ()
;;     (save-excursion
;;   	 (goto-char (point-min))
;;   	 (when (re-search-forward "^<<<<<<< " nil t)
;;   	   (smerge-mode 1))))
41
;;   (add-hook 'find-file-hook 'sm-try-smerge t)
42

43 44 45 46
;;; Todo:

;; - if requested, ask the user whether he wants to call ediff right away

47 48 49 50 51
;;; Code:

(eval-when-compile (require 'cl))


52 53 54
;;; The real definition comes later.
(defvar smerge-mode)

55
(defgroup smerge ()
56
  "Minor mode to highlight and resolve diff3 conflicts."
57 58 59
  :group 'tools
  :prefix "smerge-")

60
(defcustom smerge-diff-buffer-name "*vc-diff*"
61 62 63 64 65 66 67 68 69
  "Buffer name to use for displaying diffs."
  :group 'smerge
  :type '(choice
	  (const "*vc-diff*")
	  (const "*cvs-diff*")
	  (const "*smerge-diff*")
	  string))

(defcustom smerge-diff-switches
70 71
  (append '("-d" "-b")
	  (if (listp diff-switches) diff-switches (list diff-switches)))
72
  "A list of strings specifying switches to be passed to diff.
73 74 75 76
Used in `smerge-diff-base-mine' and related functions."
  :group 'smerge
  :type '(repeat string))

77
(defcustom smerge-auto-leave t
78
  "Non-nil means to leave `smerge-mode' when the last conflict is resolved."
79 80 81
  :group 'smerge
  :type 'boolean)

82
(defface smerge-mine
83 84 85
  '((((min-colors 88) (background light))
     (:foreground "blue1"))
    (((background light))
86
     (:foreground "blue"))
87 88
    (((min-colors 88) (background dark))
     (:foreground "cyan1"))
89 90
    (((background dark))
     (:foreground "cyan")))
91 92
  "Face for your code."
  :group 'smerge)
93 94 95
;; backward-compatibility alias
(put 'smerge-mine-face 'face-alias 'smerge-mine)
(defvar smerge-mine-face 'smerge-mine)
96

97
(defface smerge-other
98 99 100 101
  '((((background light))
     (:foreground "darkgreen"))
    (((background dark))
     (:foreground "lightgreen")))
102 103
  "Face for the other code."
  :group 'smerge)
104 105 106
;; backward-compatibility alias
(put 'smerge-other-face 'face-alias 'smerge-other)
(defvar smerge-other-face 'smerge-other)
107

108
(defface smerge-base
109 110 111
  '((((min-colors 88) (background light))
     (:foreground "red1"))
    (((background light))
112 113 114
     (:foreground "red"))
    (((background dark))
     (:foreground "orange")))
115 116
  "Face for the base code."
  :group 'smerge)
117 118 119
;; backward-compatibility alias
(put 'smerge-base-face 'face-alias 'smerge-base)
(defvar smerge-base-face 'smerge-base)
120

121
(defface smerge-markers
122 123 124 125
  '((((background light))
     (:background "grey85"))
    (((background dark))
     (:background "grey30")))
126 127
  "Face for the conflict markers."
  :group 'smerge)
128 129 130
;; backward-compatibility alias
(put 'smerge-markers-face 'face-alias 'smerge-markers)
(defvar smerge-markers-face 'smerge-markers)
131

132 133 134 135
(defface smerge-refined-change
  '((t :background "yellow"))
  "Face used for char-based changes shown by `smerge-refine'.")

136
(easy-mmode-defmap smerge-basic-map
137
  `(("n" . smerge-next)
138
    ("p" . smerge-prev)
Stefan Monnier's avatar
Stefan Monnier committed
139
    ("r" . smerge-resolve)
140 141 142 143 144
    ("a" . smerge-keep-all)
    ("b" . smerge-keep-base)
    ("o" . smerge-keep-other)
    ("m" . smerge-keep-mine)
    ("E" . smerge-ediff)
145
    ("C" . smerge-combine-with-next)
146
    ("R" . smerge-refine)
147
    ("\C-m" . smerge-keep-current)
148 149 150 151
    ("=" . ,(make-sparse-keymap "Diff"))
    ("=<" "base-mine" . smerge-diff-base-mine)
    ("=>" "base-other" . smerge-diff-base-other)
    ("==" "mine-other" . smerge-diff-mine-other))
152 153
  "The base keymap for `smerge-mode'.")

154
(defcustom smerge-command-prefix "\C-c^"
155 156
  "Prefix for `smerge-mode' commands."
  :group 'smerge
157
  :type '(choice (string "\e") (string "\C-c^") (string "") string))
158

159 160
(easy-mmode-defmap smerge-mode-map
  `((,smerge-command-prefix . ,smerge-basic-map))
161 162
  "Keymap for `smerge-mode'.")

163 164 165 166 167 168 169 170 171 172 173
(defvar smerge-check-cache nil)
(make-variable-buffer-local 'smerge-check-cache)
(defun smerge-check (n)
  (condition-case nil
      (let ((state (cons (point) (buffer-modified-tick))))
	(unless (equal (cdr smerge-check-cache) state)
	  (smerge-match-conflict)
	  (setq smerge-check-cache (cons (match-data) state)))
	(nth (* 2 n) (car smerge-check-cache)))
    (error nil)))

174 175 176
(easy-menu-define smerge-mode-menu smerge-mode-map
  "Menu for `smerge-mode'."
  '("SMerge"
Dave Love's avatar
Dave Love committed
177
    ["Next" smerge-next :help "Go to next conflict"]
Stefan Monnier's avatar
Stefan Monnier committed
178
    ["Previous" smerge-prev :help "Go to previous conflict"]
179 180 181 182 183 184 185 186 187 188 189 190
    "--"
    ["Keep All" smerge-keep-all :help "Keep all three versions"
     :active (smerge-check 1)]
    ["Keep Current" smerge-keep-current :help "Use current (at point) version"
     :active (and (smerge-check 1) (> (smerge-get-current) 0))]
    "--"
    ["Revert to Base" smerge-keep-base :help "Revert to base version"
     :active (smerge-check 2)]
    ["Keep Other" smerge-keep-other :help "Keep `other' version"
     :active (smerge-check 3)]
    ["Keep Yours" smerge-keep-mine :help "Keep your version"
     :active (smerge-check 1)]
Dave Love's avatar
Dave Love committed
191 192
    "--"
    ["Diff Base/Mine" smerge-diff-base-mine
193 194
     :help "Diff `base' and `mine' for current conflict"
     :active (smerge-check 2)]
Dave Love's avatar
Dave Love committed
195
    ["Diff Base/Other" smerge-diff-base-other
196 197
     :help "Diff `base' and `other' for current conflict"
     :active (smerge-check 2)]
Dave Love's avatar
Dave Love committed
198
    ["Diff Mine/Other" smerge-diff-mine-other
199 200
     :help "Diff `mine' and `other' for current conflict"
     :active (smerge-check 1)]
Dave Love's avatar
Dave Love committed
201 202
    "--"
    ["Invoke Ediff" smerge-ediff
203 204 205
     :help "Use Ediff to resolve the conflicts"
     :active (smerge-check 1)]
    ["Auto Resolve" smerge-resolve
206 207
     :help "Try auto-resolution heuristics"
     :active (smerge-check 1)]
208 209 210
    ["Combine" smerge-combine-with-next
     :help "Combine current conflict with next"
     :active (smerge-check 1)]
211 212
    ))

213 214 215 216 217 218 219 220 221 222
(easy-menu-define smerge-context-menu nil
  "Context menu for mine area in `smerge-mode'."
  '(nil
    ["Keep Current" smerge-keep-current :help "Use current (at point) version"]
    ["Kill Current" smerge-kill-current :help "Remove current (at point) version"]
    ["Keep All" smerge-keep-all :help "Keep all three versions"]
    "---"
    ["More..." (popup-menu smerge-mode-menu) :help "Show full SMerge mode menu"]
    ))

223 224
(defconst smerge-font-lock-keywords
  '((smerge-find-conflict
225
     (1 smerge-mine-face prepend t)
226 227
     (2 smerge-base-face prepend t)
     (3 smerge-other-face prepend t)
228
     ;; FIXME: `keep' doesn't work right with syntactic fontification.
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
     (0 smerge-markers-face keep)
     (4 nil t t)
     (5 nil t t)))
  "Font lock patterns for `smerge-mode'.")

(defconst smerge-begin-re "^<<<<<<< \\(.*\\)\n")
(defconst smerge-end-re "^>>>>>>> .*\n")
(defconst smerge-base-re "^||||||| .*\n")
(defconst smerge-other-re "^=======\n")

(defvar smerge-conflict-style nil
  "Keep track of which style of conflict is in use.
Can be nil if the style is undecided, or else:
- `diff3-E'
- `diff3-A'")

;; Compiler pacifiers
246 247
(defvar font-lock-mode)
(defvar font-lock-keywords)
248 249 250 251 252

;;;;
;;;; Actual code
;;;;

253 254
;; Define smerge-next and smerge-prev
(easy-mmode-define-navigation smerge smerge-begin-re "conflict")
255 256 257 258 259

(defconst smerge-match-names ["conflict" "mine" "base" "other"])

(defun smerge-ensure-match (n)
  (unless (match-end n)
260
    (error "No `%s'" (aref smerge-match-names n))))
261

262 263 264 265
(defun smerge-auto-leave ()
  (when (and smerge-auto-leave
	     (save-excursion (goto-char (point-min))
			     (not (re-search-forward smerge-begin-re nil t))))
266 267
    (when (and (listp buffer-undo-list) smerge-mode)
      (push (list 'apply 'smerge-mode 1) buffer-undo-list))
268
    (smerge-mode -1)))
269

270

271
(defun smerge-keep-all ()
272
  "Concatenate all versions."
273 274
  (interactive)
  (smerge-match-conflict)
275 276 277 278 279 280 281 282 283 284
  (let ((mb2 (or (match-beginning 2) (point-max)))
	(me2 (or (match-end 2) (point-min))))
    (delete-region (match-end 3) (match-end 0))
    (delete-region (max me2 (match-end 1)) (match-beginning 3))
    (if (and (match-end 2) (/= (match-end 1) (match-end 3)))
	(delete-region (match-end 1) (match-beginning 2)))
    (delete-region (match-beginning 0) (min (match-beginning 1) mb2))
    (smerge-auto-leave)))

(defun smerge-keep-n (n)
285
  (smerge-remove-props (match-beginning 0) (match-end 0))
286 287 288
  ;; We used to use replace-match, but that did not preserve markers so well.
  (delete-region (match-end n) (match-end 0))
  (delete-region (match-beginning 0) (match-beginning n)))
289

290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322
(defun smerge-combine-with-next ()
  "Combine the current conflict with the next one."
  (interactive)
  (smerge-match-conflict)
  (let ((ends nil))
    (dolist (i '(3 2 1 0))
      (push (if (match-end i) (copy-marker (match-end i) t)) ends))
    (setq ends (apply 'vector ends))
    (goto-char (aref ends 0))
    (if (not (re-search-forward smerge-begin-re nil t))
	(error "No next conflict")
      (smerge-match-conflict)
      (let ((match-data (mapcar (lambda (m) (if m (copy-marker m)))
				(match-data))))
	;; First copy the in-between text in each alternative.
	(dolist (i '(1 2 3))
	  (when (aref ends i)
	    (goto-char (aref ends i))
	    (insert-buffer-substring (current-buffer)
				     (aref ends 0) (car match-data))))
	(delete-region (aref ends 0) (car match-data))
	;; Then move the second conflict's alternatives into the first.
	(dolist (i '(1 2 3))
	  (set-match-data match-data)
	  (when (and (aref ends i) (match-end i))
	    (goto-char (aref ends i))
	    (insert-buffer-substring (current-buffer)
				     (match-beginning i) (match-end i))))
	(delete-region (car match-data) (cadr match-data))
	;; Free the markers.
	(dolist (m match-data) (if m (move-marker m nil)))
	(mapc (lambda (m) (if m (move-marker m nil))) ends)))))

Stefan Monnier's avatar
Stefan Monnier committed
323 324 325 326 327
(defvar smerge-resolve-function
  (lambda () (error "Don't know how to resolve"))
  "Mode-specific merge function.
The function is called with no argument and with the match data set
according to `smerge-match-conflict'.")
328
(add-to-list 'debug-ignored-errors "Don't know how to resolve")
Stefan Monnier's avatar
Stefan Monnier committed
329

330 331 332 333 334
(defvar smerge-text-properties
  `(help-echo "merge conflict: mouse-3 shows a menu"
    ;; mouse-face highlight
    keymap (keymap (down-mouse-3 . smerge-popup-context-menu))))

335 336
(defun smerge-remove-props (beg end)
  (remove-overlays beg end 'smerge 'refine)
337
  (remove-overlays beg end 'smerge 'conflict))
338 339 340 341 342

(defun smerge-popup-context-menu (event)
  "Pop up the Smerge mode context menu under mouse."
  (interactive "e")
  (if (and smerge-mode
343
	   (save-excursion (posn-set-point (event-end event)) (smerge-check 1)))
344
      (progn
345
	(posn-set-point (event-end event))
346 347 348 349 350 351 352
	(smerge-match-conflict)
	(let ((i (smerge-get-current))
	      o)
	  (if (<= i 0)
	      ;; Out of range
	      (popup-menu smerge-mode-menu)
	    ;; Install overlay.
353
	    (setq o (make-overlay (match-beginning i) (match-end i)))
354 355 356 357 358 359 360
	    (unwind-protect
		(progn
		  (overlay-put o 'face 'highlight)
		  (sit-for 0)		;Display the new highlighting.
		  (popup-menu smerge-context-menu))
	      ;; Delete overlay.
	      (delete-overlay o)))))
361 362 363
    ;; There's no conflict at point, the text-props are just obsolete.
    (save-excursion
      (let ((beg (re-search-backward smerge-end-re nil t))
364 365 366
	    (end (re-search-forward smerge-begin-re nil t)))
	(smerge-remove-props (or beg (point-min)) (or end (point-max)))
	(push event unread-command-events)))))
367

Stefan Monnier's avatar
Stefan Monnier committed
368 369 370 371 372 373
(defun smerge-resolve ()
  "Resolve the conflict at point intelligently.
This relies on mode-specific knowledge and thus only works in
some major modes.  Uses `smerge-resolve-function' to do the actual work."
  (interactive)
  (smerge-match-conflict)
374
  (smerge-remove-props)
375 376 377 378 379
  (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))
380 381 382 383 384 385 386 387 388
   ;; Mode-specific conflict resolution.
   ((condition-case nil
        (atomic-change-group
         (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"
389 390 391 392 393 394 395 396 397 398
   ((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
399
    (error "Don't know how to resolve")))
Stefan Monnier's avatar
Stefan Monnier committed
400 401
  (smerge-auto-leave))

402 403 404 405 406
(defun smerge-keep-base ()
  "Revert to the base version."
  (interactive)
  (smerge-match-conflict)
  (smerge-ensure-match 2)
407
  (smerge-keep-n 2)
408
  (smerge-auto-leave))
409 410 411 412 413 414

(defun smerge-keep-other ()
  "Use \"other\" version."
  (interactive)
  (smerge-match-conflict)
  ;;(smerge-ensure-match 3)
415
  (smerge-keep-n 3)
416
  (smerge-auto-leave))
417 418 419 420 421 422

(defun smerge-keep-mine ()
  "Keep your version."
  (interactive)
  (smerge-match-conflict)
  ;;(smerge-ensure-match 1)
423
  (smerge-keep-n 1)
424
  (smerge-auto-leave))
425

426
(defun smerge-get-current ()
427 428 429 430 431
  (let ((i 3))
    (while (or (not (match-end i))
	       (< (point) (match-beginning i))
	       (>= (point) (match-end i)))
      (decf i))
432 433 434 435 436 437 438
    i))

(defun smerge-keep-current ()
  "Use the current (under the cursor) version."
  (interactive)
  (smerge-match-conflict)
  (let ((i (smerge-get-current)))
439
    (if (<= i 0) (error "Not inside a version")
440
      (smerge-keep-n i)
441
      (smerge-auto-leave))))
442

443 444 445 446 447 448
(defun smerge-kill-current ()
  "Remove the current (under the cursor) version."
  (interactive)
  (smerge-match-conflict)
  (let ((i (smerge-get-current)))
    (if (<= i 0) (error "Not inside a version")
449 450 451 452 453 454 455 456 457
      (let ((left nil))
	(dolist (n '(3 2 1))
	  (if (and (match-end n) (/= (match-end n) (match-end i)))
	      (push n left)))
	(if (and (cdr left)
		 (/= (match-end (car left)) (match-end (cadr left))))
	    (ding)			;We don't know how to do that.
	  (smerge-keep-n (car left))
	  (smerge-auto-leave))))))
458

459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490
(defun smerge-diff-base-mine ()
  "Diff 'base' and 'mine' version in current conflict region."
  (interactive)
  (smerge-diff 2 1))

(defun smerge-diff-base-other ()
  "Diff 'base' and 'other' version in current conflict region."
  (interactive)
  (smerge-diff 2 3))

(defun smerge-diff-mine-other ()
  "Diff 'mine' and 'other' version in current conflict region."
  (interactive)
  (smerge-diff 1 3))

(defun smerge-match-conflict ()
  "Get info about the conflict.  Puts the info in the `match-data'.
The submatches contain:
 0:  the whole conflict.
 1:  your code.
 2:  the base code.
 3:  other code.
An error is raised if not inside a conflict."
  (save-excursion
    (condition-case nil
	(let* ((orig-point (point))

	       (_ (forward-line 1))
	       (_ (re-search-backward smerge-begin-re))

	       (start (match-beginning 0))
	       (mine-start (match-end 0))
Stefan Monnier's avatar
Stefan Monnier committed
491
	       (filename (or (match-string 1) ""))
492 493 494

	       (_ (re-search-forward smerge-end-re))
	       (_ (assert (< orig-point (match-end 0))))
495

496 497 498 499 500 501 502 503 504 505 506 507
	       (other-end (match-beginning 0))
	       (end (match-end 0))

	       (_ (re-search-backward smerge-other-re start))

	       (mine-end (match-beginning 0))
	       (other-start (match-end 0))

	       base-start base-end)

	  ;; handle the various conflict styles
	  (cond
508 509
	   ((save-excursion
	      (goto-char mine-start)
510
	      (re-search-forward smerge-begin-re end t))
511 512
	    ;; There's a nested conflict and we're after the the beginning
	    ;; of the outer one but before the beginning of the inner one.
513 514 515 516
	    ;; 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
	    ;; to handle, so may as well arbitrarily decide to treat it as
	    ;; a nested conflict.  --Stef
517 518
	    (error "There is a nested conflict"))

519 520 521 522 523 524 525
	   ((re-search-backward smerge-base-re start t)
	    ;; a 3-parts conflict
	    (set (make-local-variable 'smerge-conflict-style) 'diff3-A)
	    (setq base-end mine-end)
	    (setq mine-end (match-beginning 0))
	    (setq base-start (match-end 0)))

526 527 528 529 530 531 532 533 534 535 536 537 538 539 540
	   ((string= filename (file-name-nondirectory
			       (or buffer-file-name "")))
	    ;; a 2-parts conflict
	    (set (make-local-variable 'smerge-conflict-style) 'diff3-E))

	   ((and (not base-start)
		 (or (eq smerge-conflict-style 'diff3-A)
		     (equal filename "ANCESTOR")
		     (string-match "\\`[.0-9]+\\'" filename)))
	    ;; a same-diff conflict
	    (setq base-start mine-start)
	    (setq base-end   mine-end)
	    (setq mine-start other-start)
	    (setq mine-end   other-end)))

541 542 543 544 545 546 547
	  (store-match-data (list start end
				  mine-start mine-end
				  base-start base-end
				  other-start other-end
				  (when base-start (1- base-start)) base-start
				  (1- other-start) other-start))
	  t)
548
      (search-failed (error "Point not in conflict region")))))
549

550 551 552 553 554 555 556 557 558 559
(defun smerge-conflict-overlay (pos)
  "Return the conflict overlay at POS if any."
  (let ((ols (overlays-at pos))
        conflict)
    (dolist (ol ols)
      (if (and (eq (overlay-get ol 'smerge) 'conflict)
               (> (overlay-end ol) pos))
          (setq conflict ol)))
    conflict))

560 561 562
(defun smerge-find-conflict (&optional limit)
  "Find and match a conflict region.  Intended as a font-lock MATCHER.
The submatches are the same as in `smerge-match-conflict'.
563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603
Returns non-nil if a match is found between point and LIMIT.
Point is moved to the end of the conflict."
  (let ((found nil)
        (pos (point))
        conflict)
    ;; First check to see if point is already inside a conflict, using
    ;; the conflict overlays.
    (while (and (not found) (setq conflict (smerge-conflict-overlay pos)))
      ;; Check the overlay's validity and kill it if it's out of date.
      (condition-case nil
          (progn
            (goto-char (overlay-start conflict))
            (smerge-match-conflict)
            (goto-char (match-end 0))
            (if (<= (point) pos)
                (error "Matching backward!")
              (setq found t)))
        (error (smerge-remove-props
                (overlay-start conflict) (overlay-end conflict))
               (goto-char pos))))
    ;; If we're not already inside a conflict, look for the next conflict
    ;; and add/update its overlay.
    (while (and (not found) (re-search-forward smerge-begin-re limit t))
      (condition-case nil
          (progn
            (smerge-match-conflict)
            (goto-char (match-end 0))
            (let ((conflict (smerge-conflict-overlay (1- (point)))))
              (if conflict
                  ;; Update its location, just in case it got messed up.
                  (move-overlay conflict (match-beginning 0) (match-end 0))
                (setq conflict (make-overlay (match-beginning 0) (match-end 0)
                                             nil 'front-advance nil))
                (overlay-put conflict 'evaporate t)
                (overlay-put conflict 'smerge 'conflict)
                (let ((props smerge-text-properties))
                  (while props
                    (overlay-put conflict (pop props) (pop props))))))
            (setq found t))
        (error nil)))
    found))
604

605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682
(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.
  (let ((buf (current-buffer)))
    (with-temp-buffer
      (insert-buffer-substring buf beg end)
      (goto-char (point-min))
      (while (not (eobp))
        (forward-char 1)
        (unless (eq (char-before) ?\n) (insert ?\n)))
      (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")))

    ;; Chop up regions into smaller elements and save into files.
    (smerge-refine-chopup-region beg1 end1 file1)
    (smerge-refine-chopup-region beg2 end2 file2)

    ;; Call diff on those files.
    (unwind-protect
        (with-temp-buffer
          (let ((coding-system-for-read 'emacs-mule))
            (call-process diff-command nil t nil 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))))
                (when (memq op '(?d ?c))
                  (smerge-refine-highlight-change buf beg1 1 2))
                (when (memq op '(?a ?c))
                  (smerge-refine-highlight-change buf beg2 4 5)))
              (forward-line 1)                            ;Skip hunk header.
              (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
                   (goto-char (match-beginning 0))))))
      (delete-file file1)
      (delete-file file2))))

683 684 685 686 687 688
(defun smerge-diff (n1 n2)
  (smerge-match-conflict)
  (smerge-ensure-match n1)
  (smerge-ensure-match n2)
  (let ((name1 (aref smerge-match-names n1))
	(name2 (aref smerge-match-names n2))
689 690 691 692 693
	;; Read them before the match-data gets clobbered.
	(beg1 (match-beginning n1))
	(end1 (match-end n1))
	(beg2 (match-beginning n2))
	(end2 (match-end n2))
694
	(file1 (make-temp-file "smerge1"))
695 696
	(file2 (make-temp-file "smerge2"))
	(dir default-directory)
697 698 699 700 701 702
	(file (if buffer-file-name (file-relative-name buffer-file-name)))
        ;; We would want to use `emacs-mule-unix' for read&write, but we
        ;; bump into problems with the coding-system used by diff to write
        ;; the file names and the time stamps in the header.
        ;; `buffer-file-coding-system' is not always correct either, but if
        ;; the OS/user uses only one coding-system, then it works.
703
	(coding-system-for-read buffer-file-coding-system))
704 705
    (write-region beg1 end1 file1 nil 'nomessage)
    (write-region beg2 end2 file2 nil 'nomessage)
706 707
    (unwind-protect
	(with-current-buffer (get-buffer-create smerge-diff-buffer-name)
708
	  (setq default-directory dir)
709 710
	  (let ((inhibit-read-only t))
	    (erase-buffer)
711 712 713 714 715 716 717
	    (let ((status
		   (apply 'call-process diff-command nil t nil
			  (append smerge-diff-switches
				  (list "-L" (concat name1 "/" file)
					"-L" (concat name2 "/" file)
					file1 file2)))))
	      (if (eq status 0) (insert "No differences found.\n"))))
718 719 720 721 722 723
	  (goto-char (point-min))
	  (diff-mode)
	  (display-buffer (current-buffer) t))
      (delete-file file1)
      (delete-file file2))))

724 725 726 727 728 729
;; compiler pacifiers
(defvar smerge-ediff-windows)
(defvar smerge-ediff-buf)
(defvar ediff-buffer-A)
(defvar ediff-buffer-B)
(defvar ediff-buffer-C)
730 731
(defvar ediff-ancestor-buffer)
(defvar ediff-quit-hook)
732

Stefan Monnier's avatar
Stefan Monnier committed
733
;;;###autoload
734 735 736 737
(defun smerge-ediff (&optional name-mine name-other name-base)
  "Invoke ediff to resolve the conflicts.
NAME-MINE, NAME-OTHER, and NAME-BASE, if non-nil, are used for the
buffer names."
738 739 740 741 742 743
  (interactive)
  (let* ((buf (current-buffer))
	 (mode major-mode)
	 ;;(ediff-default-variant 'default-B)
	 (config (current-window-configuration))
	 (filename (file-name-nondirectory buffer-file-name))
744 745 746 747
	 (mine (generate-new-buffer
		(or name-mine (concat "*" filename " MINE*"))))
	 (other (generate-new-buffer
		 (or name-other (concat "*" filename " OTHER*"))))
748 749 750 751 752 753 754
	 base)
    (with-current-buffer mine
      (buffer-disable-undo)
      (insert-buffer-substring buf)
      (goto-char (point-min))
      (while (smerge-find-conflict)
	(when (match-beginning 2) (setq base t))
755
	(smerge-keep-n 1))
756 757 758 759 760 761 762 763 764
      (buffer-enable-undo)
      (set-buffer-modified-p nil)
      (funcall mode))

    (with-current-buffer other
      (buffer-disable-undo)
      (insert-buffer-substring buf)
      (goto-char (point-min))
      (while (smerge-find-conflict)
765
	(smerge-keep-n 3))
766 767 768
      (buffer-enable-undo)
      (set-buffer-modified-p nil)
      (funcall mode))
769

770
    (when base
771 772
      (setq base (generate-new-buffer
		  (or name-base (concat "*" filename " BASE*"))))
773 774 775 776 777
      (with-current-buffer base
	(buffer-disable-undo)
	(insert-buffer-substring buf)
	(goto-char (point-min))
	(while (smerge-find-conflict)
778 779 780
	  (if (match-end 2)
	      (smerge-keep-n 2)
	    (delete-region (match-beginning 0) (match-end 0))))
781 782 783
	(buffer-enable-undo)
	(set-buffer-modified-p nil)
	(funcall mode)))
784

785 786 787 788 789 790 791 792
    ;; the rest of the code is inspired from vc.el
    ;; Fire up ediff.
    (set-buffer
     (if base
	 (ediff-merge-buffers-with-ancestor mine other base)
	  ;; nil 'ediff-merge-revisions-with-ancestor buffer-file-name)
       (ediff-merge-buffers mine other)))
        ;; nil 'ediff-merge-revisions buffer-file-name)))
793

794 795 796 797 798 799 800 801 802 803 804 805 806 807 808
    ;; Ediff is now set up, and we are in the control buffer.
    ;; Do a few further adjustments and take precautions for exit.
    (set (make-local-variable 'smerge-ediff-windows) config)
    (set (make-local-variable 'smerge-ediff-buf) buf)
    (set (make-local-variable 'ediff-quit-hook)
	 (lambda ()
	   (let ((buffer-A ediff-buffer-A)
		 (buffer-B ediff-buffer-B)
		 (buffer-C ediff-buffer-C)
		 (buffer-Ancestor ediff-ancestor-buffer)
		 (buf smerge-ediff-buf)
		 (windows smerge-ediff-windows))
	     (ediff-cleanup-mess)
	     (with-current-buffer buf
	       (erase-buffer)
809
	       (insert-buffer-substring buffer-C)
810 811 812 813 814 815 816 817 818 819 820 821 822
	       (kill-buffer buffer-A)
	       (kill-buffer buffer-B)
	       (kill-buffer buffer-C)
	       (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor))
	       (set-window-configuration windows)
	       (message "Conflict resolution finished; you may save the buffer")))))
    (message "Please resolve conflicts now; exit ediff when done")))


;;;###autoload
(define-minor-mode smerge-mode
  "Minor mode to simplify editing output from the diff3 program.
\\{smerge-mode-map}"
Lute Kamstra's avatar
Lute Kamstra committed
823
  :group 'smerge :lighter " SMerge"
824
  (when (and (boundp 'font-lock-mode) font-lock-mode)
825 826 827 828 829 830
    (save-excursion
      (if smerge-mode
	  (font-lock-add-keywords nil smerge-font-lock-keywords 'append)
	(font-lock-remove-keywords nil smerge-font-lock-keywords))
      (goto-char (point-min))
      (while (smerge-find-conflict)
831
	(save-excursion
832 833 834
	  (font-lock-fontify-region (match-beginning 0) (match-end 0) nil)))))
  (unless smerge-mode
    (smerge-remove-props (point-min) (point-max))))
835 836 837


(provide 'smerge-mode)
Miles Bader's avatar
Miles Bader committed
838

839
;; arch-tag: 605c8d1e-e43d-4943-a6f3-1bcc4333e690
840
;;; smerge-mode.el ends here