Annotation of 43BSDReno/contrib/emacs-18.55/lisp/outline.el, revision 1.1

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: 

unix.superglobalmegacorp.com

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