(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'."
  :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)

   :language 'slang
   :feature 'type
   `(
     ((call_expression function: (identifier) @font-lock-type-face)
     (:match ,(rx bos
                  (and (or "bool" "int" "uint" "float")
                       (or
                        (? (any "1" "2" "3" "4"))
                        (? (and (any "1" "2" "3" "4") "x" (any "1" "2" "3" "4")))))
                  eos) @font-lock-type-face))
     ((call_expression function: (identifier) @font-lock-function-call-face))
     (type_identifier) @font-lock-type-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)
     (call_expression function: (_ field: (field_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 'property
   '(((field_identifier) @font-lock-property-use-face))
   ))

(define-derived-mode slang-ts-mode c-ts-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)