Subject: bug#75609: Hideshow support for treesitter

From: Juri Linkov <[email-masked]>
Date: Mon, 27 Jan 2025 21:11:59 +0200

>> +(defun treesit-hs-inside-comment-p ()
>> +  (let ((thing (or (treesit-thing-at (point) "comment")
>> +                   (unless (bobp)
>> +                     (treesit-thing-at (1- (point)) "comment")))))
>> +    (when thing
>> +      (list (treesit-node-start thing) (treesit-node-end thing)))))
>> +
>
> FYI some grammar calls comments line_comment and block_comment.  Maybe
> use the comment thing first, and then match “comment” with the node type?

Now this tries to use the comment thing first, and then falls back to “comment”.

diff --git a/lisp/treesit.el b/lisp/treesit.el
index e08aa52ca50..de86b847177 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -3489,6 +3489,82 @@ treesit-outline-level
       (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))
+         (thing (or thing (treesit-parent-until (treesit-node-at (point)) pred)))
+         (beg (when thing (treesit-node-start thing)))
+         (end (when thing (treesit-node-end thing))))
+    (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 end
+      (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 +3748,17 @@ treesit-major-mode-setup
     (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))
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 823eb0527c6..d96efde991f 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -481,6 +481,9 @@ hs-looking-at-block-start-p-func
 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 @@ hs-hide-block-at-point
 	  (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 @@ hs-inside-comment-p
 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
@@ -704,7 +716,7 @@ hs-grok-mode-type
            (bound-and-true-p comment-end))
       (let* ((lookup (assoc major-mode hs-special-modes-alist))
              (start-elem (or (nth 1 lookup) "\\s(")))
-        (if (listp start-elem)
+        (if (consp start-elem)
             ;; handle (START-REGEXP MDATA-SELECT)
             (setq hs-block-start-regexp (car start-elem)
                   hs-block-start-mdata-select (cadr start-elem))
@@ -850,14 +862,16 @@ hs-hide-all
      (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 @@ hs-hide-all
 			 (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 @@ hs-minor-mode
   (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