hideshow: New minor mode 'hs-indentation-mode'. (Bug#80179)

This minor mode configures hs-minor-mode to use
indentation-based folding.

* lisp/progmodes/hideshow.el (hs-hideable-block-p): New
function.
(hs-indentation-respect-end-block): New option.
(hs-indentation--store-vars): New variable.
(hs-cycle-filter, hs-get-first-block-on-line, hs-get-near-block)
(hs-find-block-beg-fn--default): Adapt code to use
'hs-hideable-block-p'.
(hs-block-positions): Update.
(hs-indentation-mode): New minor mode.

* doc/emacs/programs.texi (Hideshow): Update documentation.

* etc/NEWS: Announce changes

* test/lisp/progmodes/hideshow-tests.el: Add 'require'.
(hideshow-check-indentation-folding): New test.

doc/emacs/programs.texi

@@ -1688,6 +1688,13 @@ row).  Just what constitutes a block depends on the major mode.  In C
 mode and related modes, blocks are delimited by braces, while in Lisp
 mode they are delimited by parentheses.  Multi-line comments also
 count as blocks.
+
+Additionally, Hideshow mode supports optional indentation-based
+hiding/showing.  By default this is disabled; to enable it, turn on the
+buffer-local minor mode @code{hs-indentation-mode}.  Enabling
+@code{hs-indentation-mode} does not require that @code{hs-minor-mode} is
+already enabled.
+
 @vindex hs-prefix-map
 
   Hideshow mode provides the following commands (defined in @code{hs-prefix-map}):
@@ -1743,6 +1750,7 @@ Either hide or show all the blocks in the current buffer. (@code{hs-toggle-all})
 @vindex hs-isearch-open
 @vindex hs-hide-block-behavior
 @vindex hs-cycle-filter
+@vindex hs-indentation-respect-end-block
   These variables can be used to customize Hideshow mode:
 
 @table @code
@@ -1795,6 +1803,11 @@ block.  Its value should be either @code{code} (unhide only code
 blocks), @code{comment} (unhide only comments), @code{t} (unhide both
 code blocks and comments), or @code{nil} (unhide neither code blocks
 nor comments).  The default value is @code{code}.
+
+@item hs-indentation-respect-end-block
+This variable controls whether the end of the block should be hidden
+together with the hidden region.  This only has effect if
+@code{hs-indentation-mode} is enabled.
 @end table
 
 @node Symbol Completion

etc/NEWS

@@ -1374,6 +1374,14 @@ buffer-local variables 'hs-block-start-regexp', 'hs-c-start-regexp',
 *** 'hs-hide-level' can now hide comments too.
 This is controlled by 'hs-hide-comments-when-hiding-all'.
 
++++
+*** New minor mode 'hs-indentation-mode'.
+This buffer-local minor mode configures 'hs-indentation-mode' to detect
+blocks based on indentation.
+
+The new user option 'hs-indentation-respect-end-block' can be used to
+adjust the hiding range for this minor mode.
+
 ** C-ts mode
 
 +++

lisp/progmodes/hideshow.el

@@ -63,6 +63,8 @@
 ;; hideshow minor mode by typing `M-x hs-minor-mode'.  After hideshow is
 ;; activated or deactivated, `hs-minor-mode-hook' is run with `run-hooks'.
 ;;
+;; To enable indentation-based hiding/showing turn on `hs-indentation-mode'.
+;;
 ;; Additionally, Joseph Eydelnant writes:
 ;;   I enjoy your package hideshow.el Version 5.24 2001/02/13
 ;;   a lot and I've been looking for the following functionality:
@@ -83,28 +85,16 @@
 ;; Hideshow provides the following user options:
 ;;
 ;; - `hs-hide-comments-when-hiding-all'
-;;   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.
 ;; - `hs-isearch-open'
-;;   What kind of hidden blocks to open when doing isearch.
 ;; - `hs-set-up-overlay'
-;;   Function called with one arg (an overlay), intended to customize
-;;   the block hiding appearance.
 ;; - `hs-display-lines-hidden'
-;;   Displays the number of hidden lines next to the ellipsis.
 ;; - `hs-show-indicators'
-;;   Display indicators to show and toggle the block hiding.
 ;; - `hs-indicator-type'
-;;   Which indicator type should be used for the block indicators.
 ;; - `hs-indicator-maximum-buffer-size'
-;;   Max buffer size in bytes where the indicators should be enabled.
 ;; - `hs-allow-nesting'
-;;   If non-nil, hiding remembers internal blocks.
 ;; - `hs-cycle-filter'
