1;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts 2 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 4;; 2004, 2005, 2006, 2007 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. 73Used 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. 242Can 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. 327The function is called with no argument and with the match data set 328according 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 (let ((modified (buffer-modified-p))) 349 (remove-text-properties beg end '(fontified nil)) 350 (restore-buffer-modified-p modified))) 351 352(defun smerge-popup-context-menu (event) 353 "Pop up the Smerge mode context menu under mouse." 354 (interactive "e") 355 (if (and smerge-mode 356 (save-excursion (posn-set-point (event-end event)) (smerge-check 1))) 357 (progn 358 (posn-set-point (event-end event)) 359 (smerge-match-conflict) 360 (let ((i (smerge-get-current)) 361 o) 362 (if (<= i 0) 363 ;; Out of range 364 (popup-menu smerge-mode-menu) 365 ;; Install overlay. 366 (setq o (make-overlay (match-beginning i) (match-end i))) 367 (unwind-protect 368 (progn 369 (overlay-put o 'face 'highlight) 370 (sit-for 0) ;Display the new highlighting. 371 (popup-menu smerge-context-menu)) 372 ;; Delete overlay. 373 (delete-overlay o))))) 374 ;; There's no conflict at point, the text-props are just obsolete. 375 (save-excursion 376 (let ((beg (re-search-backward smerge-end-re nil t)) 377 (end (re-search-forward smerge-begin-re nil t))) 378 (smerge-remove-props (or beg (point-min)) (or end (point-max))) 379 (push event unread-command-events))))) 380 381(defun smerge-resolve () 382 "Resolve the conflict at point intelligently. 383This relies on mode-specific knowledge and thus only works in 384some major modes. Uses `smerge-resolve-function' to do the actual work." 385 (interactive) 386 (smerge-match-conflict) 387 (smerge-remove-props (match-beginning 0) (match-end 0)) 388 (cond 389 ;; Trivial diff3 -A non-conflicts. 390 ((and (eq (match-end 1) (match-end 3)) 391 (eq (match-beginning 1) (match-beginning 3))) 392 (smerge-keep-n 3)) 393 ;; Mode-specific conflict resolution. 394 ((condition-case nil 395 (atomic-change-group 396 (funcall smerge-resolve-function) 397 t) 398 (error nil)) 399 ;; Nothing to do: the resolution function has done it already. 400 nil) 401 ;; FIXME: Add "if [ diff -b MINE OTHER ]; then select OTHER; fi" 402 ((and (match-end 2) 403 ;; FIXME: Add "diff -b BASE MINE | patch OTHER". 404 ;; FIXME: Add "diff -b BASE OTHER | patch MINE". 405 nil) 406 ) 407 ((and (not (match-end 2)) 408 ;; FIXME: Add "diff -b"-based refinement. 409 nil) 410 ) 411 (t 412 (error "Don't know how to resolve"))) 413 (smerge-auto-leave)) 414 415(defun smerge-keep-base () 416 "Revert to the base version." 417 (interactive) 418 (smerge-match-conflict) 419 (smerge-ensure-match 2) 420 (smerge-keep-n 2) 421 (smerge-auto-leave)) 422 423(defun smerge-keep-other () 424 "Use \"other\" version." 425 (interactive) 426 (smerge-match-conflict) 427 ;;(smerge-ensure-match 3) 428 (smerge-keep-n 3) 429 (smerge-auto-leave)) 430 431(defun smerge-keep-mine () 432 "Keep your version." 433 (interactive) 434 (smerge-match-conflict) 435 ;;(smerge-ensure-match 1) 436 (smerge-keep-n 1) 437 (smerge-auto-leave)) 438 439(defun smerge-get-current () 440 (let ((i 3)) 441 (while (or (not (match-end i)) 442 (< (point) (match-beginning i)) 443 (>= (point) (match-end i))) 444 (decf i)) 445 i)) 446 447(defun smerge-keep-current () 448 "Use the current (under the cursor) version." 449 (interactive) 450 (smerge-match-conflict) 451 (let ((i (smerge-get-current))) 452 (if (<= i 0) (error "Not inside a version") 453 (smerge-keep-n i) 454 (smerge-auto-leave)))) 455 456(defun smerge-kill-current () 457 "Remove the current (under the cursor) version." 458 (interactive) 459 (smerge-match-conflict) 460 (let ((i (smerge-get-current))) 461 (if (<= i 0) (error "Not inside a version") 462 (let ((left nil)) 463 (dolist (n '(3 2 1)) 464 (if (and (match-end n) (/= (match-end n) (match-end i))) 465 (push n left))) 466 (if (and (cdr left) 467 (/= (match-end (car left)) (match-end (cadr left)))) 468 (ding) ;We don't know how to do that. 469 (smerge-keep-n (car left)) 470 (smerge-auto-leave)))))) 471 472(defun smerge-diff-base-mine () 473 "Diff 'base' and 'mine' version in current conflict region." 474 (interactive) 475 (smerge-diff 2 1)) 476 477(defun smerge-diff-base-other () 478 "Diff 'base' and 'other' version in current conflict region." 479 (interactive) 480 (smerge-diff 2 3)) 481 482(defun smerge-diff-mine-other () 483 "Diff 'mine' and 'other' version in current conflict region." 484 (interactive) 485 (smerge-diff 1 3)) 486 487(defun smerge-match-conflict () 488 "Get info about the conflict. Puts the info in the `match-data'. 489The submatches contain: 490 0: the whole conflict. 491 1: your code. 492 2: the base code. 493 3: other code. 494An error is raised if not inside a conflict." 495 (save-excursion 496 (condition-case nil 497 (let* ((orig-point (point)) 498 499 (_ (forward-line 1)) 500 (_ (re-search-backward smerge-begin-re)) 501 502 (start (match-beginning 0)) 503 (mine-start (match-end 0)) 504 (filename (or (match-string 1) "")) 505 506 (_ (re-search-forward smerge-end-re)) 507 (_ (assert (< orig-point (match-end 0)))) 508 509 (other-end (match-beginning 0)) 510 (end (match-end 0)) 511 512 (_ (re-search-backward smerge-other-re start)) 513 514 (mine-end (match-beginning 0)) 515 (other-start (match-end 0)) 516 517 base-start base-end) 518 519 ;; handle the various conflict styles 520 (cond 521 ((save-excursion 522 (goto-char mine-start) 523 (re-search-forward smerge-begin-re end t)) 524 ;; There's a nested conflict and we're after the the beginning 525 ;; of the outer one but before the beginning of the inner one. 526 ;; Of course, maybe this is not a nested conflict but in that 527 ;; case it can only be something nastier that we don't know how 528 ;; to handle, so may as well arbitrarily decide to treat it as 529 ;; a nested conflict. --Stef 530 (error "There is a nested conflict")) 531 532 ((re-search-backward smerge-base-re start t) 533 ;; a 3-parts conflict 534 (set (make-local-variable 'smerge-conflict-style) 'diff3-A) 535 (setq base-end mine-end) 536 (setq mine-end (match-beginning 0)) 537 (setq base-start (match-end 0))) 538 539 ((string= filename (file-name-nondirectory 540 (or buffer-file-name ""))) 541 ;; a 2-parts conflict 542 (set (make-local-variable 'smerge-conflict-style) 'diff3-E)) 543 544 ((and (not base-start) 545 (or (eq smerge-conflict-style 'diff3-A) 546 (equal filename "ANCESTOR") 547 (string-match "\\`[.0-9]+\\'" filename))) 548 ;; a same-diff conflict 549 (setq base-start mine-start) 550 (setq base-end mine-end) 551 (setq mine-start other-start) 552 (setq mine-end other-end))) 553 554 (store-match-data (list start end 555 mine-start mine-end 556 base-start base-end 557 other-start other-end 558 (when base-start (1- base-start)) base-start 559 (1- other-start) other-start)) 560 t) 561 (search-failed (error "Point not in conflict region"))))) 562 563(add-to-list 'debug-ignored-errors "Point not in conflict region") 564 565(defun smerge-conflict-overlay (pos) 566 "Return the conflict overlay at POS if any." 567 (let ((ols (overlays-at pos)) 568 conflict) 569 (dolist (ol ols) 570 (if (and (eq (overlay-get ol 'smerge) 'conflict) 571 (> (overlay-end ol) pos)) 572 (setq conflict ol))) 573 conflict)) 574 575(defun smerge-find-conflict (&optional limit) 576 "Find and match a conflict region. Intended as a font-lock MATCHER. 577The submatches are the same as in `smerge-match-conflict'. 578Returns non-nil if a match is found between point and LIMIT. 579Point is moved to the end of the conflict." 580 (let ((found nil) 581 (pos (point)) 582 conflict) 583 ;; First check to see if point is already inside a conflict, using 584 ;; the conflict overlays. 585 (while (and (not found) (setq conflict (smerge-conflict-overlay pos))) 586 ;; Check the overlay's validity and kill it if it's out of date. 587 (condition-case nil 588 (progn 589 (goto-char (overlay-start conflict)) 590 (smerge-match-conflict) 591 (goto-char (match-end 0)) 592 (if (<= (point) pos) 593 (error "Matching backward!") 594 (setq found t))) 595 (error (smerge-remove-props 596 (overlay-start conflict) (overlay-end conflict)) 597 (goto-char pos)))) 598 ;; If we're not already inside a conflict, look for the next conflict 599 ;; and add/update its overlay. 600 (while (and (not found) (re-search-forward smerge-begin-re limit t)) 601 (condition-case nil 602 (progn 603 (smerge-match-conflict) 604 (goto-char (match-end 0)) 605 (let ((conflict (smerge-conflict-overlay (1- (point))))) 606 (if conflict 607 ;; Update its location, just in case it got messed up. 608 (move-overlay conflict (match-beginning 0) (match-end 0)) 609 (setq conflict (make-overlay (match-beginning 0) (match-end 0) 610 nil 'front-advance nil)) 611 (overlay-put conflict 'evaporate t) 612 (overlay-put conflict 'smerge 'conflict) 613 (let ((props smerge-text-properties)) 614 (while props 615 (overlay-put conflict (pop props) (pop props)))))) 616 (setq found t)) 617 (error nil))) 618 found)) 619 620(defun smerge-refine-chopup-region (beg end file) 621 "Chopup the region into small elements, one per line." 622 ;; ediff chops up into words, where the definition of a word is 623 ;; customizable. Instead we here keep only one char per line. 624 ;; The advantages are that there's nothing to configure, that we get very 625 ;; fine results, and that it's trivial to map the line numbers in the 626 ;; output of diff back into buffer positions. The disadvantage is that it 627 ;; can take more time to compute the diff and that the result is sometimes 628 ;; too fine. I'm not too concerned about the slowdown because conflicts 629 ;; are usually significantly smaller than the whole file. As for the 630 ;; problem of too-fine-refinement, I have found it to be unimportant 631 ;; especially when you consider the cases where the fine-grain is just 632 ;; what you want. 633 (let ((buf (current-buffer))) 634 (with-temp-buffer 635 (insert-buffer-substring buf beg end) 636 (goto-char (point-min)) 637 (while (not (eobp)) 638 (forward-char 1) 639 (unless (eq (char-before) ?\n) (insert ?\n))) 640 (let ((coding-system-for-write 'emacs-mule)) 641 (write-region (point-min) (point-max) file nil 'nomessage))))) 642 643(defun smerge-refine-highlight-change (buf beg match-num1 match-num2) 644 (let* ((startline (string-to-number (match-string match-num1))) 645 (ol (make-overlay 646 (+ beg startline -1) 647 (+ beg (if (match-end match-num2) 648 (string-to-number (match-string match-num2)) 649 startline)) 650 buf 651 'front-advance nil))) 652 (overlay-put ol 'smerge 'refine) 653 (overlay-put ol 'evaporate t) 654 (overlay-put ol 'face 'smerge-refined-change))) 655 656 657(defun smerge-refine () 658 "Highlight the parts of the conflict that are different." 659 (interactive) 660 ;; FIXME: make it work with 3-way conflicts. 661 (smerge-match-conflict) 662 (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine) 663 (smerge-ensure-match 1) 664 (smerge-ensure-match 3) 665 (let ((buf (current-buffer)) 666 ;; Read them before the match-data gets clobbered. 667 (beg1 (match-beginning 1)) (end1 (match-end 1)) 668 (beg2 (match-beginning 3)) (end2 (match-end 3)) 669 (file1 (make-temp-file "smerge1")) 670 (file2 (make-temp-file "smerge2"))) 671 672 ;; Chop up regions into smaller elements and save into files. 673 (smerge-refine-chopup-region beg1 end1 file1) 674 (smerge-refine-chopup-region beg2 end2 file2) 675 676 ;; Call diff on those files. 677 (unwind-protect 678 (with-temp-buffer 679 (let ((coding-system-for-read 'emacs-mule)) 680 (call-process diff-command nil t nil file1 file2)) 681 ;; Process diff's output. 682 (goto-char (point-min)) 683 (while (not (eobp)) 684 (if (not (looking-at "\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?\\([acd]\\)\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?$")) 685 (error "Unexpected patch hunk header: %s" 686 (buffer-substring (point) (line-end-position))) 687 (let ((op (char-after (match-beginning 3)))) 688 (when (memq op '(?d ?c)) 689 (smerge-refine-highlight-change buf beg1 1 2)) 690 (when (memq op '(?a ?c)) 691 (smerge-refine-highlight-change buf beg2 4 5))) 692 (forward-line 1) ;Skip hunk header. 693 (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body. 694 (goto-char (match-beginning 0)))))) 695 (delete-file file1) 696 (delete-file file2)))) 697 698(defun smerge-diff (n1 n2) 699 (smerge-match-conflict) 700 (smerge-ensure-match n1) 701 (smerge-ensure-match n2) 702 (let ((name1 (aref smerge-match-names n1)) 703 (name2 (aref smerge-match-names n2)) 704 ;; Read them before the match-data gets clobbered. 705 (beg1 (match-beginning n1)) 706 (end1 (match-end n1)) 707 (beg2 (match-beginning n2)) 708 (end2 (match-end n2)) 709 (file1 (make-temp-file "smerge1")) 710 (file2 (make-temp-file "smerge2")) 711 (dir default-directory) 712 (file (if buffer-file-name (file-relative-name buffer-file-name))) 713 ;; We would want to use `emacs-mule-unix' for read&write, but we 714 ;; bump into problems with the coding-system used by diff to write 715 ;; the file names and the time stamps in the header. 716 ;; `buffer-file-coding-system' is not always correct either, but if 717 ;; the OS/user uses only one coding-system, then it works. 718 (coding-system-for-read buffer-file-coding-system)) 719 (write-region beg1 end1 file1 nil 'nomessage) 720 (write-region beg2 end2 file2 nil 'nomessage) 721 (unwind-protect 722 (with-current-buffer (get-buffer-create smerge-diff-buffer-name) 723 (setq default-directory dir) 724 (let ((inhibit-read-only t)) 725 (erase-buffer) 726 (let ((status 727 (apply 'call-process diff-command nil t nil 728 (append smerge-diff-switches 729 (list "-L" (concat name1 "/" file) 730 "-L" (concat name2 "/" file) 731 file1 file2))))) 732 (if (eq status 0) (insert "No differences found.\n")))) 733 (goto-char (point-min)) 734 (diff-mode) 735 (display-buffer (current-buffer) t)) 736 (delete-file file1) 737 (delete-file file2)))) 738 739;; compiler pacifiers 740(defvar smerge-ediff-windows) 741(defvar smerge-ediff-buf) 742(defvar ediff-buffer-A) 743(defvar ediff-buffer-B) 744(defvar ediff-buffer-C) 745(defvar ediff-ancestor-buffer) 746(defvar ediff-quit-hook) 747 748;;;###autoload 749(defun smerge-ediff (&optional name-mine name-other name-base) 750 "Invoke ediff to resolve the conflicts. 751NAME-MINE, NAME-OTHER, and NAME-BASE, if non-nil, are used for the 752buffer names." 753 (interactive) 754 (let* ((buf (current-buffer)) 755 (mode major-mode) 756 ;;(ediff-default-variant 'default-B) 757 (config (current-window-configuration)) 758 (filename (file-name-nondirectory buffer-file-name)) 759 (mine (generate-new-buffer 760 (or name-mine (concat "*" filename " MINE*")))) 761 (other (generate-new-buffer 762 (or name-other (concat "*" filename " OTHER*")))) 763 base) 764 (with-current-buffer mine 765 (buffer-disable-undo) 766 (insert-buffer-substring buf) 767 (goto-char (point-min)) 768 (while (smerge-find-conflict) 769 (when (match-beginning 2) (setq base t)) 770 (smerge-keep-n 1)) 771 (buffer-enable-undo) 772 (set-buffer-modified-p nil) 773 (funcall mode)) 774 775 (with-current-buffer other 776 (buffer-disable-undo) 777 (insert-buffer-substring buf) 778 (goto-char (point-min)) 779 (while (smerge-find-conflict) 780 (smerge-keep-n 3)) 781 (buffer-enable-undo) 782 (set-buffer-modified-p nil) 783 (funcall mode)) 784 785 (when base 786 (setq base (generate-new-buffer 787 (or name-base (concat "*" filename " BASE*")))) 788 (with-current-buffer base 789 (buffer-disable-undo) 790 (insert-buffer-substring buf) 791 (goto-char (point-min)) 792 (while (smerge-find-conflict) 793 (if (match-end 2) 794 (smerge-keep-n 2) 795 (delete-region (match-beginning 0) (match-end 0)))) 796 (buffer-enable-undo) 797 (set-buffer-modified-p nil) 798 (funcall mode))) 799 800 ;; the rest of the code is inspired from vc.el 801 ;; Fire up ediff. 802 (set-buffer 803 (if base 804 (ediff-merge-buffers-with-ancestor mine other base) 805 ;; nil 'ediff-merge-revisions-with-ancestor buffer-file-name) 806 (ediff-merge-buffers mine other))) 807 ;; nil 'ediff-merge-revisions buffer-file-name))) 808 809 ;; Ediff is now set up, and we are in the control buffer. 810 ;; Do a few further adjustments and take precautions for exit. 811 (set (make-local-variable 'smerge-ediff-windows) config) 812 (set (make-local-variable 'smerge-ediff-buf) buf) 813 (set (make-local-variable 'ediff-quit-hook) 814 (lambda () 815 (let ((buffer-A ediff-buffer-A) 816 (buffer-B ediff-buffer-B) 817 (buffer-C ediff-buffer-C) 818 (buffer-Ancestor ediff-ancestor-buffer) 819 (buf smerge-ediff-buf) 820 (windows smerge-ediff-windows)) 821 (ediff-cleanup-mess) 822 (with-current-buffer buf 823 (erase-buffer) 824 (insert-buffer-substring buffer-C) 825 (kill-buffer buffer-A) 826 (kill-buffer buffer-B) 827 (kill-buffer buffer-C) 828 (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor)) 829 (set-window-configuration windows) 830 (message "Conflict resolution finished; you may save the buffer"))))) 831 (message "Please resolve conflicts now; exit ediff when done"))) 832 833 834;;;###autoload 835(define-minor-mode smerge-mode 836 "Minor mode to simplify editing output from the diff3 program. 837\\{smerge-mode-map}" 838 :group 'smerge :lighter " SMerge" 839 (when (and (boundp 'font-lock-mode) font-lock-mode) 840 (save-excursion 841 (if smerge-mode 842 (font-lock-add-keywords nil smerge-font-lock-keywords 'append) 843 (font-lock-remove-keywords nil smerge-font-lock-keywords)) 844 (goto-char (point-min)) 845 (while (smerge-find-conflict) 846 (save-excursion 847 (font-lock-fontify-region (match-beginning 0) (match-end 0) nil))))) 848 (unless smerge-mode 849 (smerge-remove-props (point-min) (point-max)))) 850 851 852(provide 'smerge-mode) 853 854;; arch-tag: 605c8d1e-e43d-4943-a6f3-1bcc4333e690 855;;; smerge-mode.el ends here 856