Mercurial > emacs
comparison lisp/progmodes/hideshow.el @ 22444:977318751daa
Require `easymenu'. Rework to use easymenu. Remove eol ws.
(hs-hide-level-recursive, hs-hide-level): Add.
(hs-unbalance-handler-method): Delete.
(hs-show-block-at-point): Always use `top-level' unbalanced-handler case.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Fri, 12 Jun 1998 05:32:48 +0000 |
parents | 3e53877b4a08 |
children | 49ed9656f1ed |
comparison
equal
deleted
inserted
replaced
22443:23e135b67081 | 22444:977318751daa |
---|---|
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, 1995, 1996, 1997 Free Software Foundation | 3 ;; Copyright (C) 1994, 95, 96, 97, 98 Free Software Foundation |
4 | 4 |
5 ;; Author: Thien-Thi Nguyen <ttn@netcom.com> | 5 ;; Author: Thien-Thi Nguyen <ttn@netcom.com> |
6 ;; Maintainer: Dan Nicolaescu <done@ece.arizona.edu> | 6 ;; Dan Nicolaescu <done@ece.arizona.edu> |
7 ;; Version: 4.0 | |
8 ;; 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.20 | |
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. |
12 | 12 |
13 ;; GNU Emacs is free software; you can redistribute it and/or modify | 13 ;; GNU Emacs is free software; you can redistribute it and/or modify |
23 ;; You should have received a copy of the GNU General Public License | 23 ;; You should have received a copy of the GNU General Public License |
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 24 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
26 ;; Boston, MA 02111-1307, USA. | 26 ;; Boston, MA 02111-1307, USA. |
27 | 27 |
28 ;; LCD Archive Entry: | |
29 ;; hideshow|Thien-Thi Nguyen|ttn@netcom.com| | |
30 ;; minor mode commands to selectively display blocks of code| | |
31 ;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z| | |
32 | |
33 ;;; Commentary: | 28 ;;; Commentary: |
34 | 29 |
35 ;; This file provides `hs-minor-mode'. When active, six commands: | 30 ;; - Commands provided |
36 ;; hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode | 31 ;; |
37 ;; are available. They implement block hiding and showing. Blocks are | 32 ;; This file provides `hs-minor-mode'. When active, seven commands: |
38 ;; defined in mode-specific way. In c-mode or c++-mode, they are simply | 33 ;; |
39 ;; curly braces, while in lisp-ish modes they are parens. Multi-line | 34 ;; hs-{hide,show}-{all,block}, hs-show-region, |
40 ;; comments (c-mode) can also be hidden. The command M-x hs-minor-mode | 35 ;; hs-hide-level and hs-minor-mode |
41 ;; toggles the minor mode or sets it (similar to outline minor mode). | 36 ;; |
42 ;; See documentation for each command for more info. | 37 ;; are available, implementing block hiding and showing. Blocks are |
43 ;; | 38 ;; defined per mode. In c-mode or c++-mode, they are simply curly braces, |
44 ;; The variable `hs-unbalance-handler-method' controls hideshow's behavior | 39 ;; while in Lisp-ish modes they are parens. Multi-line comments can also |
45 ;; in the case of "unbalanced parentheses". See doc for more info. | 40 ;; be hidden. The command `M-x hs-minor-mode' toggles the minor mode or |
46 | 41 ;; sets it (similar to outline minor mode). |
47 ;; Suggested usage: | 42 |
48 | 43 ;; - Customization |
44 ;; | |
45 ;; Variables control things thusly: | |
46 ;; | |
47 ;; hs-hide-comments-when-hiding-all -- self-explanatory! | |
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 ;; | |
55 ;; Hooks are run after some commands: | |
56 ;; | |
57 ;; 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 | |
59 ;; | |
60 ;; See docs for each variable or hook for more info. | |
61 | |
62 ;; - Suggested usage | |
63 ;; | |
49 ;; (load-library "hideshow") | 64 ;; (load-library "hideshow") |
50 ;; (add-hook 'X-mode-hook 'hs-minor-mode) ; other modes similarly | 65 ;; (add-hook 'X-mode-hook 'hs-minor-mode) ; other modes similarly |
51 ;; | 66 ;; |
52 ;; where X = {emacs-lisp,c,c++,perl,...}. See the doc for the variable | 67 ;; where X = {emacs-lisp,c,c++,perl,...}. See the doc for the variable |
53 ;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes. | 68 ;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes. |
54 | 69 |
55 ;; Etc: | 70 ;; - Bugs / caveats |
56 | 71 ;; |
57 ;; Bug reports and fixes welcome (comments, too). Thanks go to | 72 ;; 1. Hideshow does not work w/ emacs 18 because emacs 18 lacks the |
58 ;; Dean Andrews <adahome@ix.netcom.com> | 73 ;; function `forward-comment' (among other things). If someone writes |
59 ;; Preston F. Crow <preston.f.crow@dartmouth.edu> | 74 ;; this, please send me a copy. |
60 ;; Gael Marziou <gael@gnlab030.grenoble.hp.com> | 75 ;; |
61 ;; Keith Sheffield <sheff@edcsgw2.cr.usgs.gov> | 76 ;; 2. Users of cc-mode.el should not hook hideshow into |
62 ;; Jan Djarv <jan.djarv@sa.erisoft.se> | 77 ;; c-mode-common-hook since at that stage of the call sequence, the |
63 ;; Lars Lindberg <qhslali@aom.ericsson.se> | 78 ;; variables `comment-start' and `comment-end' are not yet provided. |
64 ;; Alf-Ivar Holm <alfh@ifi.uio.no> | 79 ;; Instead, use c-mode-hook and c++-mode-hook as suggested above. |
65 ;; for valuable feedback, code and bug reports. | 80 |
81 ;; - Thanks and feedback | |
82 ;; | |
83 ;; Thanks go to the following people for valuable ideas, code and bug | |
84 ;; 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 ;; | |
94 ;; Special thanks go to Dan Nicolaescu <done@ece.arizona.edu>, who | |
95 ;; reimplemented hideshow using overlays (rather than selective display), | |
96 ;; added isearch magic, folded in custom.el compatibility, generalized | |
97 ;; comment handling, incorporated mouse support, and maintained the code | |
98 ;; in general. Version 4.0 is largely due to his efforts. | |
99 ;; | |
100 ;; Correspondance welcome; please indicate version number. | |
66 | 101 |
67 ;;; Code: | 102 ;;; Code: |
68 | 103 |
104 (require 'easymenu) | |
69 | 105 |
70 ;;;---------------------------------------------------------------------------- | 106 ;;;---------------------------------------------------------------------------- |
71 ;;; user-configurable variables | 107 ;;; user-configurable variables |
72 | 108 |
73 (defgroup hideshow nil | 109 (defgroup hideshow nil |
74 "Minor mode for hiding and showing program and comment blocks." | 110 "Minor mode for hiding and showing program and comment blocks." |
75 :prefix "hs-" | 111 :prefix "hs-" |
76 :group 'languages) | 112 :group 'languages) |
77 | 113 |
78 ;;;###autoload | 114 ;;;###autoload |
79 (defcustom hs-hide-comments-when-hiding-all t | 115 (defcustom hs-hide-comments-when-hiding-all t |
80 "Hide the comments too when you do an `hs-hide-all'." | 116 "Hide the comments too when you do an `hs-hide-all'." |
81 :type 'boolean | 117 :type 'boolean |
82 :group 'hideshow) | 118 :group 'hideshow) |
83 | 119 |
84 ;;;###autoload | 120 ;;;###autoload |
85 (defcustom hs-show-hidden-short-form t | 121 (defcustom hs-show-hidden-short-form t |
86 "Leave only the first line visible in a hidden block. | 122 "Leave only the first line visible in a hidden block. |
87 If t only the first line is visible when a block is in the hidden state, | 123 If non-nil only the first line is visible when a block is in the |
88 else both the first line and the last line are showed. Also if t and | 124 hidden state, else both the first line and the last line are shown. |
89 `hs-adjust-block-beginning' is set, it is used also. | 125 A nil value disables `hs-adjust-block-beginning', which see. |
90 | 126 |
91 An example of how this works: (in c-mode) | 127 An example of how this works: (in C mode) |
92 original: | 128 original: |
93 | 129 |
94 /* My function main | 130 /* My function main |
95 some more stuff about main | 131 some more stuff about main |
96 */ | 132 */ |
97 int | 133 int |
98 main(void) | 134 main(void) |
99 { | 135 { |
100 int x=0; | 136 int x=0; |
101 return 0; | 137 return 0; |
102 } | 138 } |
103 | 139 |
104 | 140 |
105 hidden and hs-show-hidden-short-form is nil | 141 hidden and `hs-show-hidden-short-form' is nil |
106 /* My function main... | 142 /* My function main... |
107 */ | 143 */ |
108 int | 144 int |
109 main(void) | 145 main(void) |
110 {... | 146 {... |
111 } | 147 } |
112 | 148 |
113 hidden and hs-show-hidden-short-form is t | 149 hidden and `hs-show-hidden-short-form' is t |
114 /* My function main... | 150 /* My function main... |
115 int | 151 int |
116 main(void)... | 152 main(void)... |
117 | 153 |
118 For latest you have to be on the line containing the ellipsis when | 154 For the last case you have to be on the line containing the |
119 you do `hs-show-block'." | 155 ellipsis when you do `hs-show-block'." |
120 :type 'boolean | 156 :type 'boolean |
121 :group 'hideshow) | 157 :group 'hideshow) |
122 | 158 |
123 (defcustom hs-minor-mode-hook 'hs-hide-initial-comment-block | 159 (defcustom hs-minor-mode-hook 'hs-hide-initial-comment-block |
124 "Hook called when `hs-minor-mode' is installed. | 160 "Hook called when `hs-minor-mode' is installed. |
126 hide all the comments at the beginning of the file." | 162 hide all the comments at the beginning of the file." |
127 :type 'hook | 163 :type 'hook |
128 :group 'hideshow) | 164 :group 'hideshow) |
129 | 165 |
130 (defcustom hs-isearch-open 'block | 166 (defcustom hs-isearch-open 'block |
131 "What kind of hidden blocks to open when doing `isearch'. | 167 "What kind of hidden blocks to open when doing `isearch'. |
132 It can have the following values: | 168 One of the following values: |
133 `block' open only blocks | 169 |
134 `comment' open only comments | 170 block -- open only blocks |
135 t open all of them | 171 comment -- open only comments |
136 nil don't open any. | 172 t -- open both blocks and comments |
137 This only has effect iff `search-invisible' is set to `open'." | 173 nil -- open neither blocks nor comments |
138 :type '(choice (const :tag "open only blocks" block) | 174 |
175 This has effect iff `search-invisible' is set to `open'." | |
176 :type '(choice (const :tag "open only blocks" block) | |
139 (const :tag "open only comments" comment) | 177 (const :tag "open only comments" comment) |
140 (const :tag "open both blocks and comments" t) | 178 (const :tag "open both blocks and comments" t) |
141 (const :tag "don't open any of them" nil)) | 179 (const :tag "don't open any of them" nil)) |
142 :group 'hideshow) | 180 :group 'hideshow) |
143 | 181 |
144 (defvar hs-unbalance-handler-method 'top-level | |
145 "*Symbol representing how \"unbalanced parentheses\" should be handled. | |
146 This error is usually signaled by `hs-show-block'. One of four values: | |
147 `top-level', `next-line', `signal' or `ignore'. Default is `top-level'. | |
148 | |
149 - `top-level' -- Show top-level block containing the currently troublesome | |
150 block. | |
151 - `next-line' -- Use the fact that, for an already hidden block, its end | |
152 will be on the next line. Attempt to show this block. | |
153 - `signal' -- Pass the error through, stopping execution. | |
154 - `ignore' -- Ignore the error, continuing execution. | |
155 | |
156 Values other than these four will be interpreted as `signal'.") | |
157 | |
158 ;;;###autoload | 182 ;;;###autoload |
159 (defvar hs-special-modes-alist | 183 (defvar hs-special-modes-alist |
160 '((c-mode "{" "}" nil nil hs-c-like-adjust-block-beginning) | 184 '((c-mode "{" "}" nil nil hs-c-like-adjust-block-beginning) |
161 (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) | 185 (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) |
162 (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)) | 186 (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)) |
163 ; I tested the java regexp using the following: | 187 ; I tested the java regexp using the following: |
164 ;(defvar hsj-public) | 188 ;(defvar hsj-public) |
166 ;(defvar hsj-fname) | 190 ;(defvar hsj-fname) |
167 ;(defvar hsj-par) | 191 ;(defvar hsj-par) |
168 ;(defvar hsj-throws) | 192 ;(defvar hsj-throws) |
169 ;(defvar hsj-static) | 193 ;(defvar hsj-static) |
170 | 194 |
171 ;(setq hsj-public | 195 ;(setq hsj-public |
172 ; (concat "[ \t]*\\(" | 196 ; (concat "[ \t]*\\(" |
173 ; (regexp-opt '("public" "private" "protected" "abstract" | 197 ; (regexp-opt '("public" "private" "protected" "abstract" |
174 ; "synchronized" "static" "final" "native") 1) | 198 ; "synchronized" "static" "final" "native") 1) |
175 ; "[ \t\n]+\\)*")) | 199 ; "[ \t\n]+\\)*")) |
176 | 200 |
177 ;(setq hsj-type "[.a-zA-Z0-9_:]+[ \t\n]*\\(\\[[ \t\n]*\\][ \t\n]*\\)?") | 201 ;(setq hsj-type "[.a-zA-Z0-9_:]+[ \t\n]*\\(\\[[ \t\n]*\\][ \t\n]*\\)?") |
178 ;(setq hsj-fname "\\([a-zA-Z0-9_:]+[ \t\n]*\\)") | 202 ;(setq hsj-fname "\\([a-zA-Z0-9_:]+[ \t\n]*\\)") |
196 ; "\\(" | 220 ; "\\(" |
197 ; hsj-static | 221 ; hsj-static |
198 ; "\\)" | 222 ; "\\)" |
199 ; "\\)" | 223 ; "\\)" |
200 ; "[ \t\n]*{" | 224 ; "[ \t\n]*{" |
201 ; "\\)" | 225 ; "\\)" |
202 ; )) | 226 ; )) |
203 | 227 |
204 "*Alist for initializing the hideshow variables for different modes. | 228 "*Alist for initializing the hideshow variables for different modes. |
205 It has the form | 229 It has the form |
206 (MODE START-RE END-RE COMMENT-START-RE FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). | 230 (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). |
207 If present, hideshow will use these values for the start and end regexps, | 231 If present, hideshow will use these values as regexps for start, end |
208 respectively. Since Algol-ish languages do not have single-character | 232 and comment-start, respectively. Since Algol-ish languages do not have |
209 block delimiters, the function `forward-sexp' which is used by hideshow | 233 single-character block delimiters, the function `forward-sexp' used |
210 doesn't work. In this case, if a similar function is provided, you can | 234 by hideshow doesn't work. In this case, if a similar function is |
211 register it and have hideshow use it instead of `forward-sexp'. To add | 235 available, you can register it and have hideshow use it instead of |
212 more values, use | 236 `forward-sexp'. See the documentation for `hs-adjust-block-beginning' |
213 | 237 to see what is the use of ADJUST-BEG-FUNC. |
214 \t(pushnew '(new-mode st-re end-re function-name) | 238 |
215 \t hs-special-modes-alist :test 'equal) | 239 If any of those is left nil, hideshow will try to guess some values |
216 | 240 using function `hs-grok-mode-type'. |
217 For example: | |
218 | |
219 \t(pushnew '(simula-mode \"begin\" \"end\" \"!\" simula-next-statement) | |
220 \t hs-special-modes-alist :test 'equal) | |
221 | |
222 See the documentation for `hs-adjust-block-beginning' to see what | |
223 is the use of ADJUST-BEG-FUNC. | |
224 | |
225 If any of those is left nil, hideshow will try to guess some values, see | |
226 `hs-grok-mode-type' for this. | |
227 | 241 |
228 Note that the regexps should not contain leading or trailing whitespace.") | 242 Note that the regexps should not contain leading or trailing whitespace.") |
229 | 243 |
230 (defvar hs-hide-hook nil | 244 (defvar hs-hide-hook nil |
231 "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.") | 245 "*Hooks called at the end of commands to hide text. |
246 These commands include `hs-hide-all', `hs-hide-block' and `hs-hide-level'.") | |
232 | 247 |
233 (defvar hs-show-hook nil | 248 (defvar hs-show-hook nil |
234 "*Hooks called at the end of commands to show text. | 249 "*Hooks called at the end of commands to show text. |
235 These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.") | 250 These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.") |
236 | 251 |
249 | 264 |
250 ;(defvar hs-menu-bar nil | 265 ;(defvar hs-menu-bar nil |
251 ; "Menu bar for hideshow minor mode (Xemacs only).") | 266 ; "Menu bar for hideshow minor mode (Xemacs only).") |
252 | 267 |
253 (defvar hs-c-start-regexp nil | 268 (defvar hs-c-start-regexp nil |
254 "Regexp for beginning of comments. | 269 "Regexp for beginning of comments. |
255 Differs from mode-specific comment regexps in that | 270 Differs from mode-specific comment regexps in that |
256 surrounding whitespace is stripped.") | 271 surrounding whitespace is stripped.") |
257 | 272 |
258 (defvar hs-block-start-regexp nil | 273 (defvar hs-block-start-regexp nil |
259 "Regexp for beginning of block.") | 274 "Regexp for beginning of block.") |
260 | 275 |
261 (defvar hs-block-end-regexp nil | 276 (defvar hs-block-end-regexp nil |
262 "Regexp for end of block.") | 277 "Regexp for end of block.") |
263 | 278 |
264 (defvar hs-forward-sexp-func 'forward-sexp | 279 (defvar hs-forward-sexp-func 'forward-sexp |
265 "Function used to do a forward-sexp. | 280 "Function used to do a `forward-sexp'. |
266 Should change for Algol-ish modes. For single-character block | 281 Should change for Algol-ish modes. For single-character block |
267 delimiters -- ie, the syntax table regexp for the character is | 282 delimiters -- ie, the syntax table regexp for the character is |
268 either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'. | 283 either `(' or `)' -- `hs-forward-sexp-func' would just be |
269 For other modes such as simula, a more specialized function | 284 `forward-sexp'. For other modes such as simula, a more specialized |
270 is necessary.") | 285 function is necessary.") |
271 | 286 |
272 (defvar hs-adjust-block-beginning nil | 287 (defvar hs-adjust-block-beginning nil |
273 "Function used to tweak the block beginning. | 288 "Function used to tweak the block beginning. |
274 It has effect only if `hs-show-hidden-short-form' is t. The block it | 289 It has effect only if `hs-show-hidden-short-form' is non-nil. |
275 is hidden from the point returned by this function, as opposed to | 290 The block it is hidden from the point returned by this function, |
276 hiding it from the point returned when searching | 291 as opposed to hiding it from the point returned when searching |
277 `hs-block-start-regexp'. In c-like modes, if we wish to also hide the | 292 `hs-block-start-regexp'. In c-like modes, if we wish to also hide the |
278 curly braces (if you think they occupy too much space on the screen), | 293 curly braces (if you think they occupy too much space on the screen), |
279 this function should return the starting point (at the end of line) of | 294 this function should return the starting point (at the end of line) of |
280 the hidden region. | 295 the hidden region. |
281 | 296 |
282 It is called with a single argument ARG which is the the position in | 297 It is called with a single argument ARG which is the the position in |
283 buffer after the block beginning. | 298 buffer after the block beginning. |
284 | 299 |
285 It should return the position from where we should start hiding. | 300 It should return the position from where we should start hiding. |
286 | 301 |
287 It should not move the point. | 302 It should not move the point. |
288 | 303 |
289 See `hs-c-like-adjust-block-beginning' for an example of using this.") | 304 See `hs-c-like-adjust-block-beginning' for an example of using this.") |
290 | 305 |
291 ;(defvar hs-emacs-type 'fsf | 306 ;(defvar hs-emacs-type 'fsf |
292 ; "Used to support both Emacs and Xemacs.") | 307 ; "Used to support both Emacs and Xemacs.") |
301 ;;;---------------------------------------------------------------------------- | 316 ;;;---------------------------------------------------------------------------- |
302 ;;; support funcs | 317 ;;; support funcs |
303 | 318 |
304 ;; snarfed from outline.el; | 319 ;; snarfed from outline.el; |
305 (defun hs-flag-region (from to flag) | 320 (defun hs-flag-region (from to flag) |
306 "Hides or shows lines from FROM to TO, according to FLAG. If FLAG | 321 "Hide or show lines from FROM to TO, according to FLAG. |
307 is nil then text is shown, while if FLAG is non-nil the text is | 322 If FLAG is nil then text is shown, while if FLAG is non-nil the text |
308 hidden. Actualy flag is realy either `comment' or `block' depending on | 323 is hidden. Actually flag is really either `comment' or `block' |
309 what kind of block it is suppose to hide." | 324 depending on what kind of block it is suppose to hide." |
310 (save-excursion | 325 (save-excursion |
311 (goto-char from) | 326 (goto-char from) |
312 (end-of-line) | 327 (end-of-line) |
313 (hs-discard-overlays (point) to 'invisible 'hs) | 328 (hs-discard-overlays (point) to 'invisible 'hs) |
314 (if flag | 329 (if flag |
315 (let ((overlay (make-overlay (point) to))) | 330 (let ((overlay (make-overlay (point) to))) |
316 ;; Make overlay hidden and intangible. | 331 ;; Make overlay hidden and intangible. |
317 (overlay-put overlay 'invisible 'hs) | 332 (overlay-put overlay 'invisible 'hs) |
318 (overlay-put overlay 'hs t) | 333 (overlay-put overlay 'hs t) |
319 (when (or (eq hs-isearch-open t) (eq hs-isearch-open flag)) | 334 (when (or (eq hs-isearch-open t) (eq hs-isearch-open flag)) |
320 (overlay-put overlay 'isearch-open-invisible | 335 (overlay-put overlay 'isearch-open-invisible |
321 'hs-isearch-open-invisible)) | 336 'hs-isearch-open-invisible)) |
322 (overlay-put overlay 'intangible t))))) | 337 (overlay-put overlay 'intangible t))))) |
323 | 338 |
324 ;; This is set as an `isearch-open-invisible' property to hidden | 339 ;; This is set as an `isearch-open-invisible' property to hidden |
325 ;; overlays. | 340 ;; overlays. |
343 (if (eq (overlay-get o prop) value) | 358 (if (eq (overlay-get o prop) value) |
344 (delete-overlay o)) | 359 (delete-overlay o)) |
345 (setq overlays (cdr overlays)))))) | 360 (setq overlays (cdr overlays)))))) |
346 | 361 |
347 (defun hs-hide-block-at-point (&optional end comment-reg) | 362 (defun hs-hide-block-at-point (&optional end comment-reg) |
348 "Hide block iff on block beginning, optional END means reposition at end. | 363 "Hide block iff on block beginning. |
349 COMMENT-REG is a list of the form (BEGIN . END) and specifies the limits | 364 Optional arg END means reposition at end. |
350 of the comment, or nil if the block is not a comment." | 365 Optional arg COMMENT-REG is a list of the form (BEGIN . END) and |
366 specifies the limits of the comment, or nil if the block is not | |
367 a comment." | |
351 (if comment-reg | 368 (if comment-reg |
352 (progn | 369 (progn |
353 ;; goto the end of line at the end of the comment | 370 ;; goto the end of line at the end of the comment |
354 (goto-char (nth 1 comment-reg)) | 371 (goto-char (nth 1 comment-reg)) |
355 (unless hs-show-hidden-short-form (forward-line -1)) | 372 (unless hs-show-hidden-short-form (forward-line -1)) |
356 (end-of-line) | 373 (end-of-line) |
357 (hs-flag-region (car comment-reg) (point) 'comment) | 374 (hs-flag-region (car comment-reg) (point) 'comment) |
358 (goto-char (if end (nth 1 comment-reg) (car comment-reg)))) | 375 (goto-char (if end (nth 1 comment-reg) (car comment-reg)))) |
359 (if (looking-at hs-block-start-regexp) | 376 (if (looking-at hs-block-start-regexp) |
360 (let* ((p ;; p is the point at the end of the block beginning | 377 (let* ((p ;; p is the point at the end of the block beginning |
361 (if (and hs-show-hidden-short-form | 378 (if (and hs-show-hidden-short-form |
362 hs-adjust-block-beginning) | 379 hs-adjust-block-beginning) |
363 ;; we need to adjust the block beginning | 380 ;; we need to adjust the block beginning |
364 (funcall hs-adjust-block-beginning (match-end 0)) | 381 (funcall hs-adjust-block-beginning (match-end 0)) |
365 (match-end 0))) | 382 (match-end 0))) |
366 ;; q is the point at the end of the block | 383 ;; q is the point at the end of the block |
367 (q (progn (funcall hs-forward-sexp-func 1) (point)))) | 384 (q (progn (funcall hs-forward-sexp-func 1) (point)))) |
368 ;; position the point so we can call `hs-flag-region' | 385 ;; position the point so we can call `hs-flag-region' |
369 (unless hs-show-hidden-short-form (forward-line -1)) | 386 (unless hs-show-hidden-short-form (forward-line -1)) |
370 (end-of-line) | 387 (end-of-line) |
371 (if (and (< p (point)) (> (count-lines p q) | 388 (if (and (< p (point)) (> (count-lines p q) |
372 (if hs-show-hidden-short-form 1 2))) | 389 (if hs-show-hidden-short-form 1 2))) |
373 (hs-flag-region p (point) 'block)) | 390 (hs-flag-region p (point) 'block)) |
374 (goto-char (if end q p)))))) | 391 (goto-char (if end q p)))))) |
375 | 392 |
376 (defun hs-show-block-at-point (&optional end comment-reg) | 393 (defun hs-show-block-at-point (&optional end comment-reg) |
377 "Show block iff on block beginning. Optional END means reposition at end. | 394 "Show block iff on block beginning. |
378 COMMENT-REG is a list of the forme (BEGIN . END) and specifies the limits | 395 Optional arg END means reposition at end. |
379 of the comment. It should be nil when hiding a block." | 396 Optional arg COMMENT-REG is a list of the forme (BEGIN . END) and |
397 specifies the limits of the comment. It should be nil when hiding | |
398 a block." | |
380 (if comment-reg | 399 (if comment-reg |
381 (when (car comment-reg) | 400 (when (car comment-reg) |
382 (hs-flag-region (car comment-reg) (nth 1 comment-reg) nil) | 401 (hs-flag-region (car comment-reg) (nth 1 comment-reg) nil) |
383 (goto-char (if end (nth 1 comment-reg) (car comment-reg)))) | 402 (goto-char (if end (nth 1 comment-reg) (car comment-reg)))) |
384 (if (looking-at hs-block-start-regexp) | 403 (if (looking-at hs-block-start-regexp) |
387 (condition-case error ; probably unbalanced paren | 406 (condition-case error ; probably unbalanced paren |
388 (progn | 407 (progn |
389 (funcall hs-forward-sexp-func 1) | 408 (funcall hs-forward-sexp-func 1) |
390 (point)) | 409 (point)) |
391 (error | 410 (error |
392 (cond | 411 ;; try to get out of rat's nest and expose the whole func |
393 ((eq hs-unbalance-handler-method 'ignore) | 412 (if (/= (current-column) 0) (beginning-of-defun)) |
394 ;; just ignore this block | 413 (setq p (point)) |
395 (point)) | 414 (re-search-forward (concat "^" hs-block-start-regexp) |
396 ((eq hs-unbalance-handler-method 'top-level) | 415 (point-max) t 2) |
397 ;; try to get out of rat's nest and expose the whole func | 416 (point))))) |
398 (if (/= (current-column) 0) (beginning-of-defun)) | |
399 (setq p (point)) | |
400 (re-search-forward (concat "^" hs-block-start-regexp) | |
401 (point-max) t 2) | |
402 (point)) | |
403 ((eq hs-unbalance-handler-method 'next-line) | |
404 ;; assumption is that user knows what s/he's doing | |
405 (beginning-of-line) (setq p (point)) | |
406 (end-of-line 2) (point)) | |
407 (t | |
408 ;; pass error through -- this applies to `signal', too | |
409 (signal (car error) (cdr error)))))))) | |
410 (hs-flag-region p q nil) | 417 (hs-flag-region p q nil) |
411 (goto-char (if end (1+ (point)) p)))))) | 418 (goto-char (if end (1+ (point)) p)))))) |
412 | 419 |
413 (defun hs-safety-is-job-n () | 420 (defun hs-safety-is-job-n () |
414 "Warn `buffer-invisibility-spec' does not contain hs." | 421 "Warn if `buffer-invisibility-spec' does not contain hs." |
415 (if (or buffer-invisibility-spec (assq 'hs buffer-invisibility-spec) ) | 422 (if (or buffer-invisibility-spec (assq 'hs buffer-invisibility-spec) ) |
416 nil | 423 nil |
417 (message "Warning: `buffer-invisibility-spec' does not contain hs!!") | 424 (message "Warning: `buffer-invisibility-spec' does not contain hs!!") |
418 (sit-for 2))) | 425 (sit-for 2))) |
419 | 426 |
420 (defun hs-hide-initial-comment-block () | 427 (defun hs-hide-initial-comment-block () |
421 (interactive) | 428 (interactive) |
422 "Hides the first block of comments in a file. | 429 "Hide the first block of comments in a file. |
423 The best usage is in `hs-minor-mode-hook', it hides all the comments at the | 430 This is useful when a part of `hs-minor-mode-hook', especially with |
424 file beginning, so if you have huge RCS logs you won't see them!" | 431 huge header-comment RCS logs." |
425 (let ((p (point)) | 432 (let ((p (point)) |
426 c-reg) | 433 c-reg) |
427 (goto-char (point-min)) | 434 (goto-char (point-min)) |
428 (skip-chars-forward " \t\n^L") | 435 (skip-chars-forward " \t\n^L") |
429 (setq c-reg (hs-inside-comment-p)) | 436 (setq c-reg (hs-inside-comment-p)) |
430 ;; see if we have enough comment lines to hide | 437 ;; see if we have enough comment lines to hide |
431 (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg)) | 438 (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg)) |
432 (if hs-show-hidden-short-form 1 2))) | 439 (if hs-show-hidden-short-form 1 2))) |
433 (hs-hide-block) | 440 (hs-hide-block) |
434 (goto-char p)))) | 441 (goto-char p)))) |
435 | 442 |
436 (defun hs-inside-comment-p () | 443 (defun hs-inside-comment-p () |
437 "Returns non-nil if point is inside a comment, otherwise nil. | 444 "Return non-nil if point is inside a comment, otherwise nil. |
438 Actually, returns a list containing the buffer position of the start | 445 Actually, returns a list containing the buffer position of the start |
439 and the end of the comment. A comment block can be hided only if on its | 446 and the end of the comment. A comment block can be hidden only if on |
440 starting line there are only white spaces preceding the actual comment | 447 its starting line there is only whitespace preceding the actual comment |
441 beginning, if we are inside of a comment but this condition is not | 448 beginning. If we are inside of a comment but this condition is not met, |
442 we return a list having a nil as its car and the end of comment position | 449 we return a list having a nil as its car and the end of comment position |
443 as cdr." | 450 as cdr." |
444 (save-excursion | 451 (save-excursion |
445 ;; the idea is to look backwards for a comment start regexp, do a | 452 ;; the idea is to look backwards for a comment start regexp, do a |
446 ;; forward comment, and see if we are inside, then extend extend | 453 ;; forward comment, and see if we are inside, then extend extend |
447 ;; forward and backward as long as we have comments | 454 ;; forward and backward as long as we have comments |
448 (let ((q (point))) | 455 (let ((q (point))) |
449 (when (or (looking-at hs-c-start-regexp) | 456 (when (or (looking-at hs-c-start-regexp) |
458 ;; (defun bar () | 465 ;; (defun bar () |
459 ;; (foo) | 466 ;; (foo) |
460 ;; ) ; comment | 467 ;; ) ; comment |
461 ;; ^ | 468 ;; ^ |
462 ;; the point was here before doing (beginning-of-line) | 469 ;; the point was here before doing (beginning-of-line) |
463 ;; here we should advance till the next comment which | 470 ;; here we should advance till the next comment which |
464 ;; eventually has only white spaces preceding it on the same | 471 ;; eventually has only white spaces preceding it on the same |
465 ;; line | 472 ;; line |
466 (goto-char p) | 473 (goto-char p) |
467 (forward-comment 1) | 474 (forward-comment 1) |
468 (skip-chars-forward " \t\n") | 475 (skip-chars-forward " \t\n") |
469 (setq p (point)) | 476 (setq p (point)) |
470 (while (and (< (point) q) | 477 (while (and (< (point) q) |
471 (> (point) p) | 478 (> (point) p) |
472 (not (looking-at hs-c-start-regexp))) | 479 (not (looking-at hs-c-start-regexp))) |
473 (setq p (point)) ;; use this to avoid an infinit cycle. | 480 (setq p (point)) ;; use this to avoid an infinit cycle. |
474 (forward-comment 1) | 481 (forward-comment 1) |
475 (skip-chars-forward " \t\n")) | 482 (skip-chars-forward " \t\n")) |
476 (if (or (not (looking-at hs-c-start-regexp)) | 483 (if (or (not (looking-at hs-c-start-regexp)) |
477 (> (point) q)) | 484 (> (point) q)) |
478 ;; we cannot hide this comment block | 485 ;; we cannot hide this comment block |
479 (setq not-hidable t))) | 486 (setq not-hidable t))) |
480 ;; goto the end of the comment | 487 ;; goto the end of the comment |
481 (forward-comment (buffer-size)) | 488 (forward-comment (buffer-size)) |
483 (end-of-line) | 490 (end-of-line) |
484 (if (>= (point) q) | 491 (if (>= (point) q) |
485 (list (if not-hidable nil p) (point)))))))) | 492 (list (if not-hidable nil p) (point)))))))) |
486 | 493 |
487 (defun hs-grok-mode-type () | 494 (defun hs-grok-mode-type () |
488 "Setup variables for new buffers where applicable." | 495 "Set up hideshow variables for new buffers. |
496 If `hs-special-modes-alist' has information associated with the | |
497 current buffer's major mode, use that. | |
498 Otherwise, guess start, end and comment-start regexps; forward-sexp | |
499 function; and adjust-block-beginning function." | |
489 (when (and (boundp 'comment-start) | 500 (when (and (boundp 'comment-start) |
490 (boundp 'comment-end)) | 501 (boundp 'comment-end)) |
491 (let ((lookup (assoc major-mode hs-special-modes-alist))) | 502 (let ((lookup (assoc major-mode hs-special-modes-alist))) |
492 (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(") | 503 (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(") |
493 hs-block-end-regexp (or (nth 2 lookup) "\\s\)") | 504 hs-block-end-regexp (or (nth 2 lookup) "\\s\)") |
494 hs-c-start-regexp (or (nth 3 lookup) | 505 hs-c-start-regexp (or (nth 3 lookup) |
495 (let ((c-start-regexp | 506 (let ((c-start-regexp |
496 (regexp-quote comment-start))) | 507 (regexp-quote comment-start))) |
497 (if (string-match " +$" c-start-regexp) | 508 (if (string-match " +$" c-start-regexp) |
498 (substring c-start-regexp 0 (1- (match-end 0))) | 509 (substring c-start-regexp 0 (1- (match-end 0))) |
499 c-start-regexp))) | 510 c-start-regexp))) |
500 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp) | 511 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp) |
501 hs-adjust-block-beginning (nth 5 lookup))))) | 512 hs-adjust-block-beginning (nth 5 lookup))))) |
502 | 513 |
503 (defun hs-find-block-beginning () | 514 (defun hs-find-block-beginning () |
504 "Repositions point at block-start. | 515 "Reposition point at block-start. |
505 Return point, or nil if top-level." | 516 Return point, or nil if top-level." |
506 (let (done | 517 (let (done |
507 (try-again t) | 518 (try-again t) |
508 (here (point)) | 519 (here (point)) |
509 (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\(" | 520 (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\(" |
516 ;; backwards for the block beginning, or a block end. | 527 ;; backwards for the block beginning, or a block end. |
517 (while try-again | 528 (while try-again |
518 (setq try-again nil) | 529 (setq try-again nil) |
519 (if (and (re-search-backward both-regexps (point-min) t) | 530 (if (and (re-search-backward both-regexps (point-min) t) |
520 (match-beginning 1)) ; found a block beginning | 531 (match-beginning 1)) ; found a block beginning |
521 (if (save-match-data (hs-inside-comment-p)) | 532 (if (save-match-data (hs-inside-comment-p)) |
522 ;;but it was inside a comment, so we have to look for | 533 ;;but it was inside a comment, so we have to look for |
523 ;;it again | 534 ;;it again |
524 (setq try-again t) | 535 (setq try-again t) |
525 ;; that's what we were looking for | 536 ;; that's what we were looking for |
526 (setq done (match-beginning 0))) | 537 (setq done (match-beginning 0))) |
527 ;; we found a block end, or we reached the beginning of the | 538 ;; we found a block end, or we reached the beginning of the |
528 ;; buffer look to see if we were on a block beginning when we | 539 ;; buffer look to see if we were on a block beginning when we |
529 ;; started | 540 ;; started |
530 (if (and | 541 (if (and |
531 (re-search-forward hs-block-start-regexp (point-max) t) | 542 (re-search-forward hs-block-start-regexp (point-max) t) |
532 (or | 543 (or |
533 (and (>= here (match-beginning 0)) (< here (match-end 0))) | 544 (and (>= here (match-beginning 0)) (< here (match-end 0))) |
534 (and hs-show-hidden-short-form hs-adjust-block-beginning | 545 (and hs-show-hidden-short-form hs-adjust-block-beginning |
535 (save-match-data | 546 (save-match-data |
536 (= 1 (count-lines | 547 (= 1 (count-lines |
537 (funcall hs-adjust-block-beginning | 548 (funcall hs-adjust-block-beginning |
538 (match-end 0)) here)))))) | 549 (match-end 0)) here)))))) |
539 (setq done (match-beginning 0))))) | 550 (setq done (match-beginning 0))))) |
540 (goto-char here) | 551 (goto-char here) |
541 (while (and (not done) | 552 (while (and (not done) |
551 (goto-char (match-end 0)) ; end of end-regexp | 562 (goto-char (match-end 0)) ; end of end-regexp |
552 (funcall hs-forward-sexp-func -1))) | 563 (funcall hs-forward-sexp-func -1))) |
553 (goto-char (or done here)) | 564 (goto-char (or done here)) |
554 done)) | 565 done)) |
555 | 566 |
567 (defun hs-hide-level-recursive (arg minp maxp) | |
568 "Hide blocks ARG levels below this block recursively." | |
569 (when (hs-find-block-beginning) | |
570 (setq minp (1+ (point))) | |
571 (forward-sexp) | |
572 (setq maxp (1- (point)))) | |
573 (hs-flag-region minp maxp ?\n) ; eliminate weirdness | |
574 (goto-char minp) | |
575 (while (progn | |
576 (forward-comment (buffer-size)) | |
577 (re-search-forward hs-block-start-regexp maxp t)) | |
578 (if (> arg 1) | |
579 (hs-hide-level-recursive (1- arg) minp maxp) | |
580 (goto-char (match-beginning 0)) | |
581 (hs-hide-block-at-point t))) | |
582 (hs-safety-is-job-n) | |
583 (goto-char maxp)) | |
584 | |
556 (defmacro hs-life-goes-on (&rest body) | 585 (defmacro hs-life-goes-on (&rest body) |
557 "Executes optional BODY iff variable `hs-minor-mode' is non-nil." | 586 "Execute optional BODY iff variable `hs-minor-mode' is non-nil." |
558 `(let ((inhibit-point-motion-hooks t)) | 587 `(let ((inhibit-point-motion-hooks t)) |
559 (when hs-minor-mode | 588 (when hs-minor-mode |
560 ,@body))) | 589 ,@body))) |
561 | |
562 | 590 |
563 (put 'hs-life-goes-on 'edebug-form-spec '(&rest form)) | 591 (put 'hs-life-goes-on 'edebug-form-spec '(&rest form)) |
564 | 592 |
565 (defun hs-already-hidden-p () | 593 (defun hs-already-hidden-p () |
566 "Return non-nil if point is in an already-hidden block, otherwise nil." | 594 "Return non-nil if point is in an already-hidden block, otherwise nil." |
591 (forward-char -1) | 619 (forward-char -1) |
592 (forward-sexp 1)) | 620 (forward-sexp 1)) |
593 (forward-sexp 1)))) | 621 (forward-sexp 1)))) |
594 | 622 |
595 (defun hs-c-like-adjust-block-beginning (arg) | 623 (defun hs-c-like-adjust-block-beginning (arg) |
596 "Function to be assigned to `hs-adjust-block-beginning' for C like modes. | 624 "Function to be assigned to `hs-adjust-block-beginning' for C-like modes. |
597 Arg is a position in buffer just after {. This goes back to the end of | 625 Arg is a position in buffer just after {. This goes back to the end of |
598 the function header. The purpose is to save some space on the screen | 626 the function header. The purpose is to save some space on the screen |
599 when displaying hidden blocks." | 627 when displaying hidden blocks." |
600 (save-excursion | 628 (save-excursion |
601 (goto-char arg) | 629 (goto-char arg) |
602 (forward-char -1) | 630 (forward-char -1) |
603 (forward-comment (- (buffer-size))) | 631 (forward-comment (- (buffer-size))) |
606 ;;;---------------------------------------------------------------------------- | 634 ;;;---------------------------------------------------------------------------- |
607 ;;; commands | 635 ;;; commands |
608 | 636 |
609 ;;;###autoload | 637 ;;;###autoload |
610 (defun hs-hide-all () | 638 (defun hs-hide-all () |
611 "Hides all top-level blocks, displaying only first and last lines. | 639 "Hide all top-level blocks, displaying only first and last lines. |
612 It moves point to the beginning of the line, and it runs the normal hook | 640 Move point to the beginning of the line, and it run the normal hook |
613 `hs-hide-hook'. See documentation for `run-hooks'. | 641 `hs-hide-hook'. See documentation for `run-hooks'. |
614 If `hs-hide-comments-when-hiding-all' is t also hides the comments." | 642 If `hs-hide-comments-when-hiding-all' is t, also hide the comments." |
615 (interactive) | 643 (interactive) |
616 (hs-life-goes-on | 644 (hs-life-goes-on |
617 (message "Hiding all blocks ...") | 645 (message "Hiding all blocks ...") |
618 (save-excursion | 646 (save-excursion |
619 (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness | 647 (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness |
620 (goto-char (point-min)) | 648 (goto-char (point-min)) |
621 (if hs-hide-comments-when-hiding-all | 649 (if hs-hide-comments-when-hiding-all |
622 (let (c-reg | 650 (let (c-reg |
623 (count 0) | 651 (count 0) |
624 (block-and-comment-re ;; this should match | 652 (block-and-comment-re ;; this should match |
625 (concat "\\(^" ;; the block beginning and comment start | 653 (concat "\\(^" ;; the block beginning and comment start |
626 hs-block-start-regexp | 654 hs-block-start-regexp |
627 "\\)\\|\\(" hs-c-start-regexp "\\)"))) | 655 "\\)\\|\\(" hs-c-start-regexp "\\)"))) |
628 (while (re-search-forward block-and-comment-re (point-max) t) | 656 (while (re-search-forward block-and-comment-re (point-max) t) |
629 (if (match-beginning 1) ;; we have found a block beginning | 657 (if (match-beginning 1) ;; we have found a block beginning |
630 (progn | 658 (progn |
631 (goto-char (match-beginning 1)) | 659 (goto-char (match-beginning 1)) |
632 (hs-hide-block-at-point t) | 660 (hs-hide-block-at-point t) |
633 (message "Hiding ... %d" (setq count (1+ count)))) | 661 (message "Hiding ... %d" (setq count (1+ count)))) |
634 ;;found a comment | 662 ;;found a comment |
635 (setq c-reg (hs-inside-comment-p)) | 663 (setq c-reg (hs-inside-comment-p)) |
636 (if (and c-reg (car c-reg)) | 664 (if (and c-reg (car c-reg)) |
637 (if (> (count-lines (car c-reg) (nth 1 c-reg)) | 665 (if (> (count-lines (car c-reg) (nth 1 c-reg)) |
638 (if hs-show-hidden-short-form 1 2)) | 666 (if hs-show-hidden-short-form 1 2)) |
639 (progn | 667 (progn |
640 (hs-hide-block-at-point t c-reg) | 668 (hs-hide-block-at-point t c-reg) |
641 (message "Hiding ... %d" (setq count (1+ count)))) | 669 (message "Hiding ... %d" (setq count (1+ count)))) |
642 (goto-char (nth 1 c-reg))))))) | 670 (goto-char (nth 1 c-reg))))))) |
643 (let ((count 0) | 671 (let ((count 0) |
644 (top-level-re (concat "^" hs-block-start-regexp)) | 672 (top-level-re (concat "^" hs-block-start-regexp)) |
645 (buf-size (buffer-size))) | 673 (buf-size (buffer-size))) |
646 (while | 674 (while |
647 (progn | 675 (progn |
648 (forward-comment buf-size) | 676 (forward-comment buf-size) |
649 (re-search-forward top-level-re (point-max) t)) | 677 (re-search-forward top-level-re (point-max) t)) |
650 (goto-char (match-beginning 0)) | 678 (goto-char (match-beginning 0)) |
651 (hs-hide-block-at-point t) | 679 (hs-hide-block-at-point t) |
654 (beginning-of-line) | 682 (beginning-of-line) |
655 (message "Hiding all blocks ... done") | 683 (message "Hiding all blocks ... done") |
656 (run-hooks 'hs-hide-hook))) | 684 (run-hooks 'hs-hide-hook))) |
657 | 685 |
658 (defun hs-show-all () | 686 (defun hs-show-all () |
659 "Shows all top-level blocks. | 687 "Show all top-level blocks. |
660 This does not change point; it runs the normal hook `hs-show-hook'. | 688 Point is unchanged; run the normal hook `hs-show-hook'. |
661 See documentation for `run-hooks'." | 689 See documentation for `run-hooks'." |
662 (interactive) | 690 (interactive) |
663 (hs-life-goes-on | 691 (hs-life-goes-on |
664 (message "Showing all blocks ...") | 692 (message "Showing all blocks ...") |
665 (hs-flag-region (point-min) (point-max) nil) | 693 (hs-flag-region (point-min) (point-max) nil) |
666 (message "Showing all blocks ... done") | 694 (message "Showing all blocks ... done") |
667 (run-hooks 'hs-show-hook))) | 695 (run-hooks 'hs-show-hook))) |
668 | 696 |
669 (defun hs-hide-block (&optional end) | 697 (defun hs-hide-block (&optional end) |
670 "Selects a block and hides it. | 698 "Select a block and hide it. |
671 With prefix arg, reposition at end. Block is defined as a sexp for | 699 With prefix arg, reposition at end. Block is defined as a sexp for |
672 lispish modes, mode-specific otherwise. Comments are blocks, too. | 700 Lispish modes, mode-specific otherwise. Comments are blocks, too. |
673 Upon completion, point is at repositioned and the normal hook | 701 Upon completion, point is repositioned and the normal hook |
674 `hs-hide-hook' is run. See documentation for `run-hooks'." | 702 `hs-hide-hook' is run. See documentation for `run-hooks'." |
675 (interactive "P") | 703 (interactive "P") |
676 (hs-life-goes-on | 704 (hs-life-goes-on |
677 (let ((c-reg (hs-inside-comment-p))) | 705 (let ((c-reg (hs-inside-comment-p))) |
678 (cond | 706 (cond |
679 ((and c-reg (or (null (nth 0 c-reg)) | 707 ((and c-reg (or (null (nth 0 c-reg)) |
680 (<= (count-lines (car c-reg) (nth 1 c-reg)) | 708 (<= (count-lines (car c-reg) (nth 1 c-reg)) |
681 (if hs-show-hidden-short-form 1 2)))) | 709 (if hs-show-hidden-short-form 1 2)))) |
682 (message "Not enough comment lines to hide!")) | 710 (message "Not enough comment lines to hide!")) |
683 ((or c-reg (looking-at hs-block-start-regexp) | 711 ((or c-reg (looking-at hs-block-start-regexp) |
684 (hs-find-block-beginning)) | 712 (hs-find-block-beginning)) |
685 (hs-hide-block-at-point end c-reg) | 713 (hs-hide-block-at-point end c-reg) |
686 (hs-safety-is-job-n) | 714 (hs-safety-is-job-n) |
687 (run-hooks 'hs-hide-hook)))))) | 715 (run-hooks 'hs-hide-hook)))))) |
688 | 716 |
689 (defun hs-show-block (&optional end) | 717 (defun hs-show-block (&optional end) |
690 "Selects a block and shows it. | 718 "Select a block and show it. |
691 With prefix arg, reposition at end. Upon completion, point is | 719 With prefix arg, reposition at end. Upon completion, point is |
692 repositioned and the normal hook `hs-show-hook' is run. | 720 repositioned and the normal hook `hs-show-hook' is run. |
693 See documentation for `hs-hide-block' and `run-hooks'." | 721 See documentation for `hs-hide-block' and `run-hooks'." |
694 (interactive "P") | 722 (interactive "P") |
695 (hs-life-goes-on | 723 (hs-life-goes-on |
696 (let ((c-reg (hs-inside-comment-p))) | 724 (let ((c-reg (hs-inside-comment-p))) |
697 (if (or c-reg | 725 (if (or c-reg |
701 (hs-show-block-at-point end c-reg) | 729 (hs-show-block-at-point end c-reg) |
702 (hs-safety-is-job-n) | 730 (hs-safety-is-job-n) |
703 (run-hooks 'hs-show-hook)))))) | 731 (run-hooks 'hs-show-hook)))))) |
704 | 732 |
705 (defun hs-show-region (beg end) | 733 (defun hs-show-region (beg end) |
706 "Shows all lines from BEG to END, without doing any block analysis. | 734 "Show all lines from BEG to END, without doing any block analysis. |
707 Note:`hs-show-region' is intended for use when `hs-show-block' signals | 735 Note: `hs-show-region' is intended for use when `hs-show-block' signals |
708 `unbalanced parentheses' and so is an emergency measure only. You may | 736 \"unbalanced parentheses\" and so is an emergency measure only. You may |
709 become very confused if you use this command indiscriminately." | 737 become very confused if you use this command indiscriminately." |
710 (interactive "r") | 738 (interactive "r") |
711 (hs-life-goes-on | 739 (hs-life-goes-on |
712 (hs-flag-region beg end nil) | 740 (hs-flag-region beg end nil) |
713 (hs-safety-is-job-n) | 741 (hs-safety-is-job-n) |
714 (run-hooks 'hs-show-hook))) | 742 (run-hooks 'hs-show-hook))) |
715 | 743 |
744 (defun hs-hide-level (arg) | |
745 "Hide all blocks ARG levels below this block." | |
746 (interactive "p") | |
747 (hs-life-goes-on | |
748 (save-excursion | |
749 (message "Hiding blocks ...") | |
750 (hs-hide-level-recursive arg (point-min) (point-max)) | |
751 (message "Hiding blocks ... done")) | |
752 (hs-safety-is-job-n) | |
753 (run-hooks 'hs-hide-hook))) | |
754 | |
716 ;;;###autoload | 755 ;;;###autoload |
717 (defun hs-mouse-toggle-hiding (e) | 756 (defun hs-mouse-toggle-hiding (e) |
718 "Toggles hiding/showing of a block. | 757 "Toggle hiding/showing of a block. |
719 Should be bound to a mouse key." | 758 Should be bound to a mouse key." |
720 (interactive "@e") | 759 (interactive "@e") |
721 (mouse-set-point e) | 760 (mouse-set-point e) |
722 (if (hs-already-hidden-p) | 761 (if (hs-already-hidden-p) |
723 (hs-show-block) | 762 (hs-show-block) |
726 ;;;###autoload | 765 ;;;###autoload |
727 (defun hs-minor-mode (&optional arg) | 766 (defun hs-minor-mode (&optional arg) |
728 "Toggle hideshow minor mode. | 767 "Toggle hideshow minor mode. |
729 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. | 768 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. |
730 When hideshow minor mode is on, the menu bar is augmented with hideshow | 769 When hideshow minor mode is on, the menu bar is augmented with hideshow |
731 commands and the hideshow commands are enabled. | 770 commands and the hideshow commands are enabled. |
732 The value '(hs . t) is added to `buffer-invisibility-spec'. | 771 The value '(hs . t) is added to `buffer-invisibility-spec'. |
733 Last, the normal hook `hs-minor-mode-hook' is run; see the doc | 772 Last, the normal hook `hs-minor-mode-hook' is run; see the doc |
734 for `run-hooks'. | 773 for `run-hooks'. |
735 | 774 |
736 The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block' | 775 The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block', |
737 and `hs-show-block'. | 776 `hs-show-block', `hs-hide-level' and `hs-show-region'. |
738 Also see the documentation for the variable `hs-show-hidden-short-form'. | 777 Also see the documentation for the variable `hs-show-hidden-short-form'. |
739 | 778 |
740 Turning hideshow minor mode off reverts the menu bar and the | 779 Turning hideshow minor mode off reverts the menu bar and the |
741 variables to default values and disables the hideshow commands. | 780 variables to default values and disables the hideshow commands. |
742 | 781 |
775 | 814 |
776 ;; keymaps and menus | 815 ;; keymaps and menus |
777 (if hs-minor-mode-map | 816 (if hs-minor-mode-map |
778 nil | 817 nil |
779 (setq hs-minor-mode-map (make-sparse-keymap)) | 818 (setq hs-minor-mode-map (make-sparse-keymap)) |
780 ;; I beleive there is nothing bound on this keys | 819 (easy-menu-define hs-minor-mode-menu |
781 (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block) | 820 hs-minor-mode-map |
782 (define-key hs-minor-mode-map "\C-cs" 'hs-show-block) | 821 "Menu used when hideshow minor mode is active." |
783 (define-key hs-minor-mode-map "\C-cH" 'hs-hide-all) | 822 (cons "Hide/Show" |
784 (define-key hs-minor-mode-map "\C-cS" 'hs-show-all) | 823 (mapcar |
785 (define-key hs-minor-mode-map "\C-cR" 'hs-show-region) | 824 ;; populate keymap then massage entry for easymenu |
786 | 825 (lambda (ent) |
787 (define-key hs-minor-mode-map [S-mouse-2] 'hs-mouse-toggle-hiding) | 826 (define-key hs-minor-mode-map (aref ent 2) (aref ent 1)) |
788 | 827 (aset ent 2 (not (vectorp (aref ent 2)))) ; disable mousy stuff |
789 ;; should we use easymenu here? | 828 ent) |
790 (define-key hs-minor-mode-map [menu-bar Hide/Show] | 829 ;; I believe there is nothing bound on these keys |
791 (cons "Hide/Show" (make-sparse-keymap "Hide/Show"))) | 830 ;; menu entry command key |
792 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-region] | 831 '(["Hide Block" hs-hide-block "\C-ch"] |
793 '("Show Region" . hs-show-region)) | 832 ["Show Block" hs-show-block "\C-cs"] |
794 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-all] | 833 ["Hide All" hs-hide-all "\C-cH"] |
795 '("Show All" . hs-show-all)) | 834 ["Show All" hs-show-all "\C-cS"] |
796 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-all] | 835 ["Hide Level" hs-hide-level "\C-cL"] |
797 '("Hide All" . hs-hide-all)) | 836 ["Show Region" hs-show-region "\C-cR"] |
798 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-block] | 837 ["Toggle Hiding" hs-mouse-toggle-hiding [S-mouse-2]] |
799 '("Show Block" . hs-show-block)) | 838 ))))) |
800 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-block] | |
801 '("Hide Block" . hs-hide-block))) | |
802 | 839 |
803 ;; some housekeeping | 840 ;; some housekeeping |
804 (or (assq 'hs-minor-mode minor-mode-map-alist) | 841 (or (assq 'hs-minor-mode minor-mode-map-alist) |
805 (setq minor-mode-map-alist | 842 (setq minor-mode-map-alist |
806 (cons (cons 'hs-minor-mode hs-minor-mode-map) | 843 (cons (cons 'hs-minor-mode hs-minor-mode-map) |
807 minor-mode-map-alist))) | 844 minor-mode-map-alist))) |
808 (or (assq 'hs-minor-mode minor-mode-alist) | 845 (or (assq 'hs-minor-mode minor-mode-alist) |
809 (setq minor-mode-alist (append minor-mode-alist | 846 (setq minor-mode-alist (append minor-mode-alist |
810 (list '(hs-minor-mode " hs"))))) | 847 (list '(hs-minor-mode " hs"))))) |
811 | 848 |
812 ;; make some variables buffer-local | 849 ;; make some variables permanently buffer-local |
813 (make-variable-buffer-local 'hs-minor-mode) | 850 (mapcar (lambda (var) |
814 (make-variable-buffer-local 'hs-c-start-regexp) | 851 (make-variable-buffer-local var) |
815 (make-variable-buffer-local 'hs-block-start-regexp) | 852 (put var 'permanent-local t)) |
816 (make-variable-buffer-local 'hs-block-end-regexp) | 853 '(hs-minor-mode |
817 (make-variable-buffer-local 'hs-forward-sexp-func) | 854 hs-c-start-regexp |
818 (make-variable-buffer-local 'hs-adjust-block-beginning) | 855 hs-block-start-regexp |
819 (put 'hs-minor-mode 'permanent-local t) | 856 hs-block-end-regexp |
820 (put 'hs-c-start-regexp 'permanent-local t) | 857 hs-forward-sexp-func |
821 (put 'hs-block-start-regexp 'permanent-local t) | 858 hs-adjust-block-beginning)) |
822 (put 'hs-block-end-regexp 'permanent-local t) | |
823 (put 'hs-forward-sexp-func 'permanent-local t) | |
824 (put 'hs-adjust-block-beginning 'permanent-local t) | |
825 | |
826 | 859 |
827 ;;;---------------------------------------------------------------------------- | 860 ;;;---------------------------------------------------------------------------- |
828 ;;; that's it | 861 ;;; that's it |
829 | 862 |
830 (provide 'hideshow) | 863 (provide 'hideshow) |