(eglot-shutdown process interactive))
(eglot--connect (eglot--project process)
(eglot--major-mode process)
- (eglot--short-name process)
- (eglot--contact process)
- interactive)
+ (jrpc-name process)
+ (jrpc-contact process))
(eglot--message "Reconnected!"))
-(defun eglot--process-sentinel (proc change)
- "Called when PROC undergoes CHANGE."
- (eglot--log-event proc `(:message "Process state changed" :change ,change))
- (when (not (process-live-p proc))
- (with-current-buffer (eglot-events-buffer proc)
- (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 proc))
- (maphash (lambda (_id watches)
- (mapcar #'file-notify-rm-watch watches))
- (eglot--file-watches proc))
- (unwind-protect
- ;; Call all outstanding error handlers
- (maphash (lambda (_id triplet)
- (cl-destructuring-bind (_success error _timeout) triplet
- (funcall error :code -1 :message (format "Server died"))))
- (eglot--pending-continuations proc))
- ;; Turn off `eglot--managed-mode' where appropriate.
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (when (eglot--buffer-managed-p proc)
- (eglot--managed-mode -1))))
- ;; Forget about the process-project relationship
- (setf (gethash (eglot--project proc) eglot--processes-by-project)
- (delq proc
- (gethash (eglot--project proc) eglot--processes-by-project)))
- (eglot--message "Server exited with status %s" (process-exit-status proc))
- (cond ((eglot--moribund proc))
- ((not (eglot--inhibit-autoreconnect proc))
- (eglot--warn "Reconnecting after unexpected server exit")
- (eglot-reconnect proc))
- ((timerp (eglot--inhibit-autoreconnect proc))
- (eglot--warn "Not auto-reconnecting, last on didn't last long.")))
- (delete-process proc))))
+(defalias 'eglot-events-buffer 'jrpc-events-buffer)
-(defun eglot--process-filter (proc string)
- "Called when new data STRING has arrived for PROC."
- (when (buffer-live-p (process-buffer proc))
- (with-current-buffer (process-buffer proc)
- (let ((inhibit-read-only t)
- (expected-bytes (eglot--expected-bytes proc)))
- ;; 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
- (let (done)
- (while (not done)
+(defvar eglot-connect-hook nil "Hook run after connecting in `eglot--connect'.")
+
+(defun eglot--dispatch (proc method id params)
+ "Dispatcher passed to `jrpc-connect'.
+Builds a function from METHOD, passes it PROC, ID and PARAMS."
+ (let* ((handler-sym (intern (concat "eglot--server-" method))))
- (if (functionp handler-sym)
++ (if (functionp handler-sym) ;; FIXME: fails if params is array, not object
+ (apply handler-sym proc (append params (if id `(:id ,id))))
+ (jrpc-reply proc id
+ :error (jrpc-obj :code -32601 :message "Unimplemented")))))
+
+(defun eglot--connect (project managed-major-mode name contact)
+ (let* ((contact (if (functionp contact) (funcall contact) contact))
+ (proc (jrpc-connect name contact #'eglot--dispatch #'eglot--on-shutdown))
+ success)
+ (setf (eglot--project proc) project)
+ (setf (eglot--major-mode proc)managed-major-mode)
+ (push proc (gethash project eglot--processes-by-project))
+ (run-hook-with-args 'eglot-connect-hook proc)
+ (unwind-protect
+ (cl-destructuring-bind (&key capabilities)
+ (jrpc-request
+ proc
+ :initialize
+ (jrpc-obj :processId (unless (eq (process-type proc)
+ 'network)
+ (emacs-pid))
+ :rootPath (car (project-roots project))
+ :rootUri (eglot--path-to-uri
+ (car (project-roots project)))
+ :initializationOptions []
+ :capabilities (eglot--client-capabilities)))
+ (setf (eglot--capabilities proc) capabilities)
+ (setf (jrpc-status proc) nil)
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (eglot--maybe-activate-editing-mode proc)))
+ (jrpc-notify proc :initialized (jrpc-obj :__dummy__ t))
+ (setf (eglot--inhibit-autoreconnect proc)
(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--process-receive proc 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
- ;;
- (setf (eglot--expected-bytes proc) expected-bytes))))))
-
-(defun eglot-events-buffer (process &optional interactive)
- "Display events buffer for current LSP connection PROCESS.
-INTERACTIVE is t if called interactively."
- (interactive (list (eglot--current-process-or-lose) t))
- (let* ((probe (eglot--events-buffer process))
- (buffer (or (and (buffer-live-p probe)
- probe)
- (let ((buffer (get-buffer-create
- (format "*%s events*"
- (process-name process)))))
- (with-current-buffer buffer
- (buffer-disable-undo)
- (read-only-mode t)
- (setf (eglot--events-buffer process) buffer))
- buffer))))
- (when interactive (display-buffer buffer))
- buffer))
-
-(defun eglot--log-event (proc message &optional type)
- "Log an eglot-related event.
-PROC is the current process. 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 proc)
- (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--process-receive (proc message)
- "Process MESSAGE from PROC."
- (cl-destructuring-bind (&key method id params error result _jsonrpc) message
- (let* ((continuations (and id
- (not method)
- (gethash id (eglot--pending-continuations proc)))))
- (eglot--log-event proc message 'server)
- (when error (setf (eglot--status proc) `(,error t)))
- (cond (method
- ;; a server notification or a server request
- (let* ((handler-sym (intern (concat "eglot--server-" method))))
- (if (functionp handler-sym)
- ;; FIXME: will fail if params is array instead of not an object
- (apply handler-sym proc (append params (if id `(:id ,id))))
- (eglot--warn "No implementation of method %s yet" method)
- (when id
- (eglot--reply
- proc id
- :error `(:code -32601 :message "Method unimplemented"))))))
- (continuations
- (cancel-timer (cl-third continuations))
- (remhash id (eglot--pending-continuations proc))
- (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 proc)
- (force-mode-line-update t))))
-
-(defun eglot--process-send (proc message)
- "Send MESSAGE to PROC (ID is optional)."
- (let ((json (json-encode message)))
- (process-send-string proc (format "Content-Length: %d\r\n\r\n%s"
- (string-bytes json)
- json))
- (eglot--log-event proc message 'client)))
-
-(defvar eglot--next-request-id 0 "ID for next request.")
-
-(defun eglot--next-request-id ()
- "Compute the next id for a client request."
- (setq eglot--next-request-id (1+ eglot--next-request-id)))
-
-(defun eglot-forget-pending-continuations (process)
- "Stop waiting for responses from the current LSP PROCESS."
- (interactive (list (eglot--current-process-or-lose)))
- (clrhash (eglot--pending-continuations process)))
-
-(defun eglot-clear-status (process)
- "Clear most recent error message from PROCESS."
- (interactive (list (eglot--current-process-or-lose)))
- (setf (eglot--status process) nil))
-
-(defun eglot--call-deferred (proc)
- "Call PROC's deferred actions, who may again defer themselves."
- (when-let ((actions (hash-table-values (eglot--deferred-actions proc))))
- (eglot--log-event proc `(:running-deferred ,(length actions)))
- (mapc #'funcall (mapcar #'car actions))))
-
-(defvar eglot--ready-predicates '(eglot--server-ready-p)
- "Special hook of predicates controlling deferred actions.
-If one of these returns nil, a deferrable `eglot--async-request'
-will be deferred. Each predicate is passed the symbol for the
-request request and a process object.")
+ ((booleanp eglot-autoreconnect) (not eglot-autoreconnect))
+ ((cl-plusp eglot-autoreconnect)
+ (run-with-timer eglot-autoreconnect nil
+ (lambda ()
+ (setf (eglot--inhibit-autoreconnect proc)
+ (null eglot-autoreconnect)))))))
+ (setq success proc))
+ (unless (or success (not (process-live-p proc)) (eglot--moribund proc))
+ (eglot-shutdown proc)))))
(defun eglot--server-ready-p (_what _proc)
"Tell if server of PROC ready for processing deferred WHAT."
(defun eglot--server-capable (feat)
"Determine if current server is capable of FEAT."
- (plist-get (eglot--capabilities (eglot--current-process-or-lose)) feat))
+ (plist-get (eglot--capabilities (jrpc-current-process-or-lose)) feat))
- (cl-defmacro eglot--with-lsp-range ((start end) range &body body
- &aux (range-sym (cl-gensym)))
- "Bind LSP RANGE to START and END. Evaluate BODY."
- (declare (indent 2) (debug (sexp sexp &rest form)))
- `(let* ((,range-sym ,range)
- (,start (eglot--lsp-position-to-point (plist-get ,range-sym :start)))
- (,end (eglot--lsp-position-to-point (plist-get ,range-sym :end))))
- ,@body))
+ (defun eglot--range-region (range)
+ "Return region (BEG . END) that represents LSP RANGE."
+ (cons (eglot--lsp-position-to-point (plist-get range :start))
+ (eglot--lsp-position-to-point (plist-get range :end))))
\f
;;; Minor modes
(location-or-locations
(if rich-identifier
(get-text-property 0 :locations rich-identifier)
- (eglot--request (eglot--current-process-or-lose)
- :textDocument/definition
- (get-text-property
- 0 :textDocumentPositionParams identifier)))))
- (mapcar (eglot--lambda (&key uri range)
- (eglot--xref-make identifier uri (plist-get range :start)))
- location-or-locations)))
+ (jrpc-request (jrpc-current-process-or-lose)
+ :textDocument/definition
+ (get-text-property
+ 0 :textDocumentPositionParams identifier)))))
- (mapcar
- (jrpc-lambda (&key uri range)
++ (mapcar (jrpc-lambda (&key uri range)
+ (eglot--xref-make identifier uri (plist-get range :start)))
+ location-or-locations)))
(cl-defmethod xref-backend-references ((_backend (eql eglot)) identifier)
(unless (eglot--server-capable :referencesProvider)
(mapc #'delete-overlay eglot--highlights)
(setq eglot--highlights
(when-buffer-window
- (mapcar (eglot--lambda (&key range _kind)
- (pcase-let ((`(,beg . ,end)
- (eglot--range-region range)))
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face 'highlight)
- (overlay-put ov 'evaporate t)
- ov)))
- highlights))))
+ (mapcar
+ (jrpc-lambda (&key range _kind)
- (eglot--with-lsp-range (beg end) range
++ (pcase-let ((`(,beg . ,end)
++ (eglot--range-region range)))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'highlight)
+ (overlay-put ov 'evaporate t)
+ ov)))
+ highlights))))
:deferred :textDocument/documentHighlight))))
nil)
projects / emacs.git / commitdiff