(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))
+ (unless (or (null method) (keywordp method))
(setq method (intern (format ":%s" method))))
- (cond ((and method id)
- (condition-case-unless-debug _err
- (apply #'eglot-handle-request server id method params)
- (cl-no-applicable-method
- (eglot--reply server id
- :error `(:code -32601 :message "Method unimplemented")))))
- (method
- (condition-case-unless-debug _err
- (apply #'eglot-handle-notification server method params)
- (cl-no-applicable-method
- (eglot--debug server "Notification unimplemented: %s" method))))
- (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)))
+ (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--log-event
++ (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--call-deferred (server)
"Call SERVER's deferred actions, who may again defer themselves."
(when-let ((actions (hash-table-values (eglot--deferred-actions server))))
- (eglot--log-event server `(:maybe-run-deferred ,(mapcar #'caddr actions)))
- (eglot--debug server "running %d deferred actions" (length actions))
++ (eglot--debug server `(:maybe-run-deferred ,(mapcar #'caddr actions)))
(mapc #'funcall (mapcar #'car actions))))
(cl-defmacro eglot--lambda (cl-lambda-list &body body)
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 timeout keeps counting). Return a list (ID
-TIMER)."
- (let* ((id (eglot--next-request-id))
- (timer nil)
- (make-timer
- (lambda ( )
- (or timer
- (run-with-timer
- timeout nil
- (lambda ()
- (remhash id (eglot--pending-continuations server))
- (funcall (or timeout-fn
- (lambda ()
- (eglot--log-event
- server `(:timed-out ,method :id ,id
- :params ,params)))))))))))
+happens, the original timer keeps counting). Return (ID TIMER)."
+ (pcase-let* ( (buf (current-buffer)) (pos (point-marker))
+ (`(,_ ,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--log-event
++ (eglot--debug
+ server `(:timed-out ,method :id ,id :params ,params))))))))
(when deferred
- (let* ((buf (current-buffer))
- (existing (gethash (list deferred buf)
- (eglot--deferred-actions server))))
- (when existing (setq existing (cadr existing)))
- (if (eglot-server-ready-p server deferred)
- (remhash (list deferred buf) (eglot--deferred-actions server))
- (eglot--debug server "deferring %s (id %s)" method id)
- (let* ((buf (current-buffer)) (point (point))
- (later (lambda ()
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (save-excursion
- (goto-char point)
- (apply #'eglot--async-request server
- method params args)))))))
- (puthash (list deferred buf)
- (list later (setq timer (funcall make-timer)))
- (eglot--deferred-actions server))
- (cl-return-from eglot--async-request nil)))))
- ;; Really run it
- ;;
- (eglot--send server (eglot--obj :jsonrpc "2.0"
- :id id
- :method method
- :params params))
- (puthash id
- (list (or success-fn
- (eglot--lambda (&rest _ignored)
- (eglot--debug server "%s success ignored (id %s)" method id)))
- (or error-fn
- (eglot--lambda (&key code message &allow-other-keys)
- (setf (eglot--status server) `(,message t))
- server (eglot--obj :message "error ignored, status set"
- :id id :error code)))
- (setq timer (funcall make-timer)))
+ (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--log-event server `(:deferring ,method :id ,id :params ,params)))
++ (eglot--debug server `(:deferring ,method :id ,id :params ,params)))
+ (puthash (list deferred buf)
+ (list (lambda () (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char pos)
+ (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--log-event
++ (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)))
+ (or timer (funcall make-timer)))
(eglot--pending-continuations server))
(list id timer)))
(let ((warning-minimum-level :error))
(display-warning 'eglot (apply #'format format args) :warning)))
- "Warning message with FORMAT and ARGS."
- (eglot--log-event server `(:message ,(format format args))))
+ (defun eglot--debug (server format &rest args)
++ "Debug message for SERVER with FORMAT and ARGS."
++ (eglot--log-event
++ server (if (stringp format)`(:message ,(format format args)) format)))
+
(defun eglot--pos-to-lsp-position (&optional pos)
"Convert point POS to LSP position."
(save-excursion
(funcall (or eglot--current-flymake-report-fn #'ignore)
eglot--unreported-diagnostics)))))
- ((server eglot-cquery) (_method (eql :$cquery/progress))
- &rest counts &key activeThreads &allow-other-keys)
+ \f
+ ;;; cquery-specific
+ ;;;
+ (defclass eglot-cquery (eglot-lsp-server) ()
+ :documentation "cquery's C/C++ langserver.")
+
+ (cl-defmethod eglot-initialization-options ((server eglot-cquery))
+ "Passes through required cquery initialization options"
+ (let* ((root (car (project-roots (eglot--project server))))
+ (cache (expand-file-name ".cquery_cached_index/" root)))
+ (vector :cacheDirectory (file-name-as-directory cache)
+ :progressReportFrequencyMs -1)))
+
+ (cl-defmethod eglot-handle-notification
- ((server eglot-cquery) (_method (eql :$cquery/setInactiveRegions))
- &key uri inactiveRegions &allow-other-keys)
++ ((_server eglot-cquery) (_method (eql :$cquery/progress))
++ &rest counts &key _activeThreads &allow-other-keys)
+ "No-op for noisy $cquery/progress extension")
+
+ (cl-defmethod eglot-handle-notification
- ((server eglot-cquery) (_method (eql :$cquery/publishSemanticHighlighting))
- &key uri symbols &allow-other-keys)
++ ((_server eglot-cquery) (_method (eql :$cquery/setInactiveRegions))
++ &key _uri _inactiveRegions &allow-other-keys)
+ "No-op for unsupported $cquery/setInactiveRegions extension")
+
+ (cl-defmethod eglot-handle-notification
++ ((_server eglot-cquery) (_method (eql :$cquery/publishSemanticHighlighting))
++ &key _uri _symbols &allow-other-keys)
+ "No-op for unsupported $cquery/publishSemanticHighlighting extension")
+
(provide 'eglot)
;;; eglot.el ends here
projects / emacs.git / commitdiff