Hideshow support for tree-sitter in hs-minor-mode (bug#75609)

* lisp/progmodes/hideshow.el (hs-inside-comment-p-func):
New buffer-local variable.
(hs-hide-block-at-point): Check if 'hs-block-end-regexp' is
a string or a function.
(hs-inside-comment-p): Move body to 'hs-inside-comment-p--default'.
Call 'hs-inside-comment-p-func' if it's a function.
(hs-inside-comment-p--default): New function with body from
'hs-inside-comment-p'.
(hs-hide-all): Don't use 'hs-block-start-regexp' when it's not a string.
(hs-minor-mode): Don't call 'hs-grok-mode-type' when
'hs-inside-comment-p-func' already has a buffer-local value.

* lisp/treesit.el (treesit-hs-block-end)
(treesit-hs-find-block-beginning, treesit-hs-find-next-block)
(treesit-hs-looking-at-block-start-p)
(treesit-hs-inside-comment-p): New functions.
(treesit-major-mode-setup): Set hs-minor-mode buffer-local variables.

3 files changed, 123 insertions, 15 deletions

diff --git a/etc/NEWS b/etc/NEWS
index ec61f2bc430..09507adecb8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1110,6 +1110,10 @@ the tree-sitter library.  The new function 'treesit-show-paren-data' is
 used to communicate the tree-sitter parsing results to
 'show-paren-mode'.
 
+*** Tree-sitter enabled modes now properly support 'hs-minor-mode'.
+All commands from hideshow.el can selectively display blocks
+defined by the new treesit thing 'list'.
+
 *** New treesit thing 'comment'.
 The new variable 'forward-comment-function' is set to the new function
 'treesit-forward-comment' if a major mode defines the thing 'comment'.
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 823eb0527c6..157a8473631 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -95,7 +95,7 @@
 ;; nested level in addition to the top-level:
 ;;
 ;;     (defun ttn-hs-hide-level-1 ()
-;;       (when (hs-looking-at-block-start-p)
+;;       (when (funcall hs-looking-at-block-start-p-func)
 ;;         (hs-hide-level 1))
 ;;       (forward-sexp 1))
 ;;     (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
@@ -481,6 +481,9 @@ Specifying this function is necessary for languages such as
 Python, where `looking-at' and `syntax-ppss' check is not enough
 to check if the point is at the block start.")
 
+(defvar-local hs-inside-comment-p-func nil
+  "Function used to check if point is inside a comment.")
+
 (defvar hs-headline nil
   "Text of the line where a hidden block begins, set during isearch.
 You can display this in the mode line by adding the symbol `hs-headline'
@@ -625,9 +628,13 @@ and then further adjusted to be at the end of the line."
           (setq p (line-end-position)))
         ;; `q' is the point at the end of the block
         (hs-forward-sexp mdata 1)
-        (setq q (if (looking-back hs-block-end-regexp nil)
-                    (match-beginning 0)
-                  (point)))
+        (setq q (cond ((and (stringp hs-block-end-regexp)
+                            (looking-back hs-block-end-regexp nil))
+                       (match-beginning 0))
+                      ((functionp hs-block-end-regexp)
+                       (funcall hs-block-end-regexp)
+                       (match-beginning 0))
+                      (t (point))))
         (when (and (< p q) (> (count-lines p q) 1))
           (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p)))
                  (delete-overlay ov))
@@ -644,6 +651,11 @@ its starting line there is only whitespace preceding the actual comment
 beginning.  If we are inside of a comment but this condition is not met,
 we return a list having a nil as its car and the end of comment position
 as cdr."
+  (if (functionp hs-inside-comment-p-func)
+      (funcall hs-inside-comment-p-func)
+    (hs-inside-comment-p--default)))
+
+(defun hs-inside-comment-p--default ()
   (save-excursion
     ;; the idea is to look backwards for a comment start regexp, do a
     ;; forward comment, and see if we are inside, then extend
@@ -850,14 +862,16 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
      (syntax-propertize (point-max))
      (let ((spew (make-progress-reporter "Hiding all blocks..."
                                          (point-min) (point-max)))
-           (re (concat "\\("
-                       hs-block-start-regexp
-                       "\\)"
-                       (if hs-hide-comments-when-hiding-all
-                           (concat "\\|\\("
-                                   hs-c-start-regexp
-                                   "\\)")
-                         ""))))
+           (re (when (stringp hs-block-start-regexp)
+                 (concat "\\("
+                         hs-block-start-regexp
+                         "\\)"
+                         (if (and hs-hide-comments-when-hiding-all
+                                  (stringp hs-c-start-regexp))
+                             (concat "\\|\\("
+                                     hs-c-start-regexp
+                                     "\\)")
+                           "")))))
        (while (funcall hs-find-next-block-func re (point-max)
                        hs-hide-comments-when-hiding-all)
          (if (match-beginning 1)
@@ -869,7 +883,9 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
                          (hs-hide-block-at-point t))
                  ;; Go to end of matched data to prevent from getting stuck
                  ;; with an endless loop.
-                 (when (looking-at hs-block-start-regexp)
+                 (when (if (stringp hs-block-start-regexp)
+                           (looking-at hs-block-start-regexp)
+                         (eq (point) (match-beginning 0)))
                    (goto-char (match-end 0)))))
            ;; found a comment, probably
            (let ((c-reg (hs-inside-comment-p)))
@@ -1008,7 +1024,10 @@ Key bindings:
   (setq hs-headline nil)
   (if hs-minor-mode
       (progn
-        (hs-grok-mode-type)
+        ;; Use such heuristics that if one buffer-local variable
+        ;; is already defined, don't overwrite other variables too.
+        (unless (buffer-local-value 'hs-inside-comment-p-func (current-buffer))
+          (hs-grok-mode-type))
         ;; Turn off this mode if we change major modes.
         (add-hook 'change-major-mode-hook
                   #'turn-off-hideshow
diff --git a/lisp/treesit.el b/lisp/treesit.el
index f7d43ab44f8..33fcd9e7207 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -3489,6 +3489,81 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in
       (setq level (1+ level)))
     (if (zerop level) 1 level)))
 
+;;; Hideshow mode
+
+(defun treesit-hs-block-end ()
+  "Tree-sitter implementation of `hs-block-end-regexp'."
+  (let* ((pred 'list)
+         (thing (treesit-thing-at
+                 (if (bobp) (point) (1- (point))) pred))
+         (end (when thing (treesit-node-end thing)))
+         (last (when thing (treesit-node-child thing -1)))
+         (beg (if last (treesit-node-start last)
+                (if (bobp) (point) (1- (point))))))
+    (when (and thing (eq (point) end))
+      (set-match-data (list beg end))
+      t)))
+
+(defun treesit-hs-find-block-beginning ()
+  "Tree-sitter implementation of `hs-find-block-beginning-func'."
+  (let* ((pred 'list)
+         (thing (treesit-thing-at (point) pred))
+         (beg (when thing (treesit-node-start thing)))
+         (end (when beg (min (1+ beg) (point-max)))))
+    (when thing
+      (goto-char beg)
+      (set-match-data (list beg end))
+      t)))
+
+(defun treesit-hs-find-next-block (_regexp maxp comments)
+  "Tree-sitter implementation of `hs-find-next-block-func'."
+  (when (not comments)
+    (forward-comment (point-max)))
+  (let* ((comment-pred
+          (when comments
+            (if (treesit-thing-defined-p 'comment (treesit-language-at (point)))
+                'comment "comment")))
+         (pred (if comment-pred (append '(or list) (list comment-pred)) 'list))
+         ;; `treesit-navigate-thing' can't find a thing at bobp,
+         ;; so use `treesit-thing-at' to match at bobp.
+         (current (treesit-thing-at (point) pred))
+         (beg (or (and current (eq (point) (treesit-node-start current)) (point))
+                  (treesit-navigate-thing (point) 1 'beg pred)))
+         ;; Check if we found a list or a comment
+         (list-thing (when beg (treesit-thing-at beg 'list)))
+         (comment-thing (when beg (treesit-thing-at beg comment-pred)))
+         (comment-p (and comment-thing (eq beg (treesit-node-start comment-thing))))
+         (thing (if comment-p comment-thing list-thing))
+         (end (if thing (min (1+ (treesit-node-start thing)) (point-max)))))
+    (when (and end (< end maxp))
+      (goto-char end)
+      (set-match-data
+       (if (and comments comment-p)
+           (list beg end nil nil beg end)
+         (list beg end beg end)))
+      t)))
+
+(defun treesit-hs-looking-at-block-start-p ()
+  "Tree-sitter implementation of `hs-looking-at-block-start-p-func'."
+  (let* ((pred 'list)
+         (thing (treesit-thing-at (point) pred))
+         (beg (when thing (treesit-node-start thing)))
+         (end (min (1+ (point)) (point-max))))
+    (when (and thing (eq (point) beg))
+      (set-match-data (list beg end))
+      t)))
+
+(defun treesit-hs-inside-comment-p ()
+  "Tree-sitter implementation of `hs-inside-comment-p-func'."
+  (let* ((comment-pred
+          (if (treesit-thing-defined-p 'comment (treesit-language-at (point)))
+              'comment "comment"))
+         (thing (or (treesit-thing-at (point) comment-pred)
+                    (unless (bobp)
+                      (treesit-thing-at (1- (point)) comment-pred)))))
+    (when thing
+      (list (treesit-node-start thing) (treesit-node-end thing)))))
+
 ;;; Show paren mode
 
 (defun treesit-show-paren-data--categorize (pos &optional end-p)
@@ -3672,7 +3747,17 @@ before calling this function."
     (setq-local forward-list-function #'treesit-forward-list)
     (setq-local down-list-function #'treesit-down-list)
     (setq-local up-list-function #'treesit-up-list)
-    (setq-local show-paren-data-function #'treesit-show-paren-data))
+    (setq-local show-paren-data-function #'treesit-show-paren-data)
+    (setq-local hs-c-start-regexp nil
+                hs-block-start-regexp nil
+                hs-block-start-mdata-select 0
+                hs-block-end-regexp #'treesit-hs-block-end
+                hs-forward-sexp-func #'forward-list
+                hs-adjust-block-beginning nil
+                hs-find-block-beginning-func #'treesit-hs-find-block-beginning
+                hs-find-next-block-func #'treesit-hs-find-next-block
+                hs-looking-at-block-start-p-func #'treesit-hs-looking-at-block-start-p
+                hs-inside-comment-p-func #'treesit-hs-inside-comment-p))
 
   (when (treesit-thing-defined-p 'sentence nil)
     (setq-local forward-sentence-function #'treesit-forward-sentence))