1 ;;; hideshow.el --- minor mode cmds to selectively display blocks of code
3 ;; Copyright (C) 1994,1995,1996 Free Software Foundation
5 ;; Author: Thien-Thi Nguyen <ttn@netcom.com>
7 ;; Keywords: C C++ lisp tools editing
8 ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
28 ;; hideshow|Thien-Thi Nguyen|ttn@netcom.com|
29 ;; minor mode commands to selectively display blocks of code|
30 ;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z|
34 ;; This file provides `hs-minor-mode'. When active, six commands:
35 ;; hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode
36 ;; are available. They implement block hiding and showing. Blocks are
37 ;; defined in mode-specific way. In c-mode or c++-mode, they are simply
38 ;; curly braces, while in lisp-ish modes they are parens. Multi-line
39 ;; comments (c-mode) can also be hidden. The command M-x hs-minor-mode
40 ;; toggles the minor mode or sets it (similar to outline minor mode).
41 ;; See documentation for each command for more info.
43 ;; The variable `hs-unbalance-handler-method' controls hideshow's behavior
44 ;; in the case of "unbalanced parentheses". See doc for more info.
48 ;; (load-library "hideshow")
49 ;; (defun my-hs-setup () "enables hideshow and binds some commands"
51 ;; (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block)
52 ;; (define-key hs-minor-mode-map "\C-cs" 'hs-show-block)
53 ;; (define-key hs-minro-mode-map "\C-cH" 'hs-hide-all)
54 ;; (define-key hs-minro-mode-map "\C-cS" 'hs-show-all)
55 ;; (define-key hs-minor-mode-map "\C-cR" 'hs-show-region))
56 ;; (add-hook 'X-mode-hook 'my-hs-setup t) ; other modes similarly
58 ;; where X = {emacs-lisp,c,c++,perl,...}. See the doc for the variable
59 ;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes.
63 ;; Bug reports and fixes welcome (comments, too). Thanks go to
64 ;; Dean Andrews <adahome@ix.netcom.com>
65 ;; Preston F. Crow <preston.f.crow@dartmouth.edu>
66 ;; Gael Marziou <gael@gnlab030.grenoble.hp.com>
67 ;; Keith Sheffield <sheff@edcsgw2.cr.usgs.gov>
68 ;; Jan Djarv <jan.djarv@sa.erisoft.se>
69 ;; Lars Lindberg <qhslali@aom.ericsson.se>
70 ;; Alf-Ivar Holm <alfh@ifi.uio.no>
71 ;; for valuable feedback, code and bug reports.
76 ;;;----------------------------------------------------------------------------
77 ;;; user-configurable variables
79 (defvar hs-unbalance-handler-method 'top-level
80 "*Symbol representing how \"unbalanced parentheses\" should be handled.
81 This error is usually signaled by `hs-show-block'. One of four values:
82 `top-level', `next-line', `signal' or `ignore'. Default is `top-level'.
84 - `top-level' -- Show top-level block containing the currently troublesome
86 - `next-line' -- Use the fact that, for an already hidden block, its end
87 will be on the next line. Attempt to show this block.
88 - `signal' -- Pass the error through, stopping execution.
89 - `ignore' -- Ignore the error, continuing execution.
91 Values other than these four will be interpreted as `signal'.")
93 (defvar hs-special-modes-alist '((c-mode "{" "}")
95 "*Alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC).
96 If present, hideshow will use these values for the start and end regexps,
97 respectively. Since Algol-ish languages do not have single-character
98 block delimiters, the function `forward-sexp' which is used by hideshow
99 doesn't work. In this case, if a similar function is provided, you can
100 register it and have hideshow use it instead of `forward-sexp'. To add
103 \t(pushnew '(new-mode st-re end-re function-name)
104 \t hs-special-modes-alist :test 'equal)
108 \t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement)
109 \t hs-special-modes-alist :test 'equal)
111 Note that the regexps should not contain leading or trailing whitespace.")
113 (defvar hs-hide-hook nil
114 "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.")
116 (defvar hs-show-hook nil
117 "*Hooks called at the end of commands to show text.
118 These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.")
120 (defvar hs-minor-mode-prefix "\C-c"
121 "*Prefix key to use for hideshow commands in hideshow minor mode.")
124 ;;;----------------------------------------------------------------------------
125 ;;; internal variables
127 (defvar hs-minor-mode nil
128 "Non-nil if using hideshow mode as a minor mode of some other mode.
129 Use the command `hs-minor-mode' to toggle this variable.")
131 (defvar hs-minor-mode-map nil
132 "Mode map for hideshow minor mode.")
134 (defvar hs-menu-bar nil
135 "Menu bar for hideshow minor mode (Xemacs only).")
137 (defvar hs-c-start-regexp nil
138 "Regexp for beginning of comments. Buffer-local.
139 Differs from mode-specific comment regexps in that surrounding
140 whitespace is stripped.")
142 (defvar hs-c-end-regexp nil
143 "Regexp for end of comments. Buffer-local.
144 See `hs-c-start-regexp'.")
146 (defvar hs-block-start-regexp nil
147 "Regexp for beginning of block. Buffer-local.")
149 (defvar hs-block-end-regexp nil
150 "Regexp for end of block. Buffer-local.")
152 (defvar hs-forward-sexp-func 'forward-sexp
153 "Function used to do a forward-sexp. Should change for Algol-ish modes.
154 For single-character block delimiters -- ie, the syntax table regexp for the
155 character is either `(' or `)' -- `hs-forward-sexp-func' would just be
156 `forward-sexp'. For other modes such as simula, a more specialized function
159 (defvar hs-emacs-type 'fsf
160 "Used to support both FSF Emacs and Xemacs.")
163 (if (string-match "xemacs\\|lucid" emacs-version)
165 (defvar current-menubar nil "")
166 (defun set-buffer-menubar (arg1))
167 (defun add-menu (arg1 arg2 arg3)))))
170 ;;;----------------------------------------------------------------------------
173 ;; snarfed from outline.el, but added buffer-read-only
174 (defun hs-flag-region (from to flag)
175 "Hides or shows lines from FROM to TO, according to FLAG.
176 If FLAG is `?\\n' (the newline character) then show the text;
177 if FLAG is `?\\^M' \(control-M) then hide the text."
178 (let ((modp (buffer-modified-p))
179 buffer-read-only) ; nothing is immune
180 (unwind-protect (progn
181 (subst-char-in-region
183 (if (= flag ?\n) ?\C-m ?\n)
185 (set-buffer-modified-p modp))))
187 (defun hs-hide-block-at-point (&optional end)
188 "Hide block iff on block beginning, optional END means reposition at end."
189 (if (looking-at hs-block-start-regexp)
191 (q (progn (funcall hs-forward-sexp-func 1) (point))))
192 (forward-line -1) (end-of-line)
193 (if (and (< p (point)) (> (count-lines p q) 1))
194 (hs-flag-region p (point) ?\C-m))
195 (goto-char (if end q p)))))
197 (defun hs-show-block-at-point (&optional end)
198 "Show block iff on block beginning. Optional END means reposition at end."
199 (if (looking-at hs-block-start-regexp)
202 (condition-case error ; probably unbalanced paren
204 (funcall hs-forward-sexp-func 1)
208 ((eq hs-unbalance-handler-method 'ignore)
209 ;; just ignore this block
211 ((eq hs-unbalance-handler-method 'top-level)
212 ;; try to get out of rat's nest and expose the whole func
213 (if (/= (current-column) 0) (beginning-of-defun))
215 (re-search-forward (concat "^" hs-block-start-regexp)
218 ((eq hs-unbalance-handler-method 'next-line)
219 ;; assumption is that user knows what s/he's doing
220 (beginning-of-line) (setq p (point))
221 (end-of-line 2) (point))
223 ;; pass error through -- this applies to `signal', too
224 (signal (car error) (cdr error))))))))
225 (hs-flag-region p q ?\n)
226 (goto-char (if end (1+ (point)) p)))))
228 (defun hs-safety-is-job-n ()
229 "Warn if `selective-display' or `selective-display-ellipses' is nil."
231 (or selective-display
232 (setq str "selective-display nil "))
233 (or selective-display-ellipses
234 (setq str (concat str "selective-display-ellipses nil")))
235 (if (= (length str) 0)
237 (message "warning: %s" str)
240 (defun hs-inside-comment-p ()
241 "Returns non-nil if point is inside a comment, otherwise nil.
242 Actually, for multi-line-able comments, returns a list containing
243 the buffer position of the start and the end of the comment."
244 ;; is it single-line-only or multi-line-able?
248 (if (string= comment-end "") ; single line
251 (setq found (re-search-forward hs-c-start-regexp p t))
252 (and found (not (search-forward "\"" p t))))
253 (re-search-forward hs-c-end-regexp (point-max) 1)
256 (re-search-forward hs-c-start-regexp (point-max) 1)
257 (if (< (- (point) (length comment-start)) p)
258 (list (match-beginning 0) q))))))
260 (defun hs-grok-mode-type ()
261 "Setup variables for new buffers where applicable."
262 (if (and (boundp 'comment-start)
263 (boundp 'comment-end))
265 (setq hs-c-start-regexp (regexp-quote comment-start))
266 (if (string-match " +$" hs-c-start-regexp)
267 (setq hs-c-start-regexp
268 (substring hs-c-start-regexp 0 (1- (match-end 0)))))
269 (setq hs-c-end-regexp (if (string= "" comment-end) "\n"
270 (regexp-quote comment-end)))
271 (if (string-match "^ +" hs-c-end-regexp)
272 (setq hs-c-end-regexp
273 (substring hs-c-end-regexp (match-end 0))))
274 (let ((lookup (assoc major-mode hs-special-modes-alist)))
275 (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(")
276 hs-block-end-regexp (or (nth 2 lookup) "\\s\)")
277 hs-forward-sexp-func (or (nth 3 lookup) 'forward-sexp))))))
279 (defun hs-find-block-beginning ()
280 "Repositions point at block-start. Return point, or nil if top-level."
283 (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\("
284 hs-block-end-regexp "\\)")))
285 (while (and (not done)
286 (re-search-backward both-regexps (point-min) t))
287 (if (match-beginning 1) ; start of start-regexp
288 (setq done (match-beginning 1))
289 (goto-char (match-end 2)) ; end of end-regexp
290 (funcall hs-forward-sexp-func -1)))
291 (goto-char (or done here))
294 (defmacro hs-life-goes-on (&rest body)
295 "Executes optional BODY iff variable `hs-minor-mode' is non-nil."
296 (list 'if 'hs-minor-mode (cons 'progn body)))
299 ;;;----------------------------------------------------------------------------
303 (defun hs-hide-all ()
304 "Hides all top-level blocks, displaying only first and last lines.
305 It moves point to the beginning of the line, and it runs the normal hook
306 `hs-hide-hook'. See documentation for `run-hooks'."
309 (message "hiding all blocks ...")
311 (hs-flag-region (point-min) (point-max) ?\n) ; eliminate weirdness
312 (goto-char (point-min))
314 (top-level-re (concat "^" hs-block-start-regexp)))
316 (forward-comment (buffer-size))
317 (re-search-forward top-level-re (point-max) t))
318 (goto-char (match-beginning 0))
319 (hs-hide-block-at-point t)
320 (message "hiding ... %d" (setq count (1+ count)))))
321 (hs-safety-is-job-n))
323 (message "hiding all blocks ... done")
324 (run-hooks 'hs-hide-hook)))
326 (defun hs-show-all ()
327 "Shows all top-level blocks.
328 This does not change point; it runs the normal hook `hs-show-hook'.
329 See documentation for `run-hooks'."
332 (message "showing all blocks ...")
333 (hs-flag-region (point-min) (point-max) ?\n)
334 (message "showing all blocks ... done")
335 (run-hooks 'hs-show-hook)))
338 (defun hs-hide-block (&optional end)
339 "Selects a block and hides it. With prefix arg, reposition at end.
340 Block is defined as a sexp for lispish modes, mode-specific otherwise.
341 Comments are blocks, too. Upon completion, point is at repositioned and
342 the normal hook `hs-hide-hook' is run. See documentation for `run-hooks'."
345 (let ((c-reg (hs-inside-comment-p)))
347 (cond ((string= comment-end "")
348 (message "can't hide a single-line comment"))
349 ((< (count-lines (car c-reg) (nth 1 c-reg)) 2)
350 (message "not enough comment lines to hide"))
352 (goto-char (nth 1 c-reg))
354 (hs-flag-region (car c-reg) (point) ?\C-m)
355 (goto-char (if end (nth 1 c-reg) (car c-reg)))
357 (run-hooks 'hs-hide-hook)))
358 (if (or (looking-at hs-block-start-regexp)
359 (hs-find-block-beginning))
361 (hs-hide-block-at-point end)
363 (run-hooks 'hs-hide-hook)))))))
365 (defun hs-show-block (&optional end)
366 "Selects a block and shows it. With prefix arg, reposition at end.
367 Upon completion, point is repositioned and the normal hook
368 `hs-show-hook' is run. See documentation for `hs-hide-block' and `run-hooks'."
371 (let ((c-reg (hs-inside-comment-p)))
373 (cond ((string= comment-end "")
374 (message "already looking at the entire comment"))
376 (hs-flag-region (car c-reg) (nth 1 c-reg) ?\n)
377 (goto-char (if end (nth 1 c-reg) (car c-reg)))))
378 (if (or (looking-at hs-block-start-regexp)
379 (hs-find-block-beginning))
381 (hs-show-block-at-point end)
383 (run-hooks 'hs-show-hook)))))))
385 (defun hs-show-region (beg end)
386 "Shows all lines from BEG to END, without doing any block analysis.
387 Note:` hs-show-region' is intended for use when when `hs-show-block' signals
388 `unbalanced parentheses' and so is an emergency measure only. You may
389 become very confused if you use this command indiscriminately."
392 (hs-flag-region beg end ?\n)
394 (run-hooks 'hs-show-hook)))
397 (defun hs-minor-mode (&optional arg)
398 "Toggle hideshow minor mode.
399 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
400 When hideshow minor mode is on, the menu bar is augmented with hideshow
401 commands and the hideshow commands are enabled. The variables
402 `selective-display' and `selective-display-ellipses' are set to t.
403 Last, the normal hook `hs-minor-mode-hook' is run; see the doc for `run-hooks'.
405 Turning hideshow minor mode off reverts the menu bar and the
406 variables to default values and disables the hideshow commands."
411 (> (prefix-numeric-value arg) 0)))
414 (if (eq hs-emacs-type 'lucid)
416 (set-buffer-menubar (copy-sequence current-menubar))
417 (add-menu nil (car hs-menu-bar) (cdr hs-menu-bar))))
418 (setq selective-display t
419 selective-display-ellipses t)
421 (run-hooks 'hs-minor-mode-hook))
422 (if (eq hs-emacs-type 'lucid)
423 (set-buffer-menubar (delete hs-menu-bar current-menubar)))
424 (kill-local-variable 'selective-display)
425 (kill-local-variable 'selective-display-ellipses)))
428 ;;;----------------------------------------------------------------------------
429 ;;; load-time setup routines
431 ;; which emacs being used?
433 (if (string-match "xemacs\\|lucid" emacs-version)
438 (if (not hs-minor-mode-map)
439 (setq hs-minor-mode-map (make-sparse-keymap))
441 ((eq hs-emacs-type 'lucid)
442 (setq hs-menu-bar ; build top down for lucid
444 ["Hide Block" hs-hide-block t]
445 ["Show Block" hs-show-block t]
446 ["Hide All" hs-hide-all t]
447 ["Show All" hs-show-all t]
448 ["Show Region" hs-show-region t])))
449 (t ; build bottom up for others
450 (define-key hs-minor-mode-map [menu-bar hideshow]
451 (cons "hideshow" (make-sparse-keymap "hideshow")))
452 (define-key hs-minor-mode-map [menu-bar hideshow hs-show-region]
453 '("Show Region" . hs-show-region))
454 (define-key hs-minor-mode-map [menu-bar hideshow hs-show-all]
455 '("Show All" . hs-show-all))
456 (define-key hs-minor-mode-map [menu-bar hideshow hs-hide-all]
457 '("Hide All" . hs-hide-all))
458 (define-key hs-minor-mode-map [menu-bar hideshow hs-show-block]
459 '("Show Block" . hs-show-block))
460 (define-key hs-minor-mode-map [menu-bar hideshow hs-hide-block]
461 '("Hide Block" . hs-hide-block)))))
464 (or (assq 'hs-minor-mode minor-mode-map-alist)
465 (setq minor-mode-map-alist
466 (cons (cons 'hs-minor-mode hs-minor-mode-map)
467 minor-mode-map-alist)))
468 (or (assq 'hs-minor-mode minor-mode-alist)
469 (setq minor-mode-alist (append minor-mode-alist
470 (list '(hs-minor-mode " hs")))))
472 ;; make some variables buffer-local
473 (make-variable-buffer-local 'hs-minor-mode)
474 (make-variable-buffer-local 'hs-c-start-regexp)
475 (make-variable-buffer-local 'hs-c-end-regexp)
476 (make-variable-buffer-local 'hs-block-start-regexp)
477 (make-variable-buffer-local 'hs-block-end-regexp)
478 (make-variable-buffer-local 'hs-forward-sexp-func)
479 (put 'hs-minor-mode 'permanent-local t)
480 (put 'hs-c-start-regexp 'permanent-local t)
481 (put 'hs-c-end-regexp 'permanent-local t)
482 (put 'hs-block-start-regexp 'permanent-local t)
483 (put 'hs-block-end-regexp 'permanent-local t)
484 (put 'hs-forward-sexp-func 'permanent-local t)
487 ;;;----------------------------------------------------------------------------
492 ;;; hideshow.el ends here