New variable 'treesit-aggregated-outline-predicate' (bug#76398)

* doc/lispref/modes.texi (Outline Minor Mode):
Add 'treesit-aggregated-outline-predicate'.

* lisp/treesit.el (treesit-aggregated-outline-predicate):
New buffer-local variable.
(treesit-outline--at-point):
Use 'treesit-aggregated-outline-predicate'.
(treesit-closest-parser-boundary): New function.
(treesit-outline-search): Use 'treesit-aggregated-outline-predicate'
and 'treesit-closest-parser-boundary'.
(treesit-outline-level): Use 'treesit-aggregated-outline-predicate'.
(treesit-major-mode-setup): Add 'treesit-aggregated-outline-predicate'.

* lisp/textmodes/html-ts-mode.el (html-ts-mode--outline-predicate):
Improve.

* lisp/textmodes/mhtml-ts-mode.el (mhtml-ts-mode):
Set 'treesit-aggregated-outline-predicate'.

(cherry picked from commit 840be8a7d8e7db8ad7f186678226ac51712724ab)

diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index e9833c301af73c75b922d515325d91a30905e3e7..8c902d6a935e2d1b34b9731c91d869ab80eba2a7 100644 (file)
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -3139,6 +3139,16 @@ This variable instructs Emacs how to find lines with outline headings.
 It should be a predicate that matches the node on the heading line.
 @end defvar
 
+@defvar treesit-aggregated-outline-predicate
+This variable allows major modes to configure outlines for multiple
+languages.  Its value is an alist mapping language symbols to outline
+headings of the form described above for the value of
+@code{treesit-outline-predicate}.
+
+If this variable is non-@code{nil}, it overrides
+@code{treesit-outline-predicate} for setting up outline headings.
+@end defvar
+
 @node Font Lock Mode
 @section Font Lock Mode
 @cindex Font Lock mode

diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el
index 26efe1be7262808f6ad5362609288d5ee4b7090c..f6d20685ea3718f882efaa5128e1855989b7a3be 100644 (file)
--- a/lisp/textmodes/html-ts-mode.el
+++ b/lisp/textmodes/html-ts-mode.el
@@ -126,14 +126,15 @@ Return nil if there is no name or if NODE is not a defun node."
      t)))
 
 (defun html-ts-mode--outline-predicate (node)
-  "Limit outlines to a few most meaningful elements."
-  (let ((name (html-ts-mode--defun-name node)))
-    (and name (string-match-p
-               (rx bos (or "html" "head" "script" "style"
-                           "body" (and "h" (any "1-6"))
-                           "ol" "ul" "table")
-                   eos)
-               name))))
+  "Limit outlines to multi-line elements."
+  (when (string-match-p "element" (treesit-node-type node))
+    (< (save-excursion
+         (goto-char (treesit-node-start node))
+         (pos-bol))
+       (save-excursion
+         (goto-char (treesit-node-end node))
+         (skip-chars-backward " \t\n")
+         (pos-bol)))))
 
 ;;;###autoload
 (define-derived-mode html-ts-mode html-mode "HTML"

diff --git a/lisp/textmodes/mhtml-ts-mode.el b/lisp/textmodes/mhtml-ts-mode.el
index 83f8879f4279dc1294ca9505b3415e2ff9615f1e..190967fcab723dbe445f9b5739644edf643d0af9 100644 (file)
--- a/lisp/textmodes/mhtml-ts-mode.el
+++ b/lisp/textmodes/mhtml-ts-mode.el
@@ -580,7 +580,11 @@ Powered by tree-sitter."
     (setq-local treesit-aggregated-simple-imenu-settings
                 mhtml-ts-mode--treesit-aggregated-simple-imenu-settings)
 
-    ;; (setq-local treesit-outline-predicate nil)
+    (setq-local treesit-aggregated-outline-predicate
+                `((html . ,#'html-ts-mode--outline-predicate)
+                  ;; TODO: add a predicate like for html above
+                  (javascript . "\\`function_declaration\\'")
+                  (css . "\\`rule_set\\'")))
 
     (treesit-major-mode-setup)
 

