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