[semantic-tokens] Add support for semantic tokens faces overrides (#2826)

* Add support for semantic tokens faces overrides

* Improve doc

Author: ericdallo

clients/lsp-clojure.el

@@ -273,6 +273,8 @@ If there are more arguments expected after the line and column numbers."
  (make-lsp-client
   :download-server-fn (lambda (_client callback error-callback _update?)
                         (lsp-package-ensure 'clojure-lsp callback error-callback))
+  :semantic-tokens-faces-overrides '(:types (("macro" . font-lock-keyword-face)
+                                             ("keyword" . clojure-keyword-face)))
   :new-connection (lsp-stdio-connection
                    (lambda ()
                      (or lsp-clojure-custom-server-command

lsp-mode.el

@@ -1416,6 +1416,8 @@ return value of `body' or nil if interrupted."
   multi-root
   ;; Initialization options or a function that returns initialization options.
   initialization-options
+  ;; Overrides semantic tokens faces for specific clients
+  semantic-tokens-faces-overrides
   ;; Provides support for registering LSP Server specific capabilities.
   custom-capabilities
   ;; Function which returns the folders that are considered to be not projects but library files.

lsp-semantic-tokens.el

@@ -378,6 +378,23 @@ IS-RANGE-PROVIDER is non-nil when server supports range requests."
                        (lsp-warn "No face has been associated to the %s '%s': consider adding a corresponding definition to %s"
                                  category id varname)) maybe-face)) identifiers)))
 
+(defun lsp-semantic-tokens--replace-alist-values (a b)
+  "Replace alist A values with B ones where available."
+  (-map
+   (-lambda ((ak . av))
+     (cons ak (alist-get ak b av nil #'string=)))
+   a))
+
+(defun lsp-semantic-tokens--type-faces-for (client)
+  "Return the semantic token type faces for CLIENT."
+  (lsp-semantic-tokens--replace-alist-values lsp-semantic-token-faces
+                                     (plist-get (lsp--client-semantic-tokens-faces-overrides client) :types)))
+
+(defun lsp-semantic-tokens--modifier-faces-for (client)
+  "Return the semantic token type faces for CLIENT."
+  (lsp-semantic-tokens--replace-alist-values lsp-semantic-token-modifier-faces
+                                     (plist-get (lsp--client-semantic-tokens-faces-overrides client) :modifiers)))
+
 ;;;###autoload
 (defun lsp--semantic-tokens-initialize-workspace (workspace)
   "Initialize semantic tokens for WORKSPACE."
@@ -389,15 +406,16 @@ IS-RANGE-PROVIDER is non-nil when server supports range requests."
                  (lsp--registered-capability-options))
                (lsp:server-capabilities-semantic-tokens-provider?
                 (lsp--workspace-server-capabilities workspace)))))
-    (-let* (((&SemanticTokensOptions :legend) token-capabilities))
+    (-let* (((&SemanticTokensOptions :legend) token-capabilities)
+            (client (lsp--workspace-client workspace)))
       (setf (lsp--workspace-semantic-tokens-faces workspace)
             (lsp--semantic-tokens-build-face-map (lsp:semantic-tokens-legend-token-types legend)
-                                                 lsp-semantic-token-faces
+                                                 (lsp-semantic-tokens--type-faces-for client)
                                                  "semantic token"
                                                  "lsp-semantic-token-faces"))
       (setf (lsp--workspace-semantic-tokens-modifier-faces workspace)
             (lsp--semantic-tokens-build-face-map (lsp:semantic-tokens-legend-token-modifiers legend)
-                                                 lsp-semantic-token-modifier-faces
+                                                 (lsp-semantic-tokens--modifier-faces-for client)
                                                  "semantic token modifier"
                                                  "lsp-semantic-token-modifier-faces")))))