;;; outline.el --- outline mode commands for Emacs
-;; Copyright (C) 1986 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1993 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
;; This file is part of GNU Emacs.
;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
-(defvar outline-regexp "[*\^l]+"
+(defvar 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.")
+
+;; 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]"
"*Regular expression to match the end of a heading line.
(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-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-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]
+ (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]
+ '("Hide Subtree" . hide-subtree))
+ (define-key outline-mode-map [menu-bar hide hide-entry]
+ '("Hide Entry" . hide-entry))
+ (define-key outline-mode-map [menu-bar hide hide-body]
+ '("Hide Body" . hide-body))
+ (define-key outline-mode-map [menu-bar hide hide-leaves]
+ '("Hide Leaves" . hide-leaves))
+
+ (define-key outline-mode-map [menu-bar show]
+ (cons "Show" (make-sparse-keymap "Show")))
+
+ (define-key outline-mode-map [menu-bar show show-subtree]
+ '("Show Subtree" . show-subtree))
+ (define-key outline-mode-map [menu-bar show show-children]
+ '("Show Children" . show-children))
+ (define-key outline-mode-map [menu-bar show show-branches]
+ '("Show Branches" . show-branches))
+ (define-key outline-mode-map [menu-bar show show-entry]
+ '("Show Entry" . show-entry))
+ (define-key outline-mode-map [menu-bar show show-all]
+ '("Show All" . show-all))
+
+ (define-key outline-mode-map [menu-bar headings]
+ (cons "Headings" (make-sparse-keymap "Headings")))
+
+ (define-key outline-mode-map [menu-bar headings outline-backward-same-level]
+ '("Previous Same Level" . outline-backward-same-level))
+ (define-key outline-mode-map [menu-bar headings outline-forward-same-level]
+ '("Next Same Level" . outline-forward-same-level))
+ (define-key outline-mode-map [menu-bar headings outline-previous-visible-heading]
+ '("Previous" . outline-previous-visible-heading))
+ (define-key outline-mode-map [menu-bar headings outline-next-visible-heading]
+ '("Next" . outline-next-visible-heading))
+ (define-key outline-mode-map [menu-bar 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.")
(make-variable-buffer-local 'outline-minor-mode)
(put 'outline-minor-mode 'permanent-local t)
-(setq minor-mode-alist (append minor-mode-alist
- (list '(outline-minor-mode " Outl"))))
+(or (assq 'outline-minor-mode minor-mode-alist)
+ (setq minor-mode-alist (append minor-mode-alist
+ (list '(outline-minor-mode " Outl")))))
;;;###autoload
(defun outline-mode ()
(make-local-variable 'paragraph-separate)
(setq paragraph-separate (concat paragraph-separate "\\|^\\("
outline-regexp "\\)"))
+ (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.")
+
(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 "\C-c"
+ (define-key outline-minor-mode-map [menu-bar]
+ (lookup-key outline-mode-map [menu-bar]))
+ (define-key outline-minor-mode-map outline-minor-mode-prefix
(lookup-key outline-mode-map "\C-c")))
(or (assq 'outline-minor-mode 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.
(progn
(setq selective-display t)
(run-hooks 'outline-minor-mode-hook))
- (setq selective-display nil)))
+ (setq selective-display nil))
+ ;; 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)))
\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.")
+
(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
"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)))
+ (progn
+ (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."
(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)))
(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 (bobp)
(looking-at outline-regexp))))
(defun outline-end-of-heading ()
"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 (buffer-read-only
- (modp (buffer-modified-p)))
- (unwind-protect
- (subst-char-in-region from to
- (if (= flag ?\n) ?\^M ?\n)
- flag)
- (set-buffer-modified-p modp))))
+ (let (buffer-read-only)
+ (subst-char-in-region from to
+ (if (= flag ?\n) ?\^M ?\n)
+ flag t)))
\f
(defun hide-entry ()
"Hide the body directly following this heading."
(interactive)
(outline-flag-subtree ?\n))
+(defun hide-sublevels (levels)
+ "Hide everything except the top LEVELS levels of headers."
+ (interactive "p")
+ (if (< levels 1)
+ (error "Must keep at least one level of headers"))
+ (setq levels (1- levels))
+ (save-excursion
+ (goto-char (point-min))
+ (hide-subtree)
+ (show-children levels)
+ (condition-case err
+ (while (outline-get-next-sibling)
+ (hide-subtree)
+ (show-children levels))
+ (error nil))))
+
+(defun hide-other ()
+ "Hide everything except for the current body and the parent headings."
+ (interactive)
+ (outline-hide-sublevels 1)
+ (let ((last (point))
+ (pos (point)))
+ (while (save-excursion
+ (and (re-search-backward "[\n\r]" nil t)
+ (eq (following-char) ?\r)))
+ (save-excursion
+ (beginning-of-line)
+ (if (eq last (point))
+ (progn
+ (outline-next-heading)
+ (outline-flag-region last (point) ?\n))
+ (show-children)
+ (setq last (point)))))))
+
(defun outline-flag-subtree (flag)
(save-excursion
(outline-back-to-heading)
(outline-back-to-heading)
(let ((opoint (point))
(first t)
- (level (outline-level)))
+ (level (funcall outline-level)))
(while (and (not (eobp))
- (or first (> (outline-level) level)))
+ (or first (> (funcall outline-level) level)))
(setq first nil)
(outline-next-heading))
- (forward-char -1)
- (if (memq (preceding-char) '(?\n ?\^M))
- (forward-char -1))))
+ (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)))))
\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)
- (let ((start-level (outline-level)))
+ (outline-back-to-heading)
+ (let ((start-level (funcall outline-level)))
(outline-next-heading)
- (max 1 (- (outline-level) start-level))))))
+ (if (eobp)
+ 1
+ (max 1 (- (funcall 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)))))))
+ (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.
With argument, move up ARG levels."
(interactive "p")
(outline-back-to-heading)
- (if (eq (outline-level) 1)
+ (if (eq (funcall outline-level) 1)
(error ""))
- (while (and (> (outline-level) 1)
+ (while (and (> (funcall outline-level) 1)
(> arg 0)
(not (bobp)))
- (let ((present-level (outline-level)))
- (while (not (< (outline-level) present-level))
+ (let ((present-level (funcall outline-level)))
+ (while (not (< (funcall outline-level) present-level))
(outline-previous-visible-heading 1))
(setq arg (- arg 1)))))
(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)))
+ (let ((level (funcall outline-level)))
(outline-next-visible-heading 1)
- (while (and (> (outline-level) level)
+ (while (and (> (funcall outline-level) level)
(not (eobp)))
(outline-next-visible-heading 1))
- (if (< (outline-level) level)
+ (if (< (funcall outline-level) level)
nil
(point))))
(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)))
+ (let ((level (funcall outline-level)))
(outline-previous-visible-heading 1)
- (while (and (> (outline-level) level)
+ (while (and (> (funcall outline-level) level)
(not (bobp)))
(outline-previous-visible-heading 1))
- (if (< (outline-level) level)
+ (if (< (funcall outline-level) level)
nil
(point))))