-;;   Control where typing a `TAB' cycles the visibility.
+;; - `hs-indentation-respect-end-block'
 ;;
 ;; The variable `hs-hide-all-non-comment-function' may be useful if you
 ;; only want to hide some N levels blocks for some languages/files or
@@ -458,10 +448,7 @@ Currently it affects only the command `hs-toggle-hiding' by default,
 but it can be easily replaced with the command `hs-cycle'."
   :type `(choice (const :tag "Nowhere" nil)
                  (const :tag "Everywhere on the headline" t)
-                 (const :tag "At block beginning"
-                        ,(lambda ()
-                           (pcase-let ((`(,beg ,end) (hs-block-positions)))
-                             (and beg (hs-hideable-region-p beg end)))))
+                 (const :tag "At block beginning" hs-hideable-block-p)
                  (const :tag "At line beginning" bolp)
                  (const :tag "Not at line beginning"
                         ,(lambda () (not (bolp))))
@@ -469,6 +456,18 @@ but it can be easily replaced with the command `hs-cycle'."
                  (function :tag "Custom filter function"))
   :version "31.1")
 
+;; Used in `hs-indentation-mode'
+(defcustom hs-indentation-respect-end-block nil
+  "If non-nil, the end of the block will not be hidden.
+This only has effect if `hs-indentation-mode' is enabled.
+
+NOTE: For some modes, enabling this may result in hiding wrong parts of
+the buffer.  If this happens, enable this only for some modes (usually
+using `add-hook')."
+  :type 'boolean
+  :local t
+  :version "31.1")
+
 ;;;; Icons
 
 (define-icon hs-indicator-hide nil
@@ -616,6 +615,9 @@ Note that `mode-line-format' is buffer-local.")
 ;; Used in `hs-toggle-all'
 (defvar-local hs--toggle-all-state)
 
+;; Used in `hs-indentation-mode'
+(defvar-local hs-indentation--store-vars nil)
+
 
 ;;;; API variables
 
@@ -788,6 +790,17 @@ Skip \"internal\" overlays if `hs-allow-nesting' is non-nil."
   (and beg end
        (< beg (save-excursion (goto-char end) (pos-bol)))))
 
+(defun hs-hideable-block-p (&optional include-comment)
+  "Return t if block at point is hideable.
+If INCLUDE-COMMENT is non-nil, include comments first.
+
+If there is no block at point, return nil."
+  (pcase-let ((`(,beg ,end)
+               (or (and include-comment
+                        (funcall hs-inside-comment-predicate))
+                   (hs-block-positions))))
+    (hs-hideable-region-p beg end)))
+
 (defun hs-already-hidden-p ()
   "Return non-nil if point is in an already-hidden block, otherwise nil."
   (save-excursion
@@ -820,14 +833,13 @@ This is for code block positions only, for comments use
     (save-match-data
       (save-excursion
         (when (funcall hs-looking-at-block-start-predicate)
-          (let* ((beg (match-end 0)) end)
+          (let ((beg (match-end 0)) end)
             ;; `beg' is the point at the block beginning, which may need
             ;; to be adjusted
             (when adjust-beg
-              (setq beg (pos-eol))
-              (save-excursion
-                (when hs-adjust-block-beginning-function
-                  (goto-char (funcall hs-adjust-block-beginning-function beg)))))
+              (setq beg (if hs-adjust-block-beginning-function
+                            (funcall hs-adjust-block-beginning-function beg)
+                          (pos-eol))))
 
             (goto-char (match-beginning hs-block-start-mdata-select))
             (condition-case _
@@ -897,13 +909,9 @@ If INCLUDE-COMMENTS is non-nil, also search for a comment block."
                 (funcall hs-find-next-block-function regexp (pos-eol) include-comments)
                 (save-excursion
                   (goto-char (match-beginning 0))
-                  (pcase-let ((`(,beg ,end)
-                               (or (and include-comments
-                                        (funcall hs-inside-comment-predicate))
-                                   (hs-block-positions))))
-                    (if (and beg (hs-hideable-region-p beg end))
-                        (setq exit (point))
-                      t)))))
+                  (if (hs-hideable-block-p include-comments)
+                      (setq exit (point))
+                    t))))
     (unless exit (goto-char bk-point))
     exit))
 
@@ -930,10 +938,10 @@ Intended to be used in commands."
       (goto-char pos)
       t)
 
-     ((and (or (funcall hs-looking-at-block-start-predicate)
+     ((and (or (hs-hideable-block-p)
                (and (forward-line 0)
-                    (funcall hs-find-block-beginning-function)))
-           (apply #'hs-hideable-region-p (hs-block-positions)))
+                    (funcall hs-find-block-beginning-function)
+                    (hs-hideable-block-p))))
       t))))
 
 (defun hs-hide-level-recursive (arg beg end &optional include-comments func progress)
@@ -1268,7 +1276,7 @@ region (point BOUND)."
 Return point, or nil if original point was not in a block."
   (let ((here (point)) done)
     ;; look if current line is block start
-    (if (funcall hs-looking-at-block-start-predicate)
+    (if (hs-hideable-block-p)
         here
       ;; look backward for the start of a block that contains the cursor
       (save-excursion
@@ -1276,8 +1284,8 @@ Return point, or nil if original point was not in a block."
                     (goto-char (match-beginning 0))
 		    ;; go again if in a comment or a string
 		    (or (save-match-data (nth 8 (syntax-ppss)))
-		        (not (setq done (and (<= here (cadr (hs-block-positions)))
-                                             (point))))))))
+		        (not (setq done (pcase-let ((`(_ ,end) (hs-block-positions)))
+                                          (and end (<= here end) (point)))))))))
       (when done (goto-char done)))))
 
 ;; This function is not used anymore (Bug#700).
@@ -1478,6 +1486,61 @@ only blocks which are that many levels below the level of point."
     (hs-hide-all))
   (setq-local hs--toggle-all-state (not hs--toggle-all-state)))
 
