Annotation of 43BSD/contrib/emacs/lisp/outline.el, revision 1.1.1.1

1.1       root        1: ;; Outline mode commands for Emacs
                      2: ;; Copyright (C) 1985 Richard M. Stallman.
                      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: 
                     22: (defvar outline-mode-map nil "")
                     23: 
                     24: (if outline-mode-map
                     25:     nil
                     26:   (setq outline-mode-map (copy-alist text-mode-map))
                     27:   (define-key outline-mode-map "\e}" 'next-visible-heading)
                     28:   (define-key outline-mode-map "\e{" 'previous-visible-heading)
                     29:   (define-key outline-mode-map "\C-c\t" 'show-children)
                     30:   (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
                     31:   (define-key outline-mode-map "\C-c\C-h" 'hide-subtree))
                     32: 
                     33: (defun outline-mode ()
                     34:   "Set major mode for editing outlines with selective display.
                     35: Headings should be lines starting with one or more asterisks.
                     36: Major headings have one asterisk, subheadings two, etc.
                     37: Lines not starting with asterisks are body lines.
                     38: 
                     39: You can make the body text under a heading, or the subheadings
                     40: under a heading, temporarily invisible, or visible again.
                     41: Invisible lines are attached to the end of the previous line
                     42: so they go with it if you kill it and yank it back.
                     43: 
                     44: Commands:
                     45: Meta-}   next-visible-heading      move by visible headings
                     46: Meta-{   previous-visible-heading  move by visible headings
                     47: 
                     48: Meta-x hide-body       make all text invisible (not headings).
                     49: Meta-x show-all                make everything in buffer visible.
                     50: 
                     51: The remaining commands are used when point is on a heading line.
                     52: They apply to some of the body or subheadings of that heading.
                     53: C-c C-h   hide-subtree make body and subheadings invisible.
                     54: C-c C-s   show-subtree make body and subheadings visible.
                     55: C-c C-i   show-children        make direct subheadings visible.
                     56:                 No effect on body, or subheadings 2 or more levels down.
                     57:                 With arg N, affects subheadings N levels down.
                     58: hide-entry     make immediately following body invisible.
                     59: show-entry     make it visible.
                     60: hide-leaves    make body under heading and under its subheadings invisible.
                     61:                 The subheadings remain visible.
                     62: show-branches  make all subheadings at all levels visible."
                     63:   (interactive)
                     64:   (kill-all-local-variables)
                     65:   (setq selective-display t)
                     66:   (use-local-map outline-mode-map)
                     67:   (setq mode-name "Outline")
                     68:   (setq major-mode 'outline-mode)
                     69:   (define-abbrev-table 'text-mode-abbrev-table ())
                     70:   (setq local-abbrev-table text-mode-abbrev-table)
                     71:   (set-syntax-table text-mode-syntax-table)
                     72:   (make-local-variable 'paragraph-start)
                     73:   (setq paragraph-start (concat paragraph-start "\\|*"))
                     74:   (make-local-variable 'paragraph-separate)
                     75:   (setq paragraph-separate (concat paragraph-separate "\\|*"))
                     76:   (run-hooks 'text-mode-hook 'outline-mode-hook))
                     77: 
                     78: (defun outline-level ()
                     79:   (save-excursion
                     80:    (- (- (point) (progn (skip-chars-forward "^ \t") (point))))))
                     81: 
                     82: (defun next-heading-preface ()
                     83:   (if (re-search-forward "[\n\^M]\\*"
                     84:                         nil 'move)
                     85:       (goto-char (match-beginning 0)))
                     86:   (if (memq (preceding-char) '(?\n ?\^M))
                     87:       (forward-char -1)))
                     88: 
                     89: (defun next-heading ()
                     90:   "Move to the next heading line (a line starting with *'s)."
                     91:   (interactive)
                     92:   (if (re-search-forward "[\n\^M]\\*"
                     93:                         nil 'move)
                     94:       (goto-char (1+ (match-beginning 0)))))
                     95: 
                     96: (defun next-visible-heading (arg)
                     97:   "Move to the next visible heading line (a line starting with *'s).
                     98: With argument, repeats or can move backward if negative."
                     99:   (interactive "p")
                    100:   (if (< arg 0)
                    101:       (beginning-of-line)
                    102:     (forward-line 1))
                    103:   (re-search-forward "^\\*" nil nil arg)
                    104:   (beginning-of-line))
                    105: 
                    106: (defun previous-visible-heading (arg)
                    107:   "Move to the previous heading line (a line starting with *'s).
                    108: With argument, repeats or can move forward if negative."
                    109:   (interactive "p")
                    110:   (if (> arg 0)
                    111:       (beginning-of-line)
                    112:     (forward-line 1))
                    113:   (re-search-backward "^\\*" nil nil arg)
                    114:   (beginning-of-line))
                    115: 
                    116: (defun flag-lines-in-region (from to flag)
                    117:   (let ((modp (buffer-modified-p)))
                    118:     (unwind-protect
                    119:      (subst-char-in-region from to
                    120:                           (if (= flag ?\n) ?\^M ?\n)
                    121:                           flag t)
                    122:      (set-buffer-modified-p modp))))
                    123: 
                    124: (defun hide-entry ()
                    125:   "Hide the body directly following this heading."
                    126:   (interactive)
                    127:   (save-excursion
                    128:    (flag-lines-in-region (point) (progn (next-heading-preface) (point)) ?\^M)))
                    129: 
                    130: (defun show-entry ()
                    131:   "Show the body directly following this heading."
                    132:   (interactive)
                    133:   (save-excursion
                    134:    (flag-lines-in-region (point) (progn (next-heading-preface) (point)) ?\n)))
                    135: 
                    136: (defun hide-body ()
                    137:   "Hide all of buffer except headings."
                    138:   (interactive)
                    139:   (hide-region-body (point-min) (point-max)))
                    140: 
                    141: (defun hide-region-body (start end)
                    142:   "Hide all body lines in the region, but not headings."
                    143:   (save-excursion
                    144:    (save-restriction
                    145:     (narrow-to-region start end)
                    146:     (goto-char (point-min))
                    147:     (while (not (eobp))
                    148:      (flag-lines-in-region (point) (progn (next-heading-preface) (point)) ?\^M)
                    149:      (forward-char
                    150:       (if (looking-at "[\n\^M][\n\^M]")
                    151:          2 1))))))
                    152: 
                    153: (defun show-all ()
                    154:   "Show all of the body in the buffer."
                    155:   (interactive)
                    156:   (flag-lines-in-region (point-min) (point-max) ?\n))
                    157: 
                    158: (defun hide-subtree ()
                    159:   "Hide everything after this heading at deeper levels."
                    160:   (interactive)
                    161:   (flag-subtree ?\^M))
                    162: 
                    163: (defun hide-leaves ()
                    164:   "Hide all body after this heading at deeper levels."
                    165:   (interactive)
                    166:   (hide-region-body (point) (progn (end-of-subtree) (point))))
                    167: 
                    168: (defun show-subtree ()
                    169:   "Show everything after this heading at deeper levels."
                    170:   (interactive)
                    171:   (flag-subtree ?\n))
                    172: 
                    173: (defun flag-subtree (flag)
                    174:   (save-excursion
                    175:    (flag-lines-in-region (point)
                    176:                         (progn (end-of-subtree) (point))
                    177:                         flag)))
                    178: 
                    179: (defun end-of-subtree ()
                    180:   (beginning-of-line)
                    181:   (let ((opoint (point))
                    182:        (first t)
                    183:        (level (outline-level)))
                    184:     (while (and (not (eobp))
                    185:                (or first (> (outline-level) level)))
                    186:       (setq first nil)
                    187:       (next-heading))
                    188:     (forward-char -1)
                    189:     (if (memq (preceding-char) '(?\n ?\^M))
                    190:        (forward-char -1))))
                    191: 
                    192: (defun show-branches ()
                    193:   "Show all subheadings of this heading, but not their bodies."
                    194:   (interactive)
                    195:   (show-children 1000))
                    196: 
                    197: (defun show-children (&optional level)
                    198:   "Show all direct subheadings of this heading."
                    199:   (interactive "p")
                    200:   (or level (setq level 1))
                    201:   (save-excursion
                    202:    (save-restriction
                    203:     (beginning-of-line)
                    204:     (setq level (+ level (outline-level)))
                    205:     (narrow-to-region (point)
                    206:                      (progn (end-of-subtree) (1+ (point))))
                    207:     (goto-char (point-min))
                    208:     (while (and (not (eobp))
                    209:                (progn
                    210:                 (next-heading)
                    211:                 (not (eobp))))
                    212:       (if (<= (outline-level) level)
                    213:          (save-excursion
                    214:           (let ((end (1+ (point))))
                    215:             (forward-char -1)
                    216:             (if (memq (preceding-char) '(?\n ?\^M))
                    217:                 (forward-char -1))
                    218:             (flag-lines-in-region (point) end ?\n))))))))
                    219: 

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.