Merge from origin/emacs-29

db96b1282f * lisp/help.el: Use 'C-h C-q' to toggle 'help-quick' wind...
489865c21e ; Improve markup of long key sequences
d42c2668cf ; * etc/NEWS: Fix wording of a recently edited entry.
7a0eaee198 * lisp/isearch.el: Small fixes.
b69bffeec0 * lisp/vc/diff-mode.el (diff-minor-mode-prefix): Replace ...
9263847ab7 ; * etc/NEWS: Move the paragraph with 'C-u RET' closer to...
62fb2dc37d * doc/emacs/display.texi (Text Scale): Improve section ab...
70480d3b6b * lisp/repeat.el (repeat-echo-function): Suggest 'add-fun...
fd48201ffe * lisp/tab-line.el (tab-line-cache-key-default): More cac...
b164660260 * etc/package-keyring.gpg: Update with new key
c0be51389e ; Yet another declare-function to avoid treesit-related w...
8676bec51d ; * lisp/treesit.el (treesit--simple-imenu-1): Doc fix; w...
2ddc480f44 Warn of absent networks module in ERC
19d00fab9a Avoid "already compiled" warning in erc-compat
2d8f7b66bc ; Fix one more treesit byte-compilation warning.
2d0a921486 ; Avoid treesit-related byte-compiler warnings
8503b370be (python--treesit-settings): Remove duplicate matcher
b464e6c490 Make last change of w32 GUI dialogs conditional and rever...
eedc9d79ae Fix tree-sitter typos
248c13dcfe Update tree-sitter major modes to use the new Imenu facility
b39dc7ab27 Add tree-sitter helper functions for Imenu
ba1ddea9da Fix treesit--things-around (bug#60355)
7512b9025a ; * lisp/treesit.el (treesit-traverse-parent): Remove alias.
5326b04198 Improve treesit-node-top-level and treesit-parent-until
637f5b164f ; Add "src" to the heuristic sub-directory heuristic
8ab6df0c9f ; * lisp/epa-ks.el (epa-ks-do-key-to-fetch): Fix 'when' u...
2b55a48d3e * src/w32menu.c (simple_dialog_show): Use MB_YESNOCANCEL ...
8b8b791567 ; Improve documentation of TAB/SPC indentation
624e382211 ; Improve doc strings of some new faces
41f12e1019 ; * lisp/elide-head.el (elide-head): Doc fix to silence c...
e3b4cd0ac1 ; * lisp/htmlfontify.el (hfy-text-p): Fix whitespace.
1b4dc4691c Fix htmlfontify.el command injection vulnerability.
1fe4b98b4d Improve support for Scheme R6RS and R7RS libraries (bug#5...
2347f37f67 ; * test/src/treesit-tests.el: remove dead store (bytecom...
a6d961ae2f Add a new tree-sitter query predicate 'pred'
835a80dcc4 ; Fix tree-sitter defun tests
a14821d615 Improve gnutls-min-prime-bits docstring
b14bbd108e Improve handling of tab-bar height.
669160d47b ; * nt/INSTALL.W64: More fixes and updates.
26b2ec7cb8 Simplify last change (bug#60311)
082fc6e308 Fix 'json-available-p' on MS-Windows
6c86faec29 loaddefs-gen: Group results by absolute file name
d90d7d15f2 ; Fix vindexes in parsing.texi
eb26872837 Fix imenu for c-ts-mode (bug#60296)
8f68b6497e Clean up python-ts-mode font-lock features
28f26b11a1 Add comment indent and filling to other tree-sitter major...
c6b0282645 ; Remove unused function in c-ts-mode
6e52a9fcad ; * doc/lispref/modes.texi (Parser-based Font Lock): Mino...
2bcd1e9a99 ; * doc/lispref/parsing.texi (Retrieving Nodes): Add notice.
7c7950fe00 Add maintainer stub for tree-sitter files
cf32776622 ; * doc/lispref/parsing.texi (Using Parser): Remove delet...

# Conflicts:
#	etc/NEWS
#	lisp/progmodes/c-ts-mode.el
#	lisp/progmodes/typescript-ts-mode.el
#	lisp/treesit.el

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