+;;;###autoload
+(define-minor-mode hs-indentation-mode
+  "Toggle indentation-based hiding/showing."
+  :group 'hideshow
+  (if hs-indentation-mode
+      (progn
+        (setq hs-indentation--store-vars
+              (buffer-local-set-state
+               hs-forward-sexp-function
+               (lambda (_)
+                 (let ((size (current-indentation)) end)
+                   (save-match-data
+                     (save-excursion
+                       (forward-line 1) ; Start from next line
+                       (while (and (not (eobp))
+                                   (re-search-forward hs-block-start-regexp nil t)
+                                   (> (current-indentation) size))
+                         (setq end (point))
+                         (forward-line 1))))
+                   (when end (goto-char end) (end-of-line))))
+               hs-block-start-regexp (rx (0+ blank) (1+ nonl))
+               hs-block-end-regexp nil
+               hs-adjust-block-end-function
+               ;; Adjust line to the "end of the block" (Usually this is
+               ;; the next line after the position by
+               ;; `hs-forward-sexp-function' with the same indentation
+               ;; level as the block start)
+               (if hs-indentation-respect-end-block
+                   (lambda (beg)
+                     (save-excursion
+                       (when (and (not (eobp))
+                                  (forward-line 1)
+                                  (not (looking-at-p (rx (0+ blank) eol)))
+                                  (= (current-indentation)
+                                     (save-excursion
+                                       (goto-char beg)
+                                       (current-indentation)))
+                                  (progn (back-to-indentation)
+                                         (not (hs-hideable-block-p))))
+                         (point))))
+                 hs-adjust-block-end-function)
+               ;; Set the other variables to their default values
+               hs-looking-at-block-start-predicate #'hs-looking-at-block-start-p--default
+               hs-find-next-block-function #'hs-find-next-block-fn--default
+               hs-find-block-beginning-function #'hs-find-block-beg-fn--default
+               hs-c-start-regexp (string-trim-right (regexp-quote comment-start))))
+        ;; Refresh indicators (if needed)
+        (when (and hs-show-indicators hs-minor-mode)
+          (hs-minor-mode -1)
+          (hs-minor-mode +1)))
+    (buffer-local-restore-state hs-indentation--store-vars)
+    (when (and hs-show-indicators hs-minor-mode)
+      (hs-minor-mode -1)
+      (hs-minor-mode +1))))
+
 ;;;###autoload
 (define-minor-mode hs-minor-mode
   "Minor mode to selectively hide/show code and comment blocks.

test/lisp/progmodes/hideshow-tests.el

@@ -26,6 +26,7 @@
 
 ;; Dependencies for testing:
 (require 'cc-mode)
+(require 'sh-script)
 
 
 (defmacro hideshow-tests-with-temp-buffer (mode contents &rest body)
@@ -475,6 +476,35 @@ def test1 ():
      (beginning-of-line)
      (should-not (hs-block-positions)))))
 
+(ert-deftest hideshow-check-indentation-folding ()
+  "Check indentation-based folding with and without end of the block respected."
+  (let ((contents "
+if [1]
+  then 2
+fi"))
+    (hideshow-tests-with-temp-buffer
+     sh-mode
+     contents
+     (hs-indentation-mode t)
+     (hideshow-tests-look-at "if")
+     (beginning-of-line)
+     (hs-hide-block)
+     (should (string=
+              (hideshow-tests-visible-string)
+              "
+if [1]
+fi"))
+     (hs-show-all)
+     ;; End of the block respected
+     (hs-indentation-mode nil) ; Reset variables
+     (setq-local hs-indentation-respect-end-block t)
+     (hs-indentation-mode t)
+     (hs-hide-block)
+     (should (string=
+              (hideshow-tests-visible-string)
+              "
+if [1]fi")))))
+
 (provide 'hideshow-tests)
 
 ;;; hideshow-tests.el ends here