![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to outline.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to outline.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Outline mode commands for Emacs
2: ;; Copyright (C) 1986 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20: ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
21:
22: (defvar outline-regexp "[*\^l]+"
23: "*Regular expression to match the beginning of a heading line.
24: Any line whose beginning matches this regexp is considered a heading.
25: The recommended way to set this is with a Local Variables: list
26: in the file it applies to.")
27:
28: (defvar outline-mode-map nil "")
29:
30: (if outline-mode-map
31: nil
32: (setq outline-mode-map (copy-keymap text-mode-map))
33: (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading)
34: (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
35: (define-key outline-mode-map "\C-c\C-i" 'show-children)
36: (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
37: (define-key outline-mode-map "\C-c\C-h" 'hide-subtree)
38: (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
39: (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
40: (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level))
41:
42: (defun outline-mode ()
43: "Set major mode for editing outlines with selective display.
44: Headings are lines which start with asterisks: one for major headings,
45: two for subheadings, etc. Lines not starting with asterisks are body lines.
46:
47: Body text or subheadings under a heading can be made temporarily
48: invisible, or visible again. Invisible lines are attached to the end
49: of the heading, so they move with it, if the line is killed and yanked
50: back. A heading with text hidden under it is marked with an ellipsis (...).
51:
52: Commands:
53: C-c C-n outline-next-visible-heading move by visible headings
54: C-c C-p outline-previous-visible-heading
55: C-c C-f outline-forward-same-level similar but skip subheadings
56: C-c C-b outline-backward-same-level
57: C-c C-u outline-up-heading move from subheading to heading
58:
59: Meta-x hide-body make all text invisible (not headings).
60: Meta-x show-all make everything in buffer visible.
61:
62: The remaining commands are used when point is on a heading line.
63: They apply to some of the body or subheadings of that heading.
64: C-c C-h hide-subtree make body and subheadings invisible.
65: C-c C-s show-subtree make body and subheadings visible.
66: C-c C-i show-children make direct subheadings visible.
67: No effect on body, or subheadings 2 or more levels down.
68: With arg N, affects subheadings N levels down.
69: M-x hide-entry make immediately following body invisible.
70: M-x show-entry make it visible.
71: M-x hide-leaves make body under heading and under its subheadings invisible.
72: The subheadings remain visible.
73: M-x show-branches make all subheadings at all levels visible.
74:
75: The variable outline-regexp can be changed to control what is a heading.
76: A line is a heading if outline-regexp matches something at the
77: beginning of the line. The longer the match, the deeper the level.
78:
79: Turning on outline mode calls the value of text-mode-hook and then of
80: outline-mode-hook, if they are non-nil."
81: (interactive)
82: (kill-all-local-variables)
83: (setq selective-display t)
84: (use-local-map outline-mode-map)
85: (setq mode-name "Outline")
86: (setq major-mode 'outline-mode)
87: (define-abbrev-table 'text-mode-abbrev-table ())
88: (setq local-abbrev-table text-mode-abbrev-table)
89: (set-syntax-table text-mode-syntax-table)
90: (make-local-variable 'paragraph-start)
91: (setq paragraph-start (concat paragraph-start "\\|^\\("
92: outline-regexp "\\)"))
93: (make-local-variable 'paragraph-separate)
94: (setq paragraph-separate (concat paragraph-separate "\\|^\\("
95: outline-regexp "\\)"))
96: (run-hooks 'text-mode-hook 'outline-mode-hook))
97:
98: (defun outline-level ()
99: "Return the depth to which a statement is nested in the outline.
100: Point must be at the beginning of a header line.
101: This is actually the length of whatever outline-regexp matches."
102: (save-excursion
103: (looking-at outline-regexp)
104: (- (match-end 0) (match-beginning 0))))
105:
106: (defun outline-next-preface ()
107: "Skip forward to just before the next heading line."
108: (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
109: nil 'move)
110: (goto-char (match-beginning 0)))
111: (if (memq (preceding-char) '(?\n ?\^M))
112: (forward-char -1)))
113:
114: (defun outline-next-heading ()
115: "Move to the next (possibly invisible) heading line."
116: (interactive)
117: (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
118: nil 'move)
119: (goto-char (1+ (match-beginning 0)))))
120:
121: (defun outline-back-to-heading ()
122: "Move to previous (possibly invisible) heading line,
123: or to beginning of this line if it is a heading line."
124: (beginning-of-line)
125: (or (outline-on-heading-p)
126: (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move)))
127:
128: (defun outline-on-heading-p ()
129: "Return T if point is on a header line."
130: (save-excursion
131: (beginning-of-line)
132: (and (eq (preceding-char) ?\n)
133: (looking-at outline-regexp))))
134:
135: (defun outline-next-visible-heading (arg)
136: "Move to the next visible heading line.
137: With argument, repeats or can move backward if negative.
138: A heading line is one that starts with a `*' (or that outline-regexp matches)."
139: (interactive "p")
140: (if (< arg 0)
141: (beginning-of-line)
142: (end-of-line))
143: (re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil arg)
144: (beginning-of-line))
145:
146: (defun outline-previous-visible-heading (arg)
147: "Move to the previous heading line.
148: With argument, repeats or can move forward if negative.
149: A heading line is one that starts with a `*' (or that outline-regexp matches)."
150: (interactive "p")
151: (outline-next-visible-heading (- arg)))
152:
153: (defun outline-flag-region (from to flag)
154: "Hides or shows lines from FROM to TO, according to FLAG.
155: If FLAG is `\\n' (newline character) then text is shown,
156: while if FLAG is `\\^M' (control-M) the text is hidden."
157: (let ((modp (buffer-modified-p)))
158: (unwind-protect
159: (subst-char-in-region from to
160: (if (= flag ?\n) ?\^M ?\n)
161: flag t)
162: (set-buffer-modified-p modp))))
163:
164: (defun hide-entry ()
165: "Hide the body directly following this heading."
166: (interactive)
167: (outline-back-to-heading)
168: (save-excursion
169: (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
170:
171: (defun show-entry ()
172: "Show the body directly following this heading."
173: (interactive)
174: (save-excursion
175: (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
176:
177: (defun hide-body ()
178: "Hide all of buffer except headings."
179: (interactive)
180: (hide-region-body (point-min) (point-max)))
181:
182: (defun hide-region-body (start end)
183: "Hide all body lines in the region, but not headings."
184: (save-excursion
185: (save-restriction
186: (narrow-to-region start end)
187: (goto-char (point-min))
188: (while (not (eobp))
189: (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)
190: (if (not (eobp))
191: (forward-char
192: (if (looking-at "[\n\^M][\n\^M]")
193: 2 1)))))))
194:
195: (defun show-all ()
196: "Show all of the text in the buffer."
197: (interactive)
198: (outline-flag-region (point-min) (point-max) ?\n))
199:
200: (defun hide-subtree ()
201: "Hide everything after this heading at deeper levels."
202: (interactive)
203: (outline-flag-subtree ?\^M))
204:
205: (defun hide-leaves ()
206: "Hide all body after this heading at deeper levels."
207: (interactive)
208: (outline-back-to-heading)
209: (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
210:
211: (defun show-subtree ()
212: "Show everything after this heading at deeper levels."
213: (interactive)
214: (outline-flag-subtree ?\n))
215:
216: (defun outline-flag-subtree (flag)
217: (save-excursion
218: (outline-back-to-heading)
219: (outline-flag-region (point)
220: (progn (outline-end-of-subtree) (point))
221: flag)))
222:
223: (defun outline-end-of-subtree ()
224: (beginning-of-line)
225: (let ((opoint (point))
226: (first t)
227: (level (outline-level)))
228: (while (and (not (eobp))
229: (or first (> (outline-level) level)))
230: (setq first nil)
231: (outline-next-heading))
232: (forward-char -1)
233: (if (memq (preceding-char) '(?\n ?\^M))
234: (forward-char -1))))
235:
236: (defun show-branches ()
237: "Show all subheadings of this heading, but not their bodies."
238: (interactive)
239: (show-children 1000))
240:
241: (defun show-children (&optional level)
242: "Show all direct subheadings of this heading. Optional LEVEL specifies
243: how many levels below the current level should be shown."
244: (interactive "p")
245: (or level (setq level 1))
246: (save-excursion
247: (save-restriction
248: (beginning-of-line)
249: (setq level (+ level (outline-level)))
250: (narrow-to-region (point)
251: (progn (outline-end-of-subtree) (1+ (point))))
252: (goto-char (point-min))
253: (while (and (not (eobp))
254: (progn
255: (outline-next-heading)
256: (not (eobp))))
257: (if (<= (outline-level) level)
258: (save-excursion
259: (let ((end (1+ (point))))
260: (forward-char -1)
261: (if (memq (preceding-char) '(?\n ?\^M))
262: (forward-char -1))
263: (outline-flag-region (point) end ?\n))))))))
264:
265: (defun outline-up-heading (arg)
266: "Move to the heading line of which the present line is a subheading.
267: With argument, move up ARG levels."
268: (interactive "p")
269: (outline-back-to-heading)
270: (if (eq (outline-level) 1)
271: (error ""))
272: (while (and (> (outline-level) 1)
273: (> arg 0)
274: (not (bobp)))
275: (let ((present-level (outline-level)))
276: (while (not (< (outline-level) present-level))
277: (outline-previous-visible-heading 1))
278: (setq arg (- arg 1)))))
279:
280: (defun outline-forward-same-level (arg)
281: "Move forward to the ARG'th subheading from here of the same level as the
282: present one. It stops at the first and last subheadings of a superior heading."
283: (interactive "p")
284: (outline-back-to-heading)
285: (while (> arg 0)
286: (let ((point-to-move-to (save-excursion
287: (outline-get-next-sibling))))
288: (if point-to-move-to
289: (progn
290: (goto-char point-to-move-to)
291: (setq arg (1- arg)))
292: (progn
293: (setq arg 0)
294: (error ""))))))
295:
296: (defun outline-get-next-sibling ()
297: "Position the point at the next heading of the same level,
298: and return that position or nil if it cannot be found."
299: (let ((level (outline-level)))
300: (outline-next-visible-heading 1)
301: (while (and (> (outline-level) level)
302: (not (eobp)))
303: (outline-next-visible-heading 1))
304: (if (< (outline-level) level)
305: nil
306: (point))))
307:
308: (defun outline-backward-same-level (arg)
309: "Move backward to the ARG'th subheading from here of the same level as the
310: present one. It stops at the first and last subheadings of a superior heading."
311: (interactive "p")
312: (outline-back-to-heading)
313: (while (> arg 0)
314: (let ((point-to-move-to (save-excursion
315: (outline-get-last-sibling))))
316: (if point-to-move-to
317: (progn
318: (goto-char point-to-move-to)
319: (setq arg (1- arg)))
320: (progn
321: (setq arg 0)
322: (error ""))))))
323:
324: (defun outline-get-last-sibling ()
325: "Position the point at the previous heading of the same level,
326: and return that position or nil if it cannot be found."
327: (let ((level (outline-level)))
328: (outline-previous-visible-heading 1)
329: (while (and (> (outline-level) level)
330: (not (bobp)))
331: (outline-previous-visible-heading 1))
332: (if (< (outline-level) level)
333: nil
334: (point))))
335:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.