Merge from emacs-24; up to 2012-04-24T21:47:24Z!michael.albinus@gmx.de
[bpt/emacs.git] / lisp / vc / smerge-mode.el
index 75e3b51..cf1cdab 100644 (file)
@@ -1,6 +1,6 @@
 ;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*-
 
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords: vc, tools, revision control, merge, diff3, cvs, conflict
@@ -78,36 +78,36 @@ Used in `smerge-diff-base-mine' and related functions."
   :type 'boolean)
 
 (defface smerge-mine
-  '((((min-colors 88) (background light))
-     (:foreground "blue1"))
-    (((background light))
-     (:foreground "blue"))
-    (((min-colors 88) (background dark))
-     (:foreground "cyan1"))
-    (((background dark))
-     (:foreground "cyan")))
+  '((((class color) (min-colors 88) (background light))
+     :background "#ffdddd")
+    (((class color) (min-colors 88) (background dark))
+     :background "#553333")
+    (((class color))
+     :foreground "red"))
   "Face for your code."
   :group 'smerge)
 (define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1")
 (defvar smerge-mine-face 'smerge-mine)
 
 (defface smerge-other
-  '((((background light))
-     (:foreground "darkgreen"))
-    (((background dark))
-     (:foreground "lightgreen")))
+  '((((class color) (min-colors 88) (background light))
+     :background "#ddffdd")
+    (((class color) (min-colors 88) (background dark))
+     :background "#335533")
+    (((class color))
+     :foreground "green"))
   "Face for the other code."
   :group 'smerge)
 (define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1")
 (defvar smerge-other-face 'smerge-other)
 
 (defface smerge-base
-  '((((min-colors 88) (background light))
-     (:foreground "red1"))
-    (((background light))
-     (:foreground "red"))
-    (((background dark))
-     (:foreground "orange")))
+  '((((class color) (min-colors 88) (background light))
+     :background "#ffffaa")
+    (((class color) (min-colors 88) (background dark))
+     :background "#888833")
+    (((class color))
+     :foreground "yellow"))
   "Face for the base code."
   :group 'smerge)
 (define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1")
@@ -124,10 +124,34 @@ Used in `smerge-diff-base-mine' and related functions."
 (defvar smerge-markers-face 'smerge-markers)
 
 (defface smerge-refined-change
-  '((t :background "yellow"))
+  '((t nil))
   "Face used for char-based changes shown by `smerge-refine'."
   :group 'smerge)
 
+(defface smerge-refined-removed
+  '((default
+     :inherit smerge-refined-change)
+    (((class color) (min-colors 88) (background light))
+     :background "#ffaaaa")
+    (((class color) (min-colors 88) (background dark))
+     :background "#aa2222")
+    (t :inverse-video t))
+  "Face used for removed characters shown by `smerge-refine'."
+  :group 'smerge
+  :version "24.2")
+
+(defface smerge-refined-added
+  '((default
+     :inherit smerge-refined-change)
+    (((class color) (min-colors 88) (background light))
+     :background "#aaffaa")
+    (((class color) (min-colors 88) (background dark))
+     :background "#22aa22")
+    (t :inverse-video t))
+  "Face used for added characters shown by `smerge-refine'."
+  :group 'smerge
+  :version "24.2")
+
 (easy-mmode-defmap smerge-basic-map
   `(("n" . smerge-next)
     ("p" . smerge-prev)
@@ -342,12 +366,11 @@ Can be nil if the style is undecided, or else:
         ))))
 
 (defvar smerge-resolve-function
-  (lambda () (error "Don't know how to resolve"))
+  (lambda () (user-error "Don't know how to resolve"))
   "Mode-specific merge function.
 The function is called with zero or one argument (non-nil if the resolution
 function should only apply safe heuristics) and with the match data set
 according to `smerge-match-conflict'.")
-(add-to-list 'debug-ignored-errors "Don't know how to resolve")
 
 (defvar smerge-text-properties
   `(help-echo "merge conflict: mouse-3 shows a menu"
@@ -443,7 +466,7 @@ BUF contains a plain diff between match-1 and match-3."
             (setq othertext
                   (if (null otherlines) ""
                     (let ((pos (point)))
-                      (dotimes (i otherlines) (delete-char 2) (forward-line 1))
+                      (dotimes (_i otherlines) (delete-char 2) (forward-line 1))
                       (buffer-substring pos (point)))))
             (with-current-buffer textbuf
               (forward-line (- startline line))
@@ -566,7 +589,7 @@ major modes.  Uses `smerge-resolve-function' to do the actual work."
              (with-current-buffer buf
                (zerop (call-process-region
                        (point-min) (point-max) "patch" t nil nil
-                       "-r" "/dev/null" "--no-backup-if-mismatch"
+                       "-r" null-device "--no-backup-if-mismatch"
                        "-fl" o))))
            (save-restriction
              (narrow-to-region m0b m0e)
@@ -582,7 +605,7 @@ major modes.  Uses `smerge-resolve-function' to do the actual work."
              (with-current-buffer buf
                (zerop (call-process-region
                        (point-min) (point-max) "patch" t nil nil
-                       "-r" "/dev/null" "--no-backup-if-mismatch"
+                       "-r" null-device "--no-backup-if-mismatch"
                        "-fl" m))))
            (save-restriction
              (narrow-to-region m0b m0e)
@@ -626,7 +649,7 @@ major modes.  Uses `smerge-resolve-function' to do the actual work."
             (set-match-data md)
            (smerge-keep-n choice))
            (t
-            (error "Don't know how to resolve"))))
+            (user-error "Don't know how to resolve"))))
       (if (buffer-name buf) (kill-buffer buf))
       (if m (delete-file m))
       (if b (delete-file b))
