Subject: bug#75609: Hideshow support for treesitter

From: Yuan Fu <[email-masked]>
Date: Fri, 17 Jan 2025 23:40:16 -0800

> On Jan 16, 2025, at 9:45 AM, Juri Linkov <[email-masked]> wrote:
> 
> Tags: patch
> 
> Now that we have the new list thing in tree-sitter, it became possible
> to implement the hideshow support to hide the list things, i.e.
> exactly what hs-minor-mode did in non-ts modes:

Awesome! Thanks :-) Some comments below:

> 
> diff --git a/lisp/treesit.el b/lisp/treesit.el
> index ac34edaf84d..0e48fb91b44 100644
> --- a/lisp/treesit.el
> +++ b/lisp/treesit.el
> @@ -3420,6 +3420,65 @@ treesit-outline-level
>       (setq level (1+ level)))
>     (if (zerop level) 1 level)))
> 
> +;;; Hideshow mode
> +
> +(defun treesit-hs-block-end ()
> +  (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 ()
> +  (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)
> +  (let* ((pred (if comments '(or list "comment") '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)))
> +         (thing (when beg (treesit-thing-at beg pred)))
> +         (end (when thing (treesit-node-end thing))))
> +    (when thing
> +      (goto-char end)
> +      (set-match-data
> +       (if (and comments (equal (treesit-node-type thing) "comment"))
> +           (list beg end nil nil beg end)
> +         (list beg end beg end)))
> +      t)))
> +
> +(defun treesit-hs-looking-at-block-start-p ()
> +  (let* ((pred 'list)
> +         (thing (treesit-thing-at (point) pred))
> +         (beg (when thing (treesit-node-start thing)))
> +         (first (when thing (treesit-node-child thing 0)))
> +         (end (if first (treesit-node-end first) (1+ (point)))))
> +    (when (and thing (eq (point) beg))
> +      (set-match-data (list beg end))
> +      t)))
> +
> +(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?

> ;;; Show paren mode
> 
> (defun treesit-show-paren-data--categorize (pos &optional end-p)
> @@ -3603,7 +3662,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 hs-block-start-regexp nil
> +          hs-block-start-mdata-select 0
> +          hs-block-end-regexp #'treesit-hs-block-end
> +          hs-c-start-regexp nil
> +          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..ea7bc738a4d 100644
> --- a/lisp/progmodes/hideshow.el
> +++ b/lisp/progmodes/hideshow.el
> @@ -259,14 +259,11 @@ hs-special-modes-alist
>   ;; to the mode hierarchy.
>   (mapcar #'purecopy
>   '((c-mode "{" "}" "/[*/]" nil nil)
> -    (c-ts-mode "{" "}" "/[*/]" nil nil)
>     (c++-mode "{" "}" "/[*/]" nil nil)
> -    (c++-ts-mode "{" "}" "/[*/]" nil nil)
>     (bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
>     (java-mode "{" "}" "/[*/]" nil nil)
>     (java-ts-mode "{" "}" "/[*/]" nil nil)
>     (js-mode "{" "}" "/[*/]" nil)
> -    (js-ts-mode "{" "}" "/[*/]" nil)
>     (lua-ts-mode "{\\|\\[\\[" "}\\|\\]\\]" "--" nil)
>     (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil)
>     ;; Add more support here.
> @@ -481,6 +478,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 +625,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 +648,9 @@ 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."
> +  (cond ((functionp hs-inside-comment-p-func)
> +         (funcall hs-inside-comment-p-func))
> +  (t

Did you do this indentation on purpose to make a easier-to-read diff?

>   (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
> @@ -692,7 +699,7 @@ hs-inside-comment-p
>           (skip-chars-backward " \t\n\f")
>           (end-of-line)
>           (when (>= (point) q)
> -            (list (and hideable p) (point))))))))
> +            (list (and hideable p) (point))))))))))
> 
> (defun hs-grok-mode-type ()
>   "Set up hideshow variables for new buffers.
> @@ -704,7 +711,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 +857,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 +878,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 +1019,8 @@ hs-minor-mode
>   (setq hs-headline nil)
>   (if hs-minor-mode
>       (progn
> -        (hs-grok-mode-type)
> +        (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