aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorElías Gabriel Pérez2025-12-05 18:42:54 -0600
committerJuri Linkov2025-12-08 09:20:29 +0200
commita582f2bb577bd8e696d51e4d3a728426b33f59cc (patch)
tree8df49b01d83eee0152149f4dac5bd3faa5579c5f
parent15f9050ce5c21d1c7d455db90443ddb4124641aa (diff)
downloademacs-a582f2bb577bd8e696d51e4d3a728426b33f59cc.tar.gz
emacs-a582f2bb577bd8e696d51e4d3a728426b33f59cc.zip
hideshow: Deep cleaning. (Bug#79934)
This is just a refactoring change, simplifying most of the code and commentaries and removing/deprecating redundant code. * etc/NEWS: Announce changes. * lisp/progmodes/hideshow.el (hs-hide-hook, hs-show-hook): Use 'defcustom' instead of 'defvar'. (hs-block-end-regexp, hs-forward-sexp-function) (hs-adjust-block-beginning-function) (hs-adjust-block-end-function, hs-find-block-beginning-function) (hs-find-next-block-function) (hs-looking-at-block-start-predicate) (hs-inside-comment-predicate): Update docstring. (hs-discard-overlays): Simplify. (hs-life-goes-on): Update docstring. (hs-hideable-region-p): Revert previous changes. (hs-overlay-at): Simplify. (hs-make-overlay): Fix performance. (hs-block-positions): Rework. (hs--add-indicators): Fix performance. (hs-isearch-show-temporary): Simplify. (hs-looking-at-block-start-p): Rename ... (hs-looking-at-block-start-p--default): ... to this. (hs-forward-sexp, hs-hide-comment-region): Mark as obsolete. (hs-hide-block-at-point): Rework. (hs-get-first-block): Rename ... (hs-get-first-block-on-line): ... to this. (hs-inside-comment-p--default): Rework. (hs-find-block-beginning): Rename ... (hs-find-block-beg-fn--default): ... to this. (hs-find-next-block): Rename ... (hs-find-next-block-fn--default): ... to this. (hs-hide-level-recursive): Rework. (hs-find-block-beginning-match): Remove function. (hs-already-hidden-p): Simplify. (hs-c-like-adjust-block-beginning): Mark as obsolete. (hs-hide-all, hs-show-all, hs-hide-block, hs-show-block) (hs-hide-level, hs-hide-initial-comment-block, hs-cycle): Simplify. * test/lisp/progmodes/hideshow-tests.el (hideshow-hide-level-1) (hideshow-hide-level-2): * test/lisp/progmodes/python-tests.el (python-hideshow-hide-levels-3, python-hideshow-hide-levels-4): * test/lisp/progmodes/hideshow-tests.el (hideshow-hide-level-1) (hideshow-hide-level-2): * test/lisp/progmodes/python-tests.el (python-hideshow-hide-levels-3, python-hideshow-hide-levels-4): Update tests.
-rw-r--r--etc/NEWS8
-rw-r--r--lisp/progmodes/hideshow.el1301
-rw-r--r--test/lisp/progmodes/hideshow-tests.el36
-rw-r--r--test/lisp/progmodes/python-tests.el12
4 files changed, 627 insertions, 730 deletions
diff --git a/etc/NEWS b/etc/NEWS
index d7c750143cc..64b3e1ca87e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1113,6 +1113,12 @@ blocks.
1113*** New command 'hs-toggle-all'. 1113*** New command 'hs-toggle-all'.
1114This command hides or shows all the blocks in the current buffer. 1114This command hides or shows all the blocks in the current buffer.
1115 1115
1116---
1117*** 'hs-hide-level' no longer hide all the blocks in the current buffer.
1118If 'hs-hide-level' was not inside a code block it would hide all the
1119blocks in the buffer like 'hs-hide-all'. Now it should only hide all
1120the second level blocks.
1121
1116+++ 1122+++
1117*** New user option 'hs-display-lines-hidden'. 1123*** New user option 'hs-display-lines-hidden'.
1118If this option is non-nil, Hideshow displays the number of hidden lines 1124If this option is non-nil, Hideshow displays the number of hidden lines
@@ -1155,7 +1161,7 @@ after cursor position. By default this is set to 'after-bol'.
1155This user option controls the positions on the headline of hideable blocks 1161This user option controls the positions on the headline of hideable blocks
1156where the 'TAB' key cycles the blocks' visibility. 1162where the 'TAB' key cycles the blocks' visibility.
1157 1163
1158+++ 1164---
1159*** The variable 'hs-special-modes-alist' is now obsolete. 1165*** The variable 'hs-special-modes-alist' is now obsolete.
1160Instead of customizing Hideshow for a mode by setting the elements of 1166Instead of customizing Hideshow for a mode by setting the elements of
1161'hs-special-modes-alist', such as START, COMMENT-START, 1167'hs-special-modes-alist', such as START, COMMENT-START,
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index e916d2091c5..886bd7505aa 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -1,12 +1,12 @@
1;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks -*- lexical-binding:t -*- 1;;; hideshow.el --- Minor mode to hide/show comment or code blocks -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1994-2025 Free Software Foundation, Inc. 3;; Copyright (C) 1994-2025 Free Software Foundation, Inc.
4 4
5;; Author: Thien-Thi Nguyen <ttn@gnu.org> 5;; Author: Thien-Thi Nguyen <ttn@gnu.org>
6;; Dan Nicolaescu <dann@gnu.org> 6;; Dan Nicolaescu <dann@gnu.org>
7;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines 7;; Maintainer: emacs-devel@gnu.org
8;; Maintainer-Version: 5.65.2.2 8;; Keywords: c tools outlines
9;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning 9;; Maintainer-Version: 6.0
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12 12
@@ -27,17 +27,16 @@
27 27
28;; * Commands provided 28;; * Commands provided
29;; 29;;
30;; This file provides the Hideshow minor mode. When active, nine commands 30;; This file provides the Hideshow minor mode, it includes the
31;; are available, implementing block hiding and showing. They (and their 31;; following commands (and their keybindings) to hiding and showing
32;; keybindings) are: 32;; code and comment blocks:
33;; 33;;
34;; `hs-hide-block' C-c @ C-h 34;; `hs-hide-block' C-c @ C-h/C-d
35;; `hs-show-block' C-c @ C-s 35;; `hs-show-block' C-c @ C-s
36;; `hs-hide-all' C-c @ C-M-h 36;; `hs-hide-all' C-c @ C-M-h/C-t
37;; `hs-show-all' C-c @ C-M-s 37;; `hs-show-all' C-c @ C-M-s/C-a
38;; `hs-hide-level' C-c @ C-l 38;; `hs-hide-level' C-c @ C-l
39;; `hs-toggle-hiding' C-c @ C-c 39;; `hs-toggle-hiding' C-c @ C-c/C-e or S-<mouse-2>
40;; `hs-toggle-hiding' S-<mouse-2>
41;; `hs-hide-initial-comment-block' 40;; `hs-hide-initial-comment-block'
42;; `hs-cycle' C-c @ TAB 41;; `hs-cycle' C-c @ TAB
43;; `hs-toggle-all' C-c @ <backtab> 42;; `hs-toggle-all' C-c @ <backtab>
@@ -45,13 +44,14 @@
45;; All these commands are defined in `hs-prefix-map', 44;; All these commands are defined in `hs-prefix-map',
46;; `hs-minor-mode-map' and `hs-indicators-map'. 45;; `hs-minor-mode-map' and `hs-indicators-map'.
47;; 46;;
48;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they 47;; Blocks are defined per mode. For example, in c-mode and similar,
49;; are simply text between curly braces, while in Lisp-ish modes parens 48;; they are simply text between curly braces, while in Lisp-ish modes
50;; are used. Multi-line comment blocks can also be hidden. Read-only 49;; parens are used. Multi-line comment blocks can also be hidden.
51;; buffers are not a problem, since hideshow doesn't modify the text. 50;; Read-only buffers are not a problem, since hideshow doesn't modify
51;; the text.
52;; 52;;
53;; The command `M-x hs-minor-mode' toggles the minor mode or sets it 53;; The command `M-x hs-minor-mode' toggles the minor mode or sets it
54;; (similar to other minor modes). 54;; buffer-local.
55 55
56;; * Suggested usage 56;; * Suggested usage
57;; 57;;
@@ -60,6 +60,9 @@
60;; (require 'hideshow) 60;; (require 'hideshow)
61;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly 61;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly
62;; 62;;
63;; ;; For use-package users:
64;; (use-package hideshow :hook (X-mode . hs-minor-mode))
65;;
63;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle 66;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle
64;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is 67;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is
65;; activated or deactivated, `hs-minor-mode-hook' is run with `run-hooks'. 68;; activated or deactivated, `hs-minor-mode-hook' is run with `run-hooks'.
@@ -78,40 +81,46 @@
78;; (if my-hs-hide 81;; (if my-hs-hide
79;; (hs-hide-all) 82;; (hs-hide-all)
80;; (hs-show-all))) 83;; (hs-show-all)))
81;;
82;; [Your hideshow hacks here!]
83 84
84;; * Customization 85;; * Customization
85;; 86;;
86;; You can use `M-x customize-variable' on the following variables: 87;; Hideshow provides the following user options:
87;; 88;;
88;; - `hs-hide-comments-when-hiding-all' -- self-explanatory! 89;; - `hs-hide-comments-when-hiding-all'
89;; - `hs-hide-all-non-comment-function' -- if non-nil, when doing a 90;; self-explanatory!
90;; `hs-hide-all', this function 91;; - `hs-hide-all-non-comment-function'
91;; is called with no arguments 92;; If non-nil, after calling `hs-hide-all', this function is called
92;; - `hs-isearch-open' -- what kind of hidden blocks to 93;; with no arguments.
93;; open when doing isearch 94;; - `hs-isearch-open'
94;; - `hs-display-lines-hidden' -- displays the number of hidden 95;; What kind of hidden blocks to open when doing isearch.
95;; lines next to the ellipsis. 96;; - `hs-set-up-overlay'
96;; - `hs-show-indicators' -- display indicators to show 97;; Function called with one arg (an overlay), intended to customize
97;; and toggle the block hiding. 98;; the block hiding appearance.
98;; - `hs-indicator-type' -- which indicator type should be 99;; - `hs-display-lines-hidden'
99;; used for the block indicators. 100;; Displays the number of hidden lines next to the ellipsis.
100;; - `hs-indicator-maximum-buffer-size' -- max buffer size in bytes where 101;; - `hs-show-indicators'
101;; the indicators should be enabled. 102;; Display indicators to show and toggle the block hiding.
103;; - `hs-indicator-type'
104;; Which indicator type should be used for the block indicators.
105;; - `hs-indicator-maximum-buffer-size'
106;; Max buffer size in bytes where the indicators should be enabled.
107;; - `hs-allow-nesting'
108;; If non-nil, hiding remembers internal blocks.
109;; - `hs-cycle-filter'
110;; Control where typing a `TAB' cycles the visibility.
102;; 111;;
103;; Some languages (e.g., Java) are deeply nested, so the normal behavior 112;; The variable `hs-hide-all-non-comment-function' may be useful if you
104;; of `hs-hide-all' (hiding all but top-level blocks) results in very 113;; only want to hide some N levels blocks for some languages/files or
105;; little information shown, which is not very useful. You can use the 114;; implement your idea of what is more useful. For example, the
106;; variable `hs-hide-all-non-comment-function' to implement your idea of 115;; following code shows the next nested level in addition to the
107;; what is more useful. For example, the following code shows the next 116;; top-level for java:
108;; nested level in addition to the top-level:
109;; 117;;
110;; (defun ttn-hs-hide-level-1 () 118;; (defun ttn-hs-hide-level-2 ()
111;; (when (funcall hs-looking-at-block-start-predicate) 119;; (when (funcall hs-looking-at-block-start-predicate)
112;; (hs-hide-level 1)) 120;; (hs-hide-level 2)))
113;; (forward-sexp 1)) 121;; (setq-mode-local java-mode ; This requires the mode-local package
114;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1) 122;; hs-hide-all-non-comment-function
123;; 'ttn-hs-hide-level-2)
115;; 124;;
116;; Hideshow works with incremental search (isearch) by setting the variable 125;; Hideshow works with incremental search (isearch) by setting the variable
117;; `hs-headline', which is the line of text at the beginning of a hidden 126;; `hs-headline', which is the line of text at the beginning of a hidden
@@ -123,30 +132,25 @@
123;; (setq mode-line-format 132;; (setq mode-line-format
124;; (append '("-" hs-headline) mode-line-format))) 133;; (append '("-" hs-headline) mode-line-format)))
125;; 134;;
126;; See documentation for `mode-line-format' for more info.
127;; 135;;
128;; Hooks are run after some commands: 136;; The following hooks are run after some commands:
129;; 137;;
130;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level 138;; hs-hide-hook => hs-hide-block hs-hide-all hs-hide-level hs-cycle
131;; hs-show-hook hs-show-block, hs-show-all 139;; hs-show-hook => hs-show-block hs-show-all hs-cycle
132;; 140;;
133;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling 141;; The variable `hs-set-up-overlay' allow customize the appearance of
134;; commands when the result of the toggle is to hide or show blocks, 142;; the hidden block and other effects associated with overlays. For
135;; respectively. All hooks are run with `run-hooks'. See the 143;; example:
136;; documentation for each variable or hook for more information.
137;; 144;;
138;; See also variable `hs-set-up-overlay' for per-block customization of 145;; (setopt hs-set-up-overlay
139;; appearance or other effects associated with overlays. For example: 146;; (defun my-display-code-line-counts (ov)
140;; 147;; (when (eq 'code (overlay-get ov 'hs))
141;; (setq hs-set-up-overlay 148;; (overlay-put ov 'display
142;; (defun my-display-code-line-counts (ov) 149;; (propertize
143;; (when (eq 'code (overlay-get ov 'hs)) 150;; (format " [... <%d>] "
144;; (overlay-put ov 'display 151;; (count-lines (overlay-start ov)
145;; (propertize 152;; (overlay-end ov)))
146;; (format " ... <%d>" 153;; 'face 'font-lock-type-face)))))
147;; (count-lines (overlay-start ov)
148;; (overlay-end ov)))
149;; 'face 'font-lock-type-face)))))
150 154
151;; * Extending hideshow 155;; * Extending hideshow
152 156
@@ -207,45 +211,39 @@
207 211
208;; * Bugs 212;; * Bugs
209;; 213;;
210;; (1) Sometimes `hs-headline' can become out of sync. To reset, type 214;; 1) Sometimes `hs-headline' can become out of sync. To reset, type
211;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate 215;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate
212;; hideshow). 216;; hideshow).
213;; 217;;
214;; (2) Some buffers can't be `byte-compile-file'd properly. This is because 218;; 2) Some buffers can't be `byte-compile-file'd properly. This is because
215;; `byte-compile-file' inserts the file to be compiled in a temporary 219;; `byte-compile-file' inserts the file to be compiled in a temporary
216;; buffer and switches `normal-mode' on. In the case where you have 220;; buffer and switches `normal-mode' on. In the case where you have
217;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding of 221;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding of
218;; the initial comment sometimes hides parts of the first statement (seems 222;; the initial comment sometimes hides parts of the first statement (seems
219;; to be only in `normal-mode'), so there are unbalanced "(" and ")". 223;; to be only in `normal-mode'), so there are unbalanced parenthesis.
220;; 224;;
221;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling: 225;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling:
222;; 226;;
223;; (defadvice byte-compile-file (around 227;; (define-advice byte-compile-file (:around
224;; byte-compile-file-hideshow-off 228;; (fn &rest rest)
225;; act) 229;; byte-compile-file-hideshow-off)
226;; (let ((hs-minor-mode-hook nil)) 230;; (let (hs-minor-mode-hook)
227;; ad-do-it)) 231;; (apply #'fn rest)))
228;; 232;;
229;; (3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, the 233;; 3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, the
230;; suggested workaround is to turn off hideshow entirely, for example: 234;; suggested workaround is to turn off hideshow entirely, for example:
231;; 235;;
232;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow) 236;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow)
233;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow) 237;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow)
234;; 238;;
235;; In the case of `vc-diff', here is a less invasive workaround: 239;; In the case of `vc-diff', here is a less invasive workaround:
236;; 240;;
237;; (add-hook 'vc-before-checkin-hook 241;; (add-hook 'vc-before-checkin-hook
238;; (lambda () 242;; (lambda ()
239;; (goto-char (point-min)) 243;; (goto-char (point-min))
240;; (hs-show-block))) 244;; (hs-show-block)))
241;; 245;;
242;; Unfortunately, these workarounds do not restore hideshow state. 246;; Unfortunately, these workarounds do not restore hideshow state.
243;; If someone figures out a better way, please let me know.
244
245;; * Correspondence
246;;
247;; Correspondence welcome; please indicate version number. Send bug
248;; reports and inquiries to <ttn@gnu.org>.
249 247
250;; * Thanks 248;; * Thanks
251;; 249;;
@@ -264,7 +262,7 @@
264;; mouse support, and maintained the code in general. Version 4.0 is 262;; mouse support, and maintained the code in general. Version 4.0 is
265;; largely due to his efforts. 263;; largely due to his efforts.
266 264
267;; * History 265;; * History (author commentary)
268;; 266;;
269;; Hideshow was inspired when I learned about selective display. It was 267;; Hideshow was inspired when I learned about selective display. It was
270;; reimplemented to use overlays for 4.0 (see above). WRT older history, 268;; reimplemented to use overlays for 4.0 (see above). WRT older history,
@@ -276,19 +274,23 @@
276;; unbundles state save and restore, and includes more isearch support. 274;; unbundles state save and restore, and includes more isearch support.
277 275
278;;; Code: 276;;; Code:
277
278
279;;;; Libraries
280
279(require 'mule-util) ; For `truncate-string-ellipsis' 281(require 'mule-util) ; For `truncate-string-ellipsis'
280;; For indicators 282;; For indicators
281(require 'icons) 283(require 'icons)
282(require 'fringe) 284(require 'fringe)
283 285
284;;--------------------------------------------------------------------------- 286
285;; user-configurable variables
286
287(defgroup hideshow nil 287(defgroup hideshow nil
288 "Minor mode for hiding and showing program and comment blocks." 288 "Minor mode for hiding and showing program and comment blocks."
289 :prefix "hs-" 289 :prefix "hs-"
290 :group 'languages) 290 :group 'languages)
291 291
292;;;; Faces
293
292(defface hs-ellipsis 294(defface hs-ellipsis
293 '((t :height 0.80 :box (:line-width -1) :inherit (shadow default))) 295 '((t :height 0.80 :box (:line-width -1) :inherit (shadow default)))
294 "Face used for hideshow ellipsis. 296 "Face used for hideshow ellipsis.
@@ -306,6 +308,22 @@ use that face for the ellipsis instead."
306 "Face used in hideshow indicator to indicate a shown block." 308 "Face used in hideshow indicator to indicate a shown block."
307 :version "31.1") 309 :version "31.1")
308 310
311;;;; Options
312
313(defcustom hs-hide-hook nil
314 "Hook called (with `run-hooks') at the end of commands to hide text.
315These commands include the toggling commands (when the result is to hide
316a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'."
317 :type 'hook
318 :version "31.1")
319
320(defcustom hs-show-hook nil
321 "Hook called (with `run-hooks') at the end of commands to show text.
322These commands include the toggling commands (when the result is to show
323a block), `hs-show-all' and `hs-show-block'."
324 :type 'hook
325 :version "31.1")
326
309(defcustom hs-hide-comments-when-hiding-all t 327(defcustom hs-hide-comments-when-hiding-all t
310 "Hide the comments too when you do an `hs-hide-all'." 328 "Hide the comments too when you do an `hs-hide-all'."
311 :type 'boolean) 329 :type 'boolean)
@@ -385,54 +403,6 @@ size."
385 :type '(choice natnum (const :tag "No limit" nil)) 403 :type '(choice natnum (const :tag "No limit" nil))
386 :version "31.1") 404 :version "31.1")
387 405
388(define-fringe-bitmap
389 'hs-hide
390 [#b0000000
391 #b1000001
392 #b1100011
393 #b0110110
394 #b0011100
395 #b0001000
396 #b0000000])
397
398(define-fringe-bitmap
399 'hs-show
400 [#b0110000
401 #b0011000
402 #b0001100
403 #b0000110
404 #b0001100
405 #b0011000
406 #b0110000])
407
408(define-icon hs-indicator-hide nil
409 `((image "outline-open.svg" "outline-open.pbm"
410 :face hs-indicator-hide
411 :height (0.6 . em)
412 :ascent center)
413 (symbol "▾" "▼" :face hs-indicator-hide)
414 (text "-" :face hs-indicator-hide))
415 "Icon used for hide block at point.
416This is only used if `hs-indicator-type' is set to `margin' or nil."
417 :version "31.1")
418
419(define-icon hs-indicator-show nil
420 `((image "outline-close.svg" "outline-close.pbm"
421 :face hs-indicator-show
422 :height (0.6 . em)
423 :ascent center)
424 (symbol "▸" "▶" :face hs-indicator-show)
425 (text "+" :face hs-indicator-show))
426 "Icon used for show block at point.
427This is only used if `hs-indicator-type' is set to `margin' or nil."
428 :version "31.1")
429
430;;;###autoload
431(defvar hs-special-modes-alist nil)
432(make-obsolete-variable 'hs-special-modes-alist
433 "use the buffer-local variables instead"
434 "31.1")
435
436(defcustom hs-allow-nesting nil 406(defcustom hs-allow-nesting nil
437 "If non-nil, hiding remembers internal blocks. 407 "If non-nil, hiding remembers internal blocks.
438This means that when the outer block is shown again, 408This means that when the outer block is shown again,
@@ -440,16 +410,6 @@ any previously hidden internal blocks remain hidden."
440 :type 'boolean 410 :type 'boolean
441 :version "31.1") 411 :version "31.1")
442 412
443(defvar hs-hide-hook nil
444 "Hook called (with `run-hooks') at the end of commands to hide text.
445These commands include the toggling commands (when the result is to hide
446a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
447
448(defvar hs-show-hook nil
449 "Hook called (with `run-hooks') at the end of commands to show text.
450These commands include the toggling commands (when the result is to show
451a block), `hs-show-all' and `hs-show-block'.")
452
453(defcustom hs-set-up-overlay #'ignore 413(defcustom hs-set-up-overlay #'ignore
454 "Function called with one arg, OV, a newly initialized overlay. 414 "Function called with one arg, OV, a newly initialized overlay.
455Hideshow puts a unique overlay on each range of text to be hidden 415Hideshow puts a unique overlay on each range of text to be hidden
@@ -495,12 +455,52 @@ major mode, elsewhere on the headlines."
495 (function :tag "Custom filter function")) 455 (function :tag "Custom filter function"))
496 :version "31.1") 456 :version "31.1")
497 457
498;;--------------------------------------------------------------------------- 458;;;; Icons
499;; internal variables 459
460(define-icon hs-indicator-hide nil
461 `((image "outline-open.svg" "outline-open.pbm"
462 :face hs-indicator-hide
463 :height (0.6 . em)
464 :ascent center)
465 (symbol "▾" "▼" :face hs-indicator-hide)
466 (text "-" :face hs-indicator-hide))
467 "Icon used for hide block at point.
468This is only used if `hs-indicator-type' is set to `margin' or nil."
469 :version "31.1")
500 470
501(defvar hs-minor-mode nil 471(define-icon hs-indicator-show nil
502 "Non-nil if using hideshow mode as a minor mode of some other mode. 472 `((image "outline-close.svg" "outline-close.pbm"
503Use the command `hs-minor-mode' to toggle or set this variable.") 473 :face hs-indicator-show
474 :height (0.6 . em)
475 :ascent center)
476 (symbol "▸" "▶" :face hs-indicator-show)
477 (text "+" :face hs-indicator-show))
478 "Icon used for show block at point.
479This is only used if `hs-indicator-type' is set to `margin' or nil."
480 :version "31.1")
481
482(define-fringe-bitmap
483 'hs-hide
484 [#b0000000
485 #b1000001
486 #b1100011
487 #b0110110
488 #b0011100
489 #b0001000
490 #b0000000])
491
492(define-fringe-bitmap
493 'hs-show
494 [#b0110000
495 #b0011000
496 #b0001100
497 #b0000110
498 #b0001100
499 #b0011000
500 #b0110000])
501
502
503;;;; Keymaps
504 504
505(defvar-keymap hs-prefix-map 505(defvar-keymap hs-prefix-map
506 :doc "Keymap for hideshow commands." 506 :doc "Keymap for hideshow commands."
@@ -530,8 +530,8 @@ Use the command `hs-minor-mode' to toggle or set this variable.")
530 (when (and hs-cycle-filter 530 (when (and hs-cycle-filter
531 ;; On the headline with hideable blocks 531 ;; On the headline with hideable blocks
532 (save-excursion 532 (save-excursion
533 (goto-char (line-beginning-position)) 533 (forward-line 0)
534 (hs-get-first-block)) 534 (hs-get-first-block-on-line))
535 (or (not (functionp hs-cycle-filter)) 535 (or (not (functionp hs-cycle-filter))
536 (funcall hs-cycle-filter))) 536 (funcall hs-cycle-filter)))
537 cmd))) 537 cmd)))
@@ -563,7 +563,7 @@ Use the command `hs-minor-mode' to toggle or set this variable.")
563 (not hs-hide-comments-when-hiding-all)) 563 (not hs-hide-comments-when-hiding-all))
564 :help "If t also hide comment blocks when doing `hs-hide-all'" 564 :help "If t also hide comment blocks when doing `hs-hide-all'"
565 :style toggle :selected hs-hide-comments-when-hiding-all] 565 :style toggle :selected hs-hide-comments-when-hiding-all]
566 ("Reveal on isearch" 566 ("Reveal on isearch"
567 ["Code blocks" (setq hs-isearch-open 'code) 567 ["Code blocks" (setq hs-isearch-open 'code)
568 :help "Show hidden code blocks when isearch matches inside them" 568 :help "Show hidden code blocks when isearch matches inside them"
569 :active t :style radio :selected (eq hs-isearch-open 'code)] 569 :active t :style radio :selected (eq hs-isearch-open 'code)]
@@ -579,13 +579,18 @@ Show both hidden code and comment blocks when isearch matches inside them"
579Do not show hidden code or comment blocks when isearch matches inside them" 579Do not show hidden code or comment blocks when isearch matches inside them"
580 :active t :style radio :selected (eq hs-isearch-open nil)]))) 580 :active t :style radio :selected (eq hs-isearch-open nil)])))
581 581
582
583;;;; Internal variables
584
585(defvar hs-minor-mode)
586
582(defvar hs-hide-all-non-comment-function nil 587(defvar hs-hide-all-non-comment-function nil
583 "Function called if non-nil when doing `hs-hide-all' for non-comments.") 588 "Function called if non-nil when doing `hs-hide-all' for non-comments.")
584 589
585(defvar hs-headline nil 590(defvar hs-headline nil
586 "Text of the line where a hidden block begins, set during isearch. 591 "Text of the line where a hidden block begins, set during isearch.
587You can display this in the mode line by adding the symbol `hs-headline' 592You can display this in the mode line by adding the symbol `hs-headline'
588to the variable `mode-line-format'. For example, 593to the variable `mode-line-format'. For example:
589 594
590 (unless (memq \\='hs-headline mode-line-format) 595 (unless (memq \\='hs-headline mode-line-format)
591 (setq mode-line-format 596 (setq mode-line-format
@@ -593,21 +598,32 @@ to the variable `mode-line-format'. For example,
593 598
594Note that `mode-line-format' is buffer-local.") 599Note that `mode-line-format' is buffer-local.")
595 600
601;; Used in `hs-toggle-all'
596(defvar-local hs--toggle-all-state) 602(defvar-local hs--toggle-all-state)
597 603
598;;--------------------------------------------------------------------------- 604
599;; API variables 605;;;; API variables
606
607;;;###autoload
608(defvar hs-special-modes-alist nil)
609(make-obsolete-variable
610 'hs-special-modes-alist
611 "use the buffer-local variables instead" "31.1")
600 612
601(defvar-local hs-block-start-regexp "\\s(" 613(defvar-local hs-block-start-regexp "\\s("
602 "Regexp for beginning of block.") 614 "Regexp for beginning of block.")
603 615
616;; This is useless, so probably should be deprecated.
604(defvar-local hs-block-start-mdata-select 0 617(defvar-local hs-block-start-mdata-select 0
605 "Element in `hs-block-start-regexp' match data to consider as block start. 618 "Element in `hs-block-start-regexp' match data to consider as block start.
606The internal function `hs-forward-sexp' moves point to the beginning of this 619The internal function `hs-forward-sexp' moves point to the beginning of this
607element (using `match-beginning') before calling `hs-forward-sexp-function'.") 620element (using `match-beginning') before calling `hs-forward-sexp-function'.")
608 621
609(defvar-local hs-block-end-regexp "\\s)" 622(defvar-local hs-block-end-regexp "\\s)"
610 "Regexp for end of block.") 623 "Regexp for end of block.
624As a special case, the value can be also a function without arguments to
625determine if point is looking at the end of the block, and return
626non-nil and set `match-data' to that block end positions.")
611 627
612(defvar-local hs-c-start-regexp nil 628(defvar-local hs-c-start-regexp nil
613 "Regexp for beginning of comments. 629 "Regexp for beginning of comments.
@@ -619,46 +635,35 @@ any trailing whitespace.")
619 635
620(define-obsolete-variable-alias 636(define-obsolete-variable-alias
621 'hs-forward-sexp-func 637 'hs-forward-sexp-func
622 'hs-forward-sexp-function 638 'hs-forward-sexp-function "31.1")
623 "31.1")
624 639
625(defvar-local hs-forward-sexp-function #'forward-sexp 640(defvar-local hs-forward-sexp-function #'forward-sexp
626 "Function used to do a `forward-sexp'. 641 "Function used to do a `forward-sexp'.
642It is called with 1 argument (like `forward-sexp').
643
627Should change for Algol-ish modes. For single-character block 644Should change for Algol-ish modes. For single-character block
628delimiters -- ie, the syntax table regexp for the character is 645delimiters such as `(' and `)' `hs-forward-sexp-function' would just be
629either `(' or `)' -- `hs-forward-sexp-function' would just be
630`forward-sexp'. For other modes such as simula, a more specialized 646`forward-sexp'. For other modes such as simula, a more specialized
631function is necessary.") 647function is necessary.")
632 648
633(define-obsolete-variable-alias 649(define-obsolete-variable-alias
634 'hs-adjust-block-beginning 650 'hs-adjust-block-beginning
635 'hs-adjust-block-beginning-function 651 'hs-adjust-block-beginning-function "31.1")
636 "31.1")
637 652
638(defvar-local hs-adjust-block-beginning-function nil 653(defvar-local hs-adjust-block-beginning-function nil
639 "Function used to tweak the block beginning. 654 "Function used to tweak the block beginning.
640The block is hidden from the position returned by this function, 655It should return the position from where we should start hiding, as
641as opposed to hiding it from the position returned when searching 656opposed to hiding it from the position returned when searching for
642for `hs-block-start-regexp'. 657`hs-block-start-regexp'.
643
644For example, in c-like modes, if we wish to also hide the curly braces
645\(if you think they occupy too much space on the screen), this function
646should return the starting point (at the end of line) of the hidden
647region.
648 658
649It is called with a single argument ARG which is the position in 659It is called with a single argument ARG which is the position in
650buffer after the block beginning. 660buffer after the block beginning.")
651
652It should return the position from where we should start hiding.
653
654It should not move the point.
655
656See `hs-c-like-adjust-block-beginning' for an example of using this.")
657 661
658(defvar-local hs-adjust-block-end-function nil 662(defvar-local hs-adjust-block-end-function nil
659 "Function used to tweak the block end. 663 "Function used to tweak the block end.
660This is useful to ensure some characters such as parenthesis or curly 664This is useful to ensure some characters such as parenthesis or curly
661braces get properly hidden in python-like modes. 665braces get properly hidden in modes without parenthesis pairs
666delimiters (such as python).
662 667
663It is called with one argument, which is the start position where the 668It is called with one argument, which is the start position where the
664overlay will be created, and should return either the last position to 669overlay will be created, and should return either the last position to
@@ -669,7 +674,8 @@ hide or nil. If it returns nil, hideshow will guess the end position.")
669 'hs-find-block-beginning-function 674 'hs-find-block-beginning-function
670 "31.1") 675 "31.1")
671 676
672(defvar-local hs-find-block-beginning-function #'hs-find-block-beginning 677(defvar-local hs-find-block-beginning-function
678 #'hs-find-block-beg-fn--default
673 "Function used to do `hs-find-block-beginning'. 679 "Function used to do `hs-find-block-beginning'.
674It should reposition point at the beginning of the current block 680It should reposition point at the beginning of the current block
675and return point, or nil if original point was not in a block. 681and return point, or nil if original point was not in a block.
@@ -683,30 +689,32 @@ to find the beginning of the current block.")
683 'hs-find-next-block-function 689 'hs-find-next-block-function
684 "31.1") 690 "31.1")
685 691
686(defvar-local hs-find-next-block-function #'hs-find-next-block 692(defvar-local hs-find-next-block-function
693 #'hs-find-next-block-fn--default
687 "Function used to do `hs-find-next-block'. 694 "Function used to do `hs-find-next-block'.
688It should reposition point at next block start. 695It should reposition point at next block start.
689 696
690It is called with three arguments REGEXP, MAXP, and COMMENTS. 697It is called with three arguments REGEXP, BOUND, and COMMENTS.
691REGEXP is a regexp representing block start. When block start is 698REGEXP is a regexp representing block start. When block start is found,
692found, `match-data' should be set using REGEXP. MAXP is a buffer 699`match-data' should be set using REGEXP. BOUND is a buffer position
693position that limits the search. When COMMENTS is nil, comments 700that limits the search. When COMMENTS is non-nil, REGEXP matches not
694should be skipped. When COMMENTS is not nil, REGEXP matches not 701only beginning of a block but also beginning of a comment. In this
695only beginning of a block but also beginning of a comment. In 702case, the function should find nearest block or comment.
696this case, the function should find nearest block or comment.
697 703
698Specifying this function is necessary for languages such as 704Specifying this function is necessary for languages such as Python,
699Python, where regexp search is not enough to find the beginning 705where regexp search is not enough to find the beginning of the next
700of the next block.") 706block.")
701 707
702(define-obsolete-variable-alias 708(define-obsolete-variable-alias
703 'hs-looking-at-block-start-p-func 709 'hs-looking-at-block-start-p-func
704 'hs-looking-at-block-start-predicate 710 'hs-looking-at-block-start-predicate
705 "31.1") 711 "31.1")
706 712
707(defvar-local hs-looking-at-block-start-predicate #'hs-looking-at-block-start-p 713(defvar-local hs-looking-at-block-start-predicate
714 #'hs-looking-at-block-start-p--default
708 "Function used to do `hs-looking-at-block-start-p'. 715 "Function used to do `hs-looking-at-block-start-p'.
709It should return non-nil if the point is at the block start. 716It should return non-nil if the point is at the block start and set
717match data with the beginning and end of that position.
710 718
711Specifying this function is necessary for languages such as 719Specifying this function is necessary for languages such as
712Python, where `looking-at' and `syntax-ppss' check is not enough 720Python, where `looking-at' and `syntax-ppss' check is not enough
@@ -716,47 +724,232 @@ to check if the point is at the block start.")
716 "Function used to check if point is inside a comment. 724 "Function used to check if point is inside a comment.
717If point is inside a comment, the function should return a list 725If point is inside a comment, the function should return a list
718containing the buffer position of the start and the end of the 726containing the buffer position of the start and the end of the
719comment, otherwise it should return nil. 727comment, otherwise it should return nil.")
720
721A comment block can be hidden only if on its starting line there is only
722whitespace preceding the actual comment beginning. If point is inside
723a comment but this condition is not met, the function can return a list
724having nil as its `car' and the end of comment position as its `cdr'.")
725 728
726(defvar-local hs-treesit-things 'list 729(defvar-local hs-treesit-things 'list
727 "Treesit things to check if point is at a valid block. 730 "Treesit things to check if point is at a valid block.
728The value should be a thing defined in `treesit-thing-settings' for the 731The value should be a thing defined in `treesit-thing-settings' for the
729current buffer's major mode.") 732current buffer's major mode.")
730 733
731;;--------------------------------------------------------------------------- 734
732;; support functions 735;;;; API functions
736
737(defmacro hs-life-goes-on (&rest body)
738 "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
739In the dynamic context of this macro, `case-fold-search' is t.
733 740
734(defun hs-discard-overlays (from to) 741This macro encloses BODY in `save-match-data' and `save-excursion'.
735 "Delete hideshow overlays in region defined by FROM and TO. 742
743Intended to be used for commands."
744 (declare (debug t))
745 `(when hs-minor-mode
746 (let ((case-fold-search t))
747 (save-match-data
748 (save-excursion ,@body)))))
749
750(defun hs-discard-overlays (beg end)
751 "Delete hideshow overlays in region defined by BEG and END.
736Skip \"internal\" overlays if `hs-allow-nesting' is non-nil." 752Skip \"internal\" overlays if `hs-allow-nesting' is non-nil."
737 (when (< to from) 753 (when (< end beg)
738 (setq from (prog1 to (setq to from)))) 754 (setq beg (prog1 end (setq end beg))))
739 (if hs-allow-nesting 755 (if hs-allow-nesting
740 (let ((from from) ov) 756 (let ((beg beg))
741 (while (> to (setq from (next-overlay-change from))) 757 (while (> end (setq beg (next-overlay-change beg)))
742 (when (setq ov (hs-overlay-at from)) 758 (when-let* ((ov (hs-overlay-at beg)))
743 (setq from (overlay-end ov)) 759 ;; Reposition point to the end of the overlay, so we avoid
760 ;; removing the nested overlays too.
761 (setq beg (overlay-end ov))
744 (delete-overlay ov)))) 762 (delete-overlay ov))))
745 (dolist (ov (overlays-in from to)) 763 (remove-overlays beg end 'invisible 'hs))
746 (when (overlay-get ov 'hs) 764 (hs--refresh-indicators beg end))
747 (delete-overlay ov)))) 765
748 (hs--refresh-indicators from to)) 766(defun hs-overlay-at (position)
749 767 "Return hideshow overlay at POSITION, or nil if none to be found."
750(defun hs-hideable-region-p (&optional beg end) 768 (seq-find
751 "Return t if region between BEG and END can be hidden. 769 (lambda (ov) (overlay-get ov 'hs))
752If BEG and END are not specified, try to check the current 770 (overlays-at position)))
753block at point." 771
772(defun hs-hideable-region-p (beg end)
773 "Return t if region between BEG and END can be hidden."
754 ;; Check if BEG and END are not in the same line number, 774 ;; Check if BEG and END are not in the same line number,
755 ;; since using `count-lines' is slow. 775 ;; since using `count-lines' is slow.
756 (if (and beg end) 776 (and beg end
757 (< beg (save-excursion (goto-char end) (line-beginning-position))) 777 (< beg (save-excursion (goto-char end) (pos-bol)))))
758 (when-let* ((block (hs-block-positions))) 778
759 (apply #'hs-hideable-region-p block)))) 779(defun hs-already-hidden-p ()
780 "Return non-nil if point is in an already-hidden block, otherwise nil."
781 (save-excursion
782 ;; Reposition point if it is inside a comment, and if that comment
783 ;; is hideable
784 (when-let* ((c-reg (funcall hs-inside-comment-predicate)))
785 (goto-char (car c-reg)))
786 ;; Search for a hidden block at EOL ...
787 (eq 'hs
788 (or (get-char-property (pos-eol) 'invisible)
789 ;; ... or behind the current cursor position
790 (get-char-property (if (bobp) (point) (1- (point)))
791 'invisible)))))
792
793(defun hs-block-positions (&optional adjust-beg adjust-end)
794 "Return the current code block positions.
795This returns a list with the current code block beginning and end
796positions. This does nothing if there is not a code block at current
797point.
798
799If either ADJUST-BEG or ADJUST-END are non-nil, adjust block positions
800according to `hs-adjust-block-beginning', `hs-adjust-block-end-function'
801and `hs-block-end-regexp'."
802 ;; `catch' is used here if the search fails due unbalanced parentheses
803 ;; or any other unknown error caused in `hs-forward-sexp-function'.
804 (catch 'hs--block-exit
805 (save-match-data
806 (save-excursion
807 (when (funcall hs-looking-at-block-start-predicate)
808 (let ((beg (match-end 0)) end)
809 ;; `beg' is the point at the end of the block
810 ;; beginning, which may need to be adjusted
811 (when adjust-beg
812 (save-excursion
813 (when hs-adjust-block-beginning-function
814 (goto-char (funcall hs-adjust-block-beginning-function beg)))
815 (setq beg (pos-eol))))
816
817 (goto-char (match-beginning hs-block-start-mdata-select))
818 (condition-case _
819 (funcall hs-forward-sexp-function 1)
820 (scan-error (throw 'hs-sexp-error nil)))
821 ;; `end' is the point at the end of the block
822 (setq end (cond ((not adjust-end) (point))
823 ((and (stringp hs-block-end-regexp)
824 (looking-back hs-block-end-regexp nil))
825 (match-beginning 0))
826 ((functionp hs-block-end-regexp)
827 (funcall hs-block-end-regexp)
828 (match-beginning 0))
829 (t (point))))
830 ;; adjust block end (if needed)
831 (when (and adjust-end hs-adjust-block-end-function)
832 (setq end (or (funcall hs-adjust-block-end-function beg)
833 end)))
834 (list beg end)))))))
835
836(defun hs-hide-comment-region (beg end &optional _repos-end)
837 "Hide a region from BEG to END, marking it as a comment.
838Optional arg REPOS-END means reposition at end."
839 (declare (obsolete "Use `hs-hide-block-at-point' instead." "31.1"))
840 (hs-hide-block-at-point (list beg end)))
841
842(defun hs-hide-block-at-point (&optional comment-reg)
843 "Hide block if on block beginning.
844Optional arg COMMENT-REG is a list of the form (BEGIN END) and
845specifies the limits of the comment, or nil if the block is not
846a comment.
847
848If hiding the block is successful, return non-nil.
849Otherwise, return nil."
850 (when-let* ((block (or comment-reg (hs-block-positions :a-beg :a-end))))
851 (let ((beg (if comment-reg (save-excursion (goto-char (car block)) (pos-eol))
852 (car block)))
853 (end (cadr block))
854 ov)
855 (if (hs-hideable-region-p beg end)
856 (progn
857 (cond (comment-reg (let (hs-allow-nesting)
858 (hs-discard-overlays beg end)))
859 ((and hs-allow-nesting (setq ov (hs-overlay-at beg)))
860 (delete-overlay ov))
861 ((not hs-allow-nesting)
862 (hs-discard-overlays beg end)))
863 (goto-char end)
864 (hs-make-overlay beg end (if comment-reg 'comment 'code)))
865 (when comment-reg (goto-char end))
866 nil))))
867
868(defun hs-get-first-block-on-line (&optional include-comments)
869 "Reposition point to the first valid block found on the current line.
870This searches for a valid block from current point to the end of current
871line and returns the start position of the first block found.
872Otherwise, if no block is found, it returns nil.
873
874If INCLUDE-COMMENTS is non-nil, also search for a comment block."
875 (let ((regexp (if include-comments
876 (concat "\\(" hs-block-start-regexp "\\)"
877 "\\|\\(" hs-c-start-regexp "\\)")
878 hs-block-start-regexp))
879 exit)
880 (while (and (not exit)
881 (funcall hs-find-next-block-function regexp (pos-eol) include-comments)
882 (save-excursion
883 (goto-char (match-beginning 0))
884 (pcase-let ((`(,beg ,end)
885 (or (and include-comments
886 (funcall hs-inside-comment-predicate))
887 (hs-block-positions))))
888 (if (and beg (hs-hideable-region-p beg end))
889 (setq exit (point))
890 t)))))
891 exit))
892
893(defun hs-get-near-block (&optional include-comment)
894 "Reposition point to a near block around point.
895It search for a valid block before and after point and return t if one
896is found.
897
898If INCLUDE-COMMENT is non-nil, it also searches for a comment block,
899returning `comment' if one is found.
900
901Intended to be used in commands."
902 (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate)))
903 pos)
904 (cond
905 ((and c-reg (apply #'hs-hideable-region-p c-reg))
906 (goto-char (car c-reg))
907 'comment)
908
909 ((and (eq hs-hide-block-behavior 'after-bol)
910 (save-excursion
911 (forward-line 0)
912 (setq pos (hs-get-first-block-on-line))))
913 (goto-char pos)
914 t)
915
916 ((and (or (funcall hs-looking-at-block-start-predicate)
917 (and (forward-line 0)
918 (funcall hs-find-block-beginning-function)))
919 (apply #'hs-hideable-region-p (hs-block-positions)))
920 t))))
921
922(defun hs-hide-level-recursive (arg beg end &optional include-comments func progress)
923 "Recursively hide blocks between BEG and END that are ARG levels below point.
924If INCLUDE-COMMENTS is non-nil, also hide recursive comment blocks. If
925FUNC is non-nil, call this function to hide the block instead. If
926PROGRESS is non-nil, also update a progress object, intended for
927commands."
928 ;; Show all blocks in that region
929 (unless hs-allow-nesting (hs-discard-overlays beg end))
930 (goto-char beg)
931 (while (not (>= (point) end))
932 (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
933 (block (save-excursion
934 (hs-get-first-block-on-line include-comments))))
935 (goto-char (match-beginning 0))
936 (if (> arg 1)
937 ;; Find a block recursively according to ARG.
938 (pcase-let ((`(,beg ,end) (or (and include-comments
939 (funcall hs-inside-comment-predicate))
940 (hs-block-positions))))
941 (hs-hide-level-recursive (1- arg) beg end include-comments))
942 ;; Now hide the block we found.
943 (if func (funcall func)
944 (hs-hide-block-at-point
945 (and include-comments (funcall hs-inside-comment-predicate))))
946 (when progress
947 (progress-reporter-update progress (point)))))
948 (forward-line 1))
949 (goto-char end))
950
951
952;;;; Internal functions
760 953
761(defun hs--discard-overlay-before-changes (o &rest _r) 954(defun hs--discard-overlay-before-changes (o &rest _r)
762 "Remove overlay O before changes. 955 "Remove overlay O before changes.
@@ -767,19 +960,49 @@ Intended to be used in `modification-hooks', `insert-in-front-hooks' and
767 (delete-overlay o) 960 (delete-overlay o)
768 (hs--refresh-indicators beg end))) 961 (hs--refresh-indicators beg end)))
769 962
770(defun hs-make-overlay (b e kind &optional b-offset e-offset) 963(defun hs--get-ellipsis (b e)
964 "Helper function for `hs-make-overlay'.
965This returns the ellipsis string to use and its face."
966 (let* ((standard-display-table
967 (or standard-display-table (make-display-table)))
968 (d-t-ellipsis
969 (display-table-slot standard-display-table 'selective-display))
970 ;; Convert ellipsis vector to a propertized string
971 (ellipsis
972 (and (vectorp d-t-ellipsis) ; Ensure the vector is not empty
973 (not (length= d-t-ellipsis 0))
974 (mapconcat
975 (lambda (g)
976 (apply #'propertize (char-to-string (glyph-char g))
977 (and (glyph-face g) (list 'face (glyph-face g)))))
978 d-t-ellipsis)))
979 (ellipsis-face (and ellipsis (get-text-property 0 'face ellipsis)))
980 (apply-face (lambda (str)
981 (apply #'propertize str
982 (and ellipsis-face (list 'face ellipsis-face)))))
983 (lines (when-let* (hs-display-lines-hidden
984 (l (1- (count-lines b e)))
985 (l-str (format "%d %s" l
986 (if (= l 1) "line" "lines"))))
987 (funcall apply-face l-str)))
988 (tty-strings (and hs-display-lines-hidden (not (display-graphic-p))))
989 (string
990 (concat (and tty-strings (funcall apply-face "["))
991 lines
992 (or ellipsis (truncate-string-ellipsis))
993 (and tty-strings (funcall apply-face "]")))))
994 (if ellipsis-face
995 ;; Return ELLIPSIS and LINES if ELLIPSIS has no face
996 string
997 ;; Otherwise propertize both with `hs-ellipsis'
998 (propertize string 'face 'hs-ellipsis))))
999
1000(defun hs-make-overlay (b e kind)
771 "Return a new overlay in region defined by B and E with type KIND. 1001 "Return a new overlay in region defined by B and E with type KIND.
772KIND is either `code' or `comment'. Optional fourth arg B-OFFSET 1002KIND is either `code' or `comment'. The following properties are set in
773when added to B specifies the actual buffer position where the block 1003the overlay: `invisible' `hs'. Also, depending on variable
774begins. Likewise for optional fifth arg E-OFFSET. If unspecified 1004`hs-isearch-open', the following properties may be present:
775they are taken to be 0 (zero). The following properties are set 1005`isearch-open-invisible' `isearch-open-invisible-temporary'."
776in the overlay: `invisible' `hs' `hs-b-offset' `hs-e-offset'. Also,
777depending on variable `hs-isearch-open', the following properties may
778be present: `isearch-open-invisible' `isearch-open-invisible-temporary'.
779If variable `hs-set-up-overlay' is non-nil it should specify a function
780to call with the newly initialized overlay."
781 (unless b-offset (setq b-offset 0))
782 (unless e-offset (setq e-offset 0))
783 (let ((ov (make-overlay b e)) 1006 (let ((ov (make-overlay b e))
784 (io (if (eq 'block hs-isearch-open) 1007 (io (if (eq 'block hs-isearch-open)
785 ;; backward compatibility -- `block'<=>`code' 1008 ;; backward compatibility -- `block'<=>`code'
@@ -795,8 +1018,6 @@ to call with the newly initialized overlay."
795 'keymap '(keymap (mouse-1 . hs-toggle-hiding)))) 1018 'keymap '(keymap (mouse-1 . hs-toggle-hiding))))
796 ;; Internal properties 1019 ;; Internal properties
797 (overlay-put ov 'hs kind) 1020 (overlay-put ov 'hs kind)
798 (overlay-put ov 'hs-b-offset b-offset)
799 (overlay-put ov 'hs-e-offset e-offset)
800 ;; Isearch integration 1021 ;; Isearch integration
801 (when (or (eq io t) (eq io kind)) 1022 (when (or (eq io t) (eq io kind))
802 (overlay-put ov 'isearch-open-invisible 'hs-isearch-show) 1023 (overlay-put ov 'isearch-open-invisible 'hs-isearch-show)
@@ -808,48 +1029,9 @@ to call with the newly initialized overlay."
808 (overlay-put ov 'insert-behind-hooks '(hs--discard-overlay-before-changes)) 1029 (overlay-put ov 'insert-behind-hooks '(hs--discard-overlay-before-changes))
809 1030
810 (when hs-set-up-overlay (funcall hs-set-up-overlay ov)) 1031 (when hs-set-up-overlay (funcall hs-set-up-overlay ov))
811 (hs--refresh-indicators b e) 1032 (hs--refresh-indicators b (1+ b))
812 ov)) 1033 ov))
813 1034
814(defun hs-block-positions ()
815 "Return the current code block positions.
816This returns a list with the current code block beginning and end
817positions. This does nothing if there is not a code block at current
818point."
819 ;; `catch' is used here if the search fails due unbalanced parentheses
820 ;; or any other unknown error caused in `hs-forward-sexp'.
821 (catch 'hs-sexp-error
822 (save-match-data
823 (save-excursion
824 (when (funcall hs-looking-at-block-start-predicate)
825 (let ((mdata (match-data t))
826 (header-end (match-end 0))
827 block-beg block-end)
828 ;; `block-start' is the point at the end of the block
829 ;; beginning, which may need to be adjusted
830 (save-excursion
831 (when hs-adjust-block-beginning-function
832 (goto-char (funcall hs-adjust-block-beginning-function header-end)))
833 (setq block-beg (line-end-position)))
834 ;; `block-end' is the point at the end of the block
835 (condition-case _
836 (hs-forward-sexp mdata 1)
837 (scan-error (throw 'hs-sexp-error nil)))
838 (setq block-end
839 (cond ((and (stringp hs-block-end-regexp)
840 (looking-back hs-block-end-regexp nil))
841 (match-beginning 0))
842 ((functionp hs-block-end-regexp)
843 (funcall hs-block-end-regexp)
844 (match-beginning 0))
845 (t (point))))
846 ;; adjust block end (if needed)
847 (when hs-adjust-block-end-function
848 (setq block-end
849 (or (funcall hs-adjust-block-end-function block-beg)
850 block-end)))
851 (list block-beg block-end)))))))
852
853(defun hs--make-indicators-overlays (beg) 1035(defun hs--make-indicators-overlays (beg)
854 "Helper function to make the indicators overlays." 1036 "Helper function to make the indicators overlays."
855 (let ((hiddenp (eq 'hs (get-char-property (pos-eol) 'invisible)))) 1037 (let ((hiddenp (eq 'hs (get-char-property (pos-eol) 'invisible))))
@@ -897,15 +1079,17 @@ point."
897 1079
898(defun hs--add-indicators (&optional beg end) 1080(defun hs--add-indicators (&optional beg end)
899 "Add hideable indicators from BEG to END." 1081 "Add hideable indicators from BEG to END."
900 (save-excursion 1082 (setq beg (progn (goto-char beg) (pos-bol))
901 (setq beg (if (null beg) (window-start) (goto-char beg) (pos-bol)) 1083 end (progn (goto-char end)
902 end (if (null end) (window-end) (goto-char end) (pos-bol)))) 1084 ;; Include the EOL indicator positions
1085 (min (1+ (pos-eol)) (point-max))))
903 (goto-char beg) 1086 (goto-char beg)
904 (remove-overlays beg end 'hs-indicator t) 1087 (remove-overlays beg end 'hs-indicator t)
905 1088
906 (while (not (>= (point) end)) 1089 (while (not (>= (point) end))
907 (save-excursion 1090 (save-excursion
908 (when-let* ((b-beg (hs-get-first-block))) 1091 (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
1092 (b-beg (hs-get-first-block-on-line)))
909 (hs--make-indicators-overlays b-beg))) 1093 (hs--make-indicators-overlays b-beg)))
910 ;; Only 1 indicator per line 1094 ;; Only 1 indicator per line
911 (forward-line)) 1095 (forward-line))
@@ -918,43 +1102,6 @@ point."
918 (save-excursion 1102 (save-excursion
919 (hs--add-indicators from to))))) 1103 (hs--add-indicators from to)))))
920 1104
921(defun hs--get-ellipsis (b e)
922 "Helper function for `hs-make-overlay'.
923This returns the ellipsis string to use and its face."
924 (let* ((standard-display-table
925 (or standard-display-table (make-display-table)))
926 (d-t-ellipsis
927 (display-table-slot standard-display-table 'selective-display))
928 ;; Convert ellipsis vector to a propertized string
929 (ellipsis
930 (and (vectorp d-t-ellipsis) ; Ensure the vector is not empty
931 (not (length= d-t-ellipsis 0))
932 (mapconcat
933 (lambda (g)
934 (apply #'propertize (char-to-string (glyph-char g))
935 (and (glyph-face g) (list 'face (glyph-face g)))))
936 d-t-ellipsis)))
937 (ellipsis-face (and ellipsis (get-text-property 0 'face ellipsis)))
938 (apply-face (lambda (str)
939 (apply #'propertize str
940 (and ellipsis-face (list 'face ellipsis-face)))))
941 (lines (when-let* (hs-display-lines-hidden
942 (l (1- (count-lines b e)))
943 (l-str (format "%d %s" l
944 (if (= l 1) "line" "lines"))))
945 (funcall apply-face l-str)))
946 (tty-strings (and hs-display-lines-hidden (not (display-graphic-p))))
947 (string
948 (concat (and tty-strings (funcall apply-face "["))
949 lines
950 (or ellipsis (truncate-string-ellipsis))
951 (and tty-strings (funcall apply-face "]")))))
952 (if ellipsis-face
953 ;; Return ELLIPSIS and LINES if ELLIPSIS has no face
954 string
955 ;; Otherwise propertize both with `hs-ellipsis'
956 (propertize string 'face 'hs-ellipsis))))
957
958(defun hs-isearch-show (ov) 1105(defun hs-isearch-show (ov)
959 "Delete overlay OV, and set `hs-headline' to nil. 1106 "Delete overlay OV, and set `hs-headline' to nil.
960 1107
@@ -972,8 +1119,7 @@ OV is shown.
972This function is meant to be used as the `isearch-open-invisible-temporary' 1119This function is meant to be used as the `isearch-open-invisible-temporary'
973property of an overlay." 1120property of an overlay."
974 (setq hs-headline 1121 (setq hs-headline
975 (if hide-p 1122 (unless hide-p
976 nil
977 (or hs-headline 1123 (or hs-headline
978 (let ((start (overlay-start ov))) 1124 (let ((start (overlay-start ov)))
979 (buffer-substring 1125 (buffer-substring
@@ -990,107 +1136,15 @@ property of an overlay."
990 (overlay-put ov 'display value) 1136 (overlay-put ov 'display value)
991 (overlay-put ov 'hs-isearch-display nil)) 1137 (overlay-put ov 'hs-isearch-display nil))
992 (when (setq value (overlay-get ov 'display)) 1138 (when (setq value (overlay-get ov 'display))
993 (overlay-put ov 'hs-isearch-display value) 1139 (overlay-put ov 'display nil)
994 (overlay-put ov 'display nil)))) 1140 (overlay-put ov 'hs-isearch-display value))))
995 (overlay-put ov 'invisible (and hide-p 'hs))) 1141 (overlay-put ov 'invisible (and hide-p 'hs)))
996 1142
997(defun hs-looking-at-block-start-p () 1143(defun hs-looking-at-block-start-p--default ()
998 "Return non-nil if the point is at the block start." 1144 "Return non-nil if the point is at the block start."
999 (and (looking-at hs-block-start-regexp) 1145 (and (looking-at hs-block-start-regexp)
1000 (save-match-data (not (nth 8 (syntax-ppss)))))) 1146 (save-match-data (not (nth 8 (syntax-ppss))))))
1001 1147
1002(defun hs-forward-sexp (match-data arg)
1003 "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function' with ARG.
1004Original match data is restored upon return."
1005 (save-match-data
1006 (set-match-data match-data)
1007 (goto-char (match-beginning hs-block-start-mdata-select))
1008 (funcall hs-forward-sexp-function arg)))
1009
1010(defun hs-hide-comment-region (beg end &optional repos-end)
1011 "Hide a region from BEG to END, marking it as a comment.
1012Optional arg REPOS-END means reposition at end."
1013 (let ((goal-col (current-column))
1014 (beg-bol (progn (goto-char beg) (line-beginning-position)))
1015 (beg-eol (line-end-position))
1016 (end-eol (progn (goto-char end) (line-end-position))))
1017 (hs-discard-overlays beg-eol end-eol)
1018 (hs-make-overlay beg-eol end-eol 'comment beg end)
1019 (goto-char (if repos-end end (min end (+ beg-bol goal-col))))))
1020
1021(defun hs-hide-block-at-point (&optional end comment-reg)
1022 "Hide block if on block beginning.
1023Optional arg END means reposition at end.
1024Optional arg COMMENT-REG is a list of the form (BEGIN END) and
1025specifies the limits of the comment, or nil if the block is not
1026a comment.
1027
1028The block beginning is adjusted by `hs-adjust-block-beginning-function'
1029and then further adjusted to be at the end of the line.
1030
1031If hiding the block is successful, return non-nil.
1032Otherwise, return nil."
1033 (if comment-reg
1034 (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
1035 (when-let* ((block (hs-block-positions)))
1036 (let ((p (car block))
1037 (q (cadr block))
1038 ov)
1039 (if (hs-hideable-region-p p q)
1040 (progn
1041 (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p)))
1042 (delete-overlay ov))
1043 ((not hs-allow-nesting)
1044 (hs-discard-overlays p q)))
1045 (goto-char q)
1046 (hs-make-overlay p q 'code (- (match-end 0) p)))
1047 (goto-char (if end q (min p (match-end 0))))
1048 nil)))))
1049
1050(defun hs-get-first-block ()
1051 "Return the position of the first valid block found on the current line.
1052This searches for a valid block on the current line and returns the
1053first block found. Otherwise, if no block is found, it returns nil."
1054 (let (exit)
1055 (while (and (not exit)
1056 (funcall hs-find-next-block-function
1057 hs-block-start-regexp
1058 (line-end-position) nil)
1059 (save-excursion
1060 (goto-char (match-beginning 0))
1061 (if (hs-hideable-region-p)
1062 (setq exit (match-beginning 0))
1063 t))))
1064 exit))
1065
1066(defun hs-get-near-block (&optional include-comment)
1067 "Reposition point to a near block around point.
1068It search for a valid block before and after point and return t if one
1069is found.
1070
1071If INCLUDE-COMMENT is non-nil, it also searches for a comment block,
1072returning `comment' if one is found."
1073 (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate)))
1074 pos)
1075 (cond
1076 ((and c-reg (car c-reg) (hs-hideable-region-p
1077 (car c-reg) (cadr c-reg)))
1078 (goto-char (car c-reg))
1079 'comment)
1080
1081 ((and (eq hs-hide-block-behavior 'after-bol)
1082 (save-excursion
1083 (goto-char (line-beginning-position))
1084 (setq pos (hs-get-first-block))))
1085 (goto-char pos)
1086 t)
1087
1088 ((and (or (funcall hs-looking-at-block-start-predicate)
1089 (and (goto-char (line-beginning-position))
1090 (funcall hs-find-block-beginning-function)))
1091 (hs-hideable-region-p))
1092 t))))
1093
1094(defun hs-inside-comment-p () 1148(defun hs-inside-comment-p ()
1095 (declare (obsolete "Call `hs-inside-comment-predicate' instead." "31.1")) 1149 (declare (obsolete "Call `hs-inside-comment-predicate' instead." "31.1"))
1096 (funcall hs-inside-comment-predicate)) 1150 (funcall hs-inside-comment-predicate))
@@ -1100,51 +1154,32 @@ returning `comment' if one is found."
1100 ;; the idea is to look backwards for a comment start regexp, do a 1154 ;; the idea is to look backwards for a comment start regexp, do a
1101 ;; forward comment, and see if we are inside, then extend 1155 ;; forward comment, and see if we are inside, then extend
1102 ;; forward and backward as long as we have comments 1156 ;; forward and backward as long as we have comments
1103 (let ((q (point))) 1157 (let ((amount (buffer-size))
1104 (skip-chars-forward "[:blank:]") 1158 (rx (concat "^[[:blank:]]*\\(" hs-c-start-regexp "\\)"))
1105 (when (or (looking-at hs-c-start-regexp) 1159 beg end)
1106 (re-search-backward hs-c-start-regexp (point-min) t)) 1160 (when (or (and (skip-chars-forward "[:blank:]")
1107 ;; first get to the beginning of this comment... 1161 (looking-at-p hs-c-start-regexp)
1108 (while (and (not (bobp)) 1162 ;; Check if there are not whitespaces before the comment
1109 (= (point) (progn (forward-comment -1) (point)))) 1163 (if (save-excursion
1110 (forward-char -1)) 1164 (forward-line 0) (not (looking-at-p rx)))
1111 ;; ...then extend backwards 1165 (setq amount 1)
1112 (forward-comment (- (buffer-size))) 1166 t))
1113 (skip-chars-forward " \t\n\f") 1167 (and (re-search-backward rx (pos-bol) t)
1114 (let ((p (point)) 1168 (goto-char (match-beginning 1))))
1115 (hideable t)) 1169
1116 (beginning-of-line) 1170 (setq beg (if (= amount 1)
1117 (unless (looking-at (concat "[ \t]*" hs-c-start-regexp)) 1171 (pos-eol)
1118 ;; we are in this situation: (example) 1172 (forward-comment (- amount))
1119 ;; (defun bar () 1173 (skip-chars-forward " \t\n\f")
1120 ;; (foo) 1174 (unless (save-excursion
1121 ;; ) ; comment 1175 (forward-line 0) (looking-at-p rx))
1122 ;; ^ 1176 (forward-comment 1)
1123 ;; the point was here before doing (beginning-of-line) 1177 (skip-chars-forward " \t\n\f"))
1124 ;; here we should advance till the next comment which 1178 (pos-eol))
1125 ;; eventually has only white spaces preceding it on the same 1179 end (progn (forward-comment amount)
1126 ;; line 1180 (skip-chars-backward " \t\n\f")
1127 (goto-char p) 1181 (point)))
1128 (forward-comment 1) 1182 (list beg end)))))
1129 (skip-chars-forward " \t\n\f")
1130 (setq p (point))
1131 (while (and (< (point) q)
1132 (> (point) p)
1133 (not (looking-at hs-c-start-regexp)))
1134 ;; avoid an infinite cycle
1135 (setq p (point))
1136 (forward-comment 1)
1137 (skip-chars-forward " \t\n\f"))
1138 (when (or (not (looking-at hs-c-start-regexp))
1139 (> (point) q))
1140 ;; we cannot hide this comment block
1141 (setq hideable nil)))
1142 ;; goto the end of the comment
1143 (forward-comment (buffer-size))
1144 (skip-chars-backward " \t\n\f")
1145 (end-of-line)
1146 (when (>= (point) q)
1147 (list (and hideable p) (point))))))))
1148 1183
1149(defun hs--set-variable (var nth &optional default) 1184(defun hs--set-variable (var nth &optional default)
1150 "Set Hideshow VAR if already not set. 1185 "Set Hideshow VAR if already not set.
@@ -1188,103 +1223,46 @@ adjust-block-beginning function."
1188 (hs--set-variable 'hs-find-next-block-function 7) 1223 (hs--set-variable 'hs-find-next-block-function 7)
1189 (hs--set-variable 'hs-looking-at-block-start-predicate 8)) 1224 (hs--set-variable 'hs-looking-at-block-start-predicate 8))
1190 1225
1191(defun hs-find-block-beginning () 1226(defun hs-forward-sexp (match-data _arg)
1192 "Reposition point at block-start. 1227 "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function' with ARG.
1193Return point, or nil if original point was not in a block." 1228Original match data is restored upon return."
1194 (let ((done nil) 1229 (declare (obsolete "Use `hs-block-positions' instead." "31.1"))
1195 (here (point))) 1230 (save-match-data
1196 ;; look if current line is block start 1231 (set-match-data match-data)
1197 (if (funcall hs-looking-at-block-start-predicate) 1232 (goto-char (match-beginning hs-block-start-mdata-select))
1198 (point) 1233 (funcall hs-forward-sexp-function 1)))
1199 ;; look backward for the start of a block that contains the cursor
1200 (while (and (re-search-backward hs-block-start-regexp nil t)
1201 ;; go again if in a comment or a string
1202 (or (save-match-data (nth 8 (syntax-ppss)))
1203 (not (setq done
1204 (< here (save-excursion
1205 (hs-forward-sexp (match-data t) 1)
1206 (point))))))))
1207 (if done
1208 (point)
1209 (goto-char here)
1210 nil))))
1211 1234
1212(defun hs-find-next-block (regexp maxp comments) 1235(define-obsolete-function-alias
1236 'hs-find-next-block 'hs-find-next-block-fn--default "31.1")
1237
1238(defun hs-find-next-block-fn--default (regexp bound comments)
1213 "Reposition point at next block-start. 1239 "Reposition point at next block-start.
1214Skip comments if COMMENTS is nil, and search for REGEXP in 1240Skip comments if COMMENTS is nil, and search for REGEXP in
1215region (point MAXP)." 1241region (point BOUND)."
1216 (when (not comments) 1242 (when (not comments)
1217 (forward-comment (point-max))) 1243 (forward-comment (point-max)))
1218 (and (< (point) maxp) 1244 (and (< (point) bound)
1219 (re-search-forward regexp maxp t))) 1245 (re-search-forward regexp bound t)))
1220
1221(defun hs-hide-level-recursive (arg &optional beg end)
1222 "Recursively hide blocks between BEG and END that are ARG levels below point.
1223If BEG and END are not specified, it will search for a near block and
1224use its position instead.
1225
1226If point is inside a block, it will use the current block positions
1227instead of BEG and END."
1228 ;; If we are near of a block, set BEG and END according to that
1229 ;; block positions.
1230 (when (funcall hs-find-block-beginning-function)
1231 (let ((block (hs-block-positions)))
1232 (setq beg (point) end (cadr block))))
1233
1234 ;; Show all blocks in that region
1235 (unless hs-allow-nesting (hs-discard-overlays beg end))
1236
1237 ;; Skip initial block
1238 (goto-char (1+ beg))
1239
1240 (while (funcall hs-find-next-block-function hs-block-start-regexp end nil)
1241 (if (> arg 1)
1242 (hs-hide-level-recursive (1- arg))
1243 ;; `hs-hide-block-at-point' already moves the cursor, but if it
1244 ;; fails, return to the previous position where we were.
1245 (unless (and (goto-char (match-beginning hs-block-start-mdata-select))
1246 (hs-hide-block-at-point t))
1247 (goto-char (match-end hs-block-start-mdata-select)))))
1248 1246
1249 (goto-char end)) 1247(define-obsolete-function-alias
1250 1248 'hs-find-block-beginning 'hs-find-block-beg-fn--default "31.1")
1251(defmacro hs-life-goes-on (&rest body)
1252 "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
1253In the dynamic context of this macro, `case-fold-search' is t."
1254 (declare (debug t))
1255 `(when hs-minor-mode
1256 (let ((case-fold-search t))
1257 (save-match-data
1258 (save-excursion ,@body)))))
1259 1249
1260(defun hs-find-block-beginning-match () 1250(defun hs-find-block-beg-fn--default ()
1261 "Reposition point at the end of match of the block-start regexp. 1251 "Reposition point at block-start.
1262Return point, or nil if original point was not in a block." 1252Return point, or nil if original point was not in a block."
1263 (when (and (funcall hs-find-block-beginning-function) 1253 (let ((here (point)) done)
1264 (funcall hs-looking-at-block-start-predicate)) 1254 ;; look if current line is block start
1265 ;; point is inside a block 1255 (if (funcall hs-looking-at-block-start-predicate)
1266 (goto-char (match-end 0)))) 1256 here
1267 1257 ;; look backward for the start of a block that contains the cursor
1268(defun hs-overlay-at (position) 1258 (save-excursion
1269 "Return hideshow overlay at POSITION, or nil if none to be found." 1259 (while (and (re-search-backward hs-block-start-regexp nil t)
1270 (let ((overlays (overlays-at position)) 1260 (goto-char (match-beginning hs-block-start-mdata-select))
1271 ov found) 1261 ;; go again if in a comment or a string
1272 (while (and (not found) (setq ov (car overlays))) 1262 (or (save-match-data (nth 8 (syntax-ppss)))
1273 (setq found (and (overlay-get ov 'hs) ov) 1263 (not (setq done (and (<= here (cadr (hs-block-positions)))
1274 overlays (cdr overlays))) 1264 (point))))))))
1275 found)) 1265 (when done (goto-char done)))))
1276
1277(defun hs-already-hidden-p ()
1278 "Return non-nil if point is in an already-hidden block, otherwise nil."
1279 (save-excursion
1280 (let ((c-reg (funcall hs-inside-comment-predicate)))
1281 (when (and c-reg (nth 0 c-reg))
1282 ;; point is inside a comment, and that comment is hideable
1283 (goto-char (nth 0 c-reg))))
1284 ;; Search for a hidden block at EOL ...
1285 (or (eq 'hs (get-char-property (line-end-position) 'invisible))
1286 ;; ... or behind the current cursor position
1287 (eq 'hs (get-char-property (if (bobp) (point) (1- (point))) 'invisible)))))
1288 1266
1289;; This function is not used anymore (Bug#700). 1267;; This function is not used anymore (Bug#700).
1290(defun hs-c-like-adjust-block-beginning (initial) 1268(defun hs-c-like-adjust-block-beginning (initial)
@@ -1292,62 +1270,35 @@ Return point, or nil if original point was not in a block."
1292Actually, point is never moved; a new position is returned that is 1270Actually, point is never moved; a new position is returned that is
1293the end of the C-function header. This adjustment function is meant 1271the end of the C-function header. This adjustment function is meant
1294to be assigned to `hs-adjust-block-beginning-function' for C-like modes." 1272to be assigned to `hs-adjust-block-beginning-function' for C-like modes."
1273 (declare (obsolete "Use `hs-adjust-block-beginning-function' instead." "31.1"))
1295 (save-excursion 1274 (save-excursion
1296 (goto-char (1- initial)) 1275 (goto-char (1- initial))
1297 (forward-comment (- (buffer-size))) 1276 (forward-comment (- (buffer-size)))
1298 (point))) 1277 (point)))
1299 1278
1300;;--------------------------------------------------------------------------- 1279;;;###autoload
1301;; commands 1280(defun turn-off-hideshow ()
1281 "Unconditionally turn off `hs-minor-mode'."
1282 (hs-minor-mode -1))
1283
1284
1285;;;; Commands
1302 1286
1303(defun hs-hide-all () 1287(defun hs-hide-all ()
1304 "Hide all top level blocks, displaying only first and last lines. 1288 "Hide all top level blocks.
1305Move point to the beginning of the line, and run the normal hook 1289This command runs `hs-hide-hook'.
1306`hs-hide-hook'. See documentation for `run-hooks'. 1290If `hs-hide-comments-when-hiding-all' is non-nil, also hide the
1307If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." 1291comments."
1308 (interactive) 1292 (interactive)
1309 (hs-life-goes-on 1293 (hs-life-goes-on
1310 (save-excursion 1294 (let ((spew (make-progress-reporter
1311 (unless hs-allow-nesting 1295 "Hiding all blocks..." (point-min) (point-max))))
1312 (hs-discard-overlays (point-min) (point-max))) 1296 (hs-hide-level-recursive
1313 (goto-char (point-min)) 1297 1 (point-min) (point-max)
1314 (syntax-propertize (point-max)) 1298 hs-hide-comments-when-hiding-all
1315 (let ((spew (make-progress-reporter "Hiding all blocks..." 1299 hs-hide-all-non-comment-function
1316 (point-min) (point-max))) 1300 spew)
1317 (re (when (stringp hs-block-start-regexp) 1301 (progress-reporter-done spew))
1318 (concat "\\("
1319 hs-block-start-regexp
1320 "\\)"
1321 (if (and hs-hide-comments-when-hiding-all
1322 (stringp hs-c-start-regexp))
1323 (concat "\\|\\("
1324 hs-c-start-regexp
1325 "\\)")
1326 "")))))
1327 (while (funcall hs-find-next-block-function re (point-max)
1328 hs-hide-comments-when-hiding-all)
1329 (if (match-beginning 1)
1330 ;; We have found a block beginning.
1331 (progn
1332 (goto-char (match-beginning 1))
1333 (unless (if hs-hide-all-non-comment-function
1334 (funcall hs-hide-all-non-comment-function)
1335 (hs-hide-block-at-point t))
1336 ;; Go to end of matched data to prevent from getting stuck
1337 ;; with an endless loop.
1338 (when (if (stringp hs-block-start-regexp)
1339 (looking-at hs-block-start-regexp)
1340 (eq (point) (match-beginning 0)))
1341 (goto-char (match-end 0)))))
1342 ;; found a comment, probably
1343 (let ((c-reg (funcall hs-inside-comment-predicate)))
1344 (when (and c-reg (car c-reg))
1345 (if (hs-hideable-region-p (car c-reg) (nth 1 c-reg))
1346 (hs-hide-block-at-point t c-reg)
1347 (goto-char (nth 1 c-reg))))))
1348 (progress-reporter-update spew (point)))
1349 (progress-reporter-done spew)))
1350 (beginning-of-line)
1351 (run-hooks 'hs-hide-hook))) 1302 (run-hooks 'hs-hide-hook)))
1352 1303
1353(defun hs-show-all () 1304(defun hs-show-all ()
@@ -1355,76 +1306,63 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
1355 (interactive) 1306 (interactive)
1356 (hs-life-goes-on 1307 (hs-life-goes-on
1357 (message "Showing all blocks ...") 1308 (message "Showing all blocks ...")
1358 (let ((hs-allow-nesting nil)) 1309 (let (hs-allow-nesting)
1359 (hs-discard-overlays (point-min) (point-max))) 1310 (hs-discard-overlays (point-min) (point-max)))
1360 (message "Showing all blocks ... done") 1311 (message "Showing all blocks ... done")
1361 (run-hooks 'hs-show-hook))) 1312 (run-hooks 'hs-show-hook)))
1362 1313
1363(defun hs-hide-block (&optional end) 1314(defun hs-hide-block ()
1364 "Select a block and hide it. With prefix arg, reposition at END. 1315 "Select a block and hide it.
1365Upon completion, point is repositioned and the normal hook 1316This command runs `hs-hide-hook'."
1366`hs-hide-hook' is run. See documentation for `run-hooks'." 1317 (interactive)
1367 (interactive "P")
1368 (hs-life-goes-on 1318 (hs-life-goes-on
1369 (let ((c-reg (funcall hs-inside-comment-predicate))) 1319 (let ((c-reg (funcall hs-inside-comment-predicate)))
1370 (cond 1320 (cond
1371 ((and c-reg (or (null (nth 0 c-reg)) 1321 ((and c-reg (not (apply #'hs-hideable-region-p c-reg)))
1372 (not (hs-hideable-region-p (car c-reg) (nth 1 c-reg)))))
1373 (user-error "(not enough comment lines to hide)")) 1322 (user-error "(not enough comment lines to hide)"))
1374 1323 ((or c-reg (hs-get-near-block))
1375 (c-reg (hs-hide-block-at-point end c-reg)) 1324 (hs-hide-block-at-point c-reg)))
1376
1377 ((hs-get-near-block) (hs-hide-block-at-point)))
1378
1379 (run-hooks 'hs-hide-hook)))) 1325 (run-hooks 'hs-hide-hook))))
1380 1326
1381(defun hs-show-block (&optional end) 1327(defun hs-show-block ()
1382 "Select a block and show it. 1328 "Select a block and show it.
1383With prefix arg, reposition at END. Upon completion, point is 1329This command runs `hs-show-hook'. See documentation for functions
1384repositioned and the normal hook `hs-show-hook' is run. 1330`hs-hide-block' and `run-hooks'."
1385See documentation for functions `hs-hide-block' and `run-hooks'." 1331 (interactive)
1386 (interactive "P")
1387 (hs-life-goes-on 1332 (hs-life-goes-on
1388 (or 1333 (if-let* ((ov (hs-overlay-at (pos-eol)))
1389 ;; first see if we have something at the end of the line 1334 (ov-start (overlay-start ov))
1390 (let ((ov (hs-overlay-at (line-end-position))) 1335 (ov-end (overlay-end ov)))
1391 (here (point)) 1336 (progn
1392 ov-start ov-end) 1337 (hs-discard-overlays (1- ov-start) ov-end)
1393 (when ov 1338 (hs--refresh-indicators ov-start ov-end))
1394 (goto-char 1339 (when-let* ((block
1395 (cond (end (overlay-end ov)) 1340 (or (funcall hs-inside-comment-predicate)
1396 ((eq 'comment (overlay-get ov 'hs)) here) 1341 (and (funcall hs-find-block-beginning-function)
1397 (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset))))) 1342 (hs-block-positions)))))
1398 (setq ov-start (overlay-start ov)) 1343 (hs-discard-overlays (car block) (cadr block))))
1399 (setq ov-end (overlay-end ov))
1400 (delete-overlay ov)
1401 (hs--refresh-indicators ov-start ov-end)
1402 t))
1403 ;; not immediately obvious, look for a suitable block
1404 (let ((c-reg (funcall hs-inside-comment-predicate))
1405 p q)
1406 (cond (c-reg
1407 (when (car c-reg)
1408 (setq p (car c-reg)
1409 q (cadr c-reg))))
1410 ((and (funcall hs-find-block-beginning-function)
1411 ;; ugh, fresh match-data
1412 (funcall hs-looking-at-block-start-predicate))
1413 (setq p (point)
1414 q (progn (hs-forward-sexp (match-data t) 1) (point)))))
1415 (when (and p q)
1416 (hs-discard-overlays p q)
1417 (goto-char (if end q (1+ p))))))
1418 (run-hooks 'hs-show-hook))) 1344 (run-hooks 'hs-show-hook)))
1419 1345
1420(defun hs-hide-level (arg) 1346(defun hs-hide-level (arg)
1421 "Hide all blocks ARG levels below this block. 1347 "Hide all blocks ARG levels below this block.
1348If point is not in a block, hide all the ARG levels blocks in the whole
1349buffer.
1350
1422The hook `hs-hide-hook' is run; see `run-hooks'." 1351The hook `hs-hide-hook' is run; see `run-hooks'."
1423 (interactive "p") 1352 (interactive "p")
1424 (hs-life-goes-on 1353 (hs-life-goes-on
1425 (save-excursion 1354 (save-excursion
1426 (message "Hiding blocks ...") 1355 (message "Hiding blocks ...")
1427 (hs-hide-level-recursive arg (point-min) (point-max)) 1356 (if (hs-get-near-block)
1357 ;; Hide block if we are looking at one.
1358 (apply #'hs-hide-level-recursive arg
1359 (hs-block-positions))
1360 ;; Otherwise hide all the blocks in the current buffer
1361 (hs-hide-level-recursive
1362 ;; Increment ARG by 1, avoiding it acts like
1363 ;; `hs-hide-all'
1364 (1+ arg)
1365 (point-min) (point-max)))
1428 (message "Hiding blocks ... done")) 1366 (message "Hiding blocks ... done"))
1429 (run-hooks 'hs-hide-hook))) 1367 (run-hooks 'hs-hide-hook)))
1430 1368
@@ -1465,15 +1403,10 @@ Argument E should be the event that triggered this action."
1465This can be useful if you have huge RCS logs in those comments." 1403This can be useful if you have huge RCS logs in those comments."
1466 (interactive) 1404 (interactive)
1467 (hs-life-goes-on 1405 (hs-life-goes-on
1468 (let ((c-reg (save-excursion 1406 (goto-char (point-min))
1469 (goto-char (point-min)) 1407 (skip-chars-forward " \t\n\f")
1470 (skip-chars-forward " \t\n\f") 1408 (when-let* ((c-reg (funcall hs-inside-comment-predicate)))
1471 (funcall hs-inside-comment-predicate)))) 1409 (hs-hide-block-at-point c-reg))))
1472 (when c-reg
1473 (let ((beg (car c-reg)) (end (cadr c-reg)))
1474 ;; see if we have enough comment lines to hide
1475 (when (hs-hideable-region-p beg end)
1476 (hs-hide-comment-region beg end)))))))
1477 1410
1478(defun hs-cycle (&optional level) 1411(defun hs-cycle (&optional level)
1479 "Cycle the visibility state of the current block. 1412 "Cycle the visibility state of the current block.
@@ -1490,11 +1423,12 @@ only blocks which are that many levels below the level of point."
1490 (hs-toggle-hiding) 1423 (hs-toggle-hiding)
1491 (message "Toggle visibility")) 1424 (message "Toggle visibility"))
1492 ((> level 1) 1425 ((> level 1)
1493 (hs-hide-level-recursive level) 1426 (apply #'hs-hide-level-recursive level
1427 (hs-block-positions))
1494 (message "Hide %d level" level)) 1428 (message "Hide %d level" level))
1495 (t 1429 (t
1496 (let* (hs-allow-nesting 1430 (let* (hs-allow-nesting
1497 (block (hs-block-positions)) 1431 (block (hs-block-positions nil :ad-end))
1498 (ov (seq-find 1432 (ov (seq-find
1499 (lambda (o) 1433 (lambda (o)
1500 (and (eq (overlay-get o 'invisible) 'hs))) 1434 (and (eq (overlay-get o 'invisible) 'hs)))
@@ -1505,9 +1439,8 @@ only blocks which are that many levels below the level of point."
1505 (hs-hide-block) 1439 (hs-hide-block)
1506 (message "Hide block and nested blocks")) 1440 (message "Hide block and nested blocks"))
1507 ;; Hide the children blocks if the parent block is hidden 1441 ;; Hide the children blocks if the parent block is hidden
1508 ((and (= (overlay-start ov) (car block)) 1442 ((= (overlay-end ov) (cadr block))
1509 (= (overlay-end ov) (cadr block))) 1443 (apply #'hs-hide-level-recursive 1 block)
1510 (hs-hide-level-recursive 1)
1511 (message "Hide first nested blocks")) 1444 (message "Hide first nested blocks"))
1512 ;; Otherwise show all in the parent block, we cannot use 1445 ;; Otherwise show all in the parent block, we cannot use
1513 ;; `hs-show-block' here because we already know the 1446 ;; `hs-show-block' here because we already know the
@@ -1533,10 +1466,6 @@ When hideshow minor mode is on, the menu bar is augmented with hideshow
1533commands and the hideshow commands are enabled. 1466commands and the hideshow commands are enabled.
1534The value (hs . t) is added to `buffer-invisibility-spec'. 1467The value (hs . t) is added to `buffer-invisibility-spec'.
1535 1468
1536The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block',
1537`hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also
1538`hs-hide-initial-comment-block'.
1539
1540Turning hideshow minor mode off reverts the menu bar and the 1469Turning hideshow minor mode off reverts the menu bar and the
1541variables to default values and disables the hideshow commands. 1470variables to default values and disables the hideshow commands.
1542 1471
@@ -1556,12 +1485,11 @@ Key bindings:
1556 (user-error "%S doesn't support the Hideshow minor mode" 1485 (user-error "%S doesn't support the Hideshow minor mode"
1557 major-mode)) 1486 major-mode))
1558 1487
1559 ;; Set the variables 1488 ;; Set the old variables
1560 (hs-grok-mode-type) 1489 (hs-grok-mode-type)
1561 ;; Turn off this mode if we change major modes. 1490 ;; Turn off this mode if we change major modes.
1562 (add-hook 'change-major-mode-hook 1491 (add-hook 'change-major-mode-hook
1563 #'turn-off-hideshow 1492 #'turn-off-hideshow nil t)
1564 nil t)
1565 (setq-local line-move-ignore-invisible t) 1493 (setq-local line-move-ignore-invisible t)
1566 (add-to-invisibility-spec '(hs . t)) 1494 (add-to-invisibility-spec '(hs . t))
1567 ;; Add block indicators 1495 ;; Add block indicators
@@ -1575,21 +1503,12 @@ Key bindings:
1575 (jit-lock-register #'hs--add-indicators))) 1503 (jit-lock-register #'hs--add-indicators)))
1576 1504
1577 (remove-from-invisibility-spec '(hs . t)) 1505 (remove-from-invisibility-spec '(hs . t))
1578 ;; hs-show-all does nothing unless h-m-m is non-nil. 1506 (remove-overlays nil nil 'hs-indicator t)
1579 (let ((hs-minor-mode t)) 1507 (remove-overlays nil nil 'invisible 'hs)
1580 (hs-show-all))
1581 (when hs-show-indicators 1508 (when hs-show-indicators
1582 (jit-lock-unregister #'hs--add-indicators) 1509 (jit-lock-unregister #'hs--add-indicators))))
1583 (remove-overlays nil nil 'hs-indicator t))))
1584
1585;;;###autoload
1586(defun turn-off-hideshow ()
1587 "Unconditionally turn off `hs-minor-mode'."
1588 (hs-minor-mode -1))
1589
1590;;---------------------------------------------------------------------------
1591;; that's it
1592 1510
1511
1512;;;; that's it
1593(provide 'hideshow) 1513(provide 'hideshow)
1594
1595;;; hideshow.el ends here 1514;;; hideshow.el ends here
diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hideshow-tests.el
index 9cf60c1ec84..39161f2455c 100644
--- a/test/lisp/progmodes/hideshow-tests.el
+++ b/test/lisp/progmodes/hideshow-tests.el
@@ -246,7 +246,7 @@ sub()
246 (should (string= (hideshow-tests-visible-string) contents))))) 246 (should (string= (hideshow-tests-visible-string) contents)))))
247 247
248(ert-deftest hideshow-hide-level-1 () 248(ert-deftest hideshow-hide-level-1 ()
249 "Should hide 1st level blocks." 249 "Should hide 2st level blocks."
250 (hideshow-tests-with-temp-buffer 250 (hideshow-tests-with-temp-buffer
251 c-mode 251 c-mode
252 " 252 "
@@ -276,40 +276,6 @@ main(int argc, char **argv)
276 276
277int 277int
278main(int argc, char **argv) 278main(int argc, char **argv)
279{}
280"))))
281
282(ert-deftest hideshow-hide-level-2 ()
283 "Should hide 2nd level blocks."
284 (hideshow-tests-with-temp-buffer
285 c-mode
286 "
287/*
288 Comments
289*/
290
291\"String\"
292
293int
294main(int argc, char **argv)
295{
296 if (argc > 1) {
297 printf(\"Hello\\n\");
298 }
299}
300"
301 (hs-hide-level 2)
302 (should (string=
303 (hideshow-tests-visible-string)
304 "
305/*
306 Comments
307*/
308
309\"String\"
310
311int
312main(int argc, char **argv)
313{ 279{
314 if (argc > 1) {} 280 if (argc > 1) {}
315} 281}
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index b9130da495d..6ddd57c9db2 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -7428,7 +7428,7 @@ class SomeClass:
7428 (or enabled (hs-minor-mode -1))))) 7428 (or enabled (hs-minor-mode -1)))))
7429 7429
7430(ert-deftest python-hideshow-hide-levels-3 () 7430(ert-deftest python-hideshow-hide-levels-3 ()
7431 "Should hide all blocks." 7431 "Should hide 2nd level blocks."
7432 (python-tests-with-temp-buffer 7432 (python-tests-with-temp-buffer
7433 " 7433 "
7434def f(): 7434def f():
@@ -7447,19 +7447,22 @@ def g():
7447 (python-tests-visible-string) 7447 (python-tests-visible-string)
7448 " 7448 "
7449def f(): 7449def f():
7450 if 0:
7450 7451
7451def g(): 7452def g():
7453 pass
7452")))) 7454"))))
7453 7455
7454(ert-deftest python-hideshow-hide-levels-4 () 7456(ert-deftest python-hideshow-hide-levels-4 ()
7455 "Should hide 2nd level block." 7457 "Should hide 3nd level block."
7456 (python-tests-with-temp-buffer 7458 (python-tests-with-temp-buffer
7457 " 7459 "
7458def f(): 7460def f():
7459 if 0: 7461 if 0:
7460 l = [i for i in range(5) 7462 l = [i for i in range(5)
7461 if i < 3] 7463 if i < 3]
7462 abc = o.match(1, 2, 3) 7464 if 1:
7465 abc = o.match(1, 2, 3)
7463 7466
7464def g(): 7467def g():
7465 pass 7468 pass
@@ -7472,6 +7475,9 @@ def g():
7472 " 7475 "
7473def f(): 7476def f():
7474 if 0: 7477 if 0:
7478 l = [i for i in range(5)
7479 if i < 3]
7480 if 1:
7475 7481
7476def g(): 7482def g():
7477 pass 7483 pass