emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 7fc0292: Allow completion styles to adjust completion metadata


From: João Távora
Subject: master 7fc0292: Allow completion styles to adjust completion metadata
Date: Sat, 26 Oct 2019 08:12:59 -0400 (EDT)

branch: master
commit 7fc0292f5c49d11fc39853f8bc25586d54221e6a
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    Allow completion styles to adjust completion metadata
    
    The new facility, realized in the completion-adjust-metadata-for-style
    generic, allows completion styles to have a say in metadata properties
    such as cycle-sort-function and display-sort-function.  This is
    especially useful for completion styles such as 'flex', which
    generally produce many matches, including some potentially "obscure"
    ones.  The default sorting strategy would often bubble the latter
    to the top of the list.
    
    The sorting function for 'flex' considers pre-computed matching scores
    and is thus much better than the default for this particular style.
    
    Additionally, it overrides the completion table's cycle-sort-function
    or display-sort-function properties if they exist, although it still
    uses them to pre-sort the result, so that they are still relevant for
    resolving ties.
    
    * lisp/minibuffer.el (completion--nth-completion): Call
    completion-adjust-metadata-for-style.
    (completion-adjust-metadata-for-style): New generic.
    (completion-adjust-metadata-for-style 'flex): New method.
---
 lisp/minibuffer.el | 46 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 37 insertions(+), 9 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 7227e83..35de3fb 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -907,6 +907,31 @@ This overrides the defaults specified in 
`completion-category-defaults'."
         (delete-dups (append (cdr over) (copy-sequence completion-styles)))
        completion-styles)))
 
+(cl-defgeneric completion-adjust-metadata-for-style (style metadata)
+  "Adjust METADATA of current completion according to STYLE."
+  (:method (_style _metadata) nil) ; nop by default
+  (:method
+   ((_style (eql flex)) metadata)
+   (cl-flet ((compose-flex-sort-fn
+              (existing-sort-fn) ; wish `cl-flet' had proper indentation...
+              (lambda (completions)
+                (let ((res
+                       (if existing-sort-fn
+                           (funcall existing-sort-fn completions)
+                         completions)))
+                  (sort
+                   res
+                   (lambda (c1 c2)
+                     (or (equal c1 minibuffer-default)
+                         (> (get-text-property 0 'completion-score c1)
+                            (get-text-property 0 'completion-score c2)))))))))
+     (let ((alist (cdr metadata)))
+       (setf (alist-get 'display-sort-function alist)
+             (compose-flex-sort-fn (alist-get 'display-sort-function alist)))
+       (setf (alist-get 'cycle-sort-function alist)
+             (compose-flex-sort-fn (alist-get 'cycle-sort-function alist)))
+       metadata))))
+
 (defun completion--nth-completion (n string table pred point metadata)
   "Call the Nth method of completion styles."
   (unless metadata
@@ -936,17 +961,20 @@ This overrides the defaults specified in 
`completion-category-defaults'."
              (setq string (pop new))
              (setq table (pop new))
              (setq point (pop new))
-            (cl-assert (<= point (length string)))
+             (cl-assert (<= point (length string)))
              (pop new))))
-        (result
-         (completion--some (lambda (style)
-                             (funcall (nth n (assq style
-                                                   completion-styles-alist))
-                                      string table pred point))
-                           (completion--styles metadata))))
+        (result-and-style
+         (completion--some
+          (lambda (style)
+            (let ((probe (funcall (nth n (assq style
+                                               completion-styles-alist))
+                                  string table pred point)))
+              (and probe (cons probe style))))
+          (completion--styles metadata))))
+    (completion-adjust-metadata-for-style (cdr result-and-style) metadata)
     (if requote
-        (funcall requote result n)
-      result)))
+        (funcall requote (car result-and-style) n)
+      (car result-and-style))))
 
 (defun completion-try-completion (string table pred point &optional metadata)
   "Try to complete STRING using completion table TABLE.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]