Use new external-completion.el in Eglot

This refactor simplifies Eglot's source code.

* lisp/progmodes/eglot.el:
(Package-Requires): Require external-completion.
(external-completion): Require it.
(xref-backend-identifier-completion-table): Use external-completion-table.
(completion-category-overrides): No longer set it.
("Backend Completion"): Delete section.

lisp/external-completion.el

@@ -0,0 +1,174 @@
+;;; external-completion.el --- Let external tools control completion style  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; Version: 0.1
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Maintainer: João Távora <joaotavora@gmail.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Written by Stefan Monnier circa 2016.  Variants of this code have
+;; been working stably in SLY and other packages for a long time.
+
+;; The `external' completion style is used with a "programmable
+;; completion" table that gathers completions from an external tool
+;; such as a shell utility, an inferior process, an http server.
+
+;; The table and external tool are fully in control of the matching of
+;; the pattern string to the potential candidates of completion.  When
+;; `external' is in use, the usual styles configured by the user or
+;; other in `completion-styles' are ignored.
+;;
+;; This compromise is for speed: all other styles need the full data
+;; set to be available in Emacs' addressing space, which is often slow
+;; if not completely unfeasible.
+;;
+;; To make use of the `external' style the function
+;; `external-completion-table' should be used.  See its docstring.
+
+;;; Code:
+(require 'cl-lib)
+
+(add-to-list 'completion-styles-alist
+             '(external
+               external-completion--try-completion
+               external-completion--all-completions
+               "Ad-hoc completion style provided by the completion table."))
+
+(defun external-completion-table (category lookup
+                                           &optional metadata
+                                           try-completion-function)
+  "Make completion table using the `external' completion style.
+
+The `external' style is particularly useful when the caller
+interfaces with an external tool that provides completions.  This
+may be a shell utility, an inferior process, an http server, etc.
+Given a pattern string, the external tool matches it to an
+arbitrarily large set of candidates.  Since the full set doesn't
+need to be transferred to Emacs's address space, this often
+results in much faster overall experience, at the expense of the
+convenience of offered by other completion styles.
+
+CATEGORY is a symbol uniquely naming the external tool.  This
+function links CATEGORY to the style `external', by modifying
+`completion-category-defaults', overriding any styles normally
+set in `completion-styles'.
+
+LOOKUP is a function taking a string PATTERN and a number
+POINT. The function should contact the backend and return a list
+of strings representing the completions for PATTERN given that
+POINT is the location of point within it.  LOOKUP decides if
+PATTERN is interpreted as a substring, a regular expression, or
+any other type of matching method.  The strings returned may be
+propertized with `completions-common-part' to illustrate the
+specific method used.  LOOKUP may ignore POINT if it doesn't
+meaningfully alter the results.
+
+LOOKUP is a synchronous blocking function.  Since it contacts an
+external tool, it's possible that it takes significant time to
+return results.  To maintain Emacs's responsiveness, LOOKUP
+should detect pending user input using `while-no-input' or
+`sit-for' (which see).  In those cases, LOOKUP should attempt to
+cancel the request (if possible) and immediately return any
+non-list.
+
+METADATA is an alist of additional properties such as
+`cycle-sort-function' to associate with CATEGORY.  This means
+that the caller may still retain control the sorting of the
+candidates while the tool controls the matching.
+
+Optional TRY-COMPLETION-FUNCTION helps some frontends partially
+or fully expand PATTERN before finishing the completion
+operation.  If supplied, it is a function taking a (PATTERN POINT
+ALL-COMPLETIONS), where PATTERN and POINT are as described above
+and ALL-COMPLETIONS are gathered by LOOKUP for these
+arguments (this function ensures LOOKUP isn't called more than
+needed).  If you know the matching method that the external tool
+using, TRY-COMPLETION-FUNCTION may return a cons
+cell (EXPANDED-PATTERN . NEW-POINT).  For example, if the tool is
+completing by prefix, one could call `try-completion' to find the
+largest common prefix in ALL-COMPLETIONS and then return that as
+EXPANDED-PATTERN."
+  (let ((probe (alist-get category completion-category-defaults)))
+    (if probe
+        (cl-assert (equal '(external) (alist-get 'styles probe))
+                   nil "Category `%s' must only use `external' style" category)
+        (push `(,category (styles external))
+              completion-category-defaults)))
+  (let ((cache (make-hash-table :test #'equal)))
+    (cl-flet ((lookup-internal (string point)
+                (let* ((key (cons string point))
+                       (probe (gethash key cache 'external--notfound)))
+                  (if (eq probe 'external--notfound)
+                      (puthash key (funcall lookup string point) cache)
+                    probe))))
+      (lambda (string pred action)
+        (pcase action
+          (`metadata
+           `(metadata (category . ,category) . ,metadata))
+          ;; Note: the `--tryc' `--allc' suffixes are made akward on
+          ;; purpose, so it's easy to pick them apart from the jungle
+          ;; of combinations of "try" and "all" and "completion" that
+          ;; inhabit Emacs's completion logic.
+          (`(external-completion--tryc . ,point)
+           ;; FIXME: Obey `pred'?  Pass it to `try-completion-function'?
+           `(external-completion--tryc
+             . ,(if try-completion-function
+                    (funcall try-completion-function
+                             string
+                             point
+                             (lookup-internal string point))
+                  (cons string point))))
+          (`(external-completion--allc . ,point)
+           (let ((all (lookup-internal string point)))
+             `(external-completion--allc
+               . ,(if pred (cl-remove-if-not pred all) all))))
+          (`(boundaries . ,_) nil)
+          (_method
+           (let ((all (lookup-internal string (length string))))
+             ;; This branch might be taken:
+             ;;
+             ;; * when users work around
+             ;;   `completion-category-defaults' (via
+             ;;   `completion-category-overrides') and access this
+             ;;   table with another completion style.  We assume
+             ;;   these users know what they are doing, but it might
+             ;;   not work very well, as this whatever is in `all'
+             ;;   very often doesn't equate the full set of candidates
+             ;;   (many tools cap to sth like 100-1000 results).
+             ;;
+             ;; * when `_method' is `nil' or `lambda' which some
+             ;;   frontends will invoke.  Here, `all' should be
+             ;;   suficient information for `complete-with-action' to
+             ;;   do the job correctly.
+             (complete-with-action action all string pred))))))))
+
+(defun external-completion--call (op string table pred point)
+  (when (functionp table)
+    (let ((res (funcall table string pred (cons op point))))
+      (when (eq op (car-safe res))
+        (cdr res)))))
+
+(defun external-completion--try-completion (string table pred point)
+  (external-completion--call 'external-completion--tryc string table pred point))
+
+(defun external-completion--all-completions (string table pred point)
+  (external-completion--call 'external-completion--allc string table pred point))
+
+(provide 'external-completion)
+;;; external-completion.el ends here

lisp/icomplete.el

@@ -416,7 +416,6 @@ if that doesn't produce a completion match."
                 icomplete-scroll (not (null icomplete-vertical-mode))
                 completion-styles '(flex)
                 completion-flex-nospace nil
-                completion-category-defaults nil
                 completion-ignore-case t
                 read-buffer-completion-ignore-case t
                 read-file-name-completion-ignore-case t)))

lisp/progmodes/eglot.el

@@ -7,7 +7,7 @@
 ;; Maintainer: João Távora <joaotavora@gmail.com>
 ;; URL: https://github.com/joaotavora/eglot
 ;; Keywords: convenience, languages
-;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23"))
+;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23") (external-completion "0.1"))
 
 ;; This is a GNU ELPA :core package.  Avoid adding functionality
 ;; that is not available in the version of Emacs recorded above or any
@@ -110,6 +110,7 @@
 (require 'filenotify)
 (require 'ert)
 (require 'array)
+(require 'external-completion)
 
 ;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are
 ;; using the latest version from GNU Elpa when we load eglot.el.  Use an
@@ -2571,7 +2572,7 @@ If BUFFER, switch to it before."
                   (let ((probe (gethash pat cache :missing)))
                     (if (eq probe :missing) (puthash pat (refresh pat) cache)
                       probe)))
-                (lookup (pat)
+                (lookup (pat _point)
                   (let ((res (lookup-1 pat))
                         (def (and (string= pat "") (gethash :default cache))))
                     (append def res nil)))
@@ -2579,16 +2580,12 @@ If BUFFER, switch to it before."
                   (cl-getf (get-text-property
                             0 'eglot--lsp-workspaceSymbol c)
                            :score 0)))
-      (lambda (string _pred action)
-        (pcase action
-          (`metadata `(metadata
-                       (cycle-sort-function
-                        . ,(lambda (completions)
-                             (cl-sort completions #'> :key #'score)))
-                       (category . eglot-indirection-joy)))
-          (`(eglot--lsp-tryc . ,point) `(eglot--lsp-tryc . (,string . ,point)))
-          (`(eglot--lsp-allc . ,_point) `(eglot--lsp-allc . ,(lookup string)))
-          (_ nil))))))
+      (external-completion-table
+       'eglot-indirection-joy
+       #'lookup
+       `((cycle-sort-function
+          . ,(lambda (completions)
+               (cl-sort completions #'> :key #'score))))))))
 
 (defun eglot--recover-workspace-symbol-meta (string)
   "Search `eglot--workspace-symbols-cache' for rich entry of STRING."
@@ -2600,9 +2597,6 @@ If BUFFER, switch to it before."
                  (setq v (cdr v))))
              eglot--workspace-symbols-cache)))
 
-(add-to-list 'completion-category-overrides
-             '(eglot-indirection-joy (styles . (eglot--lsp-backend-style))))
-
 (cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
   (let ((attempt
          (and (xref--prompt-p this-command)
@@ -3437,42 +3431,6 @@ If NOERROR, return predicate, else erroring function."
                         'eglot-managed-mode-hook "1.6")
 (provide 'eglot)
 
-
-;;; Backend completion
-
-;; Written by Stefan Monnier circa 2016.  Something to move to
-;; minibuffer.el "ASAP" (with all the `eglot--lsp-' replaced by
-;; something else. The very same code already in SLY and stable for a
-;; long time.
-
-;; This "completion style" delegates all the work to the "programmable
-;; completion" table which is then free to implement its own
-;; completion style.  Typically this is used to take advantage of some
-;; external tool which already has its own completion system and
-;; doesn't give you efficient access to the prefix completion needed
-;; by other completion styles.  The table should recognize the symbols
-;; 'eglot--lsp-tryc and 'eglot--lsp-allc as ACTION, reply with
-;; (eglot--lsp-tryc COMP...) or (eglot--lsp-allc . (STRING . POINT)),
-;; accordingly.  tryc/allc names made akward/recognizable on purpose.
-
-(add-to-list 'completion-styles-alist
-             '(eglot--lsp-backend-style
-               eglot--lsp-backend-style-try-completion
-               eglot--lsp-backend-style-all-completions
-               "Ad-hoc completion style provided by the completion table."))
-
-(defun eglot--lsp-backend-style-call (op string table pred point)
-  (when (functionp table)
-    (let ((res (funcall table string pred (cons op point))))
-      (when (eq op (car-safe res))
-        (cdr res)))))
-
-(defun eglot--lsp-backend-style-try-completion (string table pred point)
-  (eglot--lsp-backend-style-call 'eglot--lsp-tryc string table pred point))
-
-(defun eglot--lsp-backend-style-all-completions (string table pred point)
-  (eglot--lsp-backend-style-call 'eglot--lsp-allc string table pred point))
-
 
 ;; Local Variables:
 ;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"