lsp-semantic-tokens.el (41529B)
1 ;;; lsp-semantic-tokens.el --- Semantic tokens -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020 emacs-lsp maintainers 4 ;; 5 ;; This program is free software; you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 17 ;; 18 ;;; Commentary: 19 ;; 20 ;; Semantic tokens 21 ;; https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_semanticTokens 22 ;; 23 ;;; Code: 24 25 (require 'lsp-mode) 26 (require 'dash) 27 28 (defgroup lsp-semantic-tokens nil 29 "LSP support for semantic-tokens." 30 :prefix "lsp-semantic-tokens-" 31 :group 'lsp-mode 32 :tag "LSP Semantic tokens") 33 34 (define-obsolete-variable-alias 'lsp-semantic-highlighting-warn-on-missing-face 'lsp-semantic-tokens-warn-on-missing-face "lsp-mode 8.0.0") 35 36 (defcustom lsp-semantic-tokens-warn-on-missing-face nil 37 "Warning on missing face for token type/modifier. 38 When non-nil, this option will emit a warning any time a token 39 or modifier type returned by a language server has no face associated with it." 40 :group 'lsp-semantic-tokens 41 :type 'boolean) 42 43 (defcustom lsp-semantic-tokens-apply-modifiers t 44 "Whether semantic tokens should take token modifiers into account." 45 :group 'lsp-semantic-tokens 46 :type 'boolean) 47 48 (defcustom lsp-semantic-tokens-allow-ranged-requests t 49 "Whether to use ranged semantic token requests when available. 50 51 Note that even when this is set to t, delta requests will 52 be preferred whenever possible, unless 53 `lsp-semantic-tokens-allow-delta-requests' is false." 54 :group 'lsp-semantic-tokens 55 :type 'boolean) 56 57 (defcustom lsp-semantic-tokens-allow-delta-requests t 58 "Whether to use semantic token delta requests when available. 59 60 When supported by the language server, delta requests are always 61 preferred over both full and ranged token requests." 62 :group 'lsp-semantic-tokens 63 :type 'boolean) 64 65 (defcustom lsp-semantic-tokens-honor-refresh-requests nil 66 "Whether to honor semanticTokens/refresh requests. 67 68 When set to nil, refresh requests will be silently discarded. 69 When set to t, semantic tokens will be re-requested for all buffers 70 associated with the requesting language server." 71 :group 'lsp-semantic-tokens 72 :type 'boolean) 73 74 (defcustom lsp-semantic-tokens-enable-multiline-token-support t 75 "When set to nil, tokens will be truncated after end-of-line." 76 :group 'lsp-semantic-tokens 77 :type 'boolean) 78 79 (defface lsp-face-semhl-constant 80 '((t :inherit font-lock-constant-face)) 81 "Face used for semantic highlighting scopes matching constant scopes." 82 :group 'lsp-semantic-tokens) 83 84 (defface lsp-face-semhl-variable 85 '((t :inherit font-lock-variable-name-face)) 86 "Face used for semantic highlighting scopes matching variable.*. 87 Unless overridden by a more specific face association." 88 :group 'lsp-semantic-tokens) 89 90 (defface lsp-face-semhl-function 91 '((t :inherit font-lock-function-name-face)) 92 "Face used for semantic highlighting scopes matching entity.name.function.*. 93 Unless overridden by a more specific face association." 94 :group 'lsp-semantic-tokens) 95 96 (defface lsp-face-semhl-method 97 '((t :inherit lsp-face-semhl-function)) 98 "Face used for semantic highlighting scopes matching entity.name.method.*. 99 Unless overridden by a more specific face association." 100 :group 'lsp-semantic-tokens) 101 102 (defface lsp-face-semhl-namespace 103 '((t :inherit font-lock-type-face :weight bold)) 104 "Face used for semantic highlighting scopes matching entity.name.namespace.*. 105 Unless overridden by a more specific face association." 106 :group 'lsp-semantic-tokens) 107 108 (defface lsp-face-semhl-comment 109 '((t (:inherit font-lock-comment-face))) 110 "Face used for comments." 111 :group 'lsp-semantic-tokens) 112 113 (defface lsp-face-semhl-keyword 114 '((t (:inherit font-lock-keyword-face))) 115 "Face used for keywords." 116 :group 'lsp-semantic-tokens) 117 118 (defface lsp-face-semhl-string 119 '((t (:inherit font-lock-string-face))) 120 "Face used for keywords." 121 :group 'lsp-semantic-tokens) 122 123 (defface lsp-face-semhl-number 124 '((t (:inherit font-lock-constant-face))) 125 "Face used for numbers." 126 :group 'lsp-semantic-tokens) 127 128 (defface lsp-face-semhl-regexp 129 '((t (:inherit font-lock-string-face :slant italic))) 130 "Face used for regexps." 131 :group 'lsp-semantic-tokens) 132 133 (defface lsp-face-semhl-operator 134 '((t (:inherit font-lock-function-name-face))) 135 "Face used for operators." 136 :group 'lsp-semantic-tokens) 137 138 (defface lsp-face-semhl-namespace 139 '((t (:inherit font-lock-keyword-face))) 140 "Face used for namespaces." 141 :group 'lsp-semantic-tokens) 142 143 (defface lsp-face-semhl-type 144 '((t (:inherit font-lock-type-face))) 145 "Face used for types." 146 :group 'lsp-semantic-tokens) 147 148 (defface lsp-face-semhl-struct 149 '((t (:inherit font-lock-type-face))) 150 "Face used for structs." 151 :group 'lsp-semantic-tokens) 152 153 (defface lsp-face-semhl-class 154 '((t (:inherit font-lock-type-face))) 155 "Face used for classes." 156 :group 'lsp-semantic-tokens) 157 158 (defface lsp-face-semhl-interface 159 '((t (:inherit font-lock-type-face))) 160 "Face used for interfaces." 161 :group 'lsp-semantic-tokens) 162 163 (defface lsp-face-semhl-enum 164 '((t (:inherit font-lock-type-face))) 165 "Face used for enums." 166 :group 'lsp-semantic-tokens) 167 168 (defface lsp-face-semhl-type-parameter 169 '((t (:inherit font-lock-type-face))) 170 "Face used for type parameters." 171 :group 'lsp-semantic-tokens) 172 173 ;; function face already defined, move here when support 174 ;; for theia highlighting gets removed 175 (defface lsp-face-semhl-member 176 '((t (:inherit font-lock-variable-name-face))) 177 "Face used for members." 178 :group 'lsp-semantic-tokens) 179 180 (defface lsp-face-semhl-property 181 '((t (:inherit font-lock-variable-name-face))) 182 "Face used for properties." 183 :group 'lsp-semantic-tokens) 184 185 (defface lsp-face-semhl-event 186 '((t (:inherit font-lock-variable-name-face))) 187 "Face used for event properties." 188 :group 'lsp-semantic-tokens) 189 190 (defface lsp-face-semhl-macro 191 '((t (:inherit font-lock-preprocessor-face))) 192 "Face used for macros." 193 :group 'lsp-semantic-tokens) 194 195 (defface lsp-face-semhl-variable 196 '((t (:inherit font-lock-variable-name-face))) 197 "Face used for variables." 198 :group 'lsp-semantic-tokens) 199 200 (defface lsp-face-semhl-parameter 201 '((t (:inherit font-lock-variable-name-face))) 202 "Face used for parameters." 203 :group 'lsp-semantic-tokens) 204 205 (defface lsp-face-semhl-label 206 '((t (:inherit font-lock-comment-face))) 207 "Face used for labels." 208 :group 'lsp-semantic-tokens) 209 210 (defface lsp-face-semhl-deprecated 211 '((t :strike-through t)) 212 "Face used for semantic highlighting scopes matching constant scopes." 213 :group 'lsp-semantic-tokens) 214 215 (defface lsp-face-semhl-definition 216 '((t :inherit font-lock-function-name-face :weight bold)) 217 "Face used for definition modifier." 218 :group 'lsp-semantic-tokens) 219 220 (defface lsp-face-semhl-implementation 221 '((t :inherit font-lock-function-name-face :weight bold)) 222 "Face used for implementation modifier." 223 :group 'lsp-semantic-tokens) 224 225 (defface lsp-face-semhl-default-library 226 '((t :inherit font-lock-builtin-face)) 227 "Face used for defaultLibrary modifier." 228 :group 'lsp-semantic-tokens) 229 230 (defface lsp-face-semhl-static 231 '((t :inherit font-lock-keyword-face)) 232 "Face used for static modifier." 233 :group 'lsp-semantic-tokens) 234 235 (defvar-local lsp-semantic-token-faces 236 '(("comment" . lsp-face-semhl-comment) 237 ("keyword" . lsp-face-semhl-keyword) 238 ("string" . lsp-face-semhl-string) 239 ("number" . lsp-face-semhl-number) 240 ("regexp" . lsp-face-semhl-regexp) 241 ("operator" . lsp-face-semhl-operator) 242 ("namespace" . lsp-face-semhl-namespace) 243 ("type" . lsp-face-semhl-type) 244 ("struct" . lsp-face-semhl-struct) 245 ("class" . lsp-face-semhl-class) 246 ("interface" . lsp-face-semhl-interface) 247 ("enum" . lsp-face-semhl-enum) 248 ("typeParameter" . lsp-face-semhl-type-parameter) 249 ("function" . lsp-face-semhl-function) 250 ("method" . lsp-face-semhl-method) 251 ("member" . lsp-face-semhl-member) 252 ("property" . lsp-face-semhl-property) 253 ("event" . lsp-face-semhl-event) 254 ("macro" . lsp-face-semhl-macro) 255 ("variable" . lsp-face-semhl-variable) 256 ("parameter" . lsp-face-semhl-parameter) 257 ("label" . lsp-face-semhl-label) 258 ("enumConstant" . lsp-face-semhl-constant) 259 ("enumMember" . lsp-face-semhl-constant) 260 ("dependent" . lsp-face-semhl-type) 261 ("concept" . lsp-face-semhl-interface)) 262 "Faces to use for semantic tokens.") 263 264 (defvar-local lsp-semantic-token-modifier-faces 265 '(("declaration" . lsp-face-semhl-interface) 266 ("definition" . lsp-face-semhl-definition) 267 ("implementation" . lsp-face-semhl-implementation) 268 ("readonly" . lsp-face-semhl-constant) 269 ("static" . lsp-face-semhl-static) 270 ("deprecated" . lsp-face-semhl-deprecated) 271 ("abstract" . lsp-face-semhl-keyword) 272 ("async" . lsp-face-semhl-macro) 273 ("modification" . lsp-face-semhl-operator) 274 ("documentation" . lsp-face-semhl-comment) 275 ("defaultLibrary" . lsp-face-semhl-default-library)) 276 "Semantic tokens modifier faces. 277 Faces to use for semantic token modifiers if 278 `lsp-semantic-tokens-apply-modifiers' is non-nil.") 279 280 (defun lsp--semantic-tokens-capabilities () 281 `((semanticTokens 282 . ((dynamicRegistration . t) 283 (requests . ((range . t) (full . t))) 284 (tokenModifiers . ,(if lsp-semantic-tokens-apply-modifiers 285 (apply 'vector (mapcar #'car (lsp-semantic-tokens--modifier-faces-for (lsp--workspace-client lsp--cur-workspace)))) 286 [])) 287 (overlappingTokenSupport . t) 288 (multilineTokenSupport . ,(if lsp-semantic-tokens-enable-multiline-token-support t json-false)) 289 (tokenTypes . ,(apply 'vector (mapcar #'car (lsp-semantic-tokens--type-faces-for (lsp--workspace-client lsp--cur-workspace))))) 290 (formats . ["relative"]))))) 291 292 (defvar lsp--semantic-tokens-pending-full-token-requests '() 293 "Buffers which should have their semantic tokens refreshed on idle. 294 295 This is an alist of the form ((buffer_i . fontify_immediately_i) ...); entries 296 with fontify_immediately set to t will immediately refontify once their 297 token request is answered.") 298 299 ;; NOTE: doesn't keep track of outstanding requests, so might still produce large latency outliers 300 ;; if the language server doesn't process all outstanding token requests within one lsp-idle-delay 301 (defcustom lsp-semantic-tokens-max-concurrent-idle-requests 1 302 "Maximum number of on-idle token requests to be dispatched simultaneously." 303 :group 'lsp-semantic-tokens 304 :type 'integer) 305 306 (defvar lsp--semantic-tokens-idle-timer nil) 307 308 (defun lsp--semantic-tokens-process-pending-requests () 309 (let ((fuel lsp-semantic-tokens-max-concurrent-idle-requests)) 310 (while (and lsp--semantic-tokens-pending-full-token-requests (> fuel 0)) 311 (-let (((buffer . fontify-immediately) (pop lsp--semantic-tokens-pending-full-token-requests))) 312 (when (buffer-live-p buffer) 313 (setq fuel (1- fuel)) 314 (with-current-buffer buffer 315 (lsp--semantic-tokens-request nil fontify-immediately)))))) 316 (unless lsp--semantic-tokens-pending-full-token-requests 317 (cancel-timer lsp--semantic-tokens-idle-timer) 318 (setq lsp--semantic-tokens-idle-timer nil))) 319 320 (defun lsp--semantic-tokens-sort-pending-requests (pending-requests) 321 ;; service currently visible buffers first, otherwise prefer immediate-fontification requests 322 (-sort (lambda (entry-a entry-b) 323 (let ((a-hidden (eq nil (get-buffer-window (car entry-a)))) 324 (b-hidden (eq nil (get-buffer-window (car entry-b))))) 325 (cond ((and b-hidden (not a-hidden)) t) ; sort a before b 326 ((and a-hidden (not b-hidden)) nil) ; sort b before a 327 ((and (not (cdr entry-a)) (cdr entry-b)) nil) ; otherwise sort b before a only if b is immediate and a is not 328 (t t)))) 329 (--filter (buffer-live-p (car it)) pending-requests))) 330 331 (defun lsp--semantic-tokens-request-full-token-set-when-idle (buffer fontify-immediately) 332 "Request full token set after an idle timeout of `lsp-idle-delay'. 333 334 If FONTIFY-IMMEDIATELY is non-nil, fontification will be performed immediately 335 once the corresponding response is received." 336 (let ((do-fontify-immediately (or fontify-immediately 337 (cdr (assoc buffer lsp--semantic-tokens-pending-full-token-requests))))) 338 (setq lsp--semantic-tokens-pending-full-token-requests 339 (lsp--semantic-tokens-sort-pending-requests 340 (cons (cons buffer do-fontify-immediately) 341 (--remove (eq buffer (car it)) lsp--semantic-tokens-pending-full-token-requests))))) 342 (unless lsp--semantic-tokens-idle-timer 343 (setq lsp--semantic-tokens-idle-timer 344 (run-with-idle-timer lsp-idle-delay t #'lsp--semantic-tokens-process-pending-requests)))) 345 346 (defun lsp--semantic-tokens-refresh-if-enabled (buffer) 347 (when (buffer-local-value 'lsp-semantic-tokens-mode buffer) 348 (lsp--semantic-tokens-request-full-token-set-when-idle buffer t))) 349 350 (defvar-local lsp--semantic-tokens-cache nil 351 "Previously returned token set. 352 353 When non-nil, `lsp--semantic-tokens-cache' should adhere to the 354 following lsp-interface: 355 `(_SemanticTokensCache 356 (:_documentVersion) 357 (:response :_region :_truncated))'.") 358 359 (defsubst lsp--semantic-tokens-putcache (k v) 360 "Set key K of `lsp--semantic-tokens-cache' to V." 361 (setq lsp--semantic-tokens-cache 362 (plist-put lsp--semantic-tokens-cache k v))) 363 364 (defvar-local lsp--semantic-tokens-teardown nil) 365 366 (defun lsp--semantic-tokens-ingest-range-response (response) 367 "Handle RESPONSE to semanticTokens/range request." 368 (lsp--semantic-tokens-putcache :response response) 369 (cl-assert (plist-get lsp--semantic-tokens-cache :_region)) 370 (lsp--semantic-tokens-request-full-token-set-when-idle (current-buffer) nil)) 371 372 (defun lsp--semantic-tokens-ingest-full-response (response) 373 "Handle RESPONSE to semanticTokens/full request." 374 (lsp--semantic-tokens-putcache :response response) 375 (cl-assert (not (plist-get lsp--semantic-tokens-cache :_region)))) 376 377 (defsubst lsp--semantic-tokens-apply-delta-edits (old-data edits) 378 "Apply EDITS obtained from full/delta request to OLD-DATA." 379 (let* ((old-token-count (length old-data)) 380 (old-token-index 0) 381 (substrings)) 382 (cl-loop 383 for edit across edits 384 do 385 (when (< old-token-index (lsp-get edit :start)) 386 (push (substring old-data old-token-index (lsp-get edit :start)) substrings)) 387 (push (lsp-get edit :data) substrings) 388 (setq old-token-index (+ (lsp-get edit :start) (lsp-get edit :deleteCount))) 389 finally do (push (substring old-data old-token-index old-token-count) substrings)) 390 (apply #'vconcat (nreverse substrings)))) 391 392 (defun lsp--semantic-tokens-ingest-full/delta-response (response) 393 "Handle RESPONSE to semanticTokens/full/delta request." 394 (if (lsp-get response :edits) 395 (let ((old-data (--> lsp--semantic-tokens-cache (plist-get it :response) (lsp-get it :data)))) 396 (cl-assert (not (plist-get lsp--semantic-tokens-cache :_region))) 397 (when old-data 398 (lsp--semantic-tokens-putcache 399 :response (lsp-put response 400 :data (lsp--semantic-tokens-apply-delta-edits 401 old-data (lsp-get response :edits)))))) 402 ;; server decided to send full response instead 403 (lsp--semantic-tokens-ingest-full-response response))) 404 405 406 (defun lsp--semantic-tokens-request (region fontify-immediately) 407 "Send semantic tokens request to the language server. 408 409 A full/delta request will be sent if delta requests are supported by 410 the language server, allowed via `lsp-semantic-tokens-allow-delta-requests', 411 and if a full set of tokens had previously been received. 412 Otherwise, a ranged request will be dispatched if REGION is non-nil, 413 ranged requests are supported by the language server, and allowed via 414 `lsp-semantic-tokens-allow-delta-requests'. In all other cases, a full 415 tokens request will be dispatched. 416 417 If FONTIFY-IMMEDIATELY is non-nil, fontification will be performed immediately 418 upon receiving the response." 419 (let ((request-type "textDocument/semanticTokens/full") 420 (request `(:textDocument ,(lsp--text-document-identifier))) 421 (response-handler nil) 422 (final-region nil)) 423 (cond 424 ((and lsp-semantic-tokens-allow-delta-requests 425 (lsp-feature? "textDocument/semanticTokensFull/Delta") 426 (--> lsp--semantic-tokens-cache 427 (plist-get it :response) 428 (and (lsp-get it :resultId) (lsp-get it :data) 429 (not (plist-get lsp--semantic-tokens-cache :_region))))) 430 (setq request-type "textDocument/semanticTokens/full/delta") 431 (setq response-handler #'lsp--semantic-tokens-ingest-full/delta-response) 432 (setq request 433 (plist-put request :previousResultId 434 (lsp-get (plist-get lsp--semantic-tokens-cache :response) :resultId)))) 435 ((and lsp-semantic-tokens-allow-ranged-requests region 436 (lsp-feature? "textDocument/semanticTokensRangeProvider")) 437 (setq request-type "textDocument/semanticTokens/range") 438 (setq final-region region) 439 (setq request 440 (plist-put request :range (lsp--region-to-range (car final-region) (cdr final-region)))) 441 (setq response-handler #'lsp--semantic-tokens-ingest-range-response)) 442 (t (setq response-handler #'lsp--semantic-tokens-ingest-full-response))) 443 (lsp-request-async 444 request-type request 445 (lambda (response) 446 (lsp--semantic-tokens-putcache :_documentVersion lsp--cur-version) 447 (lsp--semantic-tokens-putcache :_region final-region) 448 (funcall response-handler response) 449 (when (or fontify-immediately (plist-get lsp--semantic-tokens-cache :_truncated)) (font-lock-flush))) 450 :error-handler ;; buffer is not captured in `error-handler', it is in `callback' 451 (let ((buf (current-buffer))) 452 (lambda (&rest _) 453 (when (buffer-live-p buf) 454 (lsp--semantic-tokens-request-full-token-set-when-idle buf t)))) 455 :mode 'tick 456 :cancel-token (format "semantic-tokens-%s" (lsp--buffer-uri))))) 457 458 459 ;;;###autoload 460 (defvar-local semantic-token-modifier-cache (make-hash-table) 461 "A cache of modifier values to the selected fonts. 462 This allows whole-bitmap lookup instead of checking each bit. The 463 expectation is that usage of modifiers will tend to cluster, so 464 we will not have the full range of possible usages, hence a 465 tractable hash map. 466 467 This is set as buffer-local. It should probably be shared in a 468 given workspace/language-server combination. 469 470 This cache should be flushed every time any modifier 471 configuration changes.") 472 473 (defun lsp-semantic-tokens--fontify (old-fontify-region beg-orig end-orig &optional loudly) 474 "Apply fonts to retrieved semantic tokens. 475 OLD-FONTIFY-REGION is the underlying region fontification function, 476 e.g., `font-lock-fontify-region'. 477 BEG-ORIG and END-ORIG deliminate the requested fontification region and maybe 478 modified by OLD-FONTIFY-REGION. 479 LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." 480 ;; TODO: support multiple language servers per buffer? 481 (let ((faces (seq-some #'lsp--workspace-semantic-tokens-faces lsp--buffer-workspaces)) 482 (modifier-faces 483 (when lsp-semantic-tokens-apply-modifiers 484 (seq-some #'lsp--workspace-semantic-tokens-modifier-faces lsp--buffer-workspaces))) 485 old-bounds 486 beg end) 487 (cond 488 ((or (eq nil faces) 489 (eq nil lsp--semantic-tokens-cache) 490 (eq nil (plist-get lsp--semantic-tokens-cache :response))) 491 ;; default to non-semantic highlighting until first response has arrived 492 (funcall old-fontify-region beg-orig end-orig loudly)) 493 ((not (= lsp--cur-version (plist-get lsp--semantic-tokens-cache :_documentVersion))) 494 ;; delay fontification until we have fresh tokens 495 '(jit-lock-bounds 0 . 0)) 496 (t 497 (setq old-bounds (funcall old-fontify-region beg-orig end-orig loudly)) 498 ;; this is to prevent flickering when semantic token highlighting 499 ;; is layered on top of, e.g., tree-sitter-hl, or clojure-mode's syntax highlighting. 500 (setq beg (min beg-orig (cadr old-bounds)) 501 end (max end-orig (cddr old-bounds))) 502 ;; if we're using the response to a ranged request, we'll only be able to fontify within 503 ;; that range (and hence shouldn't clear any highlights outside of that range) 504 (let ((token-region (plist-get lsp--semantic-tokens-cache :_region))) 505 (if token-region 506 (progn 507 (lsp--semantic-tokens-putcache :_truncated (or (< beg (car token-region)) 508 (> end (cdr token-region)))) 509 (setq beg (max beg (car token-region))) 510 (setq end (min end (cdr token-region)))) 511 (lsp--semantic-tokens-putcache :_truncated nil))) 512 (-let* ((inhibit-field-text-motion t) 513 (data (lsp-get (plist-get lsp--semantic-tokens-cache :response) :data)) 514 (i0 0) 515 (i-max (1- (length data))) 516 (current-line 1) 517 (line-delta) 518 (column 0) 519 (face) 520 (line-start-pos) 521 (line-min) 522 (line-max-inclusive) 523 (text-property-beg) 524 (text-property-end)) 525 (save-mark-and-excursion 526 (save-restriction 527 (widen) 528 (goto-char beg) 529 (goto-char (line-beginning-position)) 530 (setq line-min (line-number-at-pos)) 531 (with-silent-modifications 532 (goto-char end) 533 (goto-char (line-end-position)) 534 (setq line-max-inclusive (line-number-at-pos)) 535 (forward-line (- line-min line-max-inclusive)) 536 (let ((skip-lines (- line-min current-line))) 537 (while (and (<= i0 i-max) (< (aref data i0) skip-lines)) 538 (setq skip-lines (- skip-lines (aref data i0))) 539 (setq i0 (+ i0 5))) 540 (setq current-line (- line-min skip-lines))) 541 (forward-line (- current-line line-min)) 542 (setq line-start-pos (point)) 543 (cl-loop 544 for i from i0 to i-max by 5 do 545 (setq line-delta (aref data i)) 546 (unless (= line-delta 0) 547 (forward-line line-delta) 548 (setq line-start-pos (point)) 549 (setq column 0) 550 (setq current-line (+ current-line line-delta))) 551 (setq column (+ column (aref data (1+ i)))) 552 (setq face (aref faces (aref data (+ i 3)))) 553 (setq text-property-beg (+ line-start-pos column)) 554 (setq text-property-end 555 (min (if lsp-semantic-tokens-enable-multiline-token-support 556 (point-max) (line-end-position)) 557 (+ text-property-beg (aref data (+ i 2))))) 558 (when face 559 (put-text-property text-property-beg text-property-end 'face face)) 560 ;; Deal with modifiers. We cache common combinations of 561 ;; modifiers, storing the faces they resolve to. 562 (let* ((modifier-code (aref data (+ i 4))) 563 (faces-to-apply (gethash modifier-code semantic-token-modifier-cache 'not-found))) 564 (when (eq 'not-found faces-to-apply) 565 (setq faces-to-apply nil) 566 (cl-loop for j from 0 to (1- (length modifier-faces)) do 567 (when (and (aref modifier-faces j) 568 (> (logand modifier-code (ash 1 j)) 0)) 569 (push (aref modifier-faces j) faces-to-apply))) 570 (puthash modifier-code faces-to-apply semantic-token-modifier-cache)) 571 (dolist (face faces-to-apply) 572 (add-face-text-property text-property-beg text-property-end face))) 573 when (> current-line line-max-inclusive) return nil))))) 574 `(jit-lock-bounds ,beg . ,end))))) 575 576 (defun lsp-semantic-tokens--request-update () 577 "Request semantic-tokens update." 578 ;; when dispatching ranged requests, we'll over-request by several chunks in both directions, 579 ;; which should minimize those occasions where font-lock region extension extends beyond the 580 ;; region covered by our freshly requested tokens (see lsp-mode issue #3154), while still limiting 581 ;; requests to fairly small regions even if the underlying buffer is large 582 (when (lsp-feature? "textDocument/semanticTokensFull") 583 (lsp--semantic-tokens-request 584 (cons (max (point-min) (- (window-start) (* 5 jit-lock-chunk-size))) 585 (min (point-max) (+ (window-end) (* 5 jit-lock-chunk-size)))) t))) 586 587 (defun lsp--semantic-tokens-as-defined-by-workspace (workspace) 588 "Return plist of token-types and token-modifiers defined by WORKSPACE, 589 or nil if none are defined." 590 (when-let ((token-capabilities 591 (or 592 (-some-> 593 (lsp--registered-capability "textDocument/semanticTokens") 594 (lsp--registered-capability-options)) 595 (lsp:server-capabilities-semantic-tokens-provider? 596 (lsp--workspace-server-capabilities workspace))))) 597 (-let* (((&SemanticTokensOptions :legend) token-capabilities)) 598 `(:token-types ,(lsp:semantic-tokens-legend-token-types legend) 599 :token-modifiers ,(lsp:semantic-tokens-legend-token-modifiers legend))))) 600 601 (defun lsp-semantic-tokens-suggest-overrides () 602 "Suggest face overrides that best match the faces 603 chosen by `font-lock-fontify-region'." 604 (interactive) 605 (-when-let* ((token-info (-some #'lsp--semantic-tokens-as-defined-by-workspace lsp--buffer-workspaces)) 606 ((&plist :token-types token-types :token-modifiers token-modifiers) token-info)) 607 (let* ((tokens (lsp-request 608 "textDocument/semanticTokens/full" 609 `(:textDocument, (lsp--text-document-identifier)))) 610 (inhibit-field-text-motion t) 611 (data (lsp-get tokens :data)) 612 (associated-faces '()) 613 (line-delta) 614 ;; KLUDGE: clear cache so our font-lock advice won't apply semantic-token faces 615 (old-cache lsp--semantic-tokens-cache) 616 (face-or-faces)) 617 (setq lsp--semantic-tokens-cache nil) 618 (save-restriction 619 (save-excursion 620 (widen) 621 (font-lock-fontify-region (point-min) (point-max) t) 622 (save-mark-and-excursion 623 (save-restriction 624 (widen) 625 (goto-char (point-min)) 626 (cl-loop 627 for i from 0 to (1- (length data)) by 5 do 628 (setq line-delta (aref data i)) 629 (unless (= line-delta 0) (forward-line line-delta)) 630 (forward-char (aref data (+ i 1))) 631 (setq face-or-faces (get-text-property (point) 'face)) 632 ;; TODO: consider modifiers? 633 (when face-or-faces 634 (--each (if (listp face-or-faces) face-or-faces (list face-or-faces)) 635 (cl-pushnew `(,(aref data (+ i 3)) . ,it) associated-faces :test #'equal)))) 636 (setq lsp--semantic-tokens-cache old-cache) 637 (font-lock-flush))))) 638 (switch-to-buffer (get-buffer-create "*Suggested Overrides*")) 639 (insert "(") 640 ;; TODO: sort alternatives by frequency 641 (--each-indexed (-group-by #'car associated-faces) 642 (insert (if (= it-index 0) "(" "\n (")) 643 (insert (format "%s . " (aref token-types (car it)))) 644 (--each-indexed (mapcar #'cdr (cdr it)) 645 (insert (if (= it-index 0) (format "%s)" (prin1-to-string it)) 646 (format " ; Alternative: %s" (prin1-to-string it)))))) 647 (insert ")")))) 648 649 (declare-function tree-sitter-hl-mode "ext:tree-sitter-hl") 650 651 (with-eval-after-load 'tree-sitter-hl 652 (add-hook 653 'tree-sitter-hl-mode-hook 654 (lambda () 655 (when (and lsp-mode lsp--semantic-tokens-teardown 656 (boundp 'tree-sitter-hl-mode) tree-sitter-hl-mode) 657 (lsp-warn "It seems you have configured tree-sitter-hl to activate after lsp-mode. 658 To prevent tree-sitter-hl from overriding lsp-mode's semantic token highlighting, lsp-mode 659 will now disable both semantic highlighting and tree-sitter-hl mode and subsequently re-enable both, 660 starting with tree-sitter-hl-mode. 661 662 Please adapt your config to prevent unnecessary mode reinitialization in the future.") 663 (tree-sitter-hl-mode -1) 664 (funcall lsp--semantic-tokens-teardown) 665 (setq lsp--semantic-tokens-teardown nil) 666 (tree-sitter-hl-mode t) 667 (lsp--semantic-tokens-initialize-buffer))))) 668 669 ;;;###autoload 670 (defun lsp--semantic-tokens-initialize-buffer () 671 "Initialize the buffer for semantic tokens. 672 IS-RANGE-PROVIDER is non-nil when server supports range requests." 673 (let* ((old-extend-region-functions font-lock-extend-region-functions) 674 ;; make sure font-lock always fontifies entire lines (TODO: do we also have 675 ;; to change some jit-lock-...-region functions/variables?) 676 (new-extend-region-functions 677 (if (memq 'font-lock-extend-region-wholelines old-extend-region-functions) 678 old-extend-region-functions 679 (cons 'font-lock-extend-region-wholelines old-extend-region-functions))) 680 (buffer (current-buffer))) 681 (setq lsp--semantic-tokens-cache nil) 682 (setq font-lock-extend-region-functions new-extend-region-functions) 683 (add-function :around (local 'font-lock-fontify-region-function) #'lsp-semantic-tokens--fontify) 684 (add-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update nil t) 685 (lsp-semantic-tokens--request-update) 686 (setq lsp--semantic-tokens-teardown 687 (lambda () 688 (setq lsp--semantic-tokens-pending-full-token-requests 689 (--remove (eq buffer (car it)) lsp--semantic-tokens-pending-full-token-requests)) 690 (setq font-lock-extend-region-functions old-extend-region-functions) 691 (setq lsp--semantic-tokens-cache nil) 692 (remove-function (local 'font-lock-fontify-region-function) 693 #'lsp-semantic-tokens--fontify) 694 (remove-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update t))))) 695 696 (defun lsp--semantic-tokens-build-face-map (identifiers faces category varname) 697 "Build map of FACES for IDENTIFIERS using CATEGORY and VARNAME." 698 (apply 'vector 699 (mapcar (lambda (id) 700 (let ((maybe-face (cdr (assoc id faces)))) 701 (when (and lsp-semantic-tokens-warn-on-missing-face (not maybe-face)) 702 (lsp-warn "No face has been associated to the %s '%s': consider adding a corresponding definition to %s" 703 category id varname)) maybe-face)) identifiers))) 704 705 (defun lsp-semantic-tokens--apply-alist-overrides (base overrides discard-defaults) 706 "Merge or replace BASE with OVERRIDES, depending on DISCARD-DEFAULTS. 707 For keys present in both alists, the assignments made by 708 OVERRIDES will take precedence." 709 (if discard-defaults 710 overrides 711 (let* ((copy-base (copy-alist base))) 712 (mapc (-lambda ((key . value)) (setf (alist-get key copy-base nil nil #'string=) value)) overrides) 713 copy-base))) 714 715 (defun lsp-semantic-tokens--type-faces-for (client) 716 "Return the semantic token type faces for CLIENT." 717 (lsp-semantic-tokens--apply-alist-overrides 718 lsp-semantic-token-faces 719 (plist-get (lsp--client-semantic-tokens-faces-overrides client) :types) 720 (plist-get (lsp--client-semantic-tokens-faces-overrides client) :discard-default-types))) 721 722 (defun lsp-semantic-tokens--modifier-faces-for (client) 723 "Return the semantic token type faces for CLIENT." 724 (lsp-semantic-tokens--apply-alist-overrides 725 lsp-semantic-token-modifier-faces 726 (plist-get (lsp--client-semantic-tokens-faces-overrides client) :modifiers) 727 (plist-get (lsp--client-semantic-tokens-faces-overrides client) :discard-default-modifiers))) 728 729 (defun lsp--semantic-tokens-on-refresh (workspace) 730 "Clear semantic tokens within all buffers of WORKSPACE, 731 refresh in currently active buffer." 732 (cl-assert (not (eq nil workspace))) 733 (when lsp-semantic-tokens-honor-refresh-requests 734 (cl-loop 735 for ws-buffer in (lsp--workspace-buffers workspace) do 736 (let ((fontify-immediately (equal (current-buffer) ws-buffer))) 737 (with-current-buffer ws-buffer (lsp--semantic-tokens-request nil fontify-immediately)))))) 738 739 ;;;###autoload 740 (defun lsp--semantic-tokens-initialize-workspace (workspace) 741 "Initialize semantic tokens for WORKSPACE." 742 (cl-assert workspace) 743 (-let (((&plist :token-types types :token-modifiers modifiers) 744 (lsp--semantic-tokens-as-defined-by-workspace workspace)) 745 (client (lsp--workspace-client workspace))) 746 (setf (lsp--workspace-semantic-tokens-faces workspace) 747 (lsp--semantic-tokens-build-face-map 748 types (lsp-semantic-tokens--type-faces-for client) 749 "semantic token" "lsp-semantic-token-faces")) 750 (setf (lsp--workspace-semantic-tokens-modifier-faces workspace) 751 (lsp--semantic-tokens-build-face-map 752 modifiers (lsp-semantic-tokens--modifier-faces-for client) 753 "semantic token modifier" "lsp-semantic-token-modifier-faces")))) 754 755 ;;;###autoload 756 (defun lsp-semantic-tokens--warn-about-deprecated-setting () 757 "Warn about deprecated semantic highlighting variable." 758 (when (boundp 'lsp-semantic-highlighting) 759 (pcase lsp-semantic-highlighting 760 (:semantic-tokens 761 (lsp-warn "It seems you wish to use semanticTokens-based 762 highlighting. To do so, please remove any references to the 763 deprecated variable `lsp-semantic-highlighting' from your 764 configuration and set `lsp-semantic-tokens-enable' to `t' 765 instead.") 766 (setq lsp-semantic-tokens-enable t)) 767 ((or :immediate :deferred) 768 (lsp-warn "It seems you wish to use Theia-based semantic 769 highlighting. This protocol has been superseded by the 770 semanticTokens protocol specified by LSP v3.16 and is no longer 771 supported by lsp-mode. If your language server provides 772 semanticToken support, please set 773 `lsp-semantic-tokens-enable' to `t' to use it."))))) 774 775 ;;;###autoload 776 (defun lsp-semantic-tokens--enable () 777 "Enable semantic tokens mode." 778 (when (and lsp-semantic-tokens-enable 779 (lsp-feature? "textDocument/semanticTokensFull")) 780 (lsp-semantic-tokens--warn-about-deprecated-setting) 781 (lsp-semantic-tokens-mode 1))) 782 783 (defun lsp-semantic-tokens--disable () 784 "Disable semantic tokens mode." 785 (lsp-semantic-tokens-mode -1)) 786 787 ;;;###autoload 788 (define-minor-mode lsp-semantic-tokens-mode 789 "Toggle semantic-tokens support." 790 :group 'lsp-semantic-tokens 791 :global nil 792 (cond 793 ((and lsp-semantic-tokens-mode (lsp-feature? "textDocument/semanticTokensFull")) 794 (add-hook 'lsp-configure-hook #'lsp-semantic-tokens--enable nil t) 795 (add-hook 'lsp-unconfigure-hook #'lsp-semantic-tokens--disable nil t) 796 (mapc #'lsp--semantic-tokens-initialize-workspace 797 (lsp--find-workspaces-for "textDocument/semanticTokensFull")) 798 (lsp--semantic-tokens-initialize-buffer)) 799 (t 800 (remove-hook 'lsp-configure-hook #'lsp-semantic-tokens--enable t) 801 (remove-hook 'lsp-unconfigure-hook #'lsp-semantic-tokens--disable t) 802 (when lsp--semantic-tokens-teardown 803 (funcall lsp--semantic-tokens-teardown)) 804 (lsp-semantic-tokens--request-update) 805 (setq lsp--semantic-tokens-cache nil 806 lsp--semantic-tokens-teardown nil)))) 807 808 ;; debugging helpers 809 (defun lsp--semantic-tokens-verify () 810 "Store current token set and compare with the response to a full token request." 811 (interactive) 812 (let ((old-tokens (--> lsp--semantic-tokens-cache (plist-get it :response) (lsp-get it :data))) 813 (old-version (--> lsp--semantic-tokens-cache (plist-get it :_documentVersion)))) 814 (if (not (equal lsp--cur-version old-version)) 815 (message "Stored documentVersion %d differs from current version %d" old-version lsp--cur-version) 816 (lsp-request-async 817 "textDocument/semanticTokens/full" `(:textDocument ,(lsp--text-document-identifier)) 818 (lambda (response) 819 (let ((new-tokens (lsp-get response :data))) 820 (if (equal old-tokens new-tokens) 821 (message "New tokens (total count %d) are identical to previously held token set" 822 (length new-tokens)) 823 (message "Newly returned tokens differ from old token set") 824 (print old-tokens) 825 (print new-tokens)))) 826 :mode 'tick 827 :cancel-token (format "semantic-tokens-%s" (lsp--buffer-uri)))))) 828 829 (defvar-local lsp-semantic-tokens--log '()) 830 831 (defvar-local lsp-semantic-tokens--prev-response nil) 832 833 (defun lsp-semantic-tokens--log-buffer-contents (tag) 834 "Log buffer contents for TAG." 835 (save-restriction 836 (save-excursion 837 (widen) (push `(:tag ,tag 838 :buffer-contents ,(buffer-substring (point-min) (point-max)) 839 :prev-response ,lsp-semantic-tokens--prev-response) 840 lsp-semantic-tokens--log)))) 841 842 (defun lsp-semantic-tokens-enable-log () 843 "Enable logging of intermediate fontification states. 844 845 This is a debugging tool, and may incur significant performance penalties." 846 (setq lsp-semantic-tokens--log '()) 847 (defun lsp-advice-tokens-fontify (orig-func old-fontify-region beg-orig end-orig &optional loudly) 848 (lsp-semantic-tokens--log-buffer-contents 'before) 849 (let ((result (funcall orig-func old-fontify-region beg-orig end-orig loudly))) 850 (lsp-semantic-tokens--log-buffer-contents 'after) 851 result)) 852 (advice-add 'lsp-semantic-tokens--fontify :around 'lsp-advice-tokens-fontify) 853 854 (defun lsp-log-delta-response (response) 855 (setq lsp-semantic-tokens--prev-response `(:request-type "delta" 856 :response ,response 857 :version ,lsp--cur-version))) 858 (advice-add 'lsp--semantic-tokens-ingest-full/delta-response :before 'lsp-log-delta-response) 859 860 (defun lsp-log-full-response (response) 861 (setq lsp-semantic-tokens--prev-response `(:request-type "full" 862 :response ,response 863 :version ,lsp--cur-version))) 864 (advice-add 'lsp--semantic-tokens-ingest-full-response :before 'lsp-log-full-response) 865 866 (defun lsp-log-range-response (response) 867 (setq lsp-semantic-tokens--prev-response `(:request-type "range" 868 :response ,response 869 :version ,lsp--cur-version))) 870 (advice-add 'lsp--semantic-tokens-ingest-range-response :before 'lsp-log-range-response)) 871 872 (defun lsp-semantic-tokens-disable-log () 873 "Disable logging of intermediate fontification states." 874 (advice-remove 'lsp-semantic-tokens--fontify 'lsp-advice-tokens-fontify) 875 (advice-remove 'lsp--semantic-tokens-ingest-full/delta-response 'lsp-log-delta-response) 876 (advice-remove 'lsp--semantic-tokens-ingest-full-response 'lsp-log-full-response) 877 (advice-remove 'lsp--semantic-tokens-ingest-range-response 'lsp-log-range-response)) 878 879 (declare-function htmlize-buffer "ext:htmlize") 880 881 (defun lsp-semantic-tokens-export-log () 882 "Write HTML-formatted snapshots of previous fontification results to /tmp." 883 (require 'htmlize) 884 (let* ((outdir (f-join "/tmp" "semantic-token-snapshots")) 885 (progress-reporter 886 (make-progress-reporter 887 (format "Writing buffer snapshots to %s..." outdir) 888 0 (length lsp-semantic-tokens--log)))) 889 (f-mkdir outdir) 890 (--each-indexed (reverse lsp-semantic-tokens--log) 891 (-let* (((&plist :tag tag 892 :buffer-contents buffer-contents 893 :prev-response prev-response) it) 894 (html-buffer)) 895 ;; FIXME: doesn't update properly; sit-for helps... somewhat, 896 ;; but unreliably 897 (when (= (% it-index 5) 0) 898 (progress-reporter-update progress-reporter it-index) 899 (sit-for 0.01)) 900 ;; we're emitting 2 snapshots (before & after) per update, so request 901 ;; parameters should only change on every 2nd invocation 902 (when (cl-evenp it-index) 903 (with-temp-buffer 904 (insert (prin1-to-string prev-response)) 905 (write-file (f-join outdir (format "parameters_%d.el" (/ it-index 2)))))) 906 (with-temp-buffer 907 (insert buffer-contents) 908 (setq html-buffer (htmlize-buffer)) 909 (with-current-buffer html-buffer 910 ;; some configs such as emacs-doom may autoformat on save; switch to 911 ;; fundamental-mode to avoid this 912 (fundamental-mode) 913 (write-file (f-join outdir (format "buffer_%d_%s.html" (/ it-index 2) tag))))) 914 (kill-buffer html-buffer))) 915 (progress-reporter-done progress-reporter))) 916 917 (lsp-consistency-check lsp-semantic-tokens) 918 919 (provide 'lsp-semantic-tokens) 920 ;;; lsp-semantic-tokens.el ends here