diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 43dd277a2e..e272364b49 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1649,10 +1649,8 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
-                                   'mouse-face 'highlight)
-              (put-text-property (point) (progn (insert (car str)) (point))
-                                 'mouse-face 'highlight)
+                (completion--insert-string str)
+              (completion--insert-string (car str))
               (let ((beg (point))
                     (end (progn (insert (cadr str)) (point))))
                 (put-text-property beg end 'mouse-face nil)
@@ -1672,6 +1670,53 @@ completion--insert-strings
 			      ;; Round up to a whole number of columns.
 			      (* colwidth (ceiling length colwidth))))))))))))
 
+(defun completion--insert-string (s)
+  (require 'text-property-search)
+  (let* ((beg (point))
+         (end (progn (insert s)
+                     (point)))
+         (search-pred (lambda (expected value)
+                        (or (eq expected value)
+                            (and (listp value)
+                                 (memq expected value)))))
+         fdiff-match)
+    (put-text-property beg end 'mouse-face 'highlight)
+    (save-excursion
+      (save-restriction
+        (narrow-to-region beg end)
+        (goto-char beg)
+        (setq fdiff-match
+              (text-property-search-forward 'face 'completions-first-difference
+                                            search-pred))
+        (when fdiff-match
+          (let ((fdiff-pos (prop-match-beginning fdiff-match))
+                (prop-pos (point)))
+            (goto-char fdiff-pos)
+            (when (or
+                   ;; There is a place before fdiff-pos without common part.
+                   (catch 'found
+                     (while (setq prop-pos
+                                  (previous-single-property-change prop-pos 'face
+                                                                   nil beg))
+                       (when (= prop-pos beg)
+                         (throw 'found nil))
+                       (let ((value (get-text-property (1- prop-pos) 'face)))
+                         (if (or (eq value 'completions-common-part)
+                                 (and (listp value)
+                                      (memq 'completions-common-part value)))
+                             (setq prop-pos (1- prop-pos))
+                           (throw 'found t)))))
+                   ;; There is a place after fdiff-pos with common part.
+                   (text-property-search-forward 'face 'completions-common-part
+                                                 search-pred))
+              ;; FIXME: For some reason, this highlighting gets eaten
+              ;; before the buffer is displayed, somewhere.
+              ;; TODO: Highlight only the parts with -common-part.
+              (font-lock-prepend-text-property beg fdiff-pos
+                                               'font-lock-face
+                                               'completions-nontrivial-common-part)
+              )))))))
+
 (defvar completion-common-substring nil)
 (make-obsolete-variable 'completion-common-substring nil "23.1")
 
@@ -1691,6 +1736,10 @@ completions-common-part
   "Face for the parts of completions which matched the pattern.
 See also the face `completions-first-difference'.")
 
+(defface completions-nontrivial-common-part '((t (:background "white smoke")))
+  "Face for the parts of completions which matches the pattern nontrivially.
+Meaning that the match is a non-prefix one.")
+
 (defun completion-hilit-commonality (completions prefix-len &optional base-size)
   "Apply font-lock highlighting to a list of completions, COMPLETIONS.
 PREFIX-LEN is an integer.  BASE-SIZE is an integer or nil (meaning zero).