bug#10062: 24.0.91; completions-first-difference

[Leo]

On 2011-11-18 09:47 +0800, Stefan Monnier wrote:
[snipped 7 lines]
> Yup: the bug is not in the rear-stickiness but in the mere presence of
> this face.  I.e. the fix is to strip these faces when used for
> completion (but of course keep them when used for *Completions* display).
>
>
>         Stefan

On 2011-12-01 23:57 +0800, Stefan Monnier wrote:
[snipped 8 lines]
> I guess it could make sense to keep the face on the inserted text while
> you're still cycling, but it should be removed afterwards.  And since
> the transition between "cycling" and "not cycling" is not explicit,
> you'd then need/want to remove the face from something like
> a pre-command-hook.
>
>
>         Stefan

Hello Stefan,

I have been using completion with completion-cycle-threshold set to 4
and I have been annoyed often enough that I think it is worthwhile to
fix this bug because it often leaves my buffer weirdly fontified. For
example in elisp, `defma' can complete to `defmacro' unfontified.

emacs-comp-correct.png
Description: emacs-comp-correct.png

I propose the attached patch following your advice i.e. strip faces when
used for completion. Could you take a look at it? Thanks.

=== modified file 'lisp/minibuffer.el'
--- lisp/minibuffer.el  2012-01-05 09:46:05 +0000
+++ lisp/minibuffer.el  2012-01-16 09:05:45 +0000
@@ -1180,6 +1180,9 @@
 of the differing parts is, by contrast, slightly highlighted."
   :group 'completion)
 
+(defvar completion-hilit-commonality-p nil
+  "Internal variable. Bound to t in `minibuffer-completion-help'.")
+
 (defun completion-hilit-commonality (completions prefix-len base-size)
   (when completions
     (let ((com-str-len (- prefix-len (or base-size 0))))
@@ -1195,17 +1198,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)
-            (if (> (length str) com-str-len)
-                (put-text-property com-str-len (1+ com-str-len)
-                                   'font-lock-face 
'completions-first-difference
-                                   str)))
+            (when completion-hilit-commonality-p
+              (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)
+              (if (> (length str) com-str-len)
+                  (put-text-property com-str-len (1+ com-str-len)
+                                     'font-lock-face 
'completions-first-difference
+                                     str))))
           elem)
         completions)
        base-size))))
@@ -1314,12 +1318,13 @@
          (end (field-end))
          (string (field-string))
          (md (completion--field-metadata start))
-         (completions (completion-all-completions
-                       string
-                       minibuffer-completion-table
-                       minibuffer-completion-predicate
-                       (- (point) (field-beginning))
-                       md)))
+         (completions (let ((completion-hilit-commonality-p t))
+                        (completion-all-completions
+                         string
+                         minibuffer-completion-table
+                         minibuffer-completion-predicate
+                         (- (point) (field-beginning))
+                         md))))
     (message nil)
     (if (or (null completions)
             (and (not (consp (cdr completions)))
@@ -2411,14 +2416,15 @@
          (setq str (copy-sequence str))
          (unless (string-match re str)
            (error "Internal error: %s does not match %s" re str))
-         (let ((pos (or (match-beginning 1) (match-end 0))))
-           (put-text-property 0 pos
-                              'font-lock-face 'completions-common-part
-                              str)
-           (if (> (length str) pos)
-               (put-text-property pos (1+ pos)
-                                 'font-lock-face 'completions-first-difference
-                                 str)))
+         (when completion-hilit-commonality-p
+           (let ((pos (or (match-beginning 1) (match-end 0))))
+             (put-text-property 0 pos
+                                'font-lock-face 'completions-common-part
+                                str)
+             (if (> (length str) pos)
+                 (put-text-property pos (1+ pos)
+                                    'font-lock-face 
'completions-first-difference
+                                    str))))
         str)
        completions))))
 

Another simpler fix is to replace 'font-lock-face with 'face which would
then allow the major-mode to override the faces added by completion.

Leo