1 ;;; hideshow.el --- minor mode cmds to selectively display blocks of code
3 ;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation
5 ;; Author: Thien-Thi Nguyen <ttn@netcom.com>
6 ;; Maintainer: Dan Nicolaescu <done@ece.arizona.edu>
8 ;; Keywords: C C++ java lisp tools editing comments blocks hiding
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 2, or (at your option)
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; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
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|
35 ;; This file provides `hs-minor-mode'. When active, six commands:
36 ;; hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode
37 ;; are available. They implement block hiding and showing. Blocks are
38 ;; defined in mode-specific way. In c-mode or c++-mode, they are simply
39 ;; curly braces, while in lisp-ish modes they are parens. Multi-line
40 ;; comments (c-mode) can also be hidden. The command M-x hs-minor-mode
41 ;; toggles the minor mode or sets it (similar to outline minor mode).
42 ;; See documentation for each command for more info.
44 ;; The variable `hs-unbalance-handler-method' controls hideshow's behavior
45 ;; in the case of "unbalanced parentheses". See doc for more info.
49 ;; (load-library "hideshow")
50 ;; (add-hook 'X-mode-hook 'hs-minor-mode) ; other modes similarly
52 ;; 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.
57 ;; Bug reports and fixes welcome (comments, too). Thanks go to
58 ;; Dean Andrews <adahome@ix.netcom.com>
59 ;; Preston F. Crow <preston.f.crow@dartmouth.edu>
60 ;; Gael Marziou <gael@gnlab030.grenoble.hp.com>
61 ;; Keith Sheffield <sheff@edcsgw2.cr.usgs.gov>
62 ;; Jan Djarv <jan.djarv@sa.erisoft.se>
63 ;; Lars Lindberg <qhslali@aom.ericsson.se>
64 ;; Alf-Ivar Holm <alfh@ifi.uio.no>
65 ;; for valuable feedback, code and bug reports.
70 ;;;----------------------------------------------------------------------------
71 ;;; user-configurable variables
73 (defvar hs-unbalance-handler-method
'top-level
74 "*Symbol representing how \"unbalanced parentheses\" should be handled.
75 This error is usually signaled by `hs-show-block'. One of four values:
76 `top-level', `next-line', `signal' or `ignore'. Default is `top-level'.
78 - `top-level' -- Show top-level block containing the currently troublesome
80 - `next-line' -- Use the fact that, for an already hidden block, its end
81 will be on the next line. Attempt to show this block.
82 - `signal' -- Pass the error through, stopping execution.
83 - `ignore' -- Ignore the error, continuing execution.
85 Values other than these four will be interpreted as `signal'.")
88 (defvar hs-special-modes-alist
91 (java-mode "\\(\\(public\\|private\\|protected\\|static\\|\\s-\\)+\\([a-zA-Z0-9_:]+[ \t]+\\)\\([a-zA-Z0-9_:]+\\)[ \t]*([^)]*)[ \t\n]*\\([ \t\n]throws[ \t]+[^{]+\\)*[ \t]*\\){" "}" java-hs-forward-sexp
))
92 "*Alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC).
93 If present, hideshow will use these values for the start and end regexps,
94 respectively. Since Algol-ish languages do not have single-character
95 block delimiters, the function `forward-sexp' which is used by hideshow
96 doesn't work. In this case, if a similar function is provided, you can
97 register it and have hideshow use it instead of `forward-sexp'. To add
100 \t(pushnew '(new-mode st-re end-re function-name)
101 \t hs-special-modes-alist :test 'equal)
105 \t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement)
106 \t hs-special-modes-alist :test 'equal)
108 Note that the regexps should not contain leading or trailing whitespace.")
110 (defvar hs-minor-mode-hook
'hs-hide-initial-comment-block
111 "Hook called when `hs-minor-mode' is installed.
112 A good value for this would be `hs-hide-initial-comment-block' to
113 hide all the comments at the beginning of the file.")
115 (defvar hs-hide-hook nil
116 "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.")
118 (defvar hs-show-hook nil
119 "*Hooks called at the end of commands to show text.
120 These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.")
122 (defvar hs-minor-mode-prefix
"\C-c"
123 "*Prefix key to use for hideshow commands in hideshow minor mode.")
126 ;;;----------------------------------------------------------------------------
127 ;;; internal variables
129 (defvar hs-minor-mode nil
130 "Non-nil if using hideshow mode as a minor mode of some other mode.
131 Use the command `hs-minor-mode' to toggle this variable.")
133 (defvar hs-minor-mode-map nil
134 "Mode map for hideshow minor mode.")
136 (defvar hs-menu-bar nil
137 "Menu bar for hideshow minor mode (Xemacs only).")
139 (defvar hs-c-start-regexp nil
140 "Regexp for beginning of comments.
141 Differs from mode-specific comment regexps in that
142 surrounding whitespace is stripped.")
144 (defvar hs-c-end-regexp nil
145 "Regexp for end of comments.
146 See `hs-c-start-regexp'.")
148 (defvar hs-block-start-regexp nil
149 "Regexp for beginning of block.")
151 (defvar hs-block-end-regexp nil
152 "Regexp for end of block.")
154 (defvar hs-forward-sexp-func
'forward-sexp
155 "Function used to do a forward-sexp.
156 Should change for Algol-ish modes. For single-character block
157 delimiters -- ie, the syntax table regexp for the character is
158 either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'.
159 For other modes such as simula, a more specialized function
162 (defvar hs-hide-comments-when-hiding-all t
163 "Hide the comments too when you do an `hs-hide-all'." )
165 ;(defvar hs-emacs-type 'fsf
166 ; "Used to support both Emacs and Xemacs.")
169 ; (if (string-match "xemacs\\|lucid" emacs-version)
171 ; (defvar current-menubar nil "")
172 ; (defun set-buffer-menubar (arg1))
173 ; (defun add-menu (arg1 arg2 arg3)))))
175 ;;;----------------------------------------------------------------------------
178 ;; snarfed from noutline.el;
179 (defun hs-flag-region (from to flag
)
180 "Hides or shows lines from FROM to TO, according to FLAG.
181 If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
185 (hs-discard-overlays (point) to
'invisible
'hs
)
187 (let ((overlay (make-overlay (point) to
)))
188 ;; Make overlay hidden and intangible.
189 (overlay-put overlay
'invisible
'hs
)
190 (overlay-put overlay
'hs t
)
191 (overlay-put overlay
'intangible t
)))))
193 ;; Remove from the region BEG ... END all overlays
194 ;; with a PROP property equal to VALUE.
195 ;; Overlays with a PROP property different from VALUE are not touched.
196 (defun hs-discard-overlays (beg end prop value
)
198 (setq beg
(prog1 end
(setq end beg
))))
201 (while (< (point) end
)
202 (let ((overlays (overlays-at (point))))
204 (let ((o (car overlays
)))
205 (if (eq (overlay-get o prop
) value
)
207 (and (> (overlay-end o
) beg
) (< (overlay-end o
) end
))
208 (and (< (overlay-start o
) beg
) (< (overlay-start o
) end
)))
209 (delete-overlay o
))))
210 (setq overlays
(cdr overlays
))))
211 (goto-char (next-overlay-change (point))))))
213 (defun hs-hide-block-at-point (&optional end comment c-reg
)
214 "Hide block iff on block beginning, optional END means reposition at end.
215 COMMENT true means that it should hide a comment block, C-REG is a list
216 of the forme (BEGIN . END) and specifies the limits of the comment."
218 (let ((reg (if c-reg c-reg
(hs-inside-comment-p))))
219 (goto-char (nth 1 reg
))
222 (hs-flag-region (car reg
) (point) t
)
223 (goto-char (if end
(nth 1 reg
) (car reg
)))
225 (if (looking-at hs-block-start-regexp
)
227 (q (progn (funcall hs-forward-sexp-func
1) (point))))
228 (forward-line -
1) (end-of-line)
229 (if (and (< p
(point)) (> (count-lines p q
) 1))
230 (hs-flag-region p
(point) t
))
231 (goto-char (if end q p
))))))
233 (defun hs-show-block-at-point (&optional end
)
234 "Show block iff on block beginning. Optional END means reposition at end."
235 (if (looking-at hs-block-start-regexp
)
238 (condition-case error
; probably unbalanced paren
240 (funcall hs-forward-sexp-func
1)
244 ((eq hs-unbalance-handler-method
'ignore
)
245 ;; just ignore this block
247 ((eq hs-unbalance-handler-method
'top-level
)
248 ;; try to get out of rat's nest and expose the whole func
249 (if (/= (current-column) 0) (beginning-of-defun))
251 (re-search-forward (concat "^" hs-block-start-regexp
)
254 ((eq hs-unbalance-handler-method
'next-line
)
255 ;; assumption is that user knows what s/he's doing
256 (beginning-of-line) (setq p
(point))
257 (end-of-line 2) (point))
259 ;; pass error through -- this applies to `signal', too
260 (signal (car error
) (cdr error
))))))))
261 (hs-flag-region p q nil
)
262 (goto-char (if end
(1+ (point)) p
)))))
264 (defun hs-safety-is-job-n ()
265 "Warn `buffer-invisibility-spec' does not contain hs."
266 (if (or buffer-invisibility-spec
(assq hs buffer-invisibility-spec
) )
268 (message "Warning: `buffer-invisibility-spec' does not contain hs!!")
271 (defun hs-hide-initial-comment-block ()
273 "Hides the first block of comments in a file.
274 The best usage is in `hs-minor-mode-hook', it hides all the comments at the
275 file beginning, so if you have huge RCS logs you won't see them!"
278 (goto-char (point-min))
279 (skip-chars-forward " \t\n")
280 (setq c-reg
(hs-inside-comment-p))
281 (if (and c-reg
(> (count-lines (car c-reg
) (nth 1 c-reg
)) 2))
285 (defun hs-inside-single-line-comment-p ()
286 "Look to see if we are on a single line comment."
289 (looking-at (concat "^[ \t]*" hs-c-start-regexp
))))
291 (defun hs-inside-comment-p ()
292 "Returns non-nil if point is inside a comment, otherwise nil.
293 Actually, returns a list containing the buffer position of the start
294 and the end of the comment."
299 (if (string= comment-end
"") ; single line
300 (if (not (hs-inside-single-line-comment-p))
302 ;;find-beginning-of-the-chained-single-line-comments
304 (forward-comment (- (buffer-size)))
305 (skip-chars-forward " \t\n")
309 ;;find-end-of-the-chained-single-line-comments
310 (forward-comment (buffer-size))
311 (skip-chars-backward " \t\n")
313 (re-search-forward hs-c-end-regexp
(point-max) 1)
314 (forward-comment (buffer-size))
315 (skip-chars-backward " \t\n")
318 (forward-comment (- 0 (buffer-size)))
319 (re-search-forward hs-c-start-regexp
(point-max) 1)
320 (setq p-aux
(- (point) (length comment-start
)))
321 (if (and (>= p-aux
0) (< p-aux p
))
322 (list (match-beginning 0) q
))))))
324 (defun hs-grok-mode-type ()
325 "Setup variables for new buffers where applicable."
326 (if (and (boundp 'comment-start
)
327 (boundp 'comment-end
))
329 (setq hs-c-start-regexp
(regexp-quote comment-start
))
330 (if (string-match " +$" hs-c-start-regexp
)
331 (setq hs-c-start-regexp
332 (substring hs-c-start-regexp
0 (1- (match-end 0)))))
333 (setq hs-c-end-regexp
(if (string= "" comment-end
) "\n"
334 (regexp-quote comment-end
)))
335 (if (string-match "^ +" hs-c-end-regexp
)
336 (setq hs-c-end-regexp
337 (substring hs-c-end-regexp
(match-end 0))))
338 (let ((lookup (assoc major-mode hs-special-modes-alist
)))
339 (setq hs-block-start-regexp
(or (nth 1 lookup
) "\\s\(")
340 hs-block-end-regexp
(or (nth 2 lookup
) "\\s\)")
341 hs-forward-sexp-func
(or (nth 3 lookup
) 'forward-sexp
))))))
343 (defun hs-find-block-beginning ()
344 "Repositions point at block-start.
345 Return point, or nil if top-level."
348 (both-regexps (concat "\\(" hs-block-start-regexp
"\\)\\|\\("
349 hs-block-end-regexp
"\\)")))
350 (while (and (not done
)
351 (re-search-backward both-regexps
(point-min) t
))
352 (if (match-beginning 1) ; start of start-regexp
353 (setq done
(match-beginning 1))
354 (goto-char (match-end 2)) ; end of end-regexp
355 (funcall hs-forward-sexp-func -
1)))
356 (goto-char (or done here
))
359 (defmacro hs-life-goes-on
(&rest body
)
360 "Executes optional BODY iff variable `hs-minor-mode' is non-nil."
361 (list 'if
'hs-minor-mode
(cons 'progn body
)))
363 (defun hs-already-hidden-p ()
364 "Return non-nil if point is in an already-hidden block otherwise nil."
367 (let ((overlays (overlays-at (point)))
369 (while (and (not found
) (overlayp (car overlays
)))
370 (setq found
(overlay-get (car overlays
) 'hs
)
371 overlays
(cdr overlays
)))
374 (defun java-hs-forward-sexp (arg)
375 "Function used by `hs-minor-mode' for `forward-sexp' in Java mode."
378 (if (looking-at hs-block-start-regexp
)
380 (goto-char (match-end 0))
385 ;;;----------------------------------------------------------------------------
389 (defun hs-hide-all ()
390 "Hides all top-level blocks, displaying only first and last lines.
391 It moves point to the beginning of the line, and it runs the normal hook
392 `hs-hide-hook'. See documentation for `run-hooks'.
393 If `hs-hide-comments-when-hiding-all' is t also hides the comments."
396 (message "Hiding all blocks ...")
398 (hs-flag-region (point-min) (point-max) nil
) ; eliminate weirdness
399 (goto-char (point-min))
400 (if hs-hide-comments-when-hiding-all
402 (block-and-comment-re ;; this should match
403 (concat "\\(^" ;; the block beginning and comment start
404 hs-block-start-regexp
405 "\\)\\|\\(" hs-c-start-regexp
"\\)")))
406 (while (re-search-forward block-and-comment-re
(point-max) t
)
407 (if (match-beginning 1) ;; we have found a block beginning
409 (goto-char (match-beginning 1))
410 (hs-hide-block-at-point t
)
411 (message "Hiding ... %d" (setq count
(1+ count
))))
413 (setq c-reg
(hs-inside-comment-p))
416 (goto-char (nth 1 c-reg
))
417 (if (> (count-lines (car c-reg
) (nth 1 c-reg
)) 2)
419 (hs-hide-block-at-point t t c-reg
)
420 (message "Hiding ... %d"
421 (setq count
(1+ count
))))))))))
423 (top-level-re (concat "^" hs-block-start-regexp
)))
426 (forward-comment (buffer-size))
427 (re-search-forward top-level-re
(point-max) t
))
428 (goto-char (match-beginning 0))
429 (hs-hide-block-at-point t
)
430 (message "Hiding ... %d" (setq count
(1+ count
))))))
431 (hs-safety-is-job-n))
433 (message "Hiding all blocks ... done")
434 (run-hooks 'hs-hide-hook
)))
436 (defun hs-show-all ()
437 "Shows all top-level blocks.
438 This does not change point; it runs the normal hook `hs-show-hook'.
439 See documentation for `run-hooks'."
442 (message "Showing all blocks ...")
443 (hs-flag-region (point-min) (point-max) nil
)
444 (message "Showing all blocks ... done")
445 (run-hooks 'hs-show-hook
)))
447 (defun hs-hide-block (&optional end
)
448 "Selects a block and hides it.
449 With prefix arg, reposition at end. Block is defined as a sexp for
450 lispish modes, mode-specific otherwise. Comments are blocks, too.
451 Upon completion, point is at repositioned and the normal hook
452 `hs-hide-hook' is run. See documentation for `run-hooks'."
455 (let ((c-reg (hs-inside-comment-p)))
458 ((<= (count-lines (car c-reg
) (nth 1 c-reg
)) 2)
459 (message "Not enough comment lines to hide!"))
461 (goto-char (nth 1 c-reg
))
462 (hs-hide-block-at-point end t c-reg
)
464 (run-hooks 'hs-hide-hook
)))
465 (if (or (looking-at hs-block-start-regexp
)
466 (hs-find-block-beginning))
468 (hs-hide-block-at-point end
)
470 (run-hooks 'hs-hide-hook
)))))))
472 (defun hs-show-block (&optional end
)
473 "Selects a block and shows it.
474 With prefix arg, reposition at end. Upon completion, point is
475 repositioned and the normal hook `hs-show-hook' is run.
476 See documentation for `hs-hide-block' and `run-hooks'."
479 (let ((c-reg (hs-inside-comment-p)))
482 (hs-flag-region (car c-reg
) (nth 1 c-reg
) nil
)
484 (goto-char (if end
(nth 1 c-reg
) (car c-reg
))))
485 (if (or (looking-at hs-block-start-regexp
)
486 (hs-find-block-beginning))
488 (hs-show-block-at-point end
)
490 (run-hooks 'hs-show-hook
)))))))
492 (defun hs-show-region (beg end
)
493 "Shows all lines from BEG to END, without doing any block analysis.
494 Note:`hs-show-region' is intended for use when `hs-show-block' signals
495 `unbalanced parentheses' and so is an emergency measure only. You may
496 become very confused if you use this command indiscriminately."
499 (hs-flag-region beg end nil
)
501 (run-hooks 'hs-show-hook
)))
504 (defun hs-mouse-toggle-hiding (e)
505 "Toggles hiding/showing of a block.
506 Should be bound to a mouse key."
509 (if (hs-already-hidden-p)
514 (defun hs-minor-mode (&optional arg
)
515 "Toggle hideshow minor mode.
516 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
517 When hideshow minor mode is on, the menu bar is augmented with hideshow
518 commands and the hideshow commands are enabled. The variables
519 `selective-display' and `selective-display-ellipses' are set to t.
520 Last, the normal hook `hs-minor-mode-hook' is run; see the doc
523 Turning hideshow minor mode off reverts the menu bar and the
524 variables to default values and disables the hideshow commands."
529 (> (prefix-numeric-value arg
) 0)))
532 ; (if (eq hs-emacs-type 'lucid)
534 ; (set-buffer-menubar (copy-sequence current-menubar))
535 ; (add-menu nil (car hs-menu-bar) (cdr hs-menu-bar))))
536 (make-variable-buffer-local 'line-move-ignore-invisible
)
537 (setq line-move-ignore-invisible t
)
538 (add-to-invisibility-spec '(hs . t
)) ;;hs invisible
540 (run-hooks 'hs-minor-mode-hook
))
541 ; (if (eq hs-emacs-type 'lucid)
542 ; (set-buffer-menubar (delete hs-menu-bar current-menubar)))
543 (remove-from-invisibility-spec '(hs . t
))))
546 ;;;----------------------------------------------------------------------------
547 ;;; load-time setup routines
549 ;; which emacs being used?
551 ; (if (string-match "xemacs\\|lucid" emacs-version)
556 (if hs-minor-mode-map
558 (setq hs-minor-mode-map
(make-sparse-keymap))
559 ;; I beleive there is nothing bound on this keys
560 (define-key hs-minor-mode-map
"\C-ch" 'hs-hide-block
)
561 (define-key hs-minor-mode-map
"\C-cs" 'hs-show-block
)
562 (define-key hs-minor-mode-map
"\C-cH" 'hs-hide-all
)
563 (define-key hs-minor-mode-map
"\C-cS" 'hs-show-all
)
564 (define-key hs-minor-mode-map
"\C-cR" 'hs-show-region
)
566 (define-key hs-minor-mode-map
[S-mouse-2
] 'hs-mouse-toggle-hiding
)
568 ;; should we use easymenu here?
569 (define-key hs-minor-mode-map
[menu-bar Hide
/Show
]
570 (cons "Hide/Show" (make-sparse-keymap "Hide/Show")))
571 (define-key hs-minor-mode-map
[menu-bar Hide
/Show hs-show-region
]
572 '("Show Region" . hs-show-region
))
573 (define-key hs-minor-mode-map
[menu-bar Hide
/Show hs-show-all
]
574 '("Show All" . hs-show-all
))
575 (define-key hs-minor-mode-map
[menu-bar Hide
/Show hs-hide-all
]
576 '("Hide All" . hs-hide-all
))
577 (define-key hs-minor-mode-map
[menu-bar Hide
/Show hs-show-block
]
578 '("Show Block" . hs-show-block
))
579 (define-key hs-minor-mode-map
[menu-bar Hide
/Show hs-hide-block
]
580 '("Hide Block" . hs-hide-block
))
584 (or (assq 'hs-minor-mode minor-mode-map-alist
)
585 (setq minor-mode-map-alist
586 (cons (cons 'hs-minor-mode hs-minor-mode-map
)
587 minor-mode-map-alist
)))
588 (or (assq 'hs-minor-mode minor-mode-alist
)
589 (setq minor-mode-alist
(append minor-mode-alist
590 (list '(hs-minor-mode " hs")))))
592 ;; make some variables buffer-local
593 (make-variable-buffer-local 'hs-minor-mode
)
594 (make-variable-buffer-local 'hs-c-start-regexp
)
595 (make-variable-buffer-local 'hs-c-end-regexp
)
596 (make-variable-buffer-local 'hs-block-start-regexp
)
597 (make-variable-buffer-local 'hs-block-end-regexp
)
598 (make-variable-buffer-local 'hs-forward-sexp-func
)
599 (put 'hs-minor-mode
'permanent-local t
)
600 (put 'hs-c-start-regexp
'permanent-local t
)
601 (put 'hs-c-end-regexp
'permanent-local t
)
602 (put 'hs-block-start-regexp
'permanent-local t
)
603 (put 'hs-block-end-regexp
'permanent-local t
)
604 (put 'hs-forward-sexp-func
'permanent-local t
)
607 ;;;----------------------------------------------------------------------------
612 ;;; hideshow.el ends here