X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/eb6692ed468ecc811b587ea42015499ce27cf550..167bed8638b0c4463753f6100fe239cdfb5c80c8:/lisp/textmodes/ooutline.el diff --git a/lisp/textmodes/ooutline.el b/lisp/textmodes/ooutline.el index 1f86c51b6e..8eee5de2f8 100644 --- a/lisp/textmodes/ooutline.el +++ b/lisp/textmodes/ooutline.el @@ -1,12 +1,9 @@ ;;; 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. @@ -21,8 +18,9 @@ ;; 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: @@ -33,100 +31,138 @@ ;;; Code: ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS. - -(defvar outline-regexp nil + +(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 outline-hide-other] - '("Hide Other" . outline-hide-other)) - (define-key outline-mode-map [menu-bar hide outline-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, @@ -176,35 +212,41 @@ Turning on outline mode calls the value of `text-mode-hook' and then of (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. @@ -221,12 +263,17 @@ See the command `outline-mode' for more information on this mode." ;; 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)) (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 @@ -236,13 +283,14 @@ the number of characters that `outline-regexp' matches." (- (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) - (progn - (goto-char (match-beginning 0)) - (if (memq (preceding-char) '(?\n ?\^M)) - (forward-char -1))))) + (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." @@ -260,7 +308,7 @@ Only visible heading lines are considered." (error "before first heading"))) (defun outline-on-heading-p () - "Return T if point is on a (visible) heading line." + "Return t if point is on a (visible) heading line." (save-excursion (beginning-of-line) (and (bolp) @@ -359,28 +407,30 @@ while if FLAG is `\\^M' (control-M) the text is hidden." (interactive) (outline-flag-subtree ?\n)) -(defun outline-hide-sublevels (levels) - "Hide everything except the top LEVELS levels of headers." +(defun hide-sublevels (levels) + "Hide everything but the top LEVELS levels of headers, in whole buffer." (interactive "p") (if (< levels 1) (error "Must keep at least one level of headers")) (setq levels (1- levels)) (save-excursion (goto-char (point-min)) - (or (outline-on-heading-p) - (outline-next-heading)) - (hide-subtree) - (show-children levels) - (condition-case err - (while (outline-get-next-sibling) - (hide-subtree) - (show-children levels)) - (error nil)))) - -(defun outline-hide-other () + ;; 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 @@ -412,13 +462,13 @@ while if FLAG is `\\^M' (control-M) the text is hidden." (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 blank 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)))))) (defun show-branches () "Show all subheadings of this heading, but not their bodies." @@ -477,8 +527,8 @@ With argument, move up ARG levels." (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) @@ -493,8 +543,7 @@ present one. It stops at the first and last subheadings of a superior heading." (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) @@ -505,8 +554,8 @@ and return that position or nil if it cannot be found." (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) @@ -521,8 +570,7 @@ present one. It stops at the first and last subheadings of a superior heading." (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)