Eglot: spectacular optimization in files with many diagnostics

In a large (or simply long) file with many diagnostics, calling
eglot-range-region repeteadly constantly throws Emacs for a spin
around the buffer, since each diagnostics comes annotated with a
(line/col): LSP range spec that is reasonably expensive to
translate into Elisp point positions.

A much faster approach for such large lists is to first sort all the
objects containing ranges by their start lines and then do a
single pass of the buffer, moving lines by delta.

By much faster, I do mean spectacularly (100x) faster. A long python
with 7000 "ruff" diagnostics, before the change, typical editor
operations (add/delete words) are impossible.

       14053  84%    - jsonrpc-connection-receive
       14052  84%     - #<byte-code-function B94>
       14052  84%      - apply
       14052  84%       - eglot-handle-notification
       14052  84%        - applyn
       14052  84%         - #<byte-code-function 6DB>
       14052  84%          - eglot--flymake-handle-push
       12295  74%           - eglot--flymake-make-diag
       12218  73%            + eglot-range-region
          50   0%            + eglot--check-object
          12   0%              plist-member
           3   0%              flymake-make-diagnostic

After the change:

          99   1%    - jsonrpc-connection-receive
          99   1%     - #<byte-code-function 0EE>
          99   1%      - apply
          99   1%       - eglot-handle-notification
          99   1%        - apply
          99   1%         - #<byte-code-function E84>
          99   1%          - eglot--flymake-handle-push
          99   1%           - eglot--call-with-ranged
          99   1%            - #<byte-code-function 2C6>
          99   1%             - eglot-move-to-utf-16-linepos
          99   1%                line-end-position

* lisp/progmodes/eglot.el (eglot-move-to-linepos-function):
Forward declare.
(eglot--call-with-ranged, eglot--collecting-ranged): New helpers.
(eglot--flymake-report-1)
(eglot--imenu-SymbolInformation): Use eglot--collecting-ranged.
(eglot--imenu-DocumentSymbol): Could use eglot--collecting-ranged.

* etc/EGLOT-NEWS: Mention it

2 files changed, 79 insertions, 19 deletions

diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS
index 8735e966ee9..3fe87d77690 100644
--- a/etc/EGLOT-NEWS
+++ b/etc/EGLOT-NEWS
@@ -20,6 +20,13 @@ https://github.com/joaotavora/eglot/issues/1234.
 
 * Changes to upcoming Eglot
 
+** Dramatically faster handling of files with many diagnostics
+
+Diagnostic conversion between LSP and Flymake versions is now much
+faster.  Previously, editing, e.g. a Python file with thousands of
+diagnostics was next to impossible to to periodic interruptions of
+diagnostic reports.  Now it's practically unnoticeable.
+
 ** Support for LSP server multiplexers via Rassumfrassum
 
 Eglot can now leverage LSP server multiplexer programs like Rassumfrassum
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index f7d38d8e417..82610d093ad 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -1280,6 +1280,61 @@ If optional MARKERS, make markers instead."
   (list :start (eglot--pos-to-lsp-position from)
         :end (eglot--pos-to-lsp-position to)))
 