diff --git a/lisp/treesit.el b/lisp/treesit.el
index 02170d34f29de95fb1b68628402fc1b69ad15cfc..9ef8a1a609ba6c70eb420df8fe8ccd834a846013 100644 (file)
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -3594,6 +3594,16 @@ 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-aggregated-outline-predicate nil
+  "Settings that configure `treesit-outline-search' for multi-language modes.
+
+The value should be an alist of (LANG . SETTINGS), where LANG is a
+language symbol, and SETTINGS has the same form as
+`treesit-outline-predicate'.
+
+When both this variable and `treesit-outline-predicate' are non-nil,
+this variable takes priority.")
+
 (defun treesit-outline-predicate--from-imenu (node)
   ;; Return an outline searching predicate created from Imenu.
   ;; Return the value suitable to set `treesit-outline-predicate'.
@@ -3611,7 +3621,10 @@ when a major mode sets it.")
 
 (defun treesit-outline--at-point ()
   "Return the outline heading node at the current line."
-  (let* ((pred treesit-outline-predicate)
+  (let* ((pred (if treesit-aggregated-outline-predicate
+                   (alist-get (treesit-language-at (point))
+                              treesit-aggregated-outline-predicate)
+                 treesit-outline-predicate))
          (bol (pos-bol))
          (eol (pos-eol))
          (current (treesit-thing-at (point) pred))
@@ -3623,6 +3636,18 @@ when a major mode sets it.")
     (or (and current-valid current)
         (and next-valid (treesit-thing-at next pred)))))
 
+(defun treesit-closest-parser-boundary (pos backward)
+  "Get the closest boundary of a local parser."
+  (when-let* ((ranges (mapcar #'treesit-parser-included-ranges
+                              (treesit-parser-list)))
+              (ranges (delq nil (delete '((1 . 1)) ranges)))
+              (bounds (seq-filter
+                       (lambda (p) (if backward (< p pos) (> p pos)))
+                       (flatten-list ranges)))
+              (closest (when bounds
+                         (if backward (seq-max bounds) (seq-min bounds)))))
+    closest))
+
 (defun treesit-outline-search (&optional bound move backward looking-at)
   "Search for the next outline heading in the syntax tree.
 For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in
@@ -3642,28 +3667,66 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in
               (if (eq (point) (pos-bol))
                   (if (bobp) (point) (1- (point)))
                 (pos-eol))))
+           (pred (if treesit-aggregated-outline-predicate
+                     (alist-get (treesit-language-at pos)
+                                treesit-aggregated-outline-predicate)
+                   treesit-outline-predicate))
            (found (or bob-pos
-                      (treesit-navigate-thing pos (if backward -1 1) 'beg
-                                              treesit-outline-predicate))))
-      (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))))
+                      (treesit-navigate-thing pos (if backward -1 1) 'beg pred)))
+           (closest (treesit-closest-parser-boundary pos backward)))
+
+      ;; Handle multi-language modes
+      (if (and closest
+               (or
+                ;; Possibly was inside the local parser, and when can't find
+                ;; more matches inside it then need to go over the closest
+                ;; parser boundary to the primary parser.
+                (not found)
+                ;; Possibly skipped the local parser, either while navigating
+                ;; inside the primary parser, or inside a local parser
+                ;; interspersed by ranges of other local parsers, e.g.
+                ;; <html><script>|</script><style/><script/></html>
+                (if backward (> closest found) (< closest found))))
+          (progn
+            (goto-char (if backward
+                           (max (point-min) (1- closest))
+                         (min (point-max) (1+ closest))))
+            (treesit-outline-search bound move backward))
+
+        (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."
   (let* ((node (treesit-outline--at-point))
-         (level 1))
-    (while (setq node (treesit-parent-until node treesit-outline-predicate))
+         (level 1)
+         (parser (when treesit-aggregated-outline-predicate
+                   (treesit-node-parser node)))
+         (pred (if treesit-aggregated-outline-predicate
+                   (alist-get (treesit-language-at (point))
+                              treesit-aggregated-outline-predicate)
+                 treesit-outline-predicate)))
+    (while (setq node (treesit-parent-until node pred))
       (setq level (1+ level)))
-    (if (zerop level) 1 level)))
+    (when-let* ((_ parser)
+                (host-lang (treesit-parser-language treesit-primary-parser))
+                (_ (not (eq (treesit-language-at (point)) host-lang)))
+                (host-pred (alist-get host-lang treesit-aggregated-outline-predicate)))
+      ;; Now need to break out of embedded confinement
+      ;; and get the host node that contains the guest ranges
+      (setq node (treesit-parser-root-node parser))
+      (while (setq node (treesit-parent-until node host-pred))
+        (setq level (1+ level))))
+    level))
 
 ;;; Hideshow mode
 
@@ -3948,11 +4011,14 @@ before calling this function."
                 #'treesit-simple-imenu))
 
   ;; Outline minor mode.
-  (when (and (or treesit-outline-predicate treesit-simple-imenu-settings)
+  (when (and (or treesit-outline-predicate
+                 treesit-aggregated-outline-predicate
+                 treesit-simple-imenu-settings)
              (not (seq-some #'local-variable-p
                             '(outline-search-function
                               outline-regexp outline-level))))
-    (unless treesit-outline-predicate
+    (unless (or treesit-outline-predicate
+                treesit-aggregated-outline-predicate)
       (setq treesit-outline-predicate
             #'treesit-outline-predicate--from-imenu))
     (setq-local outline-search-function #'treesit-outline-search