diff options
Diffstat (limited to 'lisp/treesit.el')
| -rw-r--r-- | lisp/treesit.el | 246 |
1 files changed, 173 insertions, 73 deletions
diff --git a/lisp/treesit.el b/lisp/treesit.el index 203a724fe7a..f8c87c35aac 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2,6 +2,10 @@ ;; Copyright (C) 2021-2022 Free Software Foundation, Inc. +;; Maintainer: 付禹安 (Yuan Fu) <casouri@gmail.com> +;; Keywords: treesit, tree-sitter, languages +;; Package: emacs + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -230,19 +234,27 @@ is nil, try to guess the language at BEG using `treesit-language-at'." (or parser-or-lang (treesit-language-at beg)))))) (treesit-node-descendant-for-range root beg (or end beg) named))) -(defun treesit-node-top-level (node &optional type) +(defun treesit-node-top-level (node &optional pred include-node) "Return the top-level equivalent of NODE. + Specifically, return the highest parent of NODE that has the same type as it. If no such parent exists, return nil. -If TYPE is non-nil, match each parent's type with TYPE as a -regexp, rather than using NODE's type." - (let ((type (or type (treesit-node-type node))) +If PRED is non-nil, match each parent's type with PRED as a +regexp, rather than using NODE's type. PRED can also be a +function that takes the node as an argument, and return +non-nil/nil for match/no match. + +If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." + (let ((pred (or pred (treesit-node-type node))) (result nil)) - (cl-loop for cursor = (treesit-node-parent node) + (cl-loop for cursor = (if include-node node + (treesit-node-parent node)) then (treesit-node-parent cursor) while cursor - if (string-match-p type (treesit-node-type cursor)) + if (if (stringp pred) + (string-match-p pred (treesit-node-type cursor)) + (funcall pred cursor)) do (setq result cursor)) result)) @@ -286,11 +298,16 @@ properties." (treesit-node-start node) (treesit-node-end node)))))) -(defun treesit-parent-until (node pred) +(defun treesit-parent-until (node pred &optional include-node) "Return the closest parent of NODE that satisfies PRED. + Return nil if none was found. PRED should be a function that -takes one argument, the parent node." - (let ((node (treesit-node-parent node))) +takes one argument, the parent node, and return non-nil/nil for +match/no match. + +If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." + (let ((node (if include-node node + (treesit-node-parent node)))) (while (and node (not (funcall pred node))) (setq node (treesit-node-parent node))) node)) @@ -305,8 +322,6 @@ takes one argument, the parent node." node (treesit-node-parent node))) last)) -(defalias 'treesit-traverse-parent #'treesit-parent-until) - (defun treesit-node-children (node &optional named) "Return a list of NODE's children. If NAMED is non-nil, collect named child only." @@ -1644,7 +1659,7 @@ For example, \"(function|class)_definition\". Sometimes not all nodes matched by the regexp are valid defuns. In that case, set this variable to a cons cell of the -form (REGEXP . FILTER), where FILTER is a function that takes a +form (REGEXP . PRED), where PRED is a function that takes a node (the matched node) and returns t if node is valid, or nil for invalid node. @@ -1793,78 +1808,67 @@ sound things exists. REGEXP and PRED are the same as in `treesit-thing-at-point'." (let* ((node (treesit-node-at pos)) - ;; NODE-BEFORE/AFTER = NODE when POS is completely in NODE, - ;; but if not, that means point could be in between two - ;; defun, in that case we want to use a node that's actually - ;; before/after point. - (node-before (if (>= (treesit-node-start node) pos) - (save-excursion - (treesit-search-forward-goto node "" t t t)) - node)) - (node-after (if (<= (treesit-node-end node) pos) - (save-excursion - (treesit-search-forward-goto - node "" nil nil t)) - node)) - (result (list nil nil nil)) - (pred (or pred (lambda (_) t)))) + (result (list nil nil nil))) ;; 1. Find previous and next sibling defuns. (cl-loop for idx from 0 to 1 - for node in (list node-before node-after) for backward in '(t nil) + ;; Make sure we go in the right direction, and the defun we find + ;; doesn't cover POS. for pos-pred in (list (lambda (n) (<= (treesit-node-end n) pos)) (lambda (n) (>= (treesit-node-start n) pos))) - ;; If point is inside a defun, our process below will never - ;; return a next/prev sibling outside of that defun, effectively - ;; any prev/next sibling is locked inside the smallest defun - ;; covering point, which is the correct behavior. That's because - ;; when there exists a defun that covers point, - ;; `treesit-search-forward' will first reach that defun, after - ;; that we only go upwards in the tree, so other defuns outside - ;; of the covering defun is never reached. (Don't use - ;; `treesit-search-forward-goto' as it breaks when NODE-AFTER is - ;; the last token of a parent defun: it will skip the parent - ;; defun because it wants to ensure progress.) - do (cl-loop for cursor = (when node - (save-excursion - (treesit-search-forward - node regexp backward backward))) - then (treesit-node-parent cursor) - while cursor - if (and (string-match-p - regexp (treesit-node-type cursor)) - (funcall pred cursor) - (funcall pos-pred cursor)) - do (setf (nth idx result) cursor))) + ;; We repeatedly find next defun candidate with + ;; `treesit-search-forward', and check if it is a valid defun, + ;; until the node we find covers POS, meaning we've gone through + ;; every possible sibling defuns. But there is a catch: + ;; `treesit-search-forward' searches bottom-up, so for each + ;; candidate we need to go up the tree and find the top-most + ;; valid sibling, this defun will be at the same level as POS. + ;; Don't use `treesit-search-forward-goto', it skips nodes in + ;; order to enforce progress. + when node + do (let ((cursor node) + (iter-pred (lambda (node) + (and (string-match-p + regexp (treesit-node-type node)) + (or (null pred) (funcall pred node)) + (funcall pos-pred node))))) + ;; Find the node just before/after POS to start searching. + (save-excursion + (while (and cursor (not (funcall pos-pred cursor))) + (setq cursor (treesit-search-forward-goto + cursor "" backward backward t)))) + ;; Keep searching until we run out of candidates. + (while (and cursor + (funcall pos-pred cursor) + (null (nth idx result))) + (setf (nth idx result) + (treesit-node-top-level cursor iter-pred t)) + (setq cursor (treesit-search-forward + cursor regexp backward backward))))) ;; 2. Find the parent defun. - (setf (nth 2 result) - (cl-loop for cursor = (or (nth 0 result) - (nth 1 result) - node) - then (treesit-node-parent cursor) - while cursor - if (and (string-match-p - regexp (treesit-node-type cursor)) - (funcall pred cursor) - (not (member cursor result))) - return cursor)) + (let ((cursor (or (nth 0 result) (nth 1 result) node)) + (iter-pred (lambda (node) + (and (string-match-p + regexp (treesit-node-type node)) + (or (null pred) (funcall pred node)) + (not (treesit-node-eq node (nth 0 result))) + (not (treesit-node-eq node (nth 1 result))) + (< (treesit-node-start node) + pos + (treesit-node-end node)))))) + (setf (nth 2 result) + (treesit-parent-until cursor iter-pred))) result)) (defun treesit--top-level-thing (node regexp &optional pred) "Return the top-level parent thing of NODE. REGEXP and PRED are the same as in `treesit-thing-at-point'." - (let* ((pred (or pred (lambda (_) t)))) - ;; `treesit-search-forward-goto' will make sure the matched node - ;; is before POS. - (cl-loop for cursor = node - then (treesit-node-parent cursor) - while cursor - if (and (string-match-p - regexp (treesit-node-type cursor)) - (funcall pred cursor)) - do (setq node cursor)) - node)) + (treesit-node-top-level + node (lambda (node) + (and (string-match-p regexp (treesit-node-type node)) + (or (null pred) (funcall pred node)))) + t)) ;; The basic idea for nested defun navigation is that we first try to ;; move across sibling defuns in the same level, if no more siblings @@ -2040,6 +2044,91 @@ The delimiter between nested defun names is controlled by (setq node (treesit-node-parent node))) name)) +;;; Imenu + +(defvar treesit-simple-imenu-settings nil + "Settings that configure `treesit-simple-imenu'. + +It should be a list of (CATEGORY REGEXP PRED NAME-FN). + +CATEGORY is the name of a category, like \"Function\", \"Class\", +etc. REGEXP should be a regexp matching the type of nodes that +belong to CATEGORY. PRED should be either nil or a function +that takes a node an the argument. It should return non-nil if +the node is a valid node for CATEGORY, or nil if not. + +CATEGORY could also be nil. In that case the entries matched by +REGEXP and PRED are not grouped under CATEGORY. + +NAME-FN should be either nil or a function that takes a defun +node and returns the name of that defun node. If NAME-FN is nil, +`treesit-defun-name' is used. + +`treesit-major-mode-setup' automatically sets up Imenu if this +variable is non-nil.") + +(defun treesit--simple-imenu-1 (node pred name-fn) + "Given a sparse tree, create an Imenu index. + +NODE is a node in the tree returned by +`treesit-induce-sparse-tree' (not a tree-sitter node, its car is +a tree-sitter node). Walk that tree and return an Imenu index. + +Return a list of entries where each ENTRY has the form: + +ENTRY := (NAME . MARKER) + | (NAME . ((\" \" . MARKER) + ENTRY + ...) + +PRED and NAME-FN are the same as described in +`treesit-simple-imenu-settings'. NAME-FN computes NAME in an +ENTRY. MARKER marks the start of each tree-sitter node." + (let* ((ts-node (car node)) + (children (cdr node)) + (subtrees (mapcan (lambda (node) + (treesit--simple-imenu-1 node pred name-fn)) + children)) + ;; The root of the tree could have a nil ts-node. + (name (when ts-node + (or (if name-fn + (funcall name-fn ts-node) + (treesit-defun-name ts-node)) + "Anonymous"))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ;; The tree-sitter node in the root node of the tree returned by + ;; `treesit-induce-sparse-tree' is often nil. + ((null ts-node) + subtrees) + ;; This tree-sitter node is not a valid entry, skip it. + ((and pred (not (funcall pred ts-node))) + subtrees) + ;; Non-leaf node, return a (list of) subgroup. + (subtrees + `((,name + ,(cons " " marker) + ,@subtrees))) + ;; Leaf node, return a (list of) plain index entry. + (t (list (cons name marker)))))) + +(defun treesit-simple-imenu () + "Return an Imenu index for the current buffer." + (let ((root (treesit-buffer-root-node))) + (mapcan (lambda (setting) + (pcase-let ((`(,category ,regexp ,pred ,name-fn) + setting)) + (when-let* ((tree (treesit-induce-sparse-tree + root regexp)) + (index (treesit--simple-imenu-1 + tree pred name-fn))) + (if category + (list (cons category index)) + index)))) + treesit-simple-imenu-settings))) + ;;; Activating tree-sitter (defun treesit-ready-p (language &optional quiet) @@ -2097,6 +2186,11 @@ If `treesit-simple-indent-rules' is non-nil, setup indentation. If `treesit-defun-type-regexp' is non-nil, setup `beginning/end-of-defun' functions. +If `treesit-defun-name-function' is non-nil, setup +`add-log-current-defun'. + +If `treesit-simple-imenu-settings' is non-nil, setup Imenu. + Make sure necessary parsers are created for the current buffer before calling this function." ;; Font-lock. @@ -2138,7 +2232,13 @@ before calling this function." (when treesit-defun-name-function (setq-local add-log-current-defun-function #'treesit-add-log-current-defun)) - (setq-local transpose-sexps-function #'treesit-transpose-sexps)) + + (setq-local transpose-sexps-function #'treesit-transpose-sexps) + + ;; Imenu. + (when treesit-simple-imenu-settings + (setq-local imenu-create-index-function + #'treesit-simple-imenu))) ;;; Debugging |