diff options
| author | Juanma Barranquero | 2003-05-30 23:29:42 +0000 |
|---|---|---|
| committer | Juanma Barranquero | 2003-05-30 23:29:42 +0000 |
| commit | 3af3f5fa99804d500ff71bc914d4a5698d18dbaf (patch) | |
| tree | 7917c5f9609af5d25a54c959de41ec6334759778 | |
| parent | e667248f9225e49521ce2677124bd4762e27e026 (diff) | |
| download | emacs-3af3f5fa99804d500ff71bc914d4a5698d18dbaf.tar.gz emacs-3af3f5fa99804d500ff71bc914d4a5698d18dbaf.zip | |
Moved to lisp/.
| -rw-r--r-- | lisp/textmodes/outline.el | 987 |
1 files changed, 0 insertions, 987 deletions
diff --git a/lisp/textmodes/outline.el b/lisp/textmodes/outline.el deleted file mode 100644 index 48c0a2576fd..00000000000 --- a/lisp/textmodes/outline.el +++ /dev/null | |||
| @@ -1,987 +0,0 @@ | |||
| 1 | ;;; outline.el --- outline mode commands for Emacs | ||
| 2 | |||
| 3 | ;; Copyright (C) 1986, 93, 94, 95, 97, 2000, 2001 | ||
| 4 | ;; Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Maintainer: FSF | ||
| 7 | ;; Keywords: outlines | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 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) | ||
| 14 | ;; any later version. | ||
| 15 | |||
| 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. | ||
| 20 | |||
| 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. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 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. | ||
| 31 | |||
| 32 | ;;; Todo: | ||
| 33 | |||
| 34 | ;; - subtree-terminators | ||
| 35 | ;; - better handle comments before function bodies (i.e. heading) | ||
| 36 | ;; - don't bother hiding whitespace | ||
| 37 | |||
| 38 | ;;; Code: | ||
| 39 | |||
| 40 | (defgroup outlines nil | ||
| 41 | "Support for hierarchical outlining" | ||
| 42 | :prefix "outline-" | ||
| 43 | :group 'editing) | ||
| 44 | |||
| 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)) | ||
| 53 | :group 'outlines) | ||
| 54 | |||
| 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." | ||
| 61 | :type 'regexp | ||
| 62 | :group 'outlines) | ||
| 63 | |||
| 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-move-subtree-up) | ||
| 84 | (define-key map "\C-v" 'outline-move-subtree-down) | ||
| 85 | (define-key map [(control ?<)] 'outline-promote) | ||
| 86 | (define-key map [(control ?>)] 'outline-demote) | ||
| 87 | (define-key map "\C-m" 'outline-insert-heading) | ||
| 88 | ;; Where to bind outline-cycle ? | ||
| 89 | map)) | ||
| 90 | |||
| 91 | (defvar outline-mode-menu-bar-map | ||
| 92 | (let ((map (make-sparse-keymap))) | ||
| 93 | |||
| 94 | (define-key map [hide] (cons "Hide" (make-sparse-keymap "Hide"))) | ||
| 95 | |||
| 96 | (define-key map [hide hide-other] '("Hide Other" . hide-other)) | ||
| 97 | (define-key map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels)) | ||
| 98 | (define-key map [hide hide-subtree] '("Hide Subtree" . hide-subtree)) | ||
| 99 | (define-key map [hide hide-entry] '("Hide Entry" . hide-entry)) | ||
| 100 | (define-key map [hide hide-body] '("Hide Body" . hide-body)) | ||
| 101 | (define-key map [hide hide-leaves] '("Hide Leaves" . hide-leaves)) | ||
| 102 | |||
| 103 | (define-key map [show] (cons "Show" (make-sparse-keymap "Show"))) | ||
| 104 | |||
| 105 | (define-key map [show show-subtree] '("Show Subtree" . show-subtree)) | ||
| 106 | (define-key map [show show-children] '("Show Children" . show-children)) | ||
| 107 | (define-key map [show show-branches] '("Show Branches" . show-branches)) | ||
| 108 | (define-key map [show show-entry] '("Show Entry" . show-entry)) | ||
| 109 | (define-key map [show show-all] '("Show All" . show-all)) | ||
| 110 | |||
| 111 | (define-key map [headings] | ||
| 112 | (cons "Headings" (make-sparse-keymap "Headings"))) | ||
| 113 | |||
| 114 | (define-key map [headings demote-subtree] | ||
| 115 | '(menu-item "Demote subtree" outline-demote)) | ||
| 116 | (define-key map [headings promote-subtree] | ||
| 117 | '(menu-item "Promote subtree" outline-promote)) | ||
| 118 | (define-key map [headings move-subtree-down] | ||
| 119 | '(menu-item "Move subtree down" outline-move-subtree-down)) | ||
| 120 | (define-key map [headings move-subtree-up] | ||
| 121 | '(menu-item "Move subtree up" outline-move-subtree-up)) | ||
| 122 | (define-key map [headings copy] | ||
| 123 | '(menu-item "Copy to kill ring" outline-headers-as-kill | ||
| 124 | :enable mark-active)) | ||
| 125 | (define-key map [headings outline-insert-heading] | ||
| 126 | '("New heading" . outline-insert-heading)) | ||
| 127 | (define-key map [headings outline-backward-same-level] | ||
| 128 | '("Previous Same Level" . outline-backward-same-level)) | ||
| 129 | (define-key map [headings outline-forward-same-level] | ||
| 130 | '("Next Same Level" . outline-forward-same-level)) | ||
| 131 | (define-key map [headings outline-previous-visible-heading] | ||
| 132 | '("Previous" . outline-previous-visible-heading)) | ||
| 133 | (define-key map [headings outline-next-visible-heading] | ||
| 134 | '("Next" . outline-next-visible-heading)) | ||
| 135 | (define-key map [headings outline-up-heading] | ||
| 136 | '("Up" . outline-up-heading)) | ||
| 137 | map)) | ||
| 138 | |||
| 139 | (defvar outline-minor-mode-menu-bar-map | ||
| 140 | (let ((map (make-sparse-keymap))) | ||
| 141 | (define-key map [outline] | ||
| 142 | (cons "Outline" | ||
| 143 | (nconc (make-sparse-keymap "Outline") | ||
| 144 | ;; Remove extra separator | ||
| 145 | (cdr | ||
| 146 | ;; Flatten the major mode's menus into a single menu. | ||
| 147 | (apply 'append | ||
| 148 | (mapcar (lambda (x) | ||
| 149 | (if (consp x) | ||
| 150 | ;; Add a separator between each | ||
| 151 | ;; part of the unified menu. | ||
| 152 | (cons '(--- "---") (cdr x)))) | ||
| 153 | outline-mode-menu-bar-map)))))) | ||
| 154 | map)) | ||
| 155 | |||
| 156 | |||
| 157 | (defvar outline-mode-map | ||
| 158 | (let ((map (make-sparse-keymap))) | ||
| 159 | (define-key map "\C-c" outline-mode-prefix-map) | ||
| 160 | (define-key map [menu-bar] outline-mode-menu-bar-map) | ||
| 161 | map)) | ||
| 162 | |||
| 163 | (defvar outline-font-lock-keywords | ||
| 164 | '(;; | ||
| 165 | ;; Highlight headings according to the level. | ||
| 166 | (eval . (list (concat "^\\(?:" outline-regexp "\\).+") | ||
| 167 | 0 '(outline-font-lock-face) nil t))) | ||
| 168 | "Additional expressions to highlight in Outline mode.") | ||
| 169 | |||
| 170 | (defface outline-1 '((t :inherit font-lock-function-name-face)) "Level 1.") | ||
| 171 | (defface outline-2 '((t :inherit font-lock-variable-name-face)) "Level 2.") | ||
| 172 | (defface outline-3 '((t :inherit font-lock-keyword-face)) "Level 3.") | ||
| 173 | (defface outline-4 '((t :inherit font-lock-builtin-face)) "Level 4.") | ||
| 174 | (defface outline-5 '((t :inherit font-lock-comment-face)) "Level 5.") | ||
| 175 | (defface outline-6 '((t :inherit font-lock-constant-face)) "Level 6.") | ||
| 176 | (defface outline-7 '((t :inherit font-lock-type-face)) "Level 7.") | ||
| 177 | (defface outline-8 '((t :inherit font-lock-string-face)) "Level 8.") | ||
| 178 | |||
| 179 | (defvar outline-font-lock-faces | ||
| 180 | [outline-1 outline-2 outline-3 outline-4 | ||
| 181 | outline-5 outline-6 outline-7 outline-8]) | ||
| 182 | |||
| 183 | (defvar outline-font-lock-levels nil) | ||
| 184 | (make-variable-buffer-local 'outline-font-lock-levels) | ||
| 185 | |||
| 186 | (defun outline-font-lock-face () | ||
| 187 | ;; (save-excursion | ||
| 188 | ;; (outline-back-to-heading t) | ||
| 189 | ;; (let* ((count 0) | ||
| 190 | ;; (start-level (funcall outline-level)) | ||
| 191 | ;; (level start-level) | ||
| 192 | ;; face-level) | ||
| 193 | ;; (while (not (setq face-level | ||
| 194 | ;; (if (or (bobp) (eq level 1)) 0 | ||
| 195 | ;; (cdr (assq level outline-font-lock-levels))))) | ||
| 196 | ;; (outline-up-heading 1 t) | ||
| 197 | ;; (setq count (1+ count)) | ||
| 198 | ;; (setq level (funcall outline-level))) | ||
| 199 | ;; ;; Remember for later. | ||
| 200 | ;; (unless (zerop count) | ||
| 201 | ;; (setq face-level (+ face-level count)) | ||
| 202 | ;; (push (cons start-level face-level) outline-font-lock-levels)) | ||
| 203 | ;; (condition-case nil | ||
| 204 | ;; (aref outline-font-lock-faces face-level) | ||
| 205 | ;; (error font-lock-warning-face)))) | ||
| 206 | (save-excursion | ||
| 207 | (goto-char (match-beginning 0)) | ||
| 208 | (looking-at outline-regexp) | ||
| 209 | (condition-case nil | ||
| 210 | (aref outline-font-lock-faces (1- (funcall outline-level))) | ||
| 211 | (error font-lock-warning-face)))) | ||
| 212 | |||
| 213 | (defvar outline-view-change-hook nil | ||
| 214 | "Normal hook to be run after outline visibility changes.") | ||
| 215 | |||
| 216 | ;;;###autoload | ||
| 217 | (define-derived-mode outline-mode text-mode "Outline" | ||
| 218 | "Set major mode for editing outlines with selective display. | ||
| 219 | Headings are lines which start with asterisks: one for major headings, | ||
| 220 | two for subheadings, etc. Lines not starting with asterisks are body lines. | ||
| 221 | |||
| 222 | Body text or subheadings under a heading can be made temporarily | ||
| 223 | invisible, or visible again. Invisible lines are attached to the end | ||
| 224 | of the heading, so they move with it, if the line is killed and yanked | ||
| 225 | back. A heading with text hidden under it is marked with an ellipsis (...). | ||
| 226 | |||
| 227 | Commands:\\<outline-mode-map> | ||
| 228 | \\[outline-next-visible-heading] outline-next-visible-heading move by visible headings | ||
| 229 | \\[outline-previous-visible-heading] outline-previous-visible-heading | ||
| 230 | \\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings | ||
| 231 | \\[outline-backward-same-level] outline-backward-same-level | ||
| 232 | \\[outline-up-heading] outline-up-heading move from subheading to heading | ||
| 233 | |||
| 234 | \\[hide-body] make all text invisible (not headings). | ||
| 235 | \\[show-all] make everything in buffer visible. | ||
| 236 | \\[hide-sublevels] make only the first N levels of headers 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 | (make-local-variable 'line-move-ignore-invisible) | ||
| 258 | (setq line-move-ignore-invisible t) | ||
| 259 | ;; Cause use of ellipses for invisible text. | ||
| 260 | (add-to-invisibility-spec '(outline . t)) | ||
| 261 | (set (make-local-variable 'paragraph-start) | ||
| 262 | (concat paragraph-start "\\|\\(?:" outline-regexp "\\)")) | ||
| 263 | ;; Inhibit auto-filling of header lines. | ||
| 264 | (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp) | ||
| 265 | (set (make-local-variable 'paragraph-separate) | ||
| 266 | (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) | ||
| 267 | (set (make-local-variable 'font-lock-defaults) | ||
| 268 | '(outline-font-lock-keywords t nil nil backward-paragraph)) | ||
| 269 | (setq imenu-generic-expression | ||
| 270 | (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) | ||
| 271 | (add-hook 'change-major-mode-hook 'show-all nil t)) | ||
| 272 | |||
| 273 | (defcustom outline-minor-mode-prefix "\C-c@" | ||
| 274 | "*Prefix key to use for Outline commands in Outline minor mode. | ||
| 275 | The value of this variable is checked as part of loading Outline mode. | ||
| 276 | After that, changing the prefix key requires manipulating keymaps." | ||
| 277 | :type 'string | ||
| 278 | :group 'outlines) | ||
| 279 | |||
| 280 | ;;;###autoload | ||
| 281 | (define-minor-mode outline-minor-mode | ||
| 282 | "Toggle Outline minor mode. | ||
| 283 | With arg, turn Outline minor mode on if arg is positive, off otherwise. | ||
| 284 | See the command `outline-mode' for more information on this mode." | ||
| 285 | nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) | ||
| 286 | (cons outline-minor-mode-prefix outline-mode-prefix-map)) | ||
| 287 | :group 'outlines | ||
| 288 | (if outline-minor-mode | ||
| 289 | (progn | ||
| 290 | ;; Turn off this mode if we change major modes. | ||
| 291 | (add-hook 'change-major-mode-hook | ||
| 292 | (lambda () (outline-minor-mode -1)) | ||
| 293 | nil t) | ||
| 294 | (set (make-local-variable 'line-move-ignore-invisible) t) | ||
| 295 | ;; Cause use of ellipses for invisible text. | ||
| 296 | (add-to-invisibility-spec '(outline . t))) | ||
| 297 | (setq line-move-ignore-invisible nil) | ||
| 298 | ;; Cause use of ellipses for invisible text. | ||
| 299 | (remove-from-invisibility-spec '(outline . t)) | ||
| 300 | ;; When turning off outline mode, get rid of any outline hiding. | ||
| 301 | (show-all))) | ||
| 302 | |||
| 303 | (defvar outline-level 'outline-level | ||
| 304 | "*Function of no args to compute a header's nesting level in an outline. | ||
| 305 | It can assume point is at the beginning of a header line and that the match | ||
| 306 | data reflects the `outline-regexp'.") | ||
| 307 | |||
| 308 | (defvar outline-heading-alist () | ||
| 309 | "Alist associating a heading for every possible level. | ||
| 310 | Each entry is of the form (HEADING . LEVEL). | ||
| 311 | This alist is used two ways: to find the heading corresponding to | ||
| 312 | a given level and to find the level of a given heading. | ||
| 313 | If a mode or document needs several sets of outline headings (for example | ||
| 314 | numbered and unnumbered sections), list them set by set and sorted by level | ||
| 315 | within each set. For example in texinfo mode: | ||
| 316 | |||
| 317 | (setq outline-heading-alist | ||
| 318 | '((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4) | ||
| 319 | (\"@subsubsection\" . 5) | ||
| 320 | (\"@unnumbered\" . 2) (\"@unnumberedsec\" . 3) | ||
| 321 | (\"@unnumberedsubsec\" . 4) (\"@unnumberedsubsubsec\" . 5) | ||
| 322 | (\"@appendix\" . 2) (\"@appendixsec\" . 3)... | ||
| 323 | (\"@appendixsubsec\" . 4) (\"@appendixsubsubsec\" . 5) ..)) | ||
| 324 | |||
| 325 | Instead of sorting the entries in each set, you can also separate the | ||
| 326 | sets with nil.") | ||
| 327 | (make-variable-buffer-local 'outline-heading-alist) | ||
| 328 | |||
| 329 | ;; This used to count columns rather than characters, but that made ^L | ||
| 330 | ;; appear to be at level 2 instead of 1. Columns would be better for | ||
| 331 | ;; tab handling, but the default regexp doesn't use tabs, and anyone | ||
| 332 | ;; who changes the regexp can also redefine the outline-level variable | ||
| 333 | ;; as appropriate. | ||
| 334 | (defun outline-level () | ||
| 335 | "Return the depth to which a statement is nested in the outline. | ||
| 336 | Point must be at the beginning of a header line. | ||
| 337 | This is actually either the level specified in `outline-heading-alist' | ||
| 338 | or else the number of characters matched by `outline-regexp'." | ||
| 339 | (or (cdr (assoc (match-string 0) outline-heading-alist)) | ||
| 340 | (- (match-end 0) (match-beginning 0)))) | ||
| 341 | |||
| 342 | (defun outline-next-preface () | ||
| 343 | "Skip forward to just before the next heading line. | ||
| 344 | If there's no following heading line, stop before the newline | ||
| 345 | at the end of the buffer." | ||
| 346 | (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") | ||
| 347 | nil 'move) | ||
| 348 | (goto-char (match-beginning 0))) | ||
| 349 | (if (and (bolp) (not (bobp))) | ||
| 350 | (forward-char -1))) | ||
| 351 | |||
| 352 | (defun outline-next-heading () | ||
| 353 | "Move to the next (possibly invisible) heading line." | ||
| 354 | (interactive) | ||
| 355 | ;; Make sure we don't match the heading we're at. | ||
| 356 | (if (and (bolp) (not (eobp))) (forward-char 1)) | ||
| 357 | (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)") | ||
| 358 | nil 'move) | ||
| 359 | (goto-char (match-beginning 0)))) | ||
| 360 | |||
| 361 | (defun outline-previous-heading () | ||
| 362 | "Move to the previous (possibly invisible) heading line." | ||
| 363 | (interactive) | ||
| 364 | (re-search-backward (concat "^\\(?:" outline-regexp "\\)") | ||
| 365 | nil 'move)) | ||
| 366 | |||
| 367 | (defsubst outline-invisible-p (&optional pos) | ||
| 368 | "Non-nil if the character after point is invisible." | ||
| 369 | (get-char-property (or pos (point)) 'invisible)) | ||
| 370 | |||
| 371 | (defun outline-visible () | ||
| 372 | (not (outline-invisible-p))) | ||
| 373 | (make-obsolete 'outline-visible 'outline-invisible-p) | ||
| 374 | |||
| 375 | (defun outline-back-to-heading (&optional invisible-ok) | ||
| 376 | "Move to previous heading line, or beg of this line if it's a heading. | ||
| 377 | Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | ||
| 378 | (beginning-of-line) | ||
| 379 | (or (outline-on-heading-p invisible-ok) | ||
| 380 | (let (found) | ||
| 381 | (save-excursion | ||
| 382 | (while (not found) | ||
| 383 | (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") | ||
| 384 | nil t) | ||
| 385 | (error "before first heading")) | ||
| 386 | (setq found (and (or invisible-ok (not (outline-invisible-p))) | ||
| 387 | (point))))) | ||
| 388 | (goto-char found) | ||
| 389 | found))) | ||
| 390 | |||
| 391 | (defun outline-on-heading-p (&optional invisible-ok) | ||
| 392 | "Return t if point is on a (visible) heading line. | ||
| 393 | If INVISIBLE-OK is non-nil, an invisible heading line is ok too." | ||
| 394 | (save-excursion | ||
| 395 | (beginning-of-line) | ||
| 396 | (and (bolp) (or invisible-ok (not (outline-invisible-p))) | ||
| 397 | (looking-at outline-regexp)))) | ||
| 398 | |||
| 399 | (defun outline-insert-heading () | ||
| 400 | "Insert a new heading at same depth at point." | ||
| 401 | (interactive) | ||
| 402 | (let ((head (save-excursion | ||
| 403 | (condition-case nil | ||
| 404 | (outline-back-to-heading) | ||
| 405 | (error (outline-next-heading))) | ||
| 406 | (if (eobp) | ||
| 407 | (or (caar outline-heading-alist) "") | ||
| 408 | (match-string 0))))) | ||
| 409 | (unless (or (string-match "[ \t]\\'" head) | ||
| 410 | (not (string-match outline-regexp (concat head " ")))) | ||
| 411 | (setq head (concat head " "))) | ||
| 412 | (unless (bolp) (end-of-line) (newline)) | ||
| 413 | (insert head) | ||
| 414 | (unless (eolp) | ||
| 415 | (save-excursion (newline-and-indent))) | ||
| 416 | (run-hooks 'outline-insert-heading-hook))) | ||
| 417 | |||
| 418 | (defun outline-promote (&optional children) | ||
| 419 | "Promote headings higher up the tree. | ||
| 420 | If prefix argument CHILDREN is given, promote also all the children. | ||
| 421 | If the region is active in `transient-mark-mode', promote all headings | ||
| 422 | in the region." | ||
| 423 | (interactive | ||
| 424 | (list (if (and transient-mark-mode mark-active) 'region | ||
| 425 | (outline-back-to-heading) | ||
| 426 | (if current-prefix-arg nil 'subtree)))) | ||
| 427 | (cond | ||
| 428 | ((eq children 'region) | ||
| 429 | (outline-map-region 'outline-promote (region-beginning) (region-end))) | ||
| 430 | (children | ||
| 431 | (outline-map-region 'outline-promote | ||
| 432 | (point) | ||
| 433 | (save-excursion (outline-get-next-sibling) (point)))) | ||
| 434 | (t | ||
| 435 | (outline-back-to-heading t) | ||
| 436 | (let* ((head (match-string 0)) | ||
| 437 | (level (save-match-data (funcall outline-level))) | ||
| 438 | (up-head (or (outline-head-from-level (1- level) head) | ||
| 439 | (save-excursion | ||
| 440 | (save-match-data | ||
| 441 | (outline-up-heading 1 t) | ||
| 442 | (match-string 0)))))) | ||
| 443 | |||
| 444 | (unless (rassoc level outline-heading-alist) | ||
| 445 | (push (cons head level) outline-heading-alist)) | ||
| 446 | |||
| 447 | (replace-match up-head nil t))))) | ||
| 448 | |||
| 449 | (defun outline-demote (&optional children) | ||
| 450 | "Demote headings lower down the tree. | ||
| 451 | If prefix argument CHILDREN is given, demote also all the children. | ||
| 452 | If the region is active in `transient-mark-mode', demote all headings | ||
| 453 | in the region." | ||
| 454 | (interactive | ||
| 455 | (list (if (and transient-mark-mode mark-active) 'region | ||
| 456 | (outline-back-to-heading) | ||
| 457 | (if current-prefix-arg nil 'subtree)))) | ||
| 458 | (cond | ||
| 459 | ((eq children 'region) | ||
| 460 | (outline-map-region 'outline-demote (region-beginning) (region-end))) | ||
| 461 | (children | ||
| 462 | (outline-map-region 'outline-demote | ||
| 463 | (point) | ||
| 464 | (save-excursion (outline-get-next-sibling) (point)))) | ||
| 465 | (t | ||
| 466 | (let* ((head (match-string 0)) | ||
| 467 | (level (save-match-data (funcall outline-level))) | ||
| 468 | (down-head | ||
| 469 | (or (outline-head-from-level (1+ level) head) | ||
| 470 | (save-excursion | ||
| 471 | (save-match-data | ||
| 472 | (while (and (progn (outline-next-heading) (not (eobp))) | ||
| 473 | (<= (funcall outline-level) level))) | ||
| 474 | (when (eobp) | ||
| 475 | ;; Try again from the beginning of the buffer. | ||
| 476 | (goto-char (point-min)) | ||
| 477 | (while (and (progn (outline-next-heading) (not (eobp))) | ||
| 478 | (<= (funcall outline-level) level)))) | ||
| 479 | (unless (eobp) | ||
| 480 | (looking-at outline-regexp) | ||
| 481 | (match-string 0)))) | ||
| 482 | (save-match-data | ||
| 483 | ;; Bummer!! There is no lower heading in the buffer. | ||
| 484 | ;; Let's try to invent one by repeating the first char. | ||
| 485 | (let ((new-head (concat (substring head 0 1) head))) | ||
| 486 | (if (string-match (concat "\\`" outline-regexp) new-head) | ||
| 487 | ;; Why bother checking that it is indeed lower level ? | ||
| 488 | new-head | ||
| 489 | ;; Didn't work: keep it as is so it's still a heading. | ||
| 490 | head)))))) | ||
| 491 | |||
| 492 | (unless (rassoc level outline-heading-alist) | ||
| 493 | (push (cons head level) outline-heading-alist)) | ||
| 494 | (replace-match down-head nil t))))) | ||
| 495 | |||
| 496 | (defun outline-head-from-level (level head &optional alist) | ||
| 497 | "Get new heading with level LEVEL from ALIST. | ||
| 498 | If there are no such entries, return nil. | ||
| 499 | ALIST defaults to `outline-heading-alist'. | ||
| 500 | Similar to (car (rassoc LEVEL ALIST)). | ||
| 501 | If there are several different entries with same new level, choose | ||
| 502 | the one with the smallest distance to the assocation of HEAD in the alist. | ||
| 503 | This makes it possible for promotion to work in modes with several | ||
| 504 | independent sets of headings (numbered, unnumbered, appendix...)" | ||
| 505 | (unless alist (setq alist outline-heading-alist)) | ||
| 506 | (let ((l (rassoc level alist)) | ||
| 507 | ll h hl l2 l2l) | ||
| 508 | (cond | ||
| 509 | ((null l) nil) | ||
| 510 | ;; If there's no HEAD after L, any other entry for LEVEL after L | ||
| 511 | ;; can't be much better than L. | ||
| 512 | ((null (setq h (assoc head (setq ll (memq l alist))))) (car l)) | ||
| 513 | ;; If there's no other entry for LEVEL, just keep L. | ||
| 514 | ((null (setq l2 (rassoc level (cdr ll)))) (car l)) | ||
| 515 | ;; Now we have L, L2, and H: see if L2 seems better than L. | ||
| 516 | ;; If H is after L2, L2 is better. | ||
| 517 | ((memq h (setq l2l (memq l2 (cdr ll)))) | ||
| 518 | (outline-head-from-level level head l2l)) | ||
| 519 | ;; Now we have H between L and L2. | ||
| 520 | ;; If there's a separator between L and H, prefer L2. | ||
| 521 | ((memq h (memq nil ll)) | ||
| 522 | (outline-head-from-level level head l2l)) | ||
| 523 | ;; If there's a separator between L2 and H, prefer L. | ||
| 524 | ((memq l2 (memq nil (setq hl (memq h ll)))) (car l)) | ||
| 525 | ;; No separator between L and L2, check the distance. | ||
| 526 | ((< (* 2 (length hl)) (+ (length ll) (length l2l))) | ||
| 527 | (outline-head-from-level level head l2l)) | ||
| 528 | ;; If all else fails, just keep L. | ||
| 529 | (t (car l))))) | ||
| 530 | |||
| 531 | (defun outline-map-region (fun beg end) | ||
| 532 | "Call FUN for every heading between BEG and END. | ||
| 533 | When FUN is called, point is at the beginning of the heading and | ||
| 534 | the match data is set appropriately." | ||
| 535 | (save-excursion | ||
| 536 | (setq end (copy-marker end)) | ||
| 537 | (goto-char beg) | ||
| 538 | (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t) | ||
| 539 | (goto-char (match-beginning 0)) | ||
| 540 | (funcall fun) | ||
| 541 | (while (and (progn | ||
| 542 | (outline-next-heading) | ||
| 543 | (< (point) end)) | ||
| 544 | (not (eobp))) | ||
| 545 | (funcall fun))))) | ||
| 546 | |||
| 547 | ;; Vertical tree motion | ||
| 548 | |||
| 549 | (defun outline-move-subtree-up (&optional arg) | ||
| 550 | "Move the currrent subtree up past ARG headlines of the same level." | ||
| 551 | (interactive "p") | ||
| 552 | (outline-move-subtree-down (- arg))) | ||
| 553 | |||
| 554 | (defun outline-move-subtree-down (&optional arg) | ||
| 555 | "Move the currrent subtree down past ARG headlines of the same level." | ||
| 556 | (interactive "p") | ||
| 557 | (let ((re (concat "^" outline-regexp)) | ||
| 558 | (movfunc (if (> arg 0) 'outline-get-next-sibling | ||
| 559 | 'outline-get-last-sibling)) | ||
| 560 | (ins-point (make-marker)) | ||
| 561 | (cnt (abs arg)) | ||
| 562 | beg end txt folded) | ||
| 563 | ;; Select the tree | ||
| 564 | (outline-back-to-heading) | ||
| 565 | (setq beg (point)) | ||
| 566 | (save-match-data | ||
| 567 | (save-excursion (outline-end-of-heading) | ||
| 568 | (setq folded (outline-invisible-p))) | ||
| 569 | (outline-end-of-subtree)) | ||
| 570 | (if (= (char-after) ?\n) (forward-char 1)) | ||
| 571 | (setq end (point)) | ||
| 572 | ;; Find insertion point, with error handling | ||
| 573 | (goto-char beg) | ||
| 574 | (while (> cnt 0) | ||
| 575 | (or (funcall movfunc) | ||
| 576 | (progn (goto-char beg) | ||
| 577 | (error "Cannot move past superior level"))) | ||
| 578 | (setq cnt (1- cnt))) | ||
| 579 | (if (> arg 0) | ||
| 580 | ;; Moving forward - still need to move over subtree | ||
| 581 | (progn (outline-end-of-subtree) | ||
| 582 | (if (= (char-after) ?\n) (forward-char 1)))) | ||
| 583 | (move-marker ins-point (point)) | ||
| 584 | (insert (delete-and-extract-region beg end)) | ||
| 585 | (goto-char ins-point) | ||
| 586 | (if folded (hide-subtree)) | ||
| 587 | (move-marker ins-point nil))) | ||
| 588 | |||
| 589 | (defun outline-end-of-heading () | ||
| 590 | (if (re-search-forward outline-heading-end-regexp nil 'move) | ||
| 591 | (forward-char -1))) | ||
| 592 | |||
| 593 | (defun outline-next-visible-heading (arg) | ||
| 594 | "Move to the next visible heading line. | ||
| 595 | With argument, repeats or can move backward if negative. | ||
| 596 | A heading line is one that starts with a `*' (or that | ||
| 597 | `outline-regexp' matches)." | ||
| 598 | (interactive "p") | ||
| 599 | (if (< arg 0) | ||
| 600 | (beginning-of-line) | ||
| 601 | (end-of-line)) | ||
| 602 | (while (and (not (bobp)) (< arg 0)) | ||
| 603 | (while (and (not (bobp)) | ||
| 604 | (re-search-backward (concat "^\\(?:" outline-regexp "\\)") | ||
| 605 | nil 'move) | ||
| 606 | (outline-invisible-p))) | ||
| 607 | (setq arg (1+ arg))) | ||
| 608 | (while (and (not (eobp)) (> arg 0)) | ||
| 609 | (while (and (not (eobp)) | ||
| 610 | (re-search-forward (concat "^\\(?:" outline-regexp "\\)") | ||
| 611 | nil 'move) | ||
| 612 | (outline-invisible-p (match-beginning 0)))) | ||
| 613 | (setq arg (1- arg))) | ||
| 614 | (beginning-of-line)) | ||
| 615 | |||
| 616 | (defun outline-previous-visible-heading (arg) | ||
| 617 | "Move to the previous heading line. | ||
| 618 | With argument, repeats or can move forward if negative. | ||
| 619 | A heading line is one that starts with a `*' (or that | ||
| 620 | `outline-regexp' matches)." | ||
| 621 | (interactive "p") | ||
| 622 | (outline-next-visible-heading (- arg))) | ||
| 623 | |||
| 624 | (defun outline-mark-subtree () | ||
| 625 | "Mark the current subtree in an outlined document. | ||
| 626 | This puts point at the start of the current subtree, and mark at the end." | ||
| 627 | (interactive) | ||
| 628 | (let ((beg)) | ||
| 629 | (if (outline-on-heading-p) | ||
| 630 | ;; we are already looking at a heading | ||
| 631 | (beginning-of-line) | ||
| 632 | ;; else go back to previous heading | ||
| 633 | (outline-previous-visible-heading 1)) | ||
| 634 | (setq beg (point)) | ||
| 635 | (outline-end-of-subtree) | ||
| 636 | (push-mark (point)) | ||
| 637 | (goto-char beg))) | ||
| 638 | |||
| 639 | |||
| 640 | (put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible) | ||
| 641 | (defun outline-flag-region (from to flag) | ||
| 642 | "Hide or show lines from FROM to TO, according to FLAG. | ||
| 643 | If FLAG is nil then text is shown, while if FLAG is t the text is hidden." | ||
| 644 | (remove-overlays from to 'invisible 'outline) | ||
| 645 | (when flag | ||
| 646 | (let ((o (make-overlay from to))) | ||
| 647 | (overlay-put o 'invisible 'outline) | ||
| 648 | (overlay-put o 'isearch-open-invisible 'outline-isearch-open-invisible))) | ||
| 649 | ;; Seems only used by lazy-lock. I.e. obsolete. | ||
| 650 | (run-hooks 'outline-view-change-hook)) | ||
| 651 | |||
| 652 | (defun outline-reveal-toggle-invisible (o hidep) | ||
| 653 | (save-excursion | ||
| 654 | (goto-char (overlay-start o)) | ||
| 655 | (if hidep | ||
| 656 | ;; When hiding the area again, we could just clean it up and let | ||
| 657 | ;; reveal do the rest, by simply doing: | ||
| 658 | ;; (remove-overlays (overlay-start o) (overlay-end o) | ||
| 659 | ;; 'invisible 'outline) | ||
| 660 | ;; | ||
| 661 | ;; That works fine as long as everything is in sync, but if the | ||
| 662 | ;; structure of the document is changed while revealing parts of it, | ||
| 663 | ;; the resulting behavior can be ugly. I.e. we need to make | ||
| 664 | ;; sure that we hide exactly a subtree. | ||
| 665 | (progn | ||
| 666 | (let ((end (overlay-end o))) | ||
| 667 | (delete-overlay o) | ||
| 668 | (while (progn | ||
| 669 | (hide-subtree) | ||
| 670 | (outline-next-visible-heading 1) | ||
| 671 | (and (not (eobp)) (< (point) end)))))) | ||
| 672 | |||
| 673 | ;; When revealing, we just need to reveal sublevels. If point is | ||
| 674 | ;; inside one of the sublevels, reveal will call us again. | ||
| 675 | ;; But we need to preserve the original overlay. | ||
| 676 | (let ((o1 (copy-overlay o))) | ||
| 677 | (overlay-put o 'invisible nil) ;Show (most of) the text. | ||
| 678 | (while (progn | ||
| 679 | (show-entry) | ||
| 680 | (show-children) | ||
| 681 | ;; Normally just the above is needed. | ||
| 682 | ;; But in odd cases, the above might fail to show anything. | ||
| 683 | ;; To avoid an infinite loop, we have to make sure that | ||
| 684 | ;; *something* gets shown. | ||
| 685 | (and (equal (overlay-start o) (overlay-start o1)) | ||
| 686 | (< (point) (overlay-end o)) | ||
| 687 | (= 0 (forward-line 1))))) | ||
| 688 | ;; If still nothing was shown, just kill the damn thing. | ||
| 689 | (when (equal (overlay-start o) (overlay-start o1)) | ||
| 690 | ;; I've seen it happen at the end of buffer. | ||
| 691 | (delete-overlay o1)))))) | ||
| 692 | |||
| 693 | ;; Function to be set as an outline-isearch-open-invisible' property | ||
| 694 | ;; to the overlay that makes the outline invisible (see | ||
| 695 | ;; `outline-flag-region'). | ||
| 696 | (defun outline-isearch-open-invisible (overlay) | ||
| 697 | ;; We rely on the fact that isearch places point on the matched text. | ||
| 698 | (show-entry)) | ||
| 699 | |||
| 700 | (defun hide-entry () | ||
| 701 | "Hide the body directly following this heading." | ||
| 702 | (interactive) | ||
| 703 | (outline-back-to-heading) | ||
| 704 | (outline-end-of-heading) | ||
| 705 | (save-excursion | ||
| 706 | (outline-flag-region (point) (progn (outline-next-preface) (point)) t))) | ||
| 707 | |||
| 708 | (defun show-entry () | ||
| 709 | "Show the body directly following this heading. | ||
| 710 | Show the heading too, if it is currently invisible." | ||
| 711 | (interactive) | ||
| 712 | (save-excursion | ||
| 713 | (outline-back-to-heading t) | ||
| 714 | (outline-flag-region (1- (point)) | ||
| 715 | (progn (outline-next-preface) (point)) nil))) | ||
| 716 | |||
| 717 | (defun hide-body () | ||
| 718 | "Hide all of buffer except headings." | ||
| 719 | (interactive) | ||
| 720 | (hide-region-body (point-min) (point-max))) | ||
| 721 | |||
| 722 | (defun hide-region-body (start end) | ||
| 723 | "Hide all body lines in the region, but not headings." | ||
| 724 | ;; Nullify the hook to avoid repeated calls to `outline-flag-region' | ||
| 725 | ;; wasting lots of time running `lazy-lock-fontify-after-outline' | ||
| 726 | ;; and run the hook finally. | ||
| 727 | (let (outline-view-change-hook) | ||
| 728 | (save-excursion | ||
| 729 | (save-restriction | ||
| 730 | (narrow-to-region start end) | ||
| 731 | (goto-char (point-min)) | ||
| 732 | (if (outline-on-heading-p) | ||
| 733 | (outline-end-of-heading)) | ||
| 734 | (while (not (eobp)) | ||
| 735 | (outline-flag-region (point) | ||
| 736 | (progn (outline-next-preface) (point)) t) | ||
| 737 | (unless (eobp) | ||
| 738 | (forward-char (if (looking-at "\n\n") 2 1)) | ||
| 739 | (outline-end-of-heading)))))) | ||
| 740 | (run-hooks 'outline-view-change-hook)) | ||
| 741 | |||
| 742 | (defun show-all () | ||
| 743 | "Show all of the text in the buffer." | ||
| 744 | (interactive) | ||
| 745 | (outline-flag-region (point-min) (point-max) nil)) | ||
| 746 | |||
| 747 | (defun hide-subtree () | ||
| 748 | "Hide everything after this heading at deeper levels." | ||
| 749 | (interactive) | ||
| 750 | (outline-flag-subtree t)) | ||
| 751 | |||
| 752 | (defun hide-leaves () | ||
| 753 | "Hide all body after this heading at deeper levels." | ||
| 754 | (interactive) | ||
| 755 | (outline-back-to-heading) | ||
| 756 | (save-excursion | ||
| 757 | (outline-end-of-heading) | ||
| 758 | (hide-region-body (point) (progn (outline-end-of-subtree) (point))))) | ||
| 759 | |||
| 760 | (defun show-subtree () | ||
| 761 | "Show everything after this heading at deeper levels." | ||
| 762 | (interactive) | ||
| 763 | (outline-flag-subtree nil)) | ||
| 764 | |||
| 765 | (defun outline-show-heading () | ||
| 766 | "Show the current heading and move to its end." | ||
| 767 | (outline-flag-region (- (point) | ||
| 768 | (if (bobp) 0 | ||
| 769 | (if (eq (char-before (1- (point))) ?\n) | ||
| 770 | 2 1))) | ||
| 771 | (progn (outline-end-of-heading) (point)) | ||
| 772 | nil)) | ||
| 773 | |||
| 774 | (defun hide-sublevels (levels) | ||
| 775 | "Hide everything but the top LEVELS levels of headers, in whole buffer." | ||
| 776 | (interactive "p") | ||
| 777 | (if (< levels 1) | ||
| 778 | (error "Must keep at least one level of headers")) | ||
| 779 | (let (outline-view-change-hook) | ||
| 780 | (save-excursion | ||
| 781 | (goto-char (point-min)) | ||
| 782 | ;; Skip the prelude, if any. | ||
| 783 | (unless (outline-on-heading-p t) (outline-next-heading)) | ||
| 784 | ;; First hide everything. | ||
| 785 | (outline-flag-region (point) (point-max) t) | ||
| 786 | ;; Then unhide the top level headers. | ||
| 787 | (outline-map-region | ||
| 788 | (lambda () | ||
| 789 | (if (<= (funcall outline-level) levels) | ||
| 790 | (outline-show-heading))) | ||
| 791 | (point) (point-max)))) | ||
| 792 | (run-hooks 'outline-view-change-hook)) | ||
| 793 | |||
| 794 | (defun hide-other () | ||
| 795 | "Hide everything except current body and parent and top-level headings." | ||
| 796 | (interactive) | ||
| 797 | (hide-sublevels 1) | ||
| 798 | (let (outline-view-change-hook) | ||
| 799 | (save-excursion | ||
| 800 | (outline-back-to-heading t) | ||
| 801 | (show-entry) | ||
| 802 | (while (condition-case nil (progn (outline-up-heading 1) (not (bobp))) | ||
| 803 | (error nil)) | ||
| 804 | (outline-flag-region (1- (point)) | ||
| 805 | (save-excursion (forward-line 1) (point)) | ||
| 806 | nil)))) | ||
| 807 | (run-hooks 'outline-view-change-hook)) | ||
| 808 | |||
| 809 | (defun outline-toggle-children () | ||
| 810 | "Show or hide the current subtree depending on its current state." | ||
| 811 | (interactive) | ||
| 812 | (outline-back-to-heading) | ||
| 813 | (if (not (outline-invisible-p (line-end-position))) | ||
| 814 | (hide-subtree) | ||
| 815 | (show-children) | ||
| 816 | (show-entry))) | ||
| 817 | |||
| 818 | (defun outline-flag-subtree (flag) | ||
| 819 | (save-excursion | ||
| 820 | (outline-back-to-heading) | ||
| 821 | (outline-end-of-heading) | ||
| 822 | (outline-flag-region (point) | ||
| 823 | (progn (outline-end-of-subtree) (point)) | ||
| 824 | flag))) | ||
| 825 | |||
| 826 | (defun outline-end-of-subtree () | ||
| 827 | (outline-back-to-heading) | ||
| 828 | (let ((opoint (point)) | ||
| 829 | (first t) | ||
| 830 | (level (funcall outline-level))) | ||
| 831 | (while (and (not (eobp)) | ||
| 832 | (or first (> (funcall outline-level) level))) | ||
| 833 | (setq first nil) | ||
| 834 | (outline-next-heading)) | ||
| 835 | (if (bolp) | ||
| 836 | (progn | ||
| 837 | ;; Go to end of line before heading | ||
| 838 | (forward-char -1) | ||
| 839 | (if (bolp) | ||
| 840 | ;; leave blank line before heading | ||
| 841 | (forward-char -1)))))) | ||
| 842 | |||
| 843 | (defun show-branches () | ||
| 844 | "Show all subheadings of this heading, but not their bodies." | ||
| 845 | (interactive) | ||
| 846 | (show-children 1000)) | ||
| 847 | |||
| 848 | (defun show-children (&optional level) | ||
| 849 | "Show all direct subheadings of this heading. | ||
| 850 | Prefix arg LEVEL is how many levels below the current level should be shown. | ||
| 851 | Default is enough to cause the following heading to appear." | ||
| 852 | (interactive "P") | ||
| 853 | (setq level | ||
| 854 | (if level (prefix-numeric-value level) | ||
| 855 | (save-excursion | ||
| 856 | (outline-back-to-heading) | ||
| 857 | (let ((start-level (funcall outline-level))) | ||
| 858 | (outline-next-heading) | ||
| 859 | (if (eobp) | ||
| 860 | 1 | ||
| 861 | (max 1 (- (funcall outline-level) start-level))))))) | ||
| 862 | (let (outline-view-change-hook) | ||
| 863 | (save-excursion | ||
| 864 | (outline-back-to-heading) | ||
| 865 | (setq level (+ level (funcall outline-level))) | ||
| 866 | (outline-map-region | ||
| 867 | (lambda () | ||
| 868 | (if (<= (funcall outline-level) level) | ||
| 869 | (outline-show-heading))) | ||
| 870 | (point) | ||
| 871 | (progn (outline-end-of-subtree) | ||
| 872 | (if (eobp) (point-max) (1+ (point))))))) | ||
| 873 | (run-hooks 'outline-view-change-hook)) | ||
| 874 | |||
| 875 | |||
| 876 | |||
| 877 | (defun outline-up-heading (arg &optional invisible-ok) | ||
| 878 | "Move to the visible heading line of which the present line is a subheading. | ||
| 879 | With argument, move up ARG levels. | ||
| 880 | If INVISIBLE-OK is non-nil, also consider invisible lines." | ||
| 881 | (interactive "p") | ||
| 882 | (outline-back-to-heading invisible-ok) | ||
| 883 | (let ((start-level (funcall outline-level))) | ||
| 884 | (if (eq start-level 1) | ||
| 885 | (error "Already at top level of the outline")) | ||
| 886 | (while (and (> start-level 1) (> arg 0) (not (bobp))) | ||
| 887 | (let ((level start-level)) | ||
| 888 | (while (not (or (< level start-level) (bobp))) | ||
| 889 | (if invisible-ok | ||
| 890 | (outline-previous-heading) | ||
| 891 | (outline-previous-visible-heading 1)) | ||
| 892 | (setq level (funcall outline-level))) | ||
| 893 | (setq start-level level)) | ||
| 894 | (setq arg (- arg 1)))) | ||
| 895 | (looking-at outline-regexp)) | ||
| 896 | |||
| 897 | (defun outline-forward-same-level (arg) | ||
| 898 | "Move forward to the ARG'th subheading at same level as this one. | ||
| 899 | Stop at the first and last subheadings of a superior heading." | ||
| 900 | (interactive "p") | ||
| 901 | (outline-back-to-heading) | ||
| 902 | (while (> arg 0) | ||
| 903 | (let ((point-to-move-to (save-excursion | ||
| 904 | (outline-get-next-sibling)))) | ||
| 905 | (if point-to-move-to | ||
| 906 | (progn | ||
| 907 | (goto-char point-to-move-to) | ||
| 908 | (setq arg (1- arg))) | ||
| 909 | (progn | ||
| 910 | (setq arg 0) | ||
| 911 | (error "No following same-level heading")))))) | ||
| 912 | |||
| 913 | (defun outline-get-next-sibling () | ||
| 914 | "Move to next heading of the same level, and return point or nil if none." | ||
| 915 | (let ((level (funcall outline-level))) | ||
| 916 | (outline-next-visible-heading 1) | ||
| 917 | (while (and (not (eobp)) (> (funcall outline-level) level)) | ||
| 918 | (outline-next-visible-heading 1)) | ||
| 919 | (if (or (eobp) (< (funcall outline-level) level)) | ||
| 920 | nil | ||
| 921 | (point)))) | ||
| 922 | |||
| 923 | (defun outline-backward-same-level (arg) | ||
| 924 | "Move backward to the ARG'th subheading at same level as this one. | ||
| 925 | Stop at the first and last subheadings of a superior heading." | ||
| 926 | (interactive "p") | ||
| 927 | (outline-back-to-heading) | ||
| 928 | (while (> arg 0) | ||
| 929 | (let ((point-to-move-to (save-excursion | ||
| 930 | (outline-get-last-sibling)))) | ||
| 931 | (if point-to-move-to | ||
| 932 | (progn | ||
| 933 | (goto-char point-to-move-to) | ||
| 934 | (setq arg (1- arg))) | ||
| 935 | (progn | ||
| 936 | (setq arg 0) | ||
| 937 | (error "No previous same-level heading")))))) | ||
| 938 | |||
| 939 | (defun outline-get-last-sibling () | ||
| 940 | "Move to previous heading of the same level, and return point or nil if none." | ||
| 941 | (let ((level (funcall outline-level))) | ||
| 942 | (outline-previous-visible-heading 1) | ||
| 943 | (while (and (> (funcall outline-level) level) | ||
| 944 | (not (bobp))) | ||
| 945 | (outline-previous-visible-heading 1)) | ||
| 946 | (if (< (funcall outline-level) level) | ||
| 947 | nil | ||
| 948 | (point)))) | ||
| 949 | |||
| 950 | (defun outline-headers-as-kill (beg end) | ||
| 951 | "Save the visible outline headers in region at the start of the kill ring. | ||
| 952 | |||
| 953 | Text shown between the headers isn't copied. Two newlines are | ||
| 954 | inserted between saved headers. Yanking the result may be a | ||
| 955 | convenient way to make a table of contents of the buffer." | ||
| 956 | (interactive "r") | ||
| 957 | (save-excursion | ||
| 958 | (save-restriction | ||
| 959 | (narrow-to-region beg end) | ||
| 960 | (goto-char (point-min)) | ||
| 961 | (let ((buffer (current-buffer)) | ||
| 962 | start end) | ||
| 963 | (with-temp-buffer | ||
| 964 | (with-current-buffer buffer | ||
| 965 | ;; Boundary condition: starting on heading: | ||
| 966 | (when (outline-on-heading-p) | ||
| 967 | (outline-back-to-heading) | ||
| 968 | (setq start (point) | ||
| 969 | end (progn (outline-end-of-heading) | ||
| 970 | (point))) | ||
| 971 | (insert-buffer-substring buffer start end) | ||
| 972 | (insert "\n\n"))) | ||
| 973 | (let ((temp-buffer (current-buffer))) | ||
| 974 | (with-current-buffer buffer | ||
| 975 | (while (outline-next-heading) | ||
| 976 | (unless (outline-invisible-p) | ||
| 977 | (setq start (point) | ||
| 978 | end (progn (outline-end-of-heading) (point))) | ||
| 979 | (with-current-buffer temp-buffer | ||
| 980 | (insert-buffer-substring buffer start end) | ||
| 981 | (insert "\n\n")))))) | ||
| 982 | (kill-new (buffer-string))))))) | ||
| 983 | |||
| 984 | (provide 'outline) | ||
| 985 | (provide 'noutline) | ||
| 986 | |||
| 987 | ;;; outline.el ends here | ||