slang-ts-mode and lsp hook

init.org

@@ -1493,6 +1493,244 @@ hlsl-mode:
   (add-to-list 'auto-mode-alist '("\\.frag\\'" . hlsl-mode))
   )
 #+end_src
+
+#+begin_src emacs-lisp
+(require 'treesit)
+
+(add-to-list
+ 'treesit-language-source-alist
+ '(slang "https://github.com/tree-sitter-grammars/tree-sitter-slang"))
+
+(with-eval-after-load 'lsp-mode
+  (progn
+    ;; tree-sitter
+
+    ;; LSP
+    (add-to-list 'lsp-language-id-configuration '(".*\\.slang$" . "slang"))
+    (lsp-register-client (make-lsp-client
+                          :new-connection (lsp-stdio-connection "/opt/shader-slang-bin/bin/slangd")
+                          :activation-fn (lsp-activate-on "slang")
+                          :server-id 'slang))
+    ))
+
+(require 'c-ts-common)
+(require 'c-ts-mode)
+
+(defgroup slang nil "Khronos Slang Major Mode."
+  :group 'languages)
+
+(defcustom slang-ts-mode-indent-offset 4
+  "Number of spaces for each indentation step in `slang-ts-mode'."
+  :version "29.1"
+  :type 'integer
+  :safe 'integerp
+  :group 'slang)
+
+(declare-function treesit-parser-create "treesit.c")
+(declare-function treesit-node-parent "treesit.c")
+(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-end "treesit.c")
+(declare-function treesit-node-child "treesit.c")
+(declare-function treesit-node-child-by-field-name "treesit.c")
+(declare-function treesit-node-type "treesit.c")
+(declare-function treesit-node-prev-sibling "treesit.c")
+(declare-function treesit-node-first-child-for-pos "treesit.c")
+(declare-function treesit-node-next-sibling "treesit.c")
+(declare-function treesit-parser-set-included-ranges "treesit.c")
+(declare-function treesit-query-compile "treesit.c")
+
+;; taken from rust-ts-mode
+(defvar slang-ts-mode--syntax-table
+  (let ((table (make-syntax-table)))
+    (modify-syntax-entry ?+   "."      table)
+    (modify-syntax-entry ?-   "."      table)
+    (modify-syntax-entry ?=   "."      table)
+    (modify-syntax-entry ?%   "."      table)
+    (modify-syntax-entry ?&   "."      table)
+    (modify-syntax-entry ?|   "."      table)
+    (modify-syntax-entry ?^   "."      table)
+    (modify-syntax-entry ?!   "."      table)
+    (modify-syntax-entry ?@   "."      table)
+    (modify-syntax-entry ?~   "."      table)
+    (modify-syntax-entry ?<   "."      table)
+    (modify-syntax-entry ?>   "."      table)
+    (modify-syntax-entry ?/   ". 124b" table)
+    (modify-syntax-entry ?*   ". 23"   table)
+    (modify-syntax-entry ?\n  "> b"    table)
+    (modify-syntax-entry ?\^m "> b"    table)
+    table)
+  "Syntax table for `slang-ts-mode'.")
+
+(defvar slang-ts-mode--indent-rules
+  `((slang
+     ((parent-is "translation_unit") column-0 0)
+     ((node-is ")") parent-bol 0)
+     ((node-is "]") parent-bol 0)
+     ((node-is "}") (and parent parent-bol) 0)
+     ((and (parent-is "comment") c-ts-common-looking-at-star)
+      c-ts-common-comment-start-after-first-star -1)
+     ((parent-is "comment") prev-adaptive-prefix 0)
+     ((parent-is "parameter_list") parent-bol slang-ts-mode-indent-offset)
+     ((parent-is "binary_expression") parent-bol slang-ts-mode-indent-offset)
+     ((parent-is "compount_statement") parent-bol slang-ts-mode-indent-offset)
+     ((parent-is "field_declaration_list") parent-bol slang-ts-mode-indent-offset)
+     ))
+  "Tree-sitter indent rules for `slang-ts-mode'.")
+
+;; taken from rust-ts-mode
+(defun slang-ts-mode--syntax-propertize (beg end)
+  "Apply syntax properties to special characters between BEG and END.
+
+Apply syntax properties to various special characters with
+contextual meaning between BEG and END.
+
+The apostrophe \\=' should be treated as string when used for char literals.
+
+< and > are usually punctuation, e.g., as greater/less-than.  But
+when used for types, they should be considered pairs.
+
+This function checks for < and > in the changed RANGES and apply
+appropriate text property to alter the syntax of template
+delimiters < and >'s."
+  (goto-char beg)
+  (while (search-forward "'" end t)
+    (when (string-equal "char_literal"
+                        (treesit-node-type
+                         (treesit-node-at (match-beginning 0))))
+      (put-text-property (match-beginning 0) (match-end 0)
+                         'syntax-table (string-to-syntax "\""))))
+  (goto-char beg)
+  (while (re-search-forward (rx (or "<" ">")) end t)
+    (pcase (treesit-node-type
+            (treesit-node-parent
+             (treesit-node-at (match-beginning 0))))
+      ("template_argument_list"
+       (put-text-property (match-beginning 0)
+                          (match-end 0)
+                          'syntax-table
+                          (pcase (char-before)
+                            (?< '(4 . ?>))
+                            (?> '(5 . ?<))))))))
+
+;; (treesit-query-validate 'slang "(bitfield_clause (identifier) @font-lock-builtin-face) (:match ,(rx bos (or ,@slang-ts-mode--locations) eos))")
+
+(defvar slang-ts-mode--locations
+  '("SV_Position" "COLOR" "POSITION" "SV_Target")
+  "Slang built-in location hints for font-locking.")
+
+(defvar slang-ts-mode--keywords
+  '("struct" "interface" "where" "return")
+  "Slang built-in location hints for font-locking.")
+
+(defvar slang-ts-mode--types
+  `(,@(mapcar (lambda (type)
+                  (concat type "\\([1234]?\\|\\([1234]x[1234]\\)?\\)"))
+                '("bool" "int" "uint" "float"
+                  "min16float" "min10float" "min16int" "min12int" "min16uint")))
+  "Slang types for font-locking.")
+
+(defvar slang-ts-mode--operators
+  '("!"  "!=" "%" "%=" "&" "&=" "&&" "*" "*=" "+" "+=" "," "-" "-="
+    "->" "." "/" "/=" ":" ";" "<<" "<<=" "<" "<="
+    "=" "==" "=>" ">" ">=" ">>" ">>=" "^" "^=" "|" "|=" "||")
+  "Slang operators for tree-sitter font-locking.")
+
+(defvar slang-ts-mode--font-lock-settings
+  (treesit-font-lock-rules
+   :language 'slang
+   :feature 'bracket
+   '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face)
+
+   :language 'slang
+   :feature 'comment
+   '(((comment) @font-lock-comment-face))
+
+   :language 'slang
+   :feature 'builtin
+   '((bitfield_clause (identifier) @font-lock-builtin-face)
+     (semantics (identifier) @font-lock-builtin-face))
+
+   :language 'slang
+   :feature 'keyword
+   `([,@slang-ts-mode--keywords] @font-lock-keyword-face)
+     ;; ([,@slang-ts-mode--locations] @font-lock-builtin-face)
+
+   :language 'slang
+   :feature 'definition
+   '(
+     (declaration declarator: (identifier) @font-lock-property-name-face)
+     (field_declaration declarator: (field_identifier) @font-lock-property-name-face)
+     (parameter_declaration declarator: (identifier) @font-lock-property-name-face)
+     (function_declarator declarator: (identifier) @font-lock-function-name-face)
+     (function_declarator declarator: (template_function name: (identifier) @font-lock-type-face))
+     (hlsl_attribute (call_expression function: (identifier) @font-lock-builtin-face))
+     )
+
+   :language 'slang
+   :feature 'function
+   '((call_expression function: (identifier) @font-lock-function-call-face))
+
+   :language 'slang
+   :feature 'string
+   '(((string_content) @font-lock-string-face))
+
+   :language 'slang
+   :feature 'type
+   '(((type_identifier) @font-lock-type-face)
+     (function_definition type: (type_identifier) @font-lock-type-face)
+     (declaration type: (type_identifier) @font-lock-type-face)
+     (field_declaration type: (type_identifier) @font-lock-type-face)
+     (parameter_declaration type: (type_identifier) @font-lock-type-face)
+     (template_argument_list (type_descriptor type: (type_identifier) @font-lock-type-face))
+     )
+
+   :language 'slang
+   :feature 'operator
+   `([,@slang-ts-mode--operators] @font-lock-operator-face)
+
+   :language 'slang
+   :feature 'variable
+   '(((identifier) @font-lock-property-use-face))
+
+   :language 'slang
+   :feature 'number
+   '(((number_literal) @font-lock-number-face))
+
+   :language 'slang
+   :feature 'type
+   '(((type_identifier) @font-lock-type-face))
+
+   :language 'slang
+   :feature 'property
+   '(((field_identifier) @font-lock-property-use-face))
+   ))
+
+(define-derived-mode slang-ts-mode prog-mode "Slang"
+  "Major mode for editing Slang, powered by tree-sitter."
+  :group 'slang
+  :syntax-table slang-ts-mode--syntax-table
+
+  (when (treesit-ready-p 'slang)
+    (treesit-parser-create 'slang)
+    (setq-local treesit-font-lock-feature-list
+                '((comment definition)
+                  (keyword string)
+                  (assignment attribute builtin variable constant escape-sequence number definition property type)
+                  (bracket delimiter error function operator property variable)
+                  ))
+    (setq-local syntax-propertize-function #'slang-ts-mode--syntax-propertize
+                indent-tabs-mode nil
+                treesit-font-lock-settings slang-ts-mode--font-lock-settings
+                treesit-simple-indent-rules slang-ts-mode--indent-rules)
+    (treesit-major-mode-setup))
+  )
+
+(if (treesit-ready-p 'slang)
+    (add-to-list 'auto-mode-alist '("\\.slang\\'" . slang-ts-mode)))
+
+(provide 'slang-ts-mode)
+#+end_src
+
 ** Rust
 [[https://github.com/rust-lang/rust-mode][=rust-mode=]]
 #+begin_src emacs-lisp