|
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
|
|
48
|
175 ;; This is a nop if menubars aren't available
|
|
|
176 (when (and (featurep 'menubar) ; XEmacs
|
|
|
177 current-menubar)
|
|
|
178 (let ((menus (cdr outline-mode-menu)) path)
|
|
|
179 (and (not remove)
|
|
|
180 (set-buffer-menubar (copy-sequence current-menubar)))
|
|
|
181 (while menus
|
|
|
182 (setq path (list (car (car menus))))
|
|
|
183 (if (and remove (find-menu-item current-menubar path))
|
|
|
184 (delete-menu-item path)
|
|
|
185 (or (car (find-menu-item current-menubar path))
|
|
|
186 (add-menu nil (car (car menus)) (cdr (car menus)) nil)))
|
|
|
187 (setq menus (cdr menus))))))
|
|
0
|
188
|
|
|
189 ;;;###autoload
|
|
|
190 (defvar outline-minor-mode nil
|
|
|
191 "Non-nil if using Outline mode as a minor mode of some other mode.")
|
|
|
192 ;;;###autoload
|
|
|
193 (make-variable-buffer-local 'outline-minor-mode)
|
|
|
194 ;;;###autoload
|
|
|
195 (put 'outline-minor-mode 'permanent-local t)
|
|
|
196 ;(or (assq 'outline-minor-mode minor-mode-alist)
|
|
|
197 ; (setq minor-mode-alist (append minor-mode-alist
|
|
|
198 ; (list '(outline-minor-mode " Outl")))))
|
|
|
199 ;; XEmacs: do it right.
|
|
|
200 ;;;###autoload
|
|
|
201 (add-minor-mode 'outline-minor-mode " Outl")
|
|
|
202
|
|
2
|
203 (defvar outline-font-lock-keywords
|
|
|
204 '(;; Highlight headings according to the level.
|
|
|
205 ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$"
|
|
|
206 (1 font-lock-string-face)
|
|
|
207 (2 (let ((len (- (match-end 1) (match-beginning 1))))
|
|
|
208 (or (cdr (assq len '((1 . font-lock-function-name-face)
|
|
|
209 (2 . font-lock-keyword-face)
|
|
|
210 (3 . font-lock-comment-face))))
|
|
|
211 font-lock-variable-name-face))
|
|
|
212 nil t))
|
|
|
213 ;; Highlight citations of the form [1] and [Mar94].
|
|
|
214 ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))
|
|
|
215 "Additional expressions to highlight in Outline mode.")
|
|
|
216
|
|
0
|
217 ;;;###autoload
|
|
|
218 (defun outline-mode ()
|
|
|
219 "Set major mode for editing outlines with selective display.
|
|
|
220 Headings are lines which start with asterisks: one for major headings,
|
|
|
221 two for subheadings, etc. Lines not starting with asterisks are body lines.
|
|
|
222
|
|
|
223 Body text or subheadings under a heading can be made temporarily
|
|
|
224 invisible, or visible again. Invisible lines are attached to the end
|
|
|
225 of the heading, so they move with it, if the line is killed and yanked
|
|
|
226 back. A heading with text hidden under it is marked with an ellipsis (...).
|
|
|
227
|
|
|
228 Commands:\\<outline-mode-map>
|
|
|
229 \\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
|
|
|
230 \\[outline-previous-visible-heading] outline-previous-visible-heading
|
|
|
231 \\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
|
|
|
232 \\[outline-backward-same-level] outline-backward-same-level
|
|
|
233 \\[outline-up-heading] outline-up-heading move from subheading to heading
|
|
|
234
|
|
|
235 \\[hide-body] make all text invisible (not headings).
|
|
|
236 \\[show-all] make everything in buffer visible.
|
|
|
237
|
|
|
238 The remaining commands are used when point is on a heading line.
|
|
|
239 They apply to some of the body or subheadings of that heading.
|
|
|
240 \\[hide-subtree] hide-subtree make body and subheadings invisible.
|
|
|
241 \\[show-subtree] show-subtree make body and subheadings visible.
|
|
|
242 \\[show-children] show-children make direct subheadings visible.
|
|
|
243 No effect on body, or subheadings 2 or more levels down.
|
|
|
244 With arg N, affects subheadings N levels down.
|
|
|
245 \\[hide-entry] make immediately following body invisible.
|
|
|
246 \\[show-entry] make it visible.
|
|
|
247 \\[hide-leaves] make body under heading and under its subheadings invisible.
|
|
|
248 The subheadings remain visible.
|
|
|
249 \\[show-branches] make all subheadings at all levels visible.
|
|
|
250
|
|
|
251 The variable `outline-regexp' can be changed to control what is a heading.
|
|
|
252 A line is a heading if `outline-regexp' matches something at the
|
|
|
253 beginning of the line. The longer the match, the deeper the level.
|
|
|
254
|
|
|
255 Turning on outline mode calls the value of `text-mode-hook' and then of
|
|
|
256 `outline-mode-hook', if they are non-nil."
|
|
|
257 (interactive)
|
|
|
258 (kill-all-local-variables)
|
|
|
259 (setq selective-display t)
|
|
|
260 (use-local-map outline-mode-map)
|
|
|
261 (setq mode-name "Outline")
|
|
|
262 (setq major-mode 'outline-mode)
|
|
|
263 (define-abbrev-table 'text-mode-abbrev-table ())
|
|
|
264 (setq local-abbrev-table text-mode-abbrev-table)
|
|
|
265 (set-syntax-table text-mode-syntax-table)
|
|
|
266 (make-local-variable 'paragraph-start)
|
|
2
|
267 (setq paragraph-start (concat paragraph-start "\\|\\("
|
|
0
|
268 outline-regexp "\\)"))
|
|
|
269 ;; Inhibit auto-filling of header lines.
|
|
|
270 (make-local-variable 'auto-fill-inhibit-regexp)
|
|
|
271 (setq auto-fill-inhibit-regexp outline-regexp)
|
|
|
272 (make-local-variable 'paragraph-separate)
|
|
2
|
273 (setq paragraph-separate (concat paragraph-separate "\\|\\("
|
|
0
|
274 outline-regexp "\\)"))
|
|
|
275 ;; #+XEmacs
|
|
|
276 (outline-install-menubar)
|
|
2
|
277 (make-local-variable 'font-lock-defaults)
|
|
|
278 (setq font-lock-defaults '(outline-font-lock-keywords t))
|
|
|
279 (make-local-variable 'change-major-mode-hook)
|
|
0
|
280 (add-hook 'change-major-mode-hook 'show-all)
|
|
|
281 (run-hooks 'text-mode-hook 'outline-mode-hook))
|
|
|
282
|
|
2
|
283 (defvar outline-minor-mode-prefix "\C-c@"
|
|
|
284 "*Prefix key to use for Outline commands in Outline minor mode.
|
|
|
285 The value of this variable is checked as part of loading Outline mode.
|
|
|
286 After that, changing the prefix key requires manipulating keymaps.")
|
|
0
|
287
|
|
|
288 (defvar outline-minor-mode-map nil)
|
|
|
289 (if outline-minor-mode-map
|
|
|
290 nil
|
|
|
291 (setq outline-minor-mode-map (make-sparse-keymap))
|
|
2
|
292 (define-key outline-minor-mode-map [menu-bar]
|
|
|
293 outline-mode-menu-bar-map)
|
|
0
|
294 (define-key outline-minor-mode-map outline-minor-mode-prefix
|
|
2
|
295 outline-mode-prefix-map))
|
|
0
|
296
|
|
|
297 (or (assq 'outline-minor-mode minor-mode-map-alist)
|
|
|
298 (setq minor-mode-map-alist
|
|
|
299 (cons (cons 'outline-minor-mode outline-minor-mode-map)
|
|
|
300 minor-mode-map-alist)))
|
|
|
301
|
|
|
302 ;;;###autoload
|
|
|
303 (defun outline-minor-mode (&optional arg)
|
|
|
304 "Toggle Outline minor mode.
|
|
|
305 With arg, turn Outline minor mode on if arg is positive, off otherwise.
|
|
|
306 See the command `outline-mode' for more information on this mode."
|
|
|
307 (interactive "P")
|
|
|
308 (setq outline-minor-mode
|
|
|
309 (if (null arg) (not outline-minor-mode)
|
|
|
310 (> (prefix-numeric-value arg) 0)))
|
|
|
311 (if outline-minor-mode
|
|
|
312 (progn
|
|
|
313 (setq selective-display t)
|
|
|
314 ;; #+XEmacs
|
|
|
315 (outline-install-menubar)
|
|
|
316 (run-hooks 'outline-minor-mode-hook))
|
|
2
|
317 (setq selective-display nil))
|
|
|
318 ;; When turning off outline mode, get rid of any ^M's.
|
|
24
|
319 (unless outline-minor-mode
|
|
|
320 (outline-flag-region (point-min) (point-max) ?\n)
|
|
|
321 ;; XEmacs change
|
|
|
322 (set-buffer-modified-p (buffer-modified-p))
|
|
|
323 ;; #+XEmacs
|
|
|
324 (outline-install-menubar 'remove))
|
|
2
|
325 ;; XEmacs change
|
|
|
326 (redraw-modeline))
|
|
0
|
327
|
|
|
328 (defvar outline-level 'outline-level
|
|
|
329 "Function of no args to compute a header's nesting level in an outline.
|
|
|
330 It can assume point is at the beginning of a header line.")
|
|
|
331
|
|
|
332 ;; This used to count columns rather than characters, but that made ^L
|
|
|
333 ;; appear to be at level 2 instead of 1. Columns would be better for
|
|
|
334 ;; tab handling, but the default regexp doesn't use tabs, and anyone
|
|
|
335 ;; who changes the regexp can also redefine the outline-level variable
|
|
|
336 ;; as appropriate.
|
|
|
337 (defun outline-level ()
|
|
|
338 "Return the depth to which a statement is nested in the outline.
|
|
|
339 Point must be at the beginning of a header line. This is actually
|
|
2
|
340 the number of characters that `outline-regexp' matches."
|
|
0
|
341 (save-excursion
|
|
|
342 (looking-at outline-regexp)
|
|
|
343 (- (match-end 0) (match-beginning 0))))
|
|
|
344
|
|
|
345 (defun outline-next-preface ()
|
|
2
|
346 "Skip forward to just before the next heading line.
|
|
|
347 If there's no following heading line, stop before the newline
|
|
|
348 at the end of the buffer."
|
|
0
|
349 (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
|
|
|
350 nil 'move)
|
|
2
|
351 (goto-char (match-beginning 0)))
|
|
|
352 (if (memq (preceding-char) '(?\n ?\^M))
|
|
|
353 (forward-char -1)))
|
|
0
|
354
|
|
|
355 (defun outline-next-heading ()
|
|
|
356 "Move to the next (possibly invisible) heading line."
|
|
|
357 (interactive)
|
|
|
358 (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
|
|
|
359 nil 'move)
|
|
|
360 (goto-char (1+ (match-beginning 0)))))
|
|
|
361
|
|
|
362 (defun outline-back-to-heading ()
|
|
|
363 "Move to previous heading line, or beg of this line if it's a heading.
|
|
|
364 Only visible heading lines are considered."
|
|
|
365 (beginning-of-line)
|
|
|
366 (or (outline-on-heading-p)
|
|
|
367 (re-search-backward (concat "^\\(" outline-regexp "\\)") nil t)
|
|
|
368 (error "before first heading")))
|
|
|
369
|
|
|
370 (defun outline-on-heading-p ()
|
|
|
371 "Return t if point is on a (visible) heading line."
|
|
|
372 (save-excursion
|
|
|
373 (beginning-of-line)
|
|
|
374 (and (bolp)
|
|
|
375 (looking-at outline-regexp))))
|
|
|
376
|
|
|
377 (defun outline-end-of-heading ()
|
|
|
378 (if (re-search-forward outline-heading-end-regexp nil 'move)
|
|
|
379 (forward-char -1)))
|
|
|
380
|
|
|
381 (defun outline-next-visible-heading (arg)
|
|
|
382 "Move to the next visible heading line.
|
|
|
383 With argument, repeats or can move backward if negative.
|
|
|
384 A heading line is one that starts with a `*' (or that
|
|
|
385 `outline-regexp' matches)."
|
|
|
386 (interactive "p")
|
|
|
387 (if (< arg 0)
|
|
|
388 (beginning-of-line)
|
|
|
389 (end-of-line))
|
|
|
390 (or (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t arg)
|
|
|
391 (error ""))
|
|
|
392 (beginning-of-line))
|
|
|
393
|
|
|
394 (defun outline-previous-visible-heading (arg)
|
|
|
395 "Move to the previous heading line.
|
|
|
396 With argument, repeats or can move forward if negative.
|
|
|
397 A heading line is one that starts with a `*' (or that
|
|
|
398 `outline-regexp' matches)."
|
|
|
399 (interactive "p")
|
|
|
400 (outline-next-visible-heading (- arg)))
|
|
|
401
|
|
|
402 (defun outline-flag-region (from to flag)
|
|
|
403 "Hides or shows lines from FROM to TO, according to FLAG.
|
|
|
404 If FLAG is `\\n' (newline character) then text is shown,
|
|
|
405 while if FLAG is `\\^M' (control-M) the text is hidden."
|
|
|
406 (let (buffer-read-only)
|
|
|
407 (subst-char-in-region from to
|
|
|
408 (if (= flag ?\n) ?\^M ?\n)
|
|
|
409 flag t)))
|
|
|
410
|
|
|
411 (defun hide-entry ()
|
|
|
412 "Hide the body directly following this heading."
|
|
|
413 (interactive)
|
|
|
414 (outline-back-to-heading)
|
|
|
415 (outline-end-of-heading)
|
|
|
416 (save-excursion
|
|
|
417 (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
|
|
|
418
|
|
|
419 (defun show-entry ()
|
|
|
420 "Show the body directly following this heading."
|
|
|
421 (interactive)
|
|
|
422 (save-excursion
|
|
|
423 (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
|
|
|
424
|
|
|
425 (defun hide-body ()
|
|
|
426 "Hide all of buffer except headings."
|
|
|
427 (interactive)
|
|
|
428 (hide-region-body (point-min) (point-max)))
|
|
|
429
|
|
|
430 (defun hide-region-body (start end)
|
|
|
431 "Hide all body lines in the region, but not headings."
|
|
|
432 (save-excursion
|
|
|
433 (save-restriction
|
|
|
434 (narrow-to-region start end)
|
|
|
435 (goto-char (point-min))
|
|
|
436 (if (outline-on-heading-p)
|
|
|
437 (outline-end-of-heading))
|
|
|
438 (while (not (eobp))
|
|
|
439 (outline-flag-region (point)
|
|
|
440 (progn (outline-next-preface) (point)) ?\^M)
|
|
|
441 (if (not (eobp))
|
|
|
442 (progn
|
|
|
443 (forward-char
|
|
|
444 (if (looking-at "[\n\^M][\n\^M]")
|
|
|
445 2 1))
|
|
|
446 (outline-end-of-heading)))))))
|
|
|
447
|
|
|
448 (defun show-all ()
|
|
|
449 "Show all of the text in the buffer."
|
|
|
450 (interactive)
|
|
|
451 (outline-flag-region (point-min) (point-max) ?\n))
|
|
|
452
|
|
|
453 (defun hide-subtree ()
|
|
|
454 "Hide everything after this heading at deeper levels."
|
|
|
455 (interactive)
|
|
|
456 (outline-flag-subtree ?\^M))
|
|
|
457
|
|
|
458 (defun hide-leaves ()
|
|
|
459 "Hide all body after this heading at deeper levels."
|
|
|
460 (interactive)
|
|
|
461 (outline-back-to-heading)
|
|
|
462 (outline-end-of-heading)
|
|
|
463 (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
|
|
|
464
|
|
|
465 (defun show-subtree ()
|
|
|
466 "Show everything after this heading at deeper levels."
|
|
|
467 (interactive)
|
|
|
468 (outline-flag-subtree ?\n))
|
|
|
469
|
|
|
470 (defun hide-sublevels (levels)
|
|
|
471 "Hide everything but the top LEVELS levels of headers, in whole buffer."
|
|
|
472 (interactive "p")
|
|
|
473 (if (< levels 1)
|
|
|
474 (error "Must keep at least one level of headers"))
|
|
|
475 (setq levels (1- levels))
|
|
|
476 (save-excursion
|
|
|
477 (goto-char (point-min))
|
|
|
478 ;; Keep advancing to the next top-level heading.
|
|
|
479 (while (or (and (bobp) (outline-on-heading-p))
|
|
|
480 (outline-next-heading))
|
|
|
481 (let ((end (save-excursion (outline-end-of-subtree) (point))))
|
|
|
482 ;; Hide everything under that.
|
|
|
483 (outline-flag-region (point) end ?\^M)
|
|
|
484 ;; Show the first LEVELS levels under that.
|
|
|
485 (if (> levels 0)
|
|
|
486 (show-children levels))
|
|
|
487 ;; Move to the next, since we already found it.
|
|
|
488 (goto-char end)))))
|
|
|
489
|
|
|
490 (defun hide-other ()
|
|
|
491 "Hide everything except for the current body and the parent headings."
|
|
|
492 (interactive)
|
|
|
493 (hide-sublevels 1)
|
|
2
|
494 (let ((last (point))
|
|
|
495 (pos (point)))
|
|
0
|
496 (while (save-excursion
|
|
|
497 (and (re-search-backward "[\n\r]" nil t)
|
|
|
498 (eq (following-char) ?\r)))
|
|
|
499 (save-excursion
|
|
|
500 (beginning-of-line)
|
|
|
501 (if (eq last (point))
|
|
|
502 (progn
|
|
|
503 (outline-next-heading)
|
|
|
504 (outline-flag-region last (point) ?\n))
|
|
|
505 (show-children)
|
|
|
506 (setq last (point)))))))
|
|
|
507
|
|
|
508 (defun outline-flag-subtree (flag)
|
|
|
509 (save-excursion
|
|
|
510 (outline-back-to-heading)
|
|
|
511 (outline-end-of-heading)
|
|
|
512 (outline-flag-region (point)
|
|
|
513 (progn (outline-end-of-subtree) (point))
|
|
|
514 flag)))
|
|
|
515
|
|
|
516 (defun outline-end-of-subtree ()
|
|
|
517 (outline-back-to-heading)
|
|
2
|
518 (let ((opoint (point))
|
|
|
519 (first t)
|
|
0
|
520 (level (funcall outline-level)))
|
|
|
521 (while (and (not (eobp))
|
|
|
522 (or first (> (funcall outline-level) level)))
|
|
|
523 (setq first nil)
|
|
|
524 (outline-next-heading))
|
|
|
525 (if (memq (preceding-char) '(?\n ?\^M))
|
|
|
526 (progn
|
|
|
527 ;; Go to end of line before heading
|
|
|
528 (forward-char -1)
|
|
|
529 (if (memq (preceding-char) '(?\n ?\^M))
|
|
|
530 ;; leave blank line before heading
|
|
|
531 (forward-char -1))))))
|
|
|
532
|
|
|
533 (defun show-branches ()
|
|
|
534 "Show all subheadings of this heading, but not their bodies."
|
|
|
535 (interactive)
|
|
|
536 (show-children 1000))
|
|
|
537
|
|
|
538 (defun show-children (&optional level)
|
|
|
539 "Show all direct subheadings of this heading.
|
|
|
540 Prefix arg LEVEL is how many levels below the current level should be shown.
|
|
|
541 Default is enough to cause the following heading to appear."
|
|
|
542 (interactive "P")
|
|
|
543 (setq level
|
|
|
544 (if level (prefix-numeric-value level)
|
|
|
545 (save-excursion
|
|
|
546 (outline-back-to-heading)
|
|
|
547 (let ((start-level (funcall outline-level)))
|
|
|
548 (outline-next-heading)
|
|
|
549 (if (eobp)
|
|
|
550 1
|
|
|
551 (max 1 (- (funcall outline-level) start-level)))))))
|
|
|
552 (save-excursion
|
|
|
553 (save-restriction
|
|
|
554 (outline-back-to-heading)
|
|
|
555 (setq level (+ level (funcall outline-level)))
|
|
|
556 (narrow-to-region (point)
|
|
|
557 (progn (outline-end-of-subtree)
|
|
|
558 (if (eobp) (point-max) (1+ (point)))))
|
|
|
559 (goto-char (point-min))
|
|
|
560 (while (and (not (eobp))
|
|
|
561 (progn
|
|
|
562 (outline-next-heading)
|
|
|
563 (not (eobp))))
|
|
|
564 (if (<= (funcall outline-level) level)
|
|
|
565 (save-excursion
|
|
|
566 (outline-flag-region (save-excursion
|
|
|
567 (forward-char -1)
|
|
|
568 (if (memq (preceding-char) '(?\n ?\^M))
|
|
|
569 (forward-char -1))
|
|
|
570 (point))
|
|
|
571 (progn (outline-end-of-heading) (point))
|
|
|
572 ?\n)))))))
|
|
|
573
|
|
|
574 (defun outline-up-heading (arg)
|
|
|
575 "Move to the heading line of which the present line is a subheading.
|
|
|
576 With argument, move up ARG levels."
|
|
|
577 (interactive "p")
|
|
|
578 (outline-back-to-heading)
|
|
|
579 (if (eq (funcall outline-level) 1)
|
|
|
580 (error ""))
|
|
|
581 (while (and (> (funcall outline-level) 1)
|
|
|
582 (> arg 0)
|
|
|
583 (not (bobp)))
|
|
|
584 (let ((present-level (funcall outline-level)))
|
|
|
585 (while (not (< (funcall outline-level) present-level))
|
|
|
586 (outline-previous-visible-heading 1))
|
|
|
587 (setq arg (- arg 1)))))
|
|
|
588
|
|
|
589 (defun outline-forward-same-level (arg)
|
|
|
590 "Move forward to the ARG'th subheading at same level as this one.
|
|
|
591 Stop at the first and last subheadings of a superior heading."
|
|
|
592 (interactive "p")
|
|
|
593 (outline-back-to-heading)
|
|
|
594 (while (> arg 0)
|
|
|
595 (let ((point-to-move-to (save-excursion
|
|
|
596 (outline-get-next-sibling))))
|
|
|
597 (if point-to-move-to
|
|
|
598 (progn
|
|
|
599 (goto-char point-to-move-to)
|
|
|
600 (setq arg (1- arg)))
|
|
|
601 (progn
|
|
|
602 (setq arg 0)
|
|
|
603 (error ""))))))
|
|
|
604
|
|
|
605 (defun outline-get-next-sibling ()
|
|
|
606 "Move to next heading of the same level, and return point or nil if none."
|
|
|
607 (let ((level (funcall outline-level)))
|
|
|
608 (outline-next-visible-heading 1)
|
|
|
609 (while (and (> (funcall outline-level) level)
|
|
|
610 (not (eobp)))
|
|
|
611 (outline-next-visible-heading 1))
|
|
|
612 (if (< (funcall outline-level) level)
|
|
|
613 nil
|
|
|
614 (point))))
|
|
|
615
|
|
|
616 (defun outline-backward-same-level (arg)
|
|
|
617 "Move backward to the ARG'th subheading at same level as this one.
|
|
|
618 Stop at the first and last subheadings of a superior heading."
|
|
|
619 (interactive "p")
|
|
|
620 (outline-back-to-heading)
|
|
|
621 (while (> arg 0)
|
|
|
622 (let ((point-to-move-to (save-excursion
|
|
|
623 (outline-get-last-sibling))))
|
|
|
624 (if point-to-move-to
|
|
|
625 (progn
|
|
|
626 (goto-char point-to-move-to)
|
|
|
627 (setq arg (1- arg)))
|
|
|
628 (progn
|
|
|
629 (setq arg 0)
|
|
|
630 (error ""))))))
|
|
|
631
|
|
|
632 (defun outline-get-last-sibling ()
|
|
|
633 "Move to next heading of the same level, and return point or nil if none."
|
|
|
634 (let ((level (funcall outline-level)))
|
|
|
635 (outline-previous-visible-heading 1)
|
|
|
636 (while (and (> (funcall outline-level) level)
|
|
|
637 (not (bobp)))
|
|
|
638 (outline-previous-visible-heading 1))
|
|
|
639 (if (< (funcall outline-level) level)
|
|
|
640 nil
|
|
|
641 (point))))
|
|
|
642
|
|
|
643 (provide 'outline)
|
|
|
644
|
|
|
645 ;;; outline.el ends here
|
