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