|
0
|
1 ;;; outline.el --- outline mode commands for Emacs
|
|
|
2
|
|
|
3 ;; Copyright (C) 1986, 1993, 1994 Free Software Foundation, Inc.
|
|
2
|
4
|
|
|
5 ;; Maintainer: FSF
|
|
0
|
6 ;; Keywords: outlines
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
2
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: FSF 19.34.
|
|
0
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; This package is a major mode for editing outline-format documents.
|
|
|
30 ;; An outline can be `abstracted' to show headers at any given level,
|
|
|
31 ;; with all stuff below hidden. See the Emacs manual for details.
|
|
|
32
|
|
|
33 ;;; Code:
|
|
|
34
|
|
|
35 ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
|
|
|
36
|
|
|
37 (defvar outline-regexp nil
|
|
|
38 "*Regular expression to match the beginning of a heading.
|
|
|
39 Any line whose beginning matches this regexp is considered to start a heading.
|
|
|
40 The recommended way to set this is with a Local Variables: list
|
|
|
41 in the file it applies to. See also outline-heading-end-regexp.")
|
|
|
42
|
|
|
43 ;; Can't initialize this in the defvar above -- some major modes have
|
|
|
44 ;; already assigned a local value to it.
|
|
|
45 (or (default-value 'outline-regexp)
|
|
|
46 (setq-default outline-regexp "[*\^L]+"))
|
|
|
47
|
|
2
|
48 ;; XEmacs change
|
|
0
|
49 (defvar outline-heading-end-regexp (purecopy "[\n\^M]")
|
|
|
50 "*Regular expression to match the end of a heading line.
|
|
|
51 You can assume that point is at the beginning of a heading when this
|
|
|
52 regexp is searched for. The heading ends at the end of the match.
|
|
|
53 The recommended way to set this is with a \"Local Variables:\" list
|
|
|
54 in the file it applies to.")
|
|
|
55
|
|
2
|
56 ;; XEmacs: There is no point in doing this differently now. -sb
|
|
|
57 (defvar outline-mode-prefix-map nil)
|
|
|
58
|
|
|
59 (if outline-mode-prefix-map
|
|
|
60 nil
|
|
|
61 (setq outline-mode-prefix-map (make-sparse-keymap))
|
|
|
62 (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading)
|
|
|
63 (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading)
|
|
|
64 (define-key outline-mode-prefix-map "\C-i" 'show-children)
|
|
|
65 (define-key outline-mode-prefix-map "\C-s" 'show-subtree)
|
|
|
66 (define-key outline-mode-prefix-map "\C-d" 'hide-subtree)
|
|
|
67 (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading)
|
|
|
68 (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level)
|
|
|
69 (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level)
|
|
|
70 (define-key outline-mode-prefix-map "\C-t" 'hide-body)
|
|
|
71 (define-key outline-mode-prefix-map "\C-a" 'show-all)
|
|
|
72 (define-key outline-mode-prefix-map "\C-c" 'hide-entry)
|
|
|
73 (define-key outline-mode-prefix-map "\C-e" 'show-entry)
|
|
|
74 (define-key outline-mode-prefix-map "\C-l" 'hide-leaves)
|
|
|
75 (define-key outline-mode-prefix-map "\C-k" 'show-branches)
|
|
|
76 (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels)
|
|
|
77 (define-key outline-mode-prefix-map "\C-o" 'hide-other))
|
|
|
78
|
|
|
79 (defvar outline-mode-menu-bar-map nil)
|
|
|
80 (if outline-mode-menu-bar-map
|
|
|
81 nil
|
|
|
82 (setq outline-mode-menu-bar-map (make-sparse-keymap))
|
|
|
83
|
|
|
84 (define-key outline-mode-menu-bar-map [hide]
|
|
|
85 (cons "Hide" (make-sparse-keymap "Hide")))
|
|
|
86
|
|
|
87 (define-key outline-mode-menu-bar-map [hide hide-other]
|
|
|
88 '("Hide Other" . hide-other))
|
|
|
89 (define-key outline-mode-menu-bar-map [hide hide-sublevels]
|
|
|
90 '("Hide Sublevels" . hide-sublevels))
|
|
|
91 (define-key outline-mode-menu-bar-map [hide hide-subtree]
|
|
|
92 '("Hide Subtree" . hide-subtree))
|
|
|
93 (define-key outline-mode-menu-bar-map [hide hide-entry]
|
|
|
94 '("Hide Entry" . hide-entry))
|
|
|
95 (define-key outline-mode-menu-bar-map [hide hide-body]
|
|
|
96 '("Hide Body" . hide-body))
|
|
|
97 (define-key outline-mode-menu-bar-map [hide hide-leaves]
|
|
|
98 '("Hide Leaves" . hide-leaves))
|
|
|
99
|
|
|
100 (define-key outline-mode-menu-bar-map [show]
|
|
|
101 (cons "Show" (make-sparse-keymap "Show")))
|
|
|
102
|
|
|
103 (define-key outline-mode-menu-bar-map [show show-subtree]
|
|
|
104 '("Show Subtree" . show-subtree))
|
|
|
105 (define-key outline-mode-menu-bar-map [show show-children]
|
|
|
106 '("Show Children" . show-children))
|
|
|
107 (define-key outline-mode-menu-bar-map [show show-branches]
|
|
|
108 '("Show Branches" . show-branches))
|
|
|
109 (define-key outline-mode-menu-bar-map [show show-entry]
|
|
|
110 '("Show Entry" . show-entry))
|
|
|
111 (define-key outline-mode-menu-bar-map [show show-all]
|
|
|
112 '("Show All" . show-all))
|
|
|
113
|
|
|
114 (define-key outline-mode-menu-bar-map [headings]
|
|
|
115 (cons "Headings" (make-sparse-keymap "Headings")))
|
|
|
116
|
|
|
117 (define-key outline-mode-menu-bar-map [headings outline-backward-same-level]
|
|
|
118 '("Previous Same Level" . outline-backward-same-level))
|
|
|
119 (define-key outline-mode-menu-bar-map [headings outline-forward-same-level]
|
|
|
120 '("Next Same Level" . outline-forward-same-level))
|
|
|
121 (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading]
|
|
|
122 '("Previous" . outline-previous-visible-heading))
|
|
|
123 (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading]
|
|
|
124 '("Next" . outline-next-visible-heading))
|
|
|
125 (define-key outline-mode-menu-bar-map [headings outline-up-heading]
|
|
|
126 '("Up" . outline-up-heading)))
|
|
|
127
|
|
0
|
128 (defvar outline-mode-map nil "")
|
|
|
129
|
|
|
130 (if outline-mode-map
|
|
|
131 nil
|
|
2
|
132 ;; XEmacs change
|
|
|
133 ;(setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
|
|
|
134 (setq outline-mode-map (make-sparse-keymap 'text-mode-map))
|
|
|
135 (define-key outline-mode-map "\C-c" outline-mode-prefix-map)
|
|
|
136 (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map))
|
|
0
|
137
|
|
|
138 ;;; #+XEmacs
|
|
|
139 (defvar outline-mode-menu
|
|
|
140 ;; This is the RB menu which also makes 3 menus in the menubar (like
|
|
|
141 ;; FSF rather than because it's good)
|
|
|
142 '("Outline"
|
|
|
143 ("Headings"
|
|
|
144 ["Up" outline-up-heading t]
|
|
|
145 ["Next" outline-next-visible-heading t]
|
|
|
146 ["Previous" outline-previous-visible-heading t]
|
|
|
147 ["Next Same Level" outline-forward-same-level t]
|
|
|
148 ["Previous Same Level" outline-backward-same-level t])
|
|
|
149 ("Show"
|
|
|
150 ["Show All" show-all t]
|
|
|
151 ["Show Entry" show-entry t]
|
|
|
152 ["Show Branches" show-branches t]
|
|
|
153 ["Show Children" show-children t]
|
|
|
154 ["Show Subtree" show-subtree t])
|
|
|
155 ("Hide"
|
|
|
156 ["Hide Leaves" hide-leaves t]
|
|
|
157 ["Hide Body" hide-body t]
|
|
|
158 ["Hide Entry" hide-entry t]
|
|
|
159 ["Hide Subtree" hide-subtree t]
|
|
|
160 ["Hide Other" hide-other t]
|
|
|
161 ["Hide Sublevels" hide-sublevels t])))
|
|
|
162
|
|
|
163 ;;; #+XEmacs
|
|
|
164 (defun outline-mode-menu ()
|
|
|
165 (interactive)
|
|
|
166 (popup-menu outline-mode-menu))
|
|
|
167
|
|
|
168 ;;; #+XEmacs
|
|
|
169 ;;; ?? Is this OK & if so should it be in minor mode too?
|
|
|
170 (define-key outline-mode-map [button3] 'outline-mode-menu)
|
|
|
171
|
|
|
172 ;;; #+XEmacs
|
|
|
173 (defun outline-install-menubar (&optional remove)
|
|
|
174 ;; install or remove the outline menus
|
|
|
175 (let ((menus (cdr outline-mode-menu)) path)
|
|
|
176 (and (not remove)
|
|
|
177 (set-buffer-menubar (copy-sequence current-menubar)))
|
|
|
178 (while menus
|
|
|
179 (setq path (list (car (car menus))))
|
|
|
180 (if (and remove (find-menu-item current-menubar path))
|
|
|
181 (delete-menu-item path)
|
|
|
182 (or (car (find-menu-item current-menubar path))
|
|
|
183 (add-menu nil (car (car menus)) (cdr (car menus)) nil)))
|
|
|
184 (setq menus (cdr menus)))))
|
|
|
185
|
|
|
186 ;;;###autoload
|
|
|
187 (defvar outline-minor-mode nil
|
|
|
188 "Non-nil if using Outline mode as a minor mode of some other mode.")
|
|
|
189 ;;;###autoload
|
|
|
190 (make-variable-buffer-local 'outline-minor-mode)
|
|
|
191 ;;;###autoload
|
|
|
192 (put 'outline-minor-mode 'permanent-local t)
|
|
|
193 ;(or (assq 'outline-minor-mode minor-mode-alist)
|
|
|
194 ; (setq minor-mode-alist (append minor-mode-alist
|
|
|
195 ; (list '(outline-minor-mode " Outl")))))
|
|
|
196 ;; XEmacs: do it right.
|
|
|
197 ;;;###autoload
|
|
|
198 (add-minor-mode 'outline-minor-mode " Outl")
|
|
|
199
|
|
2
|
200 (defvar outline-font-lock-keywords
|
|
|
201 '(;; Highlight headings according to the level.
|
|
|
202 ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$"
|
|
|
203 (1 font-lock-string-face)
|
|
|
204 (2 (let ((len (- (match-end 1) (match-beginning 1))))
|
|
|
205 (or (cdr (assq len '((1 . font-lock-function-name-face)
|
|
|
206 (2 . font-lock-keyword-face)
|
|
|
207 (3 . font-lock-comment-face))))
|
|
|
208 font-lock-variable-name-face))
|
|
|
209 nil t))
|
|
|
210 ;; Highlight citations of the form [1] and [Mar94].
|
|
|
211 ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))
|
|
|
212 "Additional expressions to highlight in Outline mode.")
|
|
|
213
|
|
0
|
214 ;;;###autoload
|
|
|
215 (defun outline-mode ()
|
|
|
216 "Set major mode for editing outlines with selective display.
|
|
|
217 Headings are lines which start with asterisks: one for major headings,
|
|
|
218 two for subheadings, etc. Lines not starting with asterisks are body lines.
|
|
|
219
|
|
|
220 Body text or subheadings under a heading can be made temporarily
|
|
|
221 invisible, or visible again. Invisible lines are attached to the end
|
|
|
222 of the heading, so they move with it, if the line is killed and yanked
|
|
|
223 back. A heading with text hidden under it is marked with an ellipsis (...).
|
|
|
224
|
|
|
225 Commands:\\<outline-mode-map>
|
|
|
226 \\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
|
|
|
227 \\[outline-previous-visible-heading] outline-previous-visible-heading
|
|
|
228 \\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
|
|
|
229 \\[outline-backward-same-level] outline-backward-same-level
|
|
|
230 \\[outline-up-heading] outline-up-heading move from subheading to heading
|
|
|
231
|
|
|
232 \\[hide-body] make all text invisible (not headings).
|
|
|
233 \\[show-all] make everything in buffer visible.
|
|
|
234
|
|
|
235 The remaining commands are used when point is on a heading line.
|
|
|
236 They apply to some of the body or subheadings of that heading.
|
|
|
237 \\[hide-subtree] hide-subtree make body and subheadings invisible.
|
|
|
238 \\[show-subtree] show-subtree make body and subheadings visible.
|
|
|
239 \\[show-children] show-children make direct subheadings visible.
|
|
|
240 No effect on body, or subheadings 2 or more levels down.
|
|
|
241 With arg N, affects subheadings N levels down.
|
|
|
242 \\[hide-entry] make immediately following body invisible.
|
|
|
243 \\[show-entry] make it visible.
|
|
|
244 \\[hide-leaves] make body under heading and under its subheadings invisible.
|
|
|
245 The subheadings remain visible.
|
|
|
246 \\[show-branches] make all subheadings at all levels visible.
|
|
|
247
|
|
|
248 The variable `outline-regexp' can be changed to control what is a heading.
|
|
|
249 A line is a heading if `outline-regexp' matches something at the
|
|
|
250 beginning of the line. The longer the match, the deeper the level.
|
|
|
251
|
|
|
252 Turning on outline mode calls the value of `text-mode-hook' and then of
|
|
|
253 `outline-mode-hook', if they are non-nil."
|
|
|
254 (interactive)
|
|
|
255 (kill-all-local-variables)
|
|
|
256 (setq selective-display t)
|
|
|
257 (use-local-map outline-mode-map)
|
|
|
258 (setq mode-name "Outline")
|
|
|
259 (setq major-mode 'outline-mode)
|
|
|
260 (define-abbrev-table 'text-mode-abbrev-table ())
|
|
|
261 (setq local-abbrev-table text-mode-abbrev-table)
|
|
|
262 (set-syntax-table text-mode-syntax-table)
|
|
|
263 (make-local-variable 'paragraph-start)
|
|
2
|
264 (setq paragraph-start (concat paragraph-start "\\|\\("
|
|
0
|
265 outline-regexp "\\)"))
|
|
|
266 ;; Inhibit auto-filling of header lines.
|
|
|
267 (make-local-variable 'auto-fill-inhibit-regexp)
|
|
|
268 (setq auto-fill-inhibit-regexp outline-regexp)
|
|
|
269 (make-local-variable 'paragraph-separate)
|
|
2
|
270 (setq paragraph-separate (concat paragraph-separate "\\|\\("
|
|
0
|
271 outline-regexp "\\)"))
|
|
|
272 ;; #+XEmacs
|
|
|
273 (outline-install-menubar)
|
|
2
|
274 (make-local-variable 'font-lock-defaults)
|
|
|
275 (setq font-lock-defaults '(outline-font-lock-keywords t))
|
|
|
276 (make-local-variable 'change-major-mode-hook)
|
|
0
|
277 (add-hook 'change-major-mode-hook 'show-all)
|
|
|
278 (run-hooks 'text-mode-hook 'outline-mode-hook))
|
|
|
279
|
|
2
|
280 (defvar outline-minor-mode-prefix "\C-c@"
|
|
|
281 "*Prefix key to use for Outline commands in Outline minor mode.
|
|
|
282 The value of this variable is checked as part of loading Outline mode.
|
|
|
283 After that, changing the prefix key requires manipulating keymaps.")
|
|
0
|
284
|
|
|
285 (defvar outline-minor-mode-map nil)
|
|
|
286 (if outline-minor-mode-map
|
|
|
287 nil
|
|
|
288 (setq outline-minor-mode-map (make-sparse-keymap))
|
|
2
|
289 (define-key outline-minor-mode-map [menu-bar]
|
|
|
290 outline-mode-menu-bar-map)
|
|
0
|
291 (define-key outline-minor-mode-map outline-minor-mode-prefix
|
|
2
|
292 outline-mode-prefix-map))
|
|
0
|
293
|
|
|
294 (or (assq 'outline-minor-mode minor-mode-map-alist)
|
|
|
295 (setq minor-mode-map-alist
|
|
|
296 (cons (cons 'outline-minor-mode outline-minor-mode-map)
|
|
|
297 minor-mode-map-alist)))
|
|
|
298
|
|
|
299 ;;;###autoload
|
|
|
300 (defun outline-minor-mode (&optional arg)
|
|
|
301 "Toggle Outline minor mode.
|
|
|
302 With arg, turn Outline minor mode on if arg is positive, off otherwise.
|
|
|
303 See the command `outline-mode' for more information on this mode."
|
|
|
304 (interactive "P")
|
|
|
305 (setq outline-minor-mode
|
|
|
306 (if (null arg) (not outline-minor-mode)
|
|
|
307 (> (prefix-numeric-value arg) 0)))
|
|
|
308 (if outline-minor-mode
|
|
|
309 (progn
|
|
|
310 (setq selective-display t)
|
|
|
311 ;; #+XEmacs
|
|
|
312 (outline-install-menubar)
|
|
|
313 (run-hooks 'outline-minor-mode-hook))
|
|
2
|
314 (setq selective-display nil))
|
|
|
315 ;; When turning off outline mode, get rid of any ^M's.
|
|
24
|
316 (unless outline-minor-mode
|
|
|
317 (outline-flag-region (point-min) (point-max) ?\n)
|
|
|
318 ;; XEmacs change
|
|
|
319 (set-buffer-modified-p (buffer-modified-p))
|
|
|
320 ;; #+XEmacs
|
|
|
321 (outline-install-menubar 'remove))
|
|
2
|
322 ;; XEmacs change
|
|
|
323 (redraw-modeline))
|
|
0
|
324
|
|
|
325 (defvar outline-level 'outline-level
|
|
|
326 "Function of no args to compute a header's nesting level in an outline.
|
|
|
327 It can assume point is at the beginning of a header line.")
|
|
|
328
|
|
|
329 ;; This used to count columns rather than characters, but that made ^L
|
|
|
330 ;; appear to be at level 2 instead of 1. Columns would be better for
|
|
|
331 ;; tab handling, but the default regexp doesn't use tabs, and anyone
|
|
|
332 ;; who changes the regexp can also redefine the outline-level variable
|
|
|
333 ;; as appropriate.
|
|
|
334 (defun outline-level ()
|
|
|
335 "Return the depth to which a statement is nested in the outline.
|
|
|
336 Point must be at the beginning of a header line. This is actually
|
|
2
|
337 the number of characters that `outline-regexp' matches."
|
|
0
|
338 (save-excursion
|
|
|
339 (looking-at outline-regexp)
|
|
|
340 (- (match-end 0) (match-beginning 0))))
|
|
|
341
|
|
|
342 (defun outline-next-preface ()
|
|
2
|
343 "Skip forward to just before the next heading line.
|
|
|
344 If there's no following heading line, stop before the newline
|
|
|
345 at the end of the buffer."
|
|
0
|
346 (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
|
|
|
347 nil 'move)
|
|
2
|
348 (goto-char (match-beginning 0)))
|
|
|
349 (if (memq (preceding-char) '(?\n ?\^M))
|
|
|
350 (forward-char -1)))
|
|
0
|
351
|
|
|
352 (defun outline-next-heading ()
|
|
|
353 "Move to the next (possibly invisible) heading line."
|
|
|
354 (interactive)
|
|
|
355 (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
|
|
|
356 nil 'move)
|
|
|
357 (goto-char (1+ (match-beginning 0)))))
|
|
|
358
|
|
|
359 (defun outline-back-to-heading ()
|
|
|
360 "Move to previous heading line, or beg of this line if it's a heading.
|
|
|
361 Only visible heading lines are considered."
|
|
|
362 (beginning-of-line)
|
|
|
363 (or (outline-on-heading-p)
|
|
|
364 (re-search-backward (concat "^\\(" outline-regexp "\\)") nil t)
|
|
|
365 (error "before first heading")))
|
|
|
366
|
|
|
367 (defun outline-on-heading-p ()
|
|
|
368 "Return t if point is on a (visible) heading line."
|
|
|
369 (save-excursion
|
|
|
370 (beginning-of-line)
|
|
|
371 (and (bolp)
|
|
|
372 (looking-at outline-regexp))))
|
|
|
373
|
|
|
374 (defun outline-end-of-heading ()
|
|
|
375 (if (re-search-forward outline-heading-end-regexp nil 'move)
|
|
|
376 (forward-char -1)))
|
|
|
377
|
|
|
378 (defun outline-next-visible-heading (arg)
|
|
|
379 "Move to the next visible heading line.
|
|
|
380 With argument, repeats or can move backward if negative.
|
|
|
381 A heading line is one that starts with a `*' (or that
|
|
|
382 `outline-regexp' matches)."
|
|
|
383 (interactive "p")
|
|
|
384 (if (< arg 0)
|
|
|
385 (beginning-of-line)
|
|
|
386 (end-of-line))
|
|
|
387 (or (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t arg)
|
|
|
388 (error ""))
|
|
|
389 (beginning-of-line))
|
|
|
390
|
|
|
391 (defun outline-previous-visible-heading (arg)
|
|
|
392 "Move to the previous heading line.
|
|
|
393 With argument, repeats or can move forward if negative.
|
|
|
394 A heading line is one that starts with a `*' (or that
|
|
|
395 `outline-regexp' matches)."
|
|
|
396 (interactive "p")
|
|
|
397 (outline-next-visible-heading (- arg)))
|
|
|
398
|
|
|
399 (defun outline-flag-region (from to flag)
|
|
|
400 "Hides or shows lines from FROM to TO, according to FLAG.
|
|
|
401 If FLAG is `\\n' (newline character) then text is shown,
|
|
|
402 while if FLAG is `\\^M' (control-M) the text is hidden."
|
|
|
403 (let (buffer-read-only)
|
|
|
404 (subst-char-in-region from to
|
|
|
405 (if (= flag ?\n) ?\^M ?\n)
|
|
|
406 flag t)))
|
|
|
407
|
|
|
408 (defun hide-entry ()
|
|
|
409 "Hide the body directly following this heading."
|
|
|
410 (interactive)
|
|
|
411 (outline-back-to-heading)
|
|
|
412 (outline-end-of-heading)
|
|
|
413 (save-excursion
|
|
|
414 (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
|
|
|
415
|
|
|
416 (defun show-entry ()
|
|
|
417 "Show the body directly following this heading."
|
|
|
418 (interactive)
|
|
|
419 (save-excursion
|
|
|
420 (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
|
|
|
421
|
|
|
422 (defun hide-body ()
|
|
|
423 "Hide all of buffer except headings."
|
|
|
424 (interactive)
|
|
|
425 (hide-region-body (point-min) (point-max)))
|
|
|
426
|
|
|
427 (defun hide-region-body (start end)
|
|
|
428 "Hide all body lines in the region, but not headings."
|
|
|
429 (save-excursion
|
|
|
430 (save-restriction
|
|
|
431 (narrow-to-region start end)
|
|
|
432 (goto-char (point-min))
|
|
|
433 (if (outline-on-heading-p)
|
|
|
434 (outline-end-of-heading))
|
|
|
435 (while (not (eobp))
|
|
|
436 (outline-flag-region (point)
|
|
|
437 (progn (outline-next-preface) (point)) ?\^M)
|
|
|
438 (if (not (eobp))
|
|
|
439 (progn
|
|
|
440 (forward-char
|
|
|
441 (if (looking-at "[\n\^M][\n\^M]")
|
|
|
442 2 1))
|
|
|
443 (outline-end-of-heading)))))))
|
|
|
444
|
|
|
445 (defun show-all ()
|
|
|
446 "Show all of the text in the buffer."
|
|
|
447 (interactive)
|
|
|
448 (outline-flag-region (point-min) (point-max) ?\n))
|
|
|
449
|
|
|
450 (defun hide-subtree ()
|
|
|
451 "Hide everything after this heading at deeper levels."
|
|
|
452 (interactive)
|
|
|
453 (outline-flag-subtree ?\^M))
|
|
|
454
|
|
|
455 (defun hide-leaves ()
|
|
|
456 "Hide all body after this heading at deeper levels."
|
|
|
457 (interactive)
|
|
|
458 (outline-back-to-heading)
|
|
|
459 (outline-end-of-heading)
|
|
|
460 (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
|
|
|
461
|
|
|
462 (defun show-subtree ()
|
|
|
463 "Show everything after this heading at deeper levels."
|
|
|
464 (interactive)
|
|
|
465 (outline-flag-subtree ?\n))
|
|
|
466
|
|
|
467 (defun hide-sublevels (levels)
|
|
|
468 "Hide everything but the top LEVELS levels of headers, in whole buffer."
|
|
|
469 (interactive "p")
|
|
|
470 (if (< levels 1)
|
|
|
471 (error "Must keep at least one level of headers"))
|
|
|
472 (setq levels (1- levels))
|
|
|
473 (save-excursion
|
|
|
474 (goto-char (point-min))
|
|
|
475 ;; Keep advancing to the next top-level heading.
|
|
|
476 (while (or (and (bobp) (outline-on-heading-p))
|
|
|
477 (outline-next-heading))
|
|
|
478 (let ((end (save-excursion (outline-end-of-subtree) (point))))
|
|
|
479 ;; Hide everything under that.
|
|
|
480 (outline-flag-region (point) end ?\^M)
|
|
|
481 ;; Show the first LEVELS levels under that.
|
|
|
482 (if (> levels 0)
|
|
|
483 (show-children levels))
|
|
|
484 ;; Move to the next, since we already found it.
|
|
|
485 (goto-char end)))))
|
|
|
486
|
|
|
487 (defun hide-other ()
|
|
|
488 "Hide everything except for the current body and the parent headings."
|
|
|
489 (interactive)
|
|
|
490 (hide-sublevels 1)
|
|
2
|
491 (let ((last (point))
|
|
|
492 (pos (point)))
|
|
0
|
493 (while (save-excursion
|
|
|
494 (and (re-search-backward "[\n\r]" nil t)
|
|
|
495 (eq (following-char) ?\r)))
|
|
|
496 (save-excursion
|
|
|
497 (beginning-of-line)
|
|
|
498 (if (eq last (point))
|
|
|
499 (progn
|
|
|
500 (outline-next-heading)
|
|
|
501 (outline-flag-region last (point) ?\n))
|
|
|
502 (show-children)
|
|
|
503 (setq last (point)))))))
|
|
|
504
|
|
|
505 (defun outline-flag-subtree (flag)
|
|
|
506 (save-excursion
|
|
|
507 (outline-back-to-heading)
|
|
|
508 (outline-end-of-heading)
|
|
|
509 (outline-flag-region (point)
|
|
|
510 (progn (outline-end-of-subtree) (point))
|
|
|
511 flag)))
|
|
|
512
|
|
|
513 (defun outline-end-of-subtree ()
|
|
|
514 (outline-back-to-heading)
|
|
2
|
515 (let ((opoint (point))
|
|
|
516 (first t)
|
|
0
|
517 (level (funcall outline-level)))
|
|
|
518 (while (and (not (eobp))
|
|
|
519 (or first (> (funcall outline-level) level)))
|
|
|
520 (setq first nil)
|
|
|
521 (outline-next-heading))
|
|
|
522 (if (memq (preceding-char) '(?\n ?\^M))
|
|
|
523 (progn
|
|
|
524 ;; Go to end of line before heading
|
|
|
525 (forward-char -1)
|
|
|
526 (if (memq (preceding-char) '(?\n ?\^M))
|
|
|
527 ;; leave blank line before heading
|
|
|
528 (forward-char -1))))))
|
|
|
529
|
|
|
530 (defun show-branches ()
|
|
|
531 "Show all subheadings of this heading, but not their bodies."
|
|
|
532 (interactive)
|
|
|
533 (show-children 1000))
|
|
|
534
|
|
|
535 (defun show-children (&optional level)
|
|
|
536 "Show all direct subheadings of this heading.
|
|
|
537 Prefix arg LEVEL is how many levels below the current level should be shown.
|
|
|
538 Default is enough to cause the following heading to appear."
|
|
|
539 (interactive "P")
|
|
|
540 (setq level
|
|
|
541 (if level (prefix-numeric-value level)
|
|
|
542 (save-excursion
|
|
|
543 (outline-back-to-heading)
|
|
|
544 (let ((start-level (funcall outline-level)))
|
|
|
545 (outline-next-heading)
|
|
|
546 (if (eobp)
|
|
|
547 1
|
|
|
548 (max 1 (- (funcall outline-level) start-level)))))))
|
|
|
549 (save-excursion
|
|
|
550 (save-restriction
|
|
|
551 (outline-back-to-heading)
|
|
|
552 (setq level (+ level (funcall outline-level)))
|
|
|
553 (narrow-to-region (point)
|
|
|
554 (progn (outline-end-of-subtree)
|
|
|
555 (if (eobp) (point-max) (1+ (point)))))
|
|
|
556 (goto-char (point-min))
|
|
|
557 (while (and (not (eobp))
|
|
|
558 (progn
|
|
|
559 (outline-next-heading)
|
|
|
560 (not (eobp))))
|
|
|
561 (if (<= (funcall outline-level) level)
|
|
|
562 (save-excursion
|
|
|
563 (outline-flag-region (save-excursion
|
|
|
564 (forward-char -1)
|
|
|
565 (if (memq (preceding-char) '(?\n ?\^M))
|
|
|
566 (forward-char -1))
|
|
|
567 (point))
|
|
|
568 (progn (outline-end-of-heading) (point))
|
|
|
569 ?\n)))))))
|
|
|
570
|
|
|
571 (defun outline-up-heading (arg)
|
|
|
572 "Move to the heading line of which the present line is a subheading.
|
|
|
573 With argument, move up ARG levels."
|
|
|
574 (interactive "p")
|
|
|
575 (outline-back-to-heading)
|
|
|
576 (if (eq (funcall outline-level) 1)
|
|
|
577 (error ""))
|
|
|
578 (while (and (> (funcall outline-level) 1)
|
|
|
579 (> arg 0)
|
|
|
580 (not (bobp)))
|
|
|
581 (let ((present-level (funcall outline-level)))
|
|
|
582 (while (not (< (funcall outline-level) present-level))
|
|
|
583 (outline-previous-visible-heading 1))
|
|
|
584 (setq arg (- arg 1)))))
|
|
|
585
|
|
|
586 (defun outline-forward-same-level (arg)
|
|
|
587 "Move forward to the ARG'th subheading at same level as this one.
|
|
|
588 Stop at the first and last subheadings of a superior heading."
|
|
|
589 (interactive "p")
|
|
|
590 (outline-back-to-heading)
|
|
|
591 (while (> arg 0)
|
|
|
592 (let ((point-to-move-to (save-excursion
|
|
|
593 (outline-get-next-sibling))))
|
|
|
594 (if point-to-move-to
|
|
|
595 (progn
|
|
|
596 (goto-char point-to-move-to)
|
|
|
597 (setq arg (1- arg)))
|
|
|
598 (progn
|
|
|
599 (setq arg 0)
|
|
|
600 (error ""))))))
|
|
|
601
|
|
|
602 (defun outline-get-next-sibling ()
|
|
|
603 "Move to next heading of the same level, and return point or nil if none."
|
|
|
604 (let ((level (funcall outline-level)))
|
|
|
605 (outline-next-visible-heading 1)
|
|
|
606 (while (and (> (funcall outline-level) level)
|
|
|
607 (not (eobp)))
|
|
|
608 (outline-next-visible-heading 1))
|
|
|
609 (if (< (funcall outline-level) level)
|
|
|
610 nil
|
|
|
611 (point))))
|
|
|
612
|
|
|
613 (defun outline-backward-same-level (arg)
|
|
|
614 "Move backward to the ARG'th subheading at same level as this one.
|
|
|
615 Stop at the first and last subheadings of a superior heading."
|
|
|
616 (interactive "p")
|
|
|
617 (outline-back-to-heading)
|
|
|
618 (while (> arg 0)
|
|
|
619 (let ((point-to-move-to (save-excursion
|
|
|
620 (outline-get-last-sibling))))
|
|
|
621 (if point-to-move-to
|
|
|
622 (progn
|
|
|
623 (goto-char point-to-move-to)
|
|
|
624 (setq arg (1- arg)))
|
|
|
625 (progn
|
|
|
626 (setq arg 0)
|
|
|
627 (error ""))))))
|
|
|
628
|
|
|
629 (defun outline-get-last-sibling ()
|
|
|
630 "Move to next heading of the same level, and return point or nil if none."
|
|
|
631 (let ((level (funcall outline-level)))
|
|
|
632 (outline-previous-visible-heading 1)
|
|
|
633 (while (and (> (funcall outline-level) level)
|
|
|
634 (not (bobp)))
|
|
|
635 (outline-previous-visible-heading 1))
|
|
|
636 (if (< (funcall outline-level) level)
|
|
|
637 nil
|
|
|
638 (point))))
|
|
|
639
|
|
|
640 (provide 'outline)
|
|
|
641
|
|
|
642 ;;; outline.el ends here
|
