c-ts-mode-config.el

c-ts-mode-config.el

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tree-sitter utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ts/node-in (node types)
  (member (treesit-node-type node) types))

(defun ts/node-standalone-p (node)
  (save-excursion
    (goto-char (treesit-node-start node))
    (looking-back (rx bol (* whitespace))
                  (line-beginning-position))))

(defun ts/node-buffer-point (node)
  (save-excursion
    (goto-char (treesit-node-start node))
    (back-to-indentation)
    (point)))

;; Find ancestor whose type is not in skips.
(defun ts/skip-parent (parent skips)
  (treesit-parent-until
   parent
   (lambda (n) (not (ts/node-in n skips)))
   t))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This code finds the "actual" parent while skipping preprocessor
;; macros and gracefully handling tree-sitter-c parser bugs.
;;
;; my/actual-parent and my/actual-parent3 can directly substitute
;; treesit-node-parent node in many cases.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; case_statement is also buggy but too difficult to hande.
(defconst my/buggy-container-fields
  '(("if_statement" . "consequence")
    ("for_statement" . "body")
    ("while_statement" . "body")))

(defconst my/buggy-container-types
  (map-keys my/buggy-container-fields))

(defun my/buggy-empty-container-p (node)
  (when-let* ((type (treesit-node-type node))
              (field (cdr (assoc type my/buggy-container-fields)))
              (body (treesit-node-child-by-field-name node field)))
    (zerop (- (treesit-node-end body)
	      (treesit-node-start body)))))

(defun my/preproc-node-p (node)
  (string-prefix-p "preproc" (treesit-node-type node)))

(defun my/actual-prev-sibling (node)
  (let ((s (treesit-node-prev-sibling node)))
    (if (my/preproc-node-p s)
        (my/actual-prev-sibling s)
      s)))

(defun my/sibling-is-parent-of (sibl node)
  (and
   sibl
   (member (treesit-node-type sibl) my/buggy-container-types)
   (my/buggy-empty-container-p sibl)
   (or (my/preproc-node-p node)
       (my/preproc-node-p (treesit-node-prev-sibling node)))))

(defun my/actual-node-at (node parent bol)
  (or node
      (treesit-node-prev-sibling
       (treesit-node-first-child-for-pos parent bol))))

(defun my/actual-parent (node)
  (let ((sibl (my/actual-prev-sibling node)))
    (if (my/sibling-is-parent-of sibl node)
        sibl
      (let ((parent (treesit-node-parent node)))
        (if (my/preproc-node-p parent)
            (my/actual-parent parent)
          parent)))))

(defun my/actual-parent3 (node parent bol)
  (let* ((node-at (my/actual-node-at node parent bol))
         (actual-parent (my/actual-parent node-at)))
    (message "%s -> %s" node-at actual-parent)
    actual-parent))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Node categories
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst types/blocks
  '("case_statement"
    "compound_statement"
    "else_clause"
    "if_statement"
    "for_statement"
    "return_statement"
    "while_statement"
    ))

(defconst types/column-0
  '("translation_unit"))

(defconst types/macros
  '("#endif"
    "preproc_call"
    "preproc_def"
    "preproc_else"
    "preproc_if"
    "preproc_ifdef"
    "preproc_include"
    ))

;; Tokens that "close" opened blocks
(defconst types/closers '("}" ")" "]"))

;; Opening punctuation ({ and () placed directly below these nodes is
;; not indented.
(defconst types/list-openers
  '("call_expression"
    "case_statement"
    "do_statement"
    "else_clause"
    "enum_specifier"
    "for_statement"
    "function_declarator"
    "function_definition"
    "if_statement"
    "init_declarator"
    "struct_specifier"
    "switch_statement"
    "while_statement"
    ))

(defconst types/list-likes
  '("argument_list"
    "compound_statement"
    "enumerator_list"
    "field_declaration_list"
    "initializer_list"
    "parameter_list"
    ))

(defconst types/lineup-indentable
  '("argument_list"
    "enumerator_list"
    "field_declaration_list"
    "initializer_list"
    "parameter_list"
    "parenthesized_expression"
    ))

;; These do not affect indentation of expressions
(defconst types/skip-past
  '("binary_expression"
    "comma_expression"
    "concatenated_string"
    ))

;; return cond\n|| cond2;
(defconst types/skip-to
  '("assignment_expression"
    "init_declarator"
    "initializer_pair"
    "return_statement"
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; match/-prefixed functions match the parse, and col/-prefixed are
;; for getting node start columns.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun match/actual-parent (types)
  (lambda (node parent bol &rest _)
    (ts/node-in (my/actual-parent3 node parent bol) types)))

(defun match/node-any (types)
  (lambda (node parent &rest _)
    (ts/node-in node types)))

