;;; bison-ts-mode --- Tree-sitter mode for Bison -*- lexical-binding: t; -*-

;;; Commentary:

;;; Code:

(require 'treesit)
(require 'c-ts-mode)

(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(declare-function treesit-search-subtree "treesit.c")
(declare-function treesit-node-parent "treesit.c")
(declare-function treesit-node-next-sibling "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child "treesit.c")
(declare-function treesit-node-end "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-string "treesit.c")
(declare-function treesit-query-compile "treesit.c")
(declare-function treesit-query-capture "treesit.c")
(declare-function treesit-parser-add-notifier "treesit.c")
(declare-function treesit-parser-buffer "treesit.c")
(declare-function treesit-parser-list "treesit.c")


(defun treesit--merge-feature-lists (l1 l2)
  "Merge the lists of lists L1 and L2.
The first sublist of L1 is merged with the first sublist of L2 and so on.
L1 and L2 don't need to have the same size."
  (let ((res ()))
    (while (or l1 l2)
      (setq res (push (nconc (car l1) (car l2)) res))
      (setq l1 (cdr l1) l2 (cdr l2)))
    (nreverse res)))


;; (defun bison-ts--language-at-point-function (position)
;;   "Return the language at POSITION."
;;   (let* ((node (treesit-node-at position)))
;; 	(if (treesit-parent-until
;; 		 node
;; 		 (lambda (n) (let ((type (treesit-node-type n)))
;; 			       (or (equal "code_block" type)
;; 				   (equal "undelimited_code_block" type))))
;; 		 t)
;; 	    'c
;; 	  'bison)))


(defun bison-ts--language-at-point-function (position)
  "Return the language at POSITION."
  (let* ((parser (treesit-local-parsers-at position)))
    (if parser
	'c
      'bison)))


(defun bison-ts--font-lock-settings (language)
  (treesit-font-lock-rules
   :language language
   :feature 'bison-comment
   '((comment) @font-lock-comment-face)

   :language language
   :feature 'bison-declaration
   '((declaration (declaration_name) @font-lock-keyword-face))

   :language language
   :feature 'bison-type
   '((type) @font-lock-type-face)

   :language language
   :feature 'bison-grammar-rule-usage
   '((grammar_rule_identifier) @font-lock-variable-use-face)

   :language language
   :feature 'bison-grammar-rule-declaration
   :override t
   '((grammar_rule (grammar_rule_identifier)  @font-lock-variable-name-face))

   :language language
   :feature 'bison-string
   :override t
   '((string) @font-lock-string-face)

   :language language
   :feature 'bison-literal
   :override t
   '((char_literal) @font-lock-keyword-face
     (number_literal) @font-lock-number-face)

   :language language
   :feature 'bison-directive-grammar-rule
   :override t
   '((grammar_rule (directive_empty) @font-lock-keyword-face))

   :language language
   :feature 'bison-operator
   :override t
   '(["|"] @font-lock-operator-face)

   :language language
   :feature 'bison-delimiter
   :override t
   '([";"] @font-lock-delimiter-face)))


(defvar bison-ts-mode--font-lock-feature-list
  '(( bison-comment bison-declaration bison-type
      bison-grammar-rule-usage bison-grammar-rule-declaration
      bison-string bison-literal bison-directive-grammar-rule
      bison-operator bison-delimiter)))


(define-derived-mode bison-ts-mode prog-mode "Bison"
  "A mode for Bison."
  (when (treesit-ready-p 'bison)
    (setq-local treesit-font-lock-settings
                (append (bison-ts--font-lock-settings 'bison)
                        (c-ts-mode--font-lock-settings 'c)))

    (setq-local treesit-font-lock-feature-list
                (treesit--merge-feature-lists
		 bison-ts-mode--font-lock-feature-list
		 c-ts-mode--font-lock-feature-list))

    (setq-local treesit-simple-indent-rules
                (c-ts-mode--get-indent-style 'c))

    (setq-local treesit-language-at-point-function 'bison-ts--language-at-point-function)

    (setq-local treesit-range-settings
		(treesit-range-rules
		 :embed 'c
		 :host 'bison
		 :local t
		 '((undelimited_code_block) @capture)
		 ))

    (treesit-major-mode-setup)))

(provide 'bison-ts-mode)
;;; bison-ts-mode.el ends here