diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/minibuffer.el | 46 |
1 files changed, 37 insertions, 9 deletions
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 7227e83f878..35de3fbb969 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. |