lisp/progmodes/*.el: Lexical-binding cleanup.
[emacs.git] / lisp / progmodes / hideshow.el
blobd07edd5de2fa0c1091ce1719dfe7975635c7db77
1 ;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks
3 ;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
5 ;; Author: Thien-Thi Nguyen <ttn@gnu.org>
6 ;; Dan Nicolaescu <dann@ics.uci.edu>
7 ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
8 ;; Maintainer-Version: 5.65.2.2
9 ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;;; Commentary:
28 ;; * Commands provided
30 ;; This file provides Hideshow Minor Mode. When active, nine commands
31 ;; are available, implementing block hiding and showing. They (and their
32 ;; keybindings) are:
34 ;; hs-hide-block C-c @ C-h
35 ;; hs-show-block C-c @ C-s
36 ;; hs-hide-all C-c @ C-M-h
37 ;; hs-show-all C-c @ C-M-s
38 ;; hs-hide-level C-c @ C-l
39 ;; hs-toggle-hiding C-c @ C-c
40 ;; hs-mouse-toggle-hiding [(shift mouse-2)]
41 ;; hs-hide-initial-comment-block
43 ;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they
44 ;; are simply text between curly braces, while in Lisp-ish modes parens
45 ;; are used. Multi-line comment blocks can also be hidden. Read-only
46 ;; buffers are not a problem, since hideshow doesn't modify the text.
48 ;; The command `M-x hs-minor-mode' toggles the minor mode or sets it
49 ;; (similar to other minor modes).
51 ;; * Suggested usage
53 ;; First make sure hideshow.el is in a directory in your `load-path'.
54 ;; You can optionally byte-compile it using `M-x byte-compile-file'.
55 ;; Then, add the following to your ~/.emacs:
57 ;; (load-library "hideshow")
58 ;; (add-hook 'X-mode-hook ; other modes similarly
59 ;; (lambda () (hs-minor-mode 1)))
61 ;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle
62 ;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is
63 ;; activated or deactivated, `hs-minor-mode-hook' is run w/ `run-hooks'.
65 ;; Additionally, Joseph Eydelnant writes:
66 ;; I enjoy your package hideshow.el Ver. 5.24 2001/02/13
67 ;; a lot and I've been looking for the following functionality:
68 ;; toggle hide/show all with a single key.
69 ;; Here are a few lines of code that lets me do just that.
71 ;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.")
72 ;; ;;;###autoload
73 ;; (defun my-toggle-hideshow-all () "Toggle hideshow all."
74 ;; (interactive)
75 ;; (setq my-hs-hide (not my-hs-hide))
76 ;; (if my-hs-hide
77 ;; (hs-hide-all)
78 ;; (hs-show-all)))
80 ;; [Your hideshow hacks here!]
82 ;; * Customization
84 ;; You can use `M-x customize-variable' on the following variables:
86 ;; - hs-hide-comments-when-hiding-all -- self-explanatory!
87 ;; - hs-hide-all-non-comment-function -- if non-nil, when doing a
88 ;; `hs-hide-all', this function
89 ;; is called w/ no arguments
90 ;; - hs-isearch-open -- what kind of hidden blocks to
91 ;; open when doing isearch
93 ;; Some languages (e.g., Java) are deeply nested, so the normal behavior
94 ;; of `hs-hide-all' (hiding all but top-level blocks) results in very
95 ;; little information shown, which is not very useful. You can use the
96 ;; variable `hs-hide-all-non-comment-function' to implement your idea of
97 ;; what is more useful. For example, the following code shows the next
98 ;; nested level in addition to the top-level:
100 ;; (defun ttn-hs-hide-level-1 ()
101 ;; (hs-hide-level 1)
102 ;; (forward-sexp 1))
103 ;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
105 ;; Hideshow works w/ incremental search (isearch) by setting the variable
106 ;; `hs-headline', which is the line of text at the beginning of a hidden
107 ;; block that contains a match for the search. You can have this show up
108 ;; in the mode line by modifying the variable `mode-line-format'. For
109 ;; example, the following code prepends this info to the mode line:
111 ;; (unless (memq 'hs-headline mode-line-format)
112 ;; (setq mode-line-format
113 ;; (append '("-" hs-headline) mode-line-format)))
115 ;; See documentation for `mode-line-format' for more info.
117 ;; Hooks are run after some commands:
119 ;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level
120 ;; hs-show-hook hs-show-block, hs-show-all
122 ;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling
123 ;; commands when the result of the toggle is to hide or show blocks,
124 ;; respectively. All hooks are run w/ `run-hooks'. See docs for each
125 ;; variable or hook for more info.
127 ;; Normally, hideshow tries to determine appropriate values for block
128 ;; and comment definitions by examining the buffer's major mode. If
129 ;; there are problems, hideshow will not activate and in that case you
130 ;; may wish to override hideshow's heuristics by adding an entry to
131 ;; variable `hs-special-modes-alist'. Packages that use hideshow should
132 ;; do something like:
134 ;; (add-to-list 'hs-special-modes-alist '(my-mode "{{" "}}" ...))
136 ;; If you have an entry that works particularly well, consider
137 ;; submitting it for inclusion in hideshow.el. See docstring for
138 ;; `hs-special-modes-alist' for more info on the entry format.
140 ;; See also variable `hs-set-up-overlay' for per-block customization of
141 ;; appearance or other effects associated with overlays. For example:
143 ;; (setq hs-set-up-overlay
144 ;; (defun my-display-code-line-counts (ov)
145 ;; (when (eq 'code (overlay-get ov 'hs))
146 ;; (overlay-put ov 'display
147 ;; (propertize
148 ;; (format " ... <%d>"
149 ;; (count-lines (overlay-start ov)
150 ;; (overlay-end ov)))
151 ;; 'face 'font-lock-type-face)))))
153 ;; * Bugs
155 ;; (1) Hideshow does not work w/ emacs 18 because emacs 18 lacks the
156 ;; function `forward-comment' (among other things). If someone
157 ;; writes this, please send me a copy.
159 ;; (2) Sometimes `hs-headline' can become out of sync. To reset, type
160 ;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate
161 ;; hideshow).
163 ;; (3) Hideshow 5.x is developed and tested on GNU Emacs 20.7.
164 ;; XEmacs compatibility may have bitrotted since 4.29.
166 ;; (4) Some buffers can't be `byte-compile-file'd properly. This is because
167 ;; `byte-compile-file' inserts the file to be compiled in a temporary
168 ;; buffer and switches `normal-mode' on. In the case where you have
169 ;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding of
170 ;; the initial comment sometimes hides parts of the first statement (seems
171 ;; to be only in `normal-mode'), so there are unbalanced "(" and ")".
173 ;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling:
175 ;; (defadvice byte-compile-file (around
176 ;; byte-compile-file-hideshow-off
177 ;; act)
178 ;; (let ((hs-minor-mode-hook nil))
179 ;; ad-do-it))
181 ;; (5) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, the
182 ;; suggested workaround is to turn off hideshow entirely, for example:
184 ;; (add-hook 'ediff-prepare-buffer-hook 'turn-off-hideshow)
185 ;; (add-hook 'vc-before-checkin-hook 'turn-off-hideshow)
187 ;; In the case of `vc-diff', here is a less invasive workaround:
189 ;; (add-hook 'vc-before-checkin-hook
190 ;; (lambda ()
191 ;; (goto-char (point-min))
192 ;; (hs-show-block)))
194 ;; Unfortunately, these workarounds do not restore hideshow state.
195 ;; If someone figures out a better way, please let me know.
197 ;; * Correspondance
199 ;; Correspondance welcome; please indicate version number. Send bug
200 ;; reports and inquiries to <ttn@gnu.org>.
202 ;; * Thanks
204 ;; Thanks go to the following people for valuable ideas, code and
205 ;; bug reports.
207 ;; Dean Andrews, Alf-Ivar Holm, Holger Bauer, Christoph Conrad, Dave Love,
208 ;; Dirk Herrmann, Gael Marziou, Jan Djarv, Guillaume Leray, Moody Ahmad,
209 ;; Preston F. Crow, Lars Lindberg, Reto Zimmermann, Keith Sheffield,
210 ;; Chew Meng Kuan, Tony Lam, Pete Ware, François Pinard, Stefan Monnier,
211 ;; Joseph Eydelnant, Michael Ernst, Peter Heslin
213 ;; Special thanks go to Dan Nicolaescu, who reimplemented hideshow using
214 ;; overlays (rather than selective display), added isearch magic, folded
215 ;; in custom.el compatibility, generalized comment handling, incorporated
216 ;; mouse support, and maintained the code in general. Version 4.0 is
217 ;; largely due to his efforts.
219 ;; * History
221 ;; Hideshow was inspired when I learned about selective display. It was
222 ;; reimplemented to use overlays for 4.0 (see above). WRT older history,
223 ;; entries in the masterfile corresponding to versions 1.x and 2.x have
224 ;; been lost. XEmacs support is reliable as of 4.29. State save and
225 ;; restore was added in 3.5 (not widely distributed), and reliable as of
226 ;; 4.30. Otherwise, the code seems stable. Passes checkdoc as of 4.32.
227 ;; Version 5.x uses new algorithms for block selection and traversal,
228 ;; unbundles state save and restore, and includes more isearch support.
230 ;;; Code:
232 ;;---------------------------------------------------------------------------
233 ;; user-configurable variables
235 (defgroup hideshow nil
236 "Minor mode for hiding and showing program and comment blocks."
237 :prefix "hs-"
238 :group 'languages)
240 (defcustom hs-hide-comments-when-hiding-all t
241 "*Hide the comments too when you do an `hs-hide-all'."
242 :type 'boolean
243 :group 'hideshow)
245 (defcustom hs-minor-mode-hook nil
246 "*Hook called when hideshow minor mode is activated or deactivated."
247 :type 'hook
248 :group 'hideshow
249 :version "21.1")
251 (defcustom hs-isearch-open 'code
252 "*What kind of hidden blocks to open when doing `isearch'.
253 One of the following symbols:
255 code -- open only code blocks
256 comment -- open only comment blocks
257 t -- open both code and comment blocks
258 nil -- open neither code nor comment blocks
260 This has effect only if `search-invisible' is set to `open'."
261 :type '(choice (const :tag "open only code blocks" code)
262 (const :tag "open only comment blocks" comment)
263 (const :tag "open both code and comment blocks" t)
264 (const :tag "don't open any of them" nil))
265 :group 'hideshow)
267 ;;;###autoload
268 (defvar hs-special-modes-alist
269 (mapcar 'purecopy
270 '((c-mode "{" "}" "/[*/]" nil nil)
271 (c++-mode "{" "}" "/[*/]" nil nil)
272 (bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
273 (java-mode "{" "}" "/[*/]" nil nil)
274 (js-mode "{" "}" "/[*/]" nil)))
275 "*Alist for initializing the hideshow variables for different modes.
276 Each element has the form
277 (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
279 If non-nil, hideshow will use these values as regexps to define blocks
280 and comments, respectively for major mode MODE.
282 START, END and COMMENT-START are regular expressions. A block is
283 defined as text surrounded by START and END.
285 As a special case, START may be a list of the form (COMPLEX-START
286 MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and
287 MDATA-SELECTOR an integer that specifies which sub-match is the proper
288 place to adjust point, before calling `hs-forward-sexp-func'. Point
289 is adjusted to the beginning of the specified match. For example,
290 see the `hs-special-modes-alist' entry for `bibtex-mode'.
292 For some major modes, `forward-sexp' does not work properly. In those
293 cases, FORWARD-SEXP-FUNC specifies another function to use instead.
295 See the documentation for `hs-adjust-block-beginning' to see what is the
296 use of ADJUST-BEG-FUNC.
298 If any of the elements is left nil or omitted, hideshow tries to guess
299 appropriate values. The regexps should not contain leading or trailing
300 whitespace. Case does not matter.")
302 (defvar hs-hide-all-non-comment-function nil
303 "*Function called if non-nil when doing `hs-hide-all' for non-comments.")
305 (defvar hs-allow-nesting nil
306 "*If non-nil, hiding remembers internal blocks.
307 This means that when the outer block is shown again,
308 any previously hidden internal blocks remain hidden.")
310 (defvar hs-hide-hook nil
311 "*Hook called (with `run-hooks') at the end of commands to hide text.
312 These commands include the toggling commands (when the result is to hide
313 a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
315 (defvar hs-show-hook nil
316 "*Hook called (with `run-hooks') at the end of commands to show text.
317 These commands include the toggling commands (when the result is to show
318 a block), `hs-show-all' and `hs-show-block'.")
320 (defvar hs-set-up-overlay nil
321 "*Function called with one arg, OV, a newly initialized overlay.
322 Hideshow puts a unique overlay on each range of text to be hidden
323 in the buffer. Here is a simple example of how to use this variable:
325 (defun display-code-line-counts (ov)
326 (when (eq 'code (overlay-get ov 'hs))
327 (overlay-put ov 'display
328 (format \"... / %d\"
329 (count-lines (overlay-start ov)
330 (overlay-end ov))))))
332 (setq hs-set-up-overlay 'display-code-line-counts)
334 This example shows how to get information from the overlay as well
335 as how to set its `display' property. See `hs-make-overlay' and
336 info node `(elisp)Overlays'.")
338 ;;---------------------------------------------------------------------------
339 ;; internal variables
341 (defvar hs-minor-mode nil
342 "Non-nil if using hideshow mode as a minor mode of some other mode.
343 Use the command `hs-minor-mode' to toggle or set this variable.")
345 (defvar hs-minor-mode-map
346 (let ((map (make-sparse-keymap)))
347 ;; These bindings roughly imitate those used by Outline mode.
348 (define-key map "\C-c@\C-h" 'hs-hide-block)
349 (define-key map "\C-c@\C-s" 'hs-show-block)
350 (define-key map "\C-c@\C-\M-h" 'hs-hide-all)
351 (define-key map "\C-c@\C-\M-s" 'hs-show-all)
352 (define-key map "\C-c@\C-l" 'hs-hide-level)
353 (define-key map "\C-c@\C-c" 'hs-toggle-hiding)
354 (define-key map [(shift mouse-2)] 'hs-mouse-toggle-hiding)
355 map)
356 "Keymap for hideshow minor mode.")
358 (easy-menu-define hs-minor-mode-menu hs-minor-mode-map
359 "Menu used when hideshow minor mode is active."
360 '("Hide/Show"
361 ["Hide Block" hs-hide-block
362 :help "Hide the code or comment block at point"]
363 ["Show Block" hs-show-block
364 :help "Show the code or comment block at point"]
365 ["Hide All" hs-hide-all
366 :help "Hide all the blocks in the buffer"]
367 ["Show All" hs-show-all
368 :help "Show all the blocks in the buffer"]
369 ["Hide Level" hs-hide-level
370 :help "Hide all block at levels below the current block"]
371 ["Toggle Hiding" hs-toggle-hiding
372 :help "Toggle the hiding state of the current block"]
373 "----"
374 ["Hide comments when hiding all"
375 (setq hs-hide-comments-when-hiding-all
376 (not hs-hide-comments-when-hiding-all))
377 :help "If t also hide comment blocks when doing `hs-hide-all'"
378 :style toggle :selected hs-hide-comments-when-hiding-all]
379 ("Reveal on isearch"
380 ["Code blocks" (setq hs-isearch-open 'code)
381 :help "Show hidden code blocks when isearch matches inside them"
382 :active t :style radio :selected (eq hs-isearch-open 'code)]
383 ["Comment blocks" (setq hs-isearch-open 'comment)
384 :help "Show hidden comment blocks when isearch matches inside them"
385 :active t :style radio :selected (eq hs-isearch-open 'comment)]
386 ["Code and Comment blocks" (setq hs-isearch-open t)
387 :help "Show both hidden code and comment blocks when isearch matches inside them"
388 :active t :style radio :selected (eq hs-isearch-open t)]
389 ["None" (setq hs-isearch-open nil)
390 :help "Do not hidden code or comment blocks when isearch matches inside them"
391 :active t :style radio :selected (eq hs-isearch-open nil)])))
393 (defvar hs-c-start-regexp nil
394 "Regexp for beginning of comments.
395 Differs from mode-specific comment regexps in that
396 surrounding whitespace is stripped.")
397 (make-variable-buffer-local 'hs-c-start-regexp)
399 (defvar hs-block-start-regexp nil
400 "Regexp for beginning of block.")
401 (make-variable-buffer-local 'hs-block-start-regexp)
403 (defvar hs-block-start-mdata-select nil
404 "Element in `hs-block-start-regexp' match data to consider as block start.
405 The internal function `hs-forward-sexp' moves point to the beginning of this
406 element (using `match-beginning') before calling `hs-forward-sexp-func'.")
407 (make-variable-buffer-local 'hs-block-start-mdata-select)
409 (defvar hs-block-end-regexp nil
410 "Regexp for end of block.")
412 (defvar hs-forward-sexp-func 'forward-sexp
413 "Function used to do a `forward-sexp'.
414 Should change for Algol-ish modes. For single-character block
415 delimiters -- ie, the syntax table regexp for the character is
416 either `(' or `)' -- `hs-forward-sexp-func' would just be
417 `forward-sexp'. For other modes such as simula, a more specialized
418 function is necessary.")
419 (make-variable-buffer-local 'hs-forward-sexp-func)
421 (defvar hs-adjust-block-beginning nil
422 "Function used to tweak the block beginning.
423 The block is hidden from the position returned by this function,
424 as opposed to hiding it from the position returned when searching
425 for `hs-block-start-regexp'.
427 For example, in c-like modes, if we wish to also hide the curly braces
428 \(if you think they occupy too much space on the screen), this function
429 should return the starting point (at the end of line) of the hidden
430 region.
432 It is called with a single argument ARG which is the position in
433 buffer after the block beginning.
435 It should return the position from where we should start hiding.
437 It should not move the point.
439 See `hs-c-like-adjust-block-beginning' for an example of using this.")
440 (make-variable-buffer-local 'hs-adjust-block-beginning)
442 (defvar hs-headline nil
443 "Text of the line where a hidden block begins, set during isearch.
444 You can display this in the mode line by adding the symbol `hs-headline'
445 to the variable `mode-line-format'. For example,
447 (unless (memq 'hs-headline mode-line-format)
448 (setq mode-line-format
449 (append '(\"-\" hs-headline) mode-line-format)))
451 Note that `mode-line-format' is buffer-local.")
453 ;;---------------------------------------------------------------------------
454 ;; support functions
456 (defun hs-discard-overlays (from to)
457 "Delete hideshow overlays in region defined by FROM and TO.
458 Skip \"internal\" overlays if `hs-allow-nesting' is non-nil."
459 (when (< to from)
460 (setq from (prog1 to (setq to from))))
461 (if hs-allow-nesting
462 (let (ov)
463 (while (> to (setq from (next-overlay-change from)))
464 (when (setq ov (hs-overlay-at from))
465 (setq from (overlay-end ov))
466 (delete-overlay ov))))
467 (dolist (ov (overlays-in from to))
468 (when (overlay-get ov 'hs)
469 (delete-overlay ov)))))
471 (defun hs-make-overlay (b e kind &optional b-offset e-offset)
472 "Return a new overlay in region defined by B and E with type KIND.
473 KIND is either `code' or `comment'. Optional fourth arg B-OFFSET
474 when added to B specifies the actual buffer position where the block
475 begins. Likewise for optional fifth arg E-OFFSET. If unspecified
476 they are taken to be 0 (zero). The following properties are set
477 in the overlay: 'invisible 'hs 'hs-b-offset 'hs-e-offset. Also,
478 depending on variable `hs-isearch-open', the following properties may
479 be present: 'isearch-open-invisible 'isearch-open-invisible-temporary.
480 If variable `hs-set-up-overlay' is non-nil it should specify a function
481 to call with the newly initialized overlay."
482 (unless b-offset (setq b-offset 0))
483 (unless e-offset (setq e-offset 0))
484 (let ((ov (make-overlay b e))
485 (io (if (eq 'block hs-isearch-open)
486 ;; backward compatibility -- `block'<=>`code'
487 'code
488 hs-isearch-open)))
489 (overlay-put ov 'invisible 'hs)
490 (overlay-put ov 'hs kind)
491 (overlay-put ov 'hs-b-offset b-offset)
492 (overlay-put ov 'hs-e-offset e-offset)
493 (when (or (eq io t) (eq io kind))
494 (overlay-put ov 'isearch-open-invisible 'hs-isearch-show)
495 (overlay-put ov 'isearch-open-invisible-temporary
496 'hs-isearch-show-temporary))
497 (when hs-set-up-overlay (funcall hs-set-up-overlay ov))
498 ov))
500 (defun hs-isearch-show (ov)
501 "Delete overlay OV, and set `hs-headline' to nil.
503 This function is meant to be used as the `isearch-open-invisible'
504 property of an overlay."
505 (setq hs-headline nil)
506 (delete-overlay ov))
508 (defun hs-isearch-show-temporary (ov hide-p)
509 "Hide or show overlay OV, and set `hs-headline', all depending on HIDE-P.
510 If HIDE-P is non-nil, `hs-headline' is set to nil and overlay OV is hidden.
511 Otherwise, `hs-headline' is set to the line of text at the head of OV, and
512 OV is shown.
514 This function is meant to be used as the `isearch-open-invisible-temporary'
515 property of an overlay."
516 (setq hs-headline
517 (if hide-p
519 (or hs-headline
520 (let ((start (overlay-start ov)))
521 (buffer-substring
522 (save-excursion (goto-char start)
523 (beginning-of-line)
524 (skip-chars-forward " \t")
525 (point))
526 start)))))
527 (force-mode-line-update)
528 ;; handle `display' property specially
529 (let (value)
530 (if hide-p
531 (when (setq value (overlay-get ov 'hs-isearch-display))
532 (overlay-put ov 'display value)
533 (overlay-put ov 'hs-isearch-display nil))
534 (when (setq value (overlay-get ov 'display))
535 (overlay-put ov 'hs-isearch-display value)
536 (overlay-put ov 'display nil))))
537 (overlay-put ov 'invisible (and hide-p 'hs)))
539 (defun hs-forward-sexp (match-data arg)
540 "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG.
541 Original match data is restored upon return."
542 (save-match-data
543 (set-match-data match-data)
544 (goto-char (match-beginning hs-block-start-mdata-select))
545 (funcall hs-forward-sexp-func arg)))
547 (defun hs-hide-comment-region (beg end &optional repos-end)
548 "Hide a region from BEG to END, marking it as a comment.
549 Optional arg REPOS-END means reposition at end."
550 (let ((beg-eol (progn (goto-char beg) (line-end-position)))
551 (end-eol (progn (goto-char end) (line-end-position))))
552 (hs-discard-overlays beg-eol end-eol)
553 (hs-make-overlay beg-eol end-eol 'comment beg end))
554 (goto-char (if repos-end end beg)))
556 (defun hs-hide-block-at-point (&optional end comment-reg)
557 "Hide block if on block beginning.
558 Optional arg END means reposition at end.
559 Optional arg COMMENT-REG is a list of the form (BEGIN END) and
560 specifies the limits of the comment, or nil if the block is not
561 a comment.
563 The block beginning is adjusted by `hs-adjust-block-beginning'
564 and then further adjusted to be at the end of the line."
565 (if comment-reg
566 (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end)
567 (when (looking-at hs-block-start-regexp)
568 (let ((mdata (match-data t))
569 (header-end (match-end 0))
570 p q ov)
571 ;; `p' is the point at the end of the block beginning, which
572 ;; may need to be adjusted
573 (save-excursion
574 (if hs-adjust-block-beginning
575 (goto-char (funcall hs-adjust-block-beginning
576 header-end))
577 (goto-char header-end))
578 (setq p (line-end-position)))
579 ;; `q' is the point at the end of the block
580 (hs-forward-sexp mdata 1)
581 (setq q (if (looking-back hs-block-end-regexp)
582 (match-beginning 0)
583 (point)))
584 (when (and (< p q) (> (count-lines p q) 1))
585 (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p)))
586 (delete-overlay ov))
587 ((not hs-allow-nesting)
588 (hs-discard-overlays p q)))
589 (hs-make-overlay p q 'code (- header-end p)))
590 (goto-char (if end q (min p header-end)))))))
592 (defun hs-inside-comment-p ()
593 "Return non-nil if point is inside a comment, otherwise nil.
594 Actually, return a list containing the buffer position of the start
595 and the end of the comment. A comment block can be hidden only if on
596 its starting line there is only whitespace preceding the actual comment
597 beginning. If we are inside of a comment but this condition is not met,
598 we return a list having a nil as its car and the end of comment position
599 as cdr."
600 (save-excursion
601 ;; the idea is to look backwards for a comment start regexp, do a
602 ;; forward comment, and see if we are inside, then extend extend
603 ;; forward and backward as long as we have comments
604 (let ((q (point)))
605 (when (or (looking-at hs-c-start-regexp)
606 (re-search-backward hs-c-start-regexp (point-min) t))
607 ;; first get to the beginning of this comment...
608 (while (and (not (bobp))
609 (= (point) (progn (forward-comment -1) (point))))
610 (forward-char -1))
611 ;; ...then extend backwards
612 (forward-comment (- (buffer-size)))
613 (skip-chars-forward " \t\n\f")
614 (let ((p (point))
615 (hidable t))
616 (beginning-of-line)
617 (unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
618 ;; we are in this situation: (example)
619 ;; (defun bar ()
620 ;; (foo)
621 ;; ) ; comment
622 ;; ^
623 ;; the point was here before doing (beginning-of-line)
624 ;; here we should advance till the next comment which
625 ;; eventually has only white spaces preceding it on the same
626 ;; line
627 (goto-char p)
628 (forward-comment 1)
629 (skip-chars-forward " \t\n\f")
630 (setq p (point))
631 (while (and (< (point) q)
632 (> (point) p)
633 (not (looking-at hs-c-start-regexp)))
634 ;; avoid an infinite cycle
635 (setq p (point))
636 (forward-comment 1)
637 (skip-chars-forward " \t\n\f"))
638 (when (or (not (looking-at hs-c-start-regexp))
639 (> (point) q))
640 ;; we cannot hide this comment block
641 (setq hidable nil)))
642 ;; goto the end of the comment
643 (forward-comment (buffer-size))
644 (skip-chars-backward " \t\n\f")
645 (end-of-line)
646 (when (>= (point) q)
647 (list (and hidable p) (point))))))))
649 (defun hs-grok-mode-type ()
650 "Set up hideshow variables for new buffers.
651 If `hs-special-modes-alist' has information associated with the
652 current buffer's major mode, use that.
653 Otherwise, guess start, end and `comment-start' regexps; `forward-sexp'
654 function; and adjust-block-beginning function."
655 (if (and (boundp 'comment-start)
656 (boundp 'comment-end)
657 comment-start comment-end)
658 (let* ((lookup (assoc major-mode hs-special-modes-alist))
659 (start-elem (or (nth 1 lookup) "\\s(")))
660 (if (listp start-elem)
661 ;; handle (START-REGEXP MDATA-SELECT)
662 (setq hs-block-start-regexp (car start-elem)
663 hs-block-start-mdata-select (cadr start-elem))
664 ;; backwards compatibility: handle simple START-REGEXP
665 (setq hs-block-start-regexp start-elem
666 hs-block-start-mdata-select 0))
667 (setq hs-block-end-regexp (or (nth 2 lookup) "\\s)")
668 hs-c-start-regexp (or (nth 3 lookup)
669 (let ((c-start-regexp
670 (regexp-quote comment-start)))
671 (if (string-match " +$" c-start-regexp)
672 (substring c-start-regexp
673 0 (1- (match-end 0)))
674 c-start-regexp)))
675 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp)
676 hs-adjust-block-beginning (nth 5 lookup)))
677 (setq hs-minor-mode nil)
678 (error "%s Mode doesn't support Hideshow Minor Mode"
679 (format-mode-line mode-name))))
681 (defun hs-find-block-beginning ()
682 "Reposition point at block-start.
683 Return point, or nil if original point was not in a block."
684 (let ((done nil)
685 (here (point)))
686 ;; look if current line is block start
687 (if (looking-at hs-block-start-regexp)
688 (point)
689 ;; look backward for the start of a block that contains the cursor
690 (while (and (re-search-backward hs-block-start-regexp nil t)
691 (save-match-data
692 (not (nth 4 (syntax-ppss)))) ; not inside comments
693 (not (setq done
694 (< here (save-excursion
695 (hs-forward-sexp (match-data t) 1)
696 (point)))))))
697 (if done
698 (point)
699 (goto-char here)
700 nil))))
702 (defun hs-hide-level-recursive (arg minp maxp)
703 "Recursively hide blocks ARG levels below point in region (MINP MAXP)."
704 (when (hs-find-block-beginning)
705 (setq minp (1+ (point)))
706 (funcall hs-forward-sexp-func 1)
707 (setq maxp (1- (point))))
708 (unless hs-allow-nesting
709 (hs-discard-overlays minp maxp))
710 (goto-char minp)
711 (while (progn
712 (forward-comment (buffer-size))
713 (and (< (point) maxp)
714 (re-search-forward hs-block-start-regexp maxp t)))
715 (when (save-match-data
716 (not (nth 4 (syntax-ppss)))) ; not inside comments
717 (if (> arg 1)
718 (hs-hide-level-recursive (1- arg) minp maxp)
719 (goto-char (match-beginning hs-block-start-mdata-select))
720 (hs-hide-block-at-point t))))
721 (goto-char maxp))
723 (defmacro hs-life-goes-on (&rest body)
724 "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
725 In the dynamic context of this macro, `inhibit-point-motion-hooks'
726 and `case-fold-search' are both t."
727 `(when hs-minor-mode
728 (let ((inhibit-point-motion-hooks t)
729 (case-fold-search t))
730 ,@body)))
732 (put 'hs-life-goes-on 'edebug-form-spec '(&rest form))
734 (defun hs-overlay-at (position)
735 "Return hideshow overlay at POSITION, or nil if none to be found."
736 (let ((overlays (overlays-at position))
737 ov found)
738 (while (and (not found) (setq ov (car overlays)))
739 (setq found (and (overlay-get ov 'hs) ov)
740 overlays (cdr overlays)))
741 found))
743 (defun hs-already-hidden-p ()
744 "Return non-nil if point is in an already-hidden block, otherwise nil."
745 (save-excursion
746 (let ((c-reg (hs-inside-comment-p)))
747 (if (and c-reg (nth 0 c-reg))
748 ;; point is inside a comment, and that comment is hidable
749 (goto-char (nth 0 c-reg))
750 (end-of-line)
751 (when (and (not c-reg)
752 (hs-find-block-beginning)
753 (looking-at hs-block-start-regexp))
754 ;; point is inside a block
755 (goto-char (match-end 0)))))
756 (end-of-line)
757 (hs-overlay-at (point))))
759 ;; This function is not used anymore (Bug#700).
760 (defun hs-c-like-adjust-block-beginning (initial)
761 "Adjust INITIAL, the buffer position after `hs-block-start-regexp'.
762 Actually, point is never moved; a new position is returned that is
763 the end of the C-function header. This adjustment function is meant
764 to be assigned to `hs-adjust-block-beginning' for C-like modes."
765 (save-excursion
766 (goto-char (1- initial))
767 (forward-comment (- (buffer-size)))
768 (point)))
770 ;;---------------------------------------------------------------------------
771 ;; commands
773 (defun hs-hide-all ()
774 "Hide all top level blocks, displaying only first and last lines.
775 Move point to the beginning of the line, and run the normal hook
776 `hs-hide-hook'. See documentation for `run-hooks'.
777 If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
778 (interactive)
779 (hs-life-goes-on
780 (save-excursion
781 (unless hs-allow-nesting
782 (hs-discard-overlays (point-min) (point-max)))
783 (goto-char (point-min))
784 (let ((spew (make-progress-reporter "Hiding all blocks..."
785 (point-min) (point-max)))
786 (re (concat "\\("
787 hs-block-start-regexp
788 "\\)"
789 (if hs-hide-comments-when-hiding-all
790 (concat "\\|\\("
791 hs-c-start-regexp
792 "\\)")
793 ""))))
794 (while (progn
795 (unless hs-hide-comments-when-hiding-all
796 (forward-comment (point-max)))
797 (re-search-forward re (point-max) t))
798 (if (match-beginning 1)
799 ;; we have found a block beginning
800 (progn
801 (goto-char (match-beginning 1))
802 (if hs-hide-all-non-comment-function
803 (funcall hs-hide-all-non-comment-function)
804 (hs-hide-block-at-point t)))
805 ;; found a comment, probably
806 (let ((c-reg (hs-inside-comment-p)))
807 (when (and c-reg (car c-reg))
808 (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1)
809 (hs-hide-block-at-point t c-reg)
810 (goto-char (nth 1 c-reg))))))
811 (progress-reporter-update spew (point)))
812 (progress-reporter-done spew)))
813 (beginning-of-line)
814 (run-hooks 'hs-hide-hook)))
816 (defun hs-show-all ()
817 "Show everything then run `hs-show-hook'. See `run-hooks'."
818 (interactive)
819 (hs-life-goes-on
820 (message "Showing all blocks ...")
821 (let ((hs-allow-nesting nil))
822 (hs-discard-overlays (point-min) (point-max)))
823 (message "Showing all blocks ... done")
824 (run-hooks 'hs-show-hook)))
826 (defun hs-hide-block (&optional end)
827 "Select a block and hide it. With prefix arg, reposition at END.
828 Upon completion, point is repositioned and the normal hook
829 `hs-hide-hook' is run. See documentation for `run-hooks'."
830 (interactive "P")
831 (hs-life-goes-on
832 (let ((c-reg (hs-inside-comment-p)))
833 (cond
834 ((and c-reg (or (null (nth 0 c-reg))
835 (<= (count-lines (car c-reg) (nth 1 c-reg)) 1)))
836 (message "(not enough comment lines to hide)"))
837 ((or c-reg
838 (looking-at hs-block-start-regexp)
839 (hs-find-block-beginning))
840 (hs-hide-block-at-point end c-reg)
841 (run-hooks 'hs-hide-hook))))))
843 (defun hs-show-block (&optional end)
844 "Select a block and show it.
845 With prefix arg, reposition at END. Upon completion, point is
846 repositioned and the normal hook `hs-show-hook' is run.
847 See documentation for functions `hs-hide-block' and `run-hooks'."
848 (interactive "P")
849 (hs-life-goes-on
851 ;; first see if we have something at the end of the line
852 (let ((ov (hs-overlay-at (line-end-position)))
853 (here (point)))
854 (when ov
855 (goto-char
856 (cond (end (overlay-end ov))
857 ((eq 'comment (overlay-get ov 'hs)) here)
858 (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset)))))
859 (delete-overlay ov)
861 ;; not immediately obvious, look for a suitable block
862 (let ((c-reg (hs-inside-comment-p))
863 p q)
864 (cond (c-reg
865 (when (car c-reg)
866 (setq p (car c-reg)
867 q (cadr c-reg))))
868 ((and (hs-find-block-beginning)
869 ;; ugh, fresh match-data
870 (looking-at hs-block-start-regexp))
871 (setq p (point)
872 q (progn (hs-forward-sexp (match-data t) 1) (point)))))
873 (when (and p q)
874 (hs-discard-overlays p q)
875 (goto-char (if end q (1+ p))))))
876 (run-hooks 'hs-show-hook)))
878 (defun hs-hide-level (arg)
879 "Hide all blocks ARG levels below this block.
880 The hook `hs-hide-hook' is run; see `run-hooks'."
881 (interactive "p")
882 (hs-life-goes-on
883 (save-excursion
884 (message "Hiding blocks ...")
885 (hs-hide-level-recursive arg (point-min) (point-max))
886 (message "Hiding blocks ... done"))
887 (run-hooks 'hs-hide-hook)))
889 (defun hs-toggle-hiding ()
890 "Toggle hiding/showing of a block.
891 See `hs-hide-block' and `hs-show-block'."
892 (interactive)
893 (hs-life-goes-on
894 (if (hs-already-hidden-p)
895 (hs-show-block)
896 (hs-hide-block))))
898 (defun hs-mouse-toggle-hiding (e)
899 "Toggle hiding/showing of a block.
900 This command should be bound to a mouse key.
901 Argument E is a mouse event used by `mouse-set-point'.
902 See `hs-hide-block' and `hs-show-block'."
903 (interactive "@e")
904 (hs-life-goes-on
905 (mouse-set-point e)
906 (hs-toggle-hiding)))
908 (defun hs-hide-initial-comment-block ()
909 "Hide the first block of comments in a file.
910 This can be useful if you have huge RCS logs in those comments."
911 (interactive)
912 (hs-life-goes-on
913 (let ((c-reg (save-excursion
914 (goto-char (point-min))
915 (skip-chars-forward " \t\n\f")
916 (hs-inside-comment-p))))
917 (when c-reg
918 (let ((beg (car c-reg)) (end (cadr c-reg)))
919 ;; see if we have enough comment lines to hide
920 (when (> (count-lines beg end) 1)
921 (hs-hide-comment-region beg end)))))))
923 ;;;###autoload
924 (define-minor-mode hs-minor-mode
925 "Minor mode to selectively hide/show code and comment blocks.
926 When hideshow minor mode is on, the menu bar is augmented with hideshow
927 commands and the hideshow commands are enabled.
928 The value '(hs . t) is added to `buffer-invisibility-spec'.
930 The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block',
931 `hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also
932 `hs-hide-initial-comment-block' and `hs-mouse-toggle-hiding'.
934 Turning hideshow minor mode off reverts the menu bar and the
935 variables to default values and disables the hideshow commands.
937 Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'.
939 Key bindings:
940 \\{hs-minor-mode-map}"
941 :group 'hideshow
942 :lighter " hs"
943 :keymap hs-minor-mode-map
944 (setq hs-headline nil)
945 (if hs-minor-mode
946 (progn
947 (hs-grok-mode-type)
948 ;; Turn off this mode if we change major modes.
949 (add-hook 'change-major-mode-hook
950 'turn-off-hideshow
951 nil t)
952 (easy-menu-add hs-minor-mode-menu)
953 (set (make-local-variable 'line-move-ignore-invisible) t)
954 (add-to-invisibility-spec '(hs . t)))
955 (remove-from-invisibility-spec '(hs . t))
956 ;; hs-show-all does nothing unless h-m-m is non-nil.
957 (let ((hs-minor-mode t))
958 (hs-show-all))))
960 ;;;###autoload
961 (defun turn-off-hideshow ()
962 "Unconditionally turn off `hs-minor-mode'."
963 (hs-minor-mode -1))
965 ;;---------------------------------------------------------------------------
966 ;; that's it
968 (provide 'hideshow)
970 ;;; hideshow.el ends here