;; Copyright (C) 2016-2018 Vibhav Pant <vibhavp@gmail.com> -*- lexical-binding: t -*-
;; 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 <http://www.gnu.org/licenses/>.
(require 'cl-lib)
(require 'json)
(require 'xref)
(require 'subr-x)
(require 'widget)
(require 'lsp-io)
(require 'lsp-common)
(require 'pcase)
(require 'inline)
(require 'em-glob)
(defconst lsp--file-change-type
`((created . 1)
(changed . 2)
(deleted . 3)))
;; A ‘lsp--client’ object describes the client-side behavior of a language
;; server. It is used to start individual server processes, each of which is
;; represented by a ‘lsp--workspace’ object. Client objects are normally
;; created using ‘lsp-define-stdio-client’ or ‘lsp-define-tcp-client’. Each
;; workspace refers to exactly one client, but there can be multiple workspaces
;; for a single client.
(cl-defstruct lsp--client
;; ‘language-id’ is a function that receives a buffer as a single argument
;; and should return the language identifier for that buffer. See
;; https://microsoft.github.io/language-server-protocol/specification#textdocumentitem
;; for a list of language identifiers. Also consult the documentation for
;; the language server represented by this client to find out what language
;; identifiers it supports or expects.
(language-id nil :read-only t)
;; send-async and send-sync are unused field, but haven't been
;; removed so as to avoid breaking byte-compiled clients.
;; FIXME: We shouldn’t need to take binary compatibility into account,
;; especially since the ‘lsp--client’ structure is internal. These fields
;; should just be removed.
(send-sync nil :read-only t)
(send-async nil :read-only t)
;; FIXME: This field is apparently unused and should be removed.
(type nil :read-only t)
;; ‘new-connection’ is a function that should start a language server process
;; and return a cons (COMMAND-PROCESS . COMMUNICATION-PROCESS).
;; COMMAND-PROCESS must be a process object representing the server process
;; just started. COMMUNICATION-PROCESS must be a process (including pipe and
;; network processes) that ‘lsp-mode’ uses to communicate with the language
;; server using the language server protocol. COMMAND-PROCESS and
;; COMMUNICATION-PROCESS may be the same process; in that case
;; ‘new-connection’ may also return that process as a single
;; object. ‘new-connection’ is called with two arguments, FILTER and
;; SENTINEL. FILTER should be used as process filter for
;; COMMUNICATION-PROCESS, and SENTINEL should be used as process sentinel for
;; COMMAND-PROCESS.
(new-connection nil :read-only t)
;; ‘stderr’ is the name of a buffer to write the standard error to.
;; FIXME: ‘stderr’ should be the actual buffer, and it should be a field of
;; the ‘lsp--workspace’.
(stderr nil :read-only t)
;; ‘get-root’ is a function that should return the workspace root directory
;; for the current buffer. It may return either a directory name or a
;; directory file name. The ‘get-root’ function is called without arguments.
;; ‘lsp-mode’ will start one server process per client and root directory.
;; It passes the root directory to the ‘initialize’ method of the language
;; server; see
;; https://microsoft.github.io/language-server-protocol/specification#initialize.
;; Also consult the documentation of your language server for information
;; about what it expects as workspace root.
(get-root nil :read-only t)
;; ‘ignore-regexps’ is a list of regexps. When a data packet from the
;; language server matches any of these regexps, it will be ignored. This is
;; intended for dealing with language servers that output non-protocol data.
(ignore-regexps nil :read-only t)
;; ‘ignore-messages’ is a list of regexps. When a message from the language
;; server matches any of these regexps, it will be ignored. This is useful
;; for filtering out unwanted messages; such as servers that send nonstandard
;; message types, or extraneous log messages.
(ignore-messages nil :read-only t)
;; ‘notification-handlers’ is a hash table mapping notification method names
;; (strings) to functions handling the respective notifications. Upon
;; receiving a notification, ‘lsp-mode’ will call the associated handler
;; function passing two arguments, the ‘lsp--workspace’ object and the
;; deserialized notification parameters.
(notification-handlers (make-hash-table :test 'equal) :read-only t)
;; ‘request-handlers’ is a hash table mapping request method names
;; (strings) to functions handling the respective notifications. Upon
;; receiving a request, ‘lsp-mode’ will call the associated handler function
;; passing two arguments, the ‘lsp--workspace’ object and the deserialized
;; request parameters.
(request-handlers (make-hash-table :test 'equal) :read-only t)
;; ‘response-handlers’ is a hash table mapping integral JSON-RPC request
;; identifiers for pending asynchronous requests to functions handling the
;; respective responses. Upon receiving a response from the language server,
;; ‘lsp-mode’ will call the associated response handler function with a
;; single argument, the deserialized response parameters.
(response-handlers (make-hash-table :test 'eql) :read-only t)
;; ‘string-renderers’ is an alist mapping MarkedString language identifiers
;; (see
;; https://microsoft.github.io/language-server-protocol/specification#textDocument_hover)
;; to functions that can render the respective languages. The rendering
;; functions are called with a single argument, the MarkedString value. They
;; should return a propertized string with the rendered output.
(string-renderers '())
;; ‘last-id’ is the last JSON-RPC identifier used.
;; FIXME: ‘last-id’ should be in ‘lsp--workspace’.
(last-id 0)
;; Function to enable the client for the current buffer, called without
;; arguments.
(enable-function nil :read-only t)
;; ‘prefix-function’ is called for getting the prefix for completion.
;; The function takes no parameter and returns a cons (start . end) representing
;; the start and end bounds of the prefix. If it's not set, the client uses a
;; default prefix function."
(prefix-function nil :read-only t)
;; Contains mapping of scheme to the function that is going to be used to load
;; the file.
(uri-handlers (make-hash-table :test #'equal) :read-only t)
;; ‘action-handlers’ is a hash table mapping action to a handler function. It
;; can be used in `lsp-execute-code-action' to determine whether the action
;; current client is interested in executing the action instead of sending it
;; to the server.
(action-handlers (make-hash-table :test 'equal) :read-only t)
;; ‘default-renderer’ is the renderer that is going to be used when there is
;; no concrete "language" specified for the current MarkedString. (see
;; https://microsoft.github.io/language-server-protocol/specification#textDocument_hover)
(default-renderer nil))
(cl-defstruct lsp--registered-capability
(id "" :type string)
(method " " :type string)
(options nil))
;; A ‘lsp--workspace’ object represents exactly one language server process.
(cl-defstruct lsp--workspace
;; ‘parser’ is a ‘lsp--parser’ object used to parse messages for this
;; workspace. Parsers are not shared between workspaces.
(parser nil :read-only t)
;; ‘file-versions’ is a hashtable of files "owned" by the workspace. It maps
;; file names to file versions. See
;; https://microsoft.github.io/language-server-protocol/specification#versionedtextdocumentidentifier.
(file-versions nil :read-only t)
;; ‘server-capabilities’ is a hash table of the language server capabilities.
;; It is the hash table representation of a LSP ServerCapabilities structure;
;; cf. https://microsoft.github.io/language-server-protocol/specification#initialize.
(server-capabilities nil)
;; ‘registered-server-capabilities’ is a list of hash tables that represent
;; dynamically-registered Registration objects. See
;; https://microsoft.github.io/language-server-protocol/specification#client_registerCapability.
(registered-server-capabilities nil)
;; ‘root’ is a directory name or a directory file name for the workspace
;; root. ‘lsp-mode’ passes this directory to the ‘initialize’ method of the
;; language server; see
;; https://microsoft.github.io/language-server-protocol/specification#initialize.
(root nil :ready-only t)
;; ‘client’ is the ‘lsp--client’ object associated with this workspace.
(client nil :read-only t)
;; FIXME: ‘change-timer-disabled’ is unused and should be removed.
(change-timer-disabled nil)
;; ‘proc’ is a process object; it may represent a regular process, a pipe, or
;; a network connection. ‘lsp-mode’ communicates with ‘proc’ using the
;; language server protocol. ‘proc’ corresponds to the COMMUNICATION-PROCESS
;; element of the return value of the client’s ‘get-root’ field, which see.
(proc nil)
;; ‘proc’ is a process object; it must represent a regular process, not a
;; pipe or network process. It represents the actual server process that
;; corresponds to this workspace. ‘cmd-proc’ corresponds to the
;; COMMAND-PROCESS element of the return value of the client’s ‘get-root’
;; field, which see.
(cmd-proc nil)
;; ‘buffers’ is a list of buffers associated with this workspace.
(buffers nil)
;; ‘highlight-overlays’ is a hash table mapping buffers to a list of overlays
;; used for highlighting the symbol under point.
(highlight-overlays (make-hash-table :test 'eq) :read-only t)
;; Extra client capabilities provided by third-party packages using
;; `lsp-register-client-capabilities'. It's value is an alist of (PACKAGE-NAME
;; . CAPS), where PACKAGE-NAME is a symbol of the third-party package name,
;; and CAPS is either a plist of the client capabilities, or a function that
;; takes no argument and returns a plist of the client capabilities or nil.")
(extra-client-capabilities nil)
;; Workspace status
(status nil)
;; ‘metadata’ is a generic storage for workspace specific data. It is
;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata'
(metadata (make-hash-table :test 'equal))
;; contains all the file notification watches that have been created for the
;; current workspace in format filePath->file notification handle.
(watches (make-hash-table :test 'equal)))
(defvar lsp--workspaces (make-hash-table :test #'equal)
"Table of known workspaces, indexed by the project root directory.")
(defvar lsp--ignored-workspace-roots (make-hash-table :test #'equal)
"Table of project roots which should not have a workspace,
indexed by the project root directory.
This is populated when the user declines to open a workspace
for a file in the workspace.")
(defcustom lsp-render-markdown-markup-content nil
"Function to be use for rendering MarkupContent.
It should take two arguments - a string denoting the type of markup content
and a string containing the text to be rendered. The returned value should
be a string that may be fontified/propertized.
When nil, MarkupContent is rendered as plain text."
:type 'function
:group 'lsp-mode)
(defcustom lsp-before-initialize-hook nil
"List of functions to be called before a Language Server has been initialized
for a new workspace."
:type 'hook
:group 'lsp-mode)
(defcustom lsp-after-initialize-hook nil
"List of functions to be called after a Language Server has been initialized
for a new workspace."
:type 'hook
:group 'lsp-mode)
(defcustom lsp-before-open-hook nil
"List of functions to be called before a new file with LSP support is opened."
:type 'hook
:group 'lsp-mode)
(defcustom lsp-after-open-hook nil
"List of functions to be called after a new file with LSP support is opened."
:type 'hook
:group 'lsp-mode)
(defvar lsp--sync-methods
'((0 . none)
(1 . full)
(2 . incremental)))
(defvar-local lsp--server-sync-method nil
"Sync method recommended by the server.")
;;;###autoload
(defgroup lsp-mode nil
"Customization group for ‘lsp-mode’."
:group 'tools)
;;;###autoload
(defgroup lsp-faces nil
"Faces for ‘lsp-mode’."
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-document-sync-method nil
"How to sync the document with the language server."
:type '(choice (const :tag "Documents should not be synced at all." 'none)
(const :tag "Documents are synced by always sending the full content of the document." 'full)
(const :tag "Documents are synced by always sending incremental changes to the document." 'incremental)
(const :tag "Use the method recommended by the language server." nil))
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-project-blacklist nil
"A list of project directory regexps for which LSP shouldn't be initialized.
LSP should be initialized if the given project root matches one pattern in the
whitelist, or does not match any pattern in the blacklist."
:type '(repeat regexp)
:group 'lsp-mode)
(defcustom lsp-project-whitelist nil
"A list of project directory regexps for which LSP should be initialized."
:type '(repeat regexp)
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-enable-eldoc t
"Enable `eldoc-mode' integration."
:type 'boolean
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-eldoc-render-all t
"Define whether all of the returned by document/onHover will be displayed.
If `lsp-markup-display-all' is set to nil `eldoc' will show only
the symbol information."
:type 'boolean
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-highlight-symbol-at-point t
"Highlight the symbol under the point."
:type 'boolean
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-enable-codeaction t
"Enable code action processing."
:type 'boolean
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-enable-completion-at-point t
"Enable `completion-at-point' integration."
:type 'boolean
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-enable-xref t
"Enable xref integration."
:type 'boolean
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-enable-indentation t
"Indent regions using the file formatting functionality provided by the language server."
:type 'boolean
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-before-save-edits t
"If non-nil, `lsp-mode' will apply edits suggested by the language server
before saving a document."
:type 'boolean
:group 'lsp-mode)
;;;###autoload
(defcustom lsp-hover-text-function 'lsp--text-document-hover-string
"The LSP method to use to display text on hover."
:type '(choice (function :tag "textDocument/hover"
lsp--text-document-hover-string)
(function :tag "textDocument/signatureHelp"
lsp--text-document-signature-help))
:group 'lsp-mode)
;;;###autoload
(defface lsp-face-highlight-textual
'((((background dark)) :background "saddle brown")
(((background light)) :background "yellow"))
"Face used for textual occurances of symbols."
:group 'lsp-faces)
;;;###autoload
(defface lsp-face-highlight-read
'((((background dark)) :background "firebrick")
(((background light)) :background "red"))
"Face used for highlighting symbols being read."
:group 'lsp-faces)
;;;###autoload
(defface lsp-face-highlight-write
'((((background dark)) :background "sea green")
(((background light)) :background "green"))
"Face used for highlighting symbols being written to."
:group 'lsp-faces)
(defun lsp-client-register-uri-handler (client scheme handler)
(cl-check-type client lsp--client)
(cl-check-type scheme string)
(cl-check-type handler function)
(puthash scheme handler (lsp--client-uri-handlers client)))
(defun lsp-client-on-notification (client method callback)
(cl-check-type client lsp--client)
(cl-check-type method string)
(cl-check-type callback function)
(puthash method callback (lsp--client-notification-handlers client)))
(defun lsp-client-on-request (client method callback)
(cl-check-type client lsp--client)
(cl-check-type method string)
(cl-check-type callback function)
(puthash method callback (lsp--client-request-handlers client)))
(defun lsp-client-on-action (client method callback)
(cl-check-type client lsp--client)
(cl-check-type method string)
(cl-check-type callback function)
(puthash method callback (lsp--client-action-handlers client)))
(defun lsp-workspace-set-metadata (key value &optional workspace)
"Associate KEY with VALUE in the WORKSPACE metadata.
If WORKSPACE is not provided current workspace will be used."
(puthash key value (lsp--workspace-metadata (or workspace lsp--cur-workspace))))
(defun lsp-workspace-get-metadata (key &optional workspace)
"Lookup KEY in WORKSPACE metadata.
If WORKSPACE is not provided current workspace will be used."
(gethash key (lsp--workspace-metadata (or workspace lsp--cur-workspace))))
(define-inline lsp--make-request (method &optional params)
"Create request body for method METHOD and parameters PARAMS."
(inline-quote
(plist-put (lsp--make-notification ,method ,params)
:id (cl-incf (lsp--client-last-id (lsp--workspace-client lsp--cur-workspace))))))
(defun lsp-make-request (method &optional params)
"Create request body for method METHOD and parameters PARAMS."
(lsp--make-request method params))
(defun lsp--make-response-error (code message data)
(cl-check-type code number)
(cl-check-type message string)
`(:code ,code :message ,message :data ,data))
(defun lsp--make-response (id result error)
(cl-check-type error list)
`(:jsonrpc "2.0" :id ,id :result ,result :error ,error))
(define-inline lsp--make-notification (method &optional params)
"Create notification body for method METHOD and parameters PARAMS."
(inline-quote
(progn (cl-check-type ,method string)
(list :jsonrpc "2.0" :method ,method :params ,params))))
;; Define non-inline public aliases to avoid breaking binary compatibility.
(defun lsp-make-notification (method &optional params)
"Create notification body for method METHOD and parameters PARAMS."
(lsp--make-notification method params))
(define-inline lsp--make-message (params)
"Create a LSP message from PARAMS, after encoding it to a JSON string."
(inline-quote
(let* ((json-encoding-pretty-print lsp-print-io)
(json-false :json-false)
(body (json-encode ,params)))
(format "Content-Length: %d\r\n\r\n%s" (string-bytes body) body))))
(define-inline lsp--send-notification (body)
"Send BODY as a notification to the language server."
(inline-quote
(lsp--send-no-wait
(lsp--make-message ,body)
(lsp--workspace-proc lsp--cur-workspace))))
(defun lsp-send-notification (body)
"Send BODY as a notification to the language server."
(lsp--send-notification body))
(define-inline lsp--cur-workspace-check ()
(inline-quote
(progn
(cl-assert lsp--cur-workspace nil
"No language server is associated with this buffer.")
(cl-assert (lsp--workspace-p lsp--cur-workspace)))))
(define-inline lsp--cur-parser ()
(inline-quote (lsp--workspace-parser lsp--cur-workspace)))
(defun lsp--send-request (body &optional no-wait)
"Send BODY as a request to the language server, get the response.
If NO-WAIT is non-nil, don't synchronously wait for a response."
(let* ((parser (lsp--cur-parser))
(message (lsp--make-message body))
(process (lsp--workspace-proc lsp--cur-workspace)))
(setf (lsp--parser-waiting-for-response parser) (not no-wait))
(if no-wait
(lsp--send-no-wait message process)
(lsp--send-wait message process parser))
(when (not no-wait)
(prog1 (lsp--parser-response-result parser)
(setf (lsp--parser-response-result parser) nil)))))
(defalias 'lsp-send-request 'lsp--send-request
"Send BODY as a request to the language server and return the response synchronously.
\n(fn BODY)")
(defun lsp--send-request-async (body callback)
"Send BODY as a request to the language server, and call CALLBACK with
the response recevied from the server asynchronously."
(let ((client (lsp--workspace-client lsp--cur-workspace))
(id (plist-get body :id)))
(cl-assert id nil "body missing id field")
(puthash id callback (lsp--client-response-handlers client))
(lsp--send-no-wait (lsp--make-message body)
(lsp--workspace-proc lsp--cur-workspace))
body))
(defalias 'lsp-send-request-async 'lsp--send-request-async)
(define-inline lsp--inc-cur-file-version ()
(inline-quote (cl-incf (gethash (current-buffer)
(lsp--workspace-file-versions lsp--cur-workspace)))))
(define-inline lsp--cur-file-version ()
"Return the file version number. If INC, increment it before."
(inline-quote
(gethash (current-buffer) (lsp--workspace-file-versions lsp--cur-workspace))))
(define-inline lsp--make-text-document-item ()
"Make TextDocumentItem for the currently opened file.
interface TextDocumentItem {
uri: string; // The text document's URI
languageId: string; // The text document's language identifier.
version: number;
text: string;
}"
(inline-quote
(let ((language-id-fn (lsp--client-language-id (lsp--workspace-client lsp--cur-workspace))))
(list :uri (lsp--buffer-uri)
:languageId (funcall language-id-fn (current-buffer))
:version (lsp--cur-file-version)
:text (buffer-substring-no-properties (point-min) (point-max))))))
;; Clean up the entire state of lsp mode when Emacs is killed, to get rid of any
;; pending language servers.
(add-hook 'kill-emacs-hook #'lsp--global-teardown)
(defun lsp--global-teardown ()
(with-demoted-errors "Error in ‘lsp--global-teardown’: %S"
(maphash (lambda (_k value) (lsp--teardown-workspace value)) lsp--workspaces)))
(defun lsp--teardown-workspace (workspace)
(setq lsp--cur-workspace workspace)
(lsp--shutdown-cur-workspace))
(defun lsp--shutdown-cur-workspace ()
"Shut down the language server process for ‘lsp--cur-workspace’."
(with-demoted-errors "LSP error: %S"
(lsp--send-request (lsp--make-request "shutdown" (make-hash-table)) t)
(lsp--send-notification (lsp--make-notification "exit" nil)))
(lsp--uninitialize-workspace))
(defun lsp--uninitialize-workspace ()
"When a workspace is shut down, by request or from just
disappearing, unset all the variables related to it."
(lsp-kill-watch (lsp--workspace-watches lsp--cur-workspace))
(let (proc
(root (lsp--workspace-root lsp--cur-workspace)))
(with-current-buffer (current-buffer)
(setq proc (lsp--workspace-proc lsp--cur-workspace))
(if (process-live-p proc)
(kill-process (lsp--workspace-proc lsp--cur-workspace)))
(setq lsp--cur-workspace nil)
(lsp--unset-variables)
(kill-local-variable 'lsp--cur-workspace))
(remhash root lsp--workspaces)))
(defun lsp-restart-workspace ()
"Shut down and then restart the current workspace.
This involves uninitializing each of the buffers associated with
the workspace, closing the process managing communication with
the client, and then starting up again."
(interactive)
(when (and (lsp-mode) (buffer-file-name) lsp--cur-workspace)
(let ((old-buffers (lsp--workspace-buffers lsp--cur-workspace))
(restart (lsp--client-enable-function (lsp--workspace-client lsp--cur-workspace)))
(proc (lsp--workspace-proc lsp--cur-workspace)))
(lsp--remove-cur-overlays)
;; Shut down the LSP mode for each buffer in the workspace
(dolist (buffer old-buffers)
(with-current-buffer buffer
(lsp--text-document-did-close)
(setq lsp--cur-workspace nil)
(lsp-mode -1)))
;; Let the process actually shut down
(while (process-live-p proc)
(accept-process-output proc))
;; Re-enable LSP mode for each buffer
(dolist (buffer old-buffers)
(with-current-buffer buffer
(funcall restart))))))
;; NOTE: Possibly make this function subject to a setting, if older LSP servers
;; are unhappy
(defun lsp--client-capabilities ()
"Return the client capabilites."
(apply #'lsp--merge-plists
`(:workspace ,(lsp--client-workspace-capabilities)
:textDocument ,(lsp--client-textdocument-capabilities))
(seq-map (lambda (extra-capabilities-cons)
(let* ((package-name (car extra-capabilities-cons))
(value (cdr extra-capabilities-cons))
(capabilities (if (functionp value) (funcall value)
value)))
(if (and capabilities (not (listp capabilities)))
(progn
(message "Capabilities provided by %s are not a plist: %s" package-name value)
nil)
capabilities)))
(lsp--workspace-extra-client-capabilities lsp--cur-workspace))))
(defun lsp--merge-plists (first &rest rest)
"Deeply merge plists.
FIRST is the plist to be merged into. The rest of the arguments
can be either plists or nil. The non-nil plists in the rest of
the arguments will be merged into FIRST.
Return the merged plist."
(cl-check-type first list)
(seq-each
(lambda (pl) (setq first (lsp--merge-two-plists first pl)))
rest)
first)
(defun lsp--merge-two-plists (first second)
"Deeply merge two plists.
All values in SECOND are merged into FIRST. FIRST can be nil or
a plist. SECOND must be a plist.
Return the merged plist."
(when second
(if (not (listp second))
(warn "Cannot merge non-list value into a plist. The value is %s" second)
(cl-loop for (key second-value) on second
collect (progn
(let ((first-value (plist-get first key))
merged-value)
(cond
((null second-value)) ; do nothing
((null first-value)
(if (listp second-value)
;; Deep copy second-value so that the original value won't
;; be modified.
(setq merged-value
(lsp--merge-two-plists nil second-value)))
(setq merged-value second-value))
((and (listp first-value) (listp second-value))
(setq merged-value (lsp--merge-two-plists first-value second-value)))
;; Otherwise, the first value is a leaf entry and should
;; not be overridden.
)
(when merged-value
(setq first (plist-put first key merged-value))))))))
first)
(defun lsp--server-register-capability (reg)
(lsp--cur-workspace-check)
(let ((method (gethash "method" reg)))
(push
(make-lsp--registered-capability
:id (gethash "id" reg)
:method method
:options (gethash "registerOptions" reg))
(lsp--workspace-registered-server-capabilities lsp--cur-workspace))))
(defun lsp--server-unregister-capability (unreg)
(let* ((id (gethash "id" unreg))
(fn (lambda (e) (equal (lsp--registered-capability-id e) id))))
(setf (lsp--workspace-registered-server-capabilities lsp--cur-workspace)
(seq-remove fn
(lsp--workspace-registered-server-capabilities lsp--cur-workspace)))))
(defun lsp--client-workspace-capabilities ()
"Client Workspace capabilities according to LSP."
`(:applyEdit t
:executeCommand (:dynamicRegistration t)))
(defun lsp--client-textdocument-capabilities ()
"Client Text document capabilities according to LSP."
`(:synchronization (:willSave t :didSave t :willSaveWaitUntil t)
:symbol (:symbolKind (:valueSet ,(cl-coerce (cl-loop for kind from 1 to 25 collect kind) 'vector)))
:formatting (:dynamicRegistration t)
:codeAction (:dynamicRegistration t)))
(defun lsp-register-client-capabilities (package-name caps)
"Register extra client capabilities for the current workspace.
This function must be called before the initialize request is
sent. It's recommended to to call it in the
`lsp-before-initialize-hook'.
PACKAGE name is the symbol of the name of the package that
registers the capabilities. CAPS is either a plist of the
capabilities, or a function that takes no argument and return a
plist of the client capabilties or nil.
Registered capabilities are merged into the default capabilities
before sending to the server via the initialize request. If two
packages provide different values for the same leaf capability
entry, the value is set to the one that registers later. Default
leaf capability entries can not be overwritten."
(lsp--cur-workspace-check)
(cl-check-type package-name symbolp)
(cl-check-type caps (or list function))
(let ((extra-client-capabilities
(lsp--workspace-extra-client-capabilities lsp--cur-workspace)))
(if (alist-get package-name extra-client-capabilities)
(message "%s has already registered client capabilities" package-name)
(push `(,package-name . ,caps)
(lsp--workspace-extra-client-capabilities lsp--cur-workspace)))))
(defun lsp-unregister-client-capabilities (package-name)
"Unregister extra capabilities provided by PACKAGE-NAME for the current workspace.
PACKAGE-NAME is a symbol of the name of the package that has
registered client capabilities by calling
`lsp-register-client-capabilities'."
(lsp--cur-workspace-check)
(cl-check-type package-name symbol)
(let ((extra-client-capabilities
(lsp--workspace-extra-client-capabilities lsp--cur-workspace)))
(setf (lsp--workspace-extra-client-capabilities lsp--cur-workspace)
(assq-delete-all package-name extra-client-capabilities))))
(define-inline lsp--server-capabilities ()
"Return the capabilities of the language server associated with the buffer."
(inline-quote (lsp--workspace-server-capabilities lsp--cur-workspace)))
(defun lsp--server-has-sync-options-p ()
"Return whether the server has a TextDocumentSyncOptions object in
ServerCapabilities.textDocumentSync."
(hash-table-p (gethash "textDocumentSync" (lsp--server-capabilities))))
(defun lsp--send-open-close-p ()
"Return whether open and close notifications should be sent to the server."
(let ((sync (gethash "textDocumentSync" (lsp--server-capabilities))))
(and (hash-table-p sync)
(gethash "openClose" sync))))
(defun lsp--send-will-save-p ()
"Return whether will save notifications should be sent to the server."
(let ((sync (gethash "textDocumentSync" (lsp--server-capabilities))))
(and (hash-table-p sync)
(gethash "willSave" sync))))
(defun lsp--send-will-save-wait-until-p ()
"Return whether will save wait until notifications should be sent to the server."
(let ((sync (gethash "textDocumentSync" (lsp--server-capabilities))))
(and (hash-table-p sync)
(gethash "willSaveWaitUntil" sync))))
(defun lsp--save-include-text-p ()
"Return whether save notifications should include the text document's contents."
(let ((sync (gethash "textDocumentSync" (lsp--server-capabilities))))
(and (hash-table-p sync)
(hash-table-p (gethash "save" sync nil))
(gethash "includeText" (gethash "save" sync)))))
(defun lsp--set-sync-method ()
(let* ((sync (gethash "textDocumentSync" (lsp--server-capabilities)))
(kind (if (hash-table-p sync) (gethash "change" sync) sync))
(method (alist-get kind lsp--sync-methods)))
(setq lsp--server-sync-method (or lsp-document-sync-method
method))))
(defun lsp--workspace-apply-edit-handler (_workspace params)
(lsp--apply-workspace-edit (gethash "edit" params)))
(defun lsp--make-sentinel (workspace)
(cl-check-type workspace lsp--workspace)
(lambda (process exit-str)
(let ((status (process-status process)))
(when (memq status '(exit signal))
;; Server has exited. Uninitialize all buffer-local state for this
;; workspace.
(message "%s: %s has exited (%s)"
(lsp--workspace-root workspace)
(process-name (lsp--workspace-proc workspace))
(string-trim-right exit-str))
(dolist (buf (lsp--workspace-buffers workspace))
(with-current-buffer buf
(lsp--uninitialize-workspace)))
;; Kill standard error buffer only if the process exited normally.
;; Leave it intact otherwise for debugging purposes.
(when (and (eq status 'exit) (zerop (process-exit-status process)))
;; FIXME: The client structure should store the standard error
;; buffer, not its name.
;; FIXME: Probably the standard error buffer should be per workspace,
;; not per client.
(let ((stderr (get-buffer (lsp--client-stderr
(lsp--workspace-client workspace)))))
(when (buffer-live-p stderr)
(kill-buffer stderr))))))))
(defun lsp--should-start-p (root)
"Consult `lsp-project-blacklist' and `lsp-project-whitelist' to
determine if a server should be started for the given ROOT
directory."
(or
(cl-some (lambda (p) (string-match-p p root))
lsp-project-whitelist)
(cl-notany (lambda (p) (string-match-p p root))
lsp-project-blacklist)))
(defun lsp--start (client &optional extra-init-params)
(when lsp--cur-workspace
(user-error "LSP mode is already enabled for this buffer"))
(cl-assert client)
(let* ((root (file-truename (funcall (lsp--client-get-root client))))
(workspace (gethash root lsp--workspaces))
new-conn response init-params
parser proc cmd-proc)
(if workspace
(progn
(setq lsp--cur-workspace workspace)
(lsp-mode 1))
(setf
parser (make-lsp--parser)
lsp--cur-workspace (make-lsp--workspace
:parser parser
:file-versions (make-hash-table :test 'equal)
:root root
:client client)
(lsp--parser-workspace parser) lsp--cur-workspace
new-conn (funcall
(lsp--client-new-connection client)
(lsp--parser-make-filter parser (lsp--client-ignore-regexps client))
(lsp--make-sentinel lsp--cur-workspace))
;; the command line process invoked
cmd-proc (if (consp new-conn) (car new-conn) new-conn)
;; the process we actually communicate with
proc (if (consp new-conn) (cdr new-conn) new-conn)
(lsp--workspace-proc lsp--cur-workspace) proc
(lsp--workspace-cmd-proc lsp--cur-workspace) cmd-proc)
(puthash root lsp--cur-workspace lsp--workspaces)
(lsp-mode 1)
(run-hooks 'lsp-before-initialize-hook)
(setq init-params
`(:processId ,(emacs-pid)
:rootPath ,root
:rootUri ,(lsp--path-to-uri root)
:capabilities ,(lsp--client-capabilities)
:initializationOptions ,(if (functionp extra-init-params)
(funcall extra-init-params lsp--cur-workspace)
extra-init-params)))
(setf response (lsp--send-request
(lsp--make-request "initialize" init-params)))
(unless response
(signal 'lsp-empty-response-error (list "initialize")))
(setf (lsp--workspace-server-capabilities lsp--cur-workspace)
(gethash "capabilities" response))
;; Version 3.0 now sends an "initialized" notification to allow registration
;; of server capabilities
(lsp--send-notification (lsp--make-notification "initialized" (make-hash-table)))
(run-hooks 'lsp-after-initialize-hook))
(lsp--text-document-did-open)))
(defun lsp--text-document-did-open ()
(run-hooks 'lsp-before-open-hook)
(puthash (current-buffer) 0 (lsp--workspace-file-versions lsp--cur-workspace))
(push (current-buffer) (lsp--workspace-buffers lsp--cur-workspace))
(lsp--send-notification (lsp--make-notification
"textDocument/didOpen"
`(:textDocument ,(lsp--make-text-document-item))))
(add-hook 'after-save-hook #'lsp-on-save nil t)
(add-hook 'kill-buffer-hook #'lsp--text-document-did-close nil t)
(when lsp-enable-eldoc
;; XXX: The documentation for `eldoc-documentation-function' suggests
;; using `add-function' for modifying its value, use that instead?
(setq-local eldoc-documentation-function #'lsp--on-hover)
(eldoc-mode 1))
(when (and lsp-enable-indentation
(lsp--capability "documentRangeFormattingProvider"))
(setq-local indent-region-function #'lsp-format-region))
(when (and lsp-enable-xref
(lsp--capability "referencesProvider")
(lsp--capability "definitionProvider"))
(setq-local xref-backend-functions (list #'lsp--xref-backend)))
(when (and lsp-enable-completion-at-point (lsp--capability "completionProvider"))
(setq-local completion-at-point-functions nil)
(add-hook 'completion-at-point-functions #'lsp-completion-at-point nil t))
;; Make sure the hook is local (last param) otherwise we see all changes for all buffers
(add-hook 'before-change-functions #'lsp-before-change nil t)
(add-hook 'after-change-functions #'lsp-on-change nil t)
(add-hook 'after-revert-hook #'lsp-on-revert nil t)
(add-hook 'before-save-hook #'lsp--before-save nil t)
(add-hook 'auto-save-hook #'lsp--on-auto-save nil t)
(lsp--set-sync-method)
(run-hooks 'lsp-after-open-hook))
(define-inline lsp--text-document-identifier ()
"Make TextDocumentIdentifier.
interface TextDocumentIdentifier {
uri: string;
}"
(inline-quote (list :uri (lsp--buffer-uri))))
(define-inline lsp--versioned-text-document-identifier ()
"Make VersionedTextDocumentIdentifier.
interface VersionedTextDocumentIdentifier extends TextDocumentIdentifier {
version: number;
}"
(inline-quote (plist-put (lsp--text-document-identifier)
:version (lsp--cur-file-version))))
(define-inline lsp--position (line char)
"Make a Position object for the given LINE and CHAR.
interface Position {
line: number;
character: number;
}"
(inline-quote (list :line ,line :character ,char)))
(define-inline lsp--cur-line ()
(inline-quote (1- (line-number-at-pos))))
(define-inline lsp--cur-column ()
(inline-quote (- (point) (line-beginning-position))))
(define-inline lsp--cur-position ()
"Make a Position object for the current point."
(inline-quote
(save-restriction
(widen)
(lsp--position (lsp--cur-line) (lsp--cur-column)))))
(defun lsp--point-to-position (point)
"Convert POINT to Position."
(save-excursion
(goto-char point)
(lsp--cur-position)))
(define-inline lsp--position-p (p)
(inline-quote
(and (numberp (plist-get ,p :line)) (numberp (plist-get ,p :character)))))
(define-inline lsp--range (start end)
"Make Range body from START and END.
interface Range {
start: Position;
end: Position;
}"
;; make sure start and end are Position objects
(inline-quote
(progn
(cl-check-type ,start (satisfies lsp--position-p))
(cl-check-type ,end (satisfies lsp--position-p))
(list :start ,start :end ,end))))
(define-inline lsp--region-to-range (start end)
"Make Range object for the current region."
(inline-quote (lsp--range (lsp--point-to-position ,start)
(lsp--point-to-position ,end))))
(defun lsp--current-region-or-pos ()
"If the region is active return that, else get the point."
(if (use-region-p)
(lsp--region-to-range (region-beginning) (region-end))
(lsp--region-to-range (point) (point))))
(defun lsp--get-start-position ()
"Get the start of the region if active, else current point."
(let ((pos (if (use-region-p)
(region-beginning)
(point))))
(lsp-point-to-position pos)))
(defun lsp--get-end-position ()
"Get the end of the region if active, else current point."
(let ((pos (if (use-region-p)
(region-end)
(point))))
(lsp-point-to-position pos)))
(define-inline lsp--range-start-line (range)
"Return the start line for a given LSP range, in LSP coordinates"
(inline-quote (plist-get (plist-get ,range :start) :line)))
(define-inline lsp--range-end-line (range)
"Return the end line for a given LSP range, in LSP coordinates"
(inline-quote (plist-get (plist-get ,range :end) :line)))
(defun lsp--apply-workspace-edit (edit)
"Apply the WorkspaceEdit object EDIT.
interface WorkspaceEdit {
changes?: { [uri: string]: TextEdit[]; };
documentChanges?: TextDocumentEdit[];
}"
(let ((changes (gethash "changes" edit))
(document-changes (gethash "documentChanges" edit)))
(if document-changes
(seq-do #'lsp--apply-text-document-edit document-changes)
(when (hash-table-p changes)
(maphash
(lambda (uri text-edits)
(let ((filename (lsp--uri-to-path uri)))
(with-current-buffer (find-file-noselect filename)
(lsp--apply-text-edits text-edits))))
changes)))))
(defun lsp--apply-text-document-edit (edit)
"Apply the TextDocumentEdit object EDIT.
If the file is not being visited by any buffer, it is opened with
`find-file-noselect'.
Because lsp-mode does not store previous document versions, the edit is only
applied if the version of the textDocument matches the version of the
corresponding file.
interface TextDocumentEdit {
textDocument: VersionedTextDocumentIdentifier;
edits: TextEdit[];
}"
(let* ((ident (gethash "textDocument" edit))
(filename (lsp--uri-to-path (gethash "uri" ident)))
(version (gethash "version" ident)))
(with-current-buffer (find-file-noselect filename)
(when (and version (= version (lsp--cur-file-version)))
(lsp--apply-text-edits (gethash "edits" edit))))))
(defun lsp--text-edit-sort-predicate (e1 e2)
(let ((start1 (lsp--position-to-point (gethash "start" (gethash "range" e1))))
(start2 (lsp--position-to-point (gethash "start" (gethash "range" e2)))))
(if (= start1 start2)
(let ((end1 (lsp--position-to-point (gethash "end" (gethash "range" e1))))
(end2 (lsp--position-to-point (gethash "end" (gethash "range" e2)))))
(> end1 end2))
(> start1 start2))))
(define-inline lsp--apply-text-edits (edits)
"Apply the edits described in the TextEdit[] object in EDITS."
(inline-quote
;; We sort text edits so as to apply edits that modify earlier parts of the
;; document first. Furthermore, because the LSP spec dictates that:
;; "If multiple inserts have the same position, the order in the array
;; defines which edit to apply first."
;; We reverse the initial list to make sure that the order among edits with
;; the same position is preserved.
(seq-do #'lsp--apply-text-edit (sort (nreverse ,edits) #'lsp--text-edit-sort-predicate))))
(defun lsp--apply-text-edit (text-edit)
"Apply the edits described in the TextEdit object in TEXT-EDIT."
(let* ((range (gethash "range" text-edit))
(start-point (lsp--position-to-point (gethash "start" range)))
(end-point (lsp--position-to-point (gethash "end" range))))
(save-excursion
(goto-char start-point)
(delete-region start-point end-point)
(insert (gethash "newText" text-edit)))))
(define-inline lsp--capability (cap &optional capabilities)
"Get the value of capability CAP. If CAPABILITIES is non-nil, use them instead."
(inline-quote (gethash ,cap (or ,capabilities (lsp--server-capabilities) (make-hash-table)))))
(define-inline lsp--registered-capability (method)
(inline-quote
(seq-find (lambda (reg) (equal (lsp--registered-capability-method reg) ,method))
(lsp--workspace-registered-server-capabilities lsp--cur-workspace)
nil)))
(define-inline lsp--registered-capability-by-id (id)
(inline-quote
(seq-find (lambda (reg) (equal (lsp--registered-capability-id reg) ,id))
(lsp--workspace-registered-server-capabilities lsp--cur-workspace)
nil)))
(defvar-local lsp--before-change-vals nil
"Store the positions from the `lsp-before-change' function
call, for validation and use in the `lsp-on-change' function.")
(defun lsp--text-document-content-change-event (start end length)
"Make a TextDocumentContentChangeEvent body for START to END, of length LENGTH."
;; So (47 54 0) means add 7 chars starting at pos 47
;; must become
;; {"range":{"start":{"line":5,"character":6}
;; ,"end" :{"line":5,"character":6}}
;; ,"rangeLength":0
;; ,"text":"\nbb = 5"}
;;
;; And (47 47 7) means delete 7 chars starting at pos 47
;; must become
;; {"range":{"start":{"line":6,"character":0}
;; ,"end" :{"line":7,"character":0}}
;; ,"rangeLength":7
;; ,"text":""}
;;
;; (208 221 3) means delete 3 chars starting at pos 208, and replace them with
;; 13 chars. So it must become
;; {"range":{"start":{"line":5,"character":8}
;; ,"end" :{"line":5,"character":11}}
;; ,"rangeLength":3
;; ,"text":"new-chars-xxx"}
;;
;; Adding text:
;; lsp-before-change:(start,end)=(33,33)
;; lsp-on-change:(start,end,length)=(33,34,0)
;;
;; Changing text:
;; lsp-before-change:(start,end)=(208,211)
;; lsp-on-change:(start,end,length)=(208,221,3)
;;
;; Deleting text:
;; lsp-before-change:(start,end)=(19,27)
;; lsp-on-change:(start,end,length)=(19,19,8)
(if (eq length 0)
;; Adding something only, work from start only
`(:range ,(lsp--range (lsp--point-to-position start)
(lsp--point-to-position start))
:rangeLength 0
:text ,(buffer-substring-no-properties start end))
(if (eq start end)
;; Deleting something only
(if (lsp--bracketed-change-p start end length)
;; The before-change value is bracketed, use it
`(:range ,(lsp--range (lsp--point-to-position start)
(plist-get lsp--before-change-vals :end-pos))
:rangeLength ,length
:text "")
;; If the change is not bracketed, send a full change event instead.
(lsp--full-change-event))
;; Deleting some things, adding others
(if (lsp--bracketed-change-p start end length)
;; The before-change value is valid, use it
`(:range ,(lsp--range (lsp--point-to-position start)
(plist-get lsp--before-change-vals :end-pos))
:rangeLength ,length
:text ,(buffer-substring-no-properties start end))
(lsp--full-change-event)))))
;; TODO: Add tests for this function.
(defun lsp--bracketed-change-p (start _end length)
"If the before and after positions are the same, and the length
is the size of the start range, we are probably good."
(and (eq start (plist-get lsp--before-change-vals :start) )
(eq length (- (plist-get lsp--before-change-vals :end)
(plist-get lsp--before-change-vals :start)))))
;; Observed from vscode for applying a diff replacing one line with
;; another. Emacs on-change shows this as a delete followed by an
;; add.
;; 2017-04-22 17:43:59 [ThreadId 11] DEBUG haskell-lsp - ---> {"jsonrpc":"2.0","method":"textDocument/didChange","params":
;; {"textDocument":{"uri":"file:///home/alanz/tmp/haskell-hie-test-project/src/Foo.hs","version":2}
;; ,"contentChanges":[{"range":{"start":{"line":7,"character":0}
;; ,"end": {"line":7,"character":8}}
;; ,"rangeLength":8
;; ,"text":"baz ="}]}}
(defun lsp--full-change-event ()
(save-restriction
(widen)
`(:text ,(buffer-substring-no-properties (point-min) (point-max)))))
(defun lsp-before-change (start end)
"Executed before a file is changed.
Added to `before-change-functions'."
;; Note:
;;
;; This variable holds a list of functions to call when Emacs is about to
;; modify a buffer. Each function gets two arguments, the beginning and end of
;; the region that is about to change, represented as integers. The buffer
;; that is about to change is always the current buffer when the function is
;; called.
;;
;; WARNING:
;;
;; Do not expect the before-change hooks and the after-change hooks be called
;; in balanced pairs around each buffer change. Also don't expect the
;; before-change hooks to be called for every chunk of text Emacs is about to
;; delete. These hooks are provided on the assumption that Lisp programs will
;; use either before- or the after-change hooks, but not both, and the
;; boundaries of the region where the changes happen might include more than
;; just the actual changed text, or even lump together several changes done
;; piecemeal.
;; (message "lsp-before-change:(start,end)=(%s,%s)" start end)
(with-demoted-errors "Error in ‘lsp-before-change’: %S"
(setq lsp--before-change-vals
(list :start start
:end end
:start-pos (lsp--point-to-position start)
:end-pos (lsp--point-to-position end)))))
(defun lsp-on-change (start end length)
"Executed when a file is changed.
Added to `after-change-functions'."
;; Note:
;;
;; Each function receives three arguments: the beginning and end of the region
;; just changed, and the length of the text that existed before the change.
;; All three arguments are integers. The buffer that has been changed is
;; always the current buffer when the function is called.
;;
;; The length of the old text is the difference between the buffer positions
;; before and after that text as it was before the change. As for the
;; changed text, its length is simply the difference between the first two
;; arguments.
;;
;; So (47 54 0) means add 7 chars starting at pos 47
;; So (47 47 7) means delete 7 chars starting at pos 47
;; (message "lsp-on-change:(start,end,length)=(%s,%s,%s)" start end length)
;; (message "lsp-on-change:(lsp--before-change-vals)=%s" lsp--before-change-vals)
(with-demoted-errors "Error in ‘lsp-on-change’: %S"
(save-match-data
;; A (revert-buffer) call with the 'preserve-modes parameter (eg, as done
;; by auto-revert-mode) will cause this hander to get called with a nil
;; buffer-file-name. We need the buffer-file-name to send notifications;
;; so we skip handling revert-buffer-caused changes and instead handle
;; reverts separately in lsp-on-revert
(when (and lsp--cur-workspace (not revert-buffer-in-progress-p))
(lsp--inc-cur-file-version)
(unless (eq lsp--server-sync-method 'none)
(lsp--send-notification
(lsp--make-notification
"textDocument/didChange"
`(:textDocument
,(lsp--versioned-text-document-identifier)
:contentChanges
,(pcase lsp--server-sync-method
('incremental (vector (lsp--text-document-content-change-event
start end length)))
('full (vector (lsp--full-change-event))))))))))))
(defun lsp-on-revert ()
"Executed when a file is reverted.
Added to `after-revert-hook'."
(let ((n (buffer-size))
(revert-buffer-in-progress-p nil))
(lsp-on-change 0 n n)))
(defun lsp--text-document-did-close ()
"Executed when the file is closed, added to `kill-buffer-hook'."
(when lsp--cur-workspace
(with-demoted-errors "Error on ‘lsp--text-document-did-close’: %S"
(let ((file-versions (lsp--workspace-file-versions lsp--cur-workspace))
(old-buffers (lsp--workspace-buffers lsp--cur-workspace)))
;; remove buffer from the current workspace's list of buffers
;; do a sanity check first
(when (memq (current-buffer) old-buffers)
(setf (lsp--workspace-buffers lsp--cur-workspace)
(delq (current-buffer) old-buffers))
(remhash (current-buffer) file-versions)
(with-demoted-errors "Error sending didClose notification in ‘lsp--text-document-did-close’: %S"
(lsp--send-notification
(lsp--make-notification
"textDocument/didClose"
`(:textDocument ,(lsp--versioned-text-document-identifier)))))
(when (= 0 (hash-table-count file-versions))
(lsp--shutdown-cur-workspace)))))))
(define-inline lsp--will-save-text-document-params (reason)
(cl-check-type reason number)
(inline-quote
(list :textDocument (lsp--text-document-identifier)
:reason ,reason)))
(defun lsp--before-save ()
(when lsp--cur-workspace
(with-demoted-errors "Error in ‘lsp--before-save’: %S"
(let ((params (lsp--will-save-text-document-params 1)))
(when (lsp--send-will-save-p)
(lsp--send-notification
(lsp--make-notification "textDocument/willSave" params)))
(when (and (lsp--send-will-save-wait-until-p) lsp-before-save-edits)
(lsp--apply-text-edits
(lsp--send-request (lsp--make-request
"textDocument/willSaveWaitUntil" params))))))))
(defun lsp--on-auto-save ()
(when (and lsp--cur-workspace
(lsp--send-will-save-p))
(with-demoted-errors "Error in ‘lsp--on-auto-save’: %S"
(lsp--send-notification
(lsp--make-notification
"textDocument/willSave" (lsp--will-save-text-document-params 2))))))
(defun lsp--text-document-did-save ()
"Executed when the file is closed, added to `after-save-hook''."
(when lsp--cur-workspace
(with-demoted-errors "Error on ‘lsp--text-document-did-save: %S’"
(lsp--send-notification
(lsp--make-notification
"textDocument/didSave"
`(:textDocument ,(lsp--versioned-text-document-identifier)
:text ,(if (lsp--save-include-text-p)
(save-excursion
(widen)
(buffer-substring-no-properties (point-min) (point-max)))
nil)))))))
(define-inline lsp--text-document-position-params (&optional identifier position)
"Make TextDocumentPositionParams for the current point in the current document.
If IDENTIFIER and POSITION are non-nil, they will be used as the document identifier
and the position respectively."
(inline-quote (list :textDocument (or ,identifier (lsp--text-document-identifier))
:position (or ,position (lsp--cur-position)))))
(define-inline lsp--text-document-code-action-params ()
"Make CodeActionParams for the current region in the current document."
(inline-quote (list :textDocument (lsp--text-document-identifier)
:range (lsp--current-region-or-pos)
:context (list :diagnostics (lsp--cur-line-diagnotics)))))
(defun lsp--cur-line-diagnotics ()
"Return any diagnostics that apply to the current line."
(let* ((diags (gethash buffer-file-name lsp--diagnostics nil))
(range (lsp--current-region-or-pos))
(start-line (lsp--range-start-line range))
(end-line (lsp--range-end-line range))
(diags-in-range (cl-remove-if-not
(lambda (diag)
(let ((line (lsp-diagnostic-line diag)))
(and (>= line start-line) (<= line end-line))))
diags)))
(cl-coerce (seq-map #'lsp-diagnostic-original diags-in-range) 'vector)))
(defconst lsp--completion-item-kind
[nil
"Text"
"Method"
"Function"
"Constructor"
"Field"
"Variable"
"Class"
"Interface"
"Module"
"Property"
"Unit"
"Value"
"Enum"
"Keyword"
"Snippet"
"Color"
"File"
"Reference"
"Folder"
"EnumMember"
"Constant"
"Struct"
"Event"
"Operator"
"TypeParameter"
])
(defun lsp--gethash (key table &optional dflt)
"Look up KEY in TABLE and return its associated value,
unless KEY not found or its value is falsy, when it returns DFLT.
DFLT defaults to nil.
Needed for completion request fallback behavior for the fields
'sortText', 'filterText', and 'insertText' as described here:
https://microsoft.github.io/language-server-protocol/specification#textDocument_completion"
(let ((result (gethash key table dflt)))
(when (member result '(nil "" 0 :json-false))
(setq result dflt))
result))
(defun lsp--make-completion-item (item)
(propertize (lsp--gethash "insertText" item (gethash "label" item ""))
'lsp-completion-item
item))
(defun lsp--annotate (item)
(let* ((table (plist-get (text-properties-at 0 item) 'lsp-completion-item))
(detail (gethash "detail" table nil))
(kind-index (gethash "kind" table nil)))
;; We need check index before call `aref'.
(when kind-index
(setq kind (aref lsp--completion-item-kind kind-index))
(concat
" "
detail
(when kind (format " (%s)" kind))))
))
(defun lsp--sort-string (c)
(lsp--gethash "sortText" c (gethash "label" c "")))
(defun lsp--sort-completions (completions)
(sort completions (lambda (c1 c2)
(string-lessp
(lsp--sort-string c1)
(lsp--sort-string c2)))))
(defun lsp--default-prefix-function ()
(bounds-of-thing-at-point 'symbol))
(defun lsp--get-completions ()
(with-demoted-errors "Error in ‘lsp--get-completions’: %S"
(let* ((prefix-function (or (lsp--client-prefix-function
(lsp--workspace-client lsp--cur-workspace))
#'lsp--default-prefix-function))
(bounds (funcall prefix-function)))
(list
(if bounds (car bounds) (point))
(if bounds (cdr bounds) (point))
(completion-table-dynamic
#'(lambda (_)
;; *we* don't need to know the string being completed
;; the language server does all the work by itself
(let* ((resp (lsp--send-request
(lsp--make-request
"textDocument/completion"
(lsp--text-document-position-params))))
(items (cond
((null resp) nil)
((hash-table-p resp) (gethash "items" resp nil))
((sequencep resp) resp))))
(seq-map #'lsp--make-completion-item items))))
:annotation-function #'lsp--annotate
:display-sort-function #'lsp--sort-completions))))
(defun lsp--resolve-completion (item)
(lsp--cur-workspace-check)
(cl-assert item nil "Completion item must not be nil")
(if (gethash "resolveProvider" (lsp--capability "completionProvider"))
(lsp--send-request
(lsp--make-request
"completionItem/resolve"
item))
item))
(defun lsp--extract-line-from-buffer (pos)
"Return the line pointed to by POS (a Position object) in the current buffer."
(let* ((point (lsp--position-to-point pos))
(inhibit-field-text-motion t))
(save-excursion
(goto-char point)
(buffer-substring-no-properties (line-beginning-position)
(line-end-position)))))
(defun lsp--xref-make-item (filename location)
"Return a xref-item from a LOCATION in FILENAME."
(let* ((range (gethash "range" location))
(pos-start (gethash "start" range))
(pos-end (gethash "end" range))
(line (lsp--extract-line-from-buffer pos-start))
(start (gethash "character" pos-start))
(end (gethash "character" pos-end))
(len (length line)))
(add-face-text-property (max (min start len) 0)
(max (min end len) 0)
'highlight t line)
;; LINE is nil when FILENAME is not being current visited by any buffer.
(xref-make (or line filename)
(xref-make-file-location filename
(1+ (gethash "line" pos-start))
(gethash "character" pos-start)))))
(defun lsp--get-xrefs-in-file (file)
"Return all references that contain a file.
FILE is a cons where its car is the filename and the cdr is a list of Locations
within the file. We open and/or create the file/buffer only once for all
references. The function returns a list of `xref-item'."
(let* ((filename (car file))
(visiting (find-buffer-visiting filename))
(fn (lambda (loc) (lsp--xref-make-item filename loc))))
(if visiting
(with-current-buffer visiting
(mapcar fn (cdr file)))
(when (file-readable-p filename)
(with-temp-buffer
(insert-file-contents-literally filename)
(mapcar fn (cdr file)))))))
(defun lsp--locations-to-xref-items (locations)
"Return a list of `xref-item' from LOCATIONS.
LOCATIONS is an array of Location objects:
interface Location {
uri: DocumentUri;
range: Range;
}"
(when locations
(let* ((fn (lambda (loc) (lsp--uri-to-path (gethash "uri" loc))))
;; locations-by-file is an alist of the form
;; ((FILENAME . LOCATIONS)...), where FILENAME is a string of the
;; actual file name, and LOCATIONS is a list of Location objects
;; pointing to Ranges inside that file.
(locations-by-file (seq-group-by fn locations))
;; items-by-file is a list of list of xref-item
(items-by-file (mapcar #'lsp--get-xrefs-in-file locations-by-file)))
;; flatten the list
(apply #'append items-by-file))))
(defun lsp--get-definitions ()
"Get definition of the current symbol under point.
Returns xref-item(s)."
(let ((defs (lsp--send-request (lsp--make-request
"textDocument/definition"
(lsp--text-document-position-params)))))
;; textDocument/definition returns Location | Location[]
(lsp--locations-to-xref-items (if (listp defs) defs (list defs)))))
(defun lsp--make-reference-params (&optional td-position include-declaration)
"Make a ReferenceParam object.
If TD-POSITION is non-nil, use it as TextDocumentPositionParams object instead.
If INCLUDE-DECLARATION is non-nil, request the server to include declarations."
(let ((json-false :json-false))
(plist-put (or td-position (lsp--text-document-position-params))
:context `(:includeDeclaration ,(or include-declaration json-false)))))
(defun lsp--get-references ()
"Get all references for the symbol under point.
Returns xref-item(s)."
(let ((refs (lsp--send-request (lsp--make-request
"textDocument/references"
(lsp--make-reference-params)))))
(lsp--locations-to-xref-items refs)))
(defun lsp--cancel-request (id)
(lsp--cur-workspace-check)
(cl-check-type id (or number string))
(let ((response-handlers (lsp--client-response-handlers (lsp--workspace-client
lsp--cur-workspace))))
(remhash id response-handlers)
(lsp--send-notification (lsp--make-notification "$/cancelRequest"
`(:id ,id)))))
(defun lsp--on-hover ()
;; This function is used as ‘eldoc-documentation-function’, so it’s important
;; that it doesn’t fail.
(with-demoted-errors "Error in ‘lsp--on-hover’: %S"
(when (and (lsp--capability "documentHighlightProvider")
lsp-highlight-symbol-at-point)
(lsp-symbol-highlight))
(when (and (or (lsp--capability "codeActionProvider")
(lsp--registered-capability "textDocument/codeAction"))
lsp-enable-codeaction)
(lsp--text-document-code-action))
(when (and (lsp--capability "hoverProvider") lsp-enable-eldoc)
(funcall lsp-hover-text-function))))
(defun lsp-describe-thing-at-point ()
"Display the full documentation of the thing at point."
(interactive)
(lsp--cur-workspace-check)
(let* ((client (lsp--workspace-client lsp--cur-workspace))
(contents (gethash "contents" (lsp--send-request
(lsp--make-request "textDocument/hover"
(lsp--text-document-position-params))))))
(pop-to-buffer
(with-current-buffer (get-buffer-create "*lsp-help*")
(let ((inhibit-read-only t))
(erase-buffer)
(insert (lsp--render-on-hover-content contents client t))
(goto-char (point-min))
(view-mode t)
(current-buffer))))))
(defvar-local lsp--cur-hover-request-id nil)
(defun lsp--text-document-hover-string ()
"interface Hover {
contents: MarkedString | MarkedString[];
range?: Range;
}
type MarkedString = string | { language: string; value: string };"
(lsp--cur-workspace-check)
(when lsp--cur-hover-request-id
(lsp--cancel-request lsp--cur-hover-request-id))
(let* ((client (lsp--workspace-client lsp--cur-workspace))
bounds body)
(when (symbol-at-point)
(setq bounds (bounds-of-thing-at-point 'symbol)
body (lsp--send-request-async (lsp--make-request "textDocument/hover"
(lsp--text-document-position-params))
(lsp--make-hover-callback client (car bounds) (cdr bounds)
(current-buffer)))
lsp--cur-hover-request-id (plist-get body :id))
(cl-assert (integerp lsp--cur-hover-request-id)))))
(defun lsp--render-markup-content-1 (kind content)
(if (functionp lsp-render-markdown-markup-content)
(let ((out (funcall lsp-render-markdown-markup-content kind content)))
(cl-assert (stringp out) t
"value returned by lsp-render-markdown-markup-content should be a string")
out)
content))
(defun lsp--render-markup-content (content)
"Render MarkupContent object CONTENT.
export interface MarkupContent {
kind: MarkupKind;
value: string;
}"
(let ((kind (gethash "kind" content))
(content (gethash "value" content)))
(lsp--render-markup-content-1 kind content)))
(define-inline lsp--point-is-within-bounds-p (start end)
"Return whether the current point is within START and END."
(inline-quote
(let ((p (point)))
(and (>= p ,start) (<= p ,end)))))
(define-inline lsp--markup-content-p (obj)
(inline-letevals (obj)
(inline-quote (and (hash-table-p ,obj)
(gethash "kind" ,obj nil) (gethash "value" ,obj nil)))))
(defun lsp--render-on-hover-content (contents client render-all)
"Render the content received from 'document/onHover' request.
CLIENT - client to use.
CONTENTS - MarkedString | MarkedString[] | MarkupContent
RENDER-ALL if set to nil render only the first element from CONTENTS."
(let ((renderers (lsp--client-string-renderers client))
(default-client-renderer (lsp--client-default-renderer client)))
(string-join
(seq-map
(lambda (e)
(let (renderer)
(cond
;; hash table, language renderer set
((and (hash-table-p e)
(setq renderer
(if-let (language (gethash "language" e))
(cdr (assoc-string language renderers))
default-client-renderer)))
(when (gethash "value" e nil)
(funcall renderer (gethash "value" e))))
;; hash table - workspace renderer not set
;; trying to render using global renderer
((lsp--markup-content-p e) (lsp--render-markup-content e))
;; hash table - anything other has failed
((hash-table-p e) (gethash "value" e nil))
;; string, default workspace renderer set
(default-client-renderer (funcall default-client-renderer e))
;; no rendering
(t e))))
(if (sequencep contents)
(if render-all
contents
(seq-take contents 1))
(list contents)))
"\n")))
;; start and end are the bounds of the symbol at point
(defun lsp--make-hover-callback (client start end buffer)
(lambda (hover)
(with-current-buffer buffer
(setq lsp--cur-hover-request-id nil))
(when (and hover
(lsp--point-is-within-bounds-p start end)
(eq (current-buffer) buffer) (eldoc-display-message-p))
(let ((contents (gethash "contents" hover)))
(when contents
(eldoc-message (lsp--render-on-hover-content contents
client
lsp-eldoc-render-all)))))))
(defun lsp-provide-marked-string-renderer (client language renderer)
(cl-check-type language string)
(cl-check-type renderer function)
(setf (alist-get language (lsp--client-string-renderers client)) renderer))
(defun lsp-provide-default-marked-string-renderer (client renderer)
"Set the RENDERER for CLIENT.
It will be used when no language has been specified in document/onHover result."
(cl-check-type renderer function)
(setf (lsp--client-default-renderer client) renderer))
(defun lsp-info-under-point ()
"Show relevant documentation for the thing under point."
(interactive)
(lsp--text-document-hover-string))
(defvar-local lsp--current-signature-help-request-id nil)
(defun lsp--text-document-signature-help ()
"interface SignatureHelp {
signatures: SignatureInformation[];
activeSignature?: number;
activeParameter?: number;
};
interface SignatureInformation {
label: string;
documentation?: string | MarkupContent;
parameters?: ParameterInformation[];
};
interface ParameterInformation {
label: string;
documentation?: string | MarkupContent;
};
interface MarkupContent {
kind: MarkupKind;
value: string;
};
type MarkupKind = 'plaintext' | 'markdown';"
(lsp--cur-workspace-check)
(when lsp--current-signature-help-request-id
(lsp--cancel-request lsp--current-signature-help-request-id))
(let (bounds body)
(when (symbol-at-point)
(setq bounds (bounds-of-thing-at-point 'symbol)
body (lsp--send-request-async
(lsp--make-request "textDocument/signatureHelp"
(lsp--text-document-position-params))
(lsp--make-text-document-signature-help-callback
(car bounds) (cdr bounds) (current-buffer)))
lsp--current-signature-help-request-id (plist-get body :id))
(cl-assert (integerp lsp--current-signature-help-request-id)))))
(defun lsp--make-text-document-signature-help-callback (start end buffer)
(lambda (signature-help)
(with-current-buffer buffer
(setq lsp--current-signature-help-request-id nil))
(when (and signature-help
(lsp--point-is-within-bounds-p start end)
(eq (current-buffer) buffer) (eldoc-display-message-p))
(let* ((active-signature-number
(or (gethash "activeSignature" signature-help) 0))
(active-signature (nth
active-signature-number
(gethash "signatures" signature-help))))
(when active-signature
(eldoc-message (gethash "label" active-signature)))))))
;; NOTE: the code actions cannot currently be applied. There is some non-GNU
;; code to do this in the lsp-haskell module. We still need a GNU version, here.
;; PRs accepted.
(defvar-local lsp-code-actions nil
"Code actions for the buffer.")
(defvar-local lsp-code-action-params nil
"The last code action params.")
(defun lsp--text-document-code-action ()
"Request code action to automatically fix issues reported by
the diagnostics."
(lsp--cur-workspace-check)
(unless (or (lsp--capability "codeActionProvider")
(lsp--registered-capability "textDocument/codeAction"))
(signal 'lsp-capability-not-supported (list "codeActionProvider")))
(let ((params (lsp--text-document-code-action-params)))
(lsp--send-request-async
(lsp--make-request "textDocument/codeAction" params)
(lambda (actions)
(lsp--set-code-action-params (current-buffer) actions params)))))
(defun lsp--command-get-title (cmd)
"Given a Command object CMD, get the title.
If title is nil, return the name for the command handler."
(gethash "title" cmd (gethash "command" cmd)))
(defun lsp--set-code-action-params (buf actions params)
"Update set `lsp-code-actions' to ACTIONS and `lsp-code-action-params' to PARAMS in BUF."
(when (buffer-live-p buf)
(with-current-buffer buf
(when (equal params (lsp--text-document-code-action-params))
(setq lsp-code-actions actions)
(setq lsp-code-action-params params)))))
(defun lsp--command-p (cmd)
(and (cl-typep cmd 'hash-table)
(cl-typep (gethash "title" cmd) 'string)
(cl-typep (gethash "command" cmd) 'string)))
(defun lsp--select-action (actions)
"Select an action to execute from ACTIONS."
(if actions
(let ((name->action (mapcar (lambda (a)
(list (lsp--command-get-title a) a))
actions)))
(cadr (assoc
(completing-read "Select code action: " name->action)
name->action)))
(error "No actions to select from")))
(defun lsp-get-or-calculate-code-actions ()
"Get or calculate the current code actions.
The method will either retrieve the current code actions or it will calculate the actual one."
(let ((current-code-action-params (lsp--text-document-code-action-params)))
(when (not (equal current-code-action-params lsp-code-action-params))
(let* ((request-params (lsp--make-request
"textDocument/codeAction"
(lsp--text-document-code-action-params)))
(actions (lsp--send-request request-params)))
(setq lsp-code-action-params current-code-action-params)
(lsp--set-code-action-params (current-buffer)
actions
current-code-action-params)))
lsp-code-actions))
(defun lsp-execute-code-action (action)
"Execute code action ACTION.
If ACTION is not set it will be selected from `lsp-code-actions'."
(interactive (list
(lsp--select-action (lsp-get-or-calculate-code-actions))))
(lsp--cur-workspace-check)
(let* ((command (gethash "command" action))
(action-handler (gethash command
(lsp--client-action-handlers
(lsp--workspace-client lsp--cur-workspace)))))
(if action-handler
(funcall action-handler action)
(lsp--execute-command action))))
(defvar-local lsp-code-lenses nil
"A list of code lenses computed for the buffer.")
(defun lsp--update-code-lenses (&optional callback)
"Update the list of code lenses for the current buffer.
Optionally, CALLBACK is a function that accepts a single argument, the code lens object."
(lsp--cur-workspace-check)
(when callback
(cl-check-type callback function))
(when (gethash "codeLensProvider" (lsp--server-capabilities))
(lsp--send-request-async (lsp--make-request "textDocument/codeLens"
`(:textDocument ,(lsp--text-document-identifier)))
(let ((buf (current-buffer)))
#'(lambda (lenses)
(with-current-buffer buf
(setq lsp-code-lenses lenses)
(when callback
(funcall callback lenses))))))))
(defun lsp--make-document-formatting-options ()
(let ((json-false :json-false))
`(:tabSize ,tab-width :insertSpaces
,(if indent-tabs-mode json-false t))))
(defun lsp--make-document-formatting-params ()
`(:textDocument ,(lsp--text-document-identifier)
:options ,(lsp--make-document-formatting-options)))
(defun lsp-format-buffer ()
"Ask the server to format this document."
(interactive "*")
(unless (or (lsp--capability "documentFormattingProvider")
(lsp--registered-capability "textDocument/formatting"))
(signal 'lsp-capability-not-supported (list "documentFormattingProvider")))
(let ((edits (lsp--send-request (lsp--make-request
"textDocument/formatting"
(lsp--make-document-formatting-params)))))
(if (fboundp 'replace-buffer-contents)
(let ((current-buffer (current-buffer)))
(with-temp-buffer
(insert-buffer-substring-no-properties current-buffer)
(lsp--apply-text-edits edits)
(let ((temp-buffer (current-buffer)))
(with-current-buffer current-buffer
(replace-buffer-contents temp-buffer)))))
(let ((point (point))
(w-start (window-start)))
(lsp--apply-text-edits edits)
(goto-char point)
(goto-char (line-beginning-position))
(set-window-start (selected-window) w-start)))))
(defun lsp--make-document-range-formatting-params (start end)
"Make DocumentRangeFormattingParams for selected region.
interface DocumentRangeFormattingParams {
textDocument: TextDocumentIdentifier;
range: Range;
options: FormattingOptions;
}"
(plist-put (lsp--make-document-formatting-params)
:range (lsp--region-to-range start end)))
(defconst lsp--highlight-kind-face
'((1 . lsp-face-highlight-textual)
(2 . lsp-face-highlight-read)
(3 . lsp-face-highlight-write)))
(defun lsp--remove-cur-overlays ()
(let ((overlays (lsp--workspace-highlight-overlays lsp--cur-workspace))
(buf (current-buffer)))
(dolist (overlay (gethash buf overlays))
(delete-overlay overlay))
(remhash buf overlays)))
(defun lsp-symbol-highlight ()
"Highlight all relevant references to the symbol under point."
(interactive)
(lsp--send-request-async (lsp--make-request "textDocument/documentHighlight"
(lsp--text-document-position-params))
(lsp--make-symbol-highlight-callback (current-buffer))))
(defun lsp--make-symbol-highlight-callback (buf)
"Create a callback to process the reply of a
'textDocument/documentHightlight' message for the buffer BUF.
A reference is highlighted only if it is visible in a window."
(cl-check-type buf buffer)
(lambda (highlights)
(with-current-buffer buf
(lsp--remove-cur-overlays)
(when (and highlights (/= (length highlights) 0))
(let* ((windows-on-buffer (get-buffer-window-list nil nil 'visible))
(overlays (lsp--workspace-highlight-overlays lsp--cur-workspace))
(buf-overlays (gethash (current-buffer) overlays))
wins-visible-pos)
(save-restriction
(widen)
;; Save visible portions of the buffer
(dolist (win windows-on-buffer)
(let* ((win-start (window-start win))
(win-end (window-end win)))
(push (cons (1- (line-number-at-pos win-start))
(1+ (line-number-at-pos win-end)))
wins-visible-pos)))
(seq-doseq (highlight highlights)
(let* ((range (gethash "range" highlight nil))
(kind (gethash "kind" highlight 1))
(start (gethash "start" range))
(end (gethash "end" range))
overlay)
(dolist (win wins-visible-pos)
(let* ((start-window (car win))
(end-window (cdr win)))
;; Make the overlay only if the reference is visible
(when (and (> (1+ (gethash "line" start)) start-window)
(< (1+ (gethash "line" end)) end-window))
(setq overlay (make-overlay (lsp--position-to-point start)
(lsp--position-to-point end)))
(overlay-put overlay 'face
(cdr (assq kind lsp--highlight-kind-face)))
(push overlay buf-overlays)
(puthash (current-buffer) buf-overlays overlays))))))))))))
(defconst lsp--symbol-kind
'((1 . "File")
(2 . "Module")
(3 . "Namespace")
(4 . "Package")
(5 . "Class")
(6 . "Method")
(7 . "Property")
(8 . "Field")
(9 . "Constructor"),
(10 . "Enum")
(11 . "Interface")
(12 . "Function")
(13 . "Variable")
(14 . "Constant")
(15 . "String")
(16 . "Number")
(17 . "Boolean")
(18 . "Array")
(19 . "Object")
(20 . "Key")
(21 . "Null")
(22 . "Enum Member")
(23 . "Struct")
(24 . "Event")
(25 . "Operator")
(26 . "Type Parameter")))
(defun lsp--symbol-information-to-xref (symbol)
"Return a `xref-item' from SYMBOL information."
(let* ((location (gethash "location" symbol))
(uri (gethash "uri" location))
(range (gethash "range" location))
(start (gethash "start" range)))
(xref-make (format "[%s] %s"
(alist-get (gethash "kind" symbol) lsp--symbol-kind)
(gethash "name" symbol))
(xref-make-file-location (lsp--uri-to-path uri)
(1+ (gethash "line" start))
(gethash "character" start)))))
(defun lsp-format-region (s e)
(let ((edits (lsp--send-request (lsp--make-request
"textDocument/rangeFormatting"
(lsp--make-document-range-formatting-params s e)))))
(lsp--apply-text-edits edits)))
(defun lsp--location-to-td-position (location)
"Convert LOCATION to a TextDocumentPositionParams object."
`(:textDocument (:uri ,(gethash "uri" location))
:position ,(gethash "start" (gethash "range" location))))
(defun lsp--symbol-info-to-identifier (symbol)
(let ((td-params (lsp--location-to-td-position (gethash "location" symbol))))
(propertize (gethash "name" symbol)
'ref-params (lsp--make-reference-params td-params)
'def-params td-params)))
(defun lsp--get-document-symbols ()
(lsp--cur-workspace-check)
(lsp--send-request (lsp--make-request
"textDocument/documentSymbol"
`(:textDocument ,(lsp--text-document-identifier)))))
(defun lsp--xref-backend () 'xref-lsp)
(cl-defmethod xref-backend-identifier-at-point ((_backend (eql xref-lsp)))
(propertize (symbol-name (symbol-at-point))
'def-params (lsp--text-document-position-params)
'ref-params (lsp--make-reference-params)))
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql xref-lsp)))
(let ((json-false :json-false)
(symbols (lsp--get-document-symbols)))
(seq-map #'lsp--symbol-info-to-identifier symbols)))
;; (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql xref-lsp)))
;; nil)
(cl-defmethod xref-backend-definitions ((_backend (eql xref-lsp)) identifier)
(let* ((maybeparams (get-text-property 0 'def-params identifier))
;; In some modes (such as haskell-mode), xref-find-definitions gets
;; called directly without applying the properties expected here. So we
;; must test if the properties are present, and if not use the current
;; point location.
(params (if (null maybeparams)
(lsp--text-document-position-params)
maybeparams))
(defs (lsp--send-request (lsp--make-request
"textDocument/definition"
params))))
(lsp--locations-to-xref-items (if (listp defs) defs (list defs)))))
(cl-defmethod xref-backend-references ((_backend (eql xref-lsp)) identifier)
(let* ((properties (text-properties-at 0 identifier))
(params (plist-get properties 'ref-params))
(refs (lsp--send-request (lsp--make-request
"textDocument/references"
(or params (lsp--make-reference-params))))))
(lsp--locations-to-xref-items refs)))
(cl-defmethod xref-backend-apropos ((_backend (eql xref-lsp)) pattern)
(let ((symbols (lsp--send-request (lsp--make-request
"workspace/symbol"
`(:query ,pattern)))))
(seq-map #'lsp--symbol-information-to-xref symbols)))
(defun lsp--make-document-rename-params (newname)
"Make DocumentRangeFormattingParams for selected region.
interface RenameParams {
textDocument: TextDocumentIdentifier;
position: Position;
newName: string;
}"
`(:position ,(lsp--cur-position)
:textDocument ,(lsp--text-document-identifier)
:newName ,newname))
(defun lsp-rename (newname)
"Rename the symbol (and all references to it) under point to NEWNAME."
(interactive (list (read-string "Rename to: " (thing-at-point 'symbol))))
(lsp--cur-workspace-check)
(unless (lsp--capability "renameProvider")
(signal 'lsp-capability-not-supported (list "renameProvider")))
(let ((edits (lsp--send-request (lsp--make-request
"textDocument/rename"
(lsp--make-document-rename-params newname)))))
(when edits
(lsp--apply-workspace-edit edits))))
(defun lsp-find-custom (method &optional extra)
"Send request named METHOD and get cross references of the symbol under point.
EXTRA is a plist of extra parameters."
(let ((loc (lsp--send-request
(lsp--make-request method
(append (lsp--text-document-position-params) extra)))))
(if loc
(xref--show-xrefs
(lsp--locations-to-xref-items (if (listp loc) loc (list loc))) nil)
(message "Not found for: %s" (thing-at-point 'symbol t)))))
(defun lsp-goto-implementation ()
"Resolve, and go to the implementation(s) of the symbol under point."
(interactive)
(lsp--cur-workspace-check)
(unless (lsp--capability "implementationProvider")
(signal 'lsp-capability-not-supported (list "implementationProvider")))
(lsp-find-custom "textDocument/implementation"))
(defun lsp-goto-type-definition ()
"Resolve, and go to the type definition(s) of the symbol under point."
(interactive)
(lsp--cur-workspace-check)
(unless (lsp--capability "typeDefinitionProvider")
(signal 'lsp-capability-not-supported (list "typeDefinitionProvider")))
(lsp-find-custom "textDocument/typeDefinition"))
(define-inline lsp--execute-command (command)
"Given a COMMAND returned from the server, create and send a
'workspace/executeCommand' message."
(inline-letevals (command)
(inline-quote
(progn
(cl-check-type ,command (satisfies lsp--command-p))
(lsp--send-execute-command
(gethash "command" ,command)
(gethash "arguments" ,command nil))))))
(defun lsp--send-execute-command (command &optional args)
"Create and send a 'workspace/executeCommand' message having
command COMMAND and optionsl ARGS"
(lsp--cur-workspace-check)
(unless (or (lsp--capability "executeCommandProvider")
(lsp--registered-capability "workspace/executeCommand"))
(signal 'lsp-capability-not-supported (list "executeCommandProvider")))
(lsp--send-request
(lsp--make-request
"workspace/executeCommand"
(lsp--make-execute-command-params command args))))
(defun lsp--make-execute-command-params (cmd &optional args)
(if args
(list :command cmd :arguments args)
(list :command cmd)))
(defalias 'lsp-point-to-position #'lsp--point-to-position)
(defalias 'lsp-get-start-position #'lsp--get-start-position)
(defalias 'lsp-get-end-position #'lsp--get-end-position)
(defalias 'lsp-text-document-identifier #'lsp--text-document-identifier)
(defalias 'lsp-send-execute-command #'lsp--send-execute-command)
(defalias 'lsp-on-open #'lsp--text-document-did-open)
(defalias 'lsp-on-save #'lsp--text-document-did-save)
;; (defalias 'lsp-on-change #'lsp--text-document-did-change)
(defalias 'lsp-completion-at-point #'lsp--get-completions)
(defun lsp--unset-variables ()
(when lsp-enable-eldoc
(setq-local eldoc-documentation-function 'ignore))
(when lsp-enable-xref
(setq-local xref-backend-functions nil))
(when lsp-enable-completion-at-point
(remove-hook 'completion-at-point-functions #'lsp-completion-at-point t))
(remove-hook 'after-change-functions #'lsp-on-change t)
(remove-hook 'after-revert-hook #'lsp-on-revert t)
(remove-hook 'before-change-functions #'lsp-before-change t))
(defun lsp--set-configuration (settings)
"Set the configuration for the lsp server."
(lsp--send-notification (lsp--make-notification
"workspace/didChangeConfiguration"
`(:settings , settings))))
(defun lsp-workspace-register-watch (to-watch &optional workspace)
"Monitor for file change and trigger workspace/didChangeConfiguration.
TO-WATCH is a list of the directories and regexp in the following format:
'((root-dir1 (glob-pattern1 glob-pattern2))
(root-dir2 (glob-pattern3 glob-pattern4)))
If WORKSPACE is not specified the `lsp--cur-workspace' will be used."
(setq workspace (or workspace lsp--cur-workspace))
(let ((watches (lsp--workspace-watches workspace)))
(cl-loop for (dir glob-patterns) in to-watch do
(lsp-create-watch
dir
(mapcar 'eshell-glob-regexp glob-patterns)
(lambda (event)
(let ((lsp--cur-workspace workspace))
(lsp-send-notification
(lsp-make-notification
"workspace/didChangeWatchedFiles"
(list :changes
(list
:type (alist-get (cadr event) lsp--file-change-type)
:uri (lsp--path-to-uri (caddr event))))))))
watches))))
(declare-function lsp-mode "lsp-mode" (&optional arg))
(provide 'lsp-methods)
;;; lsp-methods.el ends here
