bug#10181: 24.0.92; [wishlist] split `diff-refine-change' in several faces

[Juri Linkov]

> Please move the :inherit to a `default' clause instead of copying it
> into each one of the clauses.

Fixed in the patch below.

>> +      (if (not (or (face-equal diff-changed-face diff-added-face)
>> +               (face-equal diff-changed-face diff-removed-face)))
>
> Please introduce a defvar for it, so we don't re-evaluate the face
> comparison for each and every line.

This defvar needs to be re-evaluated when the user customized faces.
Since faces are used by font-lock, a good place to re-evaluate the value
of this defvar before font-lock starts is in the function `diff-mode'.

> And while I'm OK with not implementing the changed-added-remove scheme
> for refinement yet, I think that if we change the API of
> smerge-refine-subst for the added-removed case, we should make sure the
> API won't need to be changed yet again if/when we add the
> changed-added-removed scheme.

The following patch implements the API for all possible cases:

=== modified file 'lisp/vc/diff-mode.el'
--- lisp/vc/diff-mode.el        2012-05-01 02:48:41 +0000
+++ lisp/vc/diff-mode.el        2012-05-23 00:31:05 +0000
@@ -277,14 +275,28 @@ (define-obsolete-face-alias 'diff-hunk-h
 (defvar diff-hunk-header-face 'diff-hunk-header)
 
 (defface diff-removed
-  '((t :inherit diff-changed))
+  '((default
+     :inherit diff-changed)
+    (((class color) (min-colors 88))
+     :background "#ffdddd")
+    (((class color))
+     :foreground "red"
+     :weight normal
+     :slant normal))
   "`diff-mode' face used to highlight removed lines."
   :group 'diff-mode)
 (define-obsolete-face-alias 'diff-removed-face 'diff-removed "22.1")
 (defvar diff-removed-face 'diff-removed)
 
 (defface diff-added
-  '((t :inherit diff-changed))
+  '((default
+     :inherit diff-changed)
+    (((class color) (min-colors 88))
+     :background "#ddffdd")
+    (((class color))
+     :foreground "green"
+     :weight normal
+     :slant normal))
   "`diff-mode' face used to highlight added lines."
   :group 'diff-mode)
 (define-obsolete-face-alias 'diff-added-face 'diff-added "22.1")
@@ -374,6 +386,8 @@ (defconst diff-hunk-header-re-unified
 (defconst diff-context-mid-hunk-header-re
   "--- \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? ----$")
 
+(defvar diff-use-changed-face nil)
+
 (defvar diff-font-lock-keywords
   `((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$")
      (1 diff-hunk-header-face) (6 diff-function-face))
@@ -393,7 +407,17 @@ (defvar diff-font-lock-keywords
     ("^\\([+>]\\)\\(.*\n\\)"
      (1 diff-indicator-added-face) (2 diff-added-face))
     ("^\\(!\\)\\(.*\n\\)"
-     (1 diff-indicator-changed-face) (2 diff-changed-face))
+     (1 diff-indicator-changed-face)
+     (2
+      (if diff-use-changed-face
+         diff-changed-face
+       ;; Otherwise, search for `diff-context-mid-hunk-header-re' and
+       ;; if the line of context diff is above, use `diff-removed-face';
+       ;; if below, use `diff-added-face'.
+       (let ((limit (save-excursion (diff-beginning-of-hunk))))
+         (if (save-excursion (re-search-backward 
diff-context-mid-hunk-header-re limit t))
+             diff-added-face
+           diff-removed-face)))))
     ("^\\(?:Index\\|revno\\): \\(.+\\).*\n"
      (0 diff-header-face) (1 diff-index-face prepend))
     ("^Only in .*\n" . diff-nonexistent-face)
