From: Dmitry Gutov <dgutov@yandex.ru>
Date: Tue, 5 Mar 2013 07:38:16 +0000 (+0400)
Subject: Keep pre-existing highlighting in completion candidates.
X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~2026^2~624
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c7a409b6f98c2677e165381380f81c061e32086a;p=emacs.git

Keep pre-existing highlighting in completion candidates.
* lisp/minibuffer.el (completions-first-difference): State that the
face is "added" in the docstring.
(completions-common-part): Same.  And don't inherit from default.
(completion-hilit-commonality): Prepend 'completions-common-part
and 'completion-first-difference faces to the 'face property,
instead of replacing the value(s).
(completion--insert-strings): Same with 'completions-annotations face.
(completion-hilit-commonality): Use 'face instead of
'font-lock-face, because it gets priority if the completion
strings already have 'face set.

Fixes: debbugs:13250
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4cf18ebb1f6..8feb3df5cdd 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2013-03-05  Dmitry Gutov  <dgutov@yandex.ru>
+
+	Keep pre-existing highlighting in completion candidates (Bug#13250).
+	* minibuffer.el (completions-first-difference): State that the
+	face is "added" in the docstring.
+	(completions-common-part): Same.  And don't inherit from default.
+	(completion-hilit-commonality): Prepend 'completions-common-part
+	and 'completion-first-difference faces to the 'face property,
+	instead of replacing the value(s).
+	(completion--insert-strings): Same with 'completions-annotations face.
+	(completion-hilit-commonality): Use 'face instead of
+	'font-lock-face, because it gets priority if the completion
+	strings already have 'face set.
+
 2013-03-04  Alan Mackenzie  <acm@muc.de>
 
 	Replace `last-command-event' by `last-command-char' in XEmacs.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e18f4c9c77f..ec237f0f664 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1458,9 +1458,11 @@ It also eliminates runs of equal strings."
                                    'mouse-face 'highlight)
               (put-text-property (point) (progn (insert (car str)) (point))
                                  'mouse-face 'highlight)
-              (add-text-properties (point) (progn (insert (cadr str)) (point))
-                                   '(mouse-face nil
-                                     face completions-annotations)))
+              (let ((beg (point))
+                    (end (progn (insert (cadr str)) (point))))
+                (put-text-property beg end 'mouse-face nil)
+                (font-lock-prepend-text-property beg end 'face
+                                                 'completions-annotations)))
 	    (cond
 	     ((eq completions-format 'vertical)
 	      ;; Vertical format
@@ -1487,12 +1489,11 @@ See also `display-completion-list'.")
 
 (defface completions-first-difference
   '((t (:inherit bold)))
-  "Face put on the first uncommon character in completions in *Completions* buffer."
+  "Face added on the first uncommon character in completions in *Completions* buffer."
   :group 'completion)
 
-(defface completions-common-part
-  '((t (:inherit default)))
-  "Face put on the common prefix substring in completions in *Completions* buffer.
+(defface completions-common-part '((t nil))
+  "Face added on the common prefix substring in completions in *Completions* buffer.
 The idea of `completions-common-part' is that you can use it to
 make the common parts less visible than normal, so that the rest
 of the differing parts is, by contrast, slightly highlighted."
@@ -1513,17 +1514,18 @@ of the differing parts is, by contrast, slightly highlighted."
                      (car (setq elem (cons (copy-sequence (car elem))
                                            (cdr elem))))
                    (setq elem (copy-sequence elem)))))
-            (put-text-property 0
-			       ;; If completion-boundaries returns incorrect
-			       ;; values, all-completions may return strings
-			       ;; that don't contain the prefix.
-			       (min com-str-len (length str))
-                               'font-lock-face 'completions-common-part
-                               str)
+            (font-lock-prepend-text-property
+             0
+             ;; If completion-boundaries returns incorrect
+             ;; values, all-completions may return strings
+             ;; that don't contain the prefix.
+             (min com-str-len (length str))
+             'face 'completions-common-part str)
             (if (> (length str) com-str-len)
-                (put-text-property com-str-len (1+ com-str-len)
-                                   'font-lock-face 'completions-first-difference
-                                   str)))
+                (font-lock-prepend-text-property com-str-len (1+ com-str-len)
+                                                 'face
+                                                 'completions-first-difference
+                                                 str)))
           elem)
         completions)
        base-size))))