[Emacs-diffs] /srv/bzr/emacs/trunk r111942: Keep pre-existing highlighting in completion candidates.

[Dmitry Gutov]

------------------------------------------------------------
revno: 111942
fixes bug: http://debbugs.gnu.org/13250
committer: Dmitry Gutov <address@hidden>
branch nick: trunk
timestamp: Tue 2013-03-05 11:38:16 +0400
message:
  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.
modified:
  lisp/ChangeLog
  lisp/minibuffer.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-03-04 19:33:23 +0000
+++ b/lisp/ChangeLog    2013-03-05 07:38:16 +0000
@@ -1,3 +1,17 @@
+2013-03-05  Dmitry Gutov  <address@hidden>
+
+       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  <address@hidden>
 
        Replace `last-command-event' by `last-command-char' in XEmacs.

=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el        2013-02-09 05:52:20 +0000
+++ b/lisp/minibuffer.el        2013-03-05 07:38:16 +0000
@@ -1458,9 +1458,11 @@
                                    '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 @@
 
 (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 @@
                      (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))))