Eglot: re-do semantic tokens again (bug#79374)

After a week of intense testing, found out there were various insidious
bugs related to out-of-date requests that rear their heads in different
typing patterns.  One way to sort this out and still minimize the number
of requests is to have Eglot's semtok code be aware of the states a
request for tokens can be in: inexistent/invalid, unsent, sent, valid.

The needs and optimization opportunities for servers that support "full"
and "full/delta" requests are considerably different from the ones of
servers which only support "full" and "range".  The latter seem to be in
the minority, so for now I've removed the range requests.  These servers
should still work with "full" requests.

In a further bug, at least two servers (clangd and lean) were found to
plainly abuse the semanticTokens/refresh server request.  This confuses
the state logic.  The solution is to simply no-op this request handler,
it doesn't seem to do anything useful.

Finally, when auto-reverting with preserve-modes (as done by vc-revert
and auto-revert-mode), the font-lock state needs to be reinitialized.
Fixed this in eglot--after-revert-hook.

* lisp/progmodes/eglot.el (eglot-client-capabilities): Don't announce
ranged request support.
(eglot--docver): Rename from eglot--versioned-identifier.
(eglot--diagnostics)
(eglot--flymake-diagnostics)
(eglot-handle-notification)
(eglot--signal-textDocument/didOpen)
(eglot--report-to-flymake)
(eglot--apply-text-edits)
(eglot--VersionedTextDocumentIdentifier): Use eglot--docver.
(eglot--send-changes-hook): Rename from eglot--document-changed-hook.
(eglot--after-change): Don't run eglot--send-changes-hook here.
(eglot--signal-textDocument/didChange): Run it here.
(eglot--semtok-state): Rename from eglot--semtok-cache.
(eglot--semtok-inflight): Delete.
(eglot--handle-request semanticTokens/refresh): Nullify.
(eglot-semantic-tokens-mode): Tweak.
(eglot--semtok-after-send-changes): New hook.
(eglot--semtok-request)
(eglot--semtok-font-lock): Rewrite.
(eglot--after-revert-hook): Reinitialize semtok state.

Co-authored-by: Lua Viana Reis <me@lua.blog.br>

lisp/progmodes/eglot.el

@@ -1125,7 +1125,7 @@ object."
              :rangeFormatting    `(:dynamicRegistration :json-false)
              :rename             `(:dynamicRegistration :json-false)
              :semanticTokens     `(:dynamicRegistration :json-false
-                                   :requests '(:range t :full (:delta t))
+                                   :requests '(:full (:delta t))
                                    :overlappingTokenSupport t
                                    :multilineTokenSupport t
                                    :tokenTypes [,@eglot-semantic-token-types]
@@ -1304,7 +1304,7 @@ If optional MARKERS, make markers instead."
 (cl-defmethod initialize-instance :before ((_server eglot-lsp-server) &optional args)
   (cl-remf args :initializationOptions))
 
-(defvar-local eglot--versioned-identifier 0
+(defvar-local eglot--docver 0
   "LSP document version.  Bumped on `eglot--after-change'.")
 
 (defvar eglot--servers-by-project (make-hash-table :test #'equal)
@@ -2337,13 +2337,16 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
   "A cons (DIAGNOSTICS . VERSION) for current buffer.
 DIAGNOSTICS is a list of Flymake diagnostics objects.  VERSION is the
 LSP Document version reported for DIAGNOSTICS (comparable to
-`eglot--versioned-identifier') or nil if server didn't bother.")
+`eglot--docver') or nil if server didn't bother.")
 
 (defvar revert-buffer-preserve-modes)
+(defvar eglot-semantic-tokens-mode) ;; forward decl
 (defun eglot--after-revert-hook ()
   "Eglot's `after-revert-hook'."
-  ;; FIXME: Do we really need this?
-  (when revert-buffer-preserve-modes (eglot--signal-textDocument/didOpen)))
+  (when revert-buffer-preserve-modes
+    (eglot--signal-textDocument/didOpen)
+    (when eglot-semantic-tokens-mode
+      (eglot-semantic-tokens-mode))))
 
 (defun eglot--maybe-activate-editing-mode ()
   "Maybe activate `eglot--managed-mode'.
@@ -2640,7 +2643,7 @@ still unanswered LSP requests to the server\n"))))
            for lsp-diag = (alist-get 'eglot-lsp-diag data)
            for version = (alist-get 'eglot--doc-version data)
            when (and lsp-diag (or (null version)
-                                  (= version eglot--versioned-identifier)))
+                                  (= version eglot--docver)))
            collect diag))
 
 (defun eglot--diag-to-lsp-diag (diag)
@@ -2771,11 +2774,11 @@ expensive cached value of `file-truename'.")
         (with-current-buffer buffer
           (cl-loop
            initially
-           (if (and version (/= version eglot--versioned-identifier))
+           (if (and version (/= version eglot--docver))
                (cl-return))
            (setq
             ;; if no explicit version received, assume it's current.
-            version eglot--versioned-identifier
+            version eglot--docver
             flymake-list-only-diagnostics
             (assoc-delete-all path flymake-list-only-diagnostics))
            for diag-spec across diagnostics
@@ -2908,7 +2911,7 @@ Sets `eglot--TextDocumentIdentifier-cache' (which see) as a side effect."
 (defun eglot--VersionedTextDocumentIdentifier ()
   "Compute VersionedTextDocumentIdentifier object for current buffer."
   (append (eglot--TextDocumentIdentifier)
-          `(:version ,eglot--versioned-identifier)))
+          `(:version ,eglot--docver)))
 
 (cl-defun eglot--languageId (&optional (server (eglot--current-server-or-lose)))
   "Compute LSP \\='languageId\\=' string for current buffer.
@@ -2993,13 +2996,13 @@ buffer."
             (,end . ,(copy-marker end t)))
           eglot--recent-changes)))
 
