From 9a62da21c2e768f5f550a92171ab81f0bac37a35 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 3 Dec 2022 13:01:26 +0000 Subject: [PATCH] Integrate Stefan suggestions but rename it to "external-completion.el" "External completion" is a much better name. There are already a thousand in-Emacs meanings for "backend" and this new style is really meant to be used for tools _outside_ of Emacs. --- lisp/backend-completion.el | 102 ----------------------------- lisp/external-completion.el | 127 ++++++++++++++++++++++++++++++++++++ lisp/progmodes/eglot.el | 24 +++---- 3 files changed, 136 insertions(+), 117 deletions(-) delete mode 100644 lisp/backend-completion.el create mode 100644 lisp/external-completion.el diff --git a/lisp/backend-completion.el b/lisp/backend-completion.el deleted file mode 100644 index bc3d0482114..00000000000 --- a/lisp/backend-completion.el +++ /dev/null @@ -1,102 +0,0 @@ -;;; backend-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 -;; Maintainer: João Távora -;; 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 . - -;;; Commentary: - -;; Written by Stefan Monnier circa 2016. Variants of this code have -;; been working stably in SLY and other packages for a long time. - -;; This completion style is meant to be used with a "programmable -;; completion" table that interfaces with an external tool provinding -;; completions, such as a shell utility, an inferior process, an http -;; server. The table and external tool are tasked to do the matching -;; of the pattern string to the potential candidates of completion, -;; and as such it fully controls the style. - -;; When this completion style is in use, the usual styles configured -;; by the user or other in `completion-styles' are completely -;; overriden. This can be seen as a drawback, but, on the other hand, -;; the regular the full data set to be available in Emacs' addressing -;; space, which is often not feasible. -;; -;; The programmable completion table amounts to a function taking -;; (PATTERN PRED ACTION) as arguments respond to at least three values -;; for ACTION: -;; -;; * The symbol `metadata', where the table should reply with a list -;; that looks like: -;; -;; (metadata (category . backend-completion) MORE...) -;; -;; where MORE... can be other "metadata" items like -;; `cycle-sort-function'. -;; -;; Other categories can be used in place of `backend-completion', -;; as long as the `styles' property of such categories contains the -;; sole element `backend-completion-backend-style'. - -;; * (backend-completion-tryc . POINT) where the reply should be: -;; -;; (backend-completion-tryc . (PATTERN . POINT)) -;; -;; * (backend-completion-allc . POINT) where the reply should be -;; -;; (backend-completion-allc COMPS...) -;; -;; Where COMPS... is a list of strings which are all the completions -;; that the external tool has found for PATTERN and POINT. If the -;; style that the external tool is using to match PATTERN is known, -;; elements of COMPS can be propertized with -;; 'completions-common-part' in the relevant sections. - -;; 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. - -;;; Code: -(add-to-list 'completion-styles-alist - '(backend-completion-backend-style - backend-completion--try-completion - backend-completion--all-completions - "Ad-hoc completion style provided by the completion table.")) - -(add-to-list 'completion-category-defaults - '(backend-completion (styles . (backend-completion-backend-style)))) - -;; (add-to-list 'completion-category-overrides -;; '(backend-completion (styles . (backend-completion-backend-style)))) - -(defun backend-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 backend-completion--try-completion (string table pred point) - (backend-completion--call 'backend-completion-tryc string table pred point)) - -(defun backend-completion--all-completions (string table pred point) - (backend-completion--call 'backend-completion-allc string table pred point)) - -(provide 'backend-completion) -;;; backend-completion.el ends here diff --git a/lisp/external-completion.el b/lisp/external-completion.el new file mode 100644 index 00000000000..da3a986b8cf --- /dev/null +++ b/lisp/external-completion.el @@ -0,0 +1,127 @@ +;;; 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 +;; Maintainer: João Távora +;; 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 . + +;;; Commentary: + +;; Written by Stefan Monnier circa 2016. Variants of this code have +;; been working stably in SLY and other packages for a long time. + +;; This completion style is meant to be used with a "programmable +;; completion" table that interfaces with an external tool provinding +;; completions, such as a shell utility, an inferior process, an http +;; server. The table and external tool are tasked to do the matching +;; of the pattern string to the potential candidates of completion, +;; and as such it fully controls the style. + +;; When this completion style is in use, the usual styles configured +;; by the user or other in `completion-styles' are completely +;; overriden. This can be seen as a drawback, but, on the other hand, +;; the regular the full data set to be available in Emacs' addressing +;; space, which is often not feasible. +;; +;; To make use of this style, the function `external-completion-table' +;; should be used. See its docstring. + +;;; Code: +(add-to-list 'completion-styles-alist + '(external-completion-style + external-completion--try-completion + external-completion--all-completions + "Ad-hoc completion style provided by the completion table.")) + +(defun external-completion-table (lookup + category &optional metadata + try-completion-function) + "Make completion table using `external-completion-style'. + +The completion table produced will forego any styles normally set +in `completion-styles' and will setup an entry for the symbol +CATEGORY in `completion-category-defaults' linking it to the +special style `external-completion-style'. + +This style is useful when the caller interfaces with an external +tool providing completions. This may be a shell utility, an +inferior process, an http server, etc. In contrast to the usual +case where a rich variety of styles do different types of pattern +matching on the full set of potential candidates, here it's the +tool who does all the matching. The advantage of this style is +that the full set of candidates doesn't need to be transferred to +Emacs's address space, potentially slowing it down. + +LOOKUP is a function taking (PATTERN POINT). The function should +contact the backend and return a list of strings representing the +candidates matching the string PATTERN given that POINT is the +location of point within it. The candidate strings may be +propertized with `completions-common-part' to illustrate how the +backend interpreted PATTERN. To maintain responsiveness in the +face of all but the spiffiest external tools, LOOKUP should +detect timeouts and user input with `while-no-input' or +`sit-for' (which see), cancel the request if possible and +immediately return any non-list. + +CATEGORY is a symbol identifying the external tool. METADATA is +an alist of additional properties such as `cycle-sort-function' +to associate with CATEGORY. This means that the caller may still +want to control the sorting of the candidates while the tool +controls the matching. + +TRY-COMPLETION-FUNCTION is an poorly understood implementation +detail. If you understand what it's for, great! It's a function +taking a (STRING POINT) as arguments. The default is to set to +`cons' which returns the arguments as a cons cell." + (unless (assq category completion-category-defaults) + (push `(,category (styles external-completion-style)) + completion-category-defaults)) + (lambda (string pred action) + (pcase action + (`metadata + `(metadata (category . ,category) . ,metadata)) + (`(external-completion-tryc . ,point) + ;; FIXME: Obey `pred'? Pass it to `try-completion-function'? + `(external-completion-tryc + . ,(funcall (or try-completion-function #'cons) string point))) + (`(external-completion-allc . ,point) + (let ((all (funcall lookup string point))) + `(external-completion-allc . ,(if pred (seq-filter pred all) all)))) + (`(boundaries . ,_) nil) + (_ + (let ((all (funcall lookup string (length string)))) + (complete-with-action action all string pred)))))) + +;; 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. +(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 diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5918483641c..7fe6fd6b2d7 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -7,7 +7,7 @@ ;; Maintainer: João Távora ;; 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") (backend-completion "0.1")) +;; 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,7 +110,7 @@ (require 'filenotify) (require 'ert) (require 'array) -(require 'backend-completion) +(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 @@ -2566,7 +2566,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))) @@ -2574,18 +2574,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))) - (`(backend-completion-tryc . ,point) - `(backend-completion-tryc . (,string . ,point))) - (`(backend-completion-allc . ,_point) - `(backend-completion-allc . ,(lookup string))) - (_ nil)))))) + (external-completion-table + #'lookup + 'eglot-indirection-joy + `((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." -- 2.39.5