From: João Távora Date: Sat, 26 May 2018 18:10:45 +0000 (+0100) Subject: Merge branch 'cquery-support' into master X-Git-Tag: emacs-29.0.90~1616^2~524^2~4^2~537 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d366cc04b706d02e26016fba470240ba2fa7a8a2;p=emacs.git Merge branch 'cquery-support' into master The conflicts in eglot.el where fixed by calling the new eglot--debug helper coming from 'cquery-support'. This helper was converted to allow a non-string format passed directly to eglot--log-event. Also fixed some compilation warnings. * eglot.el (eglot--debug): Allow non-string FORMAT to be a JSON object. (eglot-handle-notification :$cquery/progress) (eglot-handle-notification :$cquery/setInactiveRegions) (eglot-handle-notification :$cquery/publishSemanticHighlighting): Solve compilation warnings. --- d366cc04b706d02e26016fba470240ba2fa7a8a2 diff --cc lisp/progmodes/eglot.el index cc3fae1f54a,55fa40649c9..8d34b1be050 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@@ -575,28 -584,28 +577,28 @@@ originated. (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)))) @@@ -622,7 -637,7 +624,7 @@@ (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) @@@ -645,52 -658,58 +647,52 @@@ objects, respectively. Wait TIMEOUT se 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))) @@@ -751,6 -772,10 +753,11 @@@ DEFERRED is passed to `eglot--async-req (let ((warning-minimum-level :error)) (display-warning 'eglot (apply #'format format args) :warning))) + (defun eglot--debug (server format &rest args) - "Warning message with FORMAT and ARGS." - (eglot--log-event server `(:message ,(format format 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 @@@ -1590,6 -1617,34 +1597,34 @@@ Proceed? (funcall (or eglot--current-flymake-report-fn #'ignore) eglot--unreported-diagnostics))))) + + ;;; 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/progress)) - &rest counts &key activeThreads &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/setInactiveRegions)) - &key uri inactiveRegions &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) ++ ((_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