bug#68824: treesitter support for outline-minor-mode

[Juri Linkov]

Tags: patch

As discussed on 
https://lists.gnu.org/archive/html/emacs-devel/2024-01/msg00916.html
here is the patch that adds the support for outline-minor-mode to treesit.el.
It has been tested on c-ts-mode, dockerfile-ts-mode, elixir-ts-mode, 
heex-ts-mode,
java-ts-mode, js-ts-mode, typescript-ts-mode, css-ts-mode, html-ts-mode, 
toml-ts-mode.

diff --git a/etc/NEWS b/etc/NEWS
index a9d6eb6789d..6ceaa6b7b6c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -130,6 +130,12 @@ the signature) the automatically inferred function type as 
well.
 This user option controls outline visibility in the output buffer of
 'describe-bindings' when 'describe-bindings-outline' is non-nil.
 
+** Outline Mode
+
+*** 'outline-minor-mode' is supported in tree-sitter major modes.
+It can be used in all tree-sitter major modes that set either the
+variable 'treesit-simple-imenu-settings' or 'treesit-outline-predicate'.
+
 ** X selection requests are now handled much faster and asynchronously.
 This means it should be less necessary to disable the likes of
 'select-active-regions' when Emacs is running over a slow network
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 96222ed81cb..13319bb0483 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -2836,6 +2836,99 @@ treesit-simple-imenu
                     index))))
             treesit-simple-imenu-settings)))
 
+;;; Outline minor mode
+
+(defvar-local treesit-outline-predicate nil
+  "Predicate used to find outline headings in a sparse tree.
+Intended to be set by a major mode.  When nil, the predicate
+is constructed from the value of `treesit-simple-imenu-settings'
+when a major mode sets it.")
+
+(defvar-local treesit-outline-levels nil
+  "Holds a cached structure that corresponds to the outline tree.
+It's a list of (MARKER . LEVEL) where MARKER is a position of the
+beginning of the outline heading, and LEVEL is its depth in the
+outline tree.")
+
+(defun treesit-outline-levels (node level)
+  "Given a sparse tree, return a list for `treesit-outline-levels'."
+  (let* ((ts-node (car node))
+         (children (cdr node))
+         (subtrees (mapcan (lambda (node)
+                             (treesit-outline-levels node (1+ level)))
+                           children))
+         (marker (when ts-node
+                   (set-marker (make-marker)
+                               (save-excursion
+                                 (goto-char (treesit-node-start ts-node))
+                                 (search-forward (or (treesit-defun-name 
ts-node) ""))
+                                 (pos-bol))))))
+    (cond
+     ((null ts-node)
+      subtrees)
+     (subtrees
+      (cons (cons marker level) subtrees))
+     (t
+      (list (cons marker level))))))
+
+(defun treesit-outline-prepare ()
+  "Prepare `treesit-outline-levels' to be used by `treesit-outline-search'.
+Build the internal structure based either on the value
+`treesit-outline-predicate' that should be a predicate for
+`treesit-induce-sparse-tree', or use the existing value of
+`treesit-simple-imenu-settings' where outline headings are
+on the same lines as the imenu items."
+  (unless treesit-outline-predicate
+    (setq treesit-outline-predicate
+          (lambda (node)
+            (seq-some
+             (lambda (setting)
+               (and (string-match-p (nth 1 setting) (treesit-node-type node))
+                    (or (null (nth 2 setting))
+                        (funcall (nth 2 setting) node))))
+             treesit-simple-imenu-settings))))
+  (setq treesit-outline-levels
+        (treesit-outline-levels
+         (treesit-induce-sparse-tree
+          (treesit-buffer-root-node)
+          treesit-outline-predicate)
+         0)))
+
+(defun treesit-outline-search (&optional bound move backward looking-at)
+  "Search for the next outline heading.
+See the descriptions of arguments in `outline-search-function'.
+Uses the value of `treesit-outline-levels' prepared by
+`treesit-outline-prepare'."
+  (unless treesit-outline-levels
+    (treesit-outline-prepare))
+
+  (let ((positions (mapcar #'car treesit-outline-levels)))
+    (if looking-at
+        (when (member (point-marker) positions)
+          (set-match-data (list (pos-bol) (pos-eol)))
+          t)
+
+      (let ((found (seq-find (lambda (p) (>= p (point)))
+                             (if backward (nreverse positions) positions))))
+        (if found
+            (if (or (not bound) (if backward (>= found bound) (<= found 
bound)))
+                (progn
+                  (goto-char found)
+                  (goto-char (pos-bol))
+                  (set-match-data (list (point) (pos-eol)))
+                  t)
+              (when move (goto-char bound))
+              nil)
+          (when move (goto-char (or bound (if backward (point-min) 
(point-max)))))
+          nil)))))
+
+(defun treesit-outline-level ()
+  "Return the depth of the current outline heading.
+Uses the value of `treesit-outline-levels'."
+  (or (alist-get (point) treesit-outline-levels nil nil
+                 (lambda (m k) (eq (marker-position m) k)))
+      1))
+
 ;;; Activating tree-sitter
 
 (defun treesit-ready-p (language &optional quiet)
@@ -2966,6 +3059,14 @@ treesit-major-mode-setup
     (setq-local imenu-create-index-function
                 #'treesit-simple-imenu))
 
+  ;; Outline minor mode.
+  (when (and (or treesit-outline-predicate treesit-simple-imenu-settings)
+             (not (seq-some #'local-variable-p
+                            '(outline-search-function
+                              outline-regexp outline-level))))
+    (setq-local outline-search-function #'treesit-outline-search
+                outline-level #'treesit-outline-level))
+
   ;; Remove existing local parsers.
   (dolist (ov (overlays-in (point-min) (point-max)))
     (when-let ((parser (overlay-get ov 'treesit-parser)))
diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el
index 7b53a44deb2..23e2afbaaca 100644
--- a/lisp/progmodes/heex-ts-mode.el
+++ b/lisp/progmodes/heex-ts-mode.el
@@ -166,6 +166,12 @@ heex-ts-mode
                   ("Slot" "\\`slot\\'" nil nil)
                   ("Tag" "\\`tag\\'" nil nil)))
 
+    ;; Outline minor mode
+    ;; Restore default value for `treesit-outline-search'.
+    (kill-local-variable 'outline-regexp)
+    (kill-local-variable 'outline-heading-end-regexp)
+    (kill-local-variable 'outline-level)
+
     (setq-local treesit-font-lock-settings heex-ts--font-lock-settings)
 
     (setq-local treesit-simple-indent-rules heex-ts--indent-rules)
diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el
index 301f3e8791c..f157d2d6949 100644
--- a/lisp/textmodes/html-ts-mode.el
+++ b/lisp/textmodes/html-ts-mode.el
@@ -121,6 +121,16 @@ html-ts-mode
   ;; Imenu.
   (setq-local treesit-simple-imenu-settings
               '(("Element" "\\`tag_name\\'" nil nil)))
+
+  ;; Outline minor mode.
+  ;; Override default predicate to use "element" for outline headings
+  ;; instead of "tag_name" from `treesit-simple-imenu-settings'.
+  (setq-local treesit-outline-predicate "\\`element\\'")
+  ;; Restore default value for `treesit-outline-search'.
+  (kill-local-variable 'outline-regexp)
+  (kill-local-variable 'outline-heading-end-regexp)
+  (kill-local-variable 'outline-level)
+
   (treesit-major-mode-setup))
 
 (if (treesit-ready-p 'html)