(php-mode . ("php" "vendor/felixfbecker/\
language-server/bin/php-language-server.php")))
"How the command `eglot' guesses the server to start.
- An association list of (MAJOR-MODE . CONTACT) pair. MAJOR-MODE
- is a mode symbol. CONTACT is:
-An association list of (MAJOR-MODE . SPEC) pair. MAJOR-MODE is a
-mode symbol, or a list of mode symbols. The associated SPEC
-specifies how to start a server for managing buffers of those
-modes. SPEC can be:
++An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
++is a mode symbol, or a list of mode symbols. The associated
++CONTACT specifies how to start a server for managing buffers of
++those modes. CONTACT can be:
* In the most common case, a list of strings (PROGRAM [ARGS...]).
PROGRAM is called with ARGS and is expected to serve LSP requests
:documentation
"Represents a server. Wraps a process for LSP communication.")
-(cl-defmethod cl-print-object ((obj eglot-lsp-server) stream)
- (princ (format "#<%s: %s>" (eieio-object-class obj) (eglot--name obj)) stream))
-
-(defun eglot--current-server ()
- "The current logical EGLOT process."
- (let* ((probe (or (project-current) `(transient . ,default-directory))))
- (cl-find major-mode (gethash probe eglot--servers-by-project)
- :key #'eglot--major-mode)))
+\f
+;;; Process management
+(defvar eglot--servers-by-project (make-hash-table :test #'equal)
+ "Keys are projects. Values are lists of processes.")
- (defun eglot-shutdown (server &optional _interactive)
-(defun eglot--current-server-or-lose ()
- "Return the current EGLOT process or error."
- (or (eglot--current-server) (eglot--error "No current EGLOT process")))
-
-(defun eglot--make-process (name contact)
- "Make a process object from CONTACT.
-NAME is used to name the the started process or connection.
-CONTACT is in `eglot'. Returns a process object."
- (let* ((stdout (format "*%s stdout*" name)) stderr
- (proc (cond
- ((processp contact) contact)
- ((integerp (cadr contact))
- (apply #'open-network-stream name stdout contact))
- (t (make-process
- :name name :command contact :buffer stdout
- :coding 'utf-8-emacs-unix :connection-type 'pipe
- :stderr (setq stderr (format "*%s stderr*" name)))))))
- (process-put proc 'eglot-stderr stderr)
- (set-process-buffer proc (get-buffer-create stdout))
- (set-marker (process-mark proc) (with-current-buffer stdout (point-min)))
- (set-process-filter proc #'eglot--process-filter)
- (set-process-sentinel proc #'eglot--process-sentinel)
- (with-current-buffer stdout
- (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t)))
- proc))
++(defun eglot-shutdown (server &optional _interactive timeout)
+ "Politely ask SERVER to quit.
- Forcefully quit it if it doesn't respond. Don't leave this
- function with the server still running."
++Forcefully quit it if it doesn't respond within TIMEOUT seconds.
++Don't leave this function with the server still running."
+ (interactive (list (eglot--current-server-or-lose) t))
+ (eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
+ (unwind-protect
+ (progn
+ (setf (eglot--shutdown-requested server) t)
- (jsonrpc-request server :shutdown nil :timeout 3)
++ (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
+ ;; this one is supposed to always fail, because it asks the
+ ;; server to exit itself. Hence ignore-errors.
+ (ignore-errors (jsonrpc-request server :exit nil :timeout 1)))
+ ;; Turn off `eglot--managed-mode' where appropriate.
+ (dolist (buffer (eglot--managed-buffers server))
+ (with-current-buffer buffer (eglot--managed-mode-onoff server -1)))
+ ;; Now ask jsonrpc.el to shutdown server (which in normal
+ ;; conditions should return immediately).
+ (jsonrpc-shutdown server)))
+
+(defun eglot--on-shutdown (server)
+ "Called by jsonrpc.el when SERVER is already dead."
+ ;; Turn off `eglot--managed-mode' where appropriate.
+ (dolist (buffer (eglot--managed-buffers server))
+ (with-current-buffer buffer (eglot--managed-mode-onoff server -1)))
+ ;; Kill any expensive watches
+ (maphash (lambda (_id watches)
+ (mapcar #'file-notify-rm-watch watches))
+ (eglot--file-watches server))
+ ;; Sever the project/server relationship for `server'
+ (setf (gethash (eglot--project server) eglot--servers-by-project)
+ (delq server
+ (gethash (eglot--project server) eglot--servers-by-project)))
+ (cond ((eglot--shutdown-requested server)
+ t)
+ ((not (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Reconnecting after unexpected server exit.")
+ (eglot-reconnect server))
+ ((timerp (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
(defun eglot--all-major-modes ()
"Return all known major modes."
(let ((server (apply #'eglot--connect (eglot--guess-contact))))
(eglot--message
"Automatically started `%s' to manage `%s' buffers in project `%s'"
- (eglot--name server)
+ (eglot--project-nickname server)
major-mode
(eglot--project-nickname server)))))))
- (add-hook 'post-command-hook #'maybe-connect 'append nil))))
+ (when buffer-file-name
+ (add-hook 'post-command-hook #'maybe-connect 'append nil)))))
-(defun eglot--process-sentinel (proc change)
- "Called when PROC undergoes CHANGE."
- (let ((server (process-get proc 'eglot-server)))
- (eglot--debug server "Process state changed: %s" change)
- (when (not (process-live-p proc))
- (with-current-buffer (eglot-events-buffer server)
- (let ((inhibit-read-only t))
- (insert "\n----------b---y---e---b---y---e----------\n")))
- ;; Cancel outstanding timers and file system watches
- (maphash (lambda (_id triplet)
- (cl-destructuring-bind (_success _error timeout) triplet
- (cancel-timer timeout)))
- (eglot--pending-continuations server))
- (maphash (lambda (_id watches)
- (mapcar #'file-notify-rm-watch watches))
- (eglot--file-watches server))
- (unwind-protect
- ;; Call all outstanding error handlers
- (maphash (lambda (_id triplet)
- (cl-destructuring-bind (_success error _timeout) triplet
- (funcall error `(:code -1 :message "Server died"))))
- (eglot--pending-continuations server))
- ;; Turn off `eglot--managed-mode' where appropriate.
- (dolist (buffer (eglot--managed-buffers server))
- (with-current-buffer buffer (eglot--managed-mode-onoff server -1)))
- ;; Forget about the process-project relationship
- (setf (gethash (eglot--project server) eglot--servers-by-project)
- (delq server
- (gethash (eglot--project server) eglot--servers-by-project)))
- ;; Say last words
- (eglot--message "%s exited with status %s" (eglot--name server)
- (process-exit-status
- (eglot--process server)))
- (delete-process proc)
- ;; Consider autoreconnecting
- (cond ((eglot--shutdown-requested server)
- (setf (eglot--shutdown-requested server) :sentinel-done))
- ((not (eglot--inhibit-autoreconnect server))
- (eglot--warn "Reconnecting after unexpected server exit")
- (eglot-reconnect server))
- ((timerp (eglot--inhibit-autoreconnect server))
- (eglot--warn "Not auto-reconnecting, last on didn't last long.")))))))
-
-(defun eglot--process-filter (proc string)
- "Called when new data STRING has arrived for PROC."
- (eglot--with-live-buffer (process-buffer proc)
- (let ((expected-bytes (process-get proc 'eglot-expected-bytes))
- (inhibit-read-only t) done)
- ;; Insert the text, advancing the process marker.
- ;;
- (save-excursion
- (goto-char (process-mark proc))
- (insert string)
- (set-marker (process-mark proc) (point)))
- ;; Loop (more than one message might have arrived)
- ;;
- (unwind-protect
- (while (not done)
- (cond ((not expected-bytes)
- ;; Starting a new message
- ;;
- (setq expected-bytes
- (and (search-forward-regexp
- "\\(?:.*: .*\r\n\\)*Content-Length: \
-*\\([[:digit:]]+\\)\r\n\\(?:.*: .*\r\n\\)*\r\n"
- (+ (point) 100)
- t)
- (string-to-number (match-string 1))))
- (unless expected-bytes
- (setq done :waiting-for-new-message)))
- (t
- ;; Attempt to complete a message body
- ;;
- (let ((available-bytes (- (position-bytes (process-mark proc))
- (position-bytes (point)))))
- (cond
- ((>= available-bytes
- expected-bytes)
- (let* ((message-end (byte-to-position
- (+ (position-bytes (point))
- expected-bytes))))
- (unwind-protect
- (save-restriction
- (narrow-to-region (point) message-end)
- (let* ((json-object-type 'plist)
- (json-message (json-read)))
- ;; Process content in another buffer,
- ;; shielding buffer from tamper
- ;;
- (with-temp-buffer
- (eglot--server-receive
- (process-get proc 'eglot-server)
- json-message))))
- (goto-char message-end)
- (delete-region (point-min) (point))
- (setq expected-bytes nil))))
- (t
- ;; Message is still incomplete
- ;;
- (setq done :waiting-for-more-bytes-in-this-message)))))))
- ;; Saved parsing state for next visit to this filter
- ;;
- (process-put proc 'eglot-expected-bytes expected-bytes)))))
-
-(defun eglot-events-buffer (server &optional interactive)
- "Display events buffer for current LSP SERVER.
-INTERACTIVE is t if called interactively."
- (interactive (list (eglot--current-server-or-lose) t))
- (let* ((probe (eglot--events-buffer server))
- (buffer (or (and (buffer-live-p probe) probe)
- (let ((buffer (get-buffer-create
- (format "*%s events*"
- (eglot--name server)))))
- (with-current-buffer buffer
- (buffer-disable-undo)
- (read-only-mode t)
- (setf (eglot--events-buffer server) buffer))
- buffer))))
- (when interactive (display-buffer buffer))
- buffer))
+(defun eglot-events-buffer (server)
+ "Display events buffer for SERVER."
+ (interactive (eglot--current-server-or-lose))
+ (display-buffer (jsonrpc-events-buffer server)))
(defun eglot-stderr-buffer (server)
- "Pop to stderr of SERVER, if it exists, else error."
- (interactive (list (eglot--current-server-or-lose)))
- (if-let ((b (process-get (eglot--process server) 'eglot-stderr)))
- (pop-to-buffer b) (user-error "[eglot] No stderr buffer!")))
-
-(defun eglot--log-event (server message &optional type)
- "Log an eglot-related event.
-SERVER is the current server. MESSAGE is a JSON-like plist.
-TYPE is a symbol saying if this is a client or server
-originated."
- (with-current-buffer (eglot-events-buffer server)
- (cl-destructuring-bind (&key method id error &allow-other-keys) message
- (let* ((inhibit-read-only t)
- (subtype (cond ((and method id) 'request)
- (method 'notification)
- (id 'reply)
- (t 'message)))
- (type
- (format "%s-%s" (or type :internal) subtype)))
- (goto-char (point-max))
- (let ((msg (format "%s%s%s:\n%s\n"
- type
- (if id (format " (id:%s)" id) "")
- (if error " ERROR" "")
- (pp-to-string message))))
- (when error
- (setq msg (propertize msg 'face 'error)))
- (insert-before-markers msg))))))
-
-(defun eglot--server-receive (server message)
- "Process MESSAGE from SERVER."
- (cl-destructuring-bind (&key method id params error result _jsonrpc) message
- (let* ((continuations (and id
- (not method)
- (gethash id (eglot--pending-continuations server)))))
- (eglot--log-event server message 'server)
- (when error (setf (eglot--status server) `(,error t)))
- (unless (or (null method) (keywordp method))
- (setq method (intern (format ":%s" method))))
- (cond
- (method
- (condition-case-unless-debug _err
- (if id
- (apply #'eglot-handle-request server id method params)
- (apply #'eglot-handle-notification server method params))
- (cl-no-applicable-method
- (if id
- (eglot--reply
- server id :error `(:code -32601 :message "Method unimplemented"))
- (eglot--debug
- server '(:error `(:message "Notification unimplemented")))))))
- (continuations
- (cancel-timer (cl-third continuations))
- (remhash id (eglot--pending-continuations server))
- (if error
- (funcall (cl-second continuations) error)
- (funcall (cl-first continuations) result)))
- (id
- (eglot--warn "Ooops no continuation for id %s" id)))
- (eglot--call-deferred server)
- (force-mode-line-update t))))
-
-(defun eglot--send (server message)
- "Send MESSAGE to SERVER (ID is optional)."
- (let ((json (json-encode message)))
- (process-send-string (eglot--process server)
- (format "Content-Length: %d\r\n\r\n%s"
- (string-bytes json) json))
- (eglot--log-event server message 'client)))
+ "Display stderr buffer for SERVER."
+ (interactive (eglot--current-server-or-lose))
+ (display-buffer (jsonrpc-stderr-buffer server)))
(defun eglot-forget-pending-continuations (server)
- "Stop waiting for responses from the current LSP SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (clrhash (eglot--pending-continuations server)))
+ "Forget pending requests for SERVER."
+ (interactive (eglot--current-server-or-lose))
+ (jsonrpc-forget-pending-continuations server))
-(defun eglot-clear-status (server)
- "Clear most recent error message from SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (setf (eglot--status server) nil)
- (force-mode-line-update t))
-
-(defun eglot--call-deferred (server)
- "Call SERVER's deferred actions, who may again defer themselves."
- (when-let ((actions (hash-table-values (eglot--deferred-actions server))))
- (eglot--debug server `(:maybe-run-deferred ,(mapcar #'caddr actions)))
- (mapc #'funcall (mapcar #'car actions))))
-
-(defvar-local eglot--next-request-id 0 "ID for next `eglot--async-request'.")
-
-(cl-defun eglot--async-request (server
- method
- params
- &rest args
- &key success-fn error-fn timeout-fn
- (timeout eglot-request-timeout)
- (deferred nil))
- "Make a request to SERVER expecting a reply later on.
-SUCCESS-FN and ERROR-FN are passed `:result' and `:error'
-objects, respectively. Wait TIMEOUT seconds for response or call
-nullary TIMEOUT-FN. If DEFERRED, maybe defer request to the
-future, or to never at all, in case a new request with identical
-DEFERRED and for the same buffer overrides it (however, if that
-happens, the original timer keeps counting). Return (ID TIMER)."
- (pcase-let* ( (buf (current-buffer))
- (`(,_ ,timer ,old-id)
- (and deferred (gethash (list deferred buf)
- (eglot--deferred-actions server))))
- (id (or old-id (cl-incf eglot--next-request-id)))
- (make-timer
- (lambda ( )
- (run-with-timer
- timeout nil
- (lambda ()
- (remhash id (eglot--pending-continuations server))
- (if timeout-fn (funcall timeout-fn)
- (eglot--debug
- server `(:timed-out ,method :id ,id :params ,params))))))))
- (when deferred
- (if (eglot-server-ready-p server deferred)
- ;; Server is ready, we jump below and send it immediately.
- (remhash (list deferred buf) (eglot--deferred-actions server))
- ;; Otherwise, save in `eglot--deferred-actions' and exit non-locally
- (unless old-id
- ;; Also, if it's the first deferring for this id, inform the log
- (eglot--debug server `(:deferring ,method :id ,id :params ,params)))
- (puthash (list deferred buf)
- (list (lambda () (eglot--with-live-buffer buf
- (apply #'eglot--async-request server
- method params args)))
- (or timer (funcall make-timer)) id)
- (eglot--deferred-actions server))
- (cl-return-from eglot--async-request nil)))
- ;; Really send the request
- (eglot--send server `(:jsonrpc "2.0" :id ,id :method ,method :params ,params))
- (puthash id (list
- (or success-fn
- (eglot--lambda (&rest _ignored)
- (eglot--debug
- server `(:message "success ignored" :id ,id))))
- (or error-fn
- (eglot--lambda (&key code message &allow-other-keys)
- (setf (eglot--status server) `(,message t))
- server `(:message "error ignored, status set"
- :id ,id :error ,code)))
- (setq timer (or timer (funcall make-timer))))
- (eglot--pending-continuations server))
- (list id timer)))
-
-(defun eglot--request (server method params &optional deferred)
- "Like `eglot--async-request' for SERVER, METHOD and PARAMS, but synchronous.
-Meaning only return locally if successful, otherwise exit non-locally.
-DEFERRED is passed to `eglot--async-request', which see."
- ;; HACK: A deferred sync request with outstanding changes is a bad
- ;; idea, since that might lead to the request never having a chance
- ;; to run, because idle timers don't run in `accept-process-output'.
- (when deferred (eglot--signal-textDocument/didChange))
- (let* ((done (make-symbol "eglot-catch")) id-and-timer
- (res
- (unwind-protect
- (catch done
- (setq
- id-and-timer
- (eglot--async-request
- server method params
- :success-fn (lambda (result) (throw done `(done ,result)))
- :timeout-fn (lambda () (throw done
- `(error
- ,(format "Request id=%s timed out"
- (car id-and-timer)))))
- :error-fn (eglot--lambda (&key code message _data)
- (throw done `(error
- ,(format "Ooops: %s: %s" code message))))
- :deferred deferred))
- (while t (accept-process-output nil 30)))
- (pcase-let ((`(,id ,timer) id-and-timer))
- (when id (remhash id (eglot--pending-continuations server)))
- (when timer (cancel-timer timer))))))
- (when (eq 'error (car res)) (eglot--error (cadr res)))
- (cadr res)))
-
-(cl-defun eglot--notify (server method params)
- "Notify SERVER of something, don't expect a reply."
- (eglot--send server `(:jsonrpc "2.0" :method ,method :params ,params)))
-
-(cl-defun eglot--reply (server id &key result error)
- "Reply to PROCESS's request ID with MESSAGE."
- (eglot--send
- server `(:jsonrpc "2.0" :id ,id
- ,@(when result `(:result ,result))
- ,@(when error `(:error ,error)))))
+(defvar eglot-connect-hook nil "Hook run after connecting in `eglot--connect'.")
+
+(defun eglot--connect (managed-major-mode project class contact)
+ "Connect to MANAGED-MAJOR-MODE, PROJECT, CLASS and CONTACT.
+This docstring appeases checkdoc, that's all."
+ (let* ((nickname (file-name-base (directory-file-name
+ (car (project-roots project)))))
+ (readable-name (format "EGLOT (%s/%s)" nickname managed-major-mode))
+ (initargs
+ (cond ((keywordp (car contact)) contact)
+ ((integerp (cadr contact))
+ `(:process ,(lambda ()
+ (apply #'open-network-stream
+ readable-name nil
+ (car contact) (cadr contact)
+ (cddr contact)))))
+ ((stringp (car contact))
+ `(:process ,(lambda ()
+ (make-process
+ :name readable-name
+ :command contact
+ :connection-type 'pipe
+ :coding 'utf-8-emacs-unix
+ :stderr (get-buffer-create
+ (format "*%s stderr*" readable-name))))))))
+ (spread
+ (lambda (fn)
+ (lambda (&rest args)
+ (apply fn (append (butlast args) (car (last args)))))))
+ (server
+ (apply
+ #'make-instance class
+ :name readable-name
+ :notification-dispatcher (funcall spread #'eglot-handle-notification)
+ :request-dispatcher (funcall spread #'eglot-handle-request)
+ :on-shutdown #'eglot--on-shutdown
+ initargs))
+ success)
+ (setf (eglot--saved-initargs server) initargs)
+ (setf (eglot--project server) project)
+ (setf (eglot--project-nickname server) nickname)
+ (setf (eglot--major-mode server) managed-major-mode)
+ (push server (gethash project eglot--servers-by-project))
+ (run-hook-with-args 'eglot-connect-hook server)
+ (unwind-protect
+ (cl-destructuring-bind (&key capabilities)
+ (jsonrpc-request
+ server
+ :initialize
+ (list :processId (unless (eq (jsonrpc-process-type server) 'network)
+ (emacs-pid))
+ :rootPath (expand-file-name
+ (car (project-roots project)))
+ :rootUri (eglot--path-to-uri
+ (car (project-roots project)))
+ :initializationOptions (eglot-initialization-options server)
+ :capabilities (eglot-client-capabilities server)))
+ (setf (eglot--capabilities server) capabilities)
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (eglot--maybe-activate-editing-mode server)))
+ (jsonrpc-notify server :initialized `(:__dummy__ t))
+ (setf (eglot--inhibit-autoreconnect server)
+ (cond
+ ((booleanp eglot-autoreconnect) (not eglot-autoreconnect))
+ ((cl-plusp eglot-autoreconnect)
+ (run-with-timer eglot-autoreconnect nil
+ (lambda ()
+ (setf (eglot--inhibit-autoreconnect server)
+ (null eglot-autoreconnect)))))))
+ (setq success server))
+ (when (and (not success) (jsonrpc-running-p server))
+ (eglot-shutdown server)))))
\f
;;; Helpers (move these to API?)
(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
(when (eglot--server-capable :workspaceSymbolProvider)
- (mapcar (eglot--lambda (&key name location &allow-other-keys)
- (cl-destructuring-bind (&key uri range) location
- (eglot--xref-make name uri (plist-get range :start))))
- (eglot--request (eglot--current-server-or-lose)
- :workspace/symbol
- (list :query pattern)))))
+ (mapcar
+ (jsonrpc-lambda (&key name location &allow-other-keys)
+ (cl-destructuring-bind (&key uri range) location
+ (eglot--xref-make name uri (plist-get range :start))))
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :workspace/symbol
+ `(:query ,pattern)))))
- (eglot--request
+ (defun eglot-format-buffer ()
+ "Format contents of current buffer."
+ (interactive)
+ (unless (eglot--server-capable :documentFormattingProvider)
+ (eglot--error "Server can't format!"))
+ (eglot--apply-text-edits
- :textDocument/formatting)))
++ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ :textDocument/formatting
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :options (list :tabSize tab-width
+ :insertSpaces
+ (if indent-tabs-mode :json-false t)))
++ :deferred :textDocument/formatting)))
+
(defun eglot-completion-at-point ()
"EGLOT's `completion-at-point' function."
(let ((bounds (bounds-of-thing-at-point 'symbol))
(defun eglot--apply-text-edits (edits &optional version)
"Apply EDITS for current buffer if at VERSION, or if it's nil."
(unless (or (not version) (equal version eglot--versioned-identifier))
- (jsonrpc-error "Edits on `%s' require version %d, we have %d"
- (eglot--error "Edits on `%s' require version %d, you have %d"
- (current-buffer) version eglot--versioned-identifier))
++ (jsonrpc-error "Edits on `%s' require version %d, you have %d"
+ (current-buffer) version eglot--versioned-identifier))
- (eglot--widening
- (mapc (pcase-lambda (`(,newText ,beg . ,end))
- (goto-char beg) (delete-region beg end) (insert newText))
- (mapcar (jsonrpc-lambda (&key range newText)
- (cons newText (eglot--range-region range 'markers)))
- edits)))
- (eglot--message "%s: Performed %s edits" (current-buffer) (length edits)))
+ (atomic-change-group
+ (let* ((change-group (prepare-change-group))
+ (howmany (length edits))
+ (reporter (make-progress-reporter
+ (format "[eglot] applying %s edits to `%s'..."
+ howmany (current-buffer))
+ 0 howmany))
+ (done 0))
+ (mapc (pcase-lambda (`(,newText ,beg . ,end))
+ (let ((source (current-buffer)))
+ (with-temp-buffer
+ (insert newText)
+ (let ((temp (current-buffer)))
+ (with-current-buffer source
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (replace-buffer-contents temp)))
+ (progress-reporter-update reporter (cl-incf done)))))))
- (mapcar (eglot--lambda (&key range newText)
++ (mapcar (jsonrpc-lambda (&key range newText)
+ (cons newText (eglot--range-region range 'markers)))
+ edits))
+ (undo-amalgamate-change-group change-group)
+ (progress-reporter-done reporter))))
(defun eglot--apply-workspace-edit (wedit &optional confirm)
"Apply the workspace edit WEDIT. If CONFIRM, ask user first."