[PATCH] Completion preview common

[Ergus <spacibba@aol.com>]

[-- Attachment #1: Type: text/plain, Size: 750 bytes --]

Hi all:

Recently I have been playing with the new completion-preview mode and
I'm very happy to see something like this finally added to emacs with a
simple and clean code.

However, there is a missing detail that I find useful when typing:
common preview completion.

The goal is to preview a common prefix when available and longer than
the prefix already inserted. This is a point in between 1) exact match
with one candidate only and 2) getting the first candidate in the whole
list.

I tried to avoid adding complexity to the code (because the thing I like
the most in the package is actually its simplicity and predictability);
but the extra functionality I think worth the few new lines.

I attach the patch for a first review.

Best,
Ergus


[-- Attachment #2: completion-preview-common.patch --]
[-- Type: text/plain, Size: 4483 bytes --]

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."