|
|
1.1 root 1: ;; Outline mode commands for Emacs
2: ;; Copyright (C) 1985 Richard M. Stallman.
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:
22: (defvar outline-mode-map nil "")
23:
24: (if outline-mode-map
25: nil
26: (setq outline-mode-map (copy-alist text-mode-map))
27: (define-key outline-mode-map "\e}" 'next-visible-heading)
28: (define-key outline-mode-map "\e{" 'previous-visible-heading)
29: (define-key outline-mode-map "\C-c\t" 'show-children)
30: (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
31: (define-key outline-mode-map "\C-c\C-h" 'hide-subtree))
32:
33: (defun outline-mode ()
34: "Set major mode for editing outlines with selective display.
35: Headings should be lines starting with one or more asterisks.
36: Major headings have one asterisk, subheadings two, etc.
37: Lines not starting with asterisks are body lines.
38:
39: You can make the body text under a heading, or the subheadings
40: under a heading, temporarily invisible, or visible again.
41: Invisible lines are attached to the end of the previous line
42: so they go with it if you kill it and yank it back.
43:
44: Commands:
45: Meta-} next-visible-heading move by visible headings
46: Meta-{ previous-visible-heading move by visible headings
47:
48: Meta-x hide-body make all text invisible (not headings).
49: Meta-x show-all make everything in buffer visible.
50:
51: The remaining commands are used when point is on a heading line.
52: They apply to some of the body or subheadings of that heading.
53: C-c C-h hide-subtree make body and subheadings invisible.
54: C-c C-s show-subtree make body and subheadings visible.
55: C-c C-i show-children make direct subheadings visible.
56: No effect on body, or subheadings 2 or more levels down.
57: With arg N, affects subheadings N levels down.
58: hide-entry make immediately following body invisible.
59: show-entry make it visible.
60: hide-leaves make body under heading and under its subheadings invisible.
61: The subheadings remain visible.
62: show-branches make all subheadings at all levels visible."
63: (interactive)
64: (kill-all-local-variables)
65: (setq selective-display t)
66: (use-local-map outline-mode-map)
67: (setq mode-name "Outline")
68: (setq major-mode 'outline-mode)
69: (define-abbrev-table 'text-mode-abbrev-table ())
70: (setq local-abbrev-table text-mode-abbrev-table)
71: (set-syntax-table text-mode-syntax-table)
72: (make-local-variable 'paragraph-start)
73: (setq paragraph-start (concat paragraph-start "\\|*"))
74: (make-local-variable 'paragraph-separate)
75: (setq paragraph-separate (concat paragraph-separate "\\|*"))
76: (run-hooks 'text-mode-hook 'outline-mode-hook))
77:
78: (defun outline-level ()
79: (save-excursion
80: (- (- (point) (progn (skip-chars-forward "^ \t") (point))))))
81:
82: (defun next-heading-preface ()
83: (if (re-search-forward "[\n\^M]\\*"
84: nil 'move)
85: (goto-char (match-beginning 0)))
86: (if (memq (preceding-char) '(?\n ?\^M))
87: (forward-char -1)))
88:
89: (defun next-heading ()
90: "Move to the next heading line (a line starting with *'s)."
91: (interactive)
92: (if (re-search-forward "[\n\^M]\\*"
93: nil 'move)
94: (goto-char (1+ (match-beginning 0)))))
95:
96: (defun next-visible-heading (arg)
97: "Move to the next visible heading line (a line starting with *'s).
98: With argument, repeats or can move backward if negative."
99: (interactive "p")
100: (if (< arg 0)
101: (beginning-of-line)
102: (forward-line 1))
103: (re-search-forward "^\\*" nil nil arg)
104: (beginning-of-line))
105:
106: (defun previous-visible-heading (arg)
107: "Move to the previous heading line (a line starting with *'s).
108: With argument, repeats or can move forward if negative."
109: (interactive "p")
110: (if (> arg 0)
111: (beginning-of-line)
112: (forward-line 1))
113: (re-search-backward "^\\*" nil nil arg)
114: (beginning-of-line))
115:
116: (defun flag-lines-in-region (from to flag)
117: (let ((modp (buffer-modified-p)))
118: (unwind-protect
119: (subst-char-in-region from to
120: (if (= flag ?\n) ?\^M ?\n)
121: flag t)
122: (set-buffer-modified-p modp))))
123:
124: (defun hide-entry ()
125: "Hide the body directly following this heading."
126: (interactive)
127: (save-excursion
128: (flag-lines-in-region (point) (progn (next-heading-preface) (point)) ?\^M)))
129:
130: (defun show-entry ()
131: "Show the body directly following this heading."
132: (interactive)
133: (save-excursion
134: (flag-lines-in-region (point) (progn (next-heading-preface) (point)) ?\n)))
135:
136: (defun hide-body ()
137: "Hide all of buffer except headings."
138: (interactive)
139: (hide-region-body (point-min) (point-max)))
140:
141: (defun hide-region-body (start end)
142: "Hide all body lines in the region, but not headings."
143: (save-excursion
144: (save-restriction
145: (narrow-to-region start end)
146: (goto-char (point-min))
147: (while (not (eobp))
148: (flag-lines-in-region (point) (progn (next-heading-preface) (point)) ?\^M)
149: (forward-char
150: (if (looking-at "[\n\^M][\n\^M]")
151: 2 1))))))
152:
153: (defun show-all ()
154: "Show all of the body in the buffer."
155: (interactive)
156: (flag-lines-in-region (point-min) (point-max) ?\n))
157:
158: (defun hide-subtree ()
159: "Hide everything after this heading at deeper levels."
160: (interactive)
161: (flag-subtree ?\^M))
162:
163: (defun hide-leaves ()
164: "Hide all body after this heading at deeper levels."
165: (interactive)
166: (hide-region-body (point) (progn (end-of-subtree) (point))))
167:
168: (defun show-subtree ()
169: "Show everything after this heading at deeper levels."
170: (interactive)
171: (flag-subtree ?\n))
172:
173: (defun flag-subtree (flag)
174: (save-excursion
175: (flag-lines-in-region (point)
176: (progn (end-of-subtree) (point))
177: flag)))
178:
179: (defun end-of-subtree ()
180: (beginning-of-line)
181: (let ((opoint (point))
182: (first t)
183: (level (outline-level)))
184: (while (and (not (eobp))
185: (or first (> (outline-level) level)))
186: (setq first nil)
187: (next-heading))
188: (forward-char -1)
189: (if (memq (preceding-char) '(?\n ?\^M))
190: (forward-char -1))))
191:
192: (defun show-branches ()
193: "Show all subheadings of this heading, but not their bodies."
194: (interactive)
195: (show-children 1000))
196:
197: (defun show-children (&optional level)
198: "Show all direct subheadings of this heading."
199: (interactive "p")
200: (or level (setq level 1))
201: (save-excursion
202: (save-restriction
203: (beginning-of-line)
204: (setq level (+ level (outline-level)))
205: (narrow-to-region (point)
206: (progn (end-of-subtree) (1+ (point))))
207: (goto-char (point-min))
208: (while (and (not (eobp))
209: (progn
210: (next-heading)
211: (not (eobp))))
212: (if (<= (outline-level) level)
213: (save-excursion
214: (let ((end (1+ (point))))
215: (forward-char -1)
216: (if (memq (preceding-char) '(?\n ?\^M))
217: (forward-char -1))
218: (flag-lines-in-region (point) end ?\n))))))))
219:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.