Refactor lsp--create-filter-function for better performance

Author: eval-exec

CHANGELOG.org

@@ -1,5 +1,6 @@
 * Changelog
 ** Unreleased 9.0.1
+  * refactor lsp--create-filter-function for better performance
   * Add format on save support
   * Fix beancount journal file init option
   * Add support for [[https://github.com/glehmann/earthlyls][earthlyls]]

lsp-mode.el

@@ -7150,69 +7150,52 @@ server. WORKSPACE is the active workspace."
           ('request (lsp--on-request workspace json-data)))))))
 
 (defun lsp--create-filter-function (workspace)
-  "Make filter for the workspace."
-  (let ((body-received 0)
-        leftovers body-length body chunk)
-    (lambda (_proc input)
-      (setf chunk (if (s-blank? leftovers)
-                      (encode-coding-string input 'utf-8-unix t)
-                    (concat leftovers (encode-coding-string input 'utf-8-unix t))))
-
-      (let (messages)
-        (while (not (s-blank? chunk))
-          (if (not body-length)
-              ;; Read headers
-              (if-let* ((body-sep-pos (string-match-p "\r\n\r\n" chunk)))
-                  ;; We've got all the headers, handle them all at once:
-                  (setf body-length (lsp--get-body-length
-                                     (mapcar #'lsp--parse-header
-                                             (split-string
-                                              (substring-no-properties chunk
-                                                                       (or (string-match-p "Content-Length" chunk)
-                                                                           (error "Unable to find Content-Length header."))
-                                                                       body-sep-pos)
-                                              "\r\n")))
-                        body-received 0
-                        leftovers nil
-                        chunk (substring-no-properties chunk (+ body-sep-pos 4)))
-
-                ;; Haven't found the end of the headers yet. Save everything
-                ;; for when the next chunk arrives and await further input.
-                (setf leftovers chunk
-                      chunk nil))
-            (let* ((chunk-length (string-bytes chunk))
-                   (left-to-receive (- body-length body-received))
-                   (this-body (if (< left-to-receive chunk-length)
-                                  (prog1 (substring-no-properties chunk 0 left-to-receive)
-                                    (setf chunk (substring-no-properties chunk left-to-receive)))
-                                (prog1 chunk
-                                  (setf chunk nil))))
-                   (body-bytes (string-bytes this-body)))
-              (push this-body body)
-              (setf body-received (+ body-received body-bytes))
-              (when (>= chunk-length left-to-receive)
-                (condition-case err
-                    (with-temp-buffer
-                      (apply #'insert
-                             (nreverse
-                              (prog1 body
-                                (setf leftovers nil
-                                      body-length nil
-                                      body-received nil
-                                      body nil))))
-                      (decode-coding-region (point-min)
-                                            (point-max)
-                                            'utf-8)
-                      (goto-char (point-min))
-                      (push (lsp-json-read-buffer) messages))
-
-                  (error
-                   (lsp-warn "Failed to parse the following chunk:\n'''\n%s\n'''\nwith message %s"
-                             (concat leftovers input)
-                             err)))))))
-        (mapc (lambda (msg)
-                (lsp--parser-on-message msg workspace))
-              (nreverse messages))))))
+    "Efficient, low-latency filter for the workspace."
+    (let ((header-done nil)
+           (body-length nil)
+           (body-buffer (generate-new-buffer " *lsp-body*")))
+      (lambda (_proc input)
+        (with-current-buffer body-buffer
+          (goto-char (point-max))
+          ;; Always insert input directly; avoid string concat.
+          (insert (encode-coding-string input 'utf-8-unix t))
+          (goto-char (point-min))
+          ;; Loop for as long as there's a full message in the buffer.
+          (cl-loop
+            ;; Stop only if at buffer end or incomplete message.
+            while (< (point) (point-max))
+            do
+            (unless header-done
+              (let ((header-end (search-forward "\r\n\r\n" nil t)))
+                (unless header-end
+                  ;; Incomplete header, wait for more input
+                  (cl-return))
+                (let* ((headers (buffer-substring-no-properties (point-min) (- header-end 4)))
+                        (parsed (mapcar #'lsp--parse-header (split-string headers "\r\n"))))
+                  (setq body-length (lsp--get-body-length parsed))
+                  (setq header-done t)
+                  (delete-region (point-min) header-end)
+                  (goto-char (point-min)))))
+            (when (and header-done body-length)
+              (let ((bytes-available (- (point-max) (point))))
+                (if (>= bytes-available body-length)
+                  (let ((json-start (point))
+                         (json-end (+ (point) body-length)))
+                    (decode-coding-region json-start json-end 'utf-8)
+                    (goto-char json-start)
+                    (condition-case err
+                      (let ((msg (lsp-json-read-buffer)))
+                        ;; IMMEDIATELY dispatch as soon as we get one full message:
+                        (lsp--parser-on-message msg workspace))
+                      (error
+                        (lsp-warn "Failed to parse chunk with message %s" err)))
+                    (delete-region (point-min) json-end)
+                    ;; Reset for next message
+                    (setq header-done nil)
+                    (setq body-length nil)
+                    (goto-char (point-min))) ; Start parsing next message (if any)
+                  ;; Not enough body yet; wait for more data
+                  (cl-return)))))))))
 
 (defvar-local lsp--line-col-to-point-hash-table nil
   "Hash table with keys (line . col) and values that are either point positions