Juri Linkov <juri@HIDDEN>
to control <at> debbugs.gnu.org.
Full text available.Received: (at 79934) by debbugs.gnu.org; 8 Dec 2025 07:22:41 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Mon Dec 08 02:22:41 2025 Received: from localhost ([127.0.0.1]:43927 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1vSVZx-0001Jj-0k for submit <at> debbugs.gnu.org; Mon, 08 Dec 2025 02:22:41 -0500 Received: from mout-p-101.mailbox.org ([80.241.56.151]:37842) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from <juri@HIDDEN>) id 1vSVZu-0001JL-RU; Mon, 08 Dec 2025 02:22:40 -0500 Received: from smtp202.mailbox.org (smtp202.mailbox.org [10.196.197.202]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by mout-p-101.mailbox.org (Postfix) with ESMTPS id 4dPtjK3Qvcz9syG; Mon, 8 Dec 2025 08:22:29 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=linkov.net; s=MBO0001; t=1765178549; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=ekjsjIhvQF95BkUEoC2Ut4xYbj2HktIaKv8tOZKd4yE=; b=mZ8eLJ9zWpbGu9oBRWXB64yENZmK9I9vXRBPcASyPfKNCDMoUcU95ERzjJ9XEcSiroleiS Hg7l6yIBkXE33TSRaGd8T2U1NcwcSWdWOJq+GHHLq7uxyw7h/PGHOcvYRfGUDnXrylcJI7 LjKX5HTzudu+0G0G7T8IcMNBE64cbbKryH4P72FX3Ga8IQYsgNHBo/bz7viw5XjVt+Ze+Q DYD9/lSIgJNpDPCVLyxuO0ZiPj1RIP/Ia3CYMv0e2udLKAIl4O3PLXq+LLKnwt0yjtfG23 So5mmVcNmYJ4igHiMSCht55tPrdJwYVLqMY6sUdYyojy374gOVZpL/vlqx2s6w== From: Juri Linkov <juri@HIDDEN> To: Elijah Gabe =?iso-8859-1?Q?P=E9rez?= <eg642616@HIDDEN> Subject: Re: bug#79934: [PATCH] hideshow: Deep cleaning In-Reply-To: <87h5u3p3yn.fsf@HIDDEN> Organization: LINKOV.NET References: <871pldd3a9.fsf@HIDDEN> <871pl8jqvm.fsf@HIDDEN> <87h5u3p3yn.fsf@HIDDEN> Date: Mon, 08 Dec 2025 09:21:43 +0200 Message-ID: <87zf7tsak8.fsf@HIDDEN> MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 79934 Cc: 79934 <at> debbugs.gnu.org X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -1.7 (-) close 79934 31.0.50 thanks >> I've updated and split the patch into parts, so it should be easier to >> push them. >> >> [2. text/x-patch; 0001-hideshow-Deep-cleaning.-Bug-79934.patch]... > > I have noticed that this patch has a bug. I already fixed it, I > apologize for the inconvenience. Thanks for the patches! Now pushed.
bug-gnu-emacs@HIDDEN:bug#79934; Package emacs.
Full text available.
Received: (at 79934) by debbugs.gnu.org; 6 Dec 2025 23:48:39 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sat Dec 06 18:48:39 2025
Received: from localhost ([127.0.0.1]:34839 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1vS20x-0001rD-99
for submit <at> debbugs.gnu.org; Sat, 06 Dec 2025 18:48:39 -0500
Received: from mail-ot1-x342.google.com ([2607:f8b0:4864:20::342]:61548)
by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
(Exim 4.84_2) (envelope-from <eg642616@HIDDEN>)
id 1vS20r-0001qp-D9
for 79934 <at> debbugs.gnu.org; Sat, 06 Dec 2025 18:48:33 -0500
Received: by mail-ot1-x342.google.com with SMTP id
46e09a7af769-7c75dd36b1bso2665415a34.2
for <79934 <at> debbugs.gnu.org>; Sat, 06 Dec 2025 15:48:29 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=gmail.com; s=20230601; t=1765064903; x=1765669703; darn=debbugs.gnu.org;
h=mime-version:user-agent:message-id:date:references:in-reply-to
:subject:to:from:from:to:cc:subject:date:message-id:reply-to;
bh=RDd8XZ7tyQGX9bUhTPwN4PhUOYGRHDEkCzsJBmYX4Vw=;
b=hQekCVBnnpqcHEzur4R/jmcVQg50SG5rBYQEEmYw3T6Hj9Ds8OcubmH/EAqdKsClX/
G0WZWIDJ398/USt6dc0vAYo6VMMrgNfNmdergrhCGNKylVEnMJQ5CzVMiHucDo2Cl0lc
67J2GA+Se+OAGW0je/RMUQGh1HqI/VI9+sBbWcDbwuwdAKQE49n+JjkeYItuQnJ28fhR
jdqX58AOaOMTsElplNxIeNu/QiZlwD9qazM8rO42h2Nod3l4p/XoA8qQtKlLF2ZSztoP
9Fd3EwLT5eVun6qYTC0vs8bbYNuxXde7DwuGlEBFMgSA4USFzNiC0C7hH2EZbN8eFW62
CLcA==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=1e100.net; s=20230601; t=1765064903; x=1765669703;
h=mime-version:user-agent:message-id:date:references:in-reply-to
:subject:to:from:x-gm-gg:x-gm-message-state:from:to:cc:subject:date
:message-id:reply-to;
bh=RDd8XZ7tyQGX9bUhTPwN4PhUOYGRHDEkCzsJBmYX4Vw=;
b=QsCxRYtalFOBFmiDmCvFf3YrFfAyQVShgm3k2nOR8ixMQlW1KpgerW9aCw8LmF8n/0
CDLWPodmGXCOxmYnB+NFW3yj54s3lo9FAeYSY1iVEAXPC5Ysl4NqsxED9ZIDh3bVcUVW
6SIup3O4VdO4sB21Dzwab+psPTUAcC86/A/VLaE/8h5bJ9jqEHDCSJCE24E+KBzErNQ3
s3teIrdddaZSsg8GgAOLFXYs/jwRG9xRDVeBddgWcKYt0bvpgUq3CGPkhBTzn89Bvc+/
PwwbE8dYC4Jr73wilgFrNzZPPGXMRR+TzzkXb/IotrKWkVeIGcpd7EbCwHaRi1IAm0gF
QSkg==
X-Gm-Message-State: AOJu0Yx/ymuhaUGwXB8NwkIJKU7q7x3TVeiv90nzEVzch8+fW50Ni2Em
cnkwIrCQT7Sf8VzXxYSLbjfES7y7zCd9TjhKtIMdfVv2pavCV8+8JG1lnz1pVSHR
X-Gm-Gg: ASbGnct6CSHAOf66/QmJ/23U60vtnG02Q1aLuQ7eg7hLKLde5KOCjYK4nzrf9WV1Mx6
ivuKzdXbeueXt0TQ72iNDLINXtRyW+xJLl/eSQ1g1QRChr86RxeAa8dhUbvCkXa+RZYl8+FgUCC
sREfDe5CRKKkTuHRm6E2fslrpGF69XZJDPAECc8g3tXZoYWNeRPU79FyqLXbdhXaQb2jee0H3FF
uIMu41gSUUR9jDgNpZguVp2ddtxk6HD6rXpoL7aCbZkJnY+lgWuDFzpxzJCwS8subVr4YBViyAY
6nmWuEiu3SKgAGkFSbey/5yXMYKIR1UwZs4wlAzyOY7rGnF3IzUhuoCj8/7sdyvgMaHPQt5T26t
VLYGtKPGcn9rcsDz2WrBCkCvyC9HwgquSHNPvFmwVydloiarfKbRTvN7MKHiH3dbGnxOt9jbBO9
C2cUKH
X-Google-Smtp-Source: AGHT+IGwDeIf46Z68HQnSMqU/7l5ROj539WFcBagLRfDC1UaezLBAPpmK0Lo7ntMGaHKzjpTTB61rw==
X-Received: by 2002:a05:6830:270b:b0:7c7:827f:2b6a with SMTP id
46e09a7af769-7c97080d971mr2128355a34.37.1765064903268;
Sat, 06 Dec 2025 15:48:23 -0800 (PST)
Received: from fedora ([189.215.160.233]) by smtp.gmail.com with ESMTPSA id
46e09a7af769-7c95ac84f1dsm6858958a34.19.2025.12.06.15.48.09
for <79934 <at> debbugs.gnu.org>
(version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
Sat, 06 Dec 2025 15:48:22 -0800 (PST)
From: =?utf-8?Q?Elijah_Gabe_P=C3=A9rez?= <eg642616@HIDDEN>
To: 79934 <at> debbugs.gnu.org
Subject: Re: bug#79934: [PATCH] hideshow: Deep cleaning
In-Reply-To: <871pl8jqvm.fsf@HIDDEN>
References: <871pldd3a9.fsf@HIDDEN> <871pl8jqvm.fsf@HIDDEN>
Date: Sat, 06 Dec 2025 17:48:00 -0600
Message-ID: <87h5u3p3yn.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/31.0.50
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-Spam-Score: 0.3 (/)
X-Debbugs-Envelope-To: 79934
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -0.7 (/)
--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
Elijah Gabe P=C3=A9rez <eg642616@HIDDEN> writes:
> I've updated and split the patch into parts, so it should be easier to
> push them.
>
> [2. text/x-patch; 0001-hideshow-Deep-cleaning.-Bug-79934.patch]...
I have noticed that this patch has a bug. I already fixed it, I
apologize for the inconvenience.
--=-=-=
Content-Type: text/x-patch; charset=utf-8
Content-Disposition: attachment;
filename=0001-hideshow-Deep-cleaning.-Bug-79934.patch
Content-Transfer-Encoding: quoted-printable
Content-Description: fixed patch
From b2f4ad2d2a4f9d2fa1ad8d37acbed9a616bd0064 Mon Sep 17 00:00:00 2001
From: =3D?UTF-8?q?El=3DC3=3DADas=3D20Gabriel=3D20P=3DC3=3DA9rez?=3D <eg6426=
16@HIDDEN>
Date: Fri, 5 Dec 2025 18:42:54 -0600
Subject: [PATCH] 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.
---
etc/NEWS | 8 +-
lisp/progmodes/hideshow.el | 1301 ++++++++++++-------------
test/lisp/progmodes/hideshow-tests.el | 36 +-
test/lisp/progmodes/python-tests.el | 12 +-
4 files changed, 627 insertions(+), 730 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index ed5efced52c..a04120bbd98 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1102,6 +1102,12 @@ blocks.
*** New command 'hs-toggle-all'.
This command hide or show all the blocks in the current buffer.
=20
+---
+*** 'hs-hide-level' no longer hide all the blocks in the current buffer.
+If 'hs-hide-level' was not inside a code block it would hide all the
+blocks in the buffer like 'hs-hide-all'. Now it should only hide all
+the second level blocks.
+
+++
*** New user option 'hs-display-lines-hidden'.
If this option is non-nil, Hideshow displays the number of hidden lines
@@ -1144,7 +1150,7 @@ after cursor position. By default this is set to 'af=
ter-bol'.
This user option controls the positions on the headline of hideable blocks
where the 'TAB' key cycles the blocks' visibility.
=20
-+++
+---
*** The variable 'hs-special-modes-alist' is now obsolete.
Instead of customizing Hideshow for a mode by setting the elements of
'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 @@
-;;; hideshow.el --- minor mode cmds to selectively display code/comment bl=
ocks -*- lexical-binding:t -*-
+;;; hideshow.el --- Minor mode to hide/show comment or code blocks -*- le=
xical-binding:t -*-
=20
;; Copyright (C) 1994-2025 Free Software Foundation, Inc.
=20
;; Author: Thien-Thi Nguyen <ttn@HIDDEN>
;; Dan Nicolaescu <dann@HIDDEN>
-;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
-;; Maintainer-Version: 5.65.2.2
-;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
+;; Maintainer: emacs-devel@HIDDEN
+;; Keywords: c tools outlines
+;; Maintainer-Version: 6.0
=20
;; This file is part of GNU Emacs.
=20
@@ -27,17 +27,16 @@
=20
;; * Commands provided
;;
-;; This file provides the Hideshow minor mode. When active, nine commands
-;; are available, implementing block hiding and showing. They (and their
-;; keybindings) are:
+;; This file provides the Hideshow minor mode, it includes the
+;; following commands (and their keybindings) to hiding and showing
+;; code and comment blocks:
;;
-;; `hs-hide-block' C-c @ C-h
+;; `hs-hide-block' C-c @ C-h/C-d
;; `hs-show-block' C-c @ C-s
-;; `hs-hide-all' C-c @ C-M-h
-;; `hs-show-all' C-c @ C-M-s
+;; `hs-hide-all' C-c @ C-M-h/C-t
+;; `hs-show-all' C-c @ C-M-s/C-a
;; `hs-hide-level' C-c @ C-l
-;; `hs-toggle-hiding' C-c @ C-c
-;; `hs-toggle-hiding' S-<mouse-2>
+;; `hs-toggle-hiding' C-c @ C-c/C-e or S-<mouse-2>
;; `hs-hide-initial-comment-block'
;; `hs-cycle' C-c @ TAB
;; `hs-toggle-all' C-c @ <backtab>
@@ -45,13 +44,14 @@
;; All these commands are defined in `hs-prefix-map',
;; `hs-minor-mode-map' and `hs-indicators-map'.
;;
-;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they
-;; are simply text between curly braces, while in Lisp-ish modes parens
-;; are used. Multi-line comment blocks can also be hidden. Read-only
-;; buffers are not a problem, since hideshow doesn't modify the text.
+;; Blocks are defined per mode. For example, in c-mode and similar,
+;; they are simply text between curly braces, while in Lisp-ish modes
+;; parens are used. Multi-line comment blocks can also be hidden.
+;; Read-only buffers are not a problem, since hideshow doesn't modify
+;; the text.
;;
;; The command `M-x hs-minor-mode' toggles the minor mode or sets it
-;; (similar to other minor modes).
+;; buffer-local.
=20
;; * Suggested usage
;;
@@ -60,6 +60,9 @@
;; (require 'hideshow)
;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similar=
ly
;;
+;; ;; For use-package users:
+;; (use-package hideshow :hook (X-mode . hs-minor-mode))
+;;
;; where X =3D {emacs-lisp,c,c++,perl,...}. You can also manually toggle
;; 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'.
@@ -78,40 +81,46 @@
;; (if my-hs-hide
;; (hs-hide-all)
;; (hs-show-all)))
-;;
-;; [Your hideshow hacks here!]
=20
;; * Customization
;;
-;; You can use `M-x customize-variable' on the following variables:
+;; Hideshow provides the following user options:
;;
-;; - `hs-hide-comments-when-hiding-all' -- self-explanatory!
-;; - `hs-hide-all-non-comment-function' -- if non-nil, when doing a
-;; `hs-hide-all', this function
-;; is called with no arguments
-;; - `hs-isearch-open' -- what kind of hidden blocks to
-;; open when doing isearch
-;; - `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 enable=
d.
+;; - `hs-hide-comments-when-hiding-all'
+;; self-explanatory!
+;; - `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.
;;
-;; Some languages (e.g., Java) are deeply nested, so the normal behavior
-;; of `hs-hide-all' (hiding all but top-level blocks) results in very
-;; little information shown, which is not very useful. You can use the
-;; variable `hs-hide-all-non-comment-function' to implement your idea of
-;; what is more useful. For example, the following code shows the next
-;; nested level in addition to the top-level:
+;; 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
+;; implement your idea of what is more useful. For example, the
+;; following code shows the next nested level in addition to the
+;; top-level for java:
;;
-;; (defun ttn-hs-hide-level-1 ()
+;; (defun ttn-hs-hide-level-2 ()
;; (when (funcall hs-looking-at-block-start-predicate)
-;; (hs-hide-level 1))
-;; (forward-sexp 1))
-;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
+;; (hs-hide-level 2)))
+;; (setq-mode-local java-mode ; This requires the mode-local package
+;; hs-hide-all-non-comment-function
+;; 'ttn-hs-hide-level-2)
;;
;; Hideshow works with incremental search (isearch) by setting the variable
;; `hs-headline', which is the line of text at the beginning of a hidden
@@ -123,30 +132,25 @@
;; (setq mode-line-format
;; (append '("-" hs-headline) mode-line-format)))
;;
-;; See documentation for `mode-line-format' for more info.
;;
-;; Hooks are run after some commands:
+;; The following hooks are run after some commands:
;;
-;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level
-;; hs-show-hook hs-show-block, hs-show-all
+;; hs-hide-hook =3D> hs-hide-block hs-hide-all hs-hide-level hs-cycle
+;; hs-show-hook =3D> hs-show-block hs-show-all hs-cycle
;;
-;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling
-;; commands when the result of the toggle is to hide or show blocks,
-;; respectively. All hooks are run with `run-hooks'. See the
-;; documentation for each variable or hook for more information.
+;; The variable `hs-set-up-overlay' allow customize the appearance of
+;; the hidden block and other effects associated with overlays. For
+;; example:
;;
-;; See also variable `hs-set-up-overlay' for per-block customization of
-;; appearance or other effects associated with overlays. For example:
-;;
-;; (setq hs-set-up-overlay
-;; (defun my-display-code-line-counts (ov)
-;; (when (eq 'code (overlay-get ov 'hs))
-;; (overlay-put ov 'display
-;; (propertize
-;; (format " ... <%d>"
-;; (count-lines (overlay-start ov)
-;; (overlay-end ov)))
-;; 'face 'font-lock-type-face)))))
+;; (setopt hs-set-up-overlay
+;; (defun my-display-code-line-counts (ov)
+;; (when (eq 'code (overlay-get ov 'hs))
+;; (overlay-put ov 'display
+;; (propertize
+;; (format " [... <%d>] "
+;; (count-lines (overlay-start ov)
+;; (overlay-end ov)))
+;; 'face 'font-lock-type-face)))))
=20
;; * Extending hideshow
=20
@@ -207,45 +211,39 @@
=20
;; * Bugs
;;
-;; (1) Sometimes `hs-headline' can become out of sync. To reset, type
-;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate
-;; hideshow).
+;; 1) Sometimes `hs-headline' can become out of sync. To reset, type
+;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate
+;; hideshow).
;;
-;; (2) Some buffers can't be `byte-compile-file'd properly. This is becau=
se
-;; `byte-compile-file' inserts the file to be compiled in a temporary
-;; buffer and switches `normal-mode' on. In the case where you have
-;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding=
of
-;; the initial comment sometimes hides parts of the first statement (s=
eems
-;; to be only in `normal-mode'), so there are unbalanced "(" and ")".
+;; 2) Some buffers can't be `byte-compile-file'd properly. This is because
+;; `byte-compile-file' inserts the file to be compiled in a temporary
+;; buffer and switches `normal-mode' on. In the case where you have
+;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding =
of
+;; the initial comment sometimes hides parts of the first statement (se=
ems
+;; to be only in `normal-mode'), so there are unbalanced parenthesis.
;;
-;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling:
+;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling:
;;
-;; (defadvice byte-compile-file (around
-;; byte-compile-file-hideshow-off
-;; act)
-;; (let ((hs-minor-mode-hook nil))
-;; ad-do-it))
+;; (define-advice byte-compile-file (:around
+;; (fn &rest rest)
+;; byte-compile-file-hideshow-off)
+;; (let (hs-minor-mode-hook)
+;; (apply #'fn rest)))
;;
-;; (3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, =
the
-;; suggested workaround is to turn off hideshow entirely, for example:
+;; 3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, t=
he
+;; suggested workaround is to turn off hideshow entirely, for example:
;;
-;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow)
-;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow)
+;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow)
+;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow)
;;
-;; In the case of `vc-diff', here is a less invasive workaround:
+;; In the case of `vc-diff', here is a less invasive workaround:
;;
-;; (add-hook 'vc-before-checkin-hook
-;; (lambda ()
-;; (goto-char (point-min))
-;; (hs-show-block)))
+;; (add-hook 'vc-before-checkin-hook
+;; (lambda ()
+;; (goto-char (point-min))
+;; (hs-show-block)))
;;
-;; Unfortunately, these workarounds do not restore hideshow state.
-;; If someone figures out a better way, please let me know.
-
-;; * Correspondence
-;;
-;; Correspondence welcome; please indicate version number. Send bug
-;; reports and inquiries to <ttn@HIDDEN>.
+;; Unfortunately, these workarounds do not restore hideshow state.
=20
;; * Thanks
;;
@@ -264,7 +262,7 @@
;; mouse support, and maintained the code in general. Version 4.0 is
;; largely due to his efforts.
=20
-;; * History
+;; * History (author commentary)
;;
;; Hideshow was inspired when I learned about selective display. It was
;; reimplemented to use overlays for 4.0 (see above). WRT older history,
@@ -276,19 +274,23 @@
;; unbundles state save and restore, and includes more isearch support.
=20
;;; Code:
+
+
+;;;; Libraries
+
(require 'mule-util) ; For `truncate-string-ellipsis'
;; For indicators
(require 'icons)
(require 'fringe)
=20
-;;------------------------------------------------------------------------=
---
-;; user-configurable variables
-
+
(defgroup hideshow nil
"Minor mode for hiding and showing program and comment blocks."
:prefix "hs-"
:group 'languages)
=20
+;;;; Faces
+
(defface hs-ellipsis
'((t :height 0.80 :box (:line-width -1) :inherit (shadow default)))
"Face used for hideshow ellipsis.
@@ -306,6 +308,22 @@ hs-indicator-show
"Face used in hideshow indicator to indicate a shown block."
:version "31.1")
=20
+;;;; Options
+
+(defcustom hs-hide-hook nil
+ "Hook called (with `run-hooks') at the end of commands to hide text.
+These commands include the toggling commands (when the result is to hide
+a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'."
+ :type 'hook
+ :version "31.1")
+
+(defcustom hs-show-hook nil
+ "Hook called (with `run-hooks') at the end of commands to show text.
+These commands include the toggling commands (when the result is to show
+a block), `hs-show-all' and `hs-show-block'."
+ :type 'hook
+ :version "31.1")
+
(defcustom hs-hide-comments-when-hiding-all t
"Hide the comments too when you do an `hs-hide-all'."
:type 'boolean)
@@ -385,54 +403,6 @@ hs-indicator-maximum-buffer-size
:type '(choice natnum (const :tag "No limit" nil))
:version "31.1")
=20
-(define-fringe-bitmap
- 'hs-hide
- [#b0000000
- #b1000001
- #b1100011
- #b0110110
- #b0011100
- #b0001000
- #b0000000])
-
-(define-fringe-bitmap
- 'hs-show
- [#b0110000
- #b0011000
- #b0001100
- #b0000110
- #b0001100
- #b0011000
- #b0110000])
-
-(define-icon hs-indicator-hide nil
- `((image "outline-open.svg" "outline-open.pbm"
- :face hs-indicator-hide
- :height (0.6 . em)
- :ascent center)
- (symbol "=E2=96=BE" "=E2=96=BC" :face hs-indicator-hide)
- (text "-" :face hs-indicator-hide))
- "Icon used for hide block at point.
-This is only used if `hs-indicator-type' is set to `margin' or nil."
- :version "31.1")
-
-(define-icon hs-indicator-show nil
- `((image "outline-close.svg" "outline-close.pbm"
- :face hs-indicator-show
- :height (0.6 . em)
- :ascent center)
- (symbol "=E2=96=B8" "=E2=96=B6" :face hs-indicator-show)
- (text "+" :face hs-indicator-show))
- "Icon used for show block at point.
-This is only used if `hs-indicator-type' is set to `margin' or nil."
- :version "31.1")
-
-;;;###autoload
-(defvar hs-special-modes-alist nil)
-(make-obsolete-variable 'hs-special-modes-alist
- "use the buffer-local variables instead"
- "31.1")
-
(defcustom hs-allow-nesting nil
"If non-nil, hiding remembers internal blocks.
This means that when the outer block is shown again,
@@ -440,16 +410,6 @@ hs-allow-nesting
:type 'boolean
:version "31.1")
=20
-(defvar hs-hide-hook nil
- "Hook called (with `run-hooks') at the end of commands to hide text.
-These commands include the toggling commands (when the result is to hide
-a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
-
-(defvar hs-show-hook nil
- "Hook called (with `run-hooks') at the end of commands to show text.
-These commands include the toggling commands (when the result is to show
-a block), `hs-show-all' and `hs-show-block'.")
-
(defcustom hs-set-up-overlay #'ignore
"Function called with one arg, OV, a newly initialized overlay.
Hideshow puts a unique overlay on each range of text to be hidden
@@ -495,12 +455,52 @@ hs-cycle-filter
(function :tag "Custom filter function"))
:version "31.1")
=20
-;;------------------------------------------------------------------------=
---
-;; internal variables
+;;;; Icons
+
+(define-icon hs-indicator-hide nil
+ `((image "outline-open.svg" "outline-open.pbm"
+ :face hs-indicator-hide
+ :height (0.6 . em)
+ :ascent center)
+ (symbol "=E2=96=BE" "=E2=96=BC" :face hs-indicator-hide)
+ (text "-" :face hs-indicator-hide))
+ "Icon used for hide block at point.
+This is only used if `hs-indicator-type' is set to `margin' or nil."
+ :version "31.1")
=20
-(defvar hs-minor-mode nil
- "Non-nil if using hideshow mode as a minor mode of some other mode.
-Use the command `hs-minor-mode' to toggle or set this variable.")
+(define-icon hs-indicator-show nil
+ `((image "outline-close.svg" "outline-close.pbm"
+ :face hs-indicator-show
+ :height (0.6 . em)
+ :ascent center)
+ (symbol "=E2=96=B8" "=E2=96=B6" :face hs-indicator-show)
+ (text "+" :face hs-indicator-show))
+ "Icon used for show block at point.
+This is only used if `hs-indicator-type' is set to `margin' or nil."
+ :version "31.1")
+
+(define-fringe-bitmap
+ 'hs-hide
+ [#b0000000
+ #b1000001
+ #b1100011
+ #b0110110
+ #b0011100
+ #b0001000
+ #b0000000])
+
+(define-fringe-bitmap
+ 'hs-show
+ [#b0110000
+ #b0011000
+ #b0001100
+ #b0000110
+ #b0001100
+ #b0011000
+ #b0110000])
+
+
+;;;; Keymaps
=20
(defvar-keymap hs-prefix-map
:doc "Keymap for hideshow commands."
@@ -530,8 +530,8 @@ hs-minor-mode-map
(when (and hs-cycle-filter
;; On the headline with hideable blocks
(save-excursion
- (goto-char (line-beginning-position))
- (hs-get-first-block))
+ (forward-line 0)
+ (hs-get-first-block-on-line))
(or (not (functionp hs-cycle-filter))
(funcall hs-cycle-filter)))
cmd)))
@@ -563,7 +563,7 @@ hs-minor-mode-menu
(not hs-hide-comments-when-hiding-all))
:help "If t also hide comment blocks when doing `hs-hide-all'"
:style toggle :selected hs-hide-comments-when-hiding-all]
- ("Reveal on isearch"
+ ("Reveal on isearch"
["Code blocks" (setq hs-isearch-open 'code)
:help "Show hidden code blocks when isearch matches inside them"
:active t :style radio :selected (eq hs-isearch-open 'code)]
@@ -579,13 +579,18 @@ hs-minor-mode-menu
Do not show hidden code or comment blocks when isearch matches inside them"
:active t :style radio :selected (eq hs-isearch-open nil)])))
=20
+
+;;;; Internal variables
+
+(defvar hs-minor-mode)
+
(defvar hs-hide-all-non-comment-function nil
"Function called if non-nil when doing `hs-hide-all' for non-comments.")
=20
(defvar hs-headline nil
"Text of the line where a hidden block begins, set during isearch.
You can display this in the mode line by adding the symbol `hs-headline'
-to the variable `mode-line-format'. For example,
+to the variable `mode-line-format'. For example:
=20
(unless (memq \\=3D'hs-headline mode-line-format)
(setq mode-line-format
@@ -593,21 +598,32 @@ hs-headline
=20
Note that `mode-line-format' is buffer-local.")
=20
+;; Used in `hs-toggle-all'
(defvar-local hs--toggle-all-state)
=20
-;;------------------------------------------------------------------------=
---
-;; API variables
+
+;;;; API variables
+
+;;;###autoload
+(defvar hs-special-modes-alist nil)
+(make-obsolete-variable
+ 'hs-special-modes-alist
+ "use the buffer-local variables instead" "31.1")
=20
(defvar-local hs-block-start-regexp "\\s("
"Regexp for beginning of block.")
=20
+;; This is useless, so probably should be deprecated.
(defvar-local hs-block-start-mdata-select 0
"Element in `hs-block-start-regexp' match data to consider as block star=
t.
The internal function `hs-forward-sexp' moves point to the beginning of th=
is
element (using `match-beginning') before calling `hs-forward-sexp-function=
'.")
=20
(defvar-local hs-block-end-regexp "\\s)"
- "Regexp for end of block.")
+ "Regexp for end of block.
+As a special case, the value can be also a function without arguments to
+determine if point is looking at the end of the block, and return
+non-nil and set `match-data' to that block end positions.")
=20
(defvar-local hs-c-start-regexp nil
"Regexp for beginning of comments.
@@ -619,46 +635,35 @@ hs-c-start-regexp
=20
(define-obsolete-variable-alias
'hs-forward-sexp-func
- 'hs-forward-sexp-function
- "31.1")
+ 'hs-forward-sexp-function "31.1")
=20
(defvar-local hs-forward-sexp-function #'forward-sexp
"Function used to do a `forward-sexp'.
+It is called with 1 argument (like `forward-sexp').
+
Should change for Algol-ish modes. For single-character block
-delimiters -- ie, the syntax table regexp for the character is
-either `(' or `)' -- `hs-forward-sexp-function' would just be
+delimiters such as `(' and `)' `hs-forward-sexp-function' would just be
`forward-sexp'. For other modes such as simula, a more specialized
function is necessary.")
=20
(define-obsolete-variable-alias
'hs-adjust-block-beginning
- 'hs-adjust-block-beginning-function
- "31.1")
+ 'hs-adjust-block-beginning-function "31.1")
=20
(defvar-local hs-adjust-block-beginning-function nil
"Function used to tweak the block beginning.
-The block is hidden from the position returned by this function,
-as opposed to hiding it from the position returned when searching
-for `hs-block-start-regexp'.
-
-For example, in c-like modes, if we wish to also hide the curly braces
-\(if you think they occupy too much space on the screen), this function
-should return the starting point (at the end of line) of the hidden
-region.
+It should return the position from where we should start hiding, as
+opposed to hiding it from the position returned when searching for
+`hs-block-start-regexp'.
=20
It is called with a single argument ARG which is the position in
-buffer after the block beginning.
-
-It should return the position from where we should start hiding.
-
-It should not move the point.
-
-See `hs-c-like-adjust-block-beginning' for an example of using this.")
+buffer after the block beginning.")
=20
(defvar-local hs-adjust-block-end-function nil
"Function used to tweak the block end.
This is useful to ensure some characters such as parenthesis or curly
-braces get properly hidden in python-like modes.
+braces get properly hidden in modes without parenthesis pairs
+delimiters (such as python).
=20
It is called with one argument, which is the start position where the
overlay will be created, and should return either the last position to
@@ -669,7 +674,8 @@ hs-adjust-block-end-function
'hs-find-block-beginning-function
"31.1")
=20
-(defvar-local hs-find-block-beginning-function #'hs-find-block-beginning
+(defvar-local hs-find-block-beginning-function
+ #'hs-find-block-beg-fn--default
"Function used to do `hs-find-block-beginning'.
It should reposition point at the beginning of the current block
and return point, or nil if original point was not in a block.
@@ -683,30 +689,32 @@ hs-find-block-beginning-function
'hs-find-next-block-function
"31.1")
=20
-(defvar-local hs-find-next-block-function #'hs-find-next-block
+(defvar-local hs-find-next-block-function
+ #'hs-find-next-block-fn--default
"Function used to do `hs-find-next-block'.
It should reposition point at next block start.
=20
-It is called with three arguments REGEXP, MAXP, and COMMENTS.
-REGEXP is a regexp representing block start. When block start is
-found, `match-data' should be set using REGEXP. MAXP is a buffer
-position that limits the search. When COMMENTS is nil, comments
-should be skipped. When COMMENTS is not nil, REGEXP matches not
-only beginning of a block but also beginning of a comment. In
-this case, the function should find nearest block or comment.
+It is called with three arguments REGEXP, BOUND, and COMMENTS.
+REGEXP is a regexp representing block start. When block start is found,
+`match-data' should be set using REGEXP. BOUND is a buffer position
+that limits the search. When COMMENTS is non-nil, REGEXP matches not
+only beginning of a block but also beginning of a comment. In this
+case, the function should find nearest block or comment.
=20
-Specifying this function is necessary for languages such as
-Python, where regexp search is not enough to find the beginning
-of the next block.")
+Specifying this function is necessary for languages such as Python,
+where regexp search is not enough to find the beginning of the next
+block.")
=20
(define-obsolete-variable-alias
'hs-looking-at-block-start-p-func
'hs-looking-at-block-start-predicate
"31.1")
=20
-(defvar-local hs-looking-at-block-start-predicate #'hs-looking-at-block-st=
art-p
+(defvar-local hs-looking-at-block-start-predicate
+ #'hs-looking-at-block-start-p--default
"Function used to do `hs-looking-at-block-start-p'.
-It should return non-nil if the point is at the block start.
+It should return non-nil if the point is at the block start and set
+match data with the beginning and end of that position.
=20
Specifying this function is necessary for languages such as
Python, where `looking-at' and `syntax-ppss' check is not enough
@@ -716,47 +724,232 @@ hs-inside-comment-predicate
"Function used to check if point is inside a comment.
If point is inside a comment, the function should return a list
containing the buffer position of the start and the end of the
-comment, otherwise it should return nil.
-
-A comment block can be hidden only if on its starting line there is only
-whitespace preceding the actual comment beginning. If point is inside
-a comment but this condition is not met, the function can return a list
-having nil as its `car' and the end of comment position as its `cdr'.")
+comment, otherwise it should return nil.")
=20
(defvar-local hs-treesit-things 'list
"Treesit things to check if point is at a valid block.
The value should be a thing defined in `treesit-thing-settings' for the
current buffer's major mode.")
=20
-;;------------------------------------------------------------------------=
---
-;; support functions
+
+;;;; API functions
+
+(defmacro hs-life-goes-on (&rest body)
+ "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
+In the dynamic context of this macro, `case-fold-search' is t.
=20
-(defun hs-discard-overlays (from to)
- "Delete hideshow overlays in region defined by FROM and TO.
+This macro encloses BODY in `save-match-data' and `save-excursion'.
+
+Intended to be used for commands."
+ (declare (debug t))
+ `(when hs-minor-mode
+ (let ((case-fold-search t))
+ (save-match-data
+ (save-excursion ,@body)))))
+
+(defun hs-discard-overlays (beg end)
+ "Delete hideshow overlays in region defined by BEG and END.
Skip \"internal\" overlays if `hs-allow-nesting' is non-nil."
- (when (< to from)
- (setq from (prog1 to (setq to from))))
+ (when (< end beg)
+ (setq beg (prog1 end (setq end beg))))
(if hs-allow-nesting
- (let ((from from) ov)
- (while (> to (setq from (next-overlay-change from)))
- (when (setq ov (hs-overlay-at from))
- (setq from (overlay-end ov))
+ (let ((beg beg))
+ (while (> end (setq beg (next-overlay-change beg)))
+ (when-let* ((ov (hs-overlay-at beg)))
+ ;; Reposition point to the end of the overlay, so we avoid
+ ;; removing the nested overlays too.
+ (setq beg (overlay-end ov))
(delete-overlay ov))))
- (dolist (ov (overlays-in from to))
- (when (overlay-get ov 'hs)
- (delete-overlay ov))))
- (hs--refresh-indicators from to))
-
-(defun hs-hideable-region-p (&optional beg end)
- "Return t if region between BEG and END can be hidden.
-If BEG and END are not specified, try to check the current
-block at point."
+ (remove-overlays beg end 'invisible 'hs))
+ (hs--refresh-indicators beg end))
+
+(defun hs-overlay-at (position)
+ "Return hideshow overlay at POSITION, or nil if none to be found."
+ (seq-find
+ (lambda (ov) (overlay-get ov 'hs))
+ (overlays-at position)))
+
+(defun hs-hideable-region-p (beg end)
+ "Return t if region between BEG and END can be hidden."
;; Check if BEG and END are not in the same line number,
;; since using `count-lines' is slow.
- (if (and beg end)
- (< beg (save-excursion (goto-char end) (line-beginning-position)))
- (when-let* ((block (hs-block-positions)))
- (apply #'hs-hideable-region-p block))))
+ (and beg end
+ (< beg (save-excursion (goto-char end) (pos-bol)))))
+
+(defun hs-already-hidden-p ()
+ "Return non-nil if point is in an already-hidden block, otherwise nil."
+ (save-excursion
+ ;; Reposition point if it is inside a comment, and if that comment
+ ;; is hideable
+ (when-let* ((c-reg (funcall hs-inside-comment-predicate)))
+ (goto-char (car c-reg)))
+ ;; Search for a hidden block at EOL ...
+ (eq 'hs
+ (or (get-char-property (pos-eol) 'invisible)
+ ;; ... or behind the current cursor position
+ (get-char-property (if (bobp) (point) (1- (point)))
+ 'invisible)))))
+
+(defun hs-block-positions (&optional adjust-beg adjust-end)
+ "Return the current code block positions.
+This returns a list with the current code block beginning and end
+positions. This does nothing if there is not a code block at current
+point.
+
+If either ADJUST-BEG or ADJUST-END are non-nil, adjust block positions
+according to `hs-adjust-block-beginning', `hs-adjust-block-end-function'
+and `hs-block-end-regexp'."
+ ;; `catch' is used here if the search fails due unbalanced parentheses
+ ;; or any other unknown error caused in `hs-forward-sexp-function'.
+ (catch 'hs--block-exit
+ (save-match-data
+ (save-excursion
+ (when (funcall hs-looking-at-block-start-predicate)
+ (let ((beg (match-end 0)) end)
+ ;; `beg' is the point at the end of the block
+ ;; beginning, which may need to be adjusted
+ (when adjust-beg
+ (save-excursion
+ (when hs-adjust-block-beginning-function
+ (goto-char (funcall hs-adjust-block-beginning-function b=
eg)))
+ (setq beg (pos-eol))))
+
+ (goto-char (match-beginning hs-block-start-mdata-select))
+ (condition-case _
+ (funcall hs-forward-sexp-function 1)
+ (scan-error (throw 'hs-sexp-error nil)))
+ ;; `end' is the point at the end of the block
+ (setq end (cond ((not adjust-end) (point))
+ ((and (stringp hs-block-end-regexp)
+ (looking-back hs-block-end-regexp nil))
+ (match-beginning 0))
+ ((functionp hs-block-end-regexp)
+ (funcall hs-block-end-regexp)
+ (match-beginning 0))
+ (t (point))))
+ ;; adjust block end (if needed)
+ (when (and adjust-end hs-adjust-block-end-function)
+ (setq end (or (funcall hs-adjust-block-end-function beg)
+ end)))
+ (list beg end)))))))
+
+(defun hs-hide-comment-region (beg end &optional _repos-end)
+ "Hide a region from BEG to END, marking it as a comment.
+Optional arg REPOS-END means reposition at end."
+ (declare (obsolete "Use `hs-hide-block-at-point' instead." "31.1"))
+ (hs-hide-block-at-point (list beg end)))
+
+(defun hs-hide-block-at-point (&optional comment-reg)
+ "Hide block if on block beginning.
+Optional arg COMMENT-REG is a list of the form (BEGIN END) and
+specifies the limits of the comment, or nil if the block is not
+a comment.
+
+If hiding the block is successful, return non-nil.
+Otherwise, return nil."
+ (when-let* ((block (or comment-reg (hs-block-positions :a-beg :a-end))))
+ (let ((beg (if comment-reg (save-excursion (goto-char (car block)) (po=
s-eol))
+ (car block)))
+ (end (cadr block))
+ ov)
+ (if (hs-hideable-region-p beg end)
+ (progn
+ (cond (comment-reg (let (hs-allow-nesting)
+ (hs-discard-overlays beg end)))
+ ((and hs-allow-nesting (setq ov (hs-overlay-at beg)))
+ (delete-overlay ov))
+ ((not hs-allow-nesting)
+ (hs-discard-overlays beg end)))
+ (goto-char end)
+ (hs-make-overlay beg end (if comment-reg 'comment 'code)))
+ (when comment-reg (goto-char end))
+ nil))))
+
+(defun hs-get-first-block-on-line (&optional include-comments)
+ "Reposition point to the first valid block found on the current line.
+This searches for a valid block from current point to the end of current
+line and returns the start position of the first block found.
+Otherwise, if no block is found, it returns nil.
+
+If INCLUDE-COMMENTS is non-nil, also search for a comment block."
+ (let ((regexp (if include-comments
+ (concat "\\(" hs-block-start-regexp "\\)"
+ "\\|\\(" hs-c-start-regexp "\\)")
+ hs-block-start-regexp))
+ exit)
+ (while (and (not exit)
+ (funcall hs-find-next-block-function regexp (pos-eol) incl=
ude-comments)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (pcase-let ((`(,beg ,end)
+ (or (and include-comments
+ (funcall hs-inside-comment-predica=
te))
+ (hs-block-positions))))
+ (if (and beg (hs-hideable-region-p beg end))
+ (setq exit (point))
+ t)))))
+ exit))
+
+(defun hs-get-near-block (&optional include-comment)
+ "Reposition point to a near block around point.
+It search for a valid block before and after point and return t if one
+is found.
+
+If INCLUDE-COMMENT is non-nil, it also searches for a comment block,
+returning `comment' if one is found.
+
+Intended to be used in commands."
+ (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate)=
))
+ pos)
+ (cond
+ ((and c-reg (apply #'hs-hideable-region-p c-reg))
+ (goto-char (car c-reg))
+ 'comment)
+
+ ((and (eq hs-hide-block-behavior 'after-bol)
+ (save-excursion
+ (forward-line 0)
+ (setq pos (hs-get-first-block-on-line))))
+ (goto-char pos)
+ t)
+
+ ((and (or (funcall hs-looking-at-block-start-predicate)
+ (and (forward-line 0)
+ (funcall hs-find-block-beginning-function)))
+ (apply #'hs-hideable-region-p (hs-block-positions)))
+ t))))
+
+(defun hs-hide-level-recursive (arg beg end &optional include-comments fun=
c progress)
+ "Recursively hide blocks between BEG and END that are ARG levels below p=
oint.
+If INCLUDE-COMMENTS is non-nil, also hide recursive comment blocks. If
+FUNC is non-nil, call this function to hide the block instead. If
+PROGRESS is non-nil, also update a progress object, intended for
+commands."
+ ;; Show all blocks in that region
+ (unless hs-allow-nesting (hs-discard-overlays beg end))
+ (goto-char beg)
+ (while (not (>=3D (point) end))
+ (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
+ (block (save-excursion
+ (hs-get-first-block-on-line include-comments))))
+ (goto-char (match-beginning 0))
+ (if (> arg 1)
+ ;; Find a block recursively according to ARG.
+ (pcase-let ((`(,beg ,end) (or (and include-comments
+ (funcall hs-inside-comment-pr=
edicate))
+ (hs-block-positions))))
+ (hs-hide-level-recursive (1- arg) beg end include-comments))
+ ;; Now hide the block we found.
+ (if func (funcall func)
+ (hs-hide-block-at-point
+ (and include-comments (funcall hs-inside-comment-predicate))))
+ (when progress
+ (progress-reporter-update progress (point)))))
+ (forward-line 1))
+ (goto-char end))
+
+
+;;;; Internal functions
=20
(defun hs--discard-overlay-before-changes (o &rest _r)
"Remove overlay O before changes.
@@ -767,19 +960,49 @@ hs--discard-overlay-before-changes
(delete-overlay o)
(hs--refresh-indicators beg end)))
=20
-(defun hs-make-overlay (b e kind &optional b-offset e-offset)
+(defun hs--get-ellipsis (b e)
+ "Helper function for `hs-make-overlay'.
+This returns the ellipsis string to use and its face."
+ (let* ((standard-display-table
+ (or standard-display-table (make-display-table)))
+ (d-t-ellipsis
+ (display-table-slot standard-display-table 'selective-display))
+ ;; Convert ellipsis vector to a propertized string
+ (ellipsis
+ (and (vectorp d-t-ellipsis) ; Ensure the vector is not empty
+ (not (length=3D d-t-ellipsis 0))
+ (mapconcat
+ (lambda (g)
+ (apply #'propertize (char-to-string (glyph-char g))
+ (and (glyph-face g) (list 'face (glyph-face g)))))
+ d-t-ellipsis)))
+ (ellipsis-face (and ellipsis (get-text-property 0 'face ellipsis)=
))
+ (apply-face (lambda (str)
+ (apply #'propertize str
+ (and ellipsis-face (list 'face ellipsis-face=
)))))
+ (lines (when-let* (hs-display-lines-hidden
+ (l (1- (count-lines b e)))
+ (l-str (format "%d %s" l
+ (if (=3D l 1) "line" "lines"))))
+ (funcall apply-face l-str)))
+ (tty-strings (and hs-display-lines-hidden (not (display-graphic-p=
))))
+ (string
+ (concat (and tty-strings (funcall apply-face "["))
+ lines
+ (or ellipsis (truncate-string-ellipsis))
+ (and tty-strings (funcall apply-face "]")))))
+ (if ellipsis-face
+ ;; Return ELLIPSIS and LINES if ELLIPSIS has no face
+ string
+ ;; Otherwise propertize both with `hs-ellipsis'
+ (propertize string 'face 'hs-ellipsis))))
+
+(defun hs-make-overlay (b e kind)
"Return a new overlay in region defined by B and E with type KIND.
-KIND is either `code' or `comment'. Optional fourth arg B-OFFSET
-when added to B specifies the actual buffer position where the block
-begins. Likewise for optional fifth arg E-OFFSET. If unspecified
-they are taken to be 0 (zero). The following properties are set
-in the overlay: `invisible' `hs' `hs-b-offset' `hs-e-offset'. Also,
-depending on variable `hs-isearch-open', the following properties may
-be present: `isearch-open-invisible' `isearch-open-invisible-temporary'.
-If variable `hs-set-up-overlay' is non-nil it should specify a function
-to call with the newly initialized overlay."
- (unless b-offset (setq b-offset 0))
- (unless e-offset (setq e-offset 0))
+KIND is either `code' or `comment'. The following properties are set in
+the overlay: `invisible' `hs'. Also, depending on variable
+`hs-isearch-open', the following properties may be present:
+`isearch-open-invisible' `isearch-open-invisible-temporary'."
(let ((ov (make-overlay b e))
(io (if (eq 'block hs-isearch-open)
;; backward compatibility -- `block'<=3D>`code'
@@ -795,8 +1018,6 @@ hs-make-overlay
'keymap '(keymap (mouse-1 . hs-toggle-hiding))))
;; Internal properties
(overlay-put ov 'hs kind)
- (overlay-put ov 'hs-b-offset b-offset)
- (overlay-put ov 'hs-e-offset e-offset)
;; Isearch integration
(when (or (eq io t) (eq io kind))
(overlay-put ov 'isearch-open-invisible 'hs-isearch-show)
@@ -808,48 +1029,9 @@ hs-make-overlay
(overlay-put ov 'insert-behind-hooks '(hs--discard-overlay-before-ch=
anges))
=20
(when hs-set-up-overlay (funcall hs-set-up-overlay ov))
- (hs--refresh-indicators b e)
+ (hs--refresh-indicators b (1+ b))
ov))
=20
-(defun hs-block-positions ()
- "Return the current code block positions.
-This returns a list with the current code block beginning and end
-positions. This does nothing if there is not a code block at current
-point."
- ;; `catch' is used here if the search fails due unbalanced parentheses
- ;; or any other unknown error caused in `hs-forward-sexp'.
- (catch 'hs-sexp-error
- (save-match-data
- (save-excursion
- (when (funcall hs-looking-at-block-start-predicate)
- (let ((mdata (match-data t))
- (header-end (match-end 0))
- block-beg block-end)
- ;; `block-start' is the point at the end of the block
- ;; beginning, which may need to be adjusted
- (save-excursion
- (when hs-adjust-block-beginning-function
- (goto-char (funcall hs-adjust-block-beginning-function hea=
der-end)))
- (setq block-beg (line-end-position)))
- ;; `block-end' is the point at the end of the block
- (condition-case _
- (hs-forward-sexp mdata 1)
- (scan-error (throw 'hs-sexp-error nil)))
- (setq block-end
- (cond ((and (stringp hs-block-end-regexp)
- (looking-back hs-block-end-regexp nil))
- (match-beginning 0))
- ((functionp hs-block-end-regexp)
- (funcall hs-block-end-regexp)
- (match-beginning 0))
- (t (point))))
- ;; adjust block end (if needed)
- (when hs-adjust-block-end-function
- (setq block-end
- (or (funcall hs-adjust-block-end-function block-beg)
- block-end)))
- (list block-beg block-end)))))))
-
(defun hs--make-indicators-overlays (beg)
"Helper function to make the indicators overlays."
(let ((hiddenp (eq 'hs (get-char-property (pos-eol) 'invisible))))
@@ -897,15 +1079,17 @@ hs--make-indicators-overlays
=20
(defun hs--add-indicators (&optional beg end)
"Add hideable indicators from BEG to END."
- (save-excursion
- (setq beg (if (null beg) (window-start) (goto-char beg) (pos-bol))
- end (if (null end) (window-end) (goto-char end) (pos-bol))))
+ (setq beg (progn (goto-char beg) (pos-bol))
+ end (progn (goto-char end)
+ ;; Include the EOL indicator positions
+ (min (1+ (pos-eol)) (point-max))))
(goto-char beg)
(remove-overlays beg end 'hs-indicator t)
=20
(while (not (>=3D (point) end))
(save-excursion
- (when-let* ((b-beg (hs-get-first-block)))
+ (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
+ (b-beg (hs-get-first-block-on-line)))
(hs--make-indicators-overlays b-beg)))
;; Only 1 indicator per line
(forward-line))
@@ -918,43 +1102,6 @@ hs--refresh-indicators
(save-excursion
(hs--add-indicators from to)))))
=20
-(defun hs--get-ellipsis (b e)
- "Helper function for `hs-make-overlay'.
-This returns the ellipsis string to use and its face."
- (let* ((standard-display-table
- (or standard-display-table (make-display-table)))
- (d-t-ellipsis
- (display-table-slot standard-display-table 'selective-display))
- ;; Convert ellipsis vector to a propertized string
- (ellipsis
- (and (vectorp d-t-ellipsis) ; Ensure the vector is not empty
- (not (length=3D d-t-ellipsis 0))
- (mapconcat
- (lambda (g)
- (apply #'propertize (char-to-string (glyph-char g))
- (and (glyph-face g) (list 'face (glyph-face g)))))
- d-t-ellipsis)))
- (ellipsis-face (and ellipsis (get-text-property 0 'face ellipsis)=
))
- (apply-face (lambda (str)
- (apply #'propertize str
- (and ellipsis-face (list 'face ellipsis-face=
)))))
- (lines (when-let* (hs-display-lines-hidden
- (l (1- (count-lines b e)))
- (l-str (format "%d %s" l
- (if (=3D l 1) "line" "lines"))))
- (funcall apply-face l-str)))
- (tty-strings (and hs-display-lines-hidden (not (display-graphic-p=
))))
- (string
- (concat (and tty-strings (funcall apply-face "["))
- lines
- (or ellipsis (truncate-string-ellipsis))
- (and tty-strings (funcall apply-face "]")))))
- (if ellipsis-face
- ;; Return ELLIPSIS and LINES if ELLIPSIS has no face
- string
- ;; Otherwise propertize both with `hs-ellipsis'
- (propertize string 'face 'hs-ellipsis))))
-
(defun hs-isearch-show (ov)
"Delete overlay OV, and set `hs-headline' to nil.
=20
@@ -972,8 +1119,7 @@ hs-isearch-show-temporary
This function is meant to be used as the `isearch-open-invisible-temporary'
property of an overlay."
(setq hs-headline
- (if hide-p
- nil
+ (unless hide-p
(or hs-headline
(let ((start (overlay-start ov)))
(buffer-substring
@@ -990,107 +1136,15 @@ hs-isearch-show-temporary
(overlay-put ov 'display value)
(overlay-put ov 'hs-isearch-display nil))
(when (setq value (overlay-get ov 'display))
- (overlay-put ov 'hs-isearch-display value)
- (overlay-put ov 'display nil))))
+ (overlay-put ov 'display nil)
+ (overlay-put ov 'hs-isearch-display value))))
(overlay-put ov 'invisible (and hide-p 'hs)))
=20
-(defun hs-looking-at-block-start-p ()
+(defun hs-looking-at-block-start-p--default ()
"Return non-nil if the point is at the block start."
(and (looking-at hs-block-start-regexp)
(save-match-data (not (nth 8 (syntax-ppss))))))
=20
-(defun hs-forward-sexp (match-data arg)
- "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function' wi=
th ARG.
-Original match data is restored upon return."
- (save-match-data
- (set-match-data match-data)
- (goto-char (match-beginning hs-block-start-mdata-select))
- (funcall hs-forward-sexp-function arg)))
-
-(defun hs-hide-comment-region (beg end &optional repos-end)
- "Hide a region from BEG to END, marking it as a comment.
-Optional arg REPOS-END means reposition at end."
- (let ((goal-col (current-column))
- (beg-bol (progn (goto-char beg) (line-beginning-position)))
- (beg-eol (line-end-position))
- (end-eol (progn (goto-char end) (line-end-position))))
- (hs-discard-overlays beg-eol end-eol)
- (hs-make-overlay beg-eol end-eol 'comment beg end)
- (goto-char (if repos-end end (min end (+ beg-bol goal-col))))))
-
-(defun hs-hide-block-at-point (&optional end comment-reg)
- "Hide block if on block beginning.
-Optional arg END means reposition at end.
-Optional arg COMMENT-REG is a list of the form (BEGIN END) and
-specifies the limits of the comment, or nil if the block is not
-a comment.
-
-The block beginning is adjusted by `hs-adjust-block-beginning-function'
-and then further adjusted to be at the end of the line.
-
-If hiding the block is successful, return non-nil.
-Otherwise, return nil."
- (if comment-reg
- (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
- (when-let* ((block (hs-block-positions)))
- (let ((p (car block))
- (q (cadr block))
- ov)
- (if (hs-hideable-region-p p q)
- (progn
- (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p)))
- (delete-overlay ov))
- ((not hs-allow-nesting)
- (hs-discard-overlays p q)))
- (goto-char q)
- (hs-make-overlay p q 'code (- (match-end 0) p)))
- (goto-char (if end q (min p (match-end 0))))
- nil)))))
-
-(defun hs-get-first-block ()
- "Return the position of the first valid block found on the current line.
-This searches for a valid block on the current line and returns the
-first block found. Otherwise, if no block is found, it returns nil."
- (let (exit)
- (while (and (not exit)
- (funcall hs-find-next-block-function
- hs-block-start-regexp
- (line-end-position) nil)
- (save-excursion
- (goto-char (match-beginning 0))
- (if (hs-hideable-region-p)
- (setq exit (match-beginning 0))
- t))))
- exit))
-
-(defun hs-get-near-block (&optional include-comment)
- "Reposition point to a near block around point.
-It search for a valid block before and after point and return t if one
-is found.
-
-If INCLUDE-COMMENT is non-nil, it also searches for a comment block,
-returning `comment' if one is found."
- (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate)=
))
- pos)
- (cond
- ((and c-reg (car c-reg) (hs-hideable-region-p
- (car c-reg) (cadr c-reg)))
- (goto-char (car c-reg))
- 'comment)
-
- ((and (eq hs-hide-block-behavior 'after-bol)
- (save-excursion
- (goto-char (line-beginning-position))
- (setq pos (hs-get-first-block))))
- (goto-char pos)
- t)
-
- ((and (or (funcall hs-looking-at-block-start-predicate)
- (and (goto-char (line-beginning-position))
- (funcall hs-find-block-beginning-function)))
- (hs-hideable-region-p))
- t))))
-
(defun hs-inside-comment-p ()
(declare (obsolete "Call `hs-inside-comment-predicate' instead." "31.1"))
(funcall hs-inside-comment-predicate))
@@ -1100,51 +1154,32 @@ hs-inside-comment-p--default
;; the idea is to look backwards for a comment start regexp, do a
;; forward comment, and see if we are inside, then extend
;; forward and backward as long as we have comments
- (let ((q (point)))
- (skip-chars-forward "[:blank:]")
- (when (or (looking-at hs-c-start-regexp)
- (re-search-backward hs-c-start-regexp (point-min) t))
- ;; first get to the beginning of this comment...
- (while (and (not (bobp))
- (=3D (point) (progn (forward-comment -1) (point))))
- (forward-char -1))
- ;; ...then extend backwards
- (forward-comment (- (buffer-size)))
- (skip-chars-forward " \t\n\f")
- (let ((p (point))
- (hideable t))
- (beginning-of-line)
- (unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
- ;; we are in this situation: (example)
- ;; (defun bar ()
- ;; (foo)
- ;; ) ; comment
- ;; ^
- ;; the point was here before doing (beginning-of-line)
- ;; here we should advance till the next comment which
- ;; eventually has only white spaces preceding it on the same
- ;; line
- (goto-char p)
- (forward-comment 1)
- (skip-chars-forward " \t\n\f")
- (setq p (point))
- (while (and (< (point) q)
- (> (point) p)
- (not (looking-at hs-c-start-regexp)))
- ;; avoid an infinite cycle
- (setq p (point))
- (forward-comment 1)
- (skip-chars-forward " \t\n\f"))
- (when (or (not (looking-at hs-c-start-regexp))
- (> (point) q))
- ;; we cannot hide this comment block
- (setq hideable nil)))
- ;; goto the end of the comment
- (forward-comment (buffer-size))
- (skip-chars-backward " \t\n\f")
- (end-of-line)
- (when (>=3D (point) q)
- (list (and hideable p) (point))))))))
+ (let ((amount (buffer-size))
+ (rx (concat "^[[:blank:]]*\\(" hs-c-start-regexp "\\)"))
+ beg end)
+ (when (or (and (skip-chars-forward "[:blank:]")
+ (looking-at-p hs-c-start-regexp)
+ ;; Check if there are not whitespaces before the comm=
ent
+ (if (save-excursion
+ (forward-line 0) (not (looking-at-p rx)))
+ (setq amount 1)
+ t))
+ (and (re-search-backward rx (pos-bol) t)
+ (goto-char (match-beginning 1))))
+
+ (setq beg (if (=3D amount 1)
+ (pos-eol)
+ (forward-comment (- amount))
+ (skip-chars-forward " \t\n\f")
+ (unless (save-excursion
+ (forward-line 0) (looking-at-p rx))
+ (forward-comment 1)
+ (skip-chars-forward " \t\n\f"))
+ (pos-eol))
+ end (progn (forward-comment amount)
+ (skip-chars-backward " \t\n\f")
+ (point)))
+ (list beg end)))))
=20
(defun hs--set-variable (var nth &optional default)
"Set Hideshow VAR if already not set.
@@ -1188,103 +1223,46 @@ hs-grok-mode-type
(hs--set-variable 'hs-find-next-block-function 7)
(hs--set-variable 'hs-looking-at-block-start-predicate 8))
=20
-(defun hs-find-block-beginning ()
- "Reposition point at block-start.
-Return point, or nil if original point was not in a block."
- (let ((done nil)
- (here (point)))
- ;; look if current line is block start
- (if (funcall hs-looking-at-block-start-predicate)
- (point)
- ;; look backward for the start of a block that contains the cursor
- (while (and (re-search-backward hs-block-start-regexp nil t)
- ;; go again if in a comment or a string
- (or (save-match-data (nth 8 (syntax-ppss)))
- (not (setq done
- (< here (save-excursion
- (hs-forward-sexp (match-data t) 1)
- (point))))))))
- (if done
- (point)
- (goto-char here)
- nil))))
+(defun hs-forward-sexp (match-data _arg)
+ "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function' wi=
th ARG.
+Original match data is restored upon return."
+ (declare (obsolete "Use `hs-block-positions' instead." "31.1"))
+ (save-match-data
+ (set-match-data match-data)
+ (goto-char (match-beginning hs-block-start-mdata-select))
+ (funcall hs-forward-sexp-function 1)))
=20
-(defun hs-find-next-block (regexp maxp comments)
+(define-obsolete-function-alias
+ 'hs-find-next-block 'hs-find-next-block-fn--default "31.1")
+
+(defun hs-find-next-block-fn--default (regexp bound comments)
"Reposition point at next block-start.
Skip comments if COMMENTS is nil, and search for REGEXP in
-region (point MAXP)."
+region (point BOUND)."
(when (not comments)
(forward-comment (point-max)))
- (and (< (point) maxp)
- (re-search-forward regexp maxp t)))
-
-(defun hs-hide-level-recursive (arg &optional beg end)
- "Recursively hide blocks between BEG and END that are ARG levels below p=
oint.
-If BEG and END are not specified, it will search for a near block and
-use its position instead.
-
-If point is inside a block, it will use the current block positions
-instead of BEG and END."
- ;; If we are near of a block, set BEG and END according to that
- ;; block positions.
- (when (funcall hs-find-block-beginning-function)
- (let ((block (hs-block-positions)))
- (setq beg (point) end (cadr block))))
-
- ;; Show all blocks in that region
- (unless hs-allow-nesting (hs-discard-overlays beg end))
-
- ;; Skip initial block
- (goto-char (1+ beg))
-
- (while (funcall hs-find-next-block-function hs-block-start-regexp end ni=
l)
- (if (> arg 1)
- (hs-hide-level-recursive (1- arg))
- ;; `hs-hide-block-at-point' already moves the cursor, but if it
- ;; fails, return to the previous position where we were.
- (unless (and (goto-char (match-beginning hs-block-start-mdata-select=
))
- (hs-hide-block-at-point t))
- (goto-char (match-end hs-block-start-mdata-select)))))
+ (and (< (point) bound)
+ (re-search-forward regexp bound t)))
=20
- (goto-char end))
-
-(defmacro hs-life-goes-on (&rest body)
- "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
-In the dynamic context of this macro, `case-fold-search' is t."
- (declare (debug t))
- `(when hs-minor-mode
- (let ((case-fold-search t))
- (save-match-data
- (save-excursion ,@body)))))
+(define-obsolete-function-alias
+ 'hs-find-block-beginning 'hs-find-block-beg-fn--default "31.1")
=20
-(defun hs-find-block-beginning-match ()
- "Reposition point at the end of match of the block-start regexp.
+(defun hs-find-block-beg-fn--default ()
+ "Reposition point at block-start.
Return point, or nil if original point was not in a block."
- (when (and (funcall hs-find-block-beginning-function)
- (funcall hs-looking-at-block-start-predicate))
- ;; point is inside a block
- (goto-char (match-end 0))))
-
-(defun hs-overlay-at (position)
- "Return hideshow overlay at POSITION, or nil if none to be found."
- (let ((overlays (overlays-at position))
- ov found)
- (while (and (not found) (setq ov (car overlays)))
- (setq found (and (overlay-get ov 'hs) ov)
- overlays (cdr overlays)))
- found))
-
-(defun hs-already-hidden-p ()
- "Return non-nil if point is in an already-hidden block, otherwise nil."
- (save-excursion
- (let ((c-reg (funcall hs-inside-comment-predicate)))
- (when (and c-reg (nth 0 c-reg))
- ;; point is inside a comment, and that comment is hideable
- (goto-char (nth 0 c-reg))))
- ;; Search for a hidden block at EOL ...
- (or (eq 'hs (get-char-property (line-end-position) 'invisible))
- ;; ... or behind the current cursor position
- (eq 'hs (get-char-property (if (bobp) (point) (1- (point))) 'invis=
ible)))))
+ (let ((here (point)) done)
+ ;; look if current line is block start
+ (if (funcall hs-looking-at-block-start-predicate)
+ here
+ ;; look backward for the start of a block that contains the cursor
+ (save-excursion
+ (while (and (re-search-backward hs-block-start-regexp nil t)
+ (goto-char (match-beginning hs-block-start-mdata-selec=
t))
+ ;; go again if in a comment or a string
+ (or (save-match-data (nth 8 (syntax-ppss)))
+ (not (setq done (and (<=3D here (cadr (hs-block-positions)))
+ (point))))))))
+ (when done (goto-char done)))))
=20
;; This function is not used anymore (Bug#700).
(defun hs-c-like-adjust-block-beginning (initial)
@@ -1292,62 +1270,35 @@ hs-c-like-adjust-block-beginning
Actually, point is never moved; a new position is returned that is
the end of the C-function header. This adjustment function is meant
to be assigned to `hs-adjust-block-beginning-function' for C-like modes."
+ (declare (obsolete "Use `hs-adjust-block-beginning-function' instead." "=
31.1"))
(save-excursion
(goto-char (1- initial))
(forward-comment (- (buffer-size)))
(point)))
=20
-;;------------------------------------------------------------------------=
---
-;; commands
+;;;###autoload
+(defun turn-off-hideshow ()
+ "Unconditionally turn off `hs-minor-mode'."
+ (hs-minor-mode -1))
+
+
+;;;; Commands
=20
(defun hs-hide-all ()
- "Hide all top level blocks, displaying only first and last lines.
-Move point to the beginning of the line, and run the normal hook
-`hs-hide-hook'. See documentation for `run-hooks'.
-If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
+ "Hide all top level blocks.
+This command runs `hs-hide-hook'.
+If `hs-hide-comments-when-hiding-all' is non-nil, also hide the
+comments."
(interactive)
(hs-life-goes-on
- (save-excursion
- (unless hs-allow-nesting
- (hs-discard-overlays (point-min) (point-max)))
- (goto-char (point-min))
- (syntax-propertize (point-max))
- (let ((spew (make-progress-reporter "Hiding all blocks..."
- (point-min) (point-max)))
- (re (when (stringp hs-block-start-regexp)
- (concat "\\("
- hs-block-start-regexp
- "\\)"
- (if (and hs-hide-comments-when-hiding-all
- (stringp hs-c-start-regexp))
- (concat "\\|\\("
- hs-c-start-regexp
- "\\)")
- "")))))
- (while (funcall hs-find-next-block-function re (point-max)
- hs-hide-comments-when-hiding-all)
- (if (match-beginning 1)
- ;; We have found a block beginning.
- (progn
- (goto-char (match-beginning 1))
- (unless (if hs-hide-all-non-comment-function
- (funcall hs-hide-all-non-comment-function)
- (hs-hide-block-at-point t))
- ;; Go to end of matched data to prevent from getting stuck
- ;; with an endless loop.
- (when (if (stringp hs-block-start-regexp)
- (looking-at hs-block-start-regexp)
- (eq (point) (match-beginning 0)))
- (goto-char (match-end 0)))))
- ;; found a comment, probably
- (let ((c-reg (funcall hs-inside-comment-predicate)))
- (when (and c-reg (car c-reg))
- (if (hs-hideable-region-p (car c-reg) (nth 1 c-reg))
- (hs-hide-block-at-point t c-reg)
- (goto-char (nth 1 c-reg))))))
- (progress-reporter-update spew (point)))
- (progress-reporter-done spew)))
- (beginning-of-line)
+ (let ((spew (make-progress-reporter
+ "Hiding all blocks..." (point-min) (point-max))))
+ (hs-hide-level-recursive
+ 1 (point-min) (point-max)
+ hs-hide-comments-when-hiding-all
+ hs-hide-all-non-comment-function
+ spew)
+ (progress-reporter-done spew))
(run-hooks 'hs-hide-hook)))
=20
(defun hs-show-all ()
@@ -1355,76 +1306,63 @@ hs-show-all
(interactive)
(hs-life-goes-on
(message "Showing all blocks ...")
- (let ((hs-allow-nesting nil))
+ (let (hs-allow-nesting)
(hs-discard-overlays (point-min) (point-max)))
(message "Showing all blocks ... done")
(run-hooks 'hs-show-hook)))
=20
-(defun hs-hide-block (&optional end)
- "Select a block and hide it. With prefix arg, reposition at END.
-Upon completion, point is repositioned and the normal hook
-`hs-hide-hook' is run. See documentation for `run-hooks'."
- (interactive "P")
+(defun hs-hide-block ()
+ "Select a block and hide it.
+This command runs `hs-hide-hook'."
+ (interactive)
(hs-life-goes-on
(let ((c-reg (funcall hs-inside-comment-predicate)))
(cond
- ((and c-reg (or (null (nth 0 c-reg))
- (not (hs-hideable-region-p (car c-reg) (nth 1 c-reg)=
))))
+ ((and c-reg (not (apply #'hs-hideable-region-p c-reg)))
(user-error "(not enough comment lines to hide)"))
-
- (c-reg (hs-hide-block-at-point end c-reg))
-
- ((hs-get-near-block) (hs-hide-block-at-point)))
-
+ ((or c-reg (hs-get-near-block))
+ (hs-hide-block-at-point c-reg)))
(run-hooks 'hs-hide-hook))))
=20
-(defun hs-show-block (&optional end)
+(defun hs-show-block ()
"Select a block and show it.
-With prefix arg, reposition at END. Upon completion, point is
-repositioned and the normal hook `hs-show-hook' is run.
-See documentation for functions `hs-hide-block' and `run-hooks'."
- (interactive "P")
+This command runs `hs-show-hook'. See documentation for functions
+`hs-hide-block' and `run-hooks'."
+ (interactive)
(hs-life-goes-on
- (or
- ;; first see if we have something at the end of the line
- (let ((ov (hs-overlay-at (line-end-position)))
- (here (point))
- ov-start ov-end)
- (when ov
- (goto-char
- (cond (end (overlay-end ov))
- ((eq 'comment (overlay-get ov 'hs)) here)
- (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset)))))
- (setq ov-start (overlay-start ov))
- (setq ov-end (overlay-end ov))
- (delete-overlay ov)
- (hs--refresh-indicators ov-start ov-end)
- t))
- ;; not immediately obvious, look for a suitable block
- (let ((c-reg (funcall hs-inside-comment-predicate))
- p q)
- (cond (c-reg
- (when (car c-reg)
- (setq p (car c-reg)
- q (cadr c-reg))))
- ((and (funcall hs-find-block-beginning-function)
- ;; ugh, fresh match-data
- (funcall hs-looking-at-block-start-predicate))
- (setq p (point)
- q (progn (hs-forward-sexp (match-data t) 1) (point)))))
- (when (and p q)
- (hs-discard-overlays p q)
- (goto-char (if end q (1+ p))))))
+ (if-let* ((ov (hs-overlay-at (pos-eol)))
+ (ov-start (overlay-start ov))
+ (ov-end (overlay-end ov)))
+ (progn
+ (hs-discard-overlays (1- ov-start) ov-end)
+ (hs--refresh-indicators ov-start ov-end))
+ (when-let* ((block
+ (or (funcall hs-inside-comment-predicate)
+ (and (funcall hs-find-block-beginning-function)
+ (hs-block-positions)))))
+ (hs-discard-overlays (car block) (cadr block))))
(run-hooks 'hs-show-hook)))
=20
(defun hs-hide-level (arg)
"Hide all blocks ARG levels below this block.
+If point is not in a block, hide all the ARG levels blocks in the whole
+buffer.
+
The hook `hs-hide-hook' is run; see `run-hooks'."
(interactive "p")
(hs-life-goes-on
(save-excursion
(message "Hiding blocks ...")
- (hs-hide-level-recursive arg (point-min) (point-max))
+ (if (hs-get-near-block)
+ ;; Hide block if we are looking at one.
+ (apply #'hs-hide-level-recursive arg
+ (hs-block-positions))
+ ;; Otherwise hide all the blocks in the current buffer
+ (hs-hide-level-recursive
+ ;; Increment ARG by 1, avoiding it acts like
+ ;; `hs-hide-all'
+ (1+ arg)
+ (point-min) (point-max)))
(message "Hiding blocks ... done"))
(run-hooks 'hs-hide-hook)))
=20
@@ -1465,15 +1403,10 @@ hs-hide-initial-comment-block
This can be useful if you have huge RCS logs in those comments."
(interactive)
(hs-life-goes-on
- (let ((c-reg (save-excursion
- (goto-char (point-min))
- (skip-chars-forward " \t\n\f")
- (funcall hs-inside-comment-predicate))))
- (when c-reg
- (let ((beg (car c-reg)) (end (cadr c-reg)))
- ;; see if we have enough comment lines to hide
- (when (hs-hideable-region-p beg end)
- (hs-hide-comment-region beg end)))))))
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n\f")
+ (when-let* ((c-reg (funcall hs-inside-comment-predicate)))
+ (hs-hide-block-at-point c-reg))))
=20
(defun hs-cycle (&optional level)
"Cycle the visibility state of the current block.
@@ -1490,11 +1423,12 @@ hs-cycle
(hs-toggle-hiding)
(message "Toggle visibility"))
((> level 1)
- (hs-hide-level-recursive level)
+ (apply #'hs-hide-level-recursive level
+ (hs-block-positions))
(message "Hide %d level" level))
(t
(let* (hs-allow-nesting
- (block (hs-block-positions))
+ (block (hs-block-positions nil :ad-end))
(ov (seq-find
(lambda (o)
(and (eq (overlay-get o 'invisible) 'hs)))
@@ -1505,9 +1439,8 @@ hs-cycle
(hs-hide-block)
(message "Hide block and nested blocks"))
;; Hide the children blocks if the parent block is hidden
- ((and (=3D (overlay-start ov) (car block))
- (=3D (overlay-end ov) (cadr block)))
- (hs-hide-level-recursive 1)
+ ((=3D (overlay-end ov) (cadr block))
+ (apply #'hs-hide-level-recursive 1 block)
(message "Hide first nested blocks"))
;; Otherwise show all in the parent block, we cannot use
;; `hs-show-block' here because we already know the
@@ -1533,10 +1466,6 @@ hs-minor-mode
commands and the hideshow commands are enabled.
The value (hs . t) is added to `buffer-invisibility-spec'.
=20
-The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block',
-`hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also
-`hs-hide-initial-comment-block'.
-
Turning hideshow minor mode off reverts the menu bar and the
variables to default values and disables the hideshow commands.
=20
@@ -1556,12 +1485,11 @@ hs-minor-mode
(user-error "%S doesn't support the Hideshow minor mode"
major-mode))
=20
- ;; Set the variables
+ ;; Set the old variables
(hs-grok-mode-type)
;; Turn off this mode if we change major modes.
(add-hook 'change-major-mode-hook
- #'turn-off-hideshow
- nil t)
+ #'turn-off-hideshow nil t)
(setq-local line-move-ignore-invisible t)
(add-to-invisibility-spec '(hs . t))
;; Add block indicators
@@ -1575,21 +1503,12 @@ hs-minor-mode
(jit-lock-register #'hs--add-indicators)))
=20
(remove-from-invisibility-spec '(hs . t))
- ;; hs-show-all does nothing unless h-m-m is non-nil.
- (let ((hs-minor-mode t))
- (hs-show-all))
+ (remove-overlays nil nil 'hs-indicator t)
+ (remove-overlays nil nil 'invisible 'hs)
(when hs-show-indicators
- (jit-lock-unregister #'hs--add-indicators)
- (remove-overlays nil nil 'hs-indicator t))))
-
-;;;###autoload
-(defun turn-off-hideshow ()
- "Unconditionally turn off `hs-minor-mode'."
- (hs-minor-mode -1))
-
-;;------------------------------------------------------------------------=
---
-;; that's it
+ (jit-lock-unregister #'hs--add-indicators))))
=20
+
+;;;; that's it
(provide 'hideshow)
-
;;; hideshow.el ends here
diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hi=
deshow-tests.el
index 9cf60c1ec84..39161f2455c 100644
--- a/test/lisp/progmodes/hideshow-tests.el
+++ b/test/lisp/progmodes/hideshow-tests.el
@@ -246,7 +246,7 @@ hideshow-hide-all-2
(should (string=3D (hideshow-tests-visible-string) contents)))))
=20
(ert-deftest hideshow-hide-level-1 ()
- "Should hide 1st level blocks."
+ "Should hide 2st level blocks."
(hideshow-tests-with-temp-buffer
c-mode
"
@@ -274,40 +274,6 @@ hideshow-hide-level-1
=20
\"String\"
=20
-int
-main(int argc, char **argv)
-{}
-"))))
-
-(ert-deftest hideshow-hide-level-2 ()
- "Should hide 2nd level blocks."
- (hideshow-tests-with-temp-buffer
- c-mode
- "
-/*
- Comments
-*/
-
-\"String\"
-
-int
-main(int argc, char **argv)
-{
- if (argc > 1) {
- printf(\"Hello\\n\");
- }
-}
-"
- (hs-hide-level 2)
- (should (string=3D
- (hideshow-tests-visible-string)
- "
-/*
- Comments
-*/
-
-\"String\"
-
int
main(int argc, char **argv)
{
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/pyth=
on-tests.el
index b9130da495d..6ddd57c9db2 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -7428,7 +7428,7 @@ python-hideshow-hide-levels-2
(or enabled (hs-minor-mode -1)))))
=20
(ert-deftest python-hideshow-hide-levels-3 ()
- "Should hide all blocks."
+ "Should hide 2nd level blocks."
(python-tests-with-temp-buffer
"
def f():
@@ -7447,19 +7447,22 @@ python-hideshow-hide-levels-3
(python-tests-visible-string)
"
def f():
+ if 0:
=20
def g():
+ pass
"))))
=20
(ert-deftest python-hideshow-hide-levels-4 ()
- "Should hide 2nd level block."
+ "Should hide 3nd level block."
(python-tests-with-temp-buffer
"
def f():
if 0:
l =3D [i for i in range(5)
if i < 3]
- abc =3D o.match(1, 2, 3)
+ if 1:
+ abc =3D o.match(1, 2, 3)
=20
def g():
pass
@@ -7472,6 +7475,9 @@ python-hideshow-hide-levels-4
"
def f():
if 0:
+ l =3D [i for i in range(5)
+ if i < 3]
+ if 1:
=20
def g():
pass
--=20
2.52.0
--=-=-=
Content-Type: text/plain
--
- E.G via Gnus and Org.
--=-=-=--
bug-gnu-emacs@HIDDEN:bug#79934; Package emacs.
Full text available.
Received: (at 79934) by debbugs.gnu.org; 6 Dec 2025 02:17:44 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Dec 05 21:17:44 2025
Received: from localhost ([127.0.0.1]:56286 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1vRhrg-0005dW-Iu
for submit <at> debbugs.gnu.org; Fri, 05 Dec 2025 21:17:44 -0500
Received: from mail-ot1-x344.google.com ([2607:f8b0:4864:20::344]:47361)
by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
(Exim 4.84_2) (envelope-from <eg642616@HIDDEN>)
id 1vRhra-0005dB-Jd
for 79934 <at> debbugs.gnu.org; Fri, 05 Dec 2025 21:17:38 -0500
Received: by mail-ot1-x344.google.com with SMTP id
46e09a7af769-7c765f41346so1531896a34.3
for <79934 <at> debbugs.gnu.org>; Fri, 05 Dec 2025 18:17:34 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=gmail.com; s=20230601; t=1764987448; x=1765592248; darn=debbugs.gnu.org;
h=mime-version:user-agent:message-id:date:references:in-reply-to
:subject:to:from:from:to:cc:subject:date:message-id:reply-to;
bh=MwQ9OpU3jINCzj/XxFISWj4u7n/dxZ2HQGXRWKpWgck=;
b=HhNwa/YdKzrs05MPzPWHNuD0ErjljwD3uRGK6mCbgm7r5mGjOAVdtF39KvW4NDt75o
0vYoJNnCweRhdM8RAdLy8CGYDshHAEitwpfyhrciacnrW1b6A7x/50bP7ni5yNWZiaJu
AU6C4Qi1qNNxnugFZYj+dzMda5Q0Mdjd9PZbp68b8vdzMlYFpr4kCJzVRlq0ODSOfrsx
Asv23Nk3QvO0y6a8WCXANPmQ3nQvRhYjKoc0zbwfV4SbcaAUiVWLssgPjys5GLmF0zyn
syC0vgiRFjH9n8U3GNbMV1KLYpT5NTlWQwrl/OPIQFfPPRLikxuGTfwWRH9BAP9eNr5L
l75g==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=1e100.net; s=20230601; t=1764987448; x=1765592248;
h=mime-version:user-agent:message-id:date:references:in-reply-to
:subject:to:from:x-gm-gg:x-gm-message-state:from:to:cc:subject:date
:message-id:reply-to;
bh=MwQ9OpU3jINCzj/XxFISWj4u7n/dxZ2HQGXRWKpWgck=;
b=V4o3MBxku0jQ5CYoJiJQQfYJNi/8nDAQaliCI4ZPzb1QsSeUCYtDbB6s3YOoRZ1ac+
zcie3V0emrPU2p8+Jx92reIHvZAmD92AVyRMwXWsopiqgTnHgDEU34/uXr3oo9A+vZAt
9XGA/TK7FsN5sUKxWwjKPfIQxRz5rz3K1MV1E0Py2rDu2DEXe1dwFJFW51QUg3eTCOZb
8tKepW7/eL18bTHrl9IHC7EJsJJ225cjJY8RmcqAKfE8HfbnigA9QvRaJiRn/n02UAVL
6fp9MdJgfBJoBfEYCcuMYTLaedxTCxmRteEynFT9v5eE548BO/SUZXUJkMOA81sbTUM8
a+yw==
X-Gm-Message-State: AOJu0Yy8Kz0ga2AGO6/W4EddhivtfAZJ+n2b0iR9Nhy5eTn943qczHao
YGm3/pqqM4aXfEm6/OW3OSh69LqK1CJH2IfyXvs4VK9oODvgTLY4ScHqylV2oMwa
X-Gm-Gg: ASbGncsh11BY7ZeIjWZw16MWJEg1SQDfu3fdj+wOs7W2OUV4a1XqzfmXp3cpiS4evyq
iLQwKK2sTL5zsmMVmnrGhjn65dOXuNjlkYjlkMz/7xOdd1YistDFu4WojWmaq1RyiLSI0NEEjAb
yMdAtxqctXWSwNogKzU6AGukcVhDgZeabtRb8dZlITCIzGpahGHPZRyEg7LFPDHbEb6SL/r9mqZ
+2tlj2McDyfLQ5diTXIasN28xo6aOSYaqJxxwo/Fwxb5S27jxcG674TeozvjH+5aBqvT8/Y/R7H
hcQ++MFKPF4P2LdhkyDesrJxLW6UT+b6OBnkQROSoR+g614aTvBbOZFSnBxWFKvga98XM5qg1Fp
EPrfY3ceTjzOdKkdoQqE5q5nb0goqceK8C7vIxfWd2YXGUCScna4WGcXE28Istxvwh29/fEEHyu
BSUBxf
X-Google-Smtp-Source: AGHT+IHbgR6RV7KB+55hI46B6whEvBesRPO3k15pnmmQwMQZHMQqhYB08NYmmlRnr8BLRSMW4T2nWQ==
X-Received: by 2002:a05:6830:2e07:b0:7c7:1c87:4f95 with SMTP id
46e09a7af769-7c970784b5amr801092a34.4.1764987448362;
Fri, 05 Dec 2025 18:17:28 -0800 (PST)
Received: from fedora ([189.215.160.233]) by smtp.gmail.com with ESMTPSA id
46e09a7af769-7c95a91eecbsm5324184a34.11.2025.12.05.18.17.19
for <79934 <at> debbugs.gnu.org>
(version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
Fri, 05 Dec 2025 18:17:27 -0800 (PST)
From: =?utf-8?Q?Elijah_Gabe_P=C3=A9rez?= <eg642616@HIDDEN>
To: 79934 <at> debbugs.gnu.org
Subject: Re: bug#79934: [PATCH] hideshow: Deep cleaning
In-Reply-To: <871pldd3a9.fsf@HIDDEN>
References: <871pldd3a9.fsf@HIDDEN>
Date: Fri, 05 Dec 2025 20:17:17 -0600
Message-ID: <871pl8jqvm.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/31.0.50
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-Spam-Score: 0.3 (/)
X-Debbugs-Envelope-To: 79934
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -0.7 (/)
--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
Elijah Gabe P=C3=A9rez <eg642616@HIDDEN> writes:
I've updated and split the patch into parts, so it should be easier to
push them.
--=-=-=
Content-Type: text/x-patch; charset=utf-8
Content-Disposition: attachment;
filename=0001-hideshow-Deep-cleaning.-Bug-79934.patch
Content-Transfer-Encoding: quoted-printable
From 8f71b5d61e6864981f837b03bab3fb10c6626f9e Mon Sep 17 00:00:00 2001
From: =3D?UTF-8?q?El=3DC3=3DADas=3D20Gabriel=3D20P=3DC3=3DA9rez?=3D <eg6426=
16@HIDDEN>
Date: Fri, 5 Dec 2025 18:42:54 -0600
Subject: [PATCH] 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.
---
etc/NEWS | 8 +-
lisp/progmodes/hideshow.el | 1297 ++++++++++++-------------
test/lisp/progmodes/hideshow-tests.el | 36 +-
test/lisp/progmodes/python-tests.el | 12 +-
4 files changed, 626 insertions(+), 727 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index ed5efced52c..a04120bbd98 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1102,6 +1102,12 @@ blocks.
*** New command 'hs-toggle-all'.
This command hide or show all the blocks in the current buffer.
=20
+---
+*** 'hs-hide-level' no longer hide all the blocks in the current buffer.
+If 'hs-hide-level' was not inside a code block it would hide all the
+blocks in the buffer like 'hs-hide-all'. Now it should only hide all
+the second level blocks.
+
+++
*** New user option 'hs-display-lines-hidden'.
If this option is non-nil, Hideshow displays the number of hidden lines
@@ -1144,7 +1150,7 @@ after cursor position. By default this is set to 'af=
ter-bol'.
This user option controls the positions on the headline of hideable blocks
where the 'TAB' key cycles the blocks' visibility.
=20
-+++
+---
*** The variable 'hs-special-modes-alist' is now obsolete.
Instead of customizing Hideshow for a mode by setting the elements of
'hs-special-modes-alist', such as START, COMMENT-START,
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index e916d2091c5..d95c1515fcb 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -1,12 +1,12 @@
-;;; hideshow.el --- minor mode cmds to selectively display code/comment bl=
ocks -*- lexical-binding:t -*-
+;;; hideshow.el --- Minor mode to hide/show comment or code blocks -*- le=
xical-binding:t -*-
=20
;; Copyright (C) 1994-2025 Free Software Foundation, Inc.
=20
;; Author: Thien-Thi Nguyen <ttn@HIDDEN>
;; Dan Nicolaescu <dann@HIDDEN>
-;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
-;; Maintainer-Version: 5.65.2.2
-;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
+;; Maintainer: emacs-devel@HIDDEN
+;; Keywords: c tools outlines
+;; Maintainer-Version: 6.0
=20
;; This file is part of GNU Emacs.
=20
@@ -27,17 +27,16 @@
=20
;; * Commands provided
;;
-;; This file provides the Hideshow minor mode. When active, nine commands
-;; are available, implementing block hiding and showing. They (and their
-;; keybindings) are:
+;; This file provides the Hideshow minor mode, it includes the
+;; following commands (and their keybindings) to hiding and showing
+;; code and comment blocks:
;;
-;; `hs-hide-block' C-c @ C-h
+;; `hs-hide-block' C-c @ C-h/C-d
;; `hs-show-block' C-c @ C-s
-;; `hs-hide-all' C-c @ C-M-h
-;; `hs-show-all' C-c @ C-M-s
+;; `hs-hide-all' C-c @ C-M-h/C-t
+;; `hs-show-all' C-c @ C-M-s/C-a
;; `hs-hide-level' C-c @ C-l
-;; `hs-toggle-hiding' C-c @ C-c
-;; `hs-toggle-hiding' S-<mouse-2>
+;; `hs-toggle-hiding' C-c @ C-c/C-e or S-<mouse-2>
;; `hs-hide-initial-comment-block'
;; `hs-cycle' C-c @ TAB
;; `hs-toggle-all' C-c @ <backtab>
@@ -45,13 +44,14 @@
;; All these commands are defined in `hs-prefix-map',
;; `hs-minor-mode-map' and `hs-indicators-map'.
;;
-;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they
-;; are simply text between curly braces, while in Lisp-ish modes parens
-;; are used. Multi-line comment blocks can also be hidden. Read-only
-;; buffers are not a problem, since hideshow doesn't modify the text.
+;; Blocks are defined per mode. For example, in c-mode and similar,
+;; they are simply text between curly braces, while in Lisp-ish modes
+;; parens are used. Multi-line comment blocks can also be hidden.
+;; Read-only buffers are not a problem, since hideshow doesn't modify
+;; the text.
;;
;; The command `M-x hs-minor-mode' toggles the minor mode or sets it
-;; (similar to other minor modes).
+;; buffer-local.
=20
;; * Suggested usage
;;
@@ -60,6 +60,9 @@
;; (require 'hideshow)
;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similar=
ly
;;
+;; ;; For use-package users:
+;; (use-package hideshow :hook (X-mode . hs-minor-mode))
+;;
;; where X =3D {emacs-lisp,c,c++,perl,...}. You can also manually toggle
;; 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'.
@@ -78,40 +81,46 @@
;; (if my-hs-hide
;; (hs-hide-all)
;; (hs-show-all)))
-;;
-;; [Your hideshow hacks here!]
=20
;; * Customization
;;
-;; You can use `M-x customize-variable' on the following variables:
+;; Hideshow provides the following user options:
;;
-;; - `hs-hide-comments-when-hiding-all' -- self-explanatory!
-;; - `hs-hide-all-non-comment-function' -- if non-nil, when doing a
-;; `hs-hide-all', this function
-;; is called with no arguments
-;; - `hs-isearch-open' -- what kind of hidden blocks to
-;; open when doing isearch
-;; - `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 enable=
d.
+;; - `hs-hide-comments-when-hiding-all'
+;; self-explanatory!
+;; - `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.
;;
-;; Some languages (e.g., Java) are deeply nested, so the normal behavior
-;; of `hs-hide-all' (hiding all but top-level blocks) results in very
-;; little information shown, which is not very useful. You can use the
-;; variable `hs-hide-all-non-comment-function' to implement your idea of
-;; what is more useful. For example, the following code shows the next
-;; nested level in addition to the top-level:
+;; 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
+;; implement your idea of what is more useful. For example, the
+;; following code shows the next nested level in addition to the
+;; top-level for java:
;;
-;; (defun ttn-hs-hide-level-1 ()
+;; (defun ttn-hs-hide-level-2 ()
;; (when (funcall hs-looking-at-block-start-predicate)
-;; (hs-hide-level 1))
-;; (forward-sexp 1))
-;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
+;; (hs-hide-level 2)))
+;; (setq-mode-local java-mode ; This requires the mode-local package
+;; hs-hide-all-non-comment-function
+;; 'ttn-hs-hide-level-2)
;;
;; Hideshow works with incremental search (isearch) by setting the variable
;; `hs-headline', which is the line of text at the beginning of a hidden
@@ -123,30 +132,25 @@
;; (setq mode-line-format
;; (append '("-" hs-headline) mode-line-format)))
;;
-;; See documentation for `mode-line-format' for more info.
;;
-;; Hooks are run after some commands:
+;; The following hooks are run after some commands:
;;
-;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level
-;; hs-show-hook hs-show-block, hs-show-all
+;; hs-hide-hook =3D> hs-hide-block hs-hide-all hs-hide-level hs-cycle
+;; hs-show-hook =3D> hs-show-block hs-show-all hs-cycle
;;
-;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling
-;; commands when the result of the toggle is to hide or show blocks,
-;; respectively. All hooks are run with `run-hooks'. See the
-;; documentation for each variable or hook for more information.
+;; The variable `hs-set-up-overlay' allow customize the appearance of
+;; the hidden block and other effects associated with overlays. For
+;; example:
;;
-;; See also variable `hs-set-up-overlay' for per-block customization of
-;; appearance or other effects associated with overlays. For example:
-;;
-;; (setq hs-set-up-overlay
-;; (defun my-display-code-line-counts (ov)
-;; (when (eq 'code (overlay-get ov 'hs))
-;; (overlay-put ov 'display
-;; (propertize
-;; (format " ... <%d>"
-;; (count-lines (overlay-start ov)
-;; (overlay-end ov)))
-;; 'face 'font-lock-type-face)))))
+;; (setopt hs-set-up-overlay
+;; (defun my-display-code-line-counts (ov)
+;; (when (eq 'code (overlay-get ov 'hs))
+;; (overlay-put ov 'display
+;; (propertize
+;; (format " [... <%d>] "
+;; (count-lines (overlay-start ov)
+;; (overlay-end ov)))
+;; 'face 'font-lock-type-face)))))
=20
;; * Extending hideshow
=20
@@ -207,45 +211,39 @@
=20
;; * Bugs
;;
-;; (1) Sometimes `hs-headline' can become out of sync. To reset, type
-;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate
-;; hideshow).
+;; 1) Sometimes `hs-headline' can become out of sync. To reset, type
+;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate
+;; hideshow).
;;
-;; (2) Some buffers can't be `byte-compile-file'd properly. This is becau=
se
-;; `byte-compile-file' inserts the file to be compiled in a temporary
-;; buffer and switches `normal-mode' on. In the case where you have
-;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding=
of
-;; the initial comment sometimes hides parts of the first statement (s=
eems
-;; to be only in `normal-mode'), so there are unbalanced "(" and ")".
+;; 2) Some buffers can't be `byte-compile-file'd properly. This is because
+;; `byte-compile-file' inserts the file to be compiled in a temporary
+;; buffer and switches `normal-mode' on. In the case where you have
+;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding =
of
+;; the initial comment sometimes hides parts of the first statement (se=
ems
+;; to be only in `normal-mode'), so there are unbalanced parenthesis.
;;
-;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling:
+;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling:
;;
-;; (defadvice byte-compile-file (around
-;; byte-compile-file-hideshow-off
-;; act)
-;; (let ((hs-minor-mode-hook nil))
-;; ad-do-it))
+;; (define-advice byte-compile-file (:around
+;; (fn &rest rest)
+;; byte-compile-file-hideshow-off)
+;; (let (hs-minor-mode-hook)
+;; (apply #'fn rest)))
;;
-;; (3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, =
the
-;; suggested workaround is to turn off hideshow entirely, for example:
+;; 3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, t=
he
+;; suggested workaround is to turn off hideshow entirely, for example:
;;
-;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow)
-;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow)
+;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow)
+;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow)
;;
-;; In the case of `vc-diff', here is a less invasive workaround:
+;; In the case of `vc-diff', here is a less invasive workaround:
;;
-;; (add-hook 'vc-before-checkin-hook
-;; (lambda ()
-;; (goto-char (point-min))
-;; (hs-show-block)))
+;; (add-hook 'vc-before-checkin-hook
+;; (lambda ()
+;; (goto-char (point-min))
+;; (hs-show-block)))
;;
-;; Unfortunately, these workarounds do not restore hideshow state.
-;; If someone figures out a better way, please let me know.
-
-;; * Correspondence
-;;
-;; Correspondence welcome; please indicate version number. Send bug
-;; reports and inquiries to <ttn@HIDDEN>.
+;; Unfortunately, these workarounds do not restore hideshow state.
=20
;; * Thanks
;;
@@ -264,7 +262,7 @@
;; mouse support, and maintained the code in general. Version 4.0 is
;; largely due to his efforts.
=20
-;; * History
+;; * History (author commentary)
;;
;; Hideshow was inspired when I learned about selective display. It was
;; reimplemented to use overlays for 4.0 (see above). WRT older history,
@@ -276,19 +274,23 @@
;; unbundles state save and restore, and includes more isearch support.
=20
;;; Code:
+
+
+;;;; Libraries
+
(require 'mule-util) ; For `truncate-string-ellipsis'
;; For indicators
(require 'icons)
(require 'fringe)
=20
-;;------------------------------------------------------------------------=
---
-;; user-configurable variables
-
+
(defgroup hideshow nil
"Minor mode for hiding and showing program and comment blocks."
:prefix "hs-"
:group 'languages)
=20
+;;;; Faces
+
(defface hs-ellipsis
'((t :height 0.80 :box (:line-width -1) :inherit (shadow default)))
"Face used for hideshow ellipsis.
@@ -306,6 +308,22 @@ hs-indicator-show
"Face used in hideshow indicator to indicate a shown block."
:version "31.1")
=20
+;;;; Options
+
+(defcustom hs-hide-hook nil
+ "Hook called (with `run-hooks') at the end of commands to hide text.
+These commands include the toggling commands (when the result is to hide
+a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'."
+ :type 'hook
+ :version "31.1")
+
+(defcustom hs-show-hook nil
+ "Hook called (with `run-hooks') at the end of commands to show text.
+These commands include the toggling commands (when the result is to show
+a block), `hs-show-all' and `hs-show-block'."
+ :type 'hook
+ :version "31.1")
+
(defcustom hs-hide-comments-when-hiding-all t
"Hide the comments too when you do an `hs-hide-all'."
:type 'boolean)
@@ -385,54 +403,6 @@ hs-indicator-maximum-buffer-size
:type '(choice natnum (const :tag "No limit" nil))
:version "31.1")
=20
-(define-fringe-bitmap
- 'hs-hide
- [#b0000000
- #b1000001
- #b1100011
- #b0110110
- #b0011100
- #b0001000
- #b0000000])
-
-(define-fringe-bitmap
- 'hs-show
- [#b0110000
- #b0011000
- #b0001100
- #b0000110
- #b0001100
- #b0011000
- #b0110000])
-
-(define-icon hs-indicator-hide nil
- `((image "outline-open.svg" "outline-open.pbm"
- :face hs-indicator-hide
- :height (0.6 . em)
- :ascent center)
- (symbol "=E2=96=BE" "=E2=96=BC" :face hs-indicator-hide)
- (text "-" :face hs-indicator-hide))
- "Icon used for hide block at point.
-This is only used if `hs-indicator-type' is set to `margin' or nil."
- :version "31.1")
-
-(define-icon hs-indicator-show nil
- `((image "outline-close.svg" "outline-close.pbm"
- :face hs-indicator-show
- :height (0.6 . em)
- :ascent center)
- (symbol "=E2=96=B8" "=E2=96=B6" :face hs-indicator-show)
- (text "+" :face hs-indicator-show))
- "Icon used for show block at point.
-This is only used if `hs-indicator-type' is set to `margin' or nil."
- :version "31.1")
-
-;;;###autoload
-(defvar hs-special-modes-alist nil)
-(make-obsolete-variable 'hs-special-modes-alist
- "use the buffer-local variables instead"
- "31.1")
-
(defcustom hs-allow-nesting nil
"If non-nil, hiding remembers internal blocks.
This means that when the outer block is shown again,
@@ -440,16 +410,6 @@ hs-allow-nesting
:type 'boolean
:version "31.1")
=20
-(defvar hs-hide-hook nil
- "Hook called (with `run-hooks') at the end of commands to hide text.
-These commands include the toggling commands (when the result is to hide
-a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
-
-(defvar hs-show-hook nil
- "Hook called (with `run-hooks') at the end of commands to show text.
-These commands include the toggling commands (when the result is to show
-a block), `hs-show-all' and `hs-show-block'.")
-
(defcustom hs-set-up-overlay #'ignore
"Function called with one arg, OV, a newly initialized overlay.
Hideshow puts a unique overlay on each range of text to be hidden
@@ -495,12 +455,52 @@ hs-cycle-filter
(function :tag "Custom filter function"))
:version "31.1")
=20
-;;------------------------------------------------------------------------=
---
-;; internal variables
+;;;; Icons
+
+(define-icon hs-indicator-hide nil
+ `((image "outline-open.svg" "outline-open.pbm"
+ :face hs-indicator-hide
+ :height (0.6 . em)
+ :ascent center)
+ (symbol "=E2=96=BE" "=E2=96=BC" :face hs-indicator-hide)
+ (text "-" :face hs-indicator-hide))
+ "Icon used for hide block at point.
+This is only used if `hs-indicator-type' is set to `margin' or nil."
+ :version "31.1")
+
+(define-icon hs-indicator-show nil
+ `((image "outline-close.svg" "outline-close.pbm"
+ :face hs-indicator-show
+ :height (0.6 . em)
+ :ascent center)
+ (symbol "=E2=96=B8" "=E2=96=B6" :face hs-indicator-show)
+ (text "+" :face hs-indicator-show))
+ "Icon used for show block at point.
+This is only used if `hs-indicator-type' is set to `margin' or nil."
+ :version "31.1")
+
+(define-fringe-bitmap
+ 'hs-hide
+ [#b0000000
+ #b1000001
+ #b1100011
+ #b0110110
+ #b0011100
+ #b0001000
+ #b0000000])
+
+(define-fringe-bitmap
+ 'hs-show
+ [#b0110000
+ #b0011000
+ #b0001100
+ #b0000110
+ #b0001100
+ #b0011000
+ #b0110000])
=20
-(defvar hs-minor-mode nil
- "Non-nil if using hideshow mode as a minor mode of some other mode.
-Use the command `hs-minor-mode' to toggle or set this variable.")
+
+;;;; Keymaps
=20
(defvar-keymap hs-prefix-map
:doc "Keymap for hideshow commands."
@@ -530,8 +530,8 @@ hs-minor-mode-map
(when (and hs-cycle-filter
;; On the headline with hideable blocks
(save-excursion
- (goto-char (line-beginning-position))
- (hs-get-first-block))
+ (forward-line 0)
+ (hs-get-first-block-on-line))
(or (not (functionp hs-cycle-filter))
(funcall hs-cycle-filter)))
cmd)))
@@ -563,7 +563,7 @@ hs-minor-mode-menu
(not hs-hide-comments-when-hiding-all))
:help "If t also hide comment blocks when doing `hs-hide-all'"
:style toggle :selected hs-hide-comments-when-hiding-all]
- ("Reveal on isearch"
+ ("Reveal on isearch"
["Code blocks" (setq hs-isearch-open 'code)
:help "Show hidden code blocks when isearch matches inside them"
:active t :style radio :selected (eq hs-isearch-open 'code)]
@@ -579,13 +579,18 @@ hs-minor-mode-menu
Do not show hidden code or comment blocks when isearch matches inside them"
:active t :style radio :selected (eq hs-isearch-open nil)])))
=20
+
+;;;; Internal variables
+
+(defvar hs-minor-mode)
+
(defvar hs-hide-all-non-comment-function nil
"Function called if non-nil when doing `hs-hide-all' for non-comments.")
=20
(defvar hs-headline nil
"Text of the line where a hidden block begins, set during isearch.
You can display this in the mode line by adding the symbol `hs-headline'
-to the variable `mode-line-format'. For example,
+to the variable `mode-line-format'. For example:
=20
(unless (memq \\=3D'hs-headline mode-line-format)
(setq mode-line-format
@@ -593,21 +598,32 @@ hs-headline
=20
Note that `mode-line-format' is buffer-local.")
=20
+;; Used in `hs-toggle-all'
(defvar-local hs--toggle-all-state)
=20
-;;------------------------------------------------------------------------=
---
-;; API variables
+
+;;;; API variables
+
+;;;###autoload
+(defvar hs-special-modes-alist nil)
+(make-obsolete-variable
+ 'hs-special-modes-alist
+ "use the buffer-local variables instead" "31.1")
=20
(defvar-local hs-block-start-regexp "\\s("
"Regexp for beginning of block.")
=20
+;; This is useless, so probably should be deprecated.
(defvar-local hs-block-start-mdata-select 0
"Element in `hs-block-start-regexp' match data to consider as block star=
t.
The internal function `hs-forward-sexp' moves point to the beginning of th=
is
element (using `match-beginning') before calling `hs-forward-sexp-function=
'.")
=20
(defvar-local hs-block-end-regexp "\\s)"
- "Regexp for end of block.")
+ "Regexp for end of block.
+As a special case, the value can be also a function without arguments to
+determine if point is looking at the end of the block, and return
+non-nil and set `match-data' to that block end positions.")
=20
(defvar-local hs-c-start-regexp nil
"Regexp for beginning of comments.
@@ -619,46 +635,35 @@ hs-c-start-regexp
=20
(define-obsolete-variable-alias
'hs-forward-sexp-func
- 'hs-forward-sexp-function
- "31.1")
+ 'hs-forward-sexp-function "31.1")
=20
(defvar-local hs-forward-sexp-function #'forward-sexp
"Function used to do a `forward-sexp'.
+It is called with 1 argument (like `forward-sexp').
+
Should change for Algol-ish modes. For single-character block
-delimiters -- ie, the syntax table regexp for the character is
-either `(' or `)' -- `hs-forward-sexp-function' would just be
+delimiters such as `(' and `)' `hs-forward-sexp-function' would just be
`forward-sexp'. For other modes such as simula, a more specialized
function is necessary.")
=20
(define-obsolete-variable-alias
'hs-adjust-block-beginning
- 'hs-adjust-block-beginning-function
- "31.1")
+ 'hs-adjust-block-beginning-function "31.1")
=20
(defvar-local hs-adjust-block-beginning-function nil
"Function used to tweak the block beginning.
-The block is hidden from the position returned by this function,
-as opposed to hiding it from the position returned when searching
-for `hs-block-start-regexp'.
-
-For example, in c-like modes, if we wish to also hide the curly braces
-\(if you think they occupy too much space on the screen), this function
-should return the starting point (at the end of line) of the hidden
-region.
+It should return the position from where we should start hiding, as
+opposed to hiding it from the position returned when searching for
+`hs-block-start-regexp'.
=20
It is called with a single argument ARG which is the position in
-buffer after the block beginning.
-
-It should return the position from where we should start hiding.
-
-It should not move the point.
-
-See `hs-c-like-adjust-block-beginning' for an example of using this.")
+buffer after the block beginning.")
=20
(defvar-local hs-adjust-block-end-function nil
"Function used to tweak the block end.
This is useful to ensure some characters such as parenthesis or curly
-braces get properly hidden in python-like modes.
+braces get properly hidden in modes without parenthesis pairs
+delimiters (such as python).
=20
It is called with one argument, which is the start position where the
overlay will be created, and should return either the last position to
@@ -669,7 +674,8 @@ hs-adjust-block-end-function
'hs-find-block-beginning-function
"31.1")
=20
-(defvar-local hs-find-block-beginning-function #'hs-find-block-beginning
+(defvar-local hs-find-block-beginning-function
+ #'hs-find-block-beg-fn--default
"Function used to do `hs-find-block-beginning'.
It should reposition point at the beginning of the current block
and return point, or nil if original point was not in a block.
@@ -683,30 +689,32 @@ hs-find-block-beginning-function
'hs-find-next-block-function
"31.1")
=20
-(defvar-local hs-find-next-block-function #'hs-find-next-block
+(defvar-local hs-find-next-block-function
+ #'hs-find-next-block-fn--default
"Function used to do `hs-find-next-block'.
It should reposition point at next block start.
=20
-It is called with three arguments REGEXP, MAXP, and COMMENTS.
-REGEXP is a regexp representing block start. When block start is
-found, `match-data' should be set using REGEXP. MAXP is a buffer
-position that limits the search. When COMMENTS is nil, comments
-should be skipped. When COMMENTS is not nil, REGEXP matches not
-only beginning of a block but also beginning of a comment. In
-this case, the function should find nearest block or comment.
+It is called with three arguments REGEXP, BOUND, and COMMENTS.
+REGEXP is a regexp representing block start. When block start is found,
+`match-data' should be set using REGEXP. BOUND is a buffer position
+that limits the search. When COMMENTS is non-nil, REGEXP matches not
+only beginning of a block but also beginning of a comment. In this
+case, the function should find nearest block or comment.
=20
-Specifying this function is necessary for languages such as
-Python, where regexp search is not enough to find the beginning
-of the next block.")
+Specifying this function is necessary for languages such as Python,
+where regexp search is not enough to find the beginning of the next
+block.")
=20
(define-obsolete-variable-alias
'hs-looking-at-block-start-p-func
'hs-looking-at-block-start-predicate
"31.1")
=20
-(defvar-local hs-looking-at-block-start-predicate #'hs-looking-at-block-st=
art-p
+(defvar-local hs-looking-at-block-start-predicate
+ #'hs-looking-at-block-start-p--default
"Function used to do `hs-looking-at-block-start-p'.
-It should return non-nil if the point is at the block start.
+It should return non-nil if the point is at the block start and set
+match data with the beginning and end of that position.
=20
Specifying this function is necessary for languages such as
Python, where `looking-at' and `syntax-ppss' check is not enough
@@ -716,47 +724,232 @@ hs-inside-comment-predicate
"Function used to check if point is inside a comment.
If point is inside a comment, the function should return a list
containing the buffer position of the start and the end of the
-comment, otherwise it should return nil.
-
-A comment block can be hidden only if on its starting line there is only
-whitespace preceding the actual comment beginning. If point is inside
-a comment but this condition is not met, the function can return a list
-having nil as its `car' and the end of comment position as its `cdr'.")
+comment, otherwise it should return nil.")
=20
(defvar-local hs-treesit-things 'list
"Treesit things to check if point is at a valid block.
The value should be a thing defined in `treesit-thing-settings' for the
current buffer's major mode.")
=20
-;;------------------------------------------------------------------------=
---
-;; support functions
+
+;;;; API functions
=20
-(defun hs-discard-overlays (from to)
- "Delete hideshow overlays in region defined by FROM and TO.
+(defmacro hs-life-goes-on (&rest body)
+ "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
+In the dynamic context of this macro, `case-fold-search' is t.
+
+This macro encloses BODY in `save-match-data' and `save-excursion'.
+
+Intended to be used for commands."
+ (declare (debug t))
+ `(when hs-minor-mode
+ (let ((case-fold-search t))
+ (save-match-data
+ (save-excursion ,@body)))))
+
+(defun hs-discard-overlays (beg end)
+ "Delete hideshow overlays in region defined by BEG and END.
Skip \"internal\" overlays if `hs-allow-nesting' is non-nil."
- (when (< to from)
- (setq from (prog1 to (setq to from))))
+ (when (< end beg)
+ (setq beg (prog1 end (setq end beg))))
(if hs-allow-nesting
- (let ((from from) ov)
- (while (> to (setq from (next-overlay-change from)))
- (when (setq ov (hs-overlay-at from))
- (setq from (overlay-end ov))
+ (let ((beg beg))
+ (while (> end (setq beg (next-overlay-change beg)))
+ (when-let* ((ov (hs-overlay-at beg)))
+ ;; Reposition point to the end of the overlay, so we avoid
+ ;; removing the nested overlays too.
+ (setq beg (overlay-end ov))
(delete-overlay ov))))
- (dolist (ov (overlays-in from to))
- (when (overlay-get ov 'hs)
- (delete-overlay ov))))
- (hs--refresh-indicators from to))
-
-(defun hs-hideable-region-p (&optional beg end)
- "Return t if region between BEG and END can be hidden.
-If BEG and END are not specified, try to check the current
-block at point."
+ (remove-overlays beg end 'invisible 'hs))
+ (hs--refresh-indicators beg end))
+
+(defun hs-overlay-at (position)
+ "Return hideshow overlay at POSITION, or nil if none to be found."
+ (seq-find
+ (lambda (ov) (overlay-get ov 'hs))
+ (overlays-at position)))
+
+(defun hs-hideable-region-p (beg end)
+ "Return t if region between BEG and END can be hidden."
;; Check if BEG and END are not in the same line number,
;; since using `count-lines' is slow.
- (if (and beg end)
- (< beg (save-excursion (goto-char end) (line-beginning-position)))
- (when-let* ((block (hs-block-positions)))
- (apply #'hs-hideable-region-p block))))
+ (and beg end
+ (< beg (save-excursion (goto-char end) (pos-bol)))))
+
+(defun hs-already-hidden-p ()
+ "Return non-nil if point is in an already-hidden block, otherwise nil."
+ (save-excursion
+ ;; Reposition point if it is inside a comment, and if that comment
+ ;; is hideable
+ (when-let* ((c-reg (funcall hs-inside-comment-predicate)))
+ (goto-char (car c-reg)))
+ ;; Search for a hidden block at EOL ...
+ (eq 'hs
+ (or (get-char-property (pos-eol) 'invisible)
+ ;; ... or behind the current cursor position
+ (get-char-property (if (bobp) (point) (1- (point)))
+ 'invisible)))))
+
+(defun hs-block-positions (&optional adjust-beg adjust-end)
+ "Return the current code block positions.
+This returns a list with the current code block beginning and end
+positions. This does nothing if there is not a code block at current
+point.
+
+If either ADJUST-BEG or ADJUST-END are non-nil, adjust block positions
+according to `hs-adjust-block-beginning', `hs-adjust-block-end-function'
+and `hs-block-end-regexp'."
+ ;; `catch' is used here if the search fails due unbalanced parentheses
+ ;; or any other unknown error caused in `hs-forward-sexp-function'.
+ (catch 'hs--block-exit
+ (save-match-data
+ (save-excursion
+ (when (funcall hs-looking-at-block-start-predicate)
+ (let ((beg (match-end 0)) end)
+ ;; `beg' is the point at the end of the block
+ ;; beginning, which may need to be adjusted
+ (when adjust-beg
+ (save-excursion
+ (when hs-adjust-block-beginning-function
+ (goto-char (funcall hs-adjust-block-beginning-function b=
eg)))
+ (setq beg (pos-eol))))
+
+ (goto-char (match-beginning hs-block-start-mdata-select))
+ (condition-case _
+ (funcall hs-forward-sexp-function 1)
+ (scan-error (throw 'hs-sexp-error nil)))
+ ;; `end' is the point at the end of the block
+ (setq end (cond ((not adjust-end) (point))
+ ((and (stringp hs-block-end-regexp)
+ (looking-back hs-block-end-regexp nil))
+ (match-beginning 0))
+ ((functionp hs-block-end-regexp)
+ (funcall hs-block-end-regexp)
+ (match-beginning 0))
+ (t (point))))
+ ;; adjust block end (if needed)
+ (when (and adjust-end hs-adjust-block-end-function)
+ (setq end (or (funcall hs-adjust-block-end-function beg)
+ end)))
+ (list beg end)))))))
+
+(defun hs-hide-comment-region (beg end &optional _repos-end)
+ "Hide a region from BEG to END, marking it as a comment.
+Optional arg REPOS-END means reposition at end."
+ (declare (obsolete "Use `hs-hide-block-at-point' instead." "31.1"))
+ (hs-hide-block-at-point (list beg end)))
+
+(defun hs-hide-block-at-point (&optional comment-reg)
+ "Hide block if on block beginning.
+Optional arg COMMENT-REG is a list of the form (BEGIN END) and
+specifies the limits of the comment, or nil if the block is not
+a comment.
+
+If hiding the block is successful, return non-nil.
+Otherwise, return nil."
+ (when-let* ((block (or comment-reg (hs-block-positions :a-beg :a-end))))
+ (let ((beg (if comment-reg (save-excursion (goto-char (car block)) (po=
s-eol))
+ (car block)))
+ (end (cadr block))
+ ov)
+ (if (hs-hideable-region-p beg end)
+ (progn
+ (cond (comment-reg (let (hs-allow-nesting)
+ (hs-discard-overlays beg end)))
+ ((and hs-allow-nesting (setq ov (hs-overlay-at beg)))
+ (delete-overlay ov))
+ ((not hs-allow-nesting)
+ (hs-discard-overlays beg end)))
+ (goto-char end)
+ (hs-make-overlay beg end (if comment-reg 'comment 'code)))
+ (when comment-reg (goto-char end))
+ nil))))
+
+(defun hs-get-first-block-on-line (&optional include-comments)
+ "Reposition point to the first valid block found on the current line.
+This searches for a valid block from current point to the end of current
+line and returns the start position of the first block found.
+Otherwise, if no block is found, it returns nil.
+
+If INCLUDE-COMMENTS is non-nil, also search for a comment block."
+ (let ((regexp (if include-comments
+ (concat "\\(" hs-block-start-regexp "\\)"
+ "\\|\\(" hs-c-start-regexp "\\)")
+ hs-block-start-regexp))
+ exit)
+ (while (and (not exit)
+ (funcall hs-find-next-block-function regexp (pos-eol) incl=
ude-comments)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (pcase-let ((`(,beg ,end)
+ (or (and include-comments
+ (funcall hs-inside-comment-predica=
te))
+ (hs-block-positions))))
+ (if (and beg (hs-hideable-region-p beg end))
+ (setq exit (point))
+ t)))))
+ exit))
+
+(defun hs-get-near-block (&optional include-comment)
+ "Reposition point to a near block around point.
+It search for a valid block before and after point and return t if one
+is found.
+
+If INCLUDE-COMMENT is non-nil, it also searches for a comment block,
+returning `comment' if one is found.
+
+Intended to be used in commands."
+ (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate)=
))
+ pos)
+ (cond
+ ((and c-reg (apply #'hs-hideable-region-p c-reg))
+ (goto-char (car c-reg))
+ 'comment)
+
+ ((and (eq hs-hide-block-behavior 'after-bol)
+ (save-excursion
+ (forward-line 0)
+ (setq pos (hs-get-first-block-on-line))))
+ (goto-char pos)
+ t)
+
+ ((and (or (funcall hs-looking-at-block-start-predicate)
+ (and (forward-line 0)
+ (funcall hs-find-block-beginning-function)))
+ (apply #'hs-hideable-region-p (hs-block-positions)))
+ t))))
+
+(defun hs-hide-level-recursive (arg beg end &optional include-comments fun=
c progress)
+ "Recursively hide blocks between BEG and END that are ARG levels below p=
oint.
+If INCLUDE-COMMENTS is non-nil, also hide recursive comment blocks. If
+FUNC is non-nil, call this function to hide the block instead. If
+PROGRESS is non-nil, also update a progress object, intended for
+commands."
+ ;; Show all blocks in that region
+ (unless hs-allow-nesting (hs-discard-overlays beg end))
+ (goto-char beg)
+ (while (not (>=3D (point) end))
+ (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
+ (block (save-excursion
+ (hs-get-first-block-on-line include-comments))))
+ (goto-char (match-beginning 0))
+ (if (> arg 1)
+ ;; Find a block recursively according to ARG.
+ (pcase-let ((`(,beg ,end) (or (and include-comments
+ (funcall hs-inside-comment-pr=
edicate))
+ (hs-block-positions))))
+ (hs-hide-level-recursive (1- arg) beg end include-comments))
+ ;; Now hide the block we found.
+ (if func (funcall func)
+ (hs-hide-block-at-point
+ (and include-comments (funcall hs-inside-comment-predicate))))
+ (when progress
+ (progress-reporter-update progress (point)))))
+ (forward-line 1))
+ (goto-char end))
+
+
+;;;; Internal functions
=20
(defun hs--discard-overlay-before-changes (o &rest _r)
"Remove overlay O before changes.
@@ -767,19 +960,49 @@ hs--discard-overlay-before-changes
(delete-overlay o)
(hs--refresh-indicators beg end)))
=20
-(defun hs-make-overlay (b e kind &optional b-offset e-offset)
+(defun hs--get-ellipsis (b e)
+ "Helper function for `hs-make-overlay'.
+This returns the ellipsis string to use and its face."
+ (let* ((standard-display-table
+ (or standard-display-table (make-display-table)))
+ (d-t-ellipsis
+ (display-table-slot standard-display-table 'selective-display))
+ ;; Convert ellipsis vector to a propertized string
+ (ellipsis
+ (and (vectorp d-t-ellipsis) ; Ensure the vector is not empty
+ (not (length=3D d-t-ellipsis 0))
+ (mapconcat
+ (lambda (g)
+ (apply #'propertize (char-to-string (glyph-char g))
+ (and (glyph-face g) (list 'face (glyph-face g)))))
+ d-t-ellipsis)))
+ (ellipsis-face (and ellipsis (get-text-property 0 'face ellipsis)=
))
+ (apply-face (lambda (str)
+ (apply #'propertize str
+ (and ellipsis-face (list 'face ellipsis-face=
)))))
+ (lines (when-let* (hs-display-lines-hidden
+ (l (1- (count-lines b e)))
+ (l-str (format "%d %s" l
+ (if (=3D l 1) "line" "lines"))))
+ (funcall apply-face l-str)))
+ (tty-strings (and hs-display-lines-hidden (not (display-graphic-p=
))))
+ (string
+ (concat (and tty-strings (funcall apply-face "["))
+ lines
+ (or ellipsis (truncate-string-ellipsis))
+ (and tty-strings (funcall apply-face "]")))))
+ (if ellipsis-face
+ ;; Return ELLIPSIS and LINES if ELLIPSIS has no face
+ string
+ ;; Otherwise propertize both with `hs-ellipsis'
+ (propertize string 'face 'hs-ellipsis))))
+
+(defun hs-make-overlay (b e kind)
"Return a new overlay in region defined by B and E with type KIND.
-KIND is either `code' or `comment'. Optional fourth arg B-OFFSET
-when added to B specifies the actual buffer position where the block
-begins. Likewise for optional fifth arg E-OFFSET. If unspecified
-they are taken to be 0 (zero). The following properties are set
-in the overlay: `invisible' `hs' `hs-b-offset' `hs-e-offset'. Also,
-depending on variable `hs-isearch-open', the following properties may
-be present: `isearch-open-invisible' `isearch-open-invisible-temporary'.
-If variable `hs-set-up-overlay' is non-nil it should specify a function
-to call with the newly initialized overlay."
- (unless b-offset (setq b-offset 0))
- (unless e-offset (setq e-offset 0))
+KIND is either `code' or `comment'. The following properties are set in
+the overlay: `invisible' `hs'. Also, depending on variable
+`hs-isearch-open', the following properties may be present:
+`isearch-open-invisible' `isearch-open-invisible-temporary'."
(let ((ov (make-overlay b e))
(io (if (eq 'block hs-isearch-open)
;; backward compatibility -- `block'<=3D>`code'
@@ -795,8 +1018,6 @@ hs-make-overlay
'keymap '(keymap (mouse-1 . hs-toggle-hiding))))
;; Internal properties
(overlay-put ov 'hs kind)
- (overlay-put ov 'hs-b-offset b-offset)
- (overlay-put ov 'hs-e-offset e-offset)
;; Isearch integration
(when (or (eq io t) (eq io kind))
(overlay-put ov 'isearch-open-invisible 'hs-isearch-show)
@@ -808,48 +1029,9 @@ hs-make-overlay
(overlay-put ov 'insert-behind-hooks '(hs--discard-overlay-before-ch=
anges))
=20
(when hs-set-up-overlay (funcall hs-set-up-overlay ov))
- (hs--refresh-indicators b e)
+ (hs--refresh-indicators b (1+ b))
ov))
=20
-(defun hs-block-positions ()
- "Return the current code block positions.
-This returns a list with the current code block beginning and end
-positions. This does nothing if there is not a code block at current
-point."
- ;; `catch' is used here if the search fails due unbalanced parentheses
- ;; or any other unknown error caused in `hs-forward-sexp'.
- (catch 'hs-sexp-error
- (save-match-data
- (save-excursion
- (when (funcall hs-looking-at-block-start-predicate)
- (let ((mdata (match-data t))
- (header-end (match-end 0))
- block-beg block-end)
- ;; `block-start' is the point at the end of the block
- ;; beginning, which may need to be adjusted
- (save-excursion
- (when hs-adjust-block-beginning-function
- (goto-char (funcall hs-adjust-block-beginning-function hea=
der-end)))
- (setq block-beg (line-end-position)))
- ;; `block-end' is the point at the end of the block
- (condition-case _
- (hs-forward-sexp mdata 1)
- (scan-error (throw 'hs-sexp-error nil)))
- (setq block-end
- (cond ((and (stringp hs-block-end-regexp)
- (looking-back hs-block-end-regexp nil))
- (match-beginning 0))
- ((functionp hs-block-end-regexp)
- (funcall hs-block-end-regexp)
- (match-beginning 0))
- (t (point))))
- ;; adjust block end (if needed)
- (when hs-adjust-block-end-function
- (setq block-end
- (or (funcall hs-adjust-block-end-function block-beg)
- block-end)))
- (list block-beg block-end)))))))
-
(defun hs--make-indicators-overlays (beg)
"Helper function to make the indicators overlays."
(let ((hiddenp (eq 'hs (get-char-property (pos-eol) 'invisible))))
@@ -897,15 +1079,17 @@ hs--make-indicators-overlays
=20
(defun hs--add-indicators (&optional beg end)
"Add hideable indicators from BEG to END."
- (save-excursion
- (setq beg (if (null beg) (window-start) (goto-char beg) (pos-bol))
- end (if (null end) (window-end) (goto-char end) (pos-bol))))
+ (setq beg (progn (goto-char beg) (pos-bol))
+ end (progn (goto-char end)
+ ;; Include the EOL indicator positions
+ (min (1+ (pos-eol)) (point-max))))
(goto-char beg)
(remove-overlays beg end 'hs-indicator t)
=20
(while (not (>=3D (point) end))
(save-excursion
- (when-let* ((b-beg (hs-get-first-block)))
+ (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines
+ (b-beg (hs-get-first-block-on-line)))
(hs--make-indicators-overlays b-beg)))
;; Only 1 indicator per line
(forward-line))
@@ -918,43 +1102,6 @@ hs--refresh-indicators
(save-excursion
(hs--add-indicators from to)))))
=20
-(defun hs--get-ellipsis (b e)
- "Helper function for `hs-make-overlay'.
-This returns the ellipsis string to use and its face."
- (let* ((standard-display-table
- (or standard-display-table (make-display-table)))
- (d-t-ellipsis
- (display-table-slot standard-display-table 'selective-display))
- ;; Convert ellipsis vector to a propertized string
- (ellipsis
- (and (vectorp d-t-ellipsis) ; Ensure the vector is not empty
- (not (length=3D d-t-ellipsis 0))
- (mapconcat
- (lambda (g)
- (apply #'propertize (char-to-string (glyph-char g))
- (and (glyph-face g) (list 'face (glyph-face g)))))
- d-t-ellipsis)))
- (ellipsis-face (and ellipsis (get-text-property 0 'face ellipsis)=
))
- (apply-face (lambda (str)
- (apply #'propertize str
- (and ellipsis-face (list 'face ellipsis-face=
)))))
- (lines (when-let* (hs-display-lines-hidden
- (l (1- (count-lines b e)))
- (l-str (format "%d %s" l
- (if (=3D l 1) "line" "lines"))))
- (funcall apply-face l-str)))
- (tty-strings (and hs-display-lines-hidden (not (display-graphic-p=
))))
- (string
- (concat (and tty-strings (funcall apply-face "["))
- lines
- (or ellipsis (truncate-string-ellipsis))
- (and tty-strings (funcall apply-face "]")))))
- (if ellipsis-face
- ;; Return ELLIPSIS and LINES if ELLIPSIS has no face
- string
- ;; Otherwise propertize both with `hs-ellipsis'
- (propertize string 'face 'hs-ellipsis))))
-
(defun hs-isearch-show (ov)
"Delete overlay OV, and set `hs-headline' to nil.
=20
@@ -972,8 +1119,7 @@ hs-isearch-show-temporary
This function is meant to be used as the `isearch-open-invisible-temporary'
property of an overlay."
(setq hs-headline
- (if hide-p
- nil
+ (unless hide-p
(or hs-headline
(let ((start (overlay-start ov)))
(buffer-substring
@@ -990,107 +1136,15 @@ hs-isearch-show-temporary
(overlay-put ov 'display value)
(overlay-put ov 'hs-isearch-display nil))
(when (setq value (overlay-get ov 'display))
- (overlay-put ov 'hs-isearch-display value)
- (overlay-put ov 'display nil))))
+ (overlay-put ov 'display nil)
+ (overlay-put ov 'hs-isearch-display value))))
(overlay-put ov 'invisible (and hide-p 'hs)))
=20
-(defun hs-looking-at-block-start-p ()
+(defun hs-looking-at-block-start-p--default ()
"Return non-nil if the point is at the block start."
(and (looking-at hs-block-start-regexp)
(save-match-data (not (nth 8 (syntax-ppss))))))
=20
-(defun hs-forward-sexp (match-data arg)
- "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function' wi=
th ARG.
-Original match data is restored upon return."
- (save-match-data
- (set-match-data match-data)
- (goto-char (match-beginning hs-block-start-mdata-select))
- (funcall hs-forward-sexp-function arg)))
-
-(defun hs-hide-comment-region (beg end &optional repos-end)
- "Hide a region from BEG to END, marking it as a comment.
-Optional arg REPOS-END means reposition at end."
- (let ((goal-col (current-column))
- (beg-bol (progn (goto-char beg) (line-beginning-position)))
- (beg-eol (line-end-position))
- (end-eol (progn (goto-char end) (line-end-position))))
- (hs-discard-overlays beg-eol end-eol)
- (hs-make-overlay beg-eol end-eol 'comment beg end)
- (goto-char (if repos-end end (min end (+ beg-bol goal-col))))))
-
-(defun hs-hide-block-at-point (&optional end comment-reg)
- "Hide block if on block beginning.
-Optional arg END means reposition at end.
-Optional arg COMMENT-REG is a list of the form (BEGIN END) and
-specifies the limits of the comment, or nil if the block is not
-a comment.
-
-The block beginning is adjusted by `hs-adjust-block-beginning-function'
-and then further adjusted to be at the end of the line.
-
-If hiding the block is successful, return non-nil.
-Otherwise, return nil."
- (if comment-reg
- (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
- (when-let* ((block (hs-block-positions)))
- (let ((p (car block))
- (q (cadr block))
- ov)
- (if (hs-hideable-region-p p q)
- (progn
- (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p)))
- (delete-overlay ov))
- ((not hs-allow-nesting)
- (hs-discard-overlays p q)))
- (goto-char q)
- (hs-make-overlay p q 'code (- (match-end 0) p)))
- (goto-char (if end q (min p (match-end 0))))
- nil)))))
-
-(defun hs-get-first-block ()
- "Return the position of the first valid block found on the current line.
-This searches for a valid block on the current line and returns the
-first block found. Otherwise, if no block is found, it returns nil."
- (let (exit)
- (while (and (not exit)
- (funcall hs-find-next-block-function
- hs-block-start-regexp
- (line-end-position) nil)
- (save-excursion
- (goto-char (match-beginning 0))
- (if (hs-hideable-region-p)
- (setq exit (match-beginning 0))
- t))))
- exit))
-
-(defun hs-get-near-block (&optional include-comment)
- "Reposition point to a near block around point.
-It search for a valid block before and after point and return t if one
-is found.
-
-If INCLUDE-COMMENT is non-nil, it also searches for a comment block,
-returning `comment' if one is found."
- (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate)=
))
- pos)
- (cond
- ((and c-reg (car c-reg) (hs-hideable-region-p
- (car c-reg) (cadr c-reg)))
- (goto-char (car c-reg))
- 'comment)
-
- ((and (eq hs-hide-block-behavior 'after-bol)
- (save-excursion
- (goto-char (line-beginning-position))
- (setq pos (hs-get-first-block))))
- (goto-char pos)
- t)
-
- ((and (or (funcall hs-looking-at-block-start-predicate)
- (and (goto-char (line-beginning-position))
- (funcall hs-find-block-beginning-function)))
- (hs-hideable-region-p))
- t))))
-
(defun hs-inside-comment-p ()
(declare (obsolete "Call `hs-inside-comment-predicate' instead." "31.1"))
(funcall hs-inside-comment-predicate))
@@ -1100,51 +1154,32 @@ hs-inside-comment-p--default
;; the idea is to look backwards for a comment start regexp, do a
;; forward comment, and see if we are inside, then extend
;; forward and backward as long as we have comments
- (let ((q (point)))
- (skip-chars-forward "[:blank:]")
- (when (or (looking-at hs-c-start-regexp)
- (re-search-backward hs-c-start-regexp (point-min) t))
- ;; first get to the beginning of this comment...
- (while (and (not (bobp))
- (=3D (point) (progn (forward-comment -1) (point))))
- (forward-char -1))
- ;; ...then extend backwards
- (forward-comment (- (buffer-size)))
- (skip-chars-forward " \t\n\f")
- (let ((p (point))
- (hideable t))
- (beginning-of-line)
- (unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
- ;; we are in this situation: (example)
- ;; (defun bar ()
- ;; (foo)
- ;; ) ; comment
- ;; ^
- ;; the point was here before doing (beginning-of-line)
- ;; here we should advance till the next comment which
- ;; eventually has only white spaces preceding it on the same
- ;; line
- (goto-char p)
- (forward-comment 1)
- (skip-chars-forward " \t\n\f")
- (setq p (point))
- (while (and (< (point) q)
- (> (point) p)
- (not (looking-at hs-c-start-regexp)))
- ;; avoid an infinite cycle
- (setq p (point))
- (forward-comment 1)
- (skip-chars-forward " \t\n\f"))
- (when (or (not (looking-at hs-c-start-regexp))
- (> (point) q))
- ;; we cannot hide this comment block
- (setq hideable nil)))
- ;; goto the end of the comment
- (forward-comment (buffer-size))
- (skip-chars-backward " \t\n\f")
- (end-of-line)
- (when (>=3D (point) q)
- (list (and hideable p) (point))))))))
+ (let ((amount (buffer-size))
+ (rx (concat "^[[:blank:]]*\\(" hs-c-start-regexp "\\)"))
+ beg end)
+ (when (or (and (skip-chars-forward "[:blank:]")
+ (looking-at-p hs-c-start-regexp)
+ ;; Check if there are not whitespaces before the comm=
ent
+ (if (save-excursion
+ (forward-line 0) (not (looking-at-p rx)))
+ (setq amount 1)
+ t))
+ (and (re-search-backward rx (pos-bol) t)
+ (goto-char (match-beginning 1))))
+
+ (setq beg (if (=3D amount 1)
+ (pos-eol)
+ (forward-comment (- amount))
+ (skip-chars-forward " \t\n\f")
+ (unless (save-excursion
+ (forward-line 0) (looking-at-p rx))
+ (forward-comment 1)
+ (skip-chars-forward " \t\n\f"))
+ (pos-eol))
+ end (progn (forward-comment amount)
+ (skip-chars-backward " \t\n\f")
+ (point)))
+ (list beg end)))))
=20
(defun hs--set-variable (var nth &optional default)
"Set Hideshow VAR if already not set.
@@ -1188,103 +1223,46 @@ hs-grok-mode-type
(hs--set-variable 'hs-find-next-block-function 7)
(hs--set-variable 'hs-looking-at-block-start-predicate 8))
=20
-(defun hs-find-block-beginning ()
- "Reposition point at block-start.
-Return point, or nil if original point was not in a block."
- (let ((done nil)
- (here (point)))
- ;; look if current line is block start
- (if (funcall hs-looking-at-block-start-predicate)
- (point)
- ;; look backward for the start of a block that contains the cursor
- (while (and (re-search-backward hs-block-start-regexp nil t)
- ;; go again if in a comment or a string
- (or (save-match-data (nth 8 (syntax-ppss)))
- (not (setq done
- (< here (save-excursion
- (hs-forward-sexp (match-data t) 1)
- (point))))))))
- (if done
- (point)
- (goto-char here)
- nil))))
+(defun hs-forward-sexp (match-data _arg)
+ "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function' wi=
th ARG.
+Original match data is restored upon return."
+ (declare (obsolete "Use `hs-block-positions' instead." "31.1"))
+ (save-match-data
+ (set-match-data match-data)
+ (goto-char (match-beginning hs-block-start-mdata-select))
+ (funcall hs-forward-sexp-function 1)))
+
+(define-obsolete-function-alias
+ 'hs-find-next-block 'hs-find-next-block-fn--default "31.1")
=20
-(defun hs-find-next-block (regexp maxp comments)
+(defun hs-find-next-block-fn--default (regexp bound comments)
"Reposition point at next block-start.
Skip comments if COMMENTS is nil, and search for REGEXP in
-region (point MAXP)."
+region (point BOUND)."
(when (not comments)
(forward-comment (point-max)))
- (and (< (point) maxp)
- (re-search-forward regexp maxp t)))
-
-(defun hs-hide-level-recursive (arg &optional beg end)
- "Recursively hide blocks between BEG and END that are ARG levels below p=
oint.
-If BEG and END are not specified, it will search for a near block and
-use its position instead.
-
-If point is inside a block, it will use the current block positions
-instead of BEG and END."
- ;; If we are near of a block, set BEG and END according to that
- ;; block positions.
- (when (funcall hs-find-block-beginning-function)
- (let ((block (hs-block-positions)))
- (setq beg (point) end (cadr block))))
-
- ;; Show all blocks in that region
- (unless hs-allow-nesting (hs-discard-overlays beg end))
+ (and (< (point) bound)
+ (re-search-forward regexp bound t)))
=20
- ;; Skip initial block
- (goto-char (1+ beg))
-
- (while (funcall hs-find-next-block-function hs-block-start-regexp end ni=
l)
- (if (> arg 1)
- (hs-hide-level-recursive (1- arg))
- ;; `hs-hide-block-at-point' already moves the cursor, but if it
- ;; fails, return to the previous position where we were.
- (unless (and (goto-char (match-beginning hs-block-start-mdata-select=
))
- (hs-hide-block-at-point t))
- (goto-char (match-end hs-block-start-mdata-select)))))
-
- (goto-char end))
-
-(defmacro hs-life-goes-on (&rest body)
- "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
-In the dynamic context of this macro, `case-fold-search' is t."
- (declare (debug t))
- `(when hs-minor-mode
- (let ((case-fold-search t))
- (save-match-data
- (save-excursion ,@body)))))
+(define-obsolete-function-alias
+ 'hs-find-block-beginning 'hs-find-block-beg-fn--default "31.1")
=20
-(defun hs-find-block-beginning-match ()
- "Reposition point at the end of match of the block-start regexp.
+(defun hs-find-block-beg-fn--default ()
+ "Reposition point at block-start.
Return point, or nil if original point was not in a block."
- (when (and (funcall hs-find-block-beginning-function)
- (funcall hs-looking-at-block-start-predicate))
- ;; point is inside a block
- (goto-char (match-end 0))))
-
-(defun hs-overlay-at (position)
- "Return hideshow overlay at POSITION, or nil if none to be found."
- (let ((overlays (overlays-at position))
- ov found)
- (while (and (not found) (setq ov (car overlays)))
- (setq found (and (overlay-get ov 'hs) ov)
- overlays (cdr overlays)))
- found))
-
-(defun hs-already-hidden-p ()
- "Return non-nil if point is in an already-hidden block, otherwise nil."
- (save-excursion
- (let ((c-reg (funcall hs-inside-comment-predicate)))
- (when (and c-reg (nth 0 c-reg))
- ;; point is inside a comment, and that comment is hideable
- (goto-char (nth 0 c-reg))))
- ;; Search for a hidden block at EOL ...
- (or (eq 'hs (get-char-property (line-end-position) 'invisible))
- ;; ... or behind the current cursor position
- (eq 'hs (get-char-property (if (bobp) (point) (1- (point))) 'invis=
ible)))))
+ (let ((here (point)) done)
+ ;; look if current line is block start
+ (if (funcall hs-looking-at-block-start-predicate)
+ (point)
+ ;; look backward for the start of a block that contains the cursor
+ (save-excursion
+ (while (and (re-search-backward hs-block-start-regexp nil t)
+ (goto-char (match-beginning hs-block-start-mdata-selec=
t))
+ ;; go again if in a comment or a string
+ (or (save-match-data (nth 8 (syntax-ppss)))
+ (not (setq done (and (<=3D here (cadr (hs-block-positions)))
+ (point))))))))
+ (when done (goto-char done)))))
=20
;; This function is not used anymore (Bug#700).
(defun hs-c-like-adjust-block-beginning (initial)
@@ -1292,62 +1270,36 @@ hs-c-like-adjust-block-beginning
Actually, point is never moved; a new position is returned that is
the end of the C-function header. This adjustment function is meant
to be assigned to `hs-adjust-block-beginning-function' for C-like modes."
+ (declare (obsolete "Use `hs-adjust-block-beginning-function' instead." "=
31.1"))
(save-excursion
(goto-char (1- initial))
(forward-comment (- (buffer-size)))
(point)))
=20
-;;------------------------------------------------------------------------=
---
-;; commands
+;;;###autoload
+(defun turn-off-hideshow ()
+ "Unconditionally turn off `hs-minor-mode'."
+ (hs-minor-mode -1))
+
+
+;;;; Commands
=20
(defun hs-hide-all ()
"Hide all top level blocks, displaying only first and last lines.
Move point to the beginning of the line, and run the normal hook
-`hs-hide-hook'. See documentation for `run-hooks'.
-If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
- (interactive)
+`hs-hide-hook'. See documentation for `run-hooks'. If
+`hs-hide-comments-when-hiding-all' is non-nil, also hide the comments
+unless EXCLUDE-COMMENTS is non-nil."
+ (interactive "P")
(hs-life-goes-on
- (save-excursion
- (unless hs-allow-nesting
- (hs-discard-overlays (point-min) (point-max)))
- (goto-char (point-min))
- (syntax-propertize (point-max))
- (let ((spew (make-progress-reporter "Hiding all blocks..."
- (point-min) (point-max)))
- (re (when (stringp hs-block-start-regexp)
- (concat "\\("
- hs-block-start-regexp
- "\\)"
- (if (and hs-hide-comments-when-hiding-all
- (stringp hs-c-start-regexp))
- (concat "\\|\\("
- hs-c-start-regexp
- "\\)")
- "")))))
- (while (funcall hs-find-next-block-function re (point-max)
- hs-hide-comments-when-hiding-all)
- (if (match-beginning 1)
- ;; We have found a block beginning.
- (progn
- (goto-char (match-beginning 1))
- (unless (if hs-hide-all-non-comment-function
- (funcall hs-hide-all-non-comment-function)
- (hs-hide-block-at-point t))
- ;; Go to end of matched data to prevent from getting stuck
- ;; with an endless loop.
- (when (if (stringp hs-block-start-regexp)
- (looking-at hs-block-start-regexp)
- (eq (point) (match-beginning 0)))
- (goto-char (match-end 0)))))
- ;; found a comment, probably
- (let ((c-reg (funcall hs-inside-comment-predicate)))
- (when (and c-reg (car c-reg))
- (if (hs-hideable-region-p (car c-reg) (nth 1 c-reg))
- (hs-hide-block-at-point t c-reg)
- (goto-char (nth 1 c-reg))))))
- (progress-reporter-update spew (point)))
- (progress-reporter-done spew)))
- (beginning-of-line)
+ (let ((spew (make-progress-reporter
+ "Hiding all blocks..." (point-min) (point-max))))
+ (hs-hide-level-recursive
+ 1 (point-min) (point-max)
+ hs-hide-comments-when-hiding-all
+ hs-hide-all-non-comment-function
+ spew)
+ (progress-reporter-done spew))
(run-hooks 'hs-hide-hook)))
=20
(defun hs-show-all ()
@@ -1355,76 +1307,64 @@ hs-show-all
(interactive)
(hs-life-goes-on
(message "Showing all blocks ...")
- (let ((hs-allow-nesting nil))
+ (let (hs-allow-nesting)
(hs-discard-overlays (point-min) (point-max)))
(message "Showing all blocks ... done")
(run-hooks 'hs-show-hook)))
=20
-(defun hs-hide-block (&optional end)
- "Select a block and hide it. With prefix arg, reposition at END.
+(defun hs-hide-block ()
+ "Select a block and hide it.
Upon completion, point is repositioned and the normal hook
`hs-hide-hook' is run. See documentation for `run-hooks'."
- (interactive "P")
+ (interactive)
(hs-life-goes-on
(let ((c-reg (funcall hs-inside-comment-predicate)))
(cond
- ((and c-reg (or (null (nth 0 c-reg))
- (not (hs-hideable-region-p (car c-reg) (nth 1 c-reg)=
))))
+ ((and c-reg (not (apply #'hs-hideable-region-p c-reg)))
(user-error "(not enough comment lines to hide)"))
-
- (c-reg (hs-hide-block-at-point end c-reg))
-
- ((hs-get-near-block) (hs-hide-block-at-point)))
-
+ ((or c-reg (hs-get-near-block))
+ (hs-hide-block-at-point c-reg)))
(run-hooks 'hs-hide-hook))))
=20
-(defun hs-show-block (&optional end)
+(defun hs-show-block ()
"Select a block and show it.
-With prefix arg, reposition at END. Upon completion, point is
-repositioned and the normal hook `hs-show-hook' is run.
-See documentation for functions `hs-hide-block' and `run-hooks'."
- (interactive "P")
+This command runs `hs-show-hook'. See documentation for functions
+`hs-hide-block' and `run-hooks'."
+ (interactive)
(hs-life-goes-on
- (or
- ;; first see if we have something at the end of the line
- (let ((ov (hs-overlay-at (line-end-position)))
- (here (point))
- ov-start ov-end)
- (when ov
- (goto-char
- (cond (end (overlay-end ov))
- ((eq 'comment (overlay-get ov 'hs)) here)
- (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset)))))
- (setq ov-start (overlay-start ov))
- (setq ov-end (overlay-end ov))
- (delete-overlay ov)
- (hs--refresh-indicators ov-start ov-end)
- t))
- ;; not immediately obvious, look for a suitable block
- (let ((c-reg (funcall hs-inside-comment-predicate))
- p q)
- (cond (c-reg
- (when (car c-reg)
- (setq p (car c-reg)
- q (cadr c-reg))))
- ((and (funcall hs-find-block-beginning-function)
- ;; ugh, fresh match-data
- (funcall hs-looking-at-block-start-predicate))
- (setq p (point)
- q (progn (hs-forward-sexp (match-data t) 1) (point)))))
- (when (and p q)
- (hs-discard-overlays p q)
- (goto-char (if end q (1+ p))))))
+ (if-let* ((ov (hs-overlay-at (pos-eol)))
+ (ov-start (overlay-start ov))
+ (ov-end (overlay-end ov)))
+ (progn
+ (hs-discard-overlays (1- ov-start) ov-end)
+ (hs--refresh-indicators ov-start ov-end))
+ (when-let* ((block
+ (or (funcall hs-inside-comment-predicate)
+ (and (funcall hs-find-block-beginning-function)
+ (hs-block-positions)))))
+ (hs-discard-overlays (car block) (cadr block))))
(run-hooks 'hs-show-hook)))
=20
(defun hs-hide-level (arg)
"Hide all blocks ARG levels below this block.
+If point is not in a block, hide all the ARG levels blocks in the whole
+buffer.
+
The hook `hs-hide-hook' is run; see `run-hooks'."
(interactive "p")
(hs-life-goes-on
(save-excursion
(message "Hiding blocks ...")
- (hs-hide-level-recursive arg (point-min) (point-max))
+ (if (hs-get-near-block)
+ ;; Hide block if we are looking at one.
+ (apply #'hs-hide-level-recursive arg
+ (hs-block-positions))
+ ;; Otherwise hide all the blocks in the current buffer
+ (hs-hide-level-recursive
+ ;; Increment ARG by 1, avoiding it acts like
+ ;; `hs-hide-all'
+ (1+ arg)
+ (point-min) (point-max)))
(message "Hiding blocks ... done"))
(run-hooks 'hs-hide-hook)))
=20
@@ -1465,15 +1405,10 @@ hs-hide-initial-comment-block
This can be useful if you have huge RCS logs in those comments."
(interactive)
(hs-life-goes-on
- (let ((c-reg (save-excursion
- (goto-char (point-min))
- (skip-chars-forward " \t\n\f")
- (funcall hs-inside-comment-predicate))))
- (when c-reg
- (let ((beg (car c-reg)) (end (cadr c-reg)))
- ;; see if we have enough comment lines to hide
- (when (hs-hideable-region-p beg end)
- (hs-hide-comment-region beg end)))))))
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n\f")
+ (when-let* ((c-reg (funcall hs-inside-comment-predicate)))
+ (hs-hide-block-at-point (funcall hs-inside-comment-predicate)))))
=20
(defun hs-cycle (&optional level)
"Cycle the visibility state of the current block.
@@ -1490,11 +1425,12 @@ hs-cycle
(hs-toggle-hiding)
(message "Toggle visibility"))
((> level 1)
- (hs-hide-level-recursive level)
+ (apply #'hs-hide-level-recursive level
+ (hs-block-positions))
(message "Hide %d level" level))
(t
(let* (hs-allow-nesting
- (block (hs-block-positions))
+ (block (hs-block-positions nil :ad-end))
(ov (seq-find
(lambda (o)
(and (eq (overlay-get o 'invisible) 'hs)))
@@ -1505,9 +1441,8 @@ hs-cycle
(hs-hide-block)
(message "Hide block and nested blocks"))
;; Hide the children blocks if the parent block is hidden
- ((and (=3D (overlay-start ov) (car block))
- (=3D (overlay-end ov) (cadr block)))
- (hs-hide-level-recursive 1)
+ ((=3D (overlay-end ov) (cadr block))
+ (apply #'hs-hide-level-recursive 1 block)
(message "Hide first nested blocks"))
;; Otherwise show all in the parent block, we cannot use
;; `hs-show-block' here because we already know the
@@ -1533,10 +1468,6 @@ hs-minor-mode
commands and the hideshow commands are enabled.
The value (hs . t) is added to `buffer-invisibility-spec'.
=20
-The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block',
-`hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also
-`hs-hide-initial-comment-block'.
-
Turning hideshow minor mode off reverts the menu bar and the
variables to default values and disables the hideshow commands.
=20
@@ -1556,12 +1487,11 @@ hs-minor-mode
(user-error "%S doesn't support the Hideshow minor mode"
major-mode))
=20
- ;; Set the variables
+ ;; Set the old variables
(hs-grok-mode-type)
;; Turn off this mode if we change major modes.
(add-hook 'change-major-mode-hook
- #'turn-off-hideshow
- nil t)
+ #'turn-off-hideshow nil t)
(setq-local line-move-ignore-invisible t)
(add-to-invisibility-spec '(hs . t))
;; Add block indicators
@@ -1575,21 +1505,12 @@ hs-minor-mode
(jit-lock-register #'hs--add-indicators)))
=20
(remove-from-invisibility-spec '(hs . t))
- ;; hs-show-all does nothing unless h-m-m is non-nil.
- (let ((hs-minor-mode t))
- (hs-show-all))
+ (remove-overlays nil nil 'hs-indicator t)
+ (remove-overlays nil nil 'invisible 'hs)
(when hs-show-indicators
- (jit-lock-unregister #'hs--add-indicators)
- (remove-overlays nil nil 'hs-indicator t))))
-
-;;;###autoload
-(defun turn-off-hideshow ()
- "Unconditionally turn off `hs-minor-mode'."
- (hs-minor-mode -1))
-
-;;------------------------------------------------------------------------=
---
-;; that's it
+ (jit-lock-unregister #'hs--add-indicators))))
=20
+
+;;;; that's it
(provide 'hideshow)
-
;;; hideshow.el ends here
diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hi=
deshow-tests.el
index 9cf60c1ec84..39161f2455c 100644
--- a/test/lisp/progmodes/hideshow-tests.el
+++ b/test/lisp/progmodes/hideshow-tests.el
@@ -246,7 +246,7 @@ hideshow-hide-all-2
(should (string=3D (hideshow-tests-visible-string) contents)))))
=20
(ert-deftest hideshow-hide-level-1 ()
- "Should hide 1st level blocks."
+ "Should hide 2st level blocks."
(hideshow-tests-with-temp-buffer
c-mode
"
@@ -274,40 +274,6 @@ hideshow-hide-level-1
=20
\"String\"
=20
-int
-main(int argc, char **argv)
-{}
-"))))
-
-(ert-deftest hideshow-hide-level-2 ()
- "Should hide 2nd level blocks."
- (hideshow-tests-with-temp-buffer
- c-mode
- "
-/*
- Comments
-*/
-
-\"String\"
-
-int
-main(int argc, char **argv)
-{
- if (argc > 1) {
- printf(\"Hello\\n\");
- }
-}
-"
- (hs-hide-level 2)
- (should (string=3D
- (hideshow-tests-visible-string)
- "
-/*
- Comments
-*/
-
-\"String\"
-
int
main(int argc, char **argv)
{
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/pyth=
on-tests.el
index b9130da495d..6ddd57c9db2 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -7428,7 +7428,7 @@ python-hideshow-hide-levels-2
(or enabled (hs-minor-mode -1)))))
=20
(ert-deftest python-hideshow-hide-levels-3 ()
- "Should hide all blocks."
+ "Should hide 2nd level blocks."
(python-tests-with-temp-buffer
"
def f():
@@ -7447,19 +7447,22 @@ python-hideshow-hide-levels-3
(python-tests-visible-string)
"
def f():
+ if 0:
=20
def g():
+ pass
"))))
=20
(ert-deftest python-hideshow-hide-levels-4 ()
- "Should hide 2nd level block."
+ "Should hide 3nd level block."
(python-tests-with-temp-buffer
"
def f():
if 0:
l =3D [i for i in range(5)
if i < 3]
- abc =3D o.match(1, 2, 3)
+ if 1:
+ abc =3D o.match(1, 2, 3)
=20
def g():
pass
@@ -7472,6 +7475,9 @@ python-hideshow-hide-levels-4
"
def f():
if 0:
+ l =3D [i for i in range(5)
+ if i < 3]
+ if 1:
=20
def g():
pass
--=20
2.52.0
--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment;
filename=0001-Fix-treesit-hs-block-end-and-treesit-hs-inside-comme.patch
From 7898daf8e8987d165b94fbc9fddc18b5cea1412b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?El=C3=ADas=20Gabriel=20P=C3=A9rez?= <eg642616@HIDDEN>
Date: Thu, 4 Dec 2025 17:30:58 -0600
Subject: [PATCH] Fix 'treesit-hs-block-end' and 'treesit-hs-inside-comment-p'
(Bug#79934)
* lisp/treesit.el (treesit-hs-block-end): Properly get the block
end.
(treesit-hs-inside-comment-p): Add support for single-line
comments.
---
lisp/treesit.el | 34 ++++++++++++++++++++++++----------
1 file changed, 24 insertions(+), 10 deletions(-)
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 6809f1ec086..752ab73a473 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -4255,8 +4255,7 @@ treesit-hs-block-end
(if (bobp) (point) (1- (point))) pred))
(end (when thing (treesit-node-end thing)))
(last (when thing (treesit-node-child thing -1)))
- (beg (if last (treesit-node-start last)
- (if (bobp) (point) (1- (point))))))
+ (beg (treesit-node-start (or last thing))))
(when (and thing (eq (point) end))
(set-match-data (list beg end))
t)))
@@ -4313,14 +4312,29 @@ treesit-hs-looking-at-block-start-p
(defun treesit-hs-inside-comment-p ()
"Tree-sitter implementation of `hs-inside-comment-predicate'."
- (let* ((comment-pred
- (if (treesit-thing-defined-p 'comment (treesit-language-at (point)))
- 'comment "\\`comment\\'"))
- (thing (or (treesit-thing-at (point) comment-pred)
- (unless (bobp)
- (treesit-thing-at (1- (point)) comment-pred)))))
- (when thing
- (list (treesit-node-start thing) (treesit-node-end thing)))))
+ (when-let* ((comment-pred
+ (if (treesit-thing-defined-p 'comment (treesit-language-at (point)))
+ 'comment "\\`comment\\'"))
+ (thing (or (treesit-thing-at (point) comment-pred)
+ (unless (bobp)
+ (treesit-thing-at (1- (point)) comment-pred))))
+ (beg (treesit-node-start thing))
+ (end (treesit-node-end thing)))
+ (unless (and (fboundp 'hs-hideable-region-p) (hs-hideable-region-p beg end))
+ (save-excursion
+ (goto-char beg)
+ (while (and (skip-chars-forward "[:blank:]")
+ (when-let* ((c (treesit-thing-at (point) comment-pred)))
+ (setq beg (treesit-node-start c)))
+ (not (bobp))
+ (forward-line -1)))
+ (goto-char beg)
+ (while (and (skip-chars-forward "[:blank:]")
+ (when-let* ((c (treesit-thing-at (point) comment-pred)))
+ (setq end (treesit-node-end c)))
+ (not (eobp))
+ (forward-line 1)))))
+ (list beg end)))
;;; Show paren mode
--
2.52.0
--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment;
filename=0001-lisp-textmodes-bibtex.el-bibtex-mode-Fix-hs-variable.patch
From 8cf9b8bed0eb887fd514003b4d88a5138a8567d1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?El=C3=ADas=20Gabriel=20P=C3=A9rez?= <eg642616@HIDDEN>
Date: Thu, 4 Dec 2025 17:27:04 -0600
Subject: [PATCH] * lisp/textmodes/bibtex.el (bibtex-mode): Fix hs variables
(bug#79934).
---
lisp/textmodes/bibtex.el | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index c8e21884be2..cd18a54103f 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -3661,8 +3661,8 @@ bibtex-mode
(setq-local comment-column 0)
(setq-local defun-prompt-regexp "^[ \t]*@[[:alnum:]]+[ \t]*")
(setq-local outline-regexp "[ \t]*@")
- (setq-local hs-block-start-regexp "@\\S(*\\(\\s(\\)")
- (setq-local hs-block-end-regexp 1)
+ (setq-local hs-block-start-regexp "@\\S(*\\(\\s(\\)"
+ hs-block-start-mdata-select 1)
(setq-local fill-paragraph-function #'bibtex-fill-field)
(setq-local font-lock-defaults
'(bibtex-font-lock-keywords
--
2.52.0
--=-=-=
Content-Type: text/plain
--
- E.G via Gnus and Org.
--=-=-=--
bug-gnu-emacs@HIDDEN:bug#79934; Package emacs.
Full text available.
Received: (at submit) by debbugs.gnu.org; 2 Dec 2025 02:30:21 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Dec 01 21:30:21 2025
Received: from localhost ([127.0.0.1]:54963 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1vQG9h-0007Ey-Kc
for submit <at> debbugs.gnu.org; Mon, 01 Dec 2025 21:30:21 -0500
Received: from lists.gnu.org ([2001:470:142::17]:59566)
by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.84_2) (envelope-from <eg642616@HIDDEN>)
id 1vQG9b-00079T-WE
for submit <at> debbugs.gnu.org; Mon, 01 Dec 2025 21:30:16 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <eg642616@HIDDEN>)
id 1vQG9R-0000GW-C3
for bug-gnu-emacs@HIDDEN; Mon, 01 Dec 2025 21:30:02 -0500
Received: from mail-oi1-x241.google.com ([2607:f8b0:4864:20::241])
by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
(Exim 4.90_1) (envelope-from <eg642616@HIDDEN>)
id 1vQG9M-0007CS-S4
for bug-gnu-emacs@HIDDEN; Mon, 01 Dec 2025 21:30:01 -0500
Received: by mail-oi1-x241.google.com with SMTP id
5614622812f47-450c6f5ff81so2299774b6e.0
for <bug-gnu-emacs@HIDDEN>; Mon, 01 Dec 2025 18:29:56 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=gmail.com; s=20230601; t=1764642595; x=1765247395; darn=gnu.org;
h=mime-version:message-id:date:subject:to:from:from:to:cc:subject
:date:message-id:reply-to;
bh=0XIVxnYOJvbnaoHXQUNsEs2u1fXkm5+Ij4mfYn9Abds=;
b=UQqtMuqSL3xp09jv+oSim2hlI5fJlV4Rl74xcihQq5FM5HDxzzkZE1Fmfn4pM/OviX
FwbiMM+xY8L9GoeI4g70RfyYj4s6gVUd3CYfBcrzEGO/7IGnNIBSFOgjRoqkJync873u
wu4q1Uu6wvEO7E4M8lOXWAlsbXGWzpEsfZ3oWJDl0M0lyMJ4m2uDgSy/5dWqwGzyWxW/
bEOZMmdYXI1CkctgHoo5Zt9gd1NIUhFijcWhZe1Cp3LJHfr+iPx2b4P/G+2PFfZnV7pF
HgtZoBCNBReHlMsIcYbJNVeDrEUHAL8+7uTwmXZoBMS+87IBt6xA+KYPgis8SOVff7tb
QJDQ==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=1e100.net; s=20230601; t=1764642595; x=1765247395;
h=mime-version:message-id:date:subject:to:from:x-gm-gg
:x-gm-message-state:from:to:cc:subject:date:message-id:reply-to;
bh=0XIVxnYOJvbnaoHXQUNsEs2u1fXkm5+Ij4mfYn9Abds=;
b=Ux64K61g9Iy7p+9h4Vke7Ho74hqxTG9wYfAw2G+b6F2mngzgNE1tz0b33UlXaiZdsP
lL6W7U3my93wnDDUhad9NbGbts63BensiBUVyPgXTt7liBuUa+lEfODdQCcKz0UCZ2xp
psLFUw5vPdok67ivQa7y7I7VVYKpiCyvLmi+Jyl9YmHQU5+ecCY73qCigJ/jl0GCdo/Y
T+vE5edT5oYlpQP7sR1YFN+ws0DpbvQw8f78+DkKMcQIgmd4Ttm8eX0snuVZ+bD9YklU
RwlTXFl0lYfMuEUnVTygvxjHBpZAXanYa7WPRZZvSsQzp1KI4L2zfcEq/1X38rPHf4rQ
1JvA==
X-Gm-Message-State: AOJu0YwpmhjTFqjOKLanddHQ4w2Qsqkn8CA80wzrNfABsjAwhh878VPS
ZRe/sgAf/jFZnX6ZnqJElicemcID8OwqKFU4UbhUmdh5q2dsd6qmZsxGuqZa/uPH
X-Gm-Gg: ASbGncsfRGQfZaPHDzyMx3o77idl54GDc7/Sdf/dEvrWrrkYaM1uufM0KwADZJ6/e9p
mAcpoHgJfqaPYleMOzfvMf2nhkT5C7iZbTKlu2LVMbeCpqlB01S6PFtx0bTETYzSAnb6vtTM4+P
3RGOVYKaBxE4b5+eBFA6w9QB15VYzmzv1NGA9q8wslBKHpgsX0cJIwrJEcX4SPbefgK93IYL20q
0ym7dDLwNfvXhVEPFTZA1tyeqzK91nAov9RKmF5ddcpv1nqhtPBTPnUSx7un6DwLH/LGcm6WJ4A
vc04ksifrh00iG5/PiD8iyzsDDc1oVd5zkUdK01l+6Jrjnb6XbZNM0JTdVdfNelQrBAgLGRAzhw
JuRxHnsJgb0srliD7+87RjLE2Un7lobViBMC5GGPHCMW2BRubV85zDI/mxiv145j5R2lHcIZPSU
vI8Uhq
X-Google-Smtp-Source: AGHT+IGGB63DXLiHinUDN1V3iAEuRDncIrlF9e3AbHMt4DZFC4PLRwdJb50KqpGlLOHPGqCxzzcneQ==
X-Received: by 2002:a05:6808:4fd3:b0:450:f45e:f4ae with SMTP id
5614622812f47-4535d2efe12mr601044b6e.9.1764642594694;
Mon, 01 Dec 2025 18:29:54 -0800 (PST)
Received: from fedora ([189.215.160.233]) by smtp.gmail.com with ESMTPSA id
586e51a60fabf-3f0dca3d6d7sm6518338fac.8.2025.12.01.18.29.52
for <bug-gnu-emacs@HIDDEN>
(version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
Mon, 01 Dec 2025 18:29:53 -0800 (PST)
From: =?utf-8?Q?Elijah_Gabe_P=C3=A9rez?= <eg642616@HIDDEN>
To: bug-gnu-emacs@HIDDEN
Subject: [PATCH] hideshow: Deep cleaning
Date: Mon, 01 Dec 2025 20:29:50 -0600
Message-ID: <871pldd3a9.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Received-SPF: pass client-ip=2607:f8b0:4864:20::241;
envelope-from=eg642616@HIDDEN; helo=mail-oi1-x241.google.com
X-Spam_score_int: -17
X-Spam_score: -1.8
X-Spam_bar: -
X-Spam_report: (-1.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1,
FREEMAIL_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001,
RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001,
SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: 1.2 (+)
X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org",
has NOT identified this incoming email as spam. The original
message has been attached to this so you can view it or label
similar future email. If you have any questions, see
the administrator of that system for details.
Content preview: Tags: patch This is only a refactorization change, mainly
to modernize hideshow and make it easy to maintain. The only relevant changes
are: Content analysis details: (1.2 points, 10.0 required)
pts rule name description
---- ---------------------- --------------------------------------------------
-0.0 RCVD_IN_DNSWL_NONE RBL: Sender listed at https://www.dnswl.org/,
no trust [2001:470:142:0:0:0:0:17 listed in] [list.dnswl.org]
-0.0 SPF_HELO_PASS SPF: HELO matches SPF record
0.2 FREEMAIL_ENVFROM_END_DIGIT Envelope-from freemail username ends
in digit (eg642616[at]gmail.com)
1.0 SPF_SOFTFAIL SPF: sender does not match SPF record (softfail)
0.0 FREEMAIL_FROM Sender email is commonly abused enduser mail
provider (eg642616[at]gmail.com)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: 0.2 (/)
--=-=-=
Content-Type: text/plain
Tags: patch
This is only a refactorization change, mainly to modernize hideshow and
make it easy to maintain.
The only relevant changes are:
`hs-hide-level` no longer acts as `hs-hide-all`. If point was not in a
block and `hs-hide-level` is called, it would hide all the 1 level
blocks making it act like another `hs-hide-all`, IMO, this was strange
behavior to have two commands that do almost the same thing, so i
changed the behavior in `hs-hide-level` to only hide the 2nd level
blocks in the whole buffer if point is not in a block (after all, this
command only hide 2nd level blocks if point is in one by default).
Commands such as `hs-hide-level` and `hs-hide-all` should now work
properly for the treesit based modes.
I've improved the treesit support, so the blocks should now be hidden
properly.
I have moved some functions to make a quasi-API, this way, package
maintainers will know which functions and variables to use to extend
hideshow.
This probably has some typos, so I would appreciate some feedback.
Thanks.
--=-=-=
Content-Type: text/x-patch; charset=utf-8
Content-Disposition: attachment; filename=0001-hideshow-Deep-cleaning.patch
Content-Transfer-Encoding: quoted-printable
From 035496f4c728f23a0ae8f2d0194bbf8c6d42c638 Mon Sep 17 00:00:00 2001
From: =3D?UTF-8?q?El=3DC3=3DADas=3D20Gabriel=3D20P=3DC3=3DA9rez?=3D <eg6426=
16@HIDDEN>
Date: Mon, 1 Dec 2025 19:31:31 -0600
Subject: [PATCH] hideshow: Deep cleaning
This is just a refactoring change, simplifying most of the code
and commentaries and removing/deprecating redundant code, as
well as improving the treesit support.
* lisp/progmodes/hideshow.el (hs-hide-hook, hs-show-hook): Use
'defcustom' instead of 'defvar'.
(hs-minor-mode, hs-minor-mode-map, hs-minor-mode-menu)
(hs-hide-all-non-comment-function, hs-headline)
(hs--toggle-all-state, hs-block-end-regexp, hs-forward-sexp-func)
(hs-forward-sexp-function, hs-adjust-block-beginning)
(hs-find-block-beginning-function, hs-find-next-block-function)
(hs-looking-at-block-start-predicate)
(hs-inside-comment-predicate, hs-discard-overlays)
(hs-hideable-region-p, hs--discard-overlay-before-changes)
(hs-make-overlay, hs-already-hidden-p, hs-block-positions)
(hs--make-indicators-overlays, hs-hide-comment-region)
(hs--add-indicators, hs-hide-block-at-point)
(hs--refresh-indicators, hs-get-block-forward)
(hs-get-first-block-on-line, hs-get-near-block)
(hs-hide-level-recursive, hs-find-block-beginning-match)
(hs-isearch-show-temporary, hs-looking-at-block-start-p)
(hs-looking-at-block-start-p--default, hs-forward-sexp)
(hs-get-first-block, hs-inside-comment-p--default)
(hs-find-block-beginning, hs--forward-sexp, hs-find-next-block)
(hs-find-next-block-fn--default, hs-life-goes-on, hs-overlay-at)
(hs-c-like-adjust-block-beginning, turn-off-hideshow)
(hs-hide-all, hs-show-all, hs-hide-block, hs-show-block)
(hs-hide-level, hs-hide-initial-comment-block, hs-cycle):
Simplify and move code.
* lisp/treesit.el (treesit-hs-block-end):
* 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.
---
lisp/progmodes/hideshow.el | 1291 ++++++++++++-------------
lisp/treesit.el | 3 +-
test/lisp/progmodes/hideshow-tests.el | 36 +-
test/lisp/progmodes/python-tests.el | 12 +-
4 files changed, 630 insertions(+), 712 deletions(-)
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index e916d2091c5..bd6774a604d 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -1,12 +1,12 @@
-;;; hideshow.el --- minor mode cmds to selectively display code/comment bl=
ocks -*- lexical-binding:t -*-
+;;; hideshow.el --- Minor mode to hide/show comment or code blocks -*- le=
xical-binding:t -*-
=20
;; Copyright (C) 1994-2025 Free Software Foundation, Inc.
=20
;; Author: Thien-Thi Nguyen <ttn@HIDDEN>
;; Dan Nicolaescu <dann@HIDDEN>
-;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
-;; Maintainer-Version: 5.65.2.2
-;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
+;; Maintainer: emacs-devel@HIDDEN
+;; Keywords: c tools outlines
+;; Maintainer-Version: 6.0
=20
;; This file is part of GNU Emacs.
=20
@@ -27,17 +27,16 @@
=20
;; * Commands provided
;;
-;; This file provides the Hideshow minor mode. When active, nine commands
-;; are available, implementing block hiding and showing. They (and their
-;; keybindings) are:
+;; This file provides the Hideshow minor mode, it includes the
+;; following commands (and their keybindings) to hiding and showing
+;; code and comment blocks:
;;
-;; `hs-hide-block' C-c @ C-h
+;; `hs-hide-block' C-c @ C-h/C-d
;; `hs-show-block' C-c @ C-s
-;; `hs-hide-all' C-c @ C-M-h
-;; `hs-show-all' C-c @ C-M-s
+;; `hs-hide-all' C-c @ C-M-h/C-t
+;; `hs-show-all' C-c @ C-M-s/C-a
;; `hs-hide-level' C-c @ C-l
-;; `hs-toggle-hiding' C-c @ C-c
-;; `hs-toggle-hiding' S-<mouse-2>
+;; `hs-toggle-hiding' C-c @ C-c/C-e or S-<mouse-2>
;; `hs-hide-initial-comment-block'
;; `hs-cycle' C-c @ TAB
;; `hs-toggle-all' C-c @ <backtab>
@@ -45,13 +44,14 @@
;; All these commands are defined in `hs-prefix-map',
;; `hs-minor-mode-map' and `hs-indicators-map'.
;;
-;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they
-;; are simply text between curly braces, while in Lisp-ish modes parens
-;; are used. Multi-line comment blocks can also be hidden. Read-only
-;; buffers are not a problem, since hideshow doesn't modify the text.
+;; Blocks are defined per mode. For example, in c-mode and similar,
+;; they are simply text between curly braces, while in Lisp-ish modes
+;; parens are used. Multi-line comment blocks can also be hidden.
+;; Read-only buffers are not a problem, since hideshow doesn't modify
+;; the text.
;;
;; The command `M-x hs-minor-mode' toggles the minor mode or sets it
-;; (similar to other minor modes).
+;; buffer-local.
=20
;; * Suggested usage
;;
@@ -60,6 +60,9 @@
;; (require 'hideshow)
;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similar=
ly
;;
+;; ;; For use-package users:
+;; (use-package hideshow :hook (X-mode . hs-minor-mode))
+;;
;; where X =3D {emacs-lisp,c,c++,perl,...}. You can also manually toggle
;; 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'.
@@ -78,40 +81,46 @@
;; (if my-hs-hide
;; (hs-hide-all)
;; (hs-show-all)))
-;;
-;; [Your hideshow hacks here!]
=20
;; * Customization
;;
-;; You can use `M-x customize-variable' on the following variables:
+;; Hideshow provides the following user options:
;;
-;; - `hs-hide-comments-when-hiding-all' -- self-explanatory!
-;; - `hs-hide-all-non-comment-function' -- if non-nil, when doing a
-;; `hs-hide-all', this function
-;; is called with no arguments
-;; - `hs-isearch-open' -- what kind of hidden blocks to
-;; open when doing isearch
-;; - `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 enable=
d.
+;; - `hs-hide-comments-when-hiding-all'
+;; self-explanatory!
+;; - `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.
;;
-;; Some languages (e.g., Java) are deeply nested, so the normal behavior
-;; of `hs-hide-all' (hiding all but top-level blocks) results in very
-;; little information shown, which is not very useful. You can use the
-;; variable `hs-hide-all-non-comment-function' to implement your idea of
-;; what is more useful. For example, the following code shows the next
-;; nested level in addition to the top-level:
+;; 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 implement your idea of what is more useful. For example the
+;; following code shows the next nested level in addition to the
+;; top-level for java:
;;
-;; (defun ttn-hs-hide-level-1 ()
+;; (defun ttn-hs-hide-level-2 ()
;; (when (funcall hs-looking-at-block-start-predicate)
-;; (hs-hide-level 1))
-;; (forward-sexp 1))
-;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
+;; (hs-hide-level 2)))
+;; (setq-mode-local java-mode ; This requires the mode-local package
+;; hs-hide-all-non-comment-function
+;; 'ttn-hs-hide-level-2)
;;
;; Hideshow works with incremental search (isearch) by setting the variable
;; `hs-headline', which is the line of text at the beginning of a hidden
@@ -123,30 +132,25 @@
;; (setq mode-line-format
;; (append '("-" hs-headline) mode-line-format)))
;;
-;; See documentation for `mode-line-format' for more info.
;;
-;; Hooks are run after some commands:
+;; The following hooks are run after some commands:
;;
-;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level
-;; hs-show-hook hs-show-block, hs-show-all
+;; hs-hide-hook =3D> hs-hide-block hs-hide-all hs-hide-level hs-cycle
+;; hs-show-hook =3D> hs-show-block hs-show-all hs-cycle
;;
-;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling
-;; commands when the result of the toggle is to hide or show blocks,
-;; respectively. All hooks are run with `run-hooks'. See the
-;; documentation for each variable or hook for more information.
+;; The variable `hs-set-up-overlay' allow customize the appearance of
+;; the hidden block and other effects associated with overlays. For
+;; example:
;;
-;; See also variable `hs-set-up-overlay' for per-block customization of
-;; appearance or other effects associated with overlays. For example:
-;;
-;; (setq hs-set-up-overlay
-;; (defun my-display-code-line-counts (ov)
-;; (when (eq 'code (overlay-get ov 'hs))
-;; (overlay-put ov 'display
-;; (propertize
-;; (format " ... <%d>"
-;; (count-lines (overlay-start ov)
-;; (overlay-end ov)))
-;; 'face 'font-lock-type-face)))))
+;; (setopt hs-set-up-overlay
+;; (defun my-display-code-line-counts (ov)
+;; (when (eq 'code (overlay-get ov 'hs))
+;; (overlay-put ov 'display
+;; (propertize
+;; (format " [... <%d>] "
+;; (count-lines (overlay-start ov)
+;; (overlay-end ov)))
+;; 'face 'font-lock-type-face)))))
=20
;; * Extending hideshow
=20
@@ -207,45 +211,39 @@
=20
;; * Bugs
;;
-;; (1) Sometimes `hs-headline' can become out of sync. To reset, type
-;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate
-;; hideshow).
-;;
-;; (2) Some buffers can't be `byte-compile-file'd properly. This is becau=
se
-;; `byte-compile-file' inserts the file to be compiled in a temporary
-;; buffer and switches `normal-mode' on. In the case where you have
-;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding=
of
-;; the initial comment sometimes hides parts of the first statement (s=
eems
-;; to be only in `normal-mode'), so there are unbalanced "(" and ")".
+;; 1) Sometimes `hs-headline' can become out of sync. To reset, type
+;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate
+;; hideshow).
;;
-;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling:
+;; 2) Some buffers can't be `byte-compile-file'd properly. This is because
+;; `byte-compile-file' inserts the file to be compiled in a temporary
+;; buffer and switches `normal-mode' on. In the case where you have
+;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding =
of
+;; the initial comment sometimes hides parts of the first statement (se=
ems
+;; to be only in `normal-mode'), so there are unbalanced parenthesis.
;;
-;; (defadvice byte-compile-file (around
-;; byte-compile-file-hideshow-off
-;; act)
-;; (let ((hs-minor-mode-hook nil))
-;; ad-do-it))
+;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling:
;;
-;; (3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, =
the
-;; suggested workaround is to turn off hideshow entirely, for example:
+;; (define-advice byte-compile-file (:around
+;; (fn &rest rest)
+;; byte-compile-file-hideshow-off)
+;; (let (hs-minor-mode-hook)
+;; (apply #'fn rest)))
;;
-;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow)
-;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow)
+;; 3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, t=
he
+;; suggested workaround is to turn off hideshow entirely, for example:
;;
-;; In the case of `vc-diff', here is a less invasive workaround:
+;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow)
+;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow)
;;
-;; (add-hook 'vc-before-checkin-hook
-;; (lambda ()
-;; (goto-char (point-min))
-;; (hs-show-block)))
+;; In the case of `vc-diff', here is a less invasive workaround:
;;
-;; Unfortunately, these workarounds do not restore hideshow state.
-;; If someone figures out a better way, please let me know.
-
-;; * Correspondence
+;; (add-hook 'vc-before-checkin-hook
+;; (lambda ()
+;; (goto-char (point-min))
+;; (hs-show-block)))
;;
-;; Correspondence welcome; please indicate version number. Send bug
-;; reports and inquiries to <ttn@HIDDEN>.
+;; Unfortunately, these workarounds do not restore hideshow state.
=20
;; * Thanks
;;
@@ -264,7 +262,7 @@
;; mouse support, and maintained the code in general. Version 4.0 is
;; largely due to his efforts.
=20
-;; * History
+;; * History (author commentary)
;;
;; Hideshow was inspired when I learned about selective display. It was
;; reimplemented to use overlays for 4.0 (see above). WRT older history,
@@ -276,19 +274,23 @@
;; unbundles state save and restore, and includes more isearch support.
=20
;;; Code:
+
+
+;;;; Libraries
+
(require 'mule-util) ; For `truncate-string-ellipsis'
;; For indicators
(require 'icons)
(require 'fringe)
=20
-;;------------------------------------------------------------------------=
---
-;; user-configurable variables
-
+
(defgroup hideshow nil
"Minor mode for hiding and showing program and comment blocks."
:prefix "hs-"
:group 'languages)
=20
+;;;; Faces
+
(defface hs-ellipsis
'((t :height 0.80 :box (:line-width -1) :inherit (shadow default)))
"Face used for hideshow ellipsis.
@@ -306,6 +308,22 @@ hs-indicator-show
"Face used in hideshow indicator to indicate a shown block."
:version "31.1")
=20
+;;;; Options
+
+(defcustom hs-hide-hook nil
+ "Hook called (with `run-hooks') at the end of commands to hide text.
+These commands include the toggling commands (when the result is to hide
+a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'."
+ :type 'hook
+ :version "31.1")
+
+(defcustom hs-show-hook nil
+ "Hook called (with `run-hooks') at the end of commands to show text.
+These commands include the toggling commands (when the result is to show
+a block), `hs-show-all' and `hs-show-block'."
+ :type 'hook
+ :version "31.1")
+
(defcustom hs-hide-comments-when-hiding-all t
"Hide the comments too when you do an `hs-hide-all'."
:type 'boolean)
@@ -385,54 +403,6 @@ hs-indicator-maximum-buffer-size
:type '(choice natnum (const :tag "No limit" nil))
:version "31.1")
=20
-(define-fringe-bitmap
- 'hs-hide
- [#b0000000
- #b1000001
- #b1100011
- #b0110110
- #b0011100
- #b0001000
- #b0000000])
-
-(define-fringe-bitmap
- 'hs-show
- [#b0110000
- #b0011000
- #b0001100
- #b0000110
- #b0001100
- #b0011000
- #b0110000])
-
-(define-icon hs-indicator-hide nil
- `((image "outline-open.svg" "outline-open.pbm"
- :face hs-indicator-hide
- :height (0.6 . em)
- :ascent center)
- (symbol "=E2=96=BE" "=E2=96=BC" :face hs-indicator-hide)
- (text "-" :face hs-indicator-hide))
- "Icon used for hide block at point.
-This is only used if `hs-indicator-type' is set to `margin' or nil."
- :version "31.1")
-
-(define-icon hs-indicator-show nil
- `((image "outline-close.svg" "outline-close.pbm"
- :face hs-indicator-show
- :height (0.6 . em)
- :ascent center)
- (symbol "=E2=96=B8" "=E2=96=B6" :face hs-indicator-show)
- (text "+" :face hs-indicator-show))
- "Icon used for show block at point.
-This is only used if `hs-indicator-type' is set to `margin' or nil."
- :version "31.1")
-
-;;;###autoload
-(defvar hs-special-modes-alist nil)
-(make-obsolete-variable 'hs-special-modes-alist
- "use the buffer-local variables instead"
- "31.1")
-
(defcustom hs-allow-nesting nil
"If non-nil, hiding remembers internal blocks.
This means that when the outer block is shown again,
@@ -440,16 +410,6 @@ hs-allow-nesting
:type 'boolean
:version "31.1")
=20
-(defvar hs-hide-hook nil
- "Hook called (with `run-hooks') at the end of commands to hide text.
-These commands include the toggling commands (when the result is to hide
-a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
-
-(defvar hs-show-hook nil
- "Hook called (with `run-hooks') at the end of commands to show text.
-These commands include the toggling commands (when the result is to show
-a block), `hs-show-all' and `hs-show-block'.")
-
(defcustom hs-set-up-overlay #'ignore
"Function called with one arg, OV, a newly initialized overlay.
Hideshow puts a unique overlay on each range of text to be hidden
@@ -495,12 +455,52 @@ hs-cycle-filter
(function :tag "Custom filter function"))
:version "31.1")
=20
-;;------------------------------------------------------------------------=
---
-;; internal variables
+;;;; Icons
+
+(define-icon hs-indicator-hide nil
+ `((image "outline-open.svg" "outline-open.pbm"
+ :face hs-indicator-hide
+ :height (0.6 . em)
+ :ascent center)
+ (symbol "=E2=96=BE" "=E2=96=BC" :face hs-indicator-hide)
+ (text "-" :face hs-indicator-hide))
+ "Icon used for hide block at point.
+This is only used if `hs-indicator-type' is set to `margin' or nil."
+ :version "31.1")
+
+(define-icon hs-indicator-show nil
+ `((image "outline-close.svg" "outline-close.pbm"
+ :face hs-indicator-show
+ :height (0.6 . em)
+ :ascent center)
+ (symbol "=E2=96=B8" "=E2=96=B6" :face hs-indicator-show)
+ (text "+" :face hs-indicator-show))
+ "Icon used for show block at point.
+This is only used if `hs-indicator-type' is set to `margin' or nil."
+ :version "31.1")
+
+(define-fringe-bitmap
+ 'hs-hide
+ [#b0000000
+ #b1000001
+ #b1100011
+ #b0110110
+ #b0011100
+ #b0001000
+ #b0000000])
+
+(define-fringe-bitmap
+ 'hs-show
+ [#b0110000
+ #b0011000
+ #b0001100
+ #b0000110
+ #b0001100
+ #b0011000
+ #b0110000])
=20
-(defvar hs-minor-mode nil
- "Non-nil if using hideshow mode as a minor mode of some other mode.
-Use the command `hs-minor-mode' to toggle or set this variable.")
+
+;;;; Keymaps
=20
(defvar-keymap hs-prefix-map
:doc "Keymap for hideshow commands."
@@ -530,8 +530,8 @@ hs-minor-mode-map
(when (and hs-cycle-filter
;; On the headline with hideable blocks
(save-excursion
- (goto-char (line-beginning-position))
- (hs-get-first-block))
+ (goto-char (pos-bol))
+ (hs-get-first-block-on-line))
(or (not (functionp hs-cycle-filter))
(funcall hs-cycle-filter)))
cmd)))
@@ -563,7 +563,7 @@ hs-minor-mode-menu
(not hs-hide-comments-when-hiding-all))
:help "If t also hide comment blocks when doing `hs-hide-all'"
:style toggle :selected hs-hide-comments-when-hiding-all]
- ("Reveal on isearch"
+ ("Reveal on isearch"
["Code blocks" (setq hs-isearch-open 'code)
:help "Show hidden code blocks when isearch matches inside them"
:active t :style radio :selected (eq hs-isearch-open 'code)]
@@ -579,24 +579,8 @@ hs-minor-mode-menu
Do not show hidden code or comment blocks when isearch matches inside them"
:active t :style radio :selected (eq hs-isearch-open nil)])))
=20
-(defvar hs-hide-all-non-comment-function nil
- "Function called if non-nil when doing `hs-hide-all' for non-comments.")
-
-(defvar hs-headline nil
- "Text of the line where a hidden block begins, set during isearch.
-You can display this in the mode line by adding the symbol `hs-headline'
-to the variable `mode-line-format'. For example,
-
- (unless (memq \\=3D'hs-headline mode-line-format)
- (setq mode-line-format
- (append \\=3D'(\"-\" hs-headline) mode-line-format)))
-
-Note that `mode-line-format' is buffer-local.")
-
-(defvar-local hs--toggle-all-state)
-
-;;------------------------------------------------------------------------=
---
-;; API variables
+
+;;;; API variables
=20
(defvar-local hs-block-start-regexp "\\s("
"Regexp for beginning of block.")
@@ -607,7 +591,10 @@ hs-block-start-mdata-select
element (using `match-beginning') before calling `hs-forward-sexp-function=
'.")
=20
(defvar-local hs-block-end-regexp "\\s)"
- "Regexp for end of block.")
+ "Regexp for end of block.
+As a special case, the value can be also a function without arguments to
+determine if point is looking at the end of the block, and return
+non-nil and set `match-data' to that block end positions.")
=20
(defvar-local hs-c-start-regexp nil
"Regexp for beginning of comments.
@@ -619,11 +606,12 @@ hs-c-start-regexp
=20
(define-obsolete-variable-alias
'hs-forward-sexp-func
- 'hs-forward-sexp-function
- "31.1")
+ 'hs-forward-sexp-function "31.1")
=20
(defvar-local hs-forward-sexp-function #'forward-sexp
"Function used to do a `forward-sexp'.
+It is called with 1 argument for backward compatibility.
+
Should change for Algol-ish modes. For single-character block
delimiters -- ie, the syntax table regexp for the character is
either `(' or `)' -- `hs-forward-sexp-function' would just be
@@ -632,8 +620,7 @@ hs-forward-sexp-function
=20
(define-obsolete-variable-alias
'hs-adjust-block-beginning
- 'hs-adjust-block-beginning-function
- "31.1")
+ 'hs-adjust-block-beginning-function "31.1")
=20
(defvar-local hs-adjust-block-beginning-function nil
"Function used to tweak the block beginning.
@@ -669,7 +656,8 @@ hs-adjust-block-end-function
'hs-find-block-beginning-function
"31.1")
=20
-(defvar-local hs-find-block-beginning-function #'hs-find-block-beginning
+(defvar-local hs-find-block-beginning-function
+ #'hs-find-block-beg-fn--default
"Function used to do `hs-find-block-beginning'.
It should reposition point at the beginning of the current block
and return point, or nil if original point was not in a block.
@@ -683,28 +671,30 @@ hs-find-block-beginning-function
'hs-find-next-block-function
"31.1")
=20
-(defvar-local hs-find-next-block-function #'hs-find-next-block
+(defvar-local hs-find-next-block-function
+ #'hs-find-next-block-fn--default
"Function used to do `hs-find-next-block'.
It should reposition point at next block start.
=20
It is called with three arguments REGEXP, MAXP, and COMMENTS.
-REGEXP is a regexp representing block start. When block start is
-found, `match-data' should be set using REGEXP. MAXP is a buffer
-position that limits the search. When COMMENTS is nil, comments
-should be skipped. When COMMENTS is not nil, REGEXP matches not
-only beginning of a block but also beginning of a comment. In
-this case, the function should find nearest block or comment.
+REGEXP is a regexp representing block start. When block start is found,
+`match-data' should be set using REGEXP. MAXP is a buffer position that
+limits the search. When COMMENTS is nil, comments should be skipped.
+When COMMENTS is not nil, REGEXP matches not only beginning of a block
+but also beginning of a comment. In this case, the function should find
+nearest block or comment.
=20
-Specifying this function is necessary for languages such as
-Python, where regexp search is not enough to find the beginning
-of the next block.")
+Specifying this function is necessary for languages such as Python,
+where regexp search is not enough to find the beginning of the next
+block.")
=20
(define-obsolete-variable-alias
'hs-looking-at-block-start-p-func
'hs-looking-at-block-start-predicate
"31.1")
=20
-(defvar-local hs-looking-at-block-start-predicate #'hs-looking-at-block-st=
art-p
+(defvar-local hs-looking-at-block-start-predicate
+ #'hs-looking-at-block-start-p--default
"Function used to do `hs-looking-at-block-start-p'.
It should return non-nil if the point is at the block start.
=20
@@ -719,33 +709,50 @@ hs-inside-comment-predicate
comment, otherwise it should return nil.
=20
A comment block can be hidden only if on its starting line there is only
-whitespace preceding the actual comment beginning. If point is inside
-a comment but this condition is not met, the function can return a list
-having nil as its `car' and the end of comment position as its `cdr'.")
+whitespace preceding the actual comment beginning.")
=20
(defvar-local hs-treesit-things 'list
"Treesit things to check if point is at a valid block.
The value should be a thing defined in `treesit-thing-settings' for the
current buffer's major mode.")
=20
-;;------------------------------------------------------------------------=
---
-;; support functions
+
+;;;; API functions
+
+(defmacro hs-life-goes-on (&rest body)
+ "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
+In the dynamic context of this macro, `case-fold-search' is t.
+
+This macro encloses BODY in `save-match-data' and `save-excursion'.
=20
-(defun hs-discard-overlays (from to)
- "Delete hideshow overlays in region defined by FROM and TO.
+Intended to be used for commands."
+ (declare (debug t))
+ `(when (bound-and-true-p hs-minor-mode)
+ (let ((case-fold-search t))
+ (save-match-data
+ (save-excursion ,@body)))))
+
+(defun hs-discard-overlays (beg end)
+ "Delete hideshow overlays in region defined by BEG and END.
Skip \"internal\" overlays if `hs-allow-nesting' is non-nil."
- (when (< to from)
- (setq from (prog1 to (setq to from))))
+ (when (< end beg)
+ (setq beg (prog1 end (setq end beg))))
(if hs-allow-nesting
- (let ((from from) ov)
- (while (> to (setq from (next-overlay-change from)))
- (when (setq ov (hs-overlay-at from))
- (setq from (overlay-end ov))
+ (let ((beg beg))
+ (while (> end (setq beg (next-overlay-change beg)))
+ (when-let* ((ov (hs-overlay-at beg)))
+ ;; Reposition point to the end of the overlay, so we avoid
+ ;; removing the nested overlays too.
+ (setq beg (overlay-end ov))
(delete-overlay ov))))
- (dolist (ov (overlays-in from to))
- (when (overlay-get ov 'hs)
- (delete-overlay ov))))
- (hs--refresh-indicators from to))
+ (remove-overlays beg end 'invisible 'hs))
+ (hs--refresh-indicators beg end))
+
+(defun hs-overlay-at (position)
+ "Return hideshow overlay at POSITION, or nil if none to be found."
+ (seq-find
+ (lambda (ov) (overlay-get ov 'hs))
+ (overlays-at position)))
=20
(defun hs-hideable-region-p (&optional beg end)
"Return t if region between BEG and END can be hidden.
@@ -754,62 +761,23 @@ hs-hideable-region-p
;; Check if BEG and END are not in the same line number,
;; since using `count-lines' is slow.
(if (and beg end)
- (< beg (save-excursion (goto-char end) (line-beginning-position)))
+ (< beg (save-excursion (goto-char end) (pos-bol)))
(when-let* ((block (hs-block-positions)))
(apply #'hs-hideable-region-p block))))
=20
-(defun hs--discard-overlay-before-changes (o &rest _r)
- "Remove overlay O before changes.
-Intended to be used in `modification-hooks', `insert-in-front-hooks' and
-`insert-behind-hooks'."
- (let ((beg (overlay-start o))
- (end (overlay-end o)))
- (delete-overlay o)
- (hs--refresh-indicators beg end)))
-
-(defun hs-make-overlay (b e kind &optional b-offset e-offset)
- "Return a new overlay in region defined by B and E with type KIND.
-KIND is either `code' or `comment'. Optional fourth arg B-OFFSET
-when added to B specifies the actual buffer position where the block
-begins. Likewise for optional fifth arg E-OFFSET. If unspecified
-they are taken to be 0 (zero). The following properties are set
-in the overlay: `invisible' `hs' `hs-b-offset' `hs-e-offset'. Also,
-depending on variable `hs-isearch-open', the following properties may
-be present: `isearch-open-invisible' `isearch-open-invisible-temporary'.
-If variable `hs-set-up-overlay' is non-nil it should specify a function
-to call with the newly initialized overlay."
- (unless b-offset (setq b-offset 0))
- (unless e-offset (setq e-offset 0))
- (let ((ov (make-overlay b e))
- (io (if (eq 'block hs-isearch-open)
- ;; backward compatibility -- `block'<=3D>`code'
- 'code
- hs-isearch-open)))
- (overlay-put ov 'invisible 'hs)
- (overlay-put ov 'display
- (propertize
- (hs--get-ellipsis b e)
- 'mouse-face
- 'highlight
- 'help-echo "mouse-1: show hidden lines"
- 'keymap '(keymap (mouse-1 . hs-toggle-hiding))))
- ;; Internal properties
- (overlay-put ov 'hs kind)
- (overlay-put ov 'hs-b-offset b-offset)
- (overlay-put ov 'hs-e-offset e-offset)
- ;; Isearch integration
- (when (or (eq io t) (eq io kind))
- (overlay-put ov 'isearch-open-invisible 'hs-isearch-show)
- (overlay-put ov 'isearch-open-invisible-temporary
- 'hs-isearch-show-temporary))
- ;; Remove overlay after modifications
- (overlay-put ov 'modification-hooks '(hs--discard-overlay-before-ch=
anges))
- (overlay-put ov 'insert-in-front-hooks '(hs--discard-overlay-before-ch=
anges))
- (overlay-put ov 'insert-behind-hooks '(hs--discard-overlay-before-ch=
anges))
-
- (when hs-set-up-overlay (funcall hs-set-up-overlay ov))
- (hs--refresh-indicators b e)
- ov))
+(defun hs-already-hidden-p ()
+ "Return non-nil if point is in an already-hidden block, otherwise nil."
+ (save-excursion
+ ;; Reposition point if it is inside a comment, and if that comment
+ ;; is hideable
+ (when-let* ((c-reg (funcall hs-inside-comment-predicate)))
+ (goto-char (car c-reg)))
+ ;; Search for a hidden block at EOL ...
+ (eq 'hs
+ (or (get-char-property (pos-eol) 'invisible)
+ ;; ... or behind the current cursor position
+ (get-char-property (if (bobp) (point) (1- (point)))
+ 'invisible)))))
=20
(defun hs-block-positions ()
"Return the current code block positions.
@@ -830,10 +798,10 @@ hs-block-positions
(save-excursion
(when hs-adjust-block-beginning-function
(goto-char (funcall hs-adjust-block-beginning-function hea=
der-end)))
- (setq block-beg (line-end-position)))
+ (setq block-beg (pos-eol)))
;; `block-end' is the point at the end of the block
(condition-case _
- (hs-forward-sexp mdata 1)
+ (hs--forward-sexp mdata)
(scan-error (throw 'hs-sexp-error nil)))
(setq block-end
(cond ((and (stringp hs-block-end-regexp)
@@ -850,73 +818,163 @@ hs-block-positions
block-end)))
(list block-beg block-end)))))))
=20
-(defun hs--make-indicators-overlays (beg)
- "Helper function to make the indicators overlays."
- (let ((hiddenp (eq 'hs (get-char-property (pos-eol) 'invisible))))
- ;; If we are going to use the EOL indicators, then
- ;; ignore the invisible lines which mostly are already
- ;; hidden blocks.
- (when (or hs-indicator-type (not hiddenp))
- (let* ((o (make-overlay
- (if hs-indicator-type beg (pos-eol))
- (1+ (if hs-indicator-type beg (pos-eol)))))
- (fringe-type (if hiddenp 'hs-show 'hs-hide))
- (face-or-icon (if hiddenp 'hs-indicator-show 'hs-indicator-hi=
de)))
-
- (overlay-put o 'hs-indicator t)
- (overlay-put o 'hs-indicator-block-start beg)
- (overlay-put o 'evaporate t)
- (overlay-put o 'priority -50)
-
- (overlay-put
- o 'before-string
- (pcase hs-indicator-type
- ;; Fringes
- ('fringe
- (propertize
- "+" 'display
- `(left-fringe ,fringe-type ,face-or-icon)))
- ;; Margins
- ('margin
- (propertize
- "+" 'display
- `((margin left-margin)
- ,(or (plist-get (icon-elements face-or-icon) 'image)
- (propertize (icon-string face-or-icon)
- 'keymap hs-indicators-map)))
- 'face face-or-icon
- 'keymap hs-indicators-map))
- ;; EOL string
- ('nil
- (concat
- (propertize " " 'cursor t)
- (propertize
- (icon-string face-or-icon)
- 'mouse-face 'highlight
- 'keymap hs-indicators-map)))))))))
+(defun hs-hide-comment-region (beg end &optional repos-end)
+ "Hide a region from BEG to END, marking it as a comment.
+Optional arg REPOS-END means reposition at end."
+ (when (hs-hideable-region-p beg end)
+ (let (hs-allow-nesting
+ (beg (save-excursion (goto-char beg) (pos-eol)))
+ (end (save-excursion (goto-char end) (pos-eol))))
+ (hs-discard-overlays beg end)
+ (hs-make-overlay beg end 'comment)))
+ (when repos-end (goto-char end)))
=20
-(defun hs--add-indicators (&optional beg end)
- "Add hideable indicators from BEG to END."
- (save-excursion
- (setq beg (if (null beg) (window-start) (goto-char beg) (pos-bol))
- end (if (null end) (window-end) (goto-char end) (pos-bol))))
- (goto-char beg)
- (remove-overlays beg end 'hs-indicator t)
+(defun hs-hide-block-at-point (&optional end comment-reg)
+ "Hide block if on block beginning.
+Optional arg END means reposition at end.
+Optional arg COMMENT-REG is a list of the form (BEGIN END) and
+specifies the limits of the comment, or nil if the block is not
+a comment.
=20
- (while (not (>=3D (point) end))
- (save-excursion
- (when-let* ((b-beg (hs-get-first-block)))
- (hs--make-indicators-overlays b-beg)))
- ;; Only 1 indicator per line
- (forward-line))
- `(jit-lock-bounds ,beg . ,end))
+The block beginning is adjusted by `hs-adjust-block-beginning-function'
+and then further adjusted to be at the end of the line.
=20
-(defun hs--refresh-indicators (from to)
- "Update indicator appearance in FROM and TO."
- (when (and hs-show-indicators hs-minor-mode)
- (save-match-data
- (save-excursion
- (hs--add-indicators from to)))))
+If hiding the block is successful, return non-nil.
+Otherwise, return nil."
+ (if comment-reg
+ (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
+ (when-let* ((block (hs-block-positions)))
+ (let ((p (car block))
+ (q (cadr block))
+ ov)
+ (if (hs-hideable-region-p p q)
+ (progn
+ (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p)))
+ (delete-overlay ov))
+ ((not hs-allow-nesting)
+ (hs-discard-overlays p q)))
+ (goto-char q)
+ (hs-make-overlay p q 'code))
+ (goto-char (if end q (min p (match-end 0))))
+ nil)))))
+
+(defun hs-get-block-forward (bound &optional include-comments)
+ "Reposition point at next block forward to BOUND.
+BOUND is a buffer position that bounds the search.
+If INCLUDE-COMMENTS is non-nil, then also search for a comment block."
+ (let ((regexp (if include-comments
+ (concat "\\(" hs-block-start-regexp "\\)"
+ "\\|\\(" hs-c-start-regexp "\\)")
+ hs-block-start-regexp)))
+ (funcall hs-find-next-block-function regexp bound include-comments)))
+
+(defun hs-get-first-block-on-line ()
+ "Reposition point to the first valid block found on the current line.
+This searches for a valid block on the current line and returns the
+first block found. Otherwise, if no block is found, it returns nil."
+ (let (exit)
+ (while (and (not exit)
+ (hs-get-block-forward (pos-eol))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (if (hs-hideable-region-p)
+ (setq exit (match-beginning 0))
+ t))))
+ exit))
+
+(defun hs-get-near-block (&optional include-comment)
+ "Reposition point to a near block around point.
+It search for a valid block before and after point and return t if one
+is found.
+
+If INCLUDE-COMMENT is non-nil, it also searches for a comment block,
+returning `comment' if one is found."
+ (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate)=
))
+ pos)
+ (cond
+ ((and c-reg (hs-hideable-region-p (car c-reg) (cadr c-reg)))
+ (goto-char (car c-reg))
+ 'comment)
+
+ ((and (eq hs-hide-block-behavior 'after-bol)
+ (save-excursion
+ (goto-char (pos-bol))
+ (setq pos (hs-get-first-block-on-line))))
+ (goto-char pos)
+ t)
+
+ ((and (or (funcall hs-looking-at-block-start-predicate)
+ (and (goto-char (pos-bol))
+ (funcall hs-find-block-beginning-function)))
+ (hs-hideable-region-p))
+ t))))
+
+(defun hs-hide-level-recursive (arg beg end)
+ "Recursively hide blocks between BEG and END that are ARG levels below p=
oint."
+ ;; Show all blocks in that region
+ (unless hs-allow-nesting (hs-discard-overlays beg end))
+ (goto-char beg)
+ (while (not (>=3D (point) end))
+ (when (save-excursion (hs-get-first-block-on-line))
+ (if (> arg 1)
+ (progn
+ ;; Since we found a block, hide that block recursively
+ (goto-char (match-beginning hs-block-start-mdata-select))
+ (hs-hide-level-recursive
+ (1- arg)
+ (match-end hs-block-start-mdata-select)
+ (cadr (hs-block-positions))))
+ (goto-char (match-beginning hs-block-start-mdata-select))
+ (hs-hide-block-at-point :move-point)))
+ (forward-visible-line 1))
+ (goto-char end))
+
+;; NOTE: This function is not used
+(defun hs-find-block-beginning-match ()
+ "Reposition point at the end of match of the block-start regexp.
+Return point, or nil if original point was not in a block."
+ (when (and (funcall hs-find-block-beginning-function)
+ (funcall hs-looking-at-block-start-predicate))
+ ;; point is inside a block
+ (goto-char (match-end 0))))
+
+
+;;;; Internal variables
+
+(defvar hs-hide-all-non-comment-function nil
+ "Function called if non-nil when doing `hs-hide-all' for non-comments.")
+
+(defvar hs-headline nil
+ "Text of the line where a hidden block begins, set during isearch.
+You can display this in the mode line by adding the symbol `hs-headline'
+to the variable `mode-line-format'. For example:
+
+ (unless (memq \\=3D'hs-headline mode-line-format)
+ (setq mode-line-format
+ (append \\=3D'(\"-\" hs-headline) mode-line-format)))
+
+Note that `mode-line-format' is buffer-local.")
+
+;; Use in `hs-toggle-all'
+(defvar-local hs--toggle-all-state)
+
+;;;###autoload
+(defvar hs-special-modes-alist nil)
+(make-obsolete-variable
+ 'hs-special-modes-alist
+ "use the buffer-local variables instead" "31.1")
+
+
+;;;; Internal functions
+
+(defun hs--discard-overlay-before-changes (o &rest _r)
+ "Remove overlay O before changes.
+Intended to be used in `modification-hooks', `insert-in-front-hooks' and
+`insert-behind-hooks'."
+ (let ((beg (overlay-start o))
+ (end (overlay-end o)))
+ (delete-overlay o)
+ (hs--refresh-indicators beg end)))
=20
(defun hs--get-ellipsis (b e)
"Helper function for `hs-make-overlay'.
@@ -955,6 +1013,112 @@ hs--get-ellipsis
;; Otherwise propertize both with `hs-ellipsis'
(propertize string 'face 'hs-ellipsis))))
=20
+(defun hs-make-overlay (b e kind)
+ "Return a new overlay in region defined by B and E with type KIND.
+KIND is either `code' or `comment'. The following properties are set in
+the overlay: `invisible' `hs'. Also, depending on variable
+`hs-isearch-open', the following properties may be present:
+`isearch-open-invisible' `isearch-open-invisible-temporary'. If
+variable `hs-set-up-overlay' is non-nil it should specify a function to
+call with the newly initialized overlay."
+ (let ((ov (make-overlay b e))
+ (io (if (eq 'block hs-isearch-open)
+ ;; backward compatibility -- `block'<=3D>`code'
+ 'code
+ hs-isearch-open)))
+ (overlay-put ov 'invisible 'hs)
+ (overlay-put ov 'display
+ (propertize
+ (hs--get-ellipsis b e)
+ 'mouse-face
+ 'highlight
+ 'help-echo "mouse-1: show hidden lines"
+ 'keymap '(keymap (mouse-1 . hs-toggle-hiding))))
+ ;; Internal properties
+ (overlay-put ov 'hs kind)
+ ;; Isearch integration
+ (when (or (eq io t) (eq io kind))
+ (overlay-put ov 'isearch-open-invisible 'hs-isearch-show)
+ (overlay-put ov 'isearch-open-invisible-temporary
+ 'hs-isearch-show-temporary))
+ ;; Remove overlay after modifications
+ (overlay-put ov 'modification-hooks '(hs--discard-overlay-before-ch=
anges))
+ (overlay-put ov 'insert-in-front-hooks '(hs--discard-overlay-before-ch=
anges))
+ (overlay-put ov 'insert-behind-hooks '(hs--discard-overlay-before-ch=
anges))
+
+ (when hs-set-up-overlay (funcall hs-set-up-overlay ov))
+ (hs--refresh-indicators b e)
+ ov))
+
+(defun hs--make-indicators-overlays (beg)
+ "Helper function to make the indicators overlays."
+ (let ((hiddenp (eq 'hs (get-char-property (pos-eol) 'invisible))))
+ ;; If we are going to use the EOL indicators, then
+ ;; ignore the invisible lines which mostly are already
+ ;; hidden blocks.
+ (when (or hs-indicator-type (not hiddenp))
+ (let* ((o (make-overlay
+ (if hs-indicator-type beg (pos-eol))
+ (1+ (if hs-indicator-type beg (pos-eol)))))
+ (fringe-type (if hiddenp 'hs-show 'hs-hide))
+ (face-or-icon (if hiddenp 'hs-indicator-show 'hs-indicator-hi=
de)))
+
+ (overlay-put o 'hs-indicator t)
+ (overlay-put o 'hs-indicator-block-start beg)
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'priority -50)
+
+ (overlay-put
+ o 'before-string
+ (pcase hs-indicator-type
+ ;; Fringes
+ ('fringe
+ (propertize
+ "+" 'display
+ `(left-fringe ,fringe-type ,face-or-icon)))
+ ;; Margins
+ ('margin
+ (propertize
+ "+" 'display
+ `((margin left-margin)
+ ,(or (plist-get (icon-elements face-or-icon) 'image)
+ (propertize (icon-string face-or-icon)
+ 'keymap hs-indicators-map)))
+ 'face face-or-icon
+ 'keymap hs-indicators-map))
+ ;; EOL string
+ ('nil
+ (concat
+ (propertize " " 'cursor t)
+ (propertize
+ (icon-string face-or-icon)
+ 'mouse-face 'highlight
+ 'keymap hs-indicators-map)))))))))
+
+(defun hs--add-indicators (&optional beg end)
+ "Add hideable indicators from BEG to END."
+ (save-excursion
+ (setq beg (if (null beg) (window-start) (goto-char beg) (pos-bol))
+ end (if (null end) (window-end) (goto-char end) (pos-bol))))
+ (goto-char beg)
+ (remove-overlays beg end 'hs-indicator t)
+
+ (while (not (>=3D (point) end))
+ (save-excursion
+ (when-let* ((b-beg (hs-get-first-block-on-line)))
+ (hs--make-indicators-overlays b-beg)))
+ ;; Only 1 indicator per line
+ (forward-line))
+ `(jit-lock-bounds ,beg . ,end))
+
+(defun hs--refresh-indicators (from to)
+ "Update indicator appearance in FROM and TO."
+ (when (and hs-show-indicators
+ (bound-and-true-p hs-minor-mode))
+ (save-match-data
+ (save-excursion
+ (hs--add-indicators from to)))))
+
(defun hs-isearch-show (ov)
"Delete overlay OV, and set `hs-headline' to nil.
=20
@@ -972,8 +1136,7 @@ hs-isearch-show-temporary
This function is meant to be used as the `isearch-open-invisible-temporary'
property of an overlay."
(setq hs-headline
- (if hide-p
- nil
+ (unless hide-p
(or hs-headline
(let ((start (overlay-start ov)))
(buffer-substring
@@ -990,107 +1153,15 @@ hs-isearch-show-temporary
(overlay-put ov 'display value)
(overlay-put ov 'hs-isearch-display nil))
(when (setq value (overlay-get ov 'display))
- (overlay-put ov 'hs-isearch-display value)
- (overlay-put ov 'display nil))))
+ (overlay-put ov 'display nil)
+ (overlay-put ov 'hs-isearch-display value))))
(overlay-put ov 'invisible (and hide-p 'hs)))
=20
-(defun hs-looking-at-block-start-p ()
+(defun hs-looking-at-block-start-p--default ()
"Return non-nil if the point is at the block start."
(and (looking-at hs-block-start-regexp)
(save-match-data (not (nth 8 (syntax-ppss))))))
=20
-(defun hs-forward-sexp (match-data arg)
- "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function' wi=
th ARG.
-Original match data is restored upon return."
- (save-match-data
- (set-match-data match-data)
- (goto-char (match-beginning hs-block-start-mdata-select))
- (funcall hs-forward-sexp-function arg)))
-
-(defun hs-hide-comment-region (beg end &optional repos-end)
- "Hide a region from BEG to END, marking it as a comment.
-Optional arg REPOS-END means reposition at end."
- (let ((goal-col (current-column))
- (beg-bol (progn (goto-char beg) (line-beginning-position)))
- (beg-eol (line-end-position))
- (end-eol (progn (goto-char end) (line-end-position))))
- (hs-discard-overlays beg-eol end-eol)
- (hs-make-overlay beg-eol end-eol 'comment beg end)
- (goto-char (if repos-end end (min end (+ beg-bol goal-col))))))
-
-(defun hs-hide-block-at-point (&optional end comment-reg)
- "Hide block if on block beginning.
-Optional arg END means reposition at end.
-Optional arg COMMENT-REG is a list of the form (BEGIN END) and
-specifies the limits of the comment, or nil if the block is not
-a comment.
-
-The block beginning is adjusted by `hs-adjust-block-beginning-function'
-and then further adjusted to be at the end of the line.
-
-If hiding the block is successful, return non-nil.
-Otherwise, return nil."
- (if comment-reg
- (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
- (when-let* ((block (hs-block-positions)))
- (let ((p (car block))
- (q (cadr block))
- ov)
- (if (hs-hideable-region-p p q)
- (progn
- (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p)))
- (delete-overlay ov))
- ((not hs-allow-nesting)
- (hs-discard-overlays p q)))
- (goto-char q)
- (hs-make-overlay p q 'code (- (match-end 0) p)))
- (goto-char (if end q (min p (match-end 0))))
- nil)))))
-
-(defun hs-get-first-block ()
- "Return the position of the first valid block found on the current line.
-This searches for a valid block on the current line and returns the
-first block found. Otherwise, if no block is found, it returns nil."
- (let (exit)
- (while (and (not exit)
- (funcall hs-find-next-block-function
- hs-block-start-regexp
- (line-end-position) nil)
- (save-excursion
- (goto-char (match-beginning 0))
- (if (hs-hideable-region-p)
- (setq exit (match-beginning 0))
- t))))
- exit))
-
-(defun hs-get-near-block (&optional include-comment)
- "Reposition point to a near block around point.
-It search for a valid block before and after point and return t if one
-is found.
-
-If INCLUDE-COMMENT is non-nil, it also searches for a comment block,
-returning `comment' if one is found."
- (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate)=
))
- pos)
- (cond
- ((and c-reg (car c-reg) (hs-hideable-region-p
- (car c-reg) (cadr c-reg)))
- (goto-char (car c-reg))
- 'comment)
-
- ((and (eq hs-hide-block-behavior 'after-bol)
- (save-excursion
- (goto-char (line-beginning-position))
- (setq pos (hs-get-first-block))))
- (goto-char pos)
- t)
-
- ((and (or (funcall hs-looking-at-block-start-predicate)
- (and (goto-char (line-beginning-position))
- (funcall hs-find-block-beginning-function)))
- (hs-hideable-region-p))
- t))))
-
(defun hs-inside-comment-p ()
(declare (obsolete "Call `hs-inside-comment-predicate' instead." "31.1"))
(funcall hs-inside-comment-predicate))
@@ -1100,51 +1171,21 @@ hs-inside-comment-p--default
;; the idea is to look backwards for a comment start regexp, do a
;; forward comment, and see if we are inside, then extend
;; forward and backward as long as we have comments
- (let ((q (point)))
- (skip-chars-forward "[:blank:]")
- (when (or (looking-at hs-c-start-regexp)
- (re-search-backward hs-c-start-regexp (point-min) t))
- ;; first get to the beginning of this comment...
- (while (and (not (bobp))
- (=3D (point) (progn (forward-comment -1) (point))))
- (forward-char -1))
- ;; ...then extend backwards
- (forward-comment (- (buffer-size)))
- (skip-chars-forward " \t\n\f")
- (let ((p (point))
- (hideable t))
- (beginning-of-line)
- (unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
- ;; we are in this situation: (example)
- ;; (defun bar ()
- ;; (foo)
- ;; ) ; comment
- ;; ^
- ;; the point was here before doing (beginning-of-line)
- ;; here we should advance till the next comment which
- ;; eventually has only white spaces preceding it on the same
- ;; line
- (goto-char p)
- (forward-comment 1)
- (skip-chars-forward " \t\n\f")
- (setq p (point))
- (while (and (< (point) q)
- (> (point) p)
- (not (looking-at hs-c-start-regexp)))
- ;; avoid an infinite cycle
- (setq p (point))
- (forward-comment 1)
- (skip-chars-forward " \t\n\f"))
- (when (or (not (looking-at hs-c-start-regexp))
- (> (point) q))
- ;; we cannot hide this comment block
- (setq hideable nil)))
- ;; goto the end of the comment
- (forward-comment (buffer-size))
- (skip-chars-backward " \t\n\f")
- (end-of-line)
- (when (>=3D (point) q)
- (list (and hideable p) (point))))))))
+ (when (or (re-search-backward
+ (concat "^[[:blank:]]*\\(" hs-c-start-regexp "\\)")
+ (pos-bol) t)
+ (and (skip-chars-forward "[:blank:]")
+ (looking-at-p hs-c-start-regexp)))
+ (goto-char (or (match-beginning 1) (point)))
+
+ (let ((beg (progn (forward-comment (- (buffer-size)))
+ (skip-chars-forward " \t\n\f")
+ (pos-eol)))
+ (end (progn (forward-comment (buffer-size))
+ (skip-chars-backward " \t\n\f")
+ (point))))
+ (when (hs-hideable-region-p beg end)
+ (list beg end))))))
=20
(defun hs--set-variable (var nth &optional default)
"Set Hideshow VAR if already not set.
@@ -1188,7 +1229,30 @@ hs-grok-mode-type
(hs--set-variable 'hs-find-next-block-function 7)
(hs--set-variable 'hs-looking-at-block-start-predicate 8))
=20
-(defun hs-find-block-beginning ()
+(defun hs--forward-sexp (match-data)
+ "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function'.
+Original match data is restored upon return."
+ (save-match-data
+ (set-match-data match-data)
+ (goto-char (match-beginning hs-block-start-mdata-select))
+ (funcall hs-forward-sexp-function 1)))
+
+(define-obsolete-function-alias
+ 'hs-find-next-block 'hs-find-next-block-fn--default "31.1")
+
+(defun hs-find-next-block-fn--default (regexp bound comments)
+ "Reposition point at next block-start.
+Skip comments if COMMENTS is nil, and search for REGEXP in
+region (point BOUND)."
+ (when (not comments)
+ (forward-comment (point-max)))
+ (and (< (point) bound)
+ (re-search-forward regexp bound t)))
+
+(define-obsolete-function-alias
+ 'hs-find-block-beginning 'hs-find-block-beg-fn--default "31.1")
+
+(defun hs-find-block-beg-fn--default ()
"Reposition point at block-start.
Return point, or nil if original point was not in a block."
(let ((done nil)
@@ -1202,152 +1266,58 @@ hs-find-block-beginning
(or (save-match-data (nth 8 (syntax-ppss)))
(not (setq done
(< here (save-excursion
- (hs-forward-sexp (match-data t) 1)
+ (hs--forward-sexp (match-data t))
(point))))))))
(if done
(point)
(goto-char here)
nil))))
=20
-(defun hs-find-next-block (regexp maxp comments)
- "Reposition point at next block-start.
-Skip comments if COMMENTS is nil, and search for REGEXP in
-region (point MAXP)."
- (when (not comments)
- (forward-comment (point-max)))
- (and (< (point) maxp)
- (re-search-forward regexp maxp t)))
-
-(defun hs-hide-level-recursive (arg &optional beg end)
- "Recursively hide blocks between BEG and END that are ARG levels below p=
oint.
-If BEG and END are not specified, it will search for a near block and
-use its position instead.
-
-If point is inside a block, it will use the current block positions
-instead of BEG and END."
- ;; If we are near of a block, set BEG and END according to that
- ;; block positions.
- (when (funcall hs-find-block-beginning-function)
- (let ((block (hs-block-positions)))
- (setq beg (point) end (cadr block))))
-
- ;; Show all blocks in that region
- (unless hs-allow-nesting (hs-discard-overlays beg end))
-
- ;; Skip initial block
- (goto-char (1+ beg))
-
- (while (funcall hs-find-next-block-function hs-block-start-regexp end ni=
l)
- (if (> arg 1)
- (hs-hide-level-recursive (1- arg))
- ;; `hs-hide-block-at-point' already moves the cursor, but if it
- ;; fails, return to the previous position where we were.
- (unless (and (goto-char (match-beginning hs-block-start-mdata-select=
))
- (hs-hide-block-at-point t))
- (goto-char (match-end hs-block-start-mdata-select)))))
-
- (goto-char end))
-
-(defmacro hs-life-goes-on (&rest body)
- "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
-In the dynamic context of this macro, `case-fold-search' is t."
- (declare (debug t))
- `(when hs-minor-mode
- (let ((case-fold-search t))
- (save-match-data
- (save-excursion ,@body)))))
-
-(defun hs-find-block-beginning-match ()
- "Reposition point at the end of match of the block-start regexp.
-Return point, or nil if original point was not in a block."
- (when (and (funcall hs-find-block-beginning-function)
- (funcall hs-looking-at-block-start-predicate))
- ;; point is inside a block
- (goto-char (match-end 0))))
-
-(defun hs-overlay-at (position)
- "Return hideshow overlay at POSITION, or nil if none to be found."
- (let ((overlays (overlays-at position))
- ov found)
- (while (and (not found) (setq ov (car overlays)))
- (setq found (and (overlay-get ov 'hs) ov)
- overlays (cdr overlays)))
- found))
-
-(defun hs-already-hidden-p ()
- "Return non-nil if point is in an already-hidden block, otherwise nil."
- (save-excursion
- (let ((c-reg (funcall hs-inside-comment-predicate)))
- (when (and c-reg (nth 0 c-reg))
- ;; point is inside a comment, and that comment is hideable
- (goto-char (nth 0 c-reg))))
- ;; Search for a hidden block at EOL ...
- (or (eq 'hs (get-char-property (line-end-position) 'invisible))
- ;; ... or behind the current cursor position
- (eq 'hs (get-char-property (if (bobp) (point) (1- (point))) 'invis=
ible)))))
-
;; This function is not used anymore (Bug#700).
(defun hs-c-like-adjust-block-beginning (initial)
"Adjust INITIAL, the buffer position after `hs-block-start-regexp'.
Actually, point is never moved; a new position is returned that is
the end of the C-function header. This adjustment function is meant
to be assigned to `hs-adjust-block-beginning-function' for C-like modes."
+ (declare (obsolete "Use `hs-adjust-block-beginning-function' instead." "=
31.1"))
(save-excursion
(goto-char (1- initial))
(forward-comment (- (buffer-size)))
(point)))
=20
-;;------------------------------------------------------------------------=
---
-;; commands
+;;;###autoload
+(defun turn-off-hideshow ()
+ "Unconditionally turn off `hs-minor-mode'."
+ (hs-minor-mode -1))
+
+
+;;;; Commands
=20
-(defun hs-hide-all ()
+(defun hs-hide-all (&optional exclude-comments)
"Hide all top level blocks, displaying only first and last lines.
Move point to the beginning of the line, and run the normal hook
-`hs-hide-hook'. See documentation for `run-hooks'.
-If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
- (interactive)
+`hs-hide-hook'. See documentation for `run-hooks'. If
+`hs-hide-comments-when-hiding-all' is non-nil, also hide the comments
+unless EXCLUDE-COMMENTS is non-nil."
+ (interactive "P")
(hs-life-goes-on
- (save-excursion
- (unless hs-allow-nesting
- (hs-discard-overlays (point-min) (point-max)))
- (goto-char (point-min))
- (syntax-propertize (point-max))
- (let ((spew (make-progress-reporter "Hiding all blocks..."
- (point-min) (point-max)))
- (re (when (stringp hs-block-start-regexp)
- (concat "\\("
- hs-block-start-regexp
- "\\)"
- (if (and hs-hide-comments-when-hiding-all
- (stringp hs-c-start-regexp))
- (concat "\\|\\("
- hs-c-start-regexp
- "\\)")
- "")))))
- (while (funcall hs-find-next-block-function re (point-max)
- hs-hide-comments-when-hiding-all)
- (if (match-beginning 1)
- ;; We have found a block beginning.
- (progn
- (goto-char (match-beginning 1))
- (unless (if hs-hide-all-non-comment-function
- (funcall hs-hide-all-non-comment-function)
- (hs-hide-block-at-point t))
- ;; Go to end of matched data to prevent from getting stuck
- ;; with an endless loop.
- (when (if (stringp hs-block-start-regexp)
- (looking-at hs-block-start-regexp)
- (eq (point) (match-beginning 0)))
- (goto-char (match-end 0)))))
- ;; found a comment, probably
- (let ((c-reg (funcall hs-inside-comment-predicate)))
- (when (and c-reg (car c-reg))
- (if (hs-hideable-region-p (car c-reg) (nth 1 c-reg))
- (hs-hide-block-at-point t c-reg)
- (goto-char (nth 1 c-reg))))))
+ (goto-char (point-min))
+ (unless hs-allow-nesting
+ (hs-discard-overlays (point-min) (point-max)))
+ (let ((spew (make-progress-reporter
+ "Hiding all blocks..." (point-min) (point-max))))
+ (while (not (eobp))
+ (when (hs-get-block-forward
+ (point-max)
+ (unless exclude-comments hs-hide-comments-when-hiding-all))
+ (let ((comment (funcall hs-inside-comment-predicate)))
+ (if (and hs-hide-all-non-comment-function (not comment))
+ (funcall hs-hide-all-non-comment-function)
+ (goto-char (match-beginning hs-block-start-mdata-select))
+ (hs-hide-block-at-point :move-point comment)))
(progress-reporter-update spew (point)))
- (progress-reporter-done spew)))
- (beginning-of-line)
+ (forward-visible-line 1))
+ (progress-reporter-done spew))
(run-hooks 'hs-hide-hook)))
=20
(defun hs-show-all ()
@@ -1355,7 +1325,7 @@ hs-show-all
(interactive)
(hs-life-goes-on
(message "Showing all blocks ...")
- (let ((hs-allow-nesting nil))
+ (let (hs-allow-nesting)
(hs-discard-overlays (point-min) (point-max)))
(message "Showing all blocks ... done")
(run-hooks 'hs-show-hook)))
@@ -1368,8 +1338,7 @@ hs-hide-block
(hs-life-goes-on
(let ((c-reg (funcall hs-inside-comment-predicate)))
(cond
- ((and c-reg (or (null (nth 0 c-reg))
- (not (hs-hideable-region-p (car c-reg) (nth 1 c-reg)=
))))
+ ((and c-reg (not (hs-hideable-region-p (car c-reg) (nth 1 c-reg))))
(user-error "(not enough comment lines to hide)"))
=20
(c-reg (hs-hide-block-at-point end c-reg))
@@ -1378,43 +1347,23 @@ hs-hide-block
=20
(run-hooks 'hs-hide-hook))))
=20
-(defun hs-show-block (&optional end)
+(defun hs-show-block ()
"Select a block and show it.
-With prefix arg, reposition at END. Upon completion, point is
-repositioned and the normal hook `hs-show-hook' is run.
-See documentation for functions `hs-hide-block' and `run-hooks'."
- (interactive "P")
+This command runs `hs-show-hook'. See documentation for functions
+`hs-hide-block' and `run-hooks'."
+ (interactive)
(hs-life-goes-on
- (or
- ;; first see if we have something at the end of the line
- (let ((ov (hs-overlay-at (line-end-position)))
- (here (point))
- ov-start ov-end)
- (when ov
- (goto-char
- (cond (end (overlay-end ov))
- ((eq 'comment (overlay-get ov 'hs)) here)
- (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset)))))
- (setq ov-start (overlay-start ov))
- (setq ov-end (overlay-end ov))
- (delete-overlay ov)
- (hs--refresh-indicators ov-start ov-end)
- t))
- ;; not immediately obvious, look for a suitable block
- (let ((c-reg (funcall hs-inside-comment-predicate))
- p q)
- (cond (c-reg
- (when (car c-reg)
- (setq p (car c-reg)
- q (cadr c-reg))))
- ((and (funcall hs-find-block-beginning-function)
- ;; ugh, fresh match-data
- (funcall hs-looking-at-block-start-predicate))
- (setq p (point)
- q (progn (hs-forward-sexp (match-data t) 1) (point)))))
- (when (and p q)
- (hs-discard-overlays p q)
- (goto-char (if end q (1+ p))))))
+ (if-let* ((ov (hs-overlay-at (pos-eol)))
+ (ov-start (overlay-start ov))
+ (ov-end (overlay-end ov)))
+ (progn
+ (hs-discard-overlays (1- ov-start) ov-end)
+ (hs--refresh-indicators ov-start ov-end))
+ (when-let* ((block
+ (or (funcall hs-inside-comment-predicate)
+ (and (funcall hs-find-block-beginning-function)
+ (list (point) (cadr (hs-block-positions)))))))
+ (hs-discard-overlays (car block) (cadr block))))
(run-hooks 'hs-show-hook)))
=20
(defun hs-hide-level (arg)
@@ -1424,7 +1373,18 @@ hs-hide-level
(hs-life-goes-on
(save-excursion
(message "Hiding blocks ...")
- (hs-hide-level-recursive arg (point-min) (point-max))
+ (if (funcall hs-looking-at-block-start-predicate)
+ ;; Hide block if we are looking at one.
+ (apply #'hs-hide-level-recursive
+ (list arg
+ (match-end hs-block-start-mdata-select)
+ (cadr (hs-block-positions))))
+ ;; Otherwise hide all the blocks in the current buffer
+ (hs-hide-level-recursive
+ ;; Increment ARG by 1, avoiding it acts like
+ ;; `hs-hide-all'
+ (1+ arg)
+ (point-min) (point-max)))
(message "Hiding blocks ... done"))
(run-hooks 'hs-hide-hook)))
=20
@@ -1465,15 +1425,10 @@ hs-hide-initial-comment-block
This can be useful if you have huge RCS logs in those comments."
(interactive)
(hs-life-goes-on
- (let ((c-reg (save-excursion
- (goto-char (point-min))
- (skip-chars-forward " \t\n\f")
- (funcall hs-inside-comment-predicate))))
- (when c-reg
- (let ((beg (car c-reg)) (end (cadr c-reg)))
- ;; see if we have enough comment lines to hide
- (when (hs-hideable-region-p beg end)
- (hs-hide-comment-region beg end)))))))
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n\f")
+ (when-let* ((c-reg (funcall hs-inside-comment-predicate)))
+ (hs-hide-comment-region (car c-reg) (cadr c-reg)))))
=20
(defun hs-cycle (&optional level)
"Cycle the visibility state of the current block.
@@ -1490,7 +1445,10 @@ hs-cycle
(hs-toggle-hiding)
(message "Toggle visibility"))
((> level 1)
- (hs-hide-level-recursive level)
+ (apply #'hs-hide-level-recursive
+ (list level
+ (match-end hs-block-start-mdata-select)
+ (cadr (hs-block-positions))))
(message "Hide %d level" level))
(t
(let* (hs-allow-nesting
@@ -1507,7 +1465,10 @@ hs-cycle
;; Hide the children blocks if the parent block is hidden
((and (=3D (overlay-start ov) (car block))
(=3D (overlay-end ov) (cadr block)))
- (hs-hide-level-recursive 1)
+ (apply #'hs-hide-level-recursive
+ (list 1
+ (match-end hs-block-start-mdata-select)
+ (cadr (hs-block-positions))))
(message "Hide first nested blocks"))
;; Otherwise show all in the parent block, we cannot use
;; `hs-show-block' here because we already know the
@@ -1533,10 +1494,6 @@ hs-minor-mode
commands and the hideshow commands are enabled.
The value (hs . t) is added to `buffer-invisibility-spec'.
=20
-The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block',
-`hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also
-`hs-hide-initial-comment-block'.
-
Turning hideshow minor mode off reverts the menu bar and the
variables to default values and disables the hideshow commands.
=20
@@ -1556,7 +1513,7 @@ hs-minor-mode
(user-error "%S doesn't support the Hideshow minor mode"
major-mode))
=20
- ;; Set the variables
+ ;; Set the old variables
(hs-grok-mode-type)
;; Turn off this mode if we change major modes.
(add-hook 'change-major-mode-hook
@@ -1575,21 +1532,11 @@ hs-minor-mode
(jit-lock-register #'hs--add-indicators)))
=20
(remove-from-invisibility-spec '(hs . t))
- ;; hs-show-all does nothing unless h-m-m is non-nil.
- (let ((hs-minor-mode t))
- (hs-show-all))
+ (remove-overlays nil nil 'hs-indicator t)
+ (remove-overlays nil nil 'invisible 'hs)
(when hs-show-indicators
- (jit-lock-unregister #'hs--add-indicators)
- (remove-overlays nil nil 'hs-indicator t))))
-
-;;;###autoload
-(defun turn-off-hideshow ()
- "Unconditionally turn off `hs-minor-mode'."
- (hs-minor-mode -1))
-
-;;------------------------------------------------------------------------=
---
-;; that's it
+ (jit-lock-unregister #'hs--add-indicators))))
=20
+
(provide 'hideshow)
-
;;; hideshow.el ends here
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 6809f1ec086..811b365fefb 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -4255,8 +4255,7 @@ treesit-hs-block-end
(if (bobp) (point) (1- (point))) pred))
(end (when thing (treesit-node-end thing)))
(last (when thing (treesit-node-child thing -1)))
- (beg (if last (treesit-node-start last)
- (if (bobp) (point) (1- (point))))))
+ (beg (treesit-node-start (or last thing))))
(when (and thing (eq (point) end))
(set-match-data (list beg end))
t)))
diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hi=
deshow-tests.el
index 9cf60c1ec84..39161f2455c 100644
--- a/test/lisp/progmodes/hideshow-tests.el
+++ b/test/lisp/progmodes/hideshow-tests.el
@@ -246,7 +246,7 @@ hideshow-hide-all-2
(should (string=3D (hideshow-tests-visible-string) contents)))))
=20
(ert-deftest hideshow-hide-level-1 ()
- "Should hide 1st level blocks."
+ "Should hide 2st level blocks."
(hideshow-tests-with-temp-buffer
c-mode
"
@@ -274,40 +274,6 @@ hideshow-hide-level-1
=20
\"String\"
=20
-int
-main(int argc, char **argv)
-{}
-"))))
-
-(ert-deftest hideshow-hide-level-2 ()
- "Should hide 2nd level blocks."
- (hideshow-tests-with-temp-buffer
- c-mode
- "
-/*
- Comments
-*/
-
-\"String\"
-
-int
-main(int argc, char **argv)
-{
- if (argc > 1) {
- printf(\"Hello\\n\");
- }
-}
-"
- (hs-hide-level 2)
- (should (string=3D
- (hideshow-tests-visible-string)
- "
-/*
- Comments
-*/
-
-\"String\"
-
int
main(int argc, char **argv)
{
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/pyth=
on-tests.el
index b9130da495d..6ddd57c9db2 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -7428,7 +7428,7 @@ python-hideshow-hide-levels-2
(or enabled (hs-minor-mode -1)))))
=20
(ert-deftest python-hideshow-hide-levels-3 ()
- "Should hide all blocks."
+ "Should hide 2nd level blocks."
(python-tests-with-temp-buffer
"
def f():
@@ -7447,19 +7447,22 @@ python-hideshow-hide-levels-3
(python-tests-visible-string)
"
def f():
+ if 0:
=20
def g():
+ pass
"))))
=20
(ert-deftest python-hideshow-hide-levels-4 ()
- "Should hide 2nd level block."
+ "Should hide 3nd level block."
(python-tests-with-temp-buffer
"
def f():
if 0:
l =3D [i for i in range(5)
if i < 3]
- abc =3D o.match(1, 2, 3)
+ if 1:
+ abc =3D o.match(1, 2, 3)
=20
def g():
pass
@@ -7472,6 +7475,9 @@ python-hideshow-hide-levels-4
"
def f():
if 0:
+ l =3D [i for i in range(5)
+ if i < 3]
+ if 1:
=20
def g():
pass
--=20
2.51.1
--=-=-=
Content-Type: text/plain
--
- E.G via Gnus and Org.
--=-=-=--
Elijah Gabe Pérez <eg642616@HIDDEN>:bug-gnu-emacs@HIDDEN.
Full text available.bug-gnu-emacs@HIDDEN:bug#79934; Package emacs.
Full text available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.