@@ -810,9 +833,7 @@ An error is raised if not inside a conflict."
                                  (when base-start (1- base-start)) base-start
                                  (1- other-start) other-start))
          t)
-      (search-failed (error "Point not in conflict region")))))
-
-(add-to-list 'debug-ignored-errors "Point not in conflict region")
+      (search-failed (user-error "Point not in conflict region")))))
 
 (defun smerge-conflict-overlay (pos)
   "Return the conflict overlay at POS if any."
@@ -910,7 +931,7 @@ It has the following disadvantages:
                ;; whitespace changes, it'll report added/removed lines :-(
                (not smerge-refine-weight-hack))
       (setq re (concat "[ \t]*\\(?:" re "\\)")))
-    (dotimes (i n)
+    (dotimes (_i n)
       (unless (looking-at re) (error "Smerge refine internal error"))
       (goto-char (match-end 0)))))
 
@@ -948,7 +969,7 @@ chars to try and eliminate some spurious differences."
           (unless (eq (char-before) ?\n) (insert ?\n))
           ;; HACK ALERT!!
           (if smerge-refine-weight-hack
-              (dotimes (i (1- (length s))) (insert s "\n")))))
+              (dotimes (_i (1- (length s))) (insert s "\n")))))
       (unless (bolp) (error "Smerge refine internal error"))
       (let ((coding-system-for-write 'emacs-mule))
         (write-region (point-min) (point-max) file nil 'nomessage)))))
@@ -983,14 +1004,23 @@ chars to try and eliminate some spurious differences."
           (dolist (x props) (overlay-put ol (car x) (cdr x)))
           ol)))))
 
-(defun smerge-refine-subst (beg1 end1 beg2 end2 props &optional preproc)
+(defun smerge-refine-subst (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)
   "Show fine differences in the two regions BEG1..END1 and BEG2..END2.
-PROPS is an alist of properties to put (via overlays) on the changes.
+PROPS-C is an alist of properties to put (via overlays) on the changes.
+PROPS-R is an alist of properties to put on removed characters.
+PROPS-A is an alist of properties to put on added characters.
+If PROPS-R and PROPS-A are nil, put PROPS-C on all changes.
+If PROPS-C is nil, but PROPS-R and PROPS-A are non-nil,
+put PROPS-A on added characters, PROPS-R on removed characters.
+If PROPS-C, PROPS-R and PROPS-A are non-nil, put PROPS-C on changed characters,
+PROPS-A on added characters, and PROPS-R on removed characters.
+
 If non-nil, PREPROC is called with no argument in a buffer that contains
 a copy of a region, just before preparing it to for `diff'.  It can be
 used to replace chars to try and eliminate some spurious differences."
   (let* ((buf (current-buffer))
          (pos (point))
+         deactivate-mark         ; The code does not modify any visible buffer.
          (file1 (make-temp-file "diff1"))
          (file2 (make-temp-file "diff2")))
     ;; Chop up regions into smaller elements and save into files.
@@ -1028,10 +1058,18 @@ used to replace chars to try and eliminate some spurious differences."
                     (m5 (match-string 5)))
                 (when (memq op '(?d ?c))
                   (setq last1
-                        (smerge-refine-highlight-change buf beg1 m1 m2 props)))
+                        (smerge-refine-highlight-change
+                        buf beg1 m1 m2
+                        ;; Try to use props-c only for changed chars,
+                        ;; fallback to props-r for changed/removed chars,
+                        ;; but if props-r is nil then fallback to props-c.
+                        (or (and (eq op '?c) props-c) props-r props-c))))
                 (when (memq op '(?a ?c))
                   (setq last2
-                        (smerge-refine-highlight-change buf beg2 m4 m5 props))))
+                        (smerge-refine-highlight-change
+                        buf beg2 m4 m5
+                        ;; Same logic as for removed chars above.
+                        (or (and (eq op '?c) props-c) props-a props-c)))))
               (forward-line 1)                            ;Skip hunk header.
               (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
                    (goto-char (match-beginning 0))))
@@ -1083,7 +1121,11 @@ repeating the command will highlight other two parts."
                    ((eq (match-end 3) (match-beginning 3)) 3)
                    (t 2)))
   (let ((n1 (if (eq part 1) 2 1))
-        (n2 (if (eq part 3) 2 3)))
+        (n2 (if (eq part 3) 2 3))
+       (smerge-use-changed-face
+        (and (face-differs-from-default-p 'smerge-refined-change)
+             (not (face-equal 'smerge-refined-change 'smerge-refined-added))
+             (not (face-equal 'smerge-refined-change 'smerge-refined-removed)))))
     (smerge-ensure-match n1)
     (smerge-ensure-match n2)
     (with-silent-modifications
@@ -1092,8 +1134,13 @@ repeating the command will highlight other two parts."
                          (cons (buffer-chars-modified-tick) part)))
     (smerge-refine-subst (match-beginning n1) (match-end n1)
                          (match-beginning n2)  (match-end n2)
-                         '((smerge . refine)
-                           (face . smerge-refined-change)))))
+                         (if smerge-use-changed-face
+                            '((smerge . refine) (face . smerge-refined-change)))
+                        nil
+                        (unless smerge-use-changed-face
+                          '((smerge . refine) (face . smerge-refined-removed)))
+                        (unless smerge-use-changed-face
+                          '((smerge . refine) (face . smerge-refined-added))))))
 
 (defun smerge-diff (n1 n2)
   (smerge-match-conflict)
@@ -1265,6 +1312,9 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
 ;;;###autoload
 (define-minor-mode smerge-mode
   "Minor mode to simplify editing output from the diff3 program.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil.
 \\{smerge-mode-map}"
   :group 'smerge :lighter " SMerge"
   (when (and (boundp 'font-lock-mode) font-lock-mode)