1 ;;; outline.el --- outline mode commands for Emacs
3 ;; Copyright (C) 1986, 93, 94, 95, 97, 2000, 2001
4 ;; Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; This package is a major mode for editing outline-format documents.
29 ;; An outline can be `abstracted' to show headers at any given level,
30 ;; with all stuff below hidden. See the Emacs manual for details.
34 ;; - subtree-terminators
35 ;; - better handle comments before function bodies (i.e. heading)
36 ;; - don't bother hiding whitespace
40 (defgroup outlines nil
41 "Support for hierarchical outlining"
45 (defcustom outline-regexp
"[*\^L]+"
46 "*Regular expression to match the beginning of a heading.
47 Any line whose beginning matches this regexp is considered to start a heading.
48 Note that Outline mode only checks this regexp at the start of a line,
49 so the regexp need not (and usually does not) start with `^'.
50 The recommended way to set this is with a Local Variables: list
51 in the file it applies to. See also `outline-heading-end-regexp'."
52 :type
'(choice regexp
(const nil
))
55 (defcustom outline-heading-end-regexp
"\n"
56 "*Regular expression to match the end of a heading line.
57 You can assume that point is at the beginning of a heading when this
58 regexp is searched for. The heading ends at the end of the match.
59 The recommended way to set this is with a `Local Variables:' list
60 in the file it applies to."
64 (defvar outline-mode-prefix-map
65 (let ((map (make-sparse-keymap)))
66 (define-key map
"@" 'outline-mark-subtree
)
67 (define-key map
"\C-n" 'outline-next-visible-heading
)
68 (define-key map
"\C-p" 'outline-previous-visible-heading
)
69 (define-key map
"\C-i" 'show-children
)
70 (define-key map
"\C-s" 'show-subtree
)
71 (define-key map
"\C-d" 'hide-subtree
)
72 (define-key map
"\C-u" 'outline-up-heading
)
73 (define-key map
"\C-f" 'outline-forward-same-level
)
74 (define-key map
"\C-b" 'outline-backward-same-level
)
75 (define-key map
"\C-t" 'hide-body
)
76 (define-key map
"\C-a" 'show-all
)
77 (define-key map
"\C-c" 'hide-entry
)
78 (define-key map
"\C-e" 'show-entry
)
79 (define-key map
"\C-l" 'hide-leaves
)
80 (define-key map
"\C-k" 'show-branches
)
81 (define-key map
"\C-q" 'hide-sublevels
)
82 (define-key map
"\C-o" 'hide-other
)
83 (define-key map
"\C-^" 'outline-promote
)
84 (define-key map
"\C-v" 'outline-demote
)
85 ;; Where to bind toggle and insert-heading ?
88 (defvar outline-mode-menu-bar-map
89 (let ((map (make-sparse-keymap)))
91 (define-key map
[hide] (cons "Hide" (make-sparse-keymap "Hide")))
93 (define-key map [hide hide-other] '("Hide Other" . hide-other))
94 (define-key map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels))
95 (define-key map [hide hide-subtree] '("Hide Subtree" . hide-subtree))
96 (define-key map [hide hide-entry] '("Hide Entry" . hide-entry))
97 (define-key map [hide hide-body] '("Hide Body" . hide-body))
98 (define-key map [hide hide-leaves] '("Hide Leaves" . hide-leaves))
100 (define-key map [show] (cons "Show" (make-sparse-keymap "Show")))
102 (define-key map [show show-subtree] '("Show Subtree" . show-subtree))
103 (define-key map [show show-children] '("Show Children" . show-children))
104 (define-key map [show show-branches] '("Show Branches" . show-branches))
105 (define-key map [show show-entry] '("Show Entry" . show-entry))
106 (define-key map [show show-all] '("Show All" . show-all))
108 (define-key map [headings]
109 (cons "Headings" (make-sparse-keymap "Headings")))
111 (define-key map [headings copy]
112 '(menu-item "Copy to kill ring" outline-headers-as-kill
113 :enable mark-active))
114 (define-key map [headings outline-backward-same-level]
115 '("Previous Same Level" . outline-backward-same-level))
116 (define-key map [headings outline-forward-same-level]
117 '("Next Same Level" . outline-forward-same-level))
118 (define-key map [headings outline-previous-visible-heading]
119 '("Previous" . outline-previous-visible-heading))
120 (define-key map [headings outline-next-visible-heading]
121 '("Next" . outline-next-visible-heading))
122 (define-key map [headings outline-up-heading]
123 '("Up" . outline-up-heading))
126 (defvar outline-minor-mode-menu-bar-map
127 (let ((map (make-sparse-keymap)))
128 (define-key map [outline]
130 (nconc (make-sparse-keymap "Outline")
131 ;; Remove extra separator
133 ;; Flatten the major mode's menus into a single menu.
137 ;; Add a separator between each
138 ;; part of the unified menu.
139 (cons '(--- "---") (cdr x))))
140 outline-mode-menu-bar-map))))))
144 (defvar outline-mode-map
145 (let ((map (make-sparse-keymap)))
146 (define-key map "\C-c" outline-mode-prefix-map)
147 (define-key map [menu-bar] outline-mode-menu-bar-map)
150 (defvar outline-font-lock-keywords
152 ;; Highlight headings according to the level.
153 (eval . (list (concat "^\\(?:" outline-regexp "\\).+")
154 0 '(outline-font-lock-face) nil t)))
155 "Additional expressions to highlight in Outline mode.")
157 (defface outline-1 '((t :inherit font-lock-function-name-face)) "Level 1.")
158 (defface outline-2 '((t :inherit font-lock-variable-name-face)) "Level 2.")
159 (defface outline-3 '((t :inherit font-lock-keyword-face)) "Level 3.")
160 (defface outline-4 '((t :inherit font-lock-builtin-face)) "Level 4.")
161 (defface outline-5 '((t :inherit font-lock-comment-face)) "Level 5.")
162 (defface outline-6 '((t :inherit font-lock-constant-face)) "Level 6.")
163 (defface outline-7 '((t :inherit font-lock-type-face)) "Level 7.")
164 (defface outline-8 '((t :inherit font-lock-string-face)) "Level 8.")
166 (defvar outline-font-lock-faces
167 [outline-1 outline-2 outline-3 outline-4
168 outline-5 outline-6 outline-7 outline-8])
170 (defvar outline-font-lock-levels nil)
171 (make-variable-buffer-local 'outline-font-lock-levels)
173 (defun outline-font-lock-face ()
175 ;; (outline-back-to-heading t)
177 ;; (start-level (funcall outline-level))
178 ;; (level start-level)
180 ;; (while (not (setq face-level
181 ;; (if (or (bobp) (eq level 1)) 0
182 ;; (cdr (assq level outline-font-lock-levels)))))
183 ;; (outline-up-heading 1 t)
184 ;; (setq count (1+ count))
185 ;; (setq level (funcall outline-level)))
186 ;; ;; Remember for later.
187 ;; (unless (zerop count)
188 ;; (setq face-level (+ face-level count))
189 ;; (push (cons start-level face-level) outline-font-lock-levels))
190 ;; (condition-case nil
191 ;; (aref outline-font-lock-faces face-level)
192 ;; (error font-lock-warning-face))))
194 (goto-char (match-beginning 0))
195 (looking-at outline-regexp)
197 (aref outline-font-lock-faces (1- (funcall outline-level)))
198 (error font-lock-warning-face))))
200 (defvar outline-view-change-hook nil
201 "Normal hook to be run after outline visibility changes.")
204 (define-derived-mode outline-mode text-mode "Outline"
205 "Set major mode for editing outlines with selective display.
206 Headings are lines which start with asterisks: one for major headings,
207 two for subheadings, etc. Lines not starting with asterisks are body lines.
209 Body text or subheadings under a heading can be made temporarily
210 invisible, or visible again. Invisible lines are attached to the end
211 of the heading, so they move with it, if the line is killed and yanked
212 back. A heading with text hidden under it is marked with an ellipsis (...).
214 Commands:\\<outline-mode-map>
215 \\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
216 \\[outline-previous-visible-heading] outline-previous-visible-heading
217 \\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
218 \\[outline-backward-same-level] outline-backward-same-level
219 \\[outline-up-heading] outline-up-heading move from subheading to heading
221 \\[hide-body] make all text invisible (not headings).
222 \\[show-all] make everything in buffer visible.
224 The remaining commands are used when point is on a heading line.
225 They apply to some of the body or subheadings of that heading.
226 \\[hide-subtree] hide-subtree make body and subheadings invisible.
227 \\[show-subtree] show-subtree make body and subheadings visible.
228 \\[show-children] show-children make direct subheadings visible.
229 No effect on body, or subheadings 2 or more levels down.
230 With arg N, affects subheadings N levels down.
231 \\[hide-entry] make immediately following body invisible.
232 \\[show-entry] make it visible.
233 \\[hide-leaves] make body under heading and under its subheadings invisible.
234 The subheadings remain visible.
235 \\[show-branches] make all subheadings at all levels visible.
237 The variable `outline-regexp' can be changed to control what is a heading.
238 A line is a heading if `outline-regexp' matches something at the
239 beginning of the line. The longer the match, the deeper the level.
241 Turning on outline mode calls the value of `text-mode-hook' and then of
242 `outline-mode-hook', if they are non-nil."
243 (make-local-variable 'line-move-ignore-invisible)
244 (setq line-move-ignore-invisible t)
245 ;; Cause use of ellipses for invisible text.
246 (add-to-invisibility-spec '(outline . t))
247 (set (make-local-variable 'paragraph-start)
248 (concat paragraph-start "\\|\\(?:" outline-regexp "\\)"))
249 ;; Inhibit auto-filling of header lines.
250 (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp)
251 (set (make-local-variable 'paragraph-separate)
252 (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)"))
253 (set (make-local-variable 'font-lock-defaults)
254 '(outline-font-lock-keywords t nil nil backward-paragraph))
255 (setq imenu-generic-expression
256 (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
257 (add-hook 'change-major-mode-hook 'show-all nil t))
259 (defcustom outline-minor-mode-prefix "\C-c@"
260 "*Prefix key to use for Outline commands in Outline minor mode.
261 The value of this variable is checked as part of loading Outline mode.
262 After that, changing the prefix key requires manipulating keymaps."
267 (define-minor-mode outline-minor-mode
268 "Toggle Outline minor mode.
269 With arg, turn Outline minor mode on if arg is positive, off otherwise.
270 See the command `outline-mode' for more information on this mode."
271 nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
272 (cons outline-minor-mode-prefix outline-mode-prefix-map))
274 (if outline-minor-mode
276 ;; Turn off this mode if we change major modes.
277 (add-hook 'change-major-mode-hook
278 (lambda () (outline-minor-mode -1))
280 (set (make-local-variable 'line-move-ignore-invisible) t)
281 ;; Cause use of ellipses for invisible text.
282 (add-to-invisibility-spec '(outline . t)))
283 (setq line-move-ignore-invisible nil)
284 ;; Cause use of ellipses for invisible text.
285 (remove-from-invisibility-spec '(outline . t))
286 ;; When turning off outline mode, get rid of any outline hiding.
289 (defcustom outline-level 'outline-level
290 "*Function of no args to compute a header's nesting level in an outline.
291 It can assume point is at the beginning of a header line and that the match
292 data reflects the `outline-regexp'."
296 (defvar outline-heading-alist ()
297 "Alist associating a heading for every possible level.
298 Each entry is of the form (HEADING . LEVEL).
299 This alist is used both to find the heading corresponding to
300 a given level and to find the level of a given heading.")
301 (make-variable-buffer-local 'outline-heading-alist)
303 ;; This used to count columns rather than characters, but that made ^L
304 ;; appear to be at level 2 instead of 1. Columns would be better for
305 ;; tab handling, but the default regexp doesn't use tabs, and anyone
306 ;; who changes the regexp can also redefine the outline-level variable
308 (defun outline-level ()
309 "Return the depth to which a statement is nested in the outline.
310 Point must be at the beginning of a header line.
311 This is actually either the level specified in `outline-heading-alist'
312 or else the number of characters matched by `outline-regexp'."
313 (or (cdr (assoc (match-string 0) outline-heading-alist))
314 (- (match-end 0) (match-beginning 0))))
316 (defun outline-next-preface ()
317 "Skip forward to just before the next heading line.
318 If there's no following heading line, stop before the newline
319 at the end of the buffer."
320 (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
322 (goto-char (match-beginning 0)))
323 (if (and (bolp) (not (bobp)))
326 (defun outline-next-heading ()
327 "Move to the next (possibly invisible) heading line."
329 ;; Make sure we don't match the heading we're at.
330 (if (and (bolp) (not (eobp))) (forward-char 1))
331 (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
333 (goto-char (match-beginning 0))))
335 (defun outline-previous-heading ()
336 "Move to the previous (possibly invisible) heading line."
338 (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
341 (defsubst outline-invisible-p ()
342 "Non-nil if the character after point is invisible."
343 (get-char-property (point) 'invisible))
344 (defun outline-visible ()
345 "Obsolete. Use `outline-invisible-p'."
346 (not (outline-invisible-p)))
348 (defun outline-back-to-heading (&optional invisible-ok)
349 "Move to previous heading line, or beg of this line if it's a heading.
350 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
352 (or (outline-on-heading-p invisible-ok)
356 (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
358 (error "before first heading"))
359 (setq found (and (or invisible-ok (not (outline-invisible-p)))
364 (defun outline-on-heading-p (&optional invisible-ok)
365 "Return t if point is on a (visible) heading line.
366 If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
369 (and (bolp) (or invisible-ok (not (outline-invisible-p)))
370 (looking-at outline-regexp))))
372 (defun outline-insert-heading ()
373 "Insert a new heading at same depth at point."
375 (let ((head (save-excursion
377 (outline-back-to-heading)
378 (error (outline-next-heading)))
380 (or (caar outline-heading-alist) "")
382 (unless (or (string-match "[ \t]\\'" head)
383 (not (string-match outline-regexp (concat head " "))))
384 (setq head (concat head " ")))
385 (unless (bolp) (end-of-line) (newline))
388 (save-excursion (newline-and-indent)))
389 (run-hooks 'outline-insert-heading-hook)))
391 (defun outline-promote (&optional children)
392 "Promote the current heading higher up the tree.
393 If prefix argument CHILDREN is given, promote also all the children."
395 (outline-back-to-heading)
396 (let* ((head (match-string 0))
397 (level (save-match-data (funcall outline-level)))
398 (up-head (or (car (rassoc (1- level) outline-heading-alist))
401 (outline-up-heading 1 t)
402 (match-string 0))))))
404 (unless (rassoc level outline-heading-alist)
405 (push (cons head level) outline-heading-alist))
407 (replace-match up-head nil t)
409 (outline-map-tree 'outline-promote level))))
411 (defun outline-demote (&optional children)
412 "Demote the current heading lower down the tree.
413 If prefix argument CHILDREN is given, demote also all the children."
415 (outline-back-to-heading)
416 (let* ((head (match-string 0))
417 (level (save-match-data (funcall outline-level)))
419 (or (car (rassoc (1+ level) outline-heading-alist))
422 (while (and (not (eobp))
424 (outline-next-heading)
425 (<= (funcall outline-level) level))))
427 ;; Try again from the beginning of the buffer.
428 (goto-char (point-min))
429 (while (and (not (eobp))
431 (outline-next-heading)
432 (<= (funcall outline-level) level)))))
434 (looking-at outline-regexp)
437 ;; Bummer!! There is no lower heading in the buffer.
438 ;; Let's try to invent one by repeating the first char.
439 (let ((new-head (concat (substring head 0 1) head)))
440 (if (string-match (concat "\\`" outline-regexp) new-head)
441 ;; Why bother checking that it is indeed of lower level ?
443 ;; Didn't work: keep it as is so it's still a heading.
446 (unless (rassoc level outline-heading-alist)
447 (push (cons head level) outline-heading-alist))
449 (replace-match down-head nil t)
451 (outline-map-tree 'outline-demote level))))
453 (defun outline-map-tree (fun level)
454 "Call FUN for every heading underneath the current one."
457 (outline-next-heading)
458 (> (funcall outline-level) level))
462 (defun outline-end-of-heading ()
463 (if (re-search-forward outline-heading-end-regexp nil 'move)
466 (defun outline-next-visible-heading (arg)
467 "Move to the next visible heading line.
468 With argument, repeats or can move backward if negative.
469 A heading line is one that starts with a `*' (or that
470 `outline-regexp' matches)."
475 (while (and (not (bobp)) (< arg 0))
476 (while (and (not (bobp))
477 (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
479 (outline-invisible-p)))
481 (while (and (not (eobp)) (> arg 0))
482 (while (and (not (eobp))
483 (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
485 (outline-invisible-p)))
489 (defun outline-previous-visible-heading (arg)
490 "Move to the previous heading line.
491 With argument, repeats or can move forward if negative.
492 A heading line is one that starts with a `*' (or that
493 `outline-regexp' matches)."
495 (outline-next-visible-heading (- arg)))
497 (defun outline-mark-subtree ()
498 "Mark the current subtree in an outlined document.
499 This puts point at the start of the current subtree, and mark at the end."
502 (if (outline-on-heading-p)
503 ;; we are already looking at a heading
505 ;; else go back to previous heading
506 (outline-previous-visible-heading 1))
508 (outline-end-of-subtree)
513 (put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible)
514 (defun outline-flag-region (from to flag)
515 "Hide or show lines from FROM to TO, according to FLAG.
516 If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
517 (remove-overlays from to 'invisible 'outline)
519 (let ((o (make-overlay from to)))
520 (overlay-put o 'invisible 'outline)
521 (overlay-put o 'isearch-open-invisible 'outline-isearch-open-invisible)))
522 ;; Seems only used by lazy-lock. I.e. obsolete.
523 (run-hooks 'outline-view-change-hook))
525 (defun outline-reveal-toggle-invisible (o hidep)
527 (goto-char (overlay-start o))
529 ;; When hiding the area again, we could just clean it up and let
530 ;; reveal do the rest, by simply doing:
531 ;; (remove-overlays (overlay-start o) (overlay-end o)
532 ;; 'invisible 'outline)
534 ;; That works fine as long as everything is in sync, but if the
535 ;; structure of the document is changed while revealing parts of it,
536 ;; the resulting behavior can be ugly. I.e. we need to make
537 ;; sure that we hide exactly a subtree.
539 (let ((end (overlay-end o)))
543 (outline-next-visible-heading 1)
544 (and (not (eobp)) (< (point) end))))))
546 ;; When revealing, we just need to reveal sublevels. If point is
547 ;; inside one of the sublevels, reveal will call us again.
548 ;; But we need to preserve the original overlay.
549 (let ((o1 (copy-overlay o)))
550 (overlay-put o 'invisible nil) ;Show (most of) the text.
554 ;; Normally just the above is needed.
555 ;; But in odd cases, the above might fail to show anything.
556 ;; To avoid an infinite loop, we have to make sure that
557 ;; *something* gets shown.
558 (and (equal (overlay-start o) (overlay-start o1))
559 (< (point) (overlay-end o))
560 (= 0 (forward-line 1)))))
561 ;; If still nothing was shown, just kill the damn thing.
562 (when (equal (overlay-start o) (overlay-start o1))
563 ;; I've seen it happen at the end of buffer.
564 (delete-overlay o1))))))
566 ;; Function to be set as an outline-isearch-open-invisible' property
567 ;; to the overlay that makes the outline invisible (see
568 ;; `outline-flag-region').
569 (defun outline-isearch-open-invisible (overlay)
570 ;; We rely on the fact that isearch places point on the matched text.
574 "Hide the body directly following this heading."
576 (outline-back-to-heading)
577 (outline-end-of-heading)
579 (outline-flag-region (point) (progn (outline-next-preface) (point)) t)))
582 "Show the body directly following this heading.
583 Show the heading too, if it is currently invisible."
586 (outline-back-to-heading t)
587 (outline-flag-region (1- (point))
588 (progn (outline-next-preface) (point)) nil)))
591 "Hide all of buffer except headings."
593 (hide-region-body (point-min) (point-max)))
595 (defun hide-region-body (start end)
596 "Hide all body lines in the region, but not headings."
597 ;; Nullify the hook to avoid repeated calls to `outline-flag-region'
598 ;; wasting lots of time running `lazy-lock-fontify-after-outline'
599 ;; and run the hook finally.
600 (let (outline-view-change-hook)
603 (narrow-to-region start end)
604 (goto-char (point-min))
605 (if (outline-on-heading-p)
606 (outline-end-of-heading))
608 (outline-flag-region (point)
609 (progn (outline-next-preface) (point)) t)
611 (forward-char (if (looking-at "\n\n") 2 1))
612 (outline-end-of-heading))))))
613 (run-hooks 'outline-view-change-hook))
616 "Show all of the text in the buffer."
618 (outline-flag-region (point-min) (point-max) nil))
620 (defun hide-subtree ()
621 "Hide everything after this heading at deeper levels."
623 (outline-flag-subtree t))
625 (defun hide-leaves ()
626 "Hide all body after this heading at deeper levels."
628 (outline-back-to-heading)
630 (outline-end-of-heading)
631 (hide-region-body (point) (progn (outline-end-of-subtree) (point)))))
633 (defun show-subtree ()
634 "Show everything after this heading at deeper levels."
636 (outline-flag-subtree nil))
638 (defun hide-sublevels (levels)
639 "Hide everything but the top LEVELS levels of headers, in whole buffer."
642 (error "Must keep at least one level of headers"))
643 (setq levels (1- levels))
644 (let (outline-view-change-hook)
646 (goto-char (point-min))
647 ;; Keep advancing to the next top-level heading.
648 (while (or (and (bobp) (outline-on-heading-p))
649 (outline-next-heading))
650 (let ((end (save-excursion (outline-end-of-subtree) (point))))
651 ;; Hide everything under that.
652 (outline-end-of-heading)
653 (outline-flag-region (point) end t)
654 ;; Show the first LEVELS levels under that.
656 (show-children levels))
657 ;; Move to the next, since we already found it.
659 (run-hooks 'outline-view-change-hook))
662 "Hide everything except current body and parent and top-level headings."
665 (let (outline-view-change-hook)
667 (outline-back-to-heading t)
669 (while (condition-case nil (progn (outline-up-heading 1) (not (bobp)))
671 (outline-flag-region (1- (point))
672 (save-excursion (forward-line 1) (point))
674 (run-hooks 'outline-view-change-hook))
676 (defun outline-toggle-children ()
677 "Show or hide the current subtree depending on its current state."
679 (outline-back-to-heading)
682 (not (outline-invisible-p)))
687 (defun outline-flag-subtree (flag)
689 (outline-back-to-heading)
690 (outline-end-of-heading)
691 (outline-flag-region (point)
692 (progn (outline-end-of-subtree) (point))
695 (defun outline-end-of-subtree ()
696 (outline-back-to-heading)
697 (let ((opoint (point))
699 (level (funcall outline-level)))
700 (while (and (not (eobp))
701 (or first (> (funcall outline-level) level)))
703 (outline-next-heading))
706 ;; Go to end of line before heading
709 ;; leave blank line before heading
710 (forward-char -1))))))
712 (defun show-branches ()
713 "Show all subheadings of this heading, but not their bodies."
715 (show-children 1000))
717 (defun show-children (&optional level)
718 "Show all direct subheadings of this heading.
719 Prefix arg LEVEL is how many levels below the current level should be shown.
720 Default is enough to cause the following heading to appear."
723 (if level (prefix-numeric-value level)
725 (outline-back-to-heading)
726 (let ((start-level (funcall outline-level)))
727 (outline-next-heading)
730 (max 1 (- (funcall outline-level) start-level)))))))
731 (let (outline-view-change-hook)
734 (outline-back-to-heading)
735 (setq level (+ level (funcall outline-level)))
736 (narrow-to-region (point)
737 (progn (outline-end-of-subtree)
738 (if (eobp) (point-max) (1+ (point)))))
739 (goto-char (point-min))
740 (while (and (not (eobp))
742 (outline-next-heading)
744 (if (<= (funcall outline-level) level)
746 (outline-flag-region (save-excursion
751 (progn (outline-end-of-heading) (point))
753 (run-hooks 'outline-view-change-hook))
757 (defun outline-up-heading (arg &optional invisible-ok)
758 "Move to the visible heading line of which the present line is a subheading.
759 With argument, move up ARG levels.
760 If INVISIBLE-OK is non-nil, also consider invisible lines."
762 (outline-back-to-heading invisible-ok)
763 (let ((start-level (funcall outline-level)))
764 (if (eq start-level 1)
765 (error "Already at top level of the outline"))
766 (while (and (> start-level 1) (> arg 0) (not (bobp)))
767 (let ((level start-level))
768 (while (not (or (< level start-level) (bobp)))
770 (outline-previous-heading)
771 (outline-previous-visible-heading 1))
772 (setq level (funcall outline-level)))
773 (setq start-level level))
774 (setq arg (- arg 1))))
775 (looking-at outline-regexp))
777 (defun outline-forward-same-level (arg)
778 "Move forward to the ARG'th subheading at same level as this one.
779 Stop at the first and last subheadings of a superior heading."
781 (outline-back-to-heading)
783 (let ((point-to-move-to (save-excursion
784 (outline-get-next-sibling))))
787 (goto-char point-to-move-to)
791 (error "No following same-level heading"))))))
793 (defun outline-get-next-sibling ()
794 "Move to next heading of the same level, and return point or nil if none."
795 (let ((level (funcall outline-level)))
796 (outline-next-visible-heading 1)
797 (while (and (> (funcall outline-level) level)
799 (outline-next-visible-heading 1))
800 (if (< (funcall outline-level) level)
804 (defun outline-backward-same-level (arg)
805 "Move backward to the ARG'th subheading at same level as this one.
806 Stop at the first and last subheadings of a superior heading."
808 (outline-back-to-heading)
810 (let ((point-to-move-to (save-excursion
811 (outline-get-last-sibling))))
814 (goto-char point-to-move-to)
818 (error "No previous same-level heading"))))))
820 (defun outline-get-last-sibling ()
821 "Move to previous heading of the same level, and return point or nil if none."
822 (let ((level (funcall outline-level)))
823 (outline-previous-visible-heading 1)
824 (while (and (> (funcall outline-level) level)
826 (outline-previous-visible-heading 1))
827 (if (< (funcall outline-level) level)
831 (defun outline-headers-as-kill (beg end)
832 "Save the visible outline headers in region at the start of the kill ring.
834 Text shown between the headers isn't copied. Two newlines are
835 inserted between saved headers. Yanking the result may be a
836 convenient way to make a table of contents of the buffer."
840 (narrow-to-region beg end)
841 (goto-char (point-min))
842 (let ((buffer (current-buffer))
845 (with-current-buffer buffer
846 ;; Boundary condition: starting on heading:
847 (when (outline-on-heading-p)
848 (outline-back-to-heading)
850 end (progn (outline-end-of-heading)
852 (insert-buffer-substring buffer start end)
854 (let ((temp-buffer (current-buffer)))
855 (with-current-buffer buffer
856 (while (outline-next-heading)
857 (unless (outline-invisible-p)
859 end (progn (outline-end-of-heading) (point)))
860 (with-current-buffer temp-buffer
861 (insert-buffer-substring buffer start end)
863 (kill-new (buffer-string)))))))
868 ;;; outline.el ends here