From cd917365ce2c00bc8bf1c2467c61fbe7a1d830e3 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Thu, 4 Apr 2024 07:19:58 +0200 Subject: [PATCH] (completion-hilit-commonality): Support `completion-lazy-hilit` * lisp/minibuffer.el (completion-hilit-commonality): Support lazy completion candidate highlighting via `completion-lazy-hilit`. (cherry picked from commit f30801a20338cdc7716c3eff1443f1be603aa94e) --- lisp/minibuffer.el | 60 ++++++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 28 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index e3128b80bba..0f484a3f8cc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2650,34 +2650,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 completions-predicate-description (pred) (and (functionp pred) -- 2.39.5