From 65a0e2071ac25c9d536c286fde9375e942030fc9 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 28 Jan 2025 21:07:16 +0200 Subject: [PATCH] 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. (cherry picked from commit 2e3b085d447bc2cd1a0e779145be9cab9a15d7af) --- lisp/progmodes/hideshow.el | 47 ++++++++++++++------ lisp/treesit.el | 87 +++++++++++++++++++++++++++++++++++++- 2 files changed, 119 insertions(+), 15 deletions(-) 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 a9a2f7525b1..e05c74f4143 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3482,6 +3482,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) @@ -3665,7 +3740,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)) -- 2.39.5