mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-25 07:28:20 +00:00
Initial revision
This commit is contained in:
Brian Preble
parent
6d1f885f5c
commit
26d1e4fd8f
396
lisp/textmodes/ooutline.el
Normal file
396
lisp/textmodes/ooutline.el
Normal file
@ -0,0 +1,396 @@
|
||||
;; Outline mode commands for Emacs
|
||||
;; Copyright (C) 1986 Free Software Foundation, Inc.
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 1, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
|
||||
|
||||
(defvar outline-regexp "[*\^l]+"
|
||||
"*Regular expression to match the beginning of a heading.
|
||||
Any line whose beginning matches this regexp is considered to start a heading.
|
||||
The recommended way to set this is with a Local Variables: list
|
||||
in the file it applies to. See also outline-heading-end-regexp.")
|
||||
|
||||
(defvar outline-heading-end-regexp "[\n^M]"
|
||||
"*Regular expression to match the end of a heading line.
|
||||
You can assume that point is at the beginning of a heading when this
|
||||
regexp is searched for. The heading ends at the end of the match.
|
||||
The recommended way to set this is with a \"Local Variables:\" list
|
||||
in the file it applies to.")
|
||||
|
||||
(defvar outline-mode-map nil "")
|
||||
|
||||
(if outline-mode-map
|
||||
nil
|
||||
(setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
|
||||
(define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading)
|
||||
(define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
|
||||
(define-key outline-mode-map "\C-c\C-i" 'show-children)
|
||||
(define-key outline-mode-map "\C-c\C-s" 'show-subtree)
|
||||
(define-key outline-mode-map "\C-c\C-h" 'hide-subtree)
|
||||
(define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
|
||||
(define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
|
||||
(define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level))
|
||||
|
||||
(defvar outline-minor-mode nil
|
||||
"Non-nil if using Outline mode as a minor mode of some other mode.")
|
||||
(setq minor-mode-alist (append minor-mode-alist
|
||||
(list '(outline-minor-mode " Outl"))))
|
||||
|
||||
(defun outline-mode ()
|
||||
"Set major mode for editing outlines with selective display.
|
||||
Headings are lines which start with asterisks: one for major headings,
|
||||
two for subheadings, etc. Lines not starting with asterisks are body lines.
|
||||
|
||||
Body text or subheadings under a heading can be made temporarily
|
||||
invisible, or visible again. Invisible lines are attached to the end
|
||||
of the heading, so they move with it, if the line is killed and yanked
|
||||
back. A heading with text hidden under it is marked with an ellipsis (...).
|
||||
|
||||
Commands:\\<outline-mode-map>
|
||||
\\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
|
||||
\\[outline-previous-visible-heading] outline-previous-visible-heading
|
||||
\\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
|
||||
\\[outline-backward-same-level] outline-backward-same-level
|
||||
\\[outline-up-heading] outline-up-heading move from subheading to heading
|
||||
|
||||
M-x hide-body make all text invisible (not headings).
|
||||
M-x show-all make everything in buffer visible.
|
||||
|
||||
The remaining commands are used when point is on a heading line.
|
||||
They apply to some of the body or subheadings of that heading.
|
||||
\\[hide-subtree] hide-subtree make body and subheadings invisible.
|
||||
\\[show-subtree] show-subtree make body and subheadings visible.
|
||||
\\[show-children] show-children make direct subheadings visible.
|
||||
No effect on body, or subheadings 2 or more levels down.
|
||||
With arg N, affects subheadings N levels down.
|
||||
M-x hide-entry make immediately following body invisible.
|
||||
M-x show-entry make it visible.
|
||||
M-x hide-leaves make body under heading and under its subheadings invisible.
|
||||
The subheadings remain visible.
|
||||
M-x show-branches make all subheadings at all levels visible.
|
||||
|
||||
The variable `outline-regexp' can be changed to control what is a heading.
|
||||
A line is a heading if `outline-regexp' matches something at the
|
||||
beginning of the line. The longer the match, the deeper the level.
|
||||
|
||||
Turning on outline mode calls the value of `text-mode-hook' and then of
|
||||
`outline-mode-hook', if they are non-nil."
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(setq selective-display t)
|
||||
(use-local-map outline-mode-map)
|
||||
(setq mode-name "Outline")
|
||||
(setq major-mode 'outline-mode)
|
||||
(define-abbrev-table 'text-mode-abbrev-table ())
|
||||
(setq local-abbrev-table text-mode-abbrev-table)
|
||||
(set-syntax-table text-mode-syntax-table)
|
||||
(make-local-variable 'paragraph-start)
|
||||
(setq paragraph-start (concat paragraph-start "\\|^\\("
|
||||
outline-regexp "\\)"))
|
||||
;; Inhibit auto-filling of header lines.
|
||||
(make-local-variable 'auto-fill-inhibit-regexp)
|
||||
(setq auto-fill-inhibit-regexp outline-regexp)
|
||||
(make-local-variable 'paragraph-separate)
|
||||
(setq paragraph-separate (concat paragraph-separate "\\|^\\("
|
||||
outline-regexp "\\)"))
|
||||
(run-hooks 'text-mode-hook 'outline-mode-hook))
|
||||
|
||||
(defun outline-minor-mode (arg)
|
||||
(interactive "P")
|
||||
(setq outline-minor-mode
|
||||
(if (null arg) (not outline-minor-mode)
|
||||
(> (prefix-numeric-value arg) 0)))
|
||||
(if outline-minor-mode
|
||||
(progn
|
||||
(setq selective-display t)
|
||||
(make-local-variable 'outline-old-map)
|
||||
(setq outline-old-map (current-local-map))
|
||||
(let ((new-map (copy-keymap outline-old-map)))
|
||||
(define-key new-map "\C-c"
|
||||
(lookup-key outline-mode-map "\C-c"))
|
||||
(use-local-map new-map))
|
||||
(make-local-variable 'outline-regexp)
|
||||
(setq outline-regexp "[ \t]*/\\*")
|
||||
(make-local-variable 'outline-heading-end-regexp)
|
||||
(setq outline-heading-end-regexp "\\*/[^\n\^M]*[\n\^M]")
|
||||
(run-hooks 'outline-minor-mode-hook))
|
||||
(progn
|
||||
(setq selective-display nil)
|
||||
(use-local-map outline-old-map))))
|
||||
|
||||
(defun outline-level ()
|
||||
"Return the depth to which a statement is nested in the outline.
|
||||
Point must be at the beginning of a header line. This is actually
|
||||
the column number of the end of what `outline-regexp matches'."
|
||||
(save-excursion
|
||||
(looking-at outline-regexp)
|
||||
(save-excursion (goto-char (match-end 0)) (current-column))))
|
||||
|
||||
(defun outline-next-preface ()
|
||||
"Skip forward to just before the next heading line."
|
||||
(if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
|
||||
nil 'move)
|
||||
(goto-char (match-beginning 0)))
|
||||
(if (memq (preceding-char) '(?\n ?\^M))
|
||||
(forward-char -1)))
|
||||
|
||||
(defun outline-next-heading ()
|
||||
"Move to the next (possibly invisible) heading line."
|
||||
(interactive)
|
||||
(if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
|
||||
nil 'move)
|
||||
(goto-char (1+ (match-beginning 0)))))
|
||||
|
||||
(defun outline-back-to-heading ()
|
||||
"Move to previous (possibly invisible) heading line,
|
||||
or to the beginning of this line if it is a heading line."
|
||||
(beginning-of-line)
|
||||
(or (outline-on-heading-p)
|
||||
(re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move)))
|
||||
|
||||
(defun outline-on-heading-p ()
|
||||
"Return T if point is on a header line."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(and (eq (preceding-char) ?\n)
|
||||
(looking-at outline-regexp))))
|
||||
|
||||
(defun outline-end-of-heading ()
|
||||
(if (re-search-forward outline-heading-end-regexp nil 'move)
|
||||
(forward-char -1)))
|
||||
|
||||
(defun outline-next-visible-heading (arg)
|
||||
"Move to the next visible heading line.
|
||||
With argument, repeats or can move backward if negative.
|
||||
A heading line is one that starts with a `*' (or that
|
||||
`outline-regexp' matches)."
|
||||
(interactive "p")
|
||||
(if (< arg 0)
|
||||
(beginning-of-line)
|
||||
(end-of-line))
|
||||
(re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil arg)
|
||||
(beginning-of-line))
|
||||
|
||||
(defun outline-previous-visible-heading (arg)
|
||||
"Move to the previous heading line.
|
||||
With argument, repeats or can move forward if negative.
|
||||
A heading line is one that starts with a `*' (or that
|
||||
`outline-regexp' matches)."
|
||||
(interactive "p")
|
||||
(outline-next-visible-heading (- arg)))
|
||||
|
||||
(defun outline-flag-region (from to flag)
|
||||
"Hides or shows lines from FROM to TO, according to FLAG.
|
||||
If FLAG is `\\n' (newline character) then text is shown,
|
||||
while if FLAG is `\\^M' (control-M) the text is hidden."
|
||||
(let ((modp (buffer-modified-p)))
|
||||
(unwind-protect
|
||||
(subst-char-in-region from to
|
||||
(if (= flag ?\n) ?\^M ?\n)
|
||||
flag)
|
||||
(set-buffer-modified-p modp))))
|
||||
|
||||
(defun hide-entry ()
|
||||
"Hide the body directly following this heading."
|
||||
(interactive)
|
||||
(outline-back-to-heading)
|
||||
(outline-end-of-heading)
|
||||
(save-excursion
|
||||
(outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
|
||||
|
||||
(defun show-entry ()
|
||||
"Show the body directly following this heading."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
|
||||
|
||||
(defun hide-body ()
|
||||
"Hide all of buffer except headings."
|
||||
(interactive)
|
||||
(hide-region-body (point-min) (point-max)))
|
||||
|
||||
(defun hide-region-body (start end)
|
||||
"Hide all body lines in the region, but not headings."
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region start end)
|
||||
(goto-char (point-min))
|
||||
(if (outline-on-heading-p)
|
||||
(outline-end-of-heading))
|
||||
(while (not (eobp))
|
||||
(outline-flag-region (point)
|
||||
(progn (outline-next-preface) (point)) ?\^M)
|
||||
(if (not (eobp))
|
||||
(progn
|
||||
(forward-char
|
||||
(if (looking-at "[\n\^M][\n\^M]")
|
||||
2 1))
|
||||
(outline-end-of-heading)))))))
|
||||
|
||||
(defun show-all ()
|
||||
"Show all of the text in the buffer."
|
||||
(interactive)
|
||||
(outline-flag-region (point-min) (point-max) ?\n))
|
||||
|
||||
(defun hide-subtree ()
|
||||
"Hide everything after this heading at deeper levels."
|
||||
(interactive)
|
||||
(outline-flag-subtree ?\^M))
|
||||
|
||||
(defun hide-leaves ()
|
||||
"Hide all body after this heading at deeper levels."
|
||||
(interactive)
|
||||
(outline-back-to-heading)
|
||||
(outline-end-of-heading)
|
||||
(hide-region-body (point) (progn (outline-end-of-subtree) (point))))
|
||||
|
||||
(defun show-subtree ()
|
||||
"Show everything after this heading at deeper levels."
|
||||
(interactive)
|
||||
(outline-flag-subtree ?\n))
|
||||
|
||||
(defun outline-flag-subtree (flag)
|
||||
(save-excursion
|
||||
(outline-back-to-heading)
|
||||
(outline-end-of-heading)
|
||||
(outline-flag-region (point)
|
||||
(progn (outline-end-of-subtree) (point))
|
||||
flag)))
|
||||
|
||||
(defun outline-end-of-subtree ()
|
||||
(outline-back-to-heading)
|
||||
(let ((opoint (point))
|
||||
(first t)
|
||||
(level (outline-level)))
|
||||
(while (and (not (eobp))
|
||||
(or first (> (outline-level) level)))
|
||||
(setq first nil)
|
||||
(outline-next-heading))
|
||||
(forward-char -1)
|
||||
(if (memq (preceding-char) '(?\n ?\^M))
|
||||
(forward-char -1))))
|
||||
|
||||
(defun show-branches ()
|
||||
"Show all subheadings of this heading, but not their bodies."
|
||||
(interactive)
|
||||
(show-children 1000))
|
||||
|
||||
(defun show-children (&optional level)
|
||||
"Show all direct subheadings of this heading.
|
||||
Prefix arg LEVEL is how many levels below the current level should be shown.
|
||||
Default is enough to cause the following heading to appear."
|
||||
(interactive "P")
|
||||
(setq level
|
||||
(if level (prefix-numeric-value level)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(let ((start-level (outline-level)))
|
||||
(outline-next-heading)
|
||||
(max 1 (- (outline-level) start-level))))))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(beginning-of-line)
|
||||
(setq level (+ level (outline-level)))
|
||||
(narrow-to-region (point)
|
||||
(progn (outline-end-of-subtree) (1+ (point))))
|
||||
(goto-char (point-min))
|
||||
(while (and (not (eobp))
|
||||
(progn
|
||||
(outline-next-heading)
|
||||
(not (eobp))))
|
||||
(if (<= (outline-level) level)
|
||||
(save-excursion
|
||||
(outline-flag-region (save-excursion
|
||||
(forward-char -1)
|
||||
(if (memq (preceding-char) '(?\n ?\^M))
|
||||
(forward-char -1))
|
||||
(point))
|
||||
(progn (outline-end-of-heading) (point))
|
||||
?\n)))))))
|
||||
|
||||
(defun outline-up-heading (arg)
|
||||
"Move to the heading line of which the present line is a subheading.
|
||||
With argument, move up ARG levels."
|
||||
(interactive "p")
|
||||
(outline-back-to-heading)
|
||||
(if (eq (outline-level) 1)
|
||||
(error ""))
|
||||
(while (and (> (outline-level) 1)
|
||||
(> arg 0)
|
||||
(not (bobp)))
|
||||
(let ((present-level (outline-level)))
|
||||
(while (not (< (outline-level) present-level))
|
||||
(outline-previous-visible-heading 1))
|
||||
(setq arg (- arg 1)))))
|
||||
|
||||
(defun outline-forward-same-level (arg)
|
||||
"Move forward to the ARG'th subheading from here of the same level as the
|
||||
present one. It stops at the first and last subheadings of a superior heading."
|
||||
(interactive "p")
|
||||
(outline-back-to-heading)
|
||||
(while (> arg 0)
|
||||
(let ((point-to-move-to (save-excursion
|
||||
(outline-get-next-sibling))))
|
||||
(if point-to-move-to
|
||||
(progn
|
||||
(goto-char point-to-move-to)
|
||||
(setq arg (1- arg)))
|
||||
(progn
|
||||
(setq arg 0)
|
||||
(error ""))))))
|
||||
|
||||
(defun outline-get-next-sibling ()
|
||||
"Position the point at the next heading of the same level,
|
||||
and return that position or nil if it cannot be found."
|
||||
(let ((level (outline-level)))
|
||||
(outline-next-visible-heading 1)
|
||||
(while (and (> (outline-level) level)
|
||||
(not (eobp)))
|
||||
(outline-next-visible-heading 1))
|
||||
(if (< (outline-level) level)
|
||||
nil
|
||||
(point))))
|
||||
|
||||
(defun outline-backward-same-level (arg)
|
||||
"Move backward to the ARG'th subheading from here of the same level as the
|
||||
present one. It stops at the first and last subheadings of a superior heading."
|
||||
(interactive "p")
|
||||
(outline-back-to-heading)
|
||||
(while (> arg 0)
|
||||
(let ((point-to-move-to (save-excursion
|
||||
(outline-get-last-sibling))))
|
||||
(if point-to-move-to
|
||||
(progn
|
||||
(goto-char point-to-move-to)
|
||||
(setq arg (1- arg)))
|
||||
(progn
|
||||
(setq arg 0)
|
||||
(error ""))))))
|
||||
|
||||
(defun outline-get-last-sibling ()
|
||||
"Position the point at the previous heading of the same level,
|
||||
and return that position or nil if it cannot be found."
|
||||
(let ((level (outline-level)))
|
||||
(outline-previous-visible-heading 1)
|
||||
(while (and (> (outline-level) level)
|
||||
(not (bobp)))
|
||||
(outline-previous-visible-heading 1))
|
||||
(if (< (outline-level) level)
|
||||
nil
|
||||
(point))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user