hideshow: Support nested comment block in 'hs-hide-level-recursive'

bug#80009

* doc/emacs/programs.texi (Hideshow): Update documentation.
* lisp/progmodes/hideshow.el (hs-hide-level-recursive): Rework.
(hs-get-first-block-on-line): Minor changes.
(hs--add-indicators, hs-hide-comments-when-hiding-all)
(hs-minor-mode-menu, hs-hide-level, hs-cycle): Update code.
* test/lisp/progmodes/hideshow-tests.el
(hideshow-hide-levels-with-comments-1): New test.

4 files changed, 98 insertions, 35 deletions

diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 6acd04d0bae..1e487120272 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1747,8 +1747,8 @@ Either hide or show all the blocks in the current buffer. (@code{hs-toggle-all})
 
 @table @code
 @item hs-hide-comments-when-hiding-all
-If non-@code{nil}, @kbd{C-c @@ C-M-h} (@code{hs-hide-all}) hides
-comments too.
+If non-@code{nil}, @code{hs-hide-all}, @code{hs-cycle} and
+@code{hs-hide-level} hide comments too.
 
 @item hs-hide-block-behavior
 This variable controls how @code{hs-hide-block} and
diff --git a/etc/NEWS b/etc/NEWS
index e3ea4557355..7e8dbf44b9f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1169,6 +1169,11 @@ FORWARD-SEXP-FUNC, etc., major mode authors should set the corresponding
 buffer-local variables 'hs-block-start-regexp', 'hs-c-start-regexp',
 'hs-forward-sexp-function', etc.
 
