Package: emacs;
Reported by: Juri Linkov <juri <at> linkov.net>
Date: Thu, 16 Jan 2025 17:50:01 UTC
Severity: wishlist
Tags: patch
Fixed in version 31.0.50
Done: Juri Linkov <juri <at> linkov.net>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Juri Linkov <juri <at> linkov.net> To: Yuan Fu <casouri <at> gmail.com> Cc: 75609 <at> debbugs.gnu.org Subject: bug#75609: Hideshow support for treesitter Date: Mon, 27 Jan 2025 21:11:59 +0200
[Message part 1 (text/plain, inline)]
>> +(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”.
[treesit-hideshow.patch (text/x-diff, inline)]
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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.