(defun match/n-p-any (n-types p-types)
  (lambda (node parent &rest _)
    (and
     (ts/node-in node n-types)
     (ts/node-in parent p-types))))

(defun match/parent-and-rank (parent-types lo hi)
  (lambda (node parent &rest _)
    (let ((ix (treesit-node-index node)))
      (and (member (treesit-node-type parent) parent-types)
           (or (not lo)
	       (>= ix lo))
	   (or (not hi)
	       (<= ix hi))))))

(defun match/skip-parent (skip-past skip-to)
  (lambda (node p &rest _)
    (let ((skip-parent (ts/skip-parent p skip-past)))
      (message "node %s skips to %s" node skip-parent)
      (ts/node-in skip-parent skip-to))))

(defun col/skip-parent (skip-past)
  (lambda (n p bol &rest _)
    (let ((skip-parent (ts/skip-parent p skip-past)))
      (ts/node-buffer-point skip-parent))))

(defun col/actual-parent (sa)
  (lambda (node parent bol &rest _)
    (let* ((actual0 (my/actual-parent3 node parent bol))
	   (actual1 (if sa
			(treesit-parent-until
			 actual0 #'ts/node-standalone-p t))))
      (ts/node-buffer-point actual1))))

;; Complicated, but pretty robust indentation rules.
(defun my/c-ts-indent-style ()
  (let ((ofs c-ts-mode-indent-offset)
        (half-ofs (/ c-ts-mode-indent-offset 2)))
    `((c

       ;; Preprocessor directives should be at column (P6)
       ((node-is "preproc_arg") column-0 ,ofs)
       (,(match/node-any types/macros) column-0 0)

       ;; This "retracts" opening symbols
       (,(match/node-any types/closers) standalone-parent 0)

       ;; Pushing most nodes outside of functions to column 0 (P2).
       (,(match/actual-parent types/column-0) column-0 0)
       ((n-p-gp nil "declaration" "translation_unit") column-0 0)
       ((node-is "function_declarator") column-0 0)

       ;; A list-like directly below a list-opener should not be
       ;; indented (P5).
       (,(match/n-p-any types/list-likes types/list-openers)
	(col/actual-parent t) 0)

       ;; Context-dependent lineup or block-indentation (P4)
       (,(match/parent-and-rank types/lineup-indentable 0 1)
        parent-bol ,ofs)
       (,(match/parent-and-rank types/lineup-indentable 2 nil)
        (nth-sibling 1) 0)
       (,(match/node-any types/lineup-indentable) standalone-parent ,ofs)

       ;; Kludges for binary expressions (P2)
       (,(match/skip-parent types/skip-past types/skip-to)
        ,(col/skip-parent types/skip-past)
        ,ofs)
       ((parent-is "concatenated_string") parent 0)
       ((parent-is "binary_expression") parent 0)
       ((parent-is "comma_expression") parent 0)
       ((parent-is "conditional_expression") parent 0)

       ;; do-whiles
       ((n-p-gp "while" "do_statement" nil) standalone-parent 0)

       ;; Switch/case. Change 0 to ,ofs if u like indented cases.
       ((node-is "case") (col/actual-parent t) 0)

       ;; for: lineup
       ((query "(for_statement initializer: (_) @indent)") parent-bol 5)
       ((query "(for_statement condition: (_) @indent)") parent-bol 5)
       ((query "(for_statement update: (_) @indent)") parent-bol 5)

       ;; if
       ((node-is "else_clause") parent-bol 0)

       ;; Labels are wonky in tree-sitter
       ((node-is "labeled_statement") standalone-parent ,half-ofs)
       ((parent-is "labeled_statement") standalone-parent ,half-ofs)

       ;; Handles children of blocks (P0)
       (,(match/actual-parent types/blocks) (col/actual-parent t) ,ofs)
       )
      ))
  )

(defun my/c-ts-mode-hook ()
  (c-ts-mode-toggle-comment-style -1)
  (setq-local whitespace-style '(tabs tab-mark))
  (setq-local whitespace-display-mappings
	      '((tab-mark 9 [187 9] [92 9])))
  (setq-local indent-tabs-mode nil)
  (whitespace-mode))

(use-package c-ts-mode
  :if (and (fboundp 'treesit-language-available-p)
           (treesit-language-available-p 'c))
  :custom
  (c-ts-mode-indent-offset 4)
  (c-ts-mode-indent-style #'my/c-ts-indent-style)
  ;; I have NO IDEA why you need to quote the c-ts-mode symbol.
  :hook
  ('c-ts-mode . #'my/c-ts-mode-hook)
  :config
  (setq major-mode-remap-alist
	'((c-mode . c-ts-mode)
	  (c++-mode . c++-ts-mode)
	  (c-or-c++-mode . c-or-c++-ts-mode))))