code.delx.au - gnu-emacs/blob - lisp/textmodes/outline.el

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