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