feature/tree-sitter 62c8c8e51a 10/10: Plug tree-sitter-simple-indent into c-offset-alist

[Yuan Fu]

branch: feature/tree-sitter
commit 62c8c8e51a23540cd189d6b2a22dd1a1cdbbf2cb
Author: Yuan Fu <casouri@gmail.com>
Commit: Yuan Fu <casouri@gmail.com>

    Plug tree-sitter-simple-indent into c-offset-alist
    
    Now tree-sitter indentation can produce a cc-engine syntax symbol and
    use c-offset-alist to compute the offset.  Catch: line-up functions
    don't work with tree-sitter.
    
    * lisp/progmodes/js.el (js--treesit-cc-indent-rules): New variable.
    (js-mode): Use cc-indent rules by default.
    * lisp/treesit.el (treesit-simple-indent-presets): Consider types as
    regexp now.  New matchers: n-p-gp, field-is, top-level, catch-all.
    New anchors: nth-sibling, grand-parent, and, or, not, list.
    first-sibling now returns the actual first sibling rather than the
    first named sibling.
---
 lisp/progmodes/js.el | 118 ++++++++++++++++++++++++++++++++++++++++++++++++-
 lisp/treesit.el      | 122 ++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 208 insertions(+), 32 deletions(-)

diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 7e1d7569ca..89bd04b231 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3442,6 +3442,122 @@ This function is intended for use in 
`after-change-functions'."
      ((node-is "/") parent 0)
      ((parent-is "jsx_self_closing_element") parent ,js-indent-level))))
 
+(defvar js--treesit-cc-indent-rules
+  (let ((function-re (rx (or "function_declaration"
+                             "method_definition"
+                             "function")))
+        (if-statement-like (rx (or "if" "try" "while" "do")
+                               "_statement"))
+        (else-clause-like (rx (or "else" "catch" "finally")
+                              "_clause"))
+        (switch-case-re (rx "switch_" (or "case" "default"))))
+    `((javascript
+       ;; Function declaration.
+       ;; "{"
+       ((match "statement_block" ,function-re) parent defun-open)
+       ((n-p-gp "}" "statement_block" ,function-re) grand-parent defun-close)
+
+       ((and (node-is ,function-re) (parent-is "program"))
+        parent topmost-intro)
+       ((parent-is ,function-re) parent topmost-intro-cont)
+       ((and (n-p-gp nil "statement_block" ,function-re)
+             (match nil nil nil 0 0))
+        parent-bol defun-block-intro)
+
+       ;; Class
+       ((node-is "class_declaration") parent topmost-intro)
+       ((parent-is "class_declaration") parent topmost-intro-cont)
+       ((match "{" "class_declaration") parent class-open)
+       ((match "}" "class_declaration") parent class-close)
+
+       ((node-is "class_heritage") parent inher-intro)
+       ((parent-is "class_heritage") parent inher-cont)
+
+       ;; Javascript doesn't have class access keywords
+       ;; (`member-init-intro', `member-init-cont') I think?
+
+       ((match "{" "class_declaration") parent class-open)
+       ((match "}" "class_body") parent class-close)
+
+       ((parent-is "class_body") parent inclass)
+       ((parent-is "member_definition") parent topmost-intro-cont)
+
+       ((match "statement_block" "member_definition") parent defun-open)
+       ((n-p-gp "}" "statement_block" "member_definition")
+        grand-parent defun-close)
+
+       ;; Javascript doesn't have class parameters
+       ;; (`template-args-cont').
+
+       ;; Conditional.
+       ((match "statement_block" ,if-statement-like)
+        parent substatement-open)
+       ((match "statement_block" ,else-clause-like)
+        grand-parent substatement-open)
+       ;; Javascript doesn't have `substatement-label'.
+       ((node-is ,else-clause-like) parent else-clause)
+       ((parent-is ,else-clause-like) grand-parent substatement)
+       ((match "while" "do_statement") parent do-while-closure)
+       ((field-is "consequence") parent substatement)
+       ((field-is "condition") parent statement-cont)
+
+       ;; Switch.
+       ((node-is ,switch-case-re) grand-parent case-label)
+       ((match "statement_block" ,switch-case-re) parent statement-case-open)
+       ((match nil ,switch-case-re "body") parent statement-case-intro)
+       ((parent-is ,switch-case-re) first-sibling statement-case-cont)
+       ((node-is "switch_body") parent substatement-open)
+       ((match "}" "switch_body") grand-parent substatement-close)
+
+       ;; Brace list.
+       ((node-is "object") parent-bol brace-list-open)
+       ((match "}" "object") parent brace-list-close)
+       ;; ((match nil "object" nil 0 0) parent brace-list-intro)
+       ((match nil "object" nil 0 0) parent ,js-indent-level)
+       ((match nil "object" nil 1) first-sibling brace-list-entry)
+
+       ;; Pair.
+       ((match nil "pair" "value") parent ,js-indent-level)
+
+       ;; Javascript doesn't have extern.
+
+       ;; Parenthesis.  These syntax symbols uses line-up functions,
+       ;; which don't work with tree-sitter, so we roll our own:
+       ;; `arglist-close', `arglist-intro', `arglist-cont',
+       ;; `arglist-cont-nonempty'.
+       ((parent-is "formal_parameters") first-sibling 1)
+       ((node-is "formal_parameters") parent statement-cont)
+
+       ;; Misc.
+       ((parent-is "function_declaration") parent func-decl-cont)
+       ((parent-is "string-fragment") grand-parent string)
+       ((parent-is "comment") grand-parent c)
+
+       ;; Fallback for top-level statements.
+       ((parent-is "program") parent 0)
+
+       ;; Fallback for blocks & statements.
+       ((parent-is "expression_statement") parent statement-cont)
+       ((match "}" "statement_block") parent-bol block-close)
+       ((match "statement_block" "statement_block") parent block-open)
+       ((match nil "statement_block" nil 0 0) parent-bol statement-block-intro)
+       ((parent-is "statement_block") prev-sibling statement)
+
+       ;; Template substitution.
+       ((match "}" "template_substitution") parent-bol block-close)
+       ((match nil "template_substitution" nil 0 0) parent-bol 
statement-block-intro)
+       ((parent-is "template_substitution") prev-sibling statement)
+
+       ;; JSX, copied from `js--treesit-indent-rules' (TODO).
+       ((parent-is "jsx_opening_element") parent ,js-indent-level)
+       ((node-is "jsx_closing_element") parent 0)
+       ((node-is "jsx_text") parent ,js-indent-level)
+       ((parent-is "jsx_element") parent ,js-indent-level)
+       ((node-is "/") parent 0)
+       ((parent-is "jsx_self_closing_element") parent ,js-indent-level)
+
+       (catch-all parent-bol statement-cont)))))
+
 (defvar js--treesit-keywords
   '("as" "async" "await" "break" "case" "catch" "class" "const" "continue"
     "debugger" "default" "delete" "do" "else" "export" "extends" "finally"
@@ -3762,7 +3878,7 @@ definition*\"."
    ((treesit-ready-p 'js-mode 'javascript)
     (treesit-parser-create 'javascript)
     ;; Indent.
-    (setq-local treesit-simple-indent-rules js--treesit-indent-rules)
+    (setq-local treesit-simple-indent-rules js--treesit-cc-indent-rules)
     ;; Navigation.
     (setq-local treesit-defun-type-regexp
                 (rx (or "class_declaration"
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 5c89a63bf6..8700cb88f2 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -640,28 +640,49 @@ See `treesit-simple-indent-presets'.")
                           node-index-min node-index-max)
                `(lambda (node parent bol &rest _)
                   (and (or (null ,node-type)
-                           (equal (treesit-node-type node)
-                                  ,node-type))
+                           (string-match-p
+                            ,node-type (or (treesit-node-type node) "")))
                        (or (null ,parent-type)
-                           (equal (treesit-node-type parent)
-                                  ,parent-type))
+                           (string-match-p
+                            ,parent-type (treesit-node-type parent)))
                        (or (null ,node-field)
-                           (equal (treesit-node-field-name node)
-                                  ,node-field))
+                           (string-match-p
+                            ,node-field
+                            (or (treesit-node-field-name node) "")))
                        (or (null ,node-index-min)
                            (>= (treesit-node-index node t)
                                ,node-index-min))
                        (or (null ,node-index-max)
                            (<= (treesit-node-index node t)
                                ,node-index-max))))))
+    (n-p-gp . (lambda (node-t parent-t grand-parent-t)
+                `(lambda (node parent bol &rest _)
+                   (and (or (null ,node-t)
+                            (string-match-p
+                             ,node-t (or (treesit-node-type node) "")))
+                        (or (null ,parent-t)
+                            (string-match-p
+                             ,parent-t (treesit-node-type parent)))
+                        (or (null ,grand-parent-t)
+                            (string-match-p
+                             ,grand-parent-t
+                             (treesit-node-type
+                              (treesit-node-parent parent))))))))
     (no-node . (lambda (node parent bol &rest _) (null node)))
     (parent-is . (lambda (type)
                    `(lambda (node parent bol &rest _)
-                      (equal ,type (treesit-node-type parent)))))
+                      (string-match-p
+                       ,type (treesit-node-type parent)))))
 
     (node-is . (lambda (type)
                  `(lambda (node parent bol &rest _)
-                    (equal ,type (treesit-node-type node)))))
+                    (string-match-p
+                     ,type (or (treesit-node-type node) "")))))
+    (field-is . (lambda (name)
+                  `(lambda (node parent bol &rest _)
+                     (string-match-p
+                      ,name (or (treesit-node-field-name node) "")))))
+    (catch-all . (lambda (&rest _) t))
 
     (query . (lambda (pattern)
                `(lambda (node parent bol &rest _)
@@ -673,10 +694,15 @@ See `treesit-simple-indent-presets'.")
                            finally return nil))))
     (first-sibling . (lambda (node parent bol &rest _)
                        (treesit-node-start
-                        (treesit-node-child parent 0 t))))
-
+                        (treesit-node-child parent 0))))
+    (nth-sibling . (lambda (n &optional named)
+                     `(lambda (node parent bol &rest _)
+                        (treesit-node-start
+                         (treesit-node-child parent ,n ,named)))))
     (parent . (lambda (node parent bol &rest _)
                 (treesit-node-start parent)))
+    (grand-parent . (lambda (node parent bol &rest _)
+                      (treesit-node-start (treesit-node-parent parent))))
     (parent-bol . (lambda (node parent bol &rest _)
                     (save-excursion
                       (goto-char (treesit-node-start parent))
@@ -690,7 +716,28 @@ See `treesit-simple-indent-presets'.")
                    (save-excursion
                      (goto-char bol)
                      (forward-line -1)
-                     (skip-chars-forward " \t")))))
+                     (skip-chars-forward " \t"))))
+    (and . (lambda (&rest fns)
+             `(lambda (node parent bol &rest _)
+                (cl-reduce (lambda (a b) (and a b))
+                           (mapcar (lambda (fn)
+                                     (funcall fn node parent bol))
+                                   ',fns)))))
+    (or . (lambda (&rest fns)
+            `(lambda (node parent bol &rest _)
+               (cl-reduce (lambda (a b) (or a b))
+                          (mapcar (lambda (fn)
+                                    (funcall fn node parent bol))
+                                  ',fns)))))
+    (not . (lambda (fn)
+             `(lambda (node parent bol &rest _)
+                (debug)
+                (not (funcall ,fn node parent bol)))))
+    (list . (lambda (&rest fns)
+              `(lambda (node parent bol &rest _)
+                 (mapcar (lambda (fn)
+                           (funcall fn node parent bol))
+                         ',fns)))))
   "A list of presets.
 These presets that can be used as MATHER and ANCHOR in
 `treesit-simple-indent-rules'.
@@ -753,25 +800,31 @@ prev-line
 
     The first non-whitespace charater on the previous line.")
 
-(defun treesit--simple-apply (fn args)
-  "Apply ARGS to FN.
+(defun treesit--simple-indent-eval (exp)
+  "Evaluate EXP.
 
-If FN is a key in `treesit-simple-indent-presets', use the
-corresponding value as the function."
+If EXPis an application and the function is a key in
+`treesit-simple-indent-presets', use the corresponding value as
+the function."
   ;; We don't want to match uncompiled lambdas, so make sure this cons
   ;; is not a function.  We could move the condition functionp
   ;; forward, but better be explicit.
-  (cond ((and (consp fn) (not (functionp fn)))
-         (apply (treesit--simple-apply (car fn) (cdr fn))
-                ;; We don't evaluate ARGS with `simple-apply', i.e.,
-                ;; no composing, better keep it simple.
-                args))
-        ((and (symbolp fn)
-              (alist-get fn treesit-simple-indent-presets))
-         (apply (alist-get fn treesit-simple-indent-presets)
-                args))
-        ((functionp fn) (apply fn args))
-        (t (error "Couldn't find the function corresponding to %s" fn))))
+  (cond ((and (consp exp) (not (functionp exp)))
+         (apply (treesit--simple-indent-eval (car exp))
+                (mapcar #'treesit--simple-indent-eval
+                        (cdr exp))))
+        ;; Presets override functions, so this condition comes before
+        ;; `functionp'.
+        ((alist-get exp treesit-simple-indent-presets)
+         (alist-get exp treesit-simple-indent-presets))
+        ((functionp exp) exp)
+        ((symbolp exp)
+         (if (null exp)
+             exp
+           ;; Matchers only return lambdas, anchors only return
+           ;; integer, so we should never see a variable.
+           (error "Couldn't find the preset corresponding to %s" exp)))
+        (t exp)))
 
 ;; This variable might seem unnecessary: why split
 ;; `treesit-indent' and `treesit-simple-indent' into two
@@ -846,6 +899,8 @@ of the current line.")
                 (indent-line-to col))
             (indent-line-to col)))))))
 
+(declare-function c-calc-offset "cc-engine")
+
 (defun treesit-simple-indent (node parent bol)
   "Calculate indentation according to `treesit-simple-indent-rules'.
 
@@ -866,14 +921,19 @@ OFFSET."
                for pred = (nth 0 rule)
                for anchor = (nth 1 rule)
                for offset = (nth 2 rule)
-               if (treesit--simple-apply
-                   pred (list node parent bol))
+               if (treesit--simple-indent-eval
+                   (list pred node parent bol))
                do (when treesit--indent-verbose
                     (message "Matched rule: %S" rule))
                and
-               return (cons (treesit--simple-apply
-                             anchor (list node parent bol))
-                            offset)))))
+               return
+               (let ((anchor-pos
+                      (treesit--simple-indent-eval
+                       (list anchor node parent bol))))
+                 (cons anchor-pos
+                       (if (integerp offset)
+                           offset
+                         (c-calc-offset (list offset anchor-pos)))))))))
 
 (defun treesit-check-indent (mode)
   "Check current buffer's indentation against a major mode MODE.