-(defvar eglot--document-changed-hook '(eglot--signal-textDocument/didChange)
+(defvar eglot--send-changes-hook '()
   "Internal hook for doing things when the document changes.")
 
 (defun eglot--after-change (beg end pre-change-length)
   "Hook onto `after-change-functions'.
 Records BEG, END and PRE-CHANGE-LENGTH locally."
-  (cl-incf eglot--versioned-identifier)
+  (cl-incf eglot--docver)
   (pcase (car-safe eglot--recent-changes)
     (`(,lsp-beg ,lsp-end
                 (,b-beg . ,b-beg-marker)
@@ -3041,7 +3044,7 @@ Records BEG, END and PRE-CHANGE-LENGTH locally."
            eglot-send-changes-idle-time
            nil (lambda () (eglot--when-live-buffer buf
                             (when eglot--managed-mode
-                              (run-hooks 'eglot--document-changed-hook)
+                              (eglot--signal-textDocument/didChange)
                               (setq eglot--change-idle-timer nil))))))))
 
 (defvar-local eglot-workspace-configuration ()
@@ -3166,13 +3169,14 @@ When called interactively, use the currently active server"
                    vconcat `[,(list :range `(:start ,beg :end ,end)
                                     :rangeLength len :text text)]))))
       (setq eglot--recent-changes nil)
-      (jsonrpc--call-deferred server))))
+      (jsonrpc--call-deferred server)
+      (run-hooks 'eglot--send-changes-hook))))
 
 (defun eglot--signal-textDocument/didOpen ()
   "Send textDocument/didOpen to server."
   ;; Flush any potential pending change.
   (setq eglot--recent-changes nil
-        eglot--versioned-identifier 0
+        eglot--docver 0
         eglot--TextDocumentIdentifier-cache nil)
   (jsonrpc-notify
    (eglot--current-server-or-lose)
@@ -3227,7 +3231,7 @@ may be called multiple times (respecting the protocol of
   "Internal helper for `eglot-flymake-backend'."
     (save-restriction
       (widen)
-      (if (or (null version) (= version eglot--versioned-identifier))
+      (if (or (null version) (= version eglot--docver))
           (funcall eglot--current-flymake-report-fn diags
                    ;; If the buffer hasn't changed since last
                    ;; call to the report function, flymake won't
@@ -3939,9 +3943,9 @@ Returns a list as described in docstring of `imenu--index-alist'."
   "Apply EDITS for current buffer if at VERSION, or if it's nil.
 If SILENT, don't echo progress in mode-line."
   (unless edits (cl-return-from eglot--apply-text-edits))
-  (unless (or (not version) (equal version eglot--versioned-identifier))
+  (unless (or (not version) (equal version eglot--docver))
     (jsonrpc-error "Edits on `%s' require version %d, you have %d"
-                   (current-buffer) version eglot--versioned-identifier))
+                   (current-buffer) version eglot--docver))
   (atomic-change-group
     (let* ((change-group (prepare-change-group))
            (howmany (length edits))
@@ -4619,34 +4623,36 @@ If NOERROR, return predicate, else erroring function."
            semtok-cache)
         probe))))
 
-(defvar-local eglot--semtok-cache nil
-  "List of plists describing recent semtok response.
+(defvar-local eglot--semtok-state nil
+  "Plist describing current semtok state.
 See `eglot--semtok-request' implementation for details.")
 
-(defvar-local eglot--semtok-inflight (make-hash-table)
-  "Map of JSONRPC request ID to (METHOD DOCVER . REGIONS).
-REGIONS is a list of (BEG . END) of positions that can be serviced by
-this request.")
-
 (cl-defmethod eglot-handle-request
   (server (_method (eql workspace/semanticTokens/refresh)))
   "Handle a semanticTokens/refresh request from SERVER."
   (dolist (buffer (eglot--managed-buffers server))
     (eglot--when-live-buffer buffer
-      (eglot--widening
-       (font-lock-flush)))))
+      ;; JT@2025-11-20: As of time of writing, at least two servers (clangd and lean)
+      ;; abuse this entry point.  There is no practical benefit to having it enabled,
+      ;; just disadvantages.
+      ;; (unless (zerop eglot--docver)
+      ;;   (eglot--widening (font-lock-flush)))
+      )))
 
 (define-minor-mode eglot-semantic-tokens-mode
   "Minor mode for fontifying buffer with LSP server's semantic tokens."
   :global nil
-  (setq eglot--semtok-cache nil)
-  (clrhash eglot--semtok-inflight)
+  (setq eglot--semtok-state nil)
   (cond (eglot-semantic-tokens-mode
          (if (not (eglot-server-capable :semanticTokensProvider))
              (eglot-semantic-tokens-mode -1)
+           (add-hook 'eglot--send-changes-hook
+                     #'eglot--semtok-after-send-changes)
            (font-lock-add-keywords nil '((eglot--semtok-font-lock)) 'append)
            (font-lock-flush)))
         (t
+         (remove-hook 'eglot--send-changes-hook
+                      #'eglot--semtok-after-send-changes)
          (font-lock-remove-keywords nil '((eglot--semtok-font-lock)))
          (font-lock-flush))))
 
@@ -4661,116 +4667,73 @@ this request.")
    finally
    (cl-return (vconcat new (substring old-data old-i (length old-data))))))
 
-(cl-defun eglot--semtok-request
-    (beg end &aux (docver eglot--versioned-identifier) reused)
+(defun eglot--semtok-after-send-changes ()
+  ;; (trace-values "Dispatching")
+  (setf (plist-get eglot--semtok-state :dispatched) t))
+
+(cl-defun eglot--semtok-request (beg end &aux (docver eglot--docver))
   "Ask for tokens.  Arrange for BEG..END to be font-lock flushed."
-  (cl-labels
-      ((fullish-p (m)
-         (memq m '(:textDocument/semanticTokens/full/delta
-                   :textDocument/semanticTokens/full)))
-       (prune-outdated ()
-         (setq eglot--semtok-cache
-            (cl-delete-if (lambda (e)
-                            (not (eq docver (plist-get e :docver))))
-                          eglot--semtok-cache)))
-       (req (method params &optional cont
-                    &aux req-id (buf (current-buffer)))
-         (setq req-id
-               (eglot--async-request
-                (eglot--current-server-or-lose) method params
-                :success-fn
-                (lambda (response)
-                  (eglot--when-live-buffer buf
-                    (pcase-let ((`(,method ,docver ,regions)
-                                 (gethash req-id eglot--semtok-inflight)))
-                      (remhash req-id eglot--semtok-inflight)
-                      ;; (trace-values "Response: "
-                      ;;               method
-                      ;;               eglot--versioned-identifier docver
-                      ;;               "edits: "
-                      ;;               (length (cl-getf response :edits))
-                      ;;               "data: "
-                      ;;               (length (cl-getf response :data)))
-                      ;; A user edit may have come in while the request
-                      ;; was inflight, changing the state of the buffer...
-                      (when (eq docver eglot--versioned-identifier)
-                        (push
-                         (list :docver docver
-                               :method method
-                               :resultId (plist-get response :resultId)
-                               :data (if cont (funcall cont response)
-                                       (plist-get response :data))
-                               :valid (if (fullish-p method)
-                                          (eglot--widening
-                                           (cons (point-min) (point-max)))
-                                        (cons beg end)))
-                         eglot--semtok-cache))
-                      ;; ... but we should flush unconditionally.  If
-                      ;; this response was out-of-date,
-                      ;; `eglot--semtok-font-lock' should just trigger
-                      ;; another request.
-                      (cl-loop for (b . e) in regions
-                               do (font-lock-flush b e))
-                      ;; (trace-values "Flushed" (length regions)
-                      ;;               "regions" regions)
-                      )))
-                ;; For "range" requests, make sure we have one unique
-                ;; request defeating part of the "deferred" mechanism.
-                :hint (if (fullish-p method) method
-                        (gensym (symbol-name method)))))
-         ;; Can prune outdated entries now, not earlier, since "delta"
-         ;; requests rely on outdated entries by definition.
-         (prune-outdated)
-         (puthash req-id (list method docver (list (cons beg end)))
-                  eglot--semtok-inflight)))
-    ;; JT@2025-11-16: Many back-to-back calls for
-    ;; `eglot--semtok-request' and small regions occur even on
-    ;; trivial/fast edits.  We try to send just one request.  If there
-    ;; is a "full" or "full/delta" request in flight, we can piggy back
-    ;; onto it our region and our docver, and exit.  That's because very
-    ;; likely it's not actually inflight yet (because of the "deferred"
-    ;; mechanism, it's waiting for didChange), so we can still do
-    ;; changes to the state it represents when it is actually sent.
-    (cl-loop for v being the hash-values of eglot--semtok-inflight
-             when (fullish-p (car v)) do
-             (push (cons beg end) (caddr v))
-             (setf (cadr v) docver)
-             (cl-return-from eglot--semtok-request (cons 'skipped docver)))
-    (cond
-     ((and (eglot-server-capable :semanticTokensProvider :full :delta)
-           (setq reused (cl-find-if
-                         (lambda (e) (fullish-p (plist-get e :method)))
-                         eglot--semtok-cache)))
-      (req :textDocument/semanticTokens/full/delta
-           (list :textDocument (eglot--TextDocumentIdentifier)
-                 :previousResultId (plist-get reused :resultId))
-           (lambda (response)
-             (if-let* ((edits (plist-get response :edits)))
-                 (eglot--semtok-apply-delta-edits
-                             (plist-get reused :data)
-                             edits)
-               (plist-get response :data)))))
-     ((eglot-server-capable :semanticTokensProvider :range)
-      (req :textDocument/semanticTokens/range
-           (list :textDocument (eglot--TextDocumentIdentifier)
-                 :range (eglot-region-range beg end))))
-     (t
-      (req :textDocument/semanticTokens/full
-           (list :textDocument (eglot--TextDocumentIdentifier)))))))
+  (cl-macrolet ((c (tag) `(plist-get eglot--semtok-state ,tag)))
+    (cl-labels
+        ((req (method &optional params cont
+                      &aux (buf (current-buffer)))
+           (setf (c :req-docver) docver
+                 (c :orig-docver) docver
+                 (c :dispatched) (not eglot--recent-changes)
+                 (c :regions) (cons (cons (copy-marker beg) (copy-marker end)) (c :regions)))
+           ;; (trace-values "Request" method)
+           (eglot--async-request
+            (eglot--current-server-or-lose) method
+            (append (nconc params `(:textDocument ,(eglot--TextDocumentIdentifier))))
+            :success-fn
+            (lambda (response)
+              (eglot--when-live-buffer buf
+                ;; (trace-values "Response"
+                ;;               eglot--docver docver (c :orig-docver) (c :req-docver))
+                ;; This skip is different from the one below.  Comparing
+                ;; the lexical `docver' to the original request's
+                ;; `:orig-docver' allows skipping the outdated reponse
+                ;; of a dispatched request that has been overriden by
+                ;; another (perhaps not dispatched yet) request.
+                (when (eq docver (c :orig-docver))
+                  (setf (c :docver) (c :req-docver)
+                        (c :data) (if cont (funcall cont response)
+                                    (plist-get response :data))
+                        (c :resultId) (plist-get response :resultId))
+                  ;; (trace-values "Flushing" (length (c :regions)) "regions")
+                  (cl-loop for (a . b) in (c :regions) do (font-lock-flush a b))
+                  (setf (c :regions) nil))))
+            :hint 'semtok)))
+      ;; Skip actually making the request if there's an undispatched
+      ;; waiting for a eglot--send-changes-hook flush.  Just update the
+      ;; regions and the `:req-docver'.
+      (unless (or (null (c :req-docver)) (c :dispatched))
+        (push (cons (copy-marker beg) (copy-marker end)) (c :regions))
+        (setf (c :req-docver) eglot--docver)
+        (cl-return-from eglot--semtok-request 'skipped))
+      (cond
+       ((and (eglot-server-capable :semanticTokensProvider :full :delta)
+             (c :data))
+        (req :textDocument/semanticTokens/full/delta
+             `(:previousResultId ,(c :resultId))
+             (let ((data (c :data) ))
+               (lambda (response)
+                 (if-let* ((edits (plist-get response :edits)))
+                     (eglot--semtok-apply-delta-edits data edits)
+                   (plist-get response :data))))))
+       (t
+        (req :textDocument/semanticTokens/full))))))
 
 (cl-defun eglot--semtok-font-lock (limit &aux (beg (point)) (end limit))
   "Arrange for font-lock to happen from point until LIMIT.
 Either do it immediately if the information available is up-to-date or
 request new information from the server and return and hope the font
 lock machinery calls us again."
-  (let ((probe
-         (cl-find-if
-          (jsonrpc-lambda (&key docver valid &allow-other-keys)
-            (and (eq docver eglot--versioned-identifier)
-                 (<= (car valid) beg end (cdr valid))))
-          eglot--semtok-cache)))
-    (cond (probe
-           (eglot--semtok-font-lock-1 beg end (plist-get probe :data)))
+  (cl-macrolet ((c (tag) `(plist-get eglot--semtok-state ,tag)))
+    (cond ((and (eq (c :docver) eglot--docver)
+                (c :dispatched)
+                (c :data))
+           (eglot--semtok-font-lock-1 beg end (c :data)))
           (t
            (eglot--semtok-font-lock-2 beg end)
            (eglot--semtok-request beg end))))