;;; outline.el --- outline mode commands for Emacs
-;; Copyright (C) 1986, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1993, 1994, 1997 Free Software Foundation, Inc.
-;; 7-Feb-94 Kevin Broadey
-;; Fix show-children so it doesn't try to narrow to (1+ (point-max)) when
-;; exposing the last level-n header in the buffer.
-;;
;; Maintainer: FSF
+;; Keywords: outlines
;; This file is part of GNU Emacs.
;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
-
-(defvar outline-regexp "[*\^l]+"
+
+(defgroup outlines nil
+ "Support for hierarchical outlining"
+ :prefix "outline-"
+ :group 'editing)
+
+
+(defcustom outline-regexp nil
"*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.")
+in the file it applies to. See also outline-heading-end-regexp."
+ :type '(choice regexp (const nil))
+ :group 'outlines)
+
+;; Can't initialize this in the defvar above -- some major modes have
+;; already assigned a local value to it.
+(or (default-value 'outline-regexp)
+ (setq-default outline-regexp "[*\^L]+"))
-(defvar outline-heading-end-regexp "[\n\^M]"
+(defcustom 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.")
+in the file it applies to."
+ :type 'regexp
+ :group 'outlines)
-(defvar outline-mode-map nil "")
+(defvar outline-mode-prefix-map nil)
-(if outline-mode-map
+(if outline-mode-prefix-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-d" '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)
- (define-key outline-mode-map "\C-c\C-t" 'hide-body)
- (define-key outline-mode-map "\C-c\C-a" 'show-all)
- (define-key outline-mode-map "\C-c\C-c" 'hide-entry)
- (define-key outline-mode-map "\C-c\C-e" 'show-entry)
- (define-key outline-mode-map "\C-c\C-l" 'hide-leaves)
- (define-key outline-mode-map "\C-c\C-k" 'show-branches)
- (define-key outline-mode-map "\C-c\C-q" 'outline-hide-sublevels)
- (define-key outline-mode-map "\C-c\C-o" 'outline-hide-other)
-
- (define-key outline-mode-map [menu-bar hide]
+ (setq outline-mode-prefix-map (make-sparse-keymap))
+ (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading)
+ (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading)
+ (define-key outline-mode-prefix-map "\C-i" 'show-children)
+ (define-key outline-mode-prefix-map "\C-s" 'show-subtree)
+ (define-key outline-mode-prefix-map "\C-d" 'hide-subtree)
+ (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading)
+ (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level)
+ (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level)
+ (define-key outline-mode-prefix-map "\C-t" 'hide-body)
+ (define-key outline-mode-prefix-map "\C-a" 'show-all)
+ (define-key outline-mode-prefix-map "\C-c" 'hide-entry)
+ (define-key outline-mode-prefix-map "\C-e" 'show-entry)
+ (define-key outline-mode-prefix-map "\C-l" 'hide-leaves)
+ (define-key outline-mode-prefix-map "\C-k" 'show-branches)
+ (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels)
+ (define-key outline-mode-prefix-map "\C-o" 'hide-other))
+
+(defvar outline-mode-menu-bar-map nil)
+(if outline-mode-menu-bar-map
+ nil
+ (setq outline-mode-menu-bar-map (make-sparse-keymap))
+
+ (define-key outline-mode-menu-bar-map [hide]
(cons "Hide" (make-sparse-keymap "Hide")))
- (define-key outline-mode-map [menu-bar hide hide-other]
- '("Hide Other" . outline-hide-other))
- (define-key outline-mode-map [menu-bar hide hide-sublevels]
- '("Hide Sublevels" . outline-hide-sublevels))
- (define-key outline-mode-map [menu-bar hide hide-subtree]
+ (define-key outline-mode-menu-bar-map [hide hide-other]
+ '("Hide Other" . hide-other))
+ (define-key outline-mode-menu-bar-map [hide hide-sublevels]
+ '("Hide Sublevels" . hide-sublevels))
+ (define-key outline-mode-menu-bar-map [hide hide-subtree]
'("Hide Subtree" . hide-subtree))
- (define-key outline-mode-map [menu-bar hide hide-entry]
+ (define-key outline-mode-menu-bar-map [hide hide-entry]
'("Hide Entry" . hide-entry))
- (define-key outline-mode-map [menu-bar hide hide-body]
+ (define-key outline-mode-menu-bar-map [hide hide-body]
'("Hide Body" . hide-body))
- (define-key outline-mode-map [menu-bar hide hide-leaves]
+ (define-key outline-mode-menu-bar-map [hide hide-leaves]
'("Hide Leaves" . hide-leaves))
- (define-key outline-mode-map [menu-bar show]
+ (define-key outline-mode-menu-bar-map [show]
(cons "Show" (make-sparse-keymap "Show")))
- (define-key outline-mode-map [menu-bar show show-subtree]
+ (define-key outline-mode-menu-bar-map [show show-subtree]
'("Show Subtree" . show-subtree))
- (define-key outline-mode-map [menu-bar show show-children]
+ (define-key outline-mode-menu-bar-map [show show-children]
'("Show Children" . show-children))
- (define-key outline-mode-map [menu-bar show show-branches]
+ (define-key outline-mode-menu-bar-map [show show-branches]
'("Show Branches" . show-branches))
- (define-key outline-mode-map [menu-bar show show-entry]
+ (define-key outline-mode-menu-bar-map [show show-entry]
'("Show Entry" . show-entry))
- (define-key outline-mode-map [menu-bar show show-all]
+ (define-key outline-mode-menu-bar-map [show show-all]
'("Show All" . show-all))
- (define-key outline-mode-map [menu-bar headings]
+ (define-key outline-mode-menu-bar-map [headings]
(cons "Headings" (make-sparse-keymap "Headings")))
- (define-key outline-mode-map [menu-bar headings outline-backward-same-level]
+ (define-key outline-mode-menu-bar-map [headings outline-backward-same-level]
'("Previous Same Level" . outline-backward-same-level))
- (define-key outline-mode-map [menu-bar headings outline-forward-same-level]
+ (define-key outline-mode-menu-bar-map [headings outline-forward-same-level]
'("Next Same Level" . outline-forward-same-level))
- (define-key outline-mode-map [menu-bar headings outline-previous-visible-heading]
+ (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading]
'("Previous" . outline-previous-visible-heading))
- (define-key outline-mode-map [menu-bar headings outline-next-visible-heading]
+ (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading]
'("Next" . outline-next-visible-heading))
- (define-key outline-mode-map [menu-bar headings outline-up-heading]
+ (define-key outline-mode-menu-bar-map [headings outline-up-heading]
'("Up" . outline-up-heading)))
-(defvar outline-minor-mode nil
- "Non-nil if using Outline mode as a minor mode of some other mode.")
+(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" outline-mode-prefix-map)
+ (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map))
+
+(defcustom outline-minor-mode nil
+ "Non-nil if using Outline mode as a minor mode of some other mode."
+ :type 'boolean
+ :group 'outlines)
(make-variable-buffer-local 'outline-minor-mode)
(put 'outline-minor-mode 'permanent-local t)
(or (assq 'outline-minor-mode minor-mode-alist)
(setq minor-mode-alist (append minor-mode-alist
(list '(outline-minor-mode " Outl")))))
-;;;###autoload
+(defvar outline-font-lock-keywords
+ '(;; Highlight headings according to the level.
+ ("^\\([*]+\\)[ \t]*\\([^\n\r]+\\)?[ \t]*[\n\r]"
+ (1 font-lock-string-face)
+ (2 (let ((len (- (match-end 1) (match-beginning 1))))
+ (or (cdr (assq len '((1 . font-lock-function-name-face)
+ (2 . font-lock-keyword-face)
+ (3 . font-lock-comment-face))))
+ font-lock-variable-name-face))
+ nil t))
+ ;; Highlight citations of the form [1] and [Mar94].
+ ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))
+ "Additional expressions to highlight in Outline mode.")
+
(defun outline-mode ()
"Set major mode for editing outlines with selective display.
Headings are lines which start with asterisks: one for major headings,
\\[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.
+\\[hide-body] make all text invisible (not headings).
+\\[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.
\\[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.
+\\[hide-entry] make immediately following body invisible.
+\\[show-entry] make it visible.
+\\[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.
+\\[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
(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 "\\|^\\("
+ (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 "\\|^\\("
+ (setq paragraph-separate (concat paragraph-separate "\\|\\("
outline-regexp "\\)"))
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(outline-font-lock-keywords t))
+ (make-local-variable 'change-major-mode-hook)
(add-hook 'change-major-mode-hook 'show-all)
(run-hooks 'text-mode-hook 'outline-mode-hook))
-(defvar outline-minor-mode-prefix "\C-c\C-o"
- "*Prefix key to use for Outline commands in Outline minor mode.")
+(defcustom outline-minor-mode-prefix "\C-c@"
+ "*Prefix key to use for Outline commands in Outline minor mode.
+The value of this variable is checked as part of loading Outline mode.
+After that, changing the prefix key requires manipulating keymaps."
+ :type 'string
+ :group 'outlines)
(defvar outline-minor-mode-map nil)
(if outline-minor-mode-map
nil
(setq outline-minor-mode-map (make-sparse-keymap))
(define-key outline-minor-mode-map [menu-bar]
- (lookup-key outline-mode-map [menu-bar]))
+ outline-mode-menu-bar-map)
(define-key outline-minor-mode-map outline-minor-mode-prefix
- (lookup-key outline-mode-map "\C-c")))
+ outline-mode-prefix-map))
(or (assq 'outline-minor-mode minor-mode-map-alist)
(setq minor-mode-map-alist
(cons (cons 'outline-minor-mode outline-minor-mode-map)
minor-mode-map-alist)))
-;;;###autoload
(defun outline-minor-mode (&optional arg)
"Toggle Outline minor mode.
With arg, turn Outline minor mode on if arg is positive, off otherwise.
;; When turning off outline mode, get rid of any ^M's.
(or outline-minor-mode
(outline-flag-region (point-min) (point-max) ?\n))
- (set-buffer-modified-p (buffer-modified-p)))
+ (force-mode-line-update))
\f
(defvar outline-level 'outline-level
"Function of no args to compute a header's nesting level in an outline.
It can assume point is at the beginning of a header line.")
+;; This used to count columns rather than characters, but that made ^L
+;; appear to be at level 2 instead of 1. Columns would be better for
+;; tab handling, but the default regexp doesn't use tabs, and anyone
+;; who changes the regexp can also redefine the outline-level variable
+;; as appropriate.
(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'."
+the number of characters that `outline-regexp' matches."
(save-excursion
(looking-at outline-regexp)
- (save-excursion (goto-char (match-end 0)) (current-column))))
+ (- (match-end 0) (match-beginning 0))))
(defun outline-next-preface ()
- "Skip forward to just before the next heading line."
+ "Skip forward to just before the next heading line.
+If there's no following heading line, stop before the newline
+at the end of the buffer."
(if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
nil 'move)
(goto-char (match-beginning 0)))
(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."
+ "Move to previous heading line, or beg of this line if it's a heading.
+Only visible heading lines are considered."
(beginning-of-line)
(or (outline-on-heading-p)
- (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move)))
+ (re-search-backward (concat "^\\(" outline-regexp "\\)") nil t)
+ (error "before first heading")))
(defun outline-on-heading-p ()
- "Return T if point is on a header line."
+ "Return t if point is on a (visible) heading line."
(save-excursion
(beginning-of-line)
- (and (eq (preceding-char) ?\n)
+ (and (bolp)
(looking-at outline-regexp))))
(defun outline-end-of-heading ()
(if (< arg 0)
(beginning-of-line)
(end-of-line))
- (re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil arg)
+ (or (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t arg)
+ (error ""))
(beginning-of-line))
(defun outline-previous-visible-heading (arg)
(interactive)
(outline-flag-subtree ?\n))
-(defun hide-sublevels (keep-levels)
- "Hide everything except the first KEEP-LEVEL headers."
+(defun hide-sublevels (levels)
+ "Hide everything but the top LEVELS levels of headers, in whole buffer."
(interactive "p")
- (if (< keep-levels 1)
+ (if (< levels 1)
(error "Must keep at least one level of headers"))
- (setq keep-levels (1- keep-levels))
+ (setq levels (1- levels))
(save-excursion
(goto-char (point-min))
- (hide-subtree)
- (show-children keep-levels)
- (condition-case err
- (while (outline-get-next-sibling)
- (hide-subtree)
- (show-children keep-levels))
- (error nil))))
+ ;; Keep advancing to the next top-level heading.
+ (while (or (and (bobp) (outline-on-heading-p))
+ (outline-next-heading))
+ (let ((end (save-excursion (outline-end-of-subtree) (point))))
+ ;; Hide everything under that.
+ (outline-flag-region (point) end ?\^M)
+ ;; Show the first LEVELS levels under that.
+ (if (> levels 0)
+ (show-children levels))
+ ;; Move to the next, since we already found it.
+ (goto-char end)))))
(defun hide-other ()
"Hide everything except for the current body and the parent headings."
(interactive)
- (outline-hide-sublevels 1)
+ (hide-sublevels 1)
(let ((last (point))
(pos (point)))
(while (save-excursion
(or first (> (funcall outline-level) level)))
(setq first nil)
(outline-next-heading))
- (if (eobp)
- nil
- ;; go to end of line before heading
- (forward-char -1)
- ;; skip preceding balnk line, if there is one
- (if (memq (preceding-char) '(?\n ?\^M))
- (forward-char -1)))))
+ (if (memq (preceding-char) '(?\n ?\^M))
+ (progn
+ ;; Go to end of line before heading
+ (forward-char -1)
+ (if (memq (preceding-char) '(?\n ?\^M))
+ ;; leave blank line before heading
+ (forward-char -1))))))
\f
(defun show-branches ()
"Show all subheadings of this heading, but not their bodies."
(setq level
(if level (prefix-numeric-value level)
(save-excursion
- (beginning-of-line)
+ (outline-back-to-heading)
(let ((start-level (funcall outline-level)))
(outline-next-heading)
(if (eobp)
1
(max 1 (- (funcall outline-level) start-level)))))))
(save-excursion
- (save-restriction
- (beginning-of-line)
- (setq level (+ level (funcall outline-level)))
- (narrow-to-region (point)
- (progn (outline-end-of-subtree)
- (if (eobp) (point-max) (1+ (point)))))
- (goto-char (point-min))
- (while (and (not (eobp))
- (progn
- (outline-next-heading)
- (not (eobp))))
- (if (<= (funcall 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)))))))
+ (save-restriction
+ (outline-back-to-heading)
+ (setq level (+ level (funcall outline-level)))
+ (narrow-to-region (point)
+ (progn (outline-end-of-subtree)
+ (if (eobp) (point-max) (1+ (point)))))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (progn
+ (outline-next-heading)
+ (not (eobp))))
+ (if (<= (funcall 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)))))))
\f
(defun outline-up-heading (arg)
"Move to the heading line of which the present line is a subheading.
(outline-back-to-heading)
(if (eq (funcall outline-level) 1)
(error ""))
- (while (and (> (funcall outline-level) 1)
- (> arg 0)
- (not (bobp)))
- (let ((present-level (funcall outline-level)))
- (while (not (< (funcall outline-level) present-level))
- (outline-previous-visible-heading 1))
- (setq arg (- arg 1)))))
+ (while (and (> (funcall outline-level) 1)
+ (> arg 0)
+ (not (bobp)))
+ (let ((present-level (funcall outline-level)))
+ (while (not (< (funcall 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."
+ "Move forward to the ARG'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
(interactive "p")
(outline-back-to-heading)
(while (> 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."
+ "Move to next heading of the same level, and return point or nil if none."
(let ((level (funcall outline-level)))
(outline-next-visible-heading 1)
(while (and (> (funcall outline-level) level)
(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."
+ "Move backward to the ARG'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
(interactive "p")
(outline-back-to-heading)
(while (> 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."
+ "Move to next heading of the same level, and return point or nil if none."
(let ((level (funcall outline-level)))
(outline-previous-visible-heading 1)
(while (and (> (funcall outline-level) level)