diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index b007320b110..41b20174be1 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2375,34 +2375,38 @@ This adds the face `completions-common-part' to the first It returns a list with font-lock properties applied to each element, and with BASE-SIZE appended as the last element." (when completions - (let ((com-str-len (- prefix-len (or base-size 0)))) - (nconc - (mapcar - (lambda (elem) - (let ((str - ;; Don't modify the string itself, but a copy, since the - ;; string may be read-only or used for other purposes. - ;; Furthermore, since `completions' may come from - ;; display-completion-list, `elem' may be a list. - (if (consp elem) - (car (setq elem (cons (copy-sequence (car elem)) - (cdr elem)))) - (setq elem (copy-sequence elem))))) - (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) - (font-lock-prepend-text-property com-str-len (1+ com-str-len) - 'face - 'completions-first-difference - str))) - elem) - completions) - base-size)))) + (let* ((com-str-len (- prefix-len (or base-size 0))) + (hilit-fn + (lambda (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) + (when (> (length str) com-str-len) + (font-lock-prepend-text-property + com-str-len (1+ com-str-len) + 'face 'completions-first-difference str)) + str))) + (if completion-lazy-hilit + (setq completion-lazy-hilit-fn hilit-fn) + (setq completions + (mapcar + (lambda (elem) + ;; Don't modify the string itself, but a copy, since + ;; the string may be read-only or used for other + ;; purposes. Furthermore, since `completions' may come + ;; from display-completion-list, `elem' may be a list. + (funcall hilit-fn + (if (consp elem) + (car (setq elem (cons (copy-sequence (car elem)) + (cdr elem)))) + (setq elem (copy-sequence elem)))) + elem) + completions))) + (nconc completions base-size)))) (defun display-completion-list (completions &optional common-substring group-fun) "Display the list of completions, COMPLETIONS, using `standard-output'.