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