From 04ccb81fb563ca94250321fb7992561cdda6b54b Mon Sep 17 00:00:00 2001 From: Sebastian Sturm Date: Sun, 16 Nov 2025 20:51:41 +0100 Subject: [PATCH] Use font-lock-keywords for semantic tokens --- lsp-semantic-tokens.el | 142 +++++++++++++++-------------------------- 1 file changed, 52 insertions(+), 90 deletions(-) diff --git a/lsp-semantic-tokens.el b/lsp-semantic-tokens.el index 6f7a5f6752a..11da05b62d0 100644 --- a/lsp-semantic-tokens.el +++ b/lsp-semantic-tokens.el @@ -277,6 +277,9 @@ Unless overridden by a more specific face association." Faces to use for semantic token modifiers if `lsp-semantic-tokens-apply-modifiers' is non-nil.") +(defconst lsp--semantic-tokens-font-lock-keywords + '((lsp--semantic-tokens-fontify))) + (defun lsp--semantic-tokens-capabilities () `((semanticTokens . ((dynamicRegistration . t) @@ -354,7 +357,7 @@ When non-nil, `lsp--semantic-tokens-cache' should adhere to the following lsp-interface: `(_SemanticTokensCache (:_documentVersion) - (:response :_region :_truncated))'.") + (:response :_region))'.") (defsubst lsp--semantic-tokens-putcache (k v) "Set key K of `lsp--semantic-tokens-cache' to V." @@ -446,7 +449,7 @@ If FONTIFY-IMMEDIATELY is non-nil, fontification will be performed immediately (lsp--semantic-tokens-putcache :_documentVersion lsp--cur-version) (lsp--semantic-tokens-putcache :_region final-region) (funcall response-handler response) - (when (or fontify-immediately (plist-get lsp--semantic-tokens-cache :_truncated)) (font-lock-flush))) + (when fontify-immediately (font-lock-flush))) :error-handler ;; buffer is not captured in `error-handler', it is in `callback' (let ((buf (current-buffer))) (lambda (&rest _) @@ -470,45 +473,19 @@ given workspace/language-server combination. This cache should be flushed every time any modifier configuration changes.") -(defun lsp-semantic-tokens--fontify (old-fontify-region beg-orig end-orig &optional loudly) - "Apply fonts to retrieved semantic tokens. -OLD-FONTIFY-REGION is the underlying region fontification function, -e.g., `font-lock-fontify-region'. -BEG-ORIG and END-ORIG deliminate the requested fontification region and maybe -modified by OLD-FONTIFY-REGION. -LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." +(defun lsp--semantic-tokens-fontify (end) + "Apply semantic tokens from point to END." ;; TODO: support multiple language servers per buffer? (let ((faces (seq-some #'lsp--workspace-semantic-tokens-faces lsp--buffer-workspaces)) (modifier-faces (when lsp-semantic-tokens-apply-modifiers - (seq-some #'lsp--workspace-semantic-tokens-modifier-faces lsp--buffer-workspaces))) - old-bounds - beg end) - (cond - ((or (eq nil faces) - (eq nil lsp--semantic-tokens-cache) - (eq nil (plist-get lsp--semantic-tokens-cache :response))) - ;; default to non-semantic highlighting until first response has arrived - (funcall old-fontify-region beg-orig end-orig loudly)) - ((not (= lsp--cur-version (plist-get lsp--semantic-tokens-cache :_documentVersion))) - ;; delay fontification until we have fresh tokens - '(jit-lock-bounds 0 . 0)) - (t - (setq old-bounds (funcall old-fontify-region beg-orig end-orig loudly)) - ;; this is to prevent flickering when semantic token highlighting - ;; is layered on top of, e.g., tree-sitter-hl, or clojure-mode's syntax highlighting. - (setq beg (min beg-orig (cadr old-bounds)) - end (max end-orig (cddr old-bounds))) - ;; if we're using the response to a ranged request, we'll only be able to fontify within - ;; that range (and hence shouldn't clear any highlights outside of that range) - (let ((token-region (plist-get lsp--semantic-tokens-cache :_region))) - (if token-region - (progn - (lsp--semantic-tokens-putcache :_truncated (or (< beg (car token-region)) - (> end (cdr token-region)))) - (setq beg (max beg (car token-region))) - (setq end (min end (cdr token-region)))) - (lsp--semantic-tokens-putcache :_truncated nil))) + (seq-some #'lsp--workspace-semantic-tokens-modifier-faces lsp--buffer-workspaces)))) + (unless (or (eq nil faces) + (eq nil lsp--semantic-tokens-cache) + (eq nil (plist-get lsp--semantic-tokens-cache :response)) + ;; NOTE: perhaps we'd rather have stale highlights than temporarily dropping them altogether? + (not (= lsp--cur-version (plist-get lsp--semantic-tokens-cache :_documentVersion)))) + (-let* ((inhibit-field-text-motion t) (data (lsp-get (plist-get lsp--semantic-tokens-cache :response) :data)) (i0 0) @@ -517,44 +494,40 @@ LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." (line-delta) (column 0) (face) + (beg) (line-start-pos) (line-min) - (line-max-inclusive) (text-property-beg) (text-property-end)) - (save-mark-and-excursion - (save-restriction - (widen) - (goto-char beg) - (goto-char (line-beginning-position)) - (setq line-min (line-number-at-pos)) - (with-silent-modifications - (goto-char end) - (goto-char (line-end-position)) - (setq line-max-inclusive (line-number-at-pos)) - (forward-line (- line-min line-max-inclusive)) - (let ((skip-lines (- line-min current-line))) - (while (and (<= i0 i-max) (< (aref data i0) skip-lines)) - (setq skip-lines (- skip-lines (aref data i0))) - (setq i0 (+ i0 5))) - (setq current-line (- line-min skip-lines))) - (forward-line (- current-line line-min)) - (setq line-start-pos (point)) - (cl-loop - for i from i0 to i-max by 5 do - (setq line-delta (aref data i)) - (unless (= line-delta 0) - (forward-line line-delta) - (setq line-start-pos (point)) - (setq column 0) - (setq current-line (+ current-line line-delta))) - (setq column (+ column (aref data (1+ i)))) - (setq face (aref faces (aref data (+ i 3)))) - (setq text-property-beg (+ line-start-pos column)) - (setq text-property-end - (min (if lsp-semantic-tokens-enable-multiline-token-support - (point-max) (line-end-position)) - (+ text-property-beg (aref data (+ i 2))))) + ;; TODO: do we need to save mark and excursion within function-type font-lock keywords? + (save-restriction + (widen) + (setq line-min (line-number-at-pos)) + (setq beg (point)) + (with-silent-modifications + (let ((skip-lines (- line-min current-line))) + (while (and (<= i0 i-max) (< (aref data i0) skip-lines)) + (setq skip-lines (- skip-lines (aref data i0))) + (setq i0 (+ i0 5))) + (setq current-line (- line-min skip-lines))) + (forward-line (- current-line line-min)) + (setq line-start-pos (point)) + (cl-loop + for i from i0 to i-max by 5 do + (setq line-delta (aref data i)) + (unless (= line-delta 0) + (forward-line line-delta) + (setq line-start-pos (point)) + (setq column 0) + (setq current-line (+ current-line line-delta))) + (setq column (+ column (aref data (1+ i)))) + (setq face (aref faces (aref data (+ i 3)))) + (setq text-property-beg (+ line-start-pos column)) + (setq text-property-end + (min (if lsp-semantic-tokens-enable-multiline-token-support + (point-max) (line-end-position)) + (+ text-property-beg (aref data (+ i 2))))) + (unless (< text-property-beg beg) (when face (put-text-property text-property-beg text-property-end 'face face)) ;; Deal with modifiers. We cache common combinations of @@ -569,9 +542,8 @@ LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." (push (aref modifier-faces j) faces-to-apply))) (puthash modifier-code faces-to-apply semantic-token-modifier-cache)) (dolist (face faces-to-apply) - (add-face-text-property text-property-beg text-property-end face))) - when (> current-line line-max-inclusive) return nil))))) - `(jit-lock-bounds ,beg . ,end))))) + (add-face-text-property text-property-beg text-property-end face)))) + when (>= (point) end) return nil))))))) (defun lsp-semantic-tokens--request-update () "Request semantic-tokens update." @@ -670,28 +642,18 @@ Please adapt your config to prevent unnecessary mode reinitialization in the fut (defun lsp--semantic-tokens-initialize-buffer () "Initialize the buffer for semantic tokens. IS-RANGE-PROVIDER is non-nil when server supports range requests." - (let* ((old-extend-region-functions font-lock-extend-region-functions) - ;; make sure font-lock always fontifies entire lines (TODO: do we also have - ;; to change some jit-lock-...-region functions/variables?) - (new-extend-region-functions - (if (memq 'font-lock-extend-region-wholelines old-extend-region-functions) - old-extend-region-functions - (cons 'font-lock-extend-region-wholelines old-extend-region-functions))) - (buffer (current-buffer))) + (let* ((buffer (current-buffer))) (setq lsp--semantic-tokens-cache nil) - (setq font-lock-extend-region-functions new-extend-region-functions) - (add-function :around (local 'font-lock-fontify-region-function) #'lsp-semantic-tokens--fontify) (add-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update nil t) (lsp-semantic-tokens--request-update) (setq lsp--semantic-tokens-teardown (lambda () + (font-lock-remove-keywords nil lsp--semantic-tokens-font-lock-keywords) (setq lsp--semantic-tokens-pending-full-token-requests (--remove (eq buffer (car it)) lsp--semantic-tokens-pending-full-token-requests)) - (setq font-lock-extend-region-functions old-extend-region-functions) (setq lsp--semantic-tokens-cache nil) - (remove-function (local 'font-lock-fontify-region-function) - #'lsp-semantic-tokens--fontify) - (remove-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update t))))) + (remove-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update t))) + (font-lock-add-keywords nil lsp--semantic-tokens-font-lock-keywords))) (defun lsp--semantic-tokens-build-face-map (identifiers faces category varname) "Build map of FACES for IDENTIFIERS using CATEGORY and VARNAME." @@ -859,8 +821,8 @@ This is a debugging tool, and may incur significant performance penalties." (defun lsp-log-full-response (response) (setq lsp-semantic-tokens--prev-response `(:request-type "full" - :response ,response - :version ,lsp--cur-version))) + :response ,response + :version ,lsp--cur-version))) (advice-add 'lsp--semantic-tokens-ingest-full-response :before 'lsp-log-full-response) (defun lsp-log-range-response (response)