master e93d99a4a0c: Eglot: respect completion sort order dictated by the server

[João Távora]

branch: master
commit e93d99a4a0ce578249304dce350465c580a49892
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Eglot: respect completion sort order dictated by the server
    
    Don't use flex style to do any completion sorting.
    
    Previously, it was thought that the 'flex' completion style was only
    kicking in to do (approximate) fontification of the completions
    returned by the server, but it was found that it was also doing some
    its own sorting in certain situation of non-empty matching patterns.
    
    Replaced it with a new eglot--dumb-flex style which does only
    fontification.
    
    Github-reference: https://github.com/joaotavora/eglot/discussions/1306
    
    * lisp/progmodes/eglot.el (eglot-completion-at-point): Rework.
    (eglot--dumb-flex, eglot--dumb-allc): New helpers.
    (completion-category-defaults): Rework Eglot-specific category.
    (completion-styles-alist): Add Eglot-specific style.
    
    * etc/EGLOT-NEWS: Mention change.
---
 etc/EGLOT-NEWS          |  6 +++++
 lisp/progmodes/eglot.el | 63 ++++++++++++++++++++++++++++++-------------------
 2 files changed, 45 insertions(+), 24 deletions(-)

diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS
index f5f78ccd483..2f54dc43cbf 100644
--- a/etc/EGLOT-NEWS
+++ b/etc/EGLOT-NEWS
@@ -43,6 +43,12 @@ For 'newline' commands, Eglot sometimes sent the wrong 
character code
 to the server.  Also made this feature less chatty in the mode-line
 and messages buffer.
 
+** Fixed completion sorting
+
+In some situations, Eglot was not respecting the completion sort order
+decided by the language server, falling back on the sort order
+determined by the 'flex' completion style instead.  See github#1306.
+
 ** Improve mouse invocation of code actions
 
 When invoking code actions by middle clicking with the mouse on
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index e511df01850..7d83bcdd7ac 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -504,10 +504,6 @@ under cursor."
   "If non-nil, Eglot will not send the Emacs process id to the language server.
 This can be useful when using docker to run a language server.")
 
-;; Customizable via `completion-category-overrides'.
-(when (assoc 'flex completion-styles-alist)
-  (add-to-list 'completion-category-defaults '(eglot (styles flex basic))))
-
 
 ;;; Constants
 ;;;
@@ -3036,11 +3032,32 @@ for which LSP on-type-formatting should be requested."
 
 (defun eglot--capf-session-flush (&optional _) (setq eglot--capf-session 
:none))
 
+(defun eglot--dumb-flex (pat comp ignorecase)
+  "Return destructively fontified COMP iff PAT matches it."
+  (cl-loop with lcomp = (length comp)
+           with case-fold-search = ignorecase
+           initially (remove-list-of-text-properties 0 lcomp '(face) comp)
+           for x across pat
+           for i = (cl-loop for j from (if i (1+ i) 0) below lcomp
+                            when (char-equal x (aref comp j)) return j)
+           unless i do (cl-return nil)
+           ;; FIXME: could do much better here and coalesce intervals
+           do (add-face-text-property i (1+ i) 'completions-common-part
+                                      nil comp)
+           finally (cl-return comp)))
+
+(defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t))
+
+(add-to-list 'completion-category-defaults '(eglot-capf (styles 
eglot--dumb-flex)))
+(add-to-list 'completion-styles-alist '(eglot--dumb-flex ignore 
eglot--dumb-allc))
+
 (defun eglot-completion-at-point ()
   "Eglot's `completion-at-point' function."
   ;; Commit logs for this function help understand what's going on.
   (when-let (completion-capability (eglot-server-capable :completionProvider))
     (let* ((server (eglot--current-server-or-lose))
+           (bounds (or (bounds-of-thing-at-point 'symbol)
+                       (cons (point) (point))))
            (sort-completions
             (lambda (completions)
               (cl-sort completions
@@ -3049,10 +3066,9 @@ for which LSP on-type-formatting should be requested."
                               (plist-get
                                (get-text-property 0 'eglot--lsp-item c)
                                :sortText)))))
-           (metadata `(metadata (category . eglot)
+           (metadata `(metadata (category . eglot-capf)
                                 (display-sort-function . ,sort-completions)))
            (local-cache :none)
-           (bounds (bounds-of-thing-at-point 'symbol))
            (orig-pos (point))
            (resolved (make-hash-table))
            (proxies
@@ -3068,9 +3084,7 @@ for which LSP on-type-formatting should be requested."
                        (cachep (and (listp resp) items
                                     eglot-cache-session-completions
                                     (eq (plist-get resp :isIncomplete) 
:json-false)))
-                       (bounds (or bounds
-                                   (cons (point) (point))))
-                       (proxies
+                       (retval
                         (mapcar
                          (jsonrpc-lambda
                              (&rest item &key label insertText insertTextFormat
@@ -3093,8 +3107,8 @@ for which LSP on-type-formatting should be requested."
                          items)))
                   ;; (trace-values "Requested" (length proxies) cachep bounds)
                   (setq eglot--capf-session
-                        (if cachep (list bounds proxies resolved orig-pos) 
:none))
-                  (setq local-cache proxies)))))
+                        (if cachep (list bounds retval resolved orig-pos) 
:none))
+                  (setq local-cache retval)))))
            (resolve-maybe
             ;; Maybe completion/resolve JSON object `lsp-comp' into
             ;; another JSON object, if at all possible.  Otherwise,
@@ -3108,7 +3122,6 @@ for which LSP on-type-formatting should be requested."
                             (eglot--request server :completionItem/resolve
                                             lsp-comp :cancel-on-input t)
                           lsp-comp))))))
-      (unless bounds (setq bounds (cons (point) (point))))
       (when (and (consp eglot--capf-session)
                  (= (car bounds) (car (nth 0 eglot--capf-session)))
                  (>= (cdr bounds) (cdr (nth 0 eglot--capf-session))))
@@ -3120,24 +3133,26 @@ for which LSP on-type-formatting should be requested."
       (list
        (car bounds)
        (cdr bounds)
-       (lambda (probe pred action)
+       (lambda (pattern pred action)
          (cond
           ((eq action 'metadata) metadata)               ; metadata
           ((eq action 'lambda)                           ; test-completion
-           (test-completion probe (funcall proxies)))
+           (test-completion pattern (funcall proxies)))
           ((eq (car-safe action) 'boundaries) nil)       ; boundaries
           ((null action)                                 ; try-completion
-           (try-completion probe (funcall proxies)))
+           (try-completion pattern (funcall proxies)))
           ((eq action t)                                 ; all-completions
-           (all-completions
-            ""
-            (funcall proxies)
-            (lambda (proxy)
-              (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
-                     (filterText (plist-get item :filterText)))
-                (and (or (null pred) (funcall pred proxy))
-                     (string-prefix-p
-                      probe (or filterText proxy) 
completion-ignore-case))))))))
+           (let ((comps (funcall proxies)))
+             (dolist (c comps) (eglot--dumb-flex pattern c t))
+             (all-completions
+              ""
+              comps
+              (lambda (proxy)
+                (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
+                       (filterText (plist-get item :filterText)))
+                  (and (or (null pred) (funcall pred proxy))
+                       (eglot--dumb-flex
+                        pattern (or filterText proxy) 
completion-ignore-case)))))))))
        :annotation-function
        (lambda (proxy)
          (eglot--dbind ((CompletionItem) detail kind)