++++
+*** 'hs-hide-level' and 'hs-cycle' can now hide comments too.
+This is controlled by 'hs-hide-comments-when-hiding-all'.
+
+
 ** C-ts mode
 
 +++
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 41e804ae3d0..688f2e7cdff 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -83,7 +83,8 @@
 ;; Hideshow provides the following user options:
 ;;
 ;; - `hs-hide-comments-when-hiding-all'
-;;   self-explanatory!
+;;   If non-nil, `hs-hide-all', `hs-cycle' and `hs-hide-level' will hide
+;;   comments too.
 ;; - `hs-hide-all-non-comment-function'
 ;;   If non-nil, after calling `hs-hide-all', this function is called
 ;;   with no arguments.
@@ -322,7 +323,9 @@ a block), `hs-show-all' and `hs-show-block'."
   :version "31.1")
 
 (defcustom hs-hide-comments-when-hiding-all t
-  "Hide the comments too when you do an `hs-hide-all'."
+  "Whether the comments should be hidden.
+If non-nil, `hs-hide-all', `hs-cycle' and `hs-hide-level' will hide
+comments too."
   :type 'boolean)
 
 (defcustom hs-hide-block-behavior 'after-bol
@@ -560,7 +563,8 @@ This is only used if `hs-indicator-type' is set to `margin' or nil."
     ["Hide comments when hiding all"
      (setq hs-hide-comments-when-hiding-all
            (not hs-hide-comments-when-hiding-all))
-     :help "If t also hide comment blocks when doing `hs-hide-all'"
+     :help "\
+If t also hide comment blocks when doing `hs-hide-all', `hs-cycle' or `hs-hide-level'"
      :style toggle :selected hs-hide-comments-when-hiding-all]
     ("Reveal on isearch"
      ["Code blocks" (setq hs-isearch-open 'code)
@@ -693,12 +697,13 @@ to find the beginning of the current block.")
   "Function used to do `hs-find-next-block'.
 It should reposition point at next block start.
 
-It is called with three arguments REGEXP, BOUND, and COMMENTS.
-REGEXP is a regexp representing block start.  When block start is found,
+It is called with three arguments REGEXP, BOUND, and COMMENTS.  REGEXP
+is a regexp representing block start.  When block start is found,
 `match-data' should be set using REGEXP.  BOUND is a buffer position
 that limits the search.  When COMMENTS is non-nil, REGEXP matches not
 only beginning of a block but also beginning of a comment.  In this
-case, the function should find nearest block or comment.
+case, the function should find nearest block or comment and return
+non-nil.
 
 Specifying this function is necessary for languages such as Python,
 where regexp search is not enough to find the beginning of the next
@@ -871,7 +876,8 @@ line and returns the start position of the first block found.
 Otherwise, if no block is found, it returns nil.
 
 If INCLUDE-COMMENTS is non-nil, also search for a comment block."
-  (let ((regexp (if include-comments
+  (let ((bk-point (point))
+        (regexp (if include-comments
                     (concat "\\(" hs-block-start-regexp "\\)"
                             "\\|\\(" hs-c-start-regexp "\\)")
                   hs-block-start-regexp))
@@ -887,6 +893,7 @@ If INCLUDE-COMMENTS is non-nil, also search for a comment block."
                     (if (and beg (hs-hideable-region-p beg end))
                         (setq exit (point))
                       t)))))
+    (unless exit (goto-char bk-point))
     exit))
 
 (defun hs-get-near-block (&optional include-comment)
@@ -929,21 +936,21 @@ commands."
   (goto-char beg)
   (while (not (>= (point) end))
     (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
-                (block (save-excursion
-                         (hs-get-first-block-on-line include-comments))))
-      (goto-char (match-beginning 0))
-      (if (> arg 1)
-          ;; Find a block recursively according to ARG.
-          (pcase-let ((`(,beg ,end) (or (and include-comments
-                                             (funcall hs-inside-comment-predicate))
-                                        (hs-block-positions))))
-            (hs-hide-level-recursive (1- arg) beg end include-comments))
-        ;; Now hide the block we found.
-        (if func (funcall func)
-          (hs-hide-block-at-point
-           (and include-comments (funcall hs-inside-comment-predicate))))
-        (when progress
-          (progress-reporter-update progress (point)))))
+                (b-start (hs-get-first-block-on-line include-comments)))
+      (goto-char b-start)
+      (let ((comment (and include-comments (funcall hs-inside-comment-predicate)))
+            (code (hs-block-positions)))
+        ;; Find a block recursively according to ARG.
+        (if (> arg 1)
+            ;; Nested comment blocks in a comment block are impossible,
+            ;; so skip them.
+            (if comment
+                (goto-char (cadr comment))
+              (pcase-let ((`(,beg ,end) code))
+                (hs-hide-level-recursive (1- arg) beg end include-comments)))
+          ;; Now hide the block we found.
+          (if func (funcall func) (hs-hide-block-at-point comment))
+          (when progress (progress-reporter-update progress (point))))))
     (forward-line 1))
   (goto-char end))
 
@@ -1086,10 +1093,9 @@ the overlay: `invisible' `hs'.  Also, depending on variable
   (remove-overlays beg end 'hs-indicator t)
 
   (while (not (>= (point) end))
-    (save-excursion
-      (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
-                  (b-beg (hs-get-first-block-on-line)))
-        (hs--make-indicators-overlays b-beg)))
+    (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
+                (b-beg (hs-get-first-block-on-line)))
+      (hs--make-indicators-overlays b-beg))
     ;; Only 1 indicator per line
     (forward-line))
   `(jit-lock-bounds ,beg . ,end))
@@ -1354,14 +1360,14 @@ The hook `hs-hide-hook' is run; see `run-hooks'."
      (message "Hiding blocks ...")
      (if (hs-get-near-block)
          ;; Hide block if we are looking at one.
-         (apply #'hs-hide-level-recursive arg
-                (hs-block-positions))
+         (pcase-let ((`(,beg ,end) (hs-block-positions)))
+           (hs-hide-level-recursive arg beg end hs-hide-comments-when-hiding-all))
        ;; Otherwise hide all the blocks in the current buffer
        (hs-hide-level-recursive
         ;; Increment ARG by 1, avoiding it acts like
         ;; `hs-hide-all'
-        (1+ arg)
-        (point-min) (point-max)))
+        (1+ arg) (point-min) (point-max)
+        hs-hide-comments-when-hiding-all))
      (message "Hiding blocks ... done"))
    (run-hooks 'hs-hide-hook)))
 
@@ -1422,8 +1428,9 @@ only blocks which are that many levels below the level of point."
             (hs-toggle-hiding)
             (message "Toggle visibility"))
            ((> level 1)
-            (apply #'hs-hide-level-recursive level
-                   (hs-block-positions))
+            (pcase-let ((`(,beg ,end) (hs-block-positions)))
+              (hs-hide-level-recursive
+               level beg end hs-hide-comments-when-hiding-all))
             (message "Hide %d level" level))
            (t
             (let* (hs-allow-nesting
@@ -1440,7 +1447,9 @@ only blocks which are that many levels below the level of point."
                ;; Hide the children blocks if the parent block is hidden
                ((and (= (overlay-start ov) (car block))
                      (= (overlay-end ov) (cadr block)))
-                (apply #'hs-hide-level-recursive 1 block)
+                (hs-hide-level-recursive
+                 1 (car block) (cadr block)
+                 hs-hide-comments-when-hiding-all)
                 (message "Hide first nested blocks"))
                ;; Otherwise show all in the parent block, we cannot use
                ;; `hs-show-block' here because we already know the
diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hideshow-tests.el
index 49f661a2390..cf13a064f39 100644
--- a/test/lisp/progmodes/hideshow-tests.el
+++ b/test/lisp/progmodes/hideshow-tests.el
@@ -281,6 +281,55 @@ main(int argc, char **argv)
 }
 "))))
 
+(ert-deftest hideshow-hide-levels-with-comments-1 ()
+  "Should hide 2nd and then 3rd level blocks including comment blocks."
+  (hideshow-tests-with-temp-buffer
+      lisp-data-mode
+    ;; 2nd
+   "
+;; comment
+;; comment
+;; comment
+
+(list
+ ;; comment2
+ ;; comment2
+ (list
+  ;; comment3
+  ;; comment3
+  '(lv3
+    lv3)))
+"
+   (hs-hide-level-recursive 2 (point-min) (point-max) :comments)
+   (should (string=
+            (hideshow-tests-visible-string)
+            "
+;; comment
+;; comment
+;; comment
+
+(list
+ ;; comment2
+ (list))
+"))
+   ;; 3rd
+   (hs-show-all)
+   (hs-hide-level-recursive 3 (point-min) (point-max) :comments)
+   (should (string=
+            (hideshow-tests-visible-string)
+            "
+;; comment
+;; comment
+;; comment
+
+(list
+ ;; comment2
+ ;; comment2
+ (list
+  ;; comment3
+  '(lv3)))
+"))))
+
 (ert-deftest hideshow-toggle-hiding-1 ()
   "Should toggle hiding/showing of a block."
   (let ((contents "