;;; 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")


(defgroup bison nil
  "Support for the Bison and Flex."
  :group 'languages)

(defcustom bison-ts-mode-indent-offset 4
  "Number of spaces for each indentation step in `bison-ts-mode'."
  :version "30.1"
  :type 'integer
  :safe 'integerp
  :group 'bison)


(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 (append (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 'bison)))
    (if (equal (treesit-node-type node)
	       "embedded_code")
	'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
   '((grammar_rule (grammar_rule_declaration)
		   @font-lock-variable-use-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) @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)))


(treesit-query-validate 'bison '((grammar_rule (grammar_rule_declaration)  @font-lock-variable-name-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)))



(defun bison-ts--indent-rules ()
  "Indent rules supported by `bison-ts-mode'."
  (let*
      ((common
	 `(

	   ((node-is "^declaration$")
	    column-0 0)

	   ((and (parent-is "^declaration$")
		 (not (node-is "^code_block$")))
	    column-0 2)

	   ((and (parent-is "^declaration$")
		 (node-is "^code_block$"))
	    column-0 0)

	   ((parent-is "^declaration$")
	    parent 2)

	   ((node-is "^grammar_rule$")
	    column-0 0)

	   ((and
	     (parent-is "^grammar_rule$")
	     (node-is ";"))
	    column-0 bison-ts-mode-indent-offset)

	   ((and (parent-is "^grammar_rule$")
		 (node-is "|"))
	    column-0 bison-ts-mode-indent-offset)

	   ((and (parent-is "^grammar_rule$")
		 (not (node-is "^grammar_rule_declaration$"))
		 (not (node-is "^action$")))
	    column-0 ,(+ bison-ts-mode-indent-offset 2))

	   ((or
	     (node-is "^action$")
	     (node-is "}"))
	    column-0 12)

	   ;; Set '%%' at the beginning of the line
	   ((or
	     (and (parent-is "^grammar_rules_section$")
		  (node-is "%%"))
	     (node-is "^grammar_rules_section$"))
	    column-0 0)

	   (no-node parent 0)
	   )
	 ))
    `((bison . ,common))))


(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--feature-list))

    (setq-local treesit-simple-imenu-settings
		`(("Grammar"
		   "\\`grammar_rule_declaration\\'"
		   nil
		   (lambda (node) (treesit-node-text node) ))))

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

    (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
		 '((embedded_code) @capture)
		 ))

    (treesit-major-mode-setup)))

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