consult-eglot.el (8573B)
1 ;;; consult-eglot.el --- A consulting-read interface for eglot -*- lexical-binding: t; -*- 2 3 ;; Licence: MIT 4 ;; Keywords: tools, completion, lsp 5 ;; Package-Version: 0.2.0 6 ;; Package-Commit: 0da8801dd8435160ce1f62ad8066bd52e38f5cbd 7 ;; Author: mohsin kaleem <mohkale@kisara.moe> 8 ;; Maintainer: Mohsin Kaleem 9 ;; Version: 0.2 10 ;; Package-Requires: ((emacs "27.1") (eglot "1.7") (consult "0.16") (project "0.3.0")) 11 ;; Homepage: https://github.com/mohkale/consult-eglot 12 13 ;; Copyright (c) 2021 Mohsin Kaleem 14 15 ;; Permission is hereby granted, free of charge, to any person obtaining a copy 16 ;; of this software and associated documentation files (the "Software"), to deal 17 ;; in the Software without restriction, including without limitation the rights 18 ;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 19 ;; copies of the Software, and to permit persons to whom the Software is 20 ;; furnished to do so, subject to the following conditions: 21 22 ;; The above copyright notice and this permission notice shall be included in all 23 ;; copies or substantial portions of the Software. 24 25 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 26 ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 27 ;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 28 ;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 29 ;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 30 ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 31 ;; SOFTWARE. 32 33 ;;; Commentary: 34 35 ;; Query workspace symbol from eglot using consult. 36 ;; 37 ;; This package provides a single command `consult-eglot-symbols' that uses the 38 ;; lsp workspace/symbol procedure to get a list of symbols exposed in the current 39 ;; workspace. This differs from the default document/symbols call, that eglot 40 ;; exposes through imenu, in that it can present symbols from multiple open files 41 ;; or even files not indirectly loaded by an open file but still used by your 42 ;; project. 43 ;; 44 ;; This code was partially adapted from the excellent consult-lsp package. 45 46 ;;; Code: 47 48 (require 'eglot) 49 (require 'consult) 50 51 (defgroup consult-eglot nil 52 "Consulting-read for eglot." 53 :prefix "consult-eglot" 54 :group 'completion 55 :group 'eglot 56 :group 'consult) 57 58 (defcustom consult-eglot-ignore-column nil 59 "When true `consult-eglot-symbols' only jumps to start of symbols line. 60 Otherwise `consult-eglot-symbols' will go to the exact symbol of a matched 61 candidate." 62 :type 'boolean) 63 64 (defcustom consult-eglot-narrow 65 '(;; Lowercase classes 66 (?c . "Class") 67 (?f . "Function") 68 (?e . "Enum") 69 (?i . "Interface") 70 (?m . "Module") 71 (?n . "Namespace") 72 (?p . "Package") 73 (?s . "Struct") 74 (?t . "Type Parameter") 75 (?v . "Variable") 76 77 ;; Uppercase classes 78 (?A . "Array") 79 (?B . "Boolean") 80 (?C . "Constant") 81 (?E . "Enum Member") 82 (?F . "Field") 83 (?M . "Method") 84 (?N . "Number") 85 (?O . "Object") 86 (?P . "Property") 87 (?S . "String") 88 89 ;; Other. Any which aren't above are taken from here 90 (?o . "Other")) 91 "Narrow key configuration used with `consult-eglot-symbols'. 92 For the format see `consult--read', for the value types see the 93 values in `eglot--symbol-kind-names'." 94 :type '(alist :key-type character :value-type string)) 95 96 (defcustom consult-eglot-show-kind-name t 97 "When true prefix completion candidates with their type." 98 :type 'boolean) 99 100 (defun consult-eglot--make-async-source (async server) 101 "Search for symbols in a consult ASYNC source. 102 Pipe a `consult--read' compatible async-source ASYNC to search for 103 symbols in the workspace tied to SERVER." 104 (lambda (action) 105 (pcase-exhaustive action 106 ((or 'setup (pred stringp)) 107 (let ((query (if (stringp action) action ""))) 108 (jsonrpc-async-request 109 server :workspace/symbol 110 `(:query ,query) 111 :success-fn 112 (lambda (resp) 113 (funcall async 'flush) 114 (funcall async (append resp nil))) 115 :error-fn 116 (eglot--lambda ((ResponseError) code message) 117 (message "%s: %s" code message)) 118 :timeout-fn 119 (lambda () 120 (message "error: request timed out"))) 121 (funcall async action))) 122 (_ (funcall async action))))) 123 124 (defun consult-eglot--transformer (symbol-info) 125 "Default transformer to produce a completion candidate from SYMBOL-INFO. 126 The produced candidate follows the same form as `consult--grep' however it 127 contains the SYMBOL-INFO as the second field instead of the file URI." 128 (eglot--dbind ((SymbolInformation) name kind location) 129 symbol-info 130 (eglot--dbind ((Location) uri range) location 131 (let* ((line (1+ (plist-get (plist-get range :start) :line))) 132 (kind-name (alist-get kind eglot--symbol-kind-names)) 133 (uri-path (eglot--uri-to-path uri))) 134 (propertize 135 (concat 136 (when consult-eglot-show-kind-name 137 (format "%-7s " kind-name)) 138 name 139 " " 140 (string-remove-suffix ":" 141 (consult--format-location 142 ;; If the src is relative to our project directory then use 143 ;; the path from there, otherwise use the absolute file path. 144 (let ((relative-uri-path (file-relative-name uri-path))) 145 (if (string-prefix-p ".." relative-uri-path) 146 (abbreviate-file-name uri-path) 147 relative-uri-path)) 148 line))) 149 'consult--type (or (car (rassoc kind-name consult-eglot-narrow)) 150 (car (rassoc "Other" consult-eglot-narrow))) 151 'consult--candidate symbol-info))))) 152 153 (defun consult-eglot--symbol-information-to-grep-params (symbol-info) 154 "Extract grep parameters from SYMBOL-INFO." 155 (eglot--dbind ((SymbolInformation) location) symbol-info 156 (eglot--dbind ((Location) uri range) location 157 (list 158 (eglot--uri-to-path uri) ; URI 159 (1+ (plist-get (plist-get range :start) :line)) ; Line number 160 ; Column Number 161 (or 162 (and (not consult-eglot-ignore-column) 163 (plist-get (plist-get range :start) :character)) 164 0))))) 165 166 (defun consult-eglot--state () 167 "State function for `consult-eglot-symbols' to preview candidates. 168 This is mostly just a copy-paste of `consult--grep-state' except it doesn't 169 rely on regexp matching to extract the relevent file and column fields." 170 (let ((open (consult--temporary-files)) 171 (jump (consult--jump-state))) 172 (lambda (action cand) 173 (when (eq action 'exit) 174 (funcall open) 175 (setq open nil)) 176 (funcall jump 177 action 178 (and cand 179 (pcase-let 180 ((`(,file ,line ,col) 181 (consult-eglot--symbol-information-to-grep-params cand))) 182 (consult--position-marker 183 (funcall (or open #'find-file) file) 184 line col))))))) 185 186 ;;;###autoload 187 (defun consult-eglot-symbols () 188 "Interactively select a symbol from the current workspace." 189 (interactive) 190 ;; Set `default-directory' here so we can show file names 191 ;; relative to the project root. 192 (let* ((server (eglot--current-server-or-lose)) 193 (default-directory (or (project-root (eglot--project server)) 194 default-directory))) 195 (if (eglot--server-capable :workspaceSymbolProvider) 196 (progn 197 (consult--read 198 (thread-first 199 (consult--async-sink) 200 (consult--async-refresh-immediate) 201 (consult--async-map #'consult-eglot--transformer) 202 (consult-eglot--make-async-source server) 203 (consult--async-throttle) 204 (consult--async-split)) 205 :history t 206 :require-match t 207 :prompt "LSP Symbols: " 208 :initial (consult--async-split-initial nil) 209 :category 'consult-lsp-symbols 210 :lookup #'consult--lookup-candidate 211 :group (consult--type-group consult-eglot-narrow) 212 :narrow (consult--type-narrow consult-eglot-narrow) 213 :state (consult-eglot--state)) 214 (run-hooks 'consult-after-jump-hook)) 215 (user-error "Server doesn't support symbol search")))) 216 217 (provide 'consult-eglot) 218 ;;; consult-eglot.el ends here