Mercurial > hg > xemacs-beta

comparison lisp/modes/hideshow.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 54cc21c15cbb
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; hideshow.el --- minor mode cmds to selectively display blocks of code 1 ;;; hideshow.el --- minor mode cmds to selectively display blocks of code
2 2
3 ;;; Copyright (C) 1994,1995 Free Software Foundation 3 ;; Copyright (C) 1994,1995,1996 Free Software Foundation
4 4
5 ;;; Author: Thien-Thi Nguyen <ttn@netcom.com> 5 ;; Author: Thien-Thi Nguyen <ttn@netcom.com>
6 ;;; Version: 3.4 6 ;; Version: 3.4
7 ;;; Keywords: C C++ lisp tools editing 7 ;; Keywords: C C++ lisp tools editing
8 ;;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning 8 ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
9 9
10 ;;; This file is part of GNU Emacs. 10 ;; This file is part of XEmacs.
11 11
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify it 12 ;; XEmacs 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 13 ;; under the terms of the GNU General Public License as published by
14 ;;; Free Software Foundation; either version 2 of the License, or (at your 14 ;; the Free Software Foundation; either version 2 of the License, or
15 ;;; option) any later version. 15 ;; (at your option) any later version.
16 ;;; 16
17 ;;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT 17 ;; XEmacs is distributed in the hope that it will be useful, but
18 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;;; for more details. 20 ;; General Public License for more details.
21 ;;; 21
22 ;;; You should have received a copy of the GNU General Public License along 22 ;; You should have received a copy of the GNU General Public License
23 ;;; with this program; if not, write to the Free Software Foundation, Inc., 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;;; 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 25 ;; 02111-1307, USA.
26 ;;; LCD Archive Entry: 26
27 ;;; hideshow|Thien-Thi Nguyen|ttn@netcom.com| 27 ;;; Synched up with: FSF 19.34.
28 ;;; minor mode commands to selectively display blocks of code| 28
29 ;;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z| 29 ;; LCD Archive Entry:
30 ;; hideshow|Thien-Thi Nguyen|ttn@netcom.com|
31 ;; minor mode commands to selectively display blocks of code|
32 ;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z|
30 33
31 ;;; Commentary: 34 ;;; Commentary:
32 35
33 ;;; This file provides `hs-minor-mode'. When active, six commands: 36 ;; This file provides `hs-minor-mode'. When active, six commands:
34 ;;; hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode 37 ;; hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode
35 ;;; are available. They implement block hiding and showing. Blocks are 38 ;; 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 39 ;; 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 40 ;; 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 41 ;; 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). 42 ;; toggles the minor mode or sets it (similar to outline minor mode).
40 ;;; See documentation for each command for more info. 43 ;; See documentation for each command for more info.
41 ;;; 44 ;;
42 ;;; The variable `hs-unbalance-handler-method' controls hideshow's behavior 45 ;; The variable `hs-unbalance-handler-method' controls hideshow's behavior
43 ;;; in the case of "unbalanced parentheses". See doc for more info. 46 ;; in the case of "unbalanced parentheses". See doc for more info.
44 47
45 ;;; Suggested usage: 48 ;; Suggested usage:
46 49
47 ;;; (load-library "hideshow") 50 ;; (load-library "hideshow")
48 ;;; (defun my-hs-setup () "enables hideshow and binds some commands" 51 ;; (defun my-hs-setup () "enables hideshow and binds some commands"
49 ;;; (hs-minor-mode 1) 52 ;; (hs-minor-mode 1)
50 ;;; (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block) 53 ;; (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block)
51 ;;; (define-key hs-minor-mode-map "\C-cs" 'hs-show-block) 54 ;; (define-key hs-minor-mode-map "\C-cs" 'hs-show-block)
52 ;;; (define-key hs-minro-mode-map "\C-cH" 'hs-hide-all) 55 ;; (define-key hs-minro-mode-map "\C-cH" 'hs-hide-all)
53 ;;; (define-key hs-minro-mode-map "\C-cS" 'hs-show-all) 56 ;; (define-key hs-minro-mode-map "\C-cS" 'hs-show-all)
54 ;;; (define-key hs-minor-mode-map "\C-cR" 'hs-show-region)) 57 ;; (define-key hs-minor-mode-map "\C-cR" 'hs-show-region))
55 ;;; (add-hook 'X-mode-hook 'my-hs-setup t) ; other modes similarly 58 ;; (add-hook 'X-mode-hook 'my-hs-setup t) ; other modes similarly
56 ;;; 59 ;;
57 ;;; where X = {emacs-lisp,c,c++,perl,...}. See the doc for the variable 60 ;; where X = {emacs-lisp,c,c++,perl,...}. See the doc for the variable
58 ;;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes. 61 ;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes.
59 62
60 ;;; Etc: 63 ;; Etc:
61 64
62 ;;; Bug reports and fixes welcome (comments, too). Thanks go to 65 ;; Bug reports and fixes welcome (comments, too). Thanks go to
63 ;;; Dean Andrews <adahome@ix.netcom.com> 66 ;; Dean Andrews <adahome@ix.netcom.com>
64 ;;; Preston F. Crow <preston.f.crow@dartmouth.edu> 67 ;; Preston F. Crow <preston.f.crow@dartmouth.edu>
65 ;;; Gael Marziou <gael@gnlab030.grenoble.hp.com> 68 ;; Gael Marziou <gael@gnlab030.grenoble.hp.com>
66 ;;; Keith Sheffield <sheff@edcsgw2.cr.usgs.gov> 69 ;; Keith Sheffield <sheff@edcsgw2.cr.usgs.gov>
67 ;;; Jan Djarv <jan.djarv@sa.erisoft.se> 70 ;; Jan Djarv <jan.djarv@sa.erisoft.se>
68 ;;; Lars Lindberg <qhslali@aom.ericsson.se> 71 ;; Lars Lindberg <qhslali@aom.ericsson.se>
69 ;;; Alf-Ivar Holm <alfh@ifi.uio.no> 72 ;; Alf-Ivar Holm <alfh@ifi.uio.no>
70 ;;; for valuable feedback, code and bug reports. 73 ;; for valuable feedback, code and bug reports.
71 74
72 ;;; Code: 75 ;;; Code:
73 76
74 77
75 ;;;---------------------------------------------------------------------------- 78 ;;;----------------------------------------------------------------------------
76 ;;; user-configurable variables 79 ;;; user-configurable variables
77 80
78 (defvar hs-unbalance-handler-method 'top-level 81 (defvar hs-unbalance-handler-method 'top-level
79 "*Symbol representing how \"unbalanced parentheses\" should be handled. 82 "*Symbol representing how \"unbalanced parentheses\" should be handled.
80 This error is usually signalled by hs-show-block. One of four values: 83 This error is usually signaled by `hs-show-block'. One of four values:
81 `top-level', `next-line', `signal' or `ignore'. Default is `top-level'. 84 `top-level', `next-line', `signal' or `ignore'. Default is `top-level'.
82 85
83 - `top-level' -- Show top-level block containing the currently troublesome 86 - `top-level' -- Show top-level block containing the currently troublesome
84 block. 87 block.
85 - `next-line' -- Use the fact that, for an already hidden block, its end 88 - `next-line' -- Use the fact that, for an already hidden block, its end
86 will be on the next line. Attempt to show this block. 89 will be on the next line. Attempt to show this block.
87 - `signal' -- Pass the error through, stopping execution. 90 - `signal' -- Pass the error through, stopping execution.
88 - `ignore' -- Ignore the error, continuing execution. 91 - `ignore' -- Ignore the error, continuing execution.
89 92
90 Values other than these four will be interpreted as `signal'.") 93 Values other than these four will be interpreted as `signal'.")
91 94
107 \t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement) 110 \t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement)
108 \t hs-special-modes-alist :test 'equal) 111 \t hs-special-modes-alist :test 'equal)
109 112
110 Note that the regexps should not contain leading or trailing whitespace.") 113 Note that the regexps should not contain leading or trailing whitespace.")
111 114
112 (defvar hs-hide-hooks nil 115 (defvar hs-hide-hook nil
113 "*Hooks called at the end of hs-hide-all and hs-hide-block.") 116 "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.")
114 117
115 (defvar hs-show-hooks nil 118 (defvar hs-show-hook nil
116 "*Hooks called at the end of hs-show-all, hs-show-block and hs-show-region.") 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'.")
117 121
118 (defvar hs-minor-mode-prefix "\C-c" 122 (defvar hs-minor-mode-prefix "\C-c"
119 "*Prefix key to use for hideshow commands in hideshow minor mode.") 123 "*Prefix key to use for hideshow commands in hideshow minor mode.")
120 124
121 125
170 ;;; support funcs 174 ;;; support funcs
171 175
172 ;; snarfed from outline.el, but added buffer-read-only 176 ;; snarfed from outline.el, but added buffer-read-only
173 (defun hs-flag-region (from to flag) 177 (defun hs-flag-region (from to flag)
174 "Hides or shows lines from FROM to TO, according to FLAG. 178 "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 179 If FLAG is `?\\n' (the newline character) then show the text;
176 is \\^M \(control-M) the text is hidden." 180 if FLAG is `?\\^M' \(control-M) then hide the text."
177 (let ((modp (buffer-modified-p)) 181 (let ((modp (buffer-modified-p))
178 buffer-read-only) ; nothing is immune 182 buffer-read-only) ; nothing is immune
179 (unwind-protect (progn 183 (unwind-protect (progn
180 (subst-char-in-region 184 (subst-char-in-region
181 from to 185 from to
223 (signal (car error) (cdr error)))))))) 227 (signal (car error) (cdr error))))))))
224 (hs-flag-region p q ?\n) 228 (hs-flag-region p q ?\n)
225 (goto-char (if end (1+ (point)) p))))) 229 (goto-char (if end (1+ (point)) p)))))
226 230
227 (defun hs-safety-is-job-n () 231 (defun hs-safety-is-job-n ()
228 "Warns if selective-display or selective-display-ellipses is nil." 232 "Warn if `selective-display' or `selective-display-ellipses' is nil."
229 (let ((str "")) 233 (let ((str ""))
230 (or selective-display 234 (or selective-display
231 (setq str "selective-display nil ")) 235 (setq str "selective-display nil "))
232 (or selective-display-ellipses 236 (or selective-display-ellipses
233 (setq str (concat str "selective-display-ellipses nil"))) 237 (setq str (concat str "selective-display-ellipses nil")))
299 ;;; commands 303 ;;; commands
300 304
301 ;;;###autoload 305 ;;;###autoload
302 (defun hs-hide-all () 306 (defun hs-hide-all ()
303 "Hides all top-level blocks, displaying only first and last lines. 307 "Hides all top-level blocks, displaying only first and last lines.
304 When done, point is repositioned at the beginning of the line, and 308 It moves point to the beginning of the line, and it runs the normal hook
305 hs-hide-hooks is called. See documentation for `run-hooks'." 309 `hs-hide-hook'. See documentation for `run-hooks'."
306 (interactive) 310 (interactive)
307 (hs-life-goes-on 311 (hs-life-goes-on
308 (message "hiding all blocks ...") 312 (message "hiding all blocks ...")
309 (save-excursion 313 (save-excursion
310 (hs-flag-region (point-min) (point-max) ?\n) ; eliminate weirdness 314 (hs-flag-region (point-min) (point-max) ?\n) ; eliminate weirdness
318 (hs-hide-block-at-point t) 322 (hs-hide-block-at-point t)
319 (message "hiding ... %d" (setq count (1+ count))))) 323 (message "hiding ... %d" (setq count (1+ count)))))
320 (hs-safety-is-job-n)) 324 (hs-safety-is-job-n))
321 (beginning-of-line) 325 (beginning-of-line)
322 (message "hiding all blocks ... done") 326 (message "hiding all blocks ... done")
323 (run-hooks 'hs-hide-hooks))) 327 (run-hooks 'hs-hide-hook)))
324 328
325 (defun hs-show-all () 329 (defun hs-show-all ()
326 "Shows all top-level blocks. 330 "Shows all top-level blocks.
327 When done, point is unchanged, and hs-show-hooks is called. See 331 This does not change point; it runs the normal hook `hs-show-hook'.
328 documentation for `run-hooks'." 332 See documentation for `run-hooks'."
329 (interactive) 333 (interactive)
330 (hs-life-goes-on 334 (hs-life-goes-on
331 (message "showing all blocks ...") 335 (message "showing all blocks ...")
332 (hs-flag-region (point-min) (point-max) ?\n) 336 (hs-flag-region (point-min) (point-max) ?\n)
333 (message "showing all blocks ... done") 337 (message "showing all blocks ... done")
334 (run-hooks 'hs-show-hooks))) 338 (run-hooks 'hs-show-hook)))
335 339
336 ;;;###autoload 340 ;;;###autoload
337 (defun hs-hide-block (&optional end) 341 (defun hs-hide-block (&optional end)
338 "Selects a block and hides it. With prefix arg, reposition at end. 342 "Selects a block and hides it. With prefix arg, reposition at end.
339 Block is defined as a sexp for lispish modes, mode-specific otherwise. 343 Block is defined as a sexp for lispish modes, mode-specific otherwise.
340 Comments are blocks, too. Upon completion, point is at repositioned and 344 Comments are blocks, too. Upon completion, point is at repositioned and
341 hs-hide-hooks is called. See documentation for `run-hooks'." 345 the normal hook `hs-hide-hook' is run. See documentation for `run-hooks'."
342 (interactive "P") 346 (interactive "P")
343 (hs-life-goes-on 347 (hs-life-goes-on
344 (let ((c-reg (hs-inside-comment-p))) 348 (let ((c-reg (hs-inside-comment-p)))
345 (if c-reg 349 (if c-reg
346 (cond ((string= comment-end "") 350 (cond ((string= comment-end "")
347 (message "can't hide a single-line comment")) 351 (message "can't hide a single-line comment"))
348 ((< (count-lines (car c-reg) (nth 1 c-reg)) 2) 352 ((< (count-lines (car c-reg) (nth 1 c-reg)) 2)
349 (message "not enougn comment lines to hide")) 353 (message "not enough comment lines to hide"))
350 (t 354 (t
351 (goto-char (nth 1 c-reg)) 355 (goto-char (nth 1 c-reg))
352 (forward-line -1) 356 (forward-line -1)
353 (hs-flag-region (car c-reg) (point) ?\C-m) 357 (hs-flag-region (car c-reg) (point) ?\C-m)
354 (goto-char (if end (nth 1 c-reg) (car c-reg))) 358 (goto-char (if end (nth 1 c-reg) (car c-reg)))
355 (hs-safety-is-job-n) 359 (hs-safety-is-job-n)
356 (run-hooks 'hs-hide-hooks))) 360 (run-hooks 'hs-hide-hook)))
357 (if (or (looking-at hs-block-start-regexp) 361 (if (or (looking-at hs-block-start-regexp)
358 (hs-find-block-beginning)) 362 (hs-find-block-beginning))
359 (progn 363 (progn
360 (hs-hide-block-at-point end) 364 (hs-hide-block-at-point end)
361 (hs-safety-is-job-n) 365 (hs-safety-is-job-n)
362 (run-hooks 'hs-hide-hooks))))))) 366 (run-hooks 'hs-hide-hook)))))))
363 367
364 (defun hs-show-block (&optional end) 368 (defun hs-show-block (&optional end)
365 "Selects a block and shows it. With prefix arg, reposition at end. 369 "Selects a block and shows it. With prefix arg, reposition at end.
366 Upon completion, point is repositioned hs-show-hooks are called. See 370 Upon completion, point is repositioned and the normal hook
367 documetation for `hs-hide-block' and `run-hooks'." 371 `hs-show-hook' is run. See documentation for `hs-hide-block' and `run-hooks'."
368 (interactive "P") 372 (interactive "P")
369 (hs-life-goes-on 373 (hs-life-goes-on
370 (let ((c-reg (hs-inside-comment-p))) 374 (let ((c-reg (hs-inside-comment-p)))
371 (if c-reg 375 (if c-reg
372 (cond ((string= comment-end "") 376 (cond ((string= comment-end "")
377 (if (or (looking-at hs-block-start-regexp) 381 (if (or (looking-at hs-block-start-regexp)
378 (hs-find-block-beginning)) 382 (hs-find-block-beginning))
379 (progn 383 (progn
380 (hs-show-block-at-point end) 384 (hs-show-block-at-point end)
381 (hs-safety-is-job-n) 385 (hs-safety-is-job-n)
382 (run-hooks 'hs-show-hooks))))))) 386 (run-hooks 'hs-show-hook)))))))
383 387
384 (defun hs-show-region (beg end) 388 (defun hs-show-region (beg end)
385 "Shows all lines from BEG to END, without doing any block analysis. 389 "Shows all lines from BEG to END, without doing any block analysis.
386 Note: hs-show-region is intended for use when when hs-show-block signals 390 Note:` hs-show-region' is intended for use when when `hs-show-block' signals
387 `unbalanced parentheses' and so is an emergency measure only. You may 391 `unbalanced parentheses' and so is an emergency measure only. You may
388 become very confused if you use this command indiscriminately." 392 become very confused if you use this command indiscriminately."
389 (interactive "r") 393 (interactive "r")
390 (hs-life-goes-on 394 (hs-life-goes-on
391 (hs-flag-region beg end ?\n) 395 (hs-flag-region beg end ?\n)
392 (hs-safety-is-job-n) 396 (hs-safety-is-job-n)
393 (run-hooks 'hs-show-hooks))) 397 (run-hooks 'hs-show-hook)))
394 398
395 ;;;###autoload 399 ;;;###autoload
396 (defun hs-minor-mode (&optional arg) 400 (defun hs-minor-mode (&optional arg)
397 "Toggle hideshow minor mode. 401 "Toggle hideshow minor mode.
398 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. 402 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
399 When hideshow minor mode is on, the menu bar is augmented with hideshow 403 When hideshow minor mode is on, the menu bar is augmented with hideshow
400 commands and the hideshow commands are enabled. The variables\n 404 commands and the hideshow commands are enabled. The variables
401 \tselective-display\n\tselective-display-ellipses\n 405 `selective-display' and `selective-display-ellipses' are set to t.
402 are set to t. Lastly, the hooks set in hs-minor-mode-hook are called. 406 Last, the normal hook `hs-minor-mode-hook' is run; see the doc for `run-hooks'.
403 See documentation for `run-hooks'.\n 407
404 Turning hideshow minor mode off reverts the menu bar and the 408 Turning hideshow minor mode off reverts the menu bar and the
405 variables to default values and disables the hideshow commands." 409 variables to default values and disables the hideshow commands."
406 (interactive "P") 410 (interactive "P")
407 (setq hs-minor-mode 411 (setq hs-minor-mode
408 (if (null arg) 412 (if (null arg)