diff --git a/lsp-mode.el b/lsp-mode.el index a09588144f..6d5e7455d1 100644 --- a/lsp-mode.el +++ b/lsp-mode.el @@ -7332,38 +7332,71 @@ server. WORKSPACE is the active workspace." (defun lsp--parser-on-message (json-data workspace) "Called when the parser P read a complete MSG from the server." - (with-demoted-errors "Error processing message %S." - (with-lsp-workspace workspace - (let* ((client (lsp--workspace-client workspace)) - (id (--when-let (lsp:json-response-id json-data) - (if (stringp it) (string-to-number it) it))) - (data (lsp:json-response-result json-data))) - (pcase (lsp--get-message-type json-data) - ('response - (cl-assert id) - (-let [(callback _ method _ before-send) (gethash id (lsp--client-response-handlers client))] - (when (lsp--log-io-p method) - (lsp--log-entry-new - (lsp--make-log-entry method id data 'incoming-resp - (lsp--ms-since before-send)) - workspace)) - (when callback - (remhash id (lsp--client-response-handlers client)) - (funcall callback (lsp:json-response-result json-data))))) - ('response-error - (cl-assert id) - (-let [(_ callback method _ before-send) (gethash id (lsp--client-response-handlers client))] - (when (lsp--log-io-p method) - (lsp--log-entry-new - (lsp--make-log-entry method id (lsp:json-response-error-error json-data) - 'incoming-resp (lsp--ms-since before-send)) - workspace)) - (when callback - (remhash id (lsp--client-response-handlers client)) - (funcall callback (lsp:json-response-error-error json-data))))) - ('notification - (lsp--on-notification workspace json-data)) - ('request (lsp--on-request workspace json-data))))))) + (cl-labels ((json-get (obj key) + (cond + ((hash-table-p obj) + (gethash key obj)) + ((listp obj) + (or (plist-get obj (intern (concat ":" key))) + (plist-get obj (intern key)))) + (t nil)))) + ;; Silently catch and log any errors during message processing. This prevents + ;; a single malformed message from crashing the entire LSP client. + (with-demoted-errors "Error processing message %S." + (with-lsp-workspace workspace + (let* ((client (lsp--workspace-client workspace)) + (method (json-get json-data "method")) + (raw-id (json-get json-data "id")) + (has-method (not (null method))) + (has-id (not (null raw-id))) + (has-error (not (null (json-get json-data "error")))) + ;; Kind-First routing: if a method exists, it's a server-initiated + ;; message (request/notification) regardless of ID collisions. + (message-type (cond + (has-method (if has-id 'request 'notification)) + (has-id (if has-error 'response-error 'response)) + (t 'notification))) + ;; Normalize response IDs only (client-generated ids are numeric). + (id (and (memq message-type '(response response-error)) + raw-id + (if (stringp raw-id) (string-to-number raw-id) raw-id)))) + (pcase message-type + ('response + (when id + (let ((handler (gethash id (lsp--client-response-handlers client)))) + (when handler + (let ((callback (nth 0 handler)) + (cb-method (nth 2 handler)) + (before-send (nth 4 handler)) + (result (json-get json-data "result"))) + (when (lsp--log-io-p cb-method) + (lsp--log-entry-new + (lsp--make-log-entry cb-method id result 'incoming-resp + (lsp--ms-since before-send)) + workspace)) + (when callback + (remhash id (lsp--client-response-handlers client)) + (funcall callback result))))))) + ('response-error + (when id + (let ((handler (gethash id (lsp--client-response-handlers client)))) + (when handler + (let ((err-callback (nth 1 handler)) + (cb-method (nth 2 handler)) + (before-send (nth 4 handler)) + (err (json-get json-data "error"))) + (when (lsp--log-io-p cb-method) + (lsp--log-entry-new + (lsp--make-log-entry cb-method id err 'incoming-resp + (lsp--ms-since before-send)) + workspace)) + (when err-callback + (remhash id (lsp--client-response-handlers client)) + (funcall err-callback err))))))) + ('notification + (lsp--on-notification workspace json-data)) + ('request + (lsp--on-request workspace json-data)))))))) (defun lsp--create-filter-function (workspace) "Make filter for the workspace."