@@ -7151,69 +7151,44 @@ server. WORKSPACE is the active workspace."
7151
7151
('request (lsp--on-request workspace json-data)))))))
7152
7152
7153
7153
(defun lsp--create-filter-function (workspace)
7154
- "Make filter for the workspace."
7155
- (let ((body-received 0)
7156
- leftovers body-length body chunk)
7154
+ "Efficiently filter/process LSP messages for WORKSPACE.
7155
+ Accumulates incoming LSP data in a buffer, parses headers to find
7156
+ Content-Length, then extracts and decodes complete JSON messages for processing."
7157
+ (let ((input-buffer (generate-new-buffer " *lsp-input*"))
7158
+ (json-body-buffer (generate-new-buffer " *lsp-json-body*")))
7157
7159
(lambda (_proc input)
7158
- (setf chunk (if (s-blank? leftovers)
7159
- (encode-coding-string input 'utf-8-unix t)
7160
- (concat leftovers (encode-coding-string input 'utf-8-unix t))))
7161
-
7162
- (let (messages)
7163
- (while (not (s-blank? chunk))
7164
- (if (not body-length)
7165
- ;; Read headers
7166
- (if-let* ((body-sep-pos (string-match-p "\r\n\r\n" chunk)))
7167
- ;; We've got all the headers, handle them all at once:
7168
- (setf body-length (lsp--get-body-length
7169
- (mapcar #'lsp--parse-header
7170
- (split-string
7171
- (substring-no-properties chunk
7172
- (or (string-match-p "Content-Length" chunk)
7173
- (error "Unable to find Content-Length header."))
7174
- body-sep-pos)
7175
- "\r\n")))
7176
- body-received 0
7177
- leftovers nil
7178
- chunk (substring-no-properties chunk (+ body-sep-pos 4)))
7179
-
7180
- ;; Haven't found the end of the headers yet. Save everything
7181
- ;; for when the next chunk arrives and await further input.
7182
- (setf leftovers chunk
7183
- chunk nil))
7184
- (let* ((chunk-length (string-bytes chunk))
7185
- (left-to-receive (- body-length body-received))
7186
- (this-body (if (< left-to-receive chunk-length)
7187
- (prog1 (substring-no-properties chunk 0 left-to-receive)
7188
- (setf chunk (substring-no-properties chunk left-to-receive)))
7189
- (prog1 chunk
7190
- (setf chunk nil))))
7191
- (body-bytes (string-bytes this-body)))
7192
- (push this-body body)
7193
- (setf body-received (+ body-received body-bytes))
7194
- (when (>= chunk-length left-to-receive)
7195
- (condition-case err
7196
- (with-temp-buffer
7197
- (apply #'insert
7198
- (nreverse
7199
- (prog1 body
7200
- (setf leftovers nil
7201
- body-length nil
7202
- body-received nil
7203
- body nil))))
7204
- (decode-coding-region (point-min)
7205
- (point-max)
7206
- 'utf-8)
7207
- (goto-char (point-min))
7208
- (push (lsp-json-read-buffer) messages))
7209
-
7210
- (error
7211
- (lsp-warn "Failed to parse the following chunk:\n'''\n%s\n'''\nwith message %s"
7212
- (concat leftovers input)
7213
- err)))))))
7214
- (mapc (lambda (msg)
7215
- (lsp--parser-on-message msg workspace))
7216
- (nreverse messages))))))
7160
+ (with-current-buffer input-buffer
7161
+ ;; Insert raw input at the end as UTF-8 (no decode yet)
7162
+ (goto-char (point-max))
7163
+ (insert (encode-coding-string input 'utf-8-unix t))
7164
+ (goto-char (point-min))
7165
+ (cl-loop
7166
+ ;; Try to parse messages as long as possible
7167
+ while (let* ((header-end (search-forward "\r\n\r\n" nil t))
7168
+ (content-length-start (search-backward "Content-Length:" nil t)))
7169
+ (when header-end
7170
+ (let* ((headers (buffer-substring content-length-start (- header-end 4)))
7171
+ (header-lines (split-string headers "\r\n" t))
7172
+ (parsed-headers (mapcar #'lsp--parse-header header-lines))
7173
+ (body-length (lsp--get-body-length parsed-headers))
7174
+ (body-start header-end)
7175
+ (body-end (+ header-end body-length)))
7176
+ (when (<= body-end (point-max))
7177
+ ;; Copy and decode body
7178
+ (with-current-buffer json-body-buffer
7179
+ (erase-buffer)
7180
+ (insert-buffer-substring input-buffer body-start body-end)
7181
+ (decode-coding-region (point-min) (point-max) 'utf-8)
7182
+ (goto-char (point-min))
7183
+ (condition-case err
7184
+ (let ((msg (lsp-json-read-buffer)))
7185
+ (lsp--parser-on-message msg workspace))
7186
+ (error
7187
+ (message "LSP JSON parse error: %S" err))))
7188
+ ;; Remove processed data
7189
+ (delete-region (point-min) body-end)
7190
+ (goto-char (point-min))
7191
+ t)))))))))
7217
7192
7218
7193
(defvar-local lsp--line-col-to-point-hash-table nil
7219
7194
"Hash table with keys (line . col) and values that are either point positions
0 commit comments