Mercurial > emacs
comparison lisp/progmodes/hideshow.el @ 10276:86c61b6bd265
Initial revision
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Tue, 27 Dec 1994 23:28:51 +0000 |
parents | |
children | 88926963f1ae |
comparison
equal
deleted
inserted
replaced
10275:0231c0d38918 | 10276:86c61b6bd265 |
---|---|
1 ;;; hideshow.el --- minor mode cmds to selectively display blocks of code | |
2 | |
3 ;;; Copyright (C) 1994,1995 Free Software Foundation | |
4 | |
5 ;;; Author: Thien-Thi Nguyen <ttn@netcom.com> | |
6 ;;; Version: 3.4 | |
7 ;;; Keywords: C C++ lisp tools editing | |
8 ;;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning | |
9 | |
10 ;;; This file is part of GNU Emacs. | |
11 | |
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify it | |
13 ;;; under the terms of the GNU General Public License as published by the | |
14 ;;; Free Software Foundation; either version 2 of the License, or (at your | |
15 ;;; option) any later version. | |
16 ;;; | |
17 ;;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT | |
18 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
19 ;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
20 ;;; for more details. | |
21 ;;; | |
22 ;;; You should have received a copy of the GNU General Public License along | |
23 ;;; with this program; if not, write to the Free Software Foundation, Inc., | |
24 ;;; 675 Mass Ave, Cambridge, MA 02139, USA. | |
25 | |
26 ;;; LCD Archive Entry: | |
27 ;;; hideshow|Thien-Thi Nguyen|ttn@netcom.com| | |
28 ;;; minor mode commands to selectively display blocks of code| | |
29 ;;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z| | |
30 | |
31 ;;; Commentary: | |
32 | |
33 ;;; this file provides `hs-minor-mode'. when active, six commands: | |
34 ;;; hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode | |
35 ;;; are available. they implement block hiding and showing. blocks are | |
36 ;;; defined in mode-specific way. in c-mode or c++-mode, they are simply | |
37 ;;; curly braces, while in lisp-ish modes they are parens. multi-line | |
38 ;;; comments (c-mode) can also be hidden. the command M-x hs-minor-mode | |
39 ;;; toggles the minor mode or sets it (similar to outline minor mode). | |
40 ;;; see documentation for each command for more info. | |
41 ;;; | |
42 ;;; the variable `hs-unbalance-handler-method' controls hideshow's behavior | |
43 ;;; in the case of "unbalanced parentheses". see doc for more info. | |
44 | |
45 ;;; suggested usage: | |
46 | |
47 ;;; (load-library "hideshow") | |
48 ;;; (defun my-hs-setup () "enables hideshow and binds some commands" | |
49 ;;; (hs-minor-mode 1) | |
50 ;;; (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block) | |
51 ;;; (define-key hs-minor-mode-map "\C-cs" 'hs-show-block) | |
52 ;;; (define-key hs-minor-mode-map "\C-cr" 'hs-show-region)) | |
53 ;;; (add-hook 'X-mode-hook 'my-hs-setup t) ; other modes similarly | |
54 ;;; | |
55 ;;; where X = {emacs-lisp,c,c++,perl,...}. see the doc for the variable | |
56 ;;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes. | |
57 | |
58 ;;; etc: | |
59 | |
60 ;;; bug reports and fixes welcome (comments, too). thanks go to | |
61 ;;; Dean Andrews <adahome@ix.netcom.com> | |
62 ;;; Preston F. Crow <preston.f.crow@dartmouth.edu> | |
63 ;;; Gael Marziou <gael@gnlab030.grenoble.hp.com> | |
64 ;;; Keith Sheffield <sheff@edcsgw2.cr.usgs.gov> | |
65 ;;; Jan Djarv <jan.djarv@sa.erisoft.se> | |
66 ;;; Lars Lindberg <qhslali@aom.ericsson.se> | |
67 ;;; Alf-Ivar Holm <alfh@ifi.uio.no> | |
68 ;;; for valuable feedback and bug reports. | |
69 | |
70 ;;; Code: | |
71 | |
72 | |
73 ;;;---------------------------------------------------------------------------- | |
74 ;;; dependencies | |
75 | |
76 ; (require 'emacs-vers) ; support different emacs flavors | |
77 (require 'cl) ; common lisp package | |
78 | |
79 | |
80 ;;;---------------------------------------------------------------------------- | |
81 ;;; user-configurable variables | |
82 | |
83 (defvar hs-unbalance-handler-method 'top-level | |
84 "*symbol representing how \"unbalanced parentheses\" should be handled. | |
85 this error is usually signalled by hs-show-block. one of four values: | |
86 `top-level', `next-line', `signal' or `ignore'. default is `top-level'. | |
87 | |
88 - `top-level' -- show top-level block containing the currently troublesome | |
89 block. | |
90 - `next-line' -- use the fact that, for an already hidden block, its end | |
91 will be on the next line. attempt to show this block. | |
92 - `signal' -- pass the error through, stopping execution. | |
93 - `ignore' -- ignore the error, continuing execution. | |
94 | |
95 values other than these four will be interpreted as `signal'.") | |
96 | |
97 (defvar hs-special-modes-alist '((c-mode "{" "}") | |
98 (c++-mode "{" "}")) | |
99 "*alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC). | |
100 if present, hideshow will use these values for the start and end regexps, | |
101 respectively. since algol-ish languages do not have single-character | |
102 block delimiters, the function `forward-sexp' which is used by hideshow | |
103 doesn't work. in this case, if a similar function is provided, you can | |
104 register it and have hideshow use it instead of `forward-sexp'. to add | |
105 more values, use | |
106 | |
107 \t(pushnew '(new-mode st-re end-re function-name) | |
108 \t hs-special-modes-alist :test 'equal) | |
109 | |
110 for example: | |
111 | |
112 \t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement) | |
113 \t hs-special-modes-alist :test 'equal) | |
114 | |
115 note that the regexps should not contain leading or trailing whitespace.") | |
116 | |
117 (defvar hs-hide-hooks nil | |
118 "*hooks called at the end of hs-hide-all and hs-hide-block.") | |
119 | |
120 (defvar hs-show-hooks nil | |
121 "*hooks called at the end of hs-show-all, hs-show-block and hs-show-region.") | |
122 | |
123 (defvar hs-minor-mode-prefix "\C-c" | |
124 "*prefix key to use for hideshow commands in hideshow minor mode.") | |
125 | |
126 | |
127 ;;;---------------------------------------------------------------------------- | |
128 ;;; internal variables | |
129 | |
130 (defvar hs-minor-mode nil | |
131 "non-nil if using hideshow mode as a minor mode of some other mode. | |
132 use the command `hs-minor-mode' to toggle this variable.") | |
133 | |
134 (defvar hs-minor-mode-map nil | |
135 "mode map for hideshow minor mode.") | |
136 | |
137 (defvar hs-menu-bar nil | |
138 "menu bar for hideshow minor mode (xemacs only).") | |
139 | |
140 (defvar hs-c-start-regexp nil | |
141 "regexp for beginning of comments. buffer-local. | |
142 differs from mode-specific comment regexps in that surrounding | |
143 whitespace is stripped.") | |
144 | |
145 (defvar hs-c-end-regexp nil | |
146 "regexp for end of comments. buffer-local. | |
147 see `hs-c-start-regexp'.") | |
148 | |
149 (defvar hs-block-start-regexp nil | |
150 "regexp for beginning of block. buffer-local.") | |
151 | |
152 (defvar hs-block-end-regexp nil | |
153 "regexp for end of block. buffer-local.") | |
154 | |
155 (defvar hs-forward-sexp-func 'forward-sexp | |
156 "function used to do a forward-sexp. should change for algol-ish modes. | |
157 for single-character block delimiters -- ie, the syntax table regexp for the | |
158 character is either ( or ) -- `hs-forward-sexp-func' would just be | |
159 `forward-sexp'. for other modes such as simula, a more specialized function | |
160 is necessary.") | |
161 | |
162 ; (eval-when-compile ; lint free! | |
163 ; (unless (emacs-type-eq 'lucid) | |
164 ; (defvar current-menubar nil "") | |
165 ; (defun set-buffer-menubar (arg1)) | |
166 ; (defun add-menu (arg1 arg2 arg3)))) | |
167 | |
168 | |
169 ;;;---------------------------------------------------------------------------- | |
170 ;;; support funcs | |
171 | |
172 ;; snarfed from outline.el, but added buffer-read-only | |
173 (defun hs-flag-region (from to flag) | |
174 "hides or shows lines from FROM to TO, according to FLAG. | |
175 if FLAG is \\n (newline character) then text is shown, while if FLAG | |
176 is \\^M \(control-M) the text is hidden." | |
177 (let ((modp (buffer-modified-p)) | |
178 buffer-read-only) ; nothing is immune | |
179 (unwind-protect (progn | |
180 (subst-char-in-region | |
181 from to | |
182 (if (= flag ?\n) ?\C-m ?\n) | |
183 flag t)) | |
184 (set-buffer-modified-p modp)))) | |
185 | |
186 (defun hs-hide-block-at-point (&optional end) | |
187 "hide block iff on block beginning, optional END means reposition at end." | |
188 (when (looking-at hs-block-start-regexp) | |
189 (let* ((p (point)) | |
190 (q (progn (funcall hs-forward-sexp-func 1) (point)))) | |
191 (forward-line -1) (end-of-line) | |
192 (when (and (< p (point)) (> (count-lines p q) 1)) | |
193 (hs-flag-region p (point) ?\C-m)) | |
194 (goto-char (if end q p))))) | |
195 | |
196 (defun hs-show-block-at-point (&optional end) | |
197 "show block iff on block beginning. optional END means reposition at end." | |
198 (when (looking-at hs-block-start-regexp) | |
199 (let* ((p (point)) | |
200 (q | |
201 (condition-case error ; probably unbalanced paren | |
202 (progn | |
203 (funcall hs-forward-sexp-func 1) | |
204 (point)) | |
205 (error | |
206 (case hs-unbalance-handler-method | |
207 ('ignore | |
208 ;; just ignore this block | |
209 (point)) | |
210 ('top-level | |
211 ;; try to get out of rat's nest and expose the whole func | |
212 (unless (= (current-column) 0) (beginning-of-defun)) | |
213 (setq p (point)) | |
214 (re-search-forward (concat "^" hs-block-start-regexp) | |
215 (point-max) t 2) | |
216 (point)) | |
217 ('next-line | |
218 ;; assumption is that user knows what s/he's doing | |
219 (beginning-of-line) (setq p (point)) | |
220 (end-of-line 2) (point)) | |
221 (t | |
222 ;; pass error through -- this applies to `signal', too | |
223 (signal (car error) (cdr error)))))))) | |
224 (hs-flag-region p q ?\n) | |
225 (goto-char (if end (1+ (point)) p))))) | |
226 | |
227 (defun hs-safety-is-job-n () | |
228 "warns if selective-display or selective-display-ellipses is nil." | |
229 (let ((str "")) | |
230 (unless selective-display | |
231 (setq str "selective-display nil ")) | |
232 (unless selective-display-ellipses | |
233 (setq str (concat str "selective-display-ellipses nil"))) | |
234 (when (/= (length str) 0) | |
235 (message "warning: %s" str) | |
236 (sit-for 2)))) | |
237 | |
238 (defun hs-inside-comment-p () | |
239 "returns non-nil if point is inside a comment, otherwise nil. | |
240 actually, for multi-line-able comments, returns a list containing | |
241 the buffer position of the start and the end of the comment." | |
242 ;; is it single-line-only or multi-line-able? | |
243 (save-excursion | |
244 (let ((p (point)) | |
245 q) | |
246 (if (string= comment-end "") ; single line | |
247 (let (found) | |
248 (beginning-of-line) | |
249 (setq found (re-search-forward hs-c-start-regexp p t)) | |
250 (and found (not (search-forward "\"" p t)))) | |
251 (re-search-forward hs-c-end-regexp (point-max) 1) | |
252 (setq q (point)) | |
253 (forward-comment -1) | |
254 (re-search-forward hs-c-start-regexp (point-max) 1) | |
255 (when (< (- (point) (length comment-start)) p) | |
256 (list (match-beginning 0) q)))))) | |
257 | |
258 (defun hs-grok-mode-type () | |
259 "setup variables for new buffers where applicable." | |
260 (when (and (boundp 'comment-start) | |
261 (boundp 'comment-end)) | |
262 (setq hs-c-start-regexp (regexp-quote comment-start)) | |
263 (if (string-match " +$" hs-c-start-regexp) | |
264 (setq hs-c-start-regexp | |
265 (substring hs-c-start-regexp 0 (1- (match-end 0))))) | |
266 (setq hs-c-end-regexp (if (string= "" comment-end) "\n" | |
267 (regexp-quote comment-end))) | |
268 (if (string-match "^ +" hs-c-end-regexp) | |
269 (setq hs-c-end-regexp | |
270 (substring hs-c-end-regexp (match-end 0)))) | |
271 (let ((lookup (assoc major-mode hs-special-modes-alist))) | |
272 (setq hs-block-start-regexp (or (cadr lookup) "\\s\(") | |
273 hs-block-end-regexp (or (caddr lookup) "\\s\)") | |
274 hs-forward-sexp-func (or (cadddr lookup) 'forward-sexp))))) | |
275 | |
276 (defun hs-find-block-beginning () | |
277 "repositions point at block-start. return point, or nil if top-level." | |
278 (let (done | |
279 (here (point)) | |
280 (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\(" | |
281 hs-block-end-regexp "\\)"))) | |
282 (while (and (not done) | |
283 (re-search-backward both-regexps (point-min) t)) | |
284 (if (match-beginning 1) ; start of start-regexp | |
285 (setq done (match-beginning 1)) | |
286 (goto-char (match-end 2)) ; end of end-regexp | |
287 (funcall hs-forward-sexp-func -1))) | |
288 (goto-char (or done here)) | |
289 done)) | |
290 | |
291 (defmacro hs-life-goes-on (&rest body) | |
292 "executes optional BODY iff variable hs-minor-mode is non-nil." | |
293 (list 'if 'hs-minor-mode (cons 'progn body))) | |
294 | |
295 | |
296 ;;;---------------------------------------------------------------------------- | |
297 ;;; commands | |
298 | |
299 ;;;###autoload | |
300 (defun hs-hide-all () | |
301 "hides all top-level blocks, displaying only first and last lines. | |
302 when done, point is repositioned at the beginning of the line, and | |
303 hs-hide-hooks is called. see documentation for `run-hooks'." | |
304 (interactive) | |
305 (hs-life-goes-on | |
306 (message "hiding all blocks ...") | |
307 (save-excursion | |
308 (hs-flag-region (point-min) (point-max) ?\n) ; eliminate weirdness | |
309 (goto-char (point-min)) | |
310 (let ((count 0) | |
311 (top-level-re (concat "^" hs-block-start-regexp))) | |
312 (while (progn | |
313 (forward-comment (buffer-size)) | |
314 (re-search-forward top-level-re (point-max) t)) | |
315 (goto-char (match-beginning 0)) | |
316 (hs-hide-block-at-point t) | |
317 (message "hiding ... %d" (incf count)))) | |
318 (hs-safety-is-job-n)) | |
319 (beginning-of-line) | |
320 (message "hiding all blocks ... done") | |
321 (run-hooks 'hs-hide-hooks))) | |
322 | |
323 (defun hs-show-all () | |
324 "shows all top-level blocks. | |
325 when done, point is unchanged, and hs-show-hooks is called. see | |
326 documentation for `run-hooks'." | |
327 (interactive) | |
328 (hs-life-goes-on | |
329 (message "showing all blocks ...") | |
330 (hs-flag-region (point-min) (point-max) ?\n) | |
331 (message "showing all blocks ... done") | |
332 (run-hooks 'hs-show-hooks))) | |
333 | |
334 ;;;###autoload | |
335 (defun hs-hide-block (&optional end) | |
336 "selects a block and hides it. with prefix arg, reposition at end. | |
337 block is defined as a sexp for lispish modes, mode-specific otherwise. | |
338 comments are blocks, too. upon completion, point is at repositioned and | |
339 hs-hide-hooks is called. see documentation for `run-hooks'." | |
340 (interactive "P") | |
341 (hs-life-goes-on | |
342 (let ((c-reg (hs-inside-comment-p))) | |
343 (if c-reg | |
344 (cond ((string= comment-end "") | |
345 (message "can't hide a single-line comment")) | |
346 ((< (count-lines (car c-reg) (cadr c-reg)) 2) | |
347 (message "not enougn comment lines to hide")) | |
348 (t | |
349 (goto-char (cadr c-reg)) | |
350 (forward-line -1) | |
351 (hs-flag-region (car c-reg) (point) ?\C-m) | |
352 (goto-char (if end (cadr c-reg) (car c-reg))) | |
353 (hs-safety-is-job-n) | |
354 (run-hooks 'hs-hide-hooks))) | |
355 (when (or (looking-at hs-block-start-regexp) | |
356 (hs-find-block-beginning)) | |
357 (hs-hide-block-at-point end) | |
358 (hs-safety-is-job-n) | |
359 (run-hooks 'hs-hide-hooks)))))) | |
360 | |
361 (defun hs-show-block (&optional end) | |
362 "selects a block and shows it. with prefix arg, reposition at end. | |
363 upon completion, point is repositioned hs-show-hooks are called. see | |
364 documetation for `hs-hide-block' and `run-hooks'." | |
365 (interactive "P") | |
366 (hs-life-goes-on | |
367 (let ((c-reg (hs-inside-comment-p))) | |
368 (if c-reg | |
369 (cond ((string= comment-end "") | |
370 (message "already looking at the entire comment")) | |
371 (t | |
372 (hs-flag-region (car c-reg) (cadr c-reg) ?\n) | |
373 (goto-char (if end (cadr c-reg) (car c-reg))))) | |
374 (when (or (looking-at hs-block-start-regexp) | |
375 (hs-find-block-beginning)) | |
376 (hs-show-block-at-point end) | |
377 (hs-safety-is-job-n) | |
378 (run-hooks 'hs-show-hooks)))))) | |
379 | |
380 (defun hs-show-region (beg end) | |
381 "shows all lines from BEG to END, without doing any block analysis. | |
382 note: hs-show-region is intended for use when when hs-show-block signals | |
383 `unbalanced parentheses' and so is an emergency measure only. you may | |
384 become very confused if you use this command indiscriminately." | |
385 (interactive "r") | |
386 (hs-life-goes-on | |
387 (hs-flag-region beg end ?\n) | |
388 (hs-safety-is-job-n) | |
389 (run-hooks 'hs-show-hooks))) | |
390 | |
391 ;;;###autoload | |
392 (defun hs-minor-mode (&optional arg) | |
393 "toggle hideshow minor mode. | |
394 with ARG, turn hideshow minor mode on if ARG is positive, off otherwise. | |
395 when hideshow minor mode is on, the menu bar is augmented with hideshow | |
396 commands and the hideshow commands are enabled. the variables\n | |
397 \tselective-display\n\tselective-display-ellipses\n | |
398 are set to t. lastly, the hooks set in hs-minor-mode-hook are called. | |
399 see documentation for `run-hooks'.\n | |
400 turning hideshow minor mode off reverts the menu bar and the | |
401 variables to default values and disables the hideshow commands." | |
402 (interactive "P") | |
403 (setq hs-minor-mode | |
404 (if (null arg) | |
405 (not hs-minor-mode) | |
406 (> (prefix-numeric-value arg) 0))) | |
407 (if hs-minor-mode | |
408 (progn | |
409 ; (when (emacs-type-eq 'lucid) | |
410 ; (set-buffer-menubar (copy-sequence current-menubar)) | |
411 ; (add-menu nil (car hs-menu-bar) (cdr hs-menu-bar))) | |
412 (setq selective-display t | |
413 selective-display-ellipses t) | |
414 (hs-grok-mode-type) | |
415 (run-hooks 'hs-minor-mode-hook)) | |
416 ; (when (emacs-type-eq 'lucid) | |
417 ; (set-buffer-menubar (delete hs-menu-bar current-menubar))) | |
418 (kill-local-variable 'selective-display) | |
419 (kill-local-variable 'selective-display-ellipses))) | |
420 | |
421 | |
422 ;;;---------------------------------------------------------------------------- | |
423 ;;; load-time setup routines | |
424 | |
425 ;; keymaps and menus | |
426 (unless hs-minor-mode-map | |
427 (setq hs-minor-mode-map (make-sparse-keymap)) | |
428 (cond | |
429 ; ((emacs-type-eq 'lucid) | |
430 ; (setq hs-menu-bar ; build top down for lucid | |
431 ; '("hideshow" | |
432 ; ["hide block" hs-hide-block t] | |
433 ; ["show block" hs-show-block t] | |
434 ; ["hide all" hs-hide-all t] | |
435 ; ["show all" hs-show-all t] | |
436 ; ["show region" hs-show-region t]))) | |
437 (t ; build bottom up for others | |
438 (define-key hs-minor-mode-map [menu-bar hideshow] | |
439 (cons "hideshow" (make-sparse-keymap "hideshow"))) | |
440 (define-key hs-minor-mode-map [menu-bar hideshow hs-show-region] | |
441 '("show region" . hs-show-region)) | |
442 (define-key hs-minor-mode-map [menu-bar hideshow hs-show-all] | |
443 '("show all" . hs-show-all)) | |
444 (define-key hs-minor-mode-map [menu-bar hideshow hs-hide-all] | |
445 '("hide all" . hs-hide-all)) | |
446 (define-key hs-minor-mode-map [menu-bar hideshow hs-show-block] | |
447 '("show block" . hs-show-block)) | |
448 (define-key hs-minor-mode-map [menu-bar hideshow hs-hide-block] | |
449 '("hide block" . hs-hide-block))))) | |
450 | |
451 ;; some housekeeping | |
452 (pushnew (cons 'hs-minor-mode hs-minor-mode-map) | |
453 minor-mode-map-alist | |
454 :test 'equal) | |
455 (pushnew '(hs-minor-mode " hs") minor-mode-alist :test 'equal) | |
456 | |
457 ;; make some variables buffer-local | |
458 (make-variable-buffer-local 'hs-minor-mode) | |
459 (make-variable-buffer-local 'hs-c-start-regexp) | |
460 (make-variable-buffer-local 'hs-c-end-regexp) | |
461 (make-variable-buffer-local 'hs-block-start-regexp) | |
462 (make-variable-buffer-local 'hs-block-end-regexp) | |
463 (make-variable-buffer-local 'hs-forward-sexp-func) | |
464 (put 'hs-minor-mode 'permanent-local t) | |
465 (put 'hs-c-start-regexp 'permanent-local t) | |
466 (put 'hs-c-end-regexp 'permanent-local t) | |
467 (put 'hs-block-start-regexp 'permanent-local t) | |
468 (put 'hs-block-end-regexp 'permanent-local t) | |
469 (put 'hs-forward-sexp-func 'permanent-local t) | |
470 | |
471 | |
472 ;;;---------------------------------------------------------------------------- | |
473 ;;; that's it | |
474 | |
475 (provide 'hideshow) | |
476 | |
477 ;;; hideshow.el ends here |