mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Eglot: tweak some semtok functions to be more debug-friendly

Browse source 
* lisp/progmodes/eglot.el (eglot--semtok-request): Return value
records return reason.
(eglot--semtok-font-lock-1): Return number of painted tokens and
exit locus.
(eglot--semtok-decode-token): Rename
from eglot--semtok-token-faces.  Rework.
(eglot--semtok-font-lock-1): Use eglot--semtok-decode-token.
This commit is contained in:
João Távora 2025-11-13 20:56:50 +00:00
parent 2f196548f5
commit 6126ab8d82
1 changed files with 23 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

44
lisp/progmodes/eglot.el
View file

@ -4589,26 +4589,27 @@ If NOERROR, return predicate, else erroring function."
(eglot--semtok-define-things)
(defun eglot--semtok-token-faces (tok)
(defun eglot--semtok-decode-token (tok)
"Decode TOK. Return (NAMES . FACES). Filter FACES via user options."
(with-slots (semtok-cache capabilities)
(eglot--current-server-or-lose)
(let ((probe (gethash tok semtok-cache :missing))
tname)
(let ((probe (gethash tok semtok-cache :missing)))
(if (eq probe :missing)
(puthash
tok
(eglot--dbind ((SemanticTokensLegend) tokenTypes tokenModifiers)
(plist-get (plist-get capabilities :semanticTokensProvider) :legend)
(setq tname (aref tokenTypes (car tok)))
(when (member tname eglot-semantic-token-types)
(cl-loop
for j from 0 for m across tokenModifiers
unless (or (zerop (logand (cdr tok) (ash 1 j)))
(not (member m eglot-semantic-token-modifiers)))
collect (intern (format "eglot-semantic-%s-face" m)) into mfaces
finally (cl-return
(cons (intern (format "eglot-semantic-%s-face" tname))
mfaces)))))
(cl-loop
with tname = (aref tokenTypes (car tok))
for j from 0 for m across tokenModifiers
when (cl-plusp (logand (cdr tok) (ash 1 j)))
collect m into names
and when (member m eglot-semantic-token-modifiers)
collect (intern (format "eglot-semantic-%s-face" m)) into faces
finally
(when (member tname eglot-semantic-token-types)
(push (intern (format "eglot-semantic-%s-face" tname)) faces))
(cl-return (cons (cons tname names) faces))))
semtok-cache)
probe))))
@ -4697,7 +4698,7 @@ If NOERROR, return predicate, else erroring function."
;; trivial/fast edits. Even though it's fairly cheap to send
;; multiple delta requests, it's nicer to just send just one.
(when (cdr eglot--semtok-inflight)
(cl-return-from eglot--semtok-request))
(cl-return-from eglot--semtok-request 'skipped))
(req :textDocument/semanticTokens/full/delta (point-min) (point-max)
(list :textDocument (eglot--TextDocumentIdentifier)
:previousResultId (cache-get :response :resultId))
@ -4708,7 +4709,7 @@ If NOERROR, return predicate, else erroring function."
(eglot--semtok-apply-delta-edits
(cache-get :response :data)
edits)))
;; server sent full response instead, so just record that.
;; (trace-values "Server send full response instead")
response))))
((eglot-server-capable :semanticTokensProvider :range)
(req :textDocument/semanticTokens/range beg end
@ -4753,20 +4754,21 @@ lock machinery calls us again."
unless (< (point) beg) do
(setq column (+ column (aref data (+ i 1))))
(funcall eglot-move-to-linepos-function column)
(when (> (point) end) (cl-return napplied))
(when (> (point) end) (cl-return (cons napplied 'early)))
(setq p-beg (point))
(funcall eglot-move-to-linepos-function (+ column (aref data (+ i 2))))
(setq p-end (point))
(let* ((tok (cons (aref data (+ i 3))
(aref data (+ i 4))))
(faces (eglot--semtok-token-faces tok)))
(decoded (eglot--semtok-decode-token tok)))
;; The `eglot--semtok-token' prop doesn't serve much purpose:
;; just for debug...
(put-text-property p-beg p-end 'eglot--semtok-token tok)
(put-text-property p-beg p-end 'eglot--semtok-faces faces)
(dolist (f faces)
(put-text-property p-beg p-end 'eglot--semtok-names (car decoded))
(put-text-property p-beg p-end 'eglot--semtok-faces (cdr decoded))
(dolist (f (cdr decoded))
(add-face-text-property p-beg p-end f)))
count 1 into napplied))))
count 1 into napplied
finally (cl-return (cons napplied 'normal))))))
(defun eglot--semtok-font-lock-2 (beg end)
;; JT@2025-11-11: FIXME: I wish I didn't need this kludge but the