aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorThien-Thi Nguyen1999-12-26 11:03:32 +0000
committerThien-Thi Nguyen1999-12-26 11:03:32 +0000
commit26a0b3991e4bf4749b4486b264bfc05627606689 (patch)
treeb05b5f8613b37839be384b529900a198ef177587
parentf7c9e039d2487f11d2d714ce6803a464040be6cd (diff)
downloademacs-26a0b3991e4bf4749b4486b264bfc05627606689.tar.gz
emacs-26a0b3991e4bf4749b4486b264bfc05627606689.zip
Generally, synch w/ maintainer version 5.9.
(hs-show-hidden-short-form): Delete var; hard-code uses as `t'. (hs-minor-mode-hook): Don't initialize. (hs-special-modes-alist): Rewrite value and docstring. (hs-minor-mode-prefix): Delete unused var. (hs-block-start-mdata-select): New var, buffer local. (hs-headline): New var. (hs-match-data, hs-forward-sexp): New funcs. (hs-hide-comment-region): New func. (hs-discard-overlays, hs-flag-region, hs-hide-block-at-point, hs-safety-is-job-n, hs-hide-initial-comment-block, hs-inside-comment-p, hs-grok-mode-type, hs-find-block-beginning, hs-hide-level-recursive, hs-life-goes-on, hs-already-hidden-p, hs-c-like-adjust-block-beginning, hs-hide-all, hs-show-all, hs-hide-block, hs-show-block, hs-show-region, hs-hide-level, hs-mouse-toggle-hiding, hs-minor-mode): Rewrite. (hs-isearch-show): Renamed from `hs-isearch-open-invisible'. (hs-isearch-show-temporary): New funcs. (hs-show-block-at-point, java-hs-forward-sexp): Delete funcs. (hs-hide-all, hs-mouse-toggle-hiding): Don't autoload. When constructing menu, use `[(shift button2)]' notation.
Diffstat
-rw-r--r--lisp/progmodes/hideshow.el1109
1 files changed, 555 insertions, 554 deletions
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 85c917cdae7..6573ab35e68 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -1,11 +1,11 @@
1;;; hideshow.el --- minor mode cmds to selectively display blocks of code 1;;; hideshow.el --- minor mode cmds to selectively display blocks of code
2 2
3;; Copyright (C) 1994, 95, 96, 97, 98 Free Software Foundation 3;; Copyright (C) 1994, 95, 96, 97, 98, 99 Free Software Foundation
4 4
5;; Author: Thien-Thi Nguyen <ttn@netcom.com> 5;; Author: Thien-Thi Nguyen <ttn@netcom.com>
6;; Dan Nicolaescu <dann@ics.uci.edu> 6;; Dan Nicolaescu <dann@ics.uci.edu>
7;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines 7;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
8;; Maintainer-Version: 4.22 8;; Maintainer-Version: 5.9
9;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning 9;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
@@ -27,85 +27,149 @@
27 27
28;;; Commentary: 28;;; Commentary:
29 29
30;; - Commands provided 30;; * Commands provided
31;; 31;;
32;; This file provides `hs-minor-mode'. When active, seven commands: 32;; This file provides `hs-minor-mode'. When active, eight commands are
33;; available, implementing block hiding and showing. They (and their
34;; keybindings) are:
33;; 35;;
34;; hs-{hide,show}-{all,block}, hs-show-region, 36;; hs-hide-block C-c h
35;; hs-hide-level and hs-minor-mode 37;; hs-show-block C-c s
38;; hs-hide-all C-c H
39;; hs-show-all C-c S
40;; hs-show-region C-c R
41;; hs-hide-level C-c L
42;; hs-mouse-toggle-hiding [(shift button-2)]
43;; hs-hide-initial-comment-block
36;; 44;;
37;; are available, implementing block hiding and showing. Blocks are 45;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they
38;; defined per mode. In c-mode or c++-mode, they are simply curly braces, 46;; are simply text between curly braces, while in Lisp-ish modes parens
39;; while in Lisp-ish modes they are parens. Multi-line comments can also 47;; are used. Multi-line comment blocks can also be hidden. Read-only
40;; be hidden. The command `M-x hs-minor-mode' toggles the minor mode or 48;; buffers are not a problem, since hideshow doesn't modify the text.
41;; sets it (similar to outline minor mode). 49;;
50;; The command `M-x hs-minor-mode' toggles the minor mode or sets it
51;; (similar to other minor modes).
42 52
43;; - Customization 53;; * Customization
54;;
55;; You can use `M-x customize-variable' on the following variables:
56;;
57;; hs-hide-comments-when-hiding-all -- self-explanatory!
58;; hs-isearch-open -- what kind of hidden blocks to
59;; open when doing isearch
60;;
61;; Hideshow works w/ incremental search (isearch) by setting the variable
62;; `hs-headline', which is the line of text at the beginning of a hidden
63;; block that contains a match for the search. You can have this show up
64;; in the mode line by modifying the variable `mode-line-format'. For
65;; example, the following code prepends this info to the mode line:
44;; 66;;
45;; Variables control things thusly: 67;; (unless (memq 'hs-headline mode-line-format)
68;; (setq mode-line-format
69;; (append '("-" hs-headline) mode-line-format)))
46;; 70;;
47;; hs-hide-comments-when-hiding-all -- self-explanatory! 71;; See documentation for `mode-line-format' for more info.
48;; hs-show-hidden-short-form -- whether or not the last line in a form
49;; is omitted (saving screen space)
50;; hs-isearch-open -- what kind of hidden blocks to open when
51;; doing isearch
52;; hs-special-modes-alist -- keeps at bay hideshow's heuristics with
53;; respect to block definitions
54;; 72;;
55;; Hooks are run after some commands: 73;; Hooks are run after some commands:
56;; 74;;
57;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level 75;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level
58;; hs-show-hook hs-show-block, hs-show-all, hs-show-region 76;; hs-show-hook hs-show-block, hs-show-all, hs-show-region
59;; 77;;
60;; See docs for each variable or hook for more info. 78;; All hooks are run w/ `run-hooks'. See docs for each variable or hook
79;; for more info.
80;;
81;; Normally, hideshow tries to determine appropriate values for block
82;; and comment definitions by examining the buffer's major mode. If
83;; there are problems, hideshow will not activate and in that case you
84;; may wish to override hideshow's heuristics by adding an entry to
85;; variable `hs-special-modes-alist'. Packages that use hideshow should
86;; do something like:
87;;
88;; (let ((my-mode-hs-info '(my-mode "{{" "}}" ...)))
89;; (if (not (member my-mode-hs-info hs-special-modes-alist))
90;; (setq hs-special-modes-alist
91;; (cons my-mode-hs-info hs-special-modes-alist))))
92;;
93;; If you have an entry that works particularly well, consider
94;; submitting it for inclusion in hideshow.el. See docstring for
95;; `hs-special-modes-alist' for more info on the entry format.
61 96
62;; - Suggested usage 97;; * Suggested usage
98;;
99;; First make sure hideshow.el is in a directory in your `load-path'.
100;; You can optionally byte-compile it using `M-x byte-compile-file'.
101;; Then, add the following to your ~/.emacs:
63;; 102;;
64;; (load-library "hideshow") 103;; (load-library "hideshow")
65;; (add-hook 'X-mode-hook 'hs-minor-mode) ; other modes similarly 104;; (add-hook 'X-mode-hook 'hs-minor-mode) ; other modes similarly
66;; 105;;
67;; where X = {emacs-lisp,c,c++,perl,...}. See the doc for the variable 106;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle
68;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes. 107;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is
108;; activated, `hs-minor-mode-hook' is run w/ `run-hooks'. A good hook
109;; to add is `hs-hide-initial-comment-block'.
69 110
70;; - Bugs / caveats 111;; * Bugs
112;;
113;; (1) Hideshow does not work w/ emacs 18 because emacs 18 lacks the
114;; function `forward-comment' (among other things). If someone
115;; writes this, please send me a copy.
116;;
117;; (2) Sometimes `hs-headline' can become out of sync. To reset, type
118;; `M-x hs-minor-mode' twice (that is, deactivate then activate
119;; hideshow).
71;; 120;;
72;; 1. Hideshow does not work w/ emacs 18 because emacs 18 lacks the 121;; (3) Hideshow 5.x is developed and tested on GNU Emacs 20.4.
73;; function `forward-comment' (among other things). If someone writes 122;; XEmacs compatibility may have bitrotted since 4.29.
74;; this, please send me a copy.
75;; 123;;
76;; 2. Users of cc-mode.el should not hook hideshow into 124;; Correspondance welcome; please indicate version number. Send bug
77;; c-mode-common-hook since at that stage of the call sequence, the 125;; reports and inquiries to <ttn@netcom.com>.
78;; variables `comment-start' and `comment-end' are not yet provided.
79;; Instead, use c-mode-hook and c++-mode-hook as suggested above.
80 126
81;; - Thanks and feedback 127;; * Thanks
82;; 128;;
83;; Thanks go to the following people for valuable ideas, code and bug 129;; Thanks go to the following people for valuable ideas, code and
84;; reports. 130;; bug reports.
85;; adahome@ix.netcom.com Dean Andrews
86;; alfh@ifi.uio.no Alf-Ivar Holm
87;; gael@gnlab030.grenoble.hp.com Gael Marziou
88;; jan.djarv@sa.erisoft.se Jan Djarv
89;; preston.f.crow@dartmouth.edu Preston F. Crow
90;; qhslali@aom.ericsson.se Lars Lindberg
91;; sheff@edcsgw2.cr.usgs.gov Keith Sheffield
92;; ware@cis.ohio-state.edu Pete Ware
93;; d.love@dl.ac.uk Dave Love
94;; 131;;
95;; Special thanks go to Dan Nicolaescu <dann@ics.uci.edu>, who 132;; adahome@ix.netcom.com Dean Andrews
96;; reimplemented hideshow using overlays (rather than selective display), 133;; alfh@ifi.uio.no Alf-Ivar Holm
97;; added isearch magic, folded in custom.el compatibility, generalized 134;; bauer@itsm.uni-stuttgart.de Holger Bauer
98;; comment handling, incorporated mouse support, and maintained the code 135;; christoph.conrad@post.rwth-aachen.de Christoph Conrad
99;; in general. Version 4.0 is largely due to his efforts. 136;; d.love@dl.ac.uk Dave Love
137;; dirk@ida.ing.tu-bs.de Dirk Herrmann
138;; gael@gnlab030.grenoble.hp.com Gael Marziou
139;; jan.djarv@sa.erisoft.se Jan Djarv
140;; leray@dev-lme.pcc.philips.com Guillaume Leray
141;; moody@mwt.net Moody Ahmad
142;; preston.f.crow@dartmouth.edu Preston F. Crow
143;; qhslali@aom.ericsson.se Lars Lindberg
144;; reto@synopsys.com Reto Zimmermann
145;; sheff@edcsgw2.cr.usgs.gov Keith Sheffield
146;; smes@post1.com Chew Meng Kuan
147;; tonyl@eng.sun.com Tony Lam
148;; ware@cis.ohio-state.edu Pete Ware
100;; 149;;
101;; Correspondance welcome; please indicate version number. 150;; Special thanks go to Dan Nicolaescu <dann@ics.uci.edu>, who reimplemented
151;; hideshow using overlays (rather than selective display), added isearch
152;; magic, folded in custom.el compatibility, generalized comment handling,
153;; incorporated mouse support, and maintained the code in general. Version
154;; 4.0 is largely due to his efforts.
155
156;; * History
157;;
158;; Hideshow was inspired when I learned about selective display. It was
159;; reimplemented to use overlays for 4.0 (see above). WRT older history,
160;; entries in the masterfile corresponding to versions 1.x and 2.x have
161;; been lost. XEmacs support is reliable as of 4.29. State save and
162;; restore was added in 3.5 (not widely distributed), and reliable as of
163;; 4.30. Otherwise, the code seems stable. Passes checkdoc as of 4.32.
164;; Version 5.x uses new algorithms for block selection and traversal,
165;; unbundles state save and restore, and includes more isearch support.
102 166
103;;; Code: 167;;; Code:
104 168
105(require 'easymenu) 169(require 'easymenu)
106 170
107;;;---------------------------------------------------------------------------- 171;;---------------------------------------------------------------------------
108;;; user-configurable variables 172;; user-configurable variables
109 173
110(defgroup hideshow nil 174(defgroup hideshow nil
111 "Minor mode for hiding and showing program and comment blocks." 175 "Minor mode for hiding and showing program and comment blocks."
@@ -114,59 +178,18 @@
114 178
115;;;###autoload 179;;;###autoload
116(defcustom hs-hide-comments-when-hiding-all t 180(defcustom hs-hide-comments-when-hiding-all t
117 "Hide the comments too when you do an `hs-hide-all'." 181 "*Hide the comments too when you do an `hs-hide-all'."
118 :type 'boolean 182 :type 'boolean
119 :group 'hideshow) 183 :group 'hideshow)
120 184
121;;;###autoload 185(defcustom hs-minor-mode-hook nil
122(defcustom hs-show-hidden-short-form t 186 "*Hook called when hideshow minor mode is activated."
123 "Leave only the first line visible in a hidden block.
124If non-nil only the first line is visible when a block is in the
125hidden state, else both the first line and the last line are shown.
126A nil value disables `hs-adjust-block-beginning', which see.
127
128An example of how this works: (in C mode)
129original:
130
131 /* My function main
132 some more stuff about main
133 */
134 int
135 main(void)
136 {
137 int x=0;
138 return 0;
139 }
140
141
142hidden and `hs-show-hidden-short-form' is nil
143 /* My function main...
144 */
145 int
146 main(void)
147 {...
148 }
149
150hidden and `hs-show-hidden-short-form' is t
151 /* My function main...
152 int
153 main(void)...
154
155For the last case you have to be on the line containing the
156ellipsis when you do `hs-show-block'."
157 :type 'boolean
158 :group 'hideshow)
159
160(defcustom hs-minor-mode-hook 'hs-hide-initial-comment-block
161 "Hook called when `hs-minor-mode' is installed.
162A good value for this would be `hs-hide-initial-comment-block' to
163hide all the comments at the beginning of the file."
164 :type 'hook 187 :type 'hook
165 :group 'hideshow) 188 :group 'hideshow)
166 189
167(defcustom hs-isearch-open 'block 190(defcustom hs-isearch-open 'block
168 "What kind of hidden blocks to open when doing `isearch'. 191 "*What kind of hidden blocks to open when doing `isearch'.
169One of the following values: 192One of the following symbols:
170 193
171 block -- open only blocks 194 block -- open only blocks
172 comment -- open only comments 195 comment -- open only comments
@@ -175,96 +198,61 @@ One of the following values:
175 198
176This has effect iff `search-invisible' is set to `open'." 199This has effect iff `search-invisible' is set to `open'."
177 :type '(choice (const :tag "open only blocks" block) 200 :type '(choice (const :tag "open only blocks" block)
178 (const :tag "open only comments" comment) 201 (const :tag "open only comments" comment)
179 (const :tag "open both blocks and comments" t) 202 (const :tag "open both blocks and comments" t)
180 (const :tag "don't open any of them" nil)) 203 (const :tag "don't open any of them" nil))
181 :group 'hideshow) 204 :group 'hideshow)
182 205
183;;;###autoload 206;;;###autoload
184(defvar hs-special-modes-alist 207(defvar hs-special-modes-alist
185 '((c-mode "{" "}" nil nil hs-c-like-adjust-block-beginning) 208 '((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
186 (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) 209 (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
187 (java-mode "\\(\\(\\([ \t]*\\(\\(abstract\\|final\\|native\\|p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|s\\(tatic\\|ynchronized\\)\\)[ \t\n]+\\)*[.a-zA-Z0-9_:]+[ \t\n]*\\(\\[[ \t\n]*\\][ \t\n]*\\)?\\([a-zA-Z0-9_:]+[ \t\n]*\\)([^)]*)\\([ \n\t]+throws[ \t\n][^{]+\\)?\\)\\|\\([ \t]*static[^{]*\\)\\)[ \t\n]*{\\)" "}" "/[*/]" java-hs-forward-sexp hs-c-like-adjust-block-beginning)) 210 (bibtex-mode ("^@\\S(*\\(\\s(\\)" 1))
188; I tested the java regexp using the following: 211 (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
189;(defvar hsj-public) 212 )
190;(defvar hsj-type)
191;(defvar hsj-fname)
192;(defvar hsj-par)
193;(defvar hsj-throws)
194;(defvar hsj-static)
195
196;(setq hsj-public
197; (concat "[ \t]*\\("
198; (regexp-opt '("public" "private" "protected" "abstract"
199; "synchronized" "static" "final" "native") 1)
200; "[ \t\n]+\\)*"))
201
202;(setq hsj-type "[.a-zA-Z0-9_:]+[ \t\n]*\\(\\[[ \t\n]*\\][ \t\n]*\\)?")
203;(setq hsj-fname "\\([a-zA-Z0-9_:]+[ \t\n]*\\)")
204;(setq hsj-par "([^)]*)")
205;(setq hsj-throws "\\([ \n\t]+throws[ \t\n][^{]+\\)?")
206
207;(setq hsj-static "[ \t]*static[^{]*")
208
209
210;(setq hs-block-start-regexp (concat
211; "\\("
212; "\\("
213; "\\("
214; hsj-public
215; hsj-type
216; hsj-fname
217; hsj-par
218; hsj-throws
219; "\\)"
220; "\\|"
221; "\\("
222; hsj-static
223; "\\)"
224; "\\)"
225; "[ \t\n]*{"
226; "\\)"
227; ))
228
229 "*Alist for initializing the hideshow variables for different modes. 213 "*Alist for initializing the hideshow variables for different modes.
230It has the form 214Each element has the form
231 (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). 215 (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
232If present, hideshow will use these values as regexps for start, end
233and comment-start, respectively. Since Algol-ish languages do not have
234single-character block delimiters, the function `forward-sexp' used
235by hideshow doesn't work. In this case, if a similar function is
236available, you can register it and have hideshow use it instead of
237`forward-sexp'. See the documentation for `hs-adjust-block-beginning'
238to see what is the use of ADJUST-BEG-FUNC.
239 216
240If any of those is left nil, hideshow will try to guess some values 217If non-nil, hideshow will use these values as regexps to define blocks
241using function `hs-grok-mode-type'. 218and comments, respectively for major mode MODE.
219
220START, END and COMMENT-START are regular expressions. A block is
221defined as text surrounded by START and END.
222
223As a special case, START may be a list of the form (COMPLEX-START
224MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and
225MDATA-SELECTOR an integer that specifies which sub-match is the proper
226place to adjust point, before calling `hs-forward-sexp-func'. For
227example, see the `hs-special-modes-alist' entry for `bibtex-mode'.
242 228
243Note that the regexps should not contain leading or trailing whitespace.") 229For some major modes, `forward-sexp' does not work properly. In those
230cases, FORWARD-SEXP-FUNC specifies another function to use instead.
231
232See the documentation for `hs-adjust-block-beginning' to see what is the
233use of ADJUST-BEG-FUNC.
234
235If any of the elements is left nil or omitted, hideshow tries to guess
236appropriate values. The regexps should not contain leading or trailing
237whitespace. Case does not matter.")
244 238
245(defvar hs-hide-hook nil 239(defvar hs-hide-hook nil
246 "*Hooks called at the end of commands to hide text. 240 "*Hook called (with `run-hooks') at the end of commands to hide text.
247These commands include `hs-hide-all', `hs-hide-block' and `hs-hide-level'.") 241These commands include `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
248 242
249(defvar hs-show-hook nil 243(defvar hs-show-hook nil
250 "*Hooks called at the end of commands to show text. 244 "*Hook called (with `run-hooks') at the end of commands to show text.
251These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.") 245These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.")
252 246
253(defvar hs-minor-mode-prefix "\C-c" 247;;---------------------------------------------------------------------------
254 "*Prefix key to use for hideshow commands in hideshow minor mode.") 248;; internal variables
255
256;;;----------------------------------------------------------------------------
257;;; internal variables
258 249
259(defvar hs-minor-mode nil 250(defvar hs-minor-mode nil
260 "Non-nil if using hideshow mode as a minor mode of some other mode. 251 "Non-nil if using hideshow mode as a minor mode of some other mode.
261Use the command `hs-minor-mode' to toggle this variable.") 252Use the command `hs-minor-mode' to toggle or set this variable.")
262 253
263(defvar hs-minor-mode-map nil 254(defvar hs-minor-mode-map nil
264 "Mode map for hideshow minor mode.") 255 "Keymap for hideshow minor mode.")
265
266;(defvar hs-menu-bar nil
267; "Menu bar for hideshow minor mode (Xemacs only).")
268 256
269(defvar hs-c-start-regexp nil 257(defvar hs-c-start-regexp nil
270 "Regexp for beginning of comments. 258 "Regexp for beginning of comments.
@@ -274,6 +262,11 @@ surrounding whitespace is stripped.")
274(defvar hs-block-start-regexp nil 262(defvar hs-block-start-regexp nil
275 "Regexp for beginning of block.") 263 "Regexp for beginning of block.")
276 264
265(defvar hs-block-start-mdata-select nil
266 "Element in `hs-block-start-regexp' match data to consider as block start.
267The internal function `hs-forward-sexp' moves point to the beginning of this
268element (using `match-beginning') before calling `hs-forward-sexp-func'.")
269
277(defvar hs-block-end-regexp nil 270(defvar hs-block-end-regexp nil
278 "Regexp for end of block.") 271 "Regexp for end of block.")
279 272
@@ -287,13 +280,14 @@ function is necessary.")
287 280
288(defvar hs-adjust-block-beginning nil 281(defvar hs-adjust-block-beginning nil
289 "Function used to tweak the block beginning. 282 "Function used to tweak the block beginning.
290It has effect only if `hs-show-hidden-short-form' is non-nil. 283The block is hidden from the position returned by this function,
291The block it is hidden from the point returned by this function, 284as opposed to hiding it from the position returned when searching
292as opposed to hiding it from the point returned when searching 285for `hs-block-start-regexp'.
293`hs-block-start-regexp'. In c-like modes, if we wish to also hide the 286
294curly braces (if you think they occupy too much space on the screen), 287For example, in c-like modes, if we wish to also hide the curly braces
295this function should return the starting point (at the end of line) of 288(if you think they occupy too much space on the screen), this function
296the hidden region. 289should return the starting point (at the end of line) of the hidden
290region.
297 291
298It is called with a single argument ARG which is the the position in 292It is called with a single argument ARG which is the the position in
299buffer after the block beginning. 293buffer after the block beginning.
@@ -304,146 +298,157 @@ It should not move the point.
304 298
305See `hs-c-like-adjust-block-beginning' for an example of using this.") 299See `hs-c-like-adjust-block-beginning' for an example of using this.")
306 300
307;(defvar hs-emacs-type 'fsf 301(defvar hs-headline nil
308; "Used to support both Emacs and Xemacs.") 302 "Text of the line where a hidden block begins, set during isearch.
303You can display this in the mode line by adding the symbol `hs-headline'
304to the variable `mode-line-format'. For example,
305
306 (unless (memq 'hs-headline mode-line-format)
307 (setq mode-line-format
308 (append '(\"-\" hs-headline) mode-line-format)))
309
310Note that `mode-line-format' is buffer-local.")
311
312;;---------------------------------------------------------------------------
313;; system dependency
314
315; ;; xemacs compatibility
316; (when (string-match "xemacs\\|lucid" emacs-version)
317; ;; use pre-packaged compatiblity layer
318; (require 'overlay))
319;
320; ;; xemacs and emacs-19 compatibility
321; (when (or (not (fboundp 'add-to-invisibility-spec))
322; (not (fboundp 'remove-from-invisibility-spec)))
323; ;; `buffer-invisibility-spec' mutators snarfed from Emacs 20.3 lisp/subr.el
324; (defun add-to-invisibility-spec (arg)
325; (cond
326; ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t))
327; (setq buffer-invisibility-spec (list arg)))
328; (t
329; (setq buffer-invisibility-spec
330; (cons arg buffer-invisibility-spec)))))
331; (defun remove-from-invisibility-spec (arg)
332; (if buffer-invisibility-spec
333; (setq buffer-invisibility-spec
334; (delete arg buffer-invisibility-spec)))))
335
336;; hs-match-data
337(defalias 'hs-match-data 'match-data)
338
339;;---------------------------------------------------------------------------
340;; support functions
341
342(defun hs-discard-overlays (from to)
343 (when (< to from)
344 (setq from (prog1 to (setq to from))))
345 (mapcar (lambda (ov)
346 (when (overlay-get ov 'hs)
347 (delete-overlay ov)))
348 (overlays-in from to)))
349
350(defun hs-isearch-show (ov)
351 (setq hs-headline nil)
352 (hs-flag-region (overlay-start ov) (overlay-end ov) nil))
353
354(defun hs-isearch-show-temporary (ov hide-p)
355 (setq hs-headline
356 (if hide-p
357 nil
358 (or hs-headline
359 (let ((start (overlay-start ov)))
360 (buffer-substring
361 (save-excursion (goto-char start)
362 (beginning-of-line)
363 (skip-chars-forward " \t")
364 (point))
365 start)))))
366 (force-mode-line-update)
367 (overlay-put ov 'invisible (and hide-p 'hs)))
309 368
310;(eval-when-compile
311; (if (string-match "xemacs\\|lucid" emacs-version)
312; (progn
313; (defvar current-menubar nil "")
314; (defun set-buffer-menubar (arg1))
315; (defun add-menu (arg1 arg2 arg3)))))
316
317;;;----------------------------------------------------------------------------
318;;; support funcs
319
320;; snarfed from outline.el;
321(defun hs-flag-region (from to flag) 369(defun hs-flag-region (from to flag)
322 "Hide or show lines from FROM to TO, according to FLAG. 370 "Hide or show lines from FROM to TO, according to FLAG.
323If FLAG is nil then text is shown, while if FLAG is non-nil the text 371If FLAG is nil then text is shown, while if FLAG is non-nil the text is
324is hidden. Actually flag is really either `comment' or `block' 372hidden. Actually flag is really either `comment' or `block' depending
325depending on what kind of block it is suppose to hide." 373on what kind of block it is suppose to hide."
326 (save-excursion
327 (goto-char from)
328 (end-of-line)
329 (hs-discard-overlays (point) to 'invisible 'hs)
330 (if flag
331 (let ((overlay (make-overlay (point) to)))
332 ;; Make overlay hidden and intangible.
333 (overlay-put overlay 'invisible 'hs)
334 (overlay-put overlay 'hs t)
335 (when (or (eq hs-isearch-open t) (eq hs-isearch-open flag))
336 (overlay-put overlay 'isearch-open-invisible
337 'hs-isearch-open-invisible))
338 (overlay-put overlay 'intangible t)))))
339
340;; This is set as an `isearch-open-invisible' property to hidden
341;; overlays.
342(defun hs-isearch-open-invisible (ov)
343 (save-excursion 374 (save-excursion
344 (goto-char (overlay-start ov)) 375 ;; first clear it all out
345 (hs-show-block))) 376 (hs-discard-overlays from to)
346 377 ;; now create overlays if needed
347;; Remove from the region BEG ... END all overlays 378 (when flag
348;; with a PROP property equal to VALUE. 379 (let ((overlay (make-overlay from to)))
349;; Overlays with a PROP property different from VALUE are not touched. 380 (overlay-put overlay 'invisible 'hs)
350(defun hs-discard-overlays (beg end prop value) 381 (overlay-put overlay 'intangible t)
351 (if (< end beg) 382 (overlay-put overlay 'hs flag)
352 (setq beg (prog1 end (setq end beg)))) 383 (when (or (eq hs-isearch-open t) (eq hs-isearch-open flag))
353 (save-excursion 384 (mapcar
354 (goto-char beg) 385 (lambda (pair)
355 (let ((overlays (overlays-in beg end)) 386 (overlay-put overlay (car pair) (cdr pair)))
356 o) 387 '((isearch-open-invisible . hs-isearch-show)
357 (while overlays 388 (isearch-open-invisible-temporary . hs-isearch-show-temporary))))
358 (setq o (car overlays)) 389 overlay))))
359 (if (eq (overlay-get o prop) value) 390
360 (delete-overlay o)) 391(defun hs-forward-sexp (match-data arg)
361 (setq overlays (cdr overlays)))))) 392 "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG.
393Original match data is restored upon return."
394 (save-match-data
395 (set-match-data match-data)
396 (goto-char (match-beginning hs-block-start-mdata-select))
397 (funcall hs-forward-sexp-func arg)))
398
399(defun hs-hide-comment-region (beg end &optional repos-end)
400 "Hide a region from BEG to END, marking it as a comment.
401Optional arg REPOS-END means reposition at end."
402 (hs-flag-region (progn (goto-char beg) (end-of-line) (point))
403 (progn (goto-char end) (end-of-line) (point))
404 'comment)
405 (goto-char (if repos-end end beg)))
362 406
363(defun hs-hide-block-at-point (&optional end comment-reg) 407(defun hs-hide-block-at-point (&optional end comment-reg)
364 "Hide block iff on block beginning. 408 "Hide block iff on block beginning.
365Optional arg END means reposition at end. 409Optional arg END means reposition at end.
366Optional arg COMMENT-REG is a list of the form (BEGIN . END) and 410Optional arg COMMENT-REG is a list of the form (BEGIN END) and
367specifies the limits of the comment, or nil if the block is not 411specifies the limits of the comment, or nil if the block is not
368a comment." 412a comment.
369 (if comment-reg 413
370 (progn 414The block beginning is adjusted by `hs-adjust-block-beginning'
371 ;; goto the end of line at the end of the comment 415and then further adjusted to be at the end of the line."
372 (goto-char (nth 1 comment-reg))
373 (unless hs-show-hidden-short-form (forward-line -1))
374 (end-of-line)
375 (hs-flag-region (car comment-reg) (point) 'comment)
376 (goto-char (if end (nth 1 comment-reg) (car comment-reg))))
377 (if (looking-at hs-block-start-regexp)
378 (let* ((p ;; p is the point at the end of the block beginning
379 (if (and hs-show-hidden-short-form
380 hs-adjust-block-beginning)
381 ;; we need to adjust the block beginning
382 (funcall hs-adjust-block-beginning (match-end 0))
383 (match-end 0)))
384 ;; q is the point at the end of the block
385 (q (progn (funcall hs-forward-sexp-func 1) (point))))
386 ;; position the point so we can call `hs-flag-region'
387 (unless hs-show-hidden-short-form (forward-line -1))
388 (end-of-line)
389 (if (and (< p (point)) (> (count-lines p q)
390 (if hs-show-hidden-short-form 1 2)))
391 (hs-flag-region p (point) 'block))
392 (goto-char (if end q p))))))
393
394(defun hs-show-block-at-point (&optional end comment-reg)
395 "Show block iff on block beginning.
396Optional arg END means reposition at end.
397Optional arg COMMENT-REG is a list of the forme (BEGIN . END) and
398specifies the limits of the comment. It should be nil when hiding
399a block."
400 (if comment-reg 416 (if comment-reg
401 (when (car comment-reg) 417 (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
402 (hs-flag-region (car comment-reg) (nth 1 comment-reg) nil)
403 (goto-char (if end (nth 1 comment-reg) (car comment-reg))))
404 (if (looking-at hs-block-start-regexp) 418 (if (looking-at hs-block-start-regexp)
405 (let* ((p (point)) 419 (let* ((mdata (hs-match-data t))
406 (q 420 (pure-p (match-end 0))
407 (condition-case error ; probably unbalanced paren 421 (p
408 (progn 422 ;; `p' is the point at the end of the block beginning,
409 (funcall hs-forward-sexp-func 1) 423 ;; which may need to be adjusted
410 (point)) 424 (save-excursion
411 (error 425 (goto-char (funcall (or hs-adjust-block-beginning
412 ;; try to get out of rat's nest and expose the whole func 426 'identity)
413 (if (/= (current-column) 0) (beginning-of-defun)) 427 pure-p))
414 (setq p (point)) 428 ;; whatever the adjustment, we move to eol
415 (re-search-forward (concat "^" hs-block-start-regexp) 429 (end-of-line)
416 (point-max) t 2) 430 (point)))
417 (point))))) 431 (q
418 (hs-flag-region p q nil) 432 ;; `q' is the point at the end of the block
419 (goto-char (if end (1+ (point)) p)))))) 433 (progn (hs-forward-sexp mdata 1)
434 (end-of-line)
435 (point))))
436 (if (and (< p (point)) (> (count-lines p q) 1))
437 (overlay-put (hs-flag-region p q 'block)
438 'hs-ofs
439 (- pure-p p)))
440 (goto-char (if end q (min p pure-p)))))))
420 441
421(defun hs-safety-is-job-n () 442(defun hs-safety-is-job-n ()
422 "Warn if `buffer-invisibility-spec' does not contain hs." 443 "Warn if `buffer-invisibility-spec' does not contain symbol `hs'."
423 (if (or buffer-invisibility-spec (assq 'hs buffer-invisibility-spec) ) 444 (unless (and (listp buffer-invisibility-spec)
424 nil 445 (assq 'hs buffer-invisibility-spec))
425 (message "Warning: `buffer-invisibility-spec' does not contain hs!!") 446 (message "Warning: `buffer-invisibility-spec' does not contain hs!!")
426 (sit-for 2))) 447 (sit-for 2)))
427 448
428(defun hs-hide-initial-comment-block ()
429 (interactive)
430 "Hide the first block of comments in a file.
431This is useful when a part of `hs-minor-mode-hook', especially with
432huge header-comment RCS logs."
433 (let ((p (point))
434 c-reg)
435 (goto-char (point-min))
436 (skip-chars-forward " \t\n^L")
437 (setq c-reg (hs-inside-comment-p))
438 ;; see if we have enough comment lines to hide
439 (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg))
440 (if hs-show-hidden-short-form 1 2)))
441 (hs-hide-block)
442 (goto-char p))))
443
444(defun hs-inside-comment-p () 449(defun hs-inside-comment-p ()
445 "Return non-nil if point is inside a comment, otherwise nil. 450 "Return non-nil if point is inside a comment, otherwise nil.
446Actually, returns a list containing the buffer position of the start 451Actually, return a list containing the buffer position of the start
447and the end of the comment. A comment block can be hidden only if on 452and the end of the comment. A comment block can be hidden only if on
448its starting line there is only whitespace preceding the actual comment 453its starting line there is only whitespace preceding the actual comment
449beginning. If we are inside of a comment but this condition is not met, 454beginning. If we are inside of a comment but this condition is not met,
@@ -455,140 +460,120 @@ as cdr."
455 ;; forward and backward as long as we have comments 460 ;; forward and backward as long as we have comments
456 (let ((q (point))) 461 (let ((q (point)))
457 (when (or (looking-at hs-c-start-regexp) 462 (when (or (looking-at hs-c-start-regexp)
458 (re-search-backward hs-c-start-regexp (point-min) t)) 463 (re-search-backward hs-c-start-regexp (point-min) t))
459 (forward-comment (- (buffer-size))) 464 (forward-comment (- (buffer-size)))
460 (skip-chars-forward " \t\n ") 465 (skip-chars-forward " \t\n\f")
461 (let ((p (point)) 466 (let ((p (point))
462 (not-hidable nil)) 467 (not-hidable nil))
463 (beginning-of-line) 468 (beginning-of-line)
464 (unless (looking-at (concat "[ \t]*" hs-c-start-regexp)) 469 (unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
465 ;; we are in this situation: (example) 470 ;; we are in this situation: (example)
466 ;; (defun bar () 471 ;; (defun bar ()
467 ;; (foo) 472 ;; (foo)
468 ;; ) ; comment 473 ;; ) ; comment
469 ;; ^ 474 ;; ^
470 ;; the point was here before doing (beginning-of-line) 475 ;; the point was here before doing (beginning-of-line)
471 ;; here we should advance till the next comment which 476 ;; here we should advance till the next comment which
472 ;; eventually has only white spaces preceding it on the same 477 ;; eventually has only white spaces preceding it on the same
473 ;; line 478 ;; line
474 (goto-char p) 479 (goto-char p)
475 (forward-comment 1) 480 (forward-comment 1)
476 (skip-chars-forward " \t\n ") 481 (skip-chars-forward " \t\n\f")
477 (setq p (point)) 482 (setq p (point))
478 (while (and (< (point) q) 483 (while (and (< (point) q)
479 (> (point) p) 484 (> (point) p)
480 (not (looking-at hs-c-start-regexp))) 485 (not (looking-at hs-c-start-regexp)))
481 (setq p (point)) ;; use this to avoid an infinit cycle. 486 (setq p (point));; use this to avoid an infinite cycle
482 (forward-comment 1) 487 (forward-comment 1)
483 (skip-chars-forward " \t\n ")) 488 (skip-chars-forward " \t\n\f"))
484 (if (or (not (looking-at hs-c-start-regexp)) 489 (if (or (not (looking-at hs-c-start-regexp))
485 (> (point) q)) 490 (> (point) q))
486 ;; we cannot hide this comment block 491 ;; we cannot hide this comment block
487 (setq not-hidable t))) 492 (setq not-hidable t)))
488 ;; goto the end of the comment 493 ;; goto the end of the comment
489 (forward-comment (buffer-size)) 494 (forward-comment (buffer-size))
490 (skip-chars-backward " \t\n ") 495 (skip-chars-backward " \t\n\f")
491 (end-of-line) 496 (end-of-line)
492 (if (>= (point) q) 497 (if (>= (point) q)
493 (list (if not-hidable nil p) (point)))))))) 498 (list (if not-hidable nil p) (point))))))))
494 499
495(defun hs-grok-mode-type () 500(defun hs-grok-mode-type ()
496 "Set up hideshow variables for new buffers. 501 "Set up hideshow variables for new buffers.
497If `hs-special-modes-alist' has information associated with the 502If `hs-special-modes-alist' has information associated with the
498current buffer's major mode, use that. 503current buffer's major mode, use that.
499Otherwise, guess start, end and comment-start regexps; forward-sexp 504Otherwise, guess start, end and `comment-start' regexps; `forward-sexp'
500function; and adjust-block-beginning function." 505function; and adjust-block-beginning function."
501 (if (and (boundp 'comment-start) 506 (if (and (boundp 'comment-start)
502 (boundp 'comment-end) 507 (boundp 'comment-end)
503 comment-start comment-end) 508 comment-start comment-end)
504 (let ((lookup (assoc major-mode hs-special-modes-alist))) 509 (let* ((lookup (assoc major-mode hs-special-modes-alist))
505 (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(") 510 (start-elem (or (nth 1 lookup) "\\s(")))
506 hs-block-end-regexp (or (nth 2 lookup) "\\s\)") 511 (if (listp start-elem)
507 hs-c-start-regexp (or (nth 3 lookup) 512 ;; handle (START-REGEXP MDATA-SELECT)
508 (let ((c-start-regexp 513 (setq hs-block-start-regexp (car start-elem)
509 (regexp-quote comment-start))) 514 hs-block-start-mdata-select (cadr start-elem))
510 (if (string-match " +$" c-start-regexp) 515 ;; backwards compatibility: handle simple START-REGEXP
511 (substring c-start-regexp 0 (1- (match-end 0))) 516 (setq hs-block-start-regexp start-elem
512 c-start-regexp))) 517 hs-block-start-mdata-select 0))
513 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp) 518 (setq hs-block-end-regexp (or (nth 2 lookup) "\\s)")
514 hs-adjust-block-beginning (nth 5 lookup))) 519 hs-c-start-regexp (or (nth 3 lookup)
515 (error "%s Mode doesn't support Hideshow Mode" mode-name))) 520 (let ((c-start-regexp
521 (regexp-quote comment-start)))
522 (if (string-match " +$" c-start-regexp)
523 (substring c-start-regexp
524 0 (1- (match-end 0)))
525 c-start-regexp)))
526 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp)
527 hs-adjust-block-beginning (nth 5 lookup)))
528 (progn
529 (setq hs-minor-mode nil)
530 (error "%s Mode doesn't support Hideshow Minor Mode" mode-name))))
516 531
517(defun hs-find-block-beginning () 532(defun hs-find-block-beginning ()
518 "Reposition point at block-start. 533 "Reposition point at block-start.
519Return point, or nil if top-level." 534Return point, or nil if top-level."
520 (let (done 535 (let ((done nil)
521 (try-again t) 536 (here (point)))
522 (here (point)) 537 ;; look if current line is block start
523 (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\(" 538 (if (looking-at hs-block-start-regexp)
524 hs-block-end-regexp "\\)")) 539 (point)
525 (buf-size (buffer-size))) 540 ;; look backward for the start of a block that contains the cursor
526 (beginning-of-line) 541 (while (and (re-search-backward hs-block-start-regexp nil t)
527 ;; A block beginning can span on multiple lines, if the point 542 (not (setq done
528 ;; is on one of those lines, trying a regexp search from 543 (< here (save-excursion
529 ;; that point would fail to find the block beginning, so we look 544 (hs-forward-sexp (hs-match-data t) 1)
530 ;; backwards for the block beginning, or a block end. 545 (point)))))))
531 (while try-again 546 (if done
532 (setq try-again nil) 547 (point)
533 (if (and (re-search-backward both-regexps (point-min) t) 548 (goto-char here)
534 (match-beginning 1)) ; found a block beginning 549 nil))))
535 (if (save-match-data (hs-inside-comment-p))
536 ;;but it was inside a comment, so we have to look for
537 ;;it again
538 (setq try-again t)
539 ;; that's what we were looking for
540 (setq done (match-beginning 0)))
541 ;; we found a block end, or we reached the beginning of the
542 ;; buffer look to see if we were on a block beginning when we
543 ;; started
544 (if (and
545 (re-search-forward hs-block-start-regexp (point-max) t)
546 (or
547 (and (>= here (match-beginning 0)) (< here (match-end 0)))
548 (and hs-show-hidden-short-form hs-adjust-block-beginning
549 (save-match-data
550 (= 1 (count-lines
551 (funcall hs-adjust-block-beginning
552 (match-end 0)) here))))))
553 (setq done (match-beginning 0)))))
554 (goto-char here)
555 (while (and (not done)
556 ;; This had problems because the regexp can match something
557 ;; inside of a comment!
558 ;; Since inside a comment we can have incomplete sexps
559 ;; this would have signaled an error.
560 (or (forward-comment (- buf-size)) t); `or' is a hack to
561 ; make it return t
562 (re-search-backward both-regexps (point-min) t))
563 (if (match-beginning 1) ; start of start-regexp
564 (setq done (match-beginning 0))
565 (goto-char (match-end 0)) ; end of end-regexp
566 (funcall hs-forward-sexp-func -1)))
567 (goto-char (or done here))
568 done))
569 550
570(defun hs-hide-level-recursive (arg minp maxp) 551(defun hs-hide-level-recursive (arg minp maxp)
571 "Hide blocks ARG levels below this block recursively." 552 "Recursively hide blocks ARG levels below point in region (MINP MAXP)."
572 (when (hs-find-block-beginning) 553 (when (hs-find-block-beginning)
573 (setq minp (1+ (point))) 554 (setq minp (1+ (point)))
574 (forward-sexp) 555 (funcall hs-forward-sexp-func 1)
575 (setq maxp (1- (point)))) 556 (setq maxp (1- (point))))
576 (hs-flag-region minp maxp ?\n) ; eliminate weirdness 557 (hs-flag-region minp maxp nil) ; eliminate weirdness
577 (goto-char minp) 558 (goto-char minp)
578 (while (progn 559 (while (progn
579 (forward-comment (buffer-size)) 560 (forward-comment (buffer-size))
580 (re-search-forward hs-block-start-regexp maxp t)) 561 (and (< (point) maxp)
562 (re-search-forward hs-block-start-regexp maxp t)))
581 (if (> arg 1) 563 (if (> arg 1)
582 (hs-hide-level-recursive (1- arg) minp maxp) 564 (hs-hide-level-recursive (1- arg) minp maxp)
583 (goto-char (match-beginning 0)) 565 (goto-char (match-beginning hs-block-start-mdata-select))
584 (hs-hide-block-at-point t))) 566 (hs-hide-block-at-point t)))
585 (hs-safety-is-job-n) 567 (hs-safety-is-job-n)
586 (goto-char maxp)) 568 (goto-char maxp))
587 569
588(defmacro hs-life-goes-on (&rest body) 570(defmacro hs-life-goes-on (&rest body)
589 "Execute optional BODY iff variable `hs-minor-mode' is non-nil." 571 "Evaluate BODY forms iff variable `hs-minor-mode' is non-nil.
590 `(let ((inhibit-point-motion-hooks t)) 572In the dynamic context of this macro, `inhibit-point-motion-hooks'
591 (when hs-minor-mode 573and `case-fold-search' are both t."
574 `(when hs-minor-mode
575 (let ((inhibit-point-motion-hooks t)
576 (case-fold-search t))
592 ,@body))) 577 ,@body)))
593 578
594(put 'hs-life-goes-on 'edebug-form-spec '(&rest form)) 579(put 'hs-life-goes-on 'edebug-form-spec '(&rest form))
@@ -598,51 +583,39 @@ Return point, or nil if top-level."
598 (save-excursion 583 (save-excursion
599 (let ((c-reg (hs-inside-comment-p))) 584 (let ((c-reg (hs-inside-comment-p)))
600 (if (and c-reg (nth 0 c-reg)) 585 (if (and c-reg (nth 0 c-reg))
601 ;; point is inside a comment, and that comment is hidable 586 ;; point is inside a comment, and that comment is hidable
602 (goto-char (nth 0 c-reg)) 587 (goto-char (nth 0 c-reg))
603 (if (and (not c-reg) (hs-find-block-beginning) 588 (if (and (not c-reg)
604 (looking-at hs-block-start-regexp)) 589 (hs-find-block-beginning)
605 ;; point is inside a block 590 (looking-at hs-block-start-regexp))
606 (goto-char (match-end 0))))) 591 ;; point is inside a block
592 (goto-char (match-end 0)))))
607 (end-of-line) 593 (end-of-line)
608 (let ((overlays (overlays-at (point))) 594 (let ((overlays (overlays-at (point)))
609 (found nil)) 595 (found nil))
610 (while (and (not found) (overlayp (car overlays))) 596 (while (and (not found) (overlayp (car overlays)))
611 (setq found (overlay-get (car overlays) 'hs) 597 (setq found (overlay-get (car overlays) 'hs)
612 overlays (cdr overlays))) 598 overlays (cdr overlays)))
613 found))) 599 found)))
614 600
615(defun java-hs-forward-sexp (arg) 601(defun hs-c-like-adjust-block-beginning (initial)
616 "Function used by `hs-minor-mode' for `forward-sexp' in Java mode." 602 "Adjust INITIAL, the buffer position after `hs-block-start-regexp'.
617 (if (< arg 0) 603Actually, point is never moved; a new position is returned that is
618 (backward-sexp 1) 604the end of the C-function header. This adjustment function is meant
619 (if (looking-at hs-block-start-regexp) 605to be assigned to `hs-adjust-block-beginning' for C-like modes."
620 (progn
621 (goto-char (match-end 0))
622 (forward-char -1)
623 (forward-sexp 1))
624 (forward-sexp 1))))
625
626(defun hs-c-like-adjust-block-beginning (arg)
627 "Function to be assigned to `hs-adjust-block-beginning' for C-like modes.
628Arg is a position in buffer just after {. This goes back to the end of
629the function header. The purpose is to save some space on the screen
630when displaying hidden blocks."
631 (save-excursion 606 (save-excursion
632 (goto-char arg) 607 (goto-char (1- initial))
633 (forward-char -1)
634 (forward-comment (- (buffer-size))) 608 (forward-comment (- (buffer-size)))
635 (point))) 609 (point)))
636 610
637;;;---------------------------------------------------------------------------- 611;;---------------------------------------------------------------------------
638;;; commands 612;; commands
639 613
640;;;###autoload
641(defun hs-hide-all () 614(defun hs-hide-all ()
642 "Hide all top-level blocks, displaying only first and last lines. 615 "Hide all top level blocks, displaying only first and last lines.
643Move point to the beginning of the line, and it run the normal hook 616Move point to the beginning of the line, and run the normal hook
644`hs-hide-hook'. See documentation for `run-hooks'. 617`hs-hide-hook'. See documentation for `run-hooks'.
645If `hs-hide-comments-when-hiding-all' is t, also hide the comments." 618If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
646 (interactive) 619 (interactive)
647 (hs-life-goes-on 620 (hs-life-goes-on
648 (message "Hiding all blocks ...") 621 (message "Hiding all blocks ...")
@@ -650,46 +623,44 @@ If `hs-hide-comments-when-hiding-all' is t, also hide the comments."
650 (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness 623 (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness
651 (goto-char (point-min)) 624 (goto-char (point-min))
652 (if hs-hide-comments-when-hiding-all 625 (if hs-hide-comments-when-hiding-all
653 (let (c-reg 626 (let ((c-reg nil)
654 (count 0) 627 (count 0)
655 (block-and-comment-re ;; this should match 628 (block-and-comment-re
656 (concat "\\(^" ;; the block beginning and comment start 629 (concat "\\("
657 hs-block-start-regexp 630 hs-block-start-regexp
658 "\\)\\|\\(" hs-c-start-regexp "\\)"))) 631 "\\)\\|\\("
659 (while (re-search-forward block-and-comment-re (point-max) t) 632 hs-c-start-regexp
660 (if (match-beginning 1) ;; we have found a block beginning 633 "\\)")))
661 (progn 634 (while (re-search-forward block-and-comment-re (point-max) t)
662 (goto-char (match-beginning 1)) 635 (if (match-beginning 1) ;; we have found a block beginning
663 (hs-hide-block-at-point t) 636 (progn
664 (message "Hiding ... %d" (setq count (1+ count)))) 637 (goto-char (match-beginning 1))
665 ;;found a comment 638 (hs-hide-block-at-point t)
666 (setq c-reg (hs-inside-comment-p)) 639 (message "Hiding ... %d" (setq count (1+ count))))
667 (if (and c-reg (car c-reg)) 640 ;;found a comment
668 (if (> (count-lines (car c-reg) (nth 1 c-reg)) 641 (setq c-reg (hs-inside-comment-p))
669 (if hs-show-hidden-short-form 1 2)) 642 (if (and c-reg (car c-reg))
670 (progn 643 (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1)
671 (hs-hide-block-at-point t c-reg) 644 (progn
672 (message "Hiding ... %d" (setq count (1+ count)))) 645 (hs-hide-block-at-point t c-reg)
673 (goto-char (nth 1 c-reg))))))) 646 (message "Hiding ... %d" (setq count (1+ count))))
647 (goto-char (nth 1 c-reg)))))))
674 (let ((count 0) 648 (let ((count 0)
675 (top-level-re (concat "^" hs-block-start-regexp)) 649 (buf-size (buffer-size)))
676 (buf-size (buffer-size))) 650 (while
677 (while 651 (progn
678 (progn 652 (forward-comment buf-size)
679 (forward-comment buf-size) 653 (re-search-forward hs-block-start-regexp (point-max) t))
680 (re-search-forward top-level-re (point-max) t)) 654 (goto-char (match-beginning 0))
681 (goto-char (match-beginning 0)) 655 (hs-hide-block-at-point t)
682 (hs-hide-block-at-point t) 656 (message "Hiding ... %d" (setq count (1+ count))))))
683 (message "Hiding ... %d" (setq count (1+ count))))))
684 (hs-safety-is-job-n)) 657 (hs-safety-is-job-n))
685 (beginning-of-line) 658 (beginning-of-line)
686 (message "Hiding all blocks ... done") 659 (message "Hiding all blocks ... done")
687 (run-hooks 'hs-hide-hook))) 660 (run-hooks 'hs-hide-hook)))
688 661
689(defun hs-show-all () 662(defun hs-show-all ()
690 "Show all top-level blocks. 663 "Show everything then run `hs-show-hook'. See `run-hooks'."
691Point is unchanged; run the normal hook `hs-show-hook'.
692See documentation for `run-hooks'."
693 (interactive) 664 (interactive)
694 (hs-life-goes-on 665 (hs-life-goes-on
695 (message "Showing all blocks ...") 666 (message "Showing all blocks ...")
@@ -698,9 +669,7 @@ See documentation for `run-hooks'."
698 (run-hooks 'hs-show-hook))) 669 (run-hooks 'hs-show-hook)))
699 670
700(defun hs-hide-block (&optional end) 671(defun hs-hide-block (&optional end)
701 "Select a block and hide it. 672 "Select a block and hide it. With prefix arg, reposition at END.
702With prefix arg, reposition at end. Block is defined as a sexp for
703Lispish modes, mode-specific otherwise. Comments are blocks, too.
704Upon completion, point is repositioned and the normal hook 673Upon completion, point is repositioned and the normal hook
705`hs-hide-hook' is run. See documentation for `run-hooks'." 674`hs-hide-hook' is run. See documentation for `run-hooks'."
706 (interactive "P") 675 (interactive "P")
@@ -708,36 +677,60 @@ Upon completion, point is repositioned and the normal hook
708 (let ((c-reg (hs-inside-comment-p))) 677 (let ((c-reg (hs-inside-comment-p)))
709 (cond 678 (cond
710 ((and c-reg (or (null (nth 0 c-reg)) 679 ((and c-reg (or (null (nth 0 c-reg))
711 (<= (count-lines (car c-reg) (nth 1 c-reg)) 680 (<= (count-lines (car c-reg) (nth 1 c-reg)) 1)))
712 (if hs-show-hidden-short-form 1 2)))) 681 (message "(not enough comment lines to hide)"))
713 (message "Not enough comment lines to hide!")) 682 ((or c-reg
714 ((or c-reg (looking-at hs-block-start-regexp) 683 (looking-at hs-block-start-regexp)
715 (hs-find-block-beginning)) 684 (hs-find-block-beginning))
716 (hs-hide-block-at-point end c-reg) 685 (hs-hide-block-at-point end c-reg)
717 (hs-safety-is-job-n) 686 (hs-safety-is-job-n)
718 (run-hooks 'hs-hide-hook)))))) 687 (run-hooks 'hs-hide-hook))))))
719 688
720(defun hs-show-block (&optional end) 689(defun hs-show-block (&optional end)
721 "Select a block and show it. 690 "Select a block and show it.
722With prefix arg, reposition at end. Upon completion, point is 691With prefix arg, reposition at END. Upon completion, point is
723repositioned and the normal hook `hs-show-hook' is run. 692repositioned and the normal hook `hs-show-hook' is run.
724See documentation for `hs-hide-block' and `run-hooks'." 693See documentation for functions `hs-hide-block' and `run-hooks'."
725 (interactive "P") 694 (interactive "P")
726 (hs-life-goes-on 695 (hs-life-goes-on
727 (let ((c-reg (hs-inside-comment-p))) 696 (or
728 (if (or c-reg 697 ;; first see if we have something at the end of the line
729 (looking-at hs-block-start-regexp) 698 (catch 'eol-begins-hidden-region-p
730 (hs-find-block-beginning)) 699 (let ((here (point)))
731 (progn 700 (mapcar (lambda (ov)
732 (hs-show-block-at-point end c-reg) 701 (when (overlay-get ov 'hs)
733 (hs-safety-is-job-n) 702 (goto-char
734 (run-hooks 'hs-show-hook)))))) 703 (cond
704 (end (overlay-end ov))
705 ((eq 'comment (overlay-get ov 'hs)) here)
706 (t (+ (overlay-start ov) (overlay-get ov 'hs-ofs)))))
707 (delete-overlay ov)
708 (throw 'eol-begins-hidden-region-p t)))
709 (save-excursion (end-of-line) (overlays-at (point))))
710 nil))
711 ;; not immediately obvious, look for a suitable block
712 (let ((c-reg (hs-inside-comment-p))
713 p q)
714 (cond (c-reg
715 (when (car c-reg)
716 (setq p (car c-reg)
717 q (cadr c-reg))))
718 ((and (hs-find-block-beginning)
719 (looking-at hs-block-start-regexp)) ; fresh match-data, ugh
720 (setq p (point)
721 q (progn (hs-forward-sexp (hs-match-data t) 1) (point)))))
722 (when (and p q)
723 (hs-flag-region p q nil)
724 (goto-char (if end q (1+ p)))))
725 (hs-safety-is-job-n)
726 (run-hooks 'hs-show-hook))))
735 727
736(defun hs-show-region (beg end) 728(defun hs-show-region (beg end)
737 "Show all lines from BEG to END, without doing any block analysis. 729 "Show all lines from BEG to END, without doing any block analysis.
738Note: `hs-show-region' is intended for use when `hs-show-block' signals 730Note: `hs-show-region' is intended for use when `hs-show-block' signals
739\"unbalanced parentheses\" and so is an emergency measure only. You may 731\"unbalanced parentheses\" and so is an emergency measure only. You may
740become very confused if you use this command indiscriminately." 732become very confused if you use this command indiscriminately.
733The hook `hs-show-hook' is run; see `run-hooks'."
741 (interactive "r") 734 (interactive "r")
742 (hs-life-goes-on 735 (hs-life-goes-on
743 (hs-flag-region beg end nil) 736 (hs-flag-region beg end nil)
@@ -745,7 +738,8 @@ become very confused if you use this command indiscriminately."
745 (run-hooks 'hs-show-hook))) 738 (run-hooks 'hs-show-hook)))
746 739
747(defun hs-hide-level (arg) 740(defun hs-hide-level (arg)
748 "Hide all blocks ARG levels below this block." 741 "Hide all blocks ARG levels below this block.
742The hook `hs-hide-hook' is run; see `run-hooks'."
749 (interactive "p") 743 (interactive "p")
750 (hs-life-goes-on 744 (hs-life-goes-on
751 (save-excursion 745 (save-excursion
@@ -755,15 +749,32 @@ become very confused if you use this command indiscriminately."
755 (hs-safety-is-job-n) 749 (hs-safety-is-job-n)
756 (run-hooks 'hs-hide-hook))) 750 (run-hooks 'hs-hide-hook)))
757 751
758;;;###autoload
759(defun hs-mouse-toggle-hiding (e) 752(defun hs-mouse-toggle-hiding (e)
760 "Toggle hiding/showing of a block. 753 "Toggle hiding/showing of a block.
761Should be bound to a mouse key." 754This command should be bound to a mouse key.
755Argument E is a mouse event used by `mouse-set-point'.
756See `hs-hide-block' and `hs-show-block'."
762 (interactive "@e") 757 (interactive "@e")
763 (mouse-set-point e) 758 (hs-life-goes-on
764 (if (hs-already-hidden-p) 759 (mouse-set-point e)
765 (hs-show-block) 760 (if (hs-already-hidden-p)
766 (hs-hide-block))) 761 (hs-show-block)
762 (hs-hide-block))))
763
764(defun hs-hide-initial-comment-block ()
765 "Hide the first block of comments in a file.
766This can be useful if you have huge RCS logs in those comments."
767 (interactive)
768 (hs-life-goes-on
769 (let ((c-reg (save-excursion
770 (goto-char (point-min))
771 (skip-chars-forward " \t\n\f")
772 (hs-inside-comment-p))))
773 (when c-reg
774 (let ((beg (car c-reg)) (end (cadr c-reg)))
775 ;; see if we have enough comment lines to hide
776 (when (> (count-lines beg end) 1)
777 (hs-hide-comment-region beg end)))))))
767 778
768;;;###autoload 779;;;###autoload
769(defun hs-minor-mode (&optional arg) 780(defun hs-minor-mode (&optional arg)
@@ -772,12 +783,11 @@ With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
772When hideshow minor mode is on, the menu bar is augmented with hideshow 783When hideshow minor mode is on, the menu bar is augmented with hideshow
773commands and the hideshow commands are enabled. 784commands and the hideshow commands are enabled.
774The value '(hs . t) is added to `buffer-invisibility-spec'. 785The value '(hs . t) is added to `buffer-invisibility-spec'.
775Last, the normal hook `hs-minor-mode-hook' is run; see the doc 786Last, the normal hook `hs-minor-mode-hook' is run; see `run-hooks'.
776for `run-hooks'.
777 787
778The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block', 788The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block',
779`hs-show-block', `hs-hide-level' and `hs-show-region'. 789`hs-show-block', `hs-hide-level' and `hs-show-region'. There is also
780Also see the documentation for the variable `hs-show-hidden-short-form'. 790`hs-hide-initial-comment-block' and `hs-mouse-toggle-hiding'.
781 791
782Turning hideshow minor mode off reverts the menu bar and the 792Turning hideshow minor mode off reverts the menu bar and the
783variables to default values and disables the hideshow commands. 793variables to default values and disables the hideshow commands.
@@ -786,34 +796,23 @@ Key bindings:
786\\{hs-minor-mode-map}" 796\\{hs-minor-mode-map}"
787 797
788 (interactive "P") 798 (interactive "P")
789 (setq hs-minor-mode 799 (setq hs-headline nil
790 (if (null arg) 800 hs-minor-mode (if (null arg)
791 (not hs-minor-mode) 801 (not hs-minor-mode)
792 (> (prefix-numeric-value arg) 0))) 802 (> (prefix-numeric-value arg) 0)))
793 (if hs-minor-mode 803 (if hs-minor-mode
794 (progn 804 (progn
795; (if (eq hs-emacs-type 'lucid) 805 (easy-menu-add hs-minor-mode-menu)
796; (progn 806 (make-variable-buffer-local 'line-move-ignore-invisible)
797; (set-buffer-menubar (copy-sequence current-menubar)) 807 (setq line-move-ignore-invisible t)
798; (add-menu nil (car hs-menu-bar) (cdr hs-menu-bar)))) 808 (add-to-invisibility-spec '(hs . t)) ; hs invisible
799 (make-local-variable 'line-move-ignore-invisible) 809 (hs-grok-mode-type)
800 (setq line-move-ignore-invisible t) 810 (run-hooks 'hs-minor-mode-hook))
801 (add-to-invisibility-spec '(hs . t)) ;;hs invisible 811 (easy-menu-remove hs-minor-mode-menu)
802 (hs-grok-mode-type)
803 (run-hooks 'hs-minor-mode-hook))
804; (if (eq hs-emacs-type 'lucid)
805; (set-buffer-menubar (delete hs-menu-bar current-menubar)))
806 (remove-from-invisibility-spec '(hs . t)))) 812 (remove-from-invisibility-spec '(hs . t))))
807 813
808 814;;---------------------------------------------------------------------------
809;;;---------------------------------------------------------------------------- 815;; load-time actions
810;;; load-time setup routines
811
812;; which emacs being used?
813;(setq hs-emacs-type
814; (if (string-match "xemacs\\|lucid" emacs-version)
815; 'lucid
816; 'fsf))
817 816
818;; keymaps and menus 817;; keymaps and menus
819(if hs-minor-mode-map 818(if hs-minor-mode-map
@@ -823,22 +822,23 @@ Key bindings:
823 hs-minor-mode-map 822 hs-minor-mode-map
824 "Menu used when hideshow minor mode is active." 823 "Menu used when hideshow minor mode is active."
825 (cons "Hide/Show" 824 (cons "Hide/Show"
826 (mapcar 825 (mapcar
827 ;; populate keymap then massage entry for easymenu 826 ;; Interpret each table entry as follows: first, populate keymap
828 (lambda (ent) 827 ;; with elements 2 and 1; then, for easymenu, use entry directly
829 (define-key hs-minor-mode-map (aref ent 2) (aref ent 1)) 828 ;; unless element 0 is nil, in which case the entry is "omitted".
830 (aset ent 2 (not (vectorp (aref ent 2)))) ; disable mousy stuff 829 (lambda (ent)
831 ent) 830 (define-key hs-minor-mode-map (aref ent 2) (aref ent 1))
832 ;; I believe there is nothing bound on these keys 831 (if (aref ent 0) ent "-----"))
833 ;; menu entry command key 832 ;; I believe there is nothing bound on these keys.
834 '(["Hide Block" hs-hide-block "\C-ch"] 833 ;; menu entry command key
835 ["Show Block" hs-show-block "\C-cs"] 834 '(["Hide Block" hs-hide-block "\C-ch"]
836 ["Hide All" hs-hide-all "\C-cH"] 835 ["Show Block" hs-show-block "\C-cs"]
837 ["Show All" hs-show-all "\C-cS"] 836 ["Hide All" hs-hide-all "\C-cH"]
838 ["Hide Level" hs-hide-level "\C-cL"] 837 ["Show All" hs-show-all "\C-cS"]
839 ["Show Region" hs-show-region "\C-cR"] 838 ["Hide Level" hs-hide-level "\C-cL"]
840 ["Toggle Hiding" hs-mouse-toggle-hiding [S-mouse-2]] 839 ["Show Region" hs-show-region "\C-cR"]
841 ))))) 840 [nil hs-mouse-toggle-hiding [(shift button2)]]
841 )))))
842 842
843;; some housekeeping 843;; some housekeeping
844(or (assq 'hs-minor-mode minor-mode-map-alist) 844(or (assq 'hs-minor-mode minor-mode-map-alist)
@@ -851,17 +851,18 @@ Key bindings:
851 851
852;; make some variables permanently buffer-local 852;; make some variables permanently buffer-local
853(mapcar (lambda (var) 853(mapcar (lambda (var)
854 (make-variable-buffer-local var) 854 (make-variable-buffer-local var)
855 (put var 'permanent-local t)) 855 (put var 'permanent-local t))
856 '(hs-minor-mode 856 '(hs-minor-mode
857 hs-c-start-regexp 857 hs-c-start-regexp
858 hs-block-start-regexp 858 hs-block-start-regexp
859 hs-block-end-regexp 859 hs-block-start-mdata-select
860 hs-forward-sexp-func 860 hs-block-end-regexp
861 hs-adjust-block-beginning)) 861 hs-forward-sexp-func
862 862 hs-adjust-block-beginning))
863;;;---------------------------------------------------------------------------- 863
864;;; that's it 864;;---------------------------------------------------------------------------
865;; that's it
865 866
866(provide 'hideshow) 867(provide 'hideshow)
867 868
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-23 18:23:04 +0000