aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/minibuffer.el46
1 files changed, 9 insertions, 37 deletions
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 35de3fbb969..7227e83f878 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -907,31 +907,6 @@ This overrides the defaults specified in `completion-category-defaults'."
907 (delete-dups (append (cdr over) (copy-sequence completion-styles))) 907 (delete-dups (append (cdr over) (copy-sequence completion-styles)))
908 completion-styles))) 908 completion-styles)))
909 909
910(cl-defgeneric completion-adjust-metadata-for-style (style metadata)
911 "Adjust METADATA of current completion according to STYLE."
912 (:method (_style _metadata) nil) ; nop by default
913 (:method
914 ((_style (eql flex)) metadata)
915 (cl-flet ((compose-flex-sort-fn
916 (existing-sort-fn) ; wish `cl-flet' had proper indentation...
917 (lambda (completions)
918 (let ((res
919 (if existing-sort-fn
920 (funcall existing-sort-fn completions)
921 completions)))
922 (sort
923 res
924 (lambda (c1 c2)
925 (or (equal c1 minibuffer-default)
926 (> (get-text-property 0 'completion-score c1)
927 (get-text-property 0 'completion-score c2)))))))))
928 (let ((alist (cdr metadata)))
929 (setf (alist-get 'display-sort-function alist)
930 (compose-flex-sort-fn (alist-get 'display-sort-function alist)))
931 (setf (alist-get 'cycle-sort-function alist)
932 (compose-flex-sort-fn (alist-get 'cycle-sort-function alist)))
933 metadata))))
934
935(defun completion--nth-completion (n string table pred point metadata) 910(defun completion--nth-completion (n string table pred point metadata)
936 "Call the Nth method of completion styles." 911 "Call the Nth method of completion styles."
937 (unless metadata 912 (unless metadata
@@ -961,20 +936,17 @@ This overrides the defaults specified in `completion-category-defaults'."
961 (setq string (pop new)) 936 (setq string (pop new))
962 (setq table (pop new)) 937 (setq table (pop new))
963 (setq point (pop new)) 938 (setq point (pop new))
964 (cl-assert (<= point (length string))) 939 (cl-assert (<= point (length string)))
965 (pop new)))) 940 (pop new))))
966 (result-and-style 941 (result
967 (completion--some 942 (completion--some (lambda (style)
968 (lambda (style) 943 (funcall (nth n (assq style
969 (let ((probe (funcall (nth n (assq style 944 completion-styles-alist))
970 completion-styles-alist)) 945 string table pred point))
971 string table pred point))) 946 (completion--styles metadata))))
972 (and probe (cons probe style))))
973 (completion--styles metadata))))
974 (completion-adjust-metadata-for-style (cdr result-and-style) metadata)
975 (if requote 947 (if requote
976 (funcall requote (car result-and-style) n) 948 (funcall requote result n)
977 (car result-and-style)))) 949 result)))
978 950
979(defun completion-try-completion (string table pred point &optional metadata) 951(defun completion-try-completion (string table pred point &optional metadata)
980 "Try to complete STRING using completion table TABLE. 952 "Try to complete STRING using completion table TABLE.