@@ -1281,6 +1305,11 @@ (define-derived-mode diff-mode fundament
    \\{diff-mode-map}"
 
   (set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults)
+  (set (make-local-variable 'diff-use-changed-face)
+       (and (face-differs-from-default-p diff-changed-face)
+           (not (face-equal diff-changed-face diff-added-face))
+           (not (face-equal diff-changed-face diff-removed-face))))
+
   (set (make-local-variable 'outline-regexp) diff-outline-regexp)
   (set (make-local-variable 'imenu-generic-expression)
        diff-imenu-generic-expression)
@@ -1866,6 +1895,28 @@ (defface diff-refine-change
   "Face used for char-based changes shown by `diff-refine-hunk'."
   :group 'diff-mode)
 
+(defface diff-refine-removed
+  '((default
+     :inherit diff-refine-change)
+    (((class color) (min-colors 88))
+     :background "#ffaaaa")
+    (((class color))
+     :background "red"))
+  "Face used for removed characters shown by `diff-refine-hunk'."
+  :group 'diff-mode
+  :version "24.2")
+
+(defface diff-refine-added
+  '((default
+     :inherit diff-refine-change)
+    (((class color) (min-colors 88))
+     :background "#aaffaa")
+    (((class color))
+     :background "green"))
+  "Face used for added characters shown by `diff-refine-hunk'."
+  :group 'diff-mode
+  :version "24.2")
+
 (defun diff-refine-preproc ()
   (while (re-search-forward "^[+>]" nil t)
     ;; Remove spurious changes due to the fact that one side of the hunk is
@@ -1879,7 +1930,7 @@ (defun diff-refine-preproc ()
   )
 
 (declare-function smerge-refine-subst "smerge-mode"
-                  (beg1 end1 beg2 end2 props &optional preproc))
+                  (beg1 end1 beg2 end2 props-c &optional preproc props-r 
props-a))
 
 (defun diff-refine-hunk ()
   "Highlight changes of hunk at point at a finer granularity."
@@ -1890,7 +1941,9 @@ (defun diff-refine-hunk ()
     (let* ((start (point))
            (style (diff-hunk-style))    ;Skips the hunk header as well.
            (beg (point))
-           (props '((diff-mode . fine) (face diff-refine-change)))
+           (props-c '((diff-mode . fine) (face diff-refine-change)))
+           (props-r '((diff-mode . fine) (face diff-refine-removed)))
+           (props-a '((diff-mode . fine) (face diff-refine-added)))
            ;; Be careful to go back to `start' so diff-end-of-hunk gets
            ;; to read the hunk header's line info.
            (end (progn (goto-char start) (diff-end-of-hunk) (point))))
@@ -1904,7 +1957,7 @@ (defun diff-refine-hunk ()
                                    end t)
            (smerge-refine-subst (match-beginning 0) (match-end 1)
                                 (match-end 1) (match-end 0)
-                                props 'diff-refine-preproc)))
+                                nil 'diff-refine-preproc props-r props-a)))
         (context
          (let* ((middle (save-excursion (re-search-forward "^---")))
                 (other middle))
@@ -1916,14 +1969,17 @@ (defun diff-refine-hunk ()
                                     (setq other (match-end 0))
                                     (match-beginning 0))
                                   other
-                                  props 'diff-refine-preproc))))
+                                  (if diff-use-changed-face props-c)
+                                  'diff-refine-preproc
+                                  (unless diff-use-changed-face props-r)
+                                  (unless diff-use-changed-face props-a)))))
         (t ;; Normal diffs.
          (let ((beg1 (1+ (point))))
            (when (re-search-forward "^---.*\n" end t)
              ;; It's a combined add&remove, so there's something to do.
              (smerge-refine-subst beg1 (match-beginning 0)
                                   (match-end 0) end
-                                  props 'diff-refine-preproc))))))))
+                                  nil 'diff-refine-preproc props-r 
props-a))))))))
 
 (defun diff-undo (&optional arg)
   "Perform `undo', ignoring the buffer's read-only status."

=== modified file 'lisp/vc/smerge-mode.el'
--- lisp/vc/smerge-mode.el      2012-05-04 23:16:47 +0000
+++ lisp/vc/smerge-mode.el      2012-05-23 00:34:09 +0000
@@ -128,6 +128,28 @@ (defface smerge-refined-change
   "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 "#ffaaaa")
+    (((class color))
+     :background "red"))
+  "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 "#aaffaa")
+    (((class color))
+     :background "green"))
+  "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)
@@ -980,9 +1002,17 @@ (defun smerge-refine-highlight-change (b
           (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 changes characters,
+PROPS-A on added characters, 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."
@@ -1026,10 +1056,18 @@ (defun smerge-refine-subst (beg1 end1 be
                     (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))))
@@ -1081,7 +1119,11 @@ (defun smerge-refine (&optional part)
                    ((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
@@ -1090,8 +1132,13 @@ (defun smerge-refine (&optional part)
                          (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)