![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to outline.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to outline.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 ! root 1: ;; Outline mode commands for Emacs ! 2: ;; Copyright (C) 1986 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is free software; you can redistribute it and/or modify ! 7: ;; it under the terms of the GNU General Public License as published by ! 8: ;; the Free Software Foundation; either version 1, or (at your option) ! 9: ;; any later version. ! 10: ! 11: ;; GNU Emacs is distributed in the hope that it will be useful, ! 12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: ;; GNU General Public License for more details. ! 15: ! 16: ;; You should have received a copy of the GNU General Public License ! 17: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 19: ! 20: ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS. ! 21: ! 22: (defvar outline-regexp "[*\^l]+" ! 23: "*Regular expression to match the beginning of a heading line. ! 24: Any line whose beginning matches this regexp is considered a heading. ! 25: The recommended way to set this is with a Local Variables: list ! 26: in the file it applies to.") ! 27: ! 28: (defvar outline-mode-map nil "") ! 29: ! 30: (if outline-mode-map ! 31: nil ! 32: (setq outline-mode-map (copy-keymap text-mode-map)) ! 33: (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading) ! 34: (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading) ! 35: (define-key outline-mode-map "\C-c\C-i" 'show-children) ! 36: (define-key outline-mode-map "\C-c\C-s" 'show-subtree) ! 37: (define-key outline-mode-map "\C-c\C-h" 'hide-subtree) ! 38: (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading) ! 39: (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level) ! 40: (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level)) ! 41: ! 42: (defun outline-mode () ! 43: "Set major mode for editing outlines with selective display. ! 44: Headings are lines which start with asterisks: one for major headings, ! 45: two for subheadings, etc. Lines not starting with asterisks are body lines. ! 46: ! 47: Body text or subheadings under a heading can be made temporarily ! 48: invisible, or visible again. Invisible lines are attached to the end ! 49: of the heading, so they move with it, if the line is killed and yanked ! 50: back. A heading with text hidden under it is marked with an ellipsis (...). ! 51: ! 52: Commands: ! 53: C-c C-n outline-next-visible-heading move by visible headings ! 54: C-c C-p outline-previous-visible-heading ! 55: C-c C-f outline-forward-same-level similar but skip subheadings ! 56: C-c C-b outline-backward-same-level ! 57: C-c C-u outline-up-heading move from subheading to heading ! 58: ! 59: Meta-x hide-body make all text invisible (not headings). ! 60: Meta-x show-all make everything in buffer visible. ! 61: ! 62: The remaining commands are used when point is on a heading line. ! 63: They apply to some of the body or subheadings of that heading. ! 64: C-c C-h hide-subtree make body and subheadings invisible. ! 65: C-c C-s show-subtree make body and subheadings visible. ! 66: C-c C-i show-children make direct subheadings visible. ! 67: No effect on body, or subheadings 2 or more levels down. ! 68: With arg N, affects subheadings N levels down. ! 69: M-x hide-entry make immediately following body invisible. ! 70: M-x show-entry make it visible. ! 71: M-x hide-leaves make body under heading and under its subheadings invisible. ! 72: The subheadings remain visible. ! 73: M-x show-branches make all subheadings at all levels visible. ! 74: ! 75: The variable outline-regexp can be changed to control what is a heading. ! 76: A line is a heading if outline-regexp matches something at the ! 77: beginning of the line. The longer the match, the deeper the level. ! 78: ! 79: Turning on outline mode calls the value of text-mode-hook and then of ! 80: outline-mode-hook, if they are non-nil." ! 81: (interactive) ! 82: (kill-all-local-variables) ! 83: (setq selective-display t) ! 84: (use-local-map outline-mode-map) ! 85: (setq mode-name "Outline") ! 86: (setq major-mode 'outline-mode) ! 87: (define-abbrev-table 'text-mode-abbrev-table ()) ! 88: (setq local-abbrev-table text-mode-abbrev-table) ! 89: (set-syntax-table text-mode-syntax-table) ! 90: (make-local-variable 'paragraph-start) ! 91: (setq paragraph-start (concat paragraph-start "\\|^\\(" ! 92: outline-regexp "\\)")) ! 93: (make-local-variable 'paragraph-separate) ! 94: (setq paragraph-separate (concat paragraph-separate "\\|^\\(" ! 95: outline-regexp "\\)")) ! 96: (run-hooks 'text-mode-hook 'outline-mode-hook)) ! 97: ! 98: (defun outline-level () ! 99: "Return the depth to which a statement is nested in the outline. ! 100: Point must be at the beginning of a header line. ! 101: This is actually the length of whatever outline-regexp matches." ! 102: (save-excursion ! 103: (looking-at outline-regexp) ! 104: (- (match-end 0) (match-beginning 0)))) ! 105: ! 106: (defun outline-next-preface () ! 107: "Skip forward to just before the next heading line." ! 108: (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)") ! 109: nil 'move) ! 110: (goto-char (match-beginning 0))) ! 111: (if (memq (preceding-char) '(?\n ?\^M)) ! 112: (forward-char -1))) ! 113: ! 114: (defun outline-next-heading () ! 115: "Move to the next (possibly invisible) heading line." ! 116: (interactive) ! 117: (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)") ! 118: nil 'move) ! 119: (goto-char (1+ (match-beginning 0))))) ! 120: ! 121: (defun outline-back-to-heading () ! 122: "Move to previous (possibly invisible) heading line, ! 123: or to beginning of this line if it is a heading line." ! 124: (beginning-of-line) ! 125: (or (outline-on-heading-p) ! 126: (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move))) ! 127: ! 128: (defun outline-on-heading-p () ! 129: "Return T if point is on a header line." ! 130: (save-excursion ! 131: (beginning-of-line) ! 132: (and (eq (preceding-char) ?\n) ! 133: (looking-at outline-regexp)))) ! 134: ! 135: (defun outline-next-visible-heading (arg) ! 136: "Move to the next visible heading line. ! 137: With argument, repeats or can move backward if negative. ! 138: A heading line is one that starts with a `*' (or that outline-regexp matches)." ! 139: (interactive "p") ! 140: (if (< arg 0) ! 141: (beginning-of-line) ! 142: (end-of-line)) ! 143: (re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil arg) ! 144: (beginning-of-line)) ! 145: ! 146: (defun outline-previous-visible-heading (arg) ! 147: "Move to the previous heading line. ! 148: With argument, repeats or can move forward if negative. ! 149: A heading line is one that starts with a `*' (or that outline-regexp matches)." ! 150: (interactive "p") ! 151: (outline-next-visible-heading (- arg))) ! 152: ! 153: (defun outline-flag-region (from to flag) ! 154: "Hides or shows lines from FROM to TO, according to FLAG. ! 155: If FLAG is `\\n' (newline character) then text is shown, ! 156: while if FLAG is `\\^M' (control-M) the text is hidden." ! 157: (let ((modp (buffer-modified-p))) ! 158: (unwind-protect ! 159: (subst-char-in-region from to ! 160: (if (= flag ?\n) ?\^M ?\n) ! 161: flag t) ! 162: (set-buffer-modified-p modp)))) ! 163: ! 164: (defun hide-entry () ! 165: "Hide the body directly following this heading." ! 166: (interactive) ! 167: (outline-back-to-heading) ! 168: (save-excursion ! 169: (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M))) ! 170: ! 171: (defun show-entry () ! 172: "Show the body directly following this heading." ! 173: (interactive) ! 174: (save-excursion ! 175: (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n))) ! 176: ! 177: (defun hide-body () ! 178: "Hide all of buffer except headings." ! 179: (interactive) ! 180: (hide-region-body (point-min) (point-max))) ! 181: ! 182: (defun hide-region-body (start end) ! 183: "Hide all body lines in the region, but not headings." ! 184: (save-excursion ! 185: (save-restriction ! 186: (narrow-to-region start end) ! 187: (goto-char (point-min)) ! 188: (while (not (eobp)) ! 189: (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M) ! 190: (if (not (eobp)) ! 191: (forward-char ! 192: (if (looking-at "[\n\^M][\n\^M]") ! 193: 2 1))))))) ! 194: ! 195: (defun show-all () ! 196: "Show all of the text in the buffer." ! 197: (interactive) ! 198: (outline-flag-region (point-min) (point-max) ?\n)) ! 199: ! 200: (defun hide-subtree () ! 201: "Hide everything after this heading at deeper levels." ! 202: (interactive) ! 203: (outline-flag-subtree ?\^M)) ! 204: ! 205: (defun hide-leaves () ! 206: "Hide all body after this heading at deeper levels." ! 207: (interactive) ! 208: (outline-back-to-heading) ! 209: (hide-region-body (point) (progn (outline-end-of-subtree) (point)))) ! 210: ! 211: (defun show-subtree () ! 212: "Show everything after this heading at deeper levels." ! 213: (interactive) ! 214: (outline-flag-subtree ?\n)) ! 215: ! 216: (defun outline-flag-subtree (flag) ! 217: (save-excursion ! 218: (outline-back-to-heading) ! 219: (outline-flag-region (point) ! 220: (progn (outline-end-of-subtree) (point)) ! 221: flag))) ! 222: ! 223: (defun outline-end-of-subtree () ! 224: (beginning-of-line) ! 225: (let ((opoint (point)) ! 226: (first t) ! 227: (level (outline-level))) ! 228: (while (and (not (eobp)) ! 229: (or first (> (outline-level) level))) ! 230: (setq first nil) ! 231: (outline-next-heading)) ! 232: (forward-char -1) ! 233: (if (memq (preceding-char) '(?\n ?\^M)) ! 234: (forward-char -1)))) ! 235: ! 236: (defun show-branches () ! 237: "Show all subheadings of this heading, but not their bodies." ! 238: (interactive) ! 239: (show-children 1000)) ! 240: ! 241: (defun show-children (&optional level) ! 242: "Show all direct subheadings of this heading. Optional LEVEL specifies ! 243: how many levels below the current level should be shown." ! 244: (interactive "p") ! 245: (or level (setq level 1)) ! 246: (save-excursion ! 247: (save-restriction ! 248: (beginning-of-line) ! 249: (setq level (+ level (outline-level))) ! 250: (narrow-to-region (point) ! 251: (progn (outline-end-of-subtree) (1+ (point)))) ! 252: (goto-char (point-min)) ! 253: (while (and (not (eobp)) ! 254: (progn ! 255: (outline-next-heading) ! 256: (not (eobp)))) ! 257: (if (<= (outline-level) level) ! 258: (save-excursion ! 259: (let ((end (1+ (point)))) ! 260: (forward-char -1) ! 261: (if (memq (preceding-char) '(?\n ?\^M)) ! 262: (forward-char -1)) ! 263: (outline-flag-region (point) end ?\n)))))))) ! 264: ! 265: (defun outline-up-heading (arg) ! 266: "Move to the heading line of which the present line is a subheading. ! 267: With argument, move up ARG levels." ! 268: (interactive "p") ! 269: (outline-back-to-heading) ! 270: (if (eq (outline-level) 1) ! 271: (error "")) ! 272: (while (and (> (outline-level) 1) ! 273: (> arg 0) ! 274: (not (bobp))) ! 275: (let ((present-level (outline-level))) ! 276: (while (not (< (outline-level) present-level)) ! 277: (outline-previous-visible-heading 1)) ! 278: (setq arg (- arg 1))))) ! 279: ! 280: (defun outline-forward-same-level (arg) ! 281: "Move forward to the ARG'th subheading from here of the same level as the ! 282: present one. It stops at the first and last subheadings of a superior heading." ! 283: (interactive "p") ! 284: (outline-back-to-heading) ! 285: (while (> arg 0) ! 286: (let ((point-to-move-to (save-excursion ! 287: (outline-get-next-sibling)))) ! 288: (if point-to-move-to ! 289: (progn ! 290: (goto-char point-to-move-to) ! 291: (setq arg (1- arg))) ! 292: (progn ! 293: (setq arg 0) ! 294: (error "")))))) ! 295: ! 296: (defun outline-get-next-sibling () ! 297: "Position the point at the next heading of the same level, ! 298: and return that position or nil if it cannot be found." ! 299: (let ((level (outline-level))) ! 300: (outline-next-visible-heading 1) ! 301: (while (and (> (outline-level) level) ! 302: (not (eobp))) ! 303: (outline-next-visible-heading 1)) ! 304: (if (< (outline-level) level) ! 305: nil ! 306: (point)))) ! 307: ! 308: (defun outline-backward-same-level (arg) ! 309: "Move backward to the ARG'th subheading from here of the same level as the ! 310: present one. It stops at the first and last subheadings of a superior heading." ! 311: (interactive "p") ! 312: (outline-back-to-heading) ! 313: (while (> arg 0) ! 314: (let ((point-to-move-to (save-excursion ! 315: (outline-get-last-sibling)))) ! 316: (if point-to-move-to ! 317: (progn ! 318: (goto-char point-to-move-to) ! 319: (setq arg (1- arg))) ! 320: (progn ! 321: (setq arg 0) ! 322: (error "")))))) ! 323: ! 324: (defun outline-get-last-sibling () ! 325: "Position the point at the previous heading of the same level, ! 326: and return that position or nil if it cannot be found." ! 327: (let ((level (outline-level))) ! 328: (outline-previous-visible-heading 1) ! 329: (while (and (> (outline-level) level) ! 330: (not (bobp))) ! 331: (outline-previous-visible-heading 1)) ! 332: (if (< (outline-level) level) ! 333: nil ! 334: (point)))) ! 335:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.