]> code.delx.au - gnu-emacs/blobdiff - lisp/textmodes/ooutline.el
(outline-minor-mode): Use force-mode-line-update.
[gnu-emacs] / lisp / textmodes / ooutline.el
index 88d4c595ecc20befbe8c44eea5b29d86f49f978e..e3752c6c75ce61aae71058cd689da86c13ec582a 100644 (file)
@@ -1,12 +1,8 @@
 ;;; outline.el --- outline mode commands for Emacs
+;; Copyright (C) 1986, 1993, 1994 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
+;; Keywords: outlines
 
 ;; This file is part of GNU Emacs.
 
@@ -52,72 +48,85 @@ 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 "")
+(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-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))
+
 (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)
@@ -126,6 +135,20 @@ in the file it applies to.")
     (setq minor-mode-alist (append minor-mode-alist
                                   (list '(outline-minor-mode " Outl")))))
 
+(defvar outline-font-lock-keywords
+  '(;; Highlight headings according to the level.
+    ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$"
+     (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))
+    ;; Highight 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.")
+
 ;;;###autoload
 (defun outline-mode ()
   "Set major mode for editing outlines with selective display.
@@ -176,28 +199,33 @@ 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.")
+  "*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.")
 
 (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
@@ -221,7 +249,7 @@ 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))
 \f
 (defvar outline-level 'outline-level
   "Function of no args to compute a header's nesting level in an outline.
@@ -241,13 +269,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."
@@ -265,7 +294,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)
@@ -364,28 +393,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
@@ -417,13 +448,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))))))
 \f
 (defun show-branches ()
   "Show all subheadings of this heading, but not their bodies."
@@ -482,8 +513,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)
@@ -498,8 +529,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)
@@ -510,8 +540,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)
@@ -526,8 +556,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)