+(defvar eglot-move-to-linepos-function)
+(cl-defun eglot--call-with-ranged (objs key fn &aux (curline 0))
+  (unless key
+    (setq key (lambda (o) (plist-get o :range))))
+  (cl-flet ((moveit (line col)
+              (forward-line (- line curline))
+              (setq curline line)
+              (unless (eobp)
+                (unless (wholenump col) (setq col 0))
+                (funcall eglot-move-to-linepos-function col))
+              (point)))
+    (eglot--widening
+     (goto-char (point-min))
+     (cl-loop
+      with pairs = (if key
+                       (mapcar (lambda (obj) (cons obj (funcall key obj)))
+                               objs)
+                     (mapcar (lambda (range) (cons range range))
+                             objs))
+      with sorted =
+      (sort pairs
+            (lambda (p1 p2)
+              (< (plist-get (plist-get (cdr p1) :start) :line)
+                 (plist-get (plist-get (cdr p2) :start) :line))))
+      for (object . range) in sorted
+      for spos = (plist-get range :start)
+      for epos = (plist-get range :end)
+      for sline = (plist-get spos :line)
+      for scol = (plist-get spos :character)
+      for eline = (plist-get epos :line)
+      for ecol = (plist-get epos :character)
+      collect (funcall fn object (cons (moveit sline scol)
+                                        (moveit eline ecol)))))))
+
+(cl-defmacro eglot--collecting-ranged ((object-sym region-sym
+                                                          objects
+                                                          &optional key)
+                                              &rest body)
+  "Iterate over OBJECTS, binding each element and its region.
+For each element in OBJECTS, bind OBJECT-SYM to the element and
+REGION-SYM to its computed Emacs region (a cons of buffer positions).
+Evaluate BODY and collect the result into a list.  Return that list.
+
+KEY, if non-nil, should be a function to extract the LSP range from each
+element.  If nil, elements are assumed to be plists with `:range' keys.
+
+This macro uses optimized incremental navigation instead of repeatedly
+calling `eglot-range-region', providing significant performance benefits
+when processing many ranges."
+  (declare (indent 1) (debug t))
+  `(eglot--call-with-ranged
+    ,objects
+    ,key
+    (lambda (,object-sym ,region-sym) ,@body)))
+
 (defun eglot-server-capable (&rest feats)
   "Determine if current server is capable of FEATS."
   (unless (cl-some (lambda (feat)
@@ -3167,11 +3222,8 @@ version the diagnostics pertain to."
               eglot--flymake-report-fn)
      (when (and ,diags (vectorp ,diags))
        (setf ,diags
-             (cl-loop
-              for d across ,diags
-              collect (eglot--flymake-make-diag
-                       d
-                       ,version (eglot-range-region (plist-get d :range))))))
+             (eglot--collecting-ranged (o r ,diags)
+               (eglot--flymake-make-diag o ,version r))))
      (eglot--flymake-report-2 ,diags ,mode)))
 
 (cl-defmethod eglot-handle-notification
@@ -4090,20 +4142,20 @@ for which LSP on-type-formatting should be requested."
       (alist-get kind eglot--symbol-kind-names "Unknown")
       (mapcan
        (pcase-lambda (`(,container . ,objs))
-         (let ((elems (mapcar
-                       (eglot--lambda ((SymbolInformation) kind name location)
-                         (let ((reg (eglot-range-region
-                                     (plist-get location :range)))
-                               (kind (alist-get kind eglot--symbol-kind-names)))
-                           (cons (propertize name
-                                             'imenu-region reg
-                                             'imenu-kind kind
-                                             ;; Backward-compatible props
-                                             ;; to be removed later:
-                                             'breadcrumb-region reg
-                                             'breadcrumb-kind kind)
-                                 (car reg))))
-                       objs)))
+         (let ((elems
+                (eglot--collecting-ranged
+                    (s reg objs (lambda (o)
+                                  (plist-get :range (plist-get o :location))))
+                  (eglot--dbind ((SymbolInformation) kind name) s
+                    (let ((kind (alist-get kind eglot--symbol-kind-names)))
+                      (cons (propertize name
+                                        'imenu-region reg
+                                        'imenu-kind kind
+                                        ;; Backward-compatible props
+                                        ;; to be removed later:
+                                        'breadcrumb-region reg
+                                        'breadcrumb-kind kind)
+                            (car reg)))))))
            (if container (list (cons container elems)) elems)))
        (seq-group-by
         (eglot--lambda ((SymbolInformation) containerName) containerName) objs))))
@@ -4123,6 +4175,7 @@ for which LSP on-type-formatting should be requested."
                                          'breadcrumb-kind kind)))
                   (if (seq-empty-p children)
                       (cons name (car reg))
+                    ;; FIXME: leverage eglot--collecting-ranged
                     (cons name
                             (mapcar (lambda (c) (apply #'dfs c)) children))))))
     (mapcar (lambda (s) (apply #'dfs s)) res)))