diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index a86c1ba1cc9..11ac929efcf 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -59,16 +59,21 @@ completion-preview :group 'completion) (defcustom completion-preview-exact-match-only nil - "Whether to show completion preview only when there is an exact match. - -If this option is non-nil, Completion Preview mode only shows the -preview when there is exactly one completion candidate that -matches the symbol at point. Otherwise, if this option is nil, -when there are multiple matching candidates the preview shows the -first candidate, and you can cycle between the candidates with + "Show completion preview only when there is an exact or common prefix match. + + If this option is t, Completion Preview mode only shows the preview when +there is exactly one completion candidate that matches the symbol at +point. + If the option is `common', only shows the preview if there is a common +prefix in all the candidates and it is longer than the current input. + Otherwise, if this option is nil, when there are multiple matching +candidates the preview shows the first candidate, and you can cycle +between the candidates with \\[completion-preview-next-candidate] and \\[completion-preview-prev-candidate]." - :type 'boolean + :type '(choice (const :tag "Yes" t) + (const :tag "No" nil) + (const :tag "Common" common)) :version "30.1") (defcustom completion-preview-commands '(self-insert-command @@ -236,7 +241,10 @@ completion-preview--try-table (sort-fn (or (completion-metadata-get md 'cycle-sort-function) (completion-metadata-get md 'display-sort-function) completion-preview-sort-function)) - (all (let ((completion-lazy-hilit t)) + (all (let ((completion-lazy-hilit t) + (completion-styles (pcase completion-preview-exact-match-only + ('common '(basic)) + (_ completion-styles)))) (completion-all-completions string table pred (- (point) beg) md))) (last (last all)) @@ -244,17 +252,28 @@ completion-preview--try-table (prefix (substring string base))) (when last (setcdr last nil) - (when-let ((sorted (funcall sort-fn - (delete prefix (all-completions prefix all))))) - (unless (and (cdr sorted) completion-preview-exact-match-only) - (list (propertize (substring (car sorted) (length prefix)) - 'face (if (cdr sorted) - 'completion-preview - 'completion-preview-exact) - 'mouse-face 'completion-preview-highlight - 'keymap completion-preview--mouse-map) - (+ beg base) end sorted - (substring string 0 base) exit-fn)))))) + (when-let ((sorted (cond + ((not completion-preview-exact-match-only) + (funcall sort-fn + (delete prefix (all-completions prefix all)))) + ((eq completion-preview-exact-match-only t) + (when-let ((cands (delete prefix (all-completions prefix all)))) + (unless (cdr cands) cands))) + ((eq completion-preview-exact-match-only 'common) + (when-let ((cand (try-completion prefix all))) + (when (and (stringp cand) + (> (length cand) (length prefix))) + (list cand)))) + ))) + + (list (propertize (substring (car sorted) (length prefix)) + 'face (if (cdr sorted) + 'completion-preview + 'completion-preview-exact) + 'mouse-face 'completion-preview-highlight + 'keymap completion-preview--mouse-map) + (+ beg base) end sorted + (substring string 0 base) exit-fn))))) (defun completion-preview--capf-wrapper (capf) "Translate return value of CAPF to properties for completion preview overlay."