]> code.delx.au - gnu-emacs/blobdiff - lisp/outline.el
Switch to recommended form of GPLv3 permissions notice.
[gnu-emacs] / lisp / outline.el
index 92542bae7e307e7c6c73600aaa28d57e7a894876..93ec79c976a651a13f8ee21ead33ac3a431836d3 100644 (file)
@@ -1,7 +1,7 @@
 ;;; outline.el --- outline mode commands for Emacs
 
 ;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
-;;   2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;;   2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: outlines
@@ -10,7 +10,7 @@
 
 ;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -54,6 +54,7 @@ The recommended way to set this is with a Local Variables: list
 in the file it applies to.  See also `outline-heading-end-regexp'."
   :type '(choice regexp (const nil))
   :group 'outlines)
+;;;###autoload(put 'outline-regexp 'safe-local-variable 'string-or-null-p)
 
 (defcustom outline-heading-end-regexp "\n"
   "Regular expression to match the end of a heading line.
@@ -96,47 +97,86 @@ in the file it applies to."
 
     (define-key map [hide] (cons "Hide" (make-sparse-keymap "Hide")))
 
-    (define-key map [hide hide-other] '("Hide Other" . hide-other))
-    (define-key map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels))
-    (define-key map [hide hide-subtree] '("Hide Subtree" . hide-subtree))
-    (define-key map [hide hide-entry] '("Hide Entry" . hide-entry))
-    (define-key map [hide hide-body] '("Hide Body" . hide-body))
-    (define-key map [hide hide-leaves] '("Hide Leaves" . hide-leaves))
+    (define-key map [hide hide-other]
+      '(menu-item "Hide Other" hide-other
+                 :help "Hide everything except current body and parent and top-level headings"))
+    (define-key map [hide hide-sublevels]
+      '(menu-item "Hide Sublevels" hide-sublevels
+                 :help "Hide everything but the top LEVELS levels of headers, in whole buffer"))
+    (define-key map [hide hide-subtree]
+      '(menu-item "Hide Subtree" hide-subtree
+                 :help "Hide everything after this heading at deeper levels"))
+    (define-key map [hide hide-entry]
+      '(menu-item "Hide Entry" hide-entry
+                 :help "Hide the body directly following this heading"))
+    (define-key map [hide hide-body]
+      '(menu-item "Hide Body" hide-body
+                 :help "Hide all body lines in buffer, leaving all headings visible"))
+    (define-key map [hide hide-leaves]
+      '(menu-item "Hide Leaves" hide-leaves
+                 :help "Hide the body after this heading and at deeper levels"))
 
     (define-key map [show] (cons "Show" (make-sparse-keymap "Show")))
 
-    (define-key map [show show-subtree] '("Show Subtree" . show-subtree))
-    (define-key map [show show-children] '("Show Children" . show-children))
-    (define-key map [show show-branches] '("Show Branches" . show-branches))
-    (define-key map [show show-entry] '("Show Entry" . show-entry))
-    (define-key map [show show-all] '("Show All" . show-all))
+    (define-key map [show show-subtree]
+      '(menu-item "Show Subtree" show-subtree
+                 :help "Show everything after this heading at deeper levels"))
+    (define-key map [show show-children]
+      '(menu-item "Show Children" show-children
+                 :help "Show all direct subheadings of this heading"))
+    (define-key map [show show-branches]
+      '(menu-item "Show Branches" show-branches
+                 :help "Show all subheadings of this heading, but not their bodies"))
+    (define-key map [show show-entry]
+      '(menu-item "Show Entry" show-entry
+                 :help "Show the body directly following this heading"))
+    (define-key map [show show-all]
+      '(menu-item "Show All" show-all
+                 :help "Show all of the text in the buffer"))
 
     (define-key map [headings]
       (cons "Headings" (make-sparse-keymap "Headings")))
 
     (define-key map [headings demote-subtree]
-      '(menu-item "Demote subtree" outline-demote))
+      '(menu-item "Demote subtree" outline-demote
+                 :help "Demote headings lower down the tree"))
     (define-key map [headings promote-subtree]
-      '(menu-item "Promote subtree" outline-promote))
+      '(menu-item "Promote subtree" outline-promote
+                 :help "Promote headings higher up the tree"))
     (define-key map [headings move-subtree-down]
-      '(menu-item "Move subtree down" outline-move-subtree-down))
+      '(menu-item "Move subtree down" outline-move-subtree-down
+                 :help "Move the currrent subtree down past arg headlines of the same level"))
     (define-key map [headings move-subtree-up]
-      '(menu-item "Move subtree up" outline-move-subtree-up))
+      '(menu-item "Move subtree up" outline-move-subtree-up
+                 :help "Move the currrent subtree up past arg headlines of the same level"))
     (define-key map [headings copy]
       '(menu-item "Copy to kill ring" outline-headers-as-kill
-       :enable mark-active))
+                 :enable mark-active
+                 :help "Save the visible outline headers in region at the start of the kill ring"))
     (define-key map [headings outline-insert-heading]
-      '("New heading" . outline-insert-heading))
+
+      '(menu-item "New heading" outline-insert-heading
+                 :help "Insert a new heading at same depth at point"))
     (define-key map [headings outline-backward-same-level]
-      '("Previous Same Level" . outline-backward-same-level))
+
+      '(menu-item "Previous Same Level" outline-backward-same-level
+                 :help "Move backward to the arg'th subheading at same level as this one."))
     (define-key map [headings outline-forward-same-level]
-      '("Next Same Level" . outline-forward-same-level))
+
+      '(menu-item "Next Same Level" outline-forward-same-level
+                 :help "Move forward to the arg'th subheading at same level as this one"))
     (define-key map [headings outline-previous-visible-heading]
-      '("Previous" . outline-previous-visible-heading))
+
+      '(menu-item "Previous" outline-previous-visible-heading
+                 :help "Move to the previous heading line"))
     (define-key map [headings outline-next-visible-heading]
-      '("Next" . outline-next-visible-heading))
+
+      '(menu-item "Next" outline-next-visible-heading
+                 :help "Move to the next visible heading line"))
     (define-key map [headings outline-up-heading]
-      '("Up" . outline-up-heading))
+
+      '(menu-item "Up" outline-up-heading
+                 :help "Move to the visible heading line of which the present line is a subheading"))
     map))
 
 (defvar outline-minor-mode-menu-bar-map
@@ -186,12 +226,12 @@ in the file it applies to."
   :group 'outlines)
 
 (defface outline-4
-  '((t :inherit font-lock-builtin-face))
+  '((t :inherit font-lock-comment-face))
   "Level 4."
   :group 'outlines)
 
 (defface outline-5
-  '((t :inherit font-lock-comment-face))
+  '((t :inherit font-lock-type-face))
   "Level 5."
   :group 'outlines)
 
@@ -201,7 +241,7 @@ in the file it applies to."
   :group 'outlines)
 
 (defface outline-7
-  '((t :inherit font-lock-type-face))
+  '((t :inherit font-lock-builtin-face))
   "Level 7."
   :group 'outlines)
 
@@ -214,8 +254,8 @@ in the file it applies to."
   [outline-1 outline-2 outline-3 outline-4
    outline-5 outline-6 outline-7 outline-8])
 
-(defvar outline-font-lock-levels nil)
-(make-variable-buffer-local 'outline-font-lock-levels)
+;; (defvar outline-font-lock-levels nil)
+;; (make-variable-buffer-local 'outline-font-lock-levels)
 
 (defun outline-font-lock-face ()
   ;; (save-excursion
@@ -240,9 +280,7 @@ in the file it applies to."
   (save-excursion
     (goto-char (match-beginning 0))
     (looking-at outline-regexp)
-    (condition-case nil
-       (aref outline-font-lock-faces (1- (funcall outline-level)))
-      (error font-lock-warning-face))))
+    (aref outline-font-lock-faces (% (1- (funcall outline-level)) (length outline-font-lock-faces)))))
 
 (defvar outline-view-change-hook nil
   "Normal hook to be run after outline visibility changes.")
@@ -410,7 +448,7 @@ at the end of the buffer."
 
 (defun outline-visible ()
   (not (outline-invisible-p)))
-(make-obsolete 'outline-visible 'outline-invisible-p)
+(make-obsolete 'outline-visible 'outline-invisible-p "21.1")
 
 (defun outline-back-to-heading (&optional invisible-ok)
   "Move to previous heading line, or beg of this line if it's a heading.
@@ -470,19 +508,22 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
                              (if up "Parent" "Demoted") head)
                      head nil nil t)))))
 
-(defun outline-promote (&optional children)
+(defun outline-promote (&optional which)
   "Promote headings higher up the tree.
-If prefix argument CHILDREN is given, promote also all the children.
-If the region is active in `transient-mark-mode', promote all headings
-in the region."
+If transient-mark-mode is on, and mark is active, promote headings in
+the region (from a Lisp program, pass `region' for WHICH).  Otherwise:
+without prefix argument, promote current heading and all headings in the
+subtree (from a Lisp program, pass `subtree' for WHICH); with prefix
+argument, promote just the current heading (from a Lisp program, pass
+nil for WHICH, or do not pass any argument)."
   (interactive
    (list (if (and transient-mark-mode mark-active) 'region
           (outline-back-to-heading)
           (if current-prefix-arg nil 'subtree))))
   (cond
-   ((eq children 'region)
+   ((eq which 'region)
     (outline-map-region 'outline-promote (region-beginning) (region-end)))
-   (children
+   (which
     (outline-map-region 'outline-promote
                        (point)
                        (save-excursion (outline-get-next-sibling) (point))))
@@ -506,19 +547,22 @@ in the region."
 
       (replace-match up-head nil t)))))
 
-(defun outline-demote (&optional children)
+(defun outline-demote (&optional which)
   "Demote headings lower down the tree.
-If prefix argument CHILDREN is given, demote also all the children.
-If the region is active in `transient-mark-mode', demote all headings
-in the region."
+If transient-mark-mode is on, and mark is active, demote headings in
+the region (from a Lisp program, pass `region' for WHICH).  Otherwise:
+without prefix argument, demote current heading and all headings in the
+subtree (from a Lisp program, pass `subtree' for WHICH); with prefix
+argument, demote just the current heading (from a Lisp program, pass
+nil for WHICH, or do not pass any argument)."
   (interactive
    (list (if (and transient-mark-mode mark-active) 'region
           (outline-back-to-heading)
           (if current-prefix-arg nil 'subtree))))
   (cond
-   ((eq children 'region)
+   ((eq which 'region)
     (outline-map-region 'outline-demote (region-beginning) (region-end)))
-   (children
+   (which
     (outline-map-region 'outline-demote
                        (point)
                        (save-excursion (outline-get-next-sibling) (point))))
@@ -651,19 +695,24 @@ A heading line is one that starts with a `*' (or that
   (if (< arg 0)
       (beginning-of-line)
     (end-of-line))
-  (while (and (not (bobp)) (< arg 0))
-    (while (and (not (bobp))
-               (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
-                                   nil 'move)
-               (outline-invisible-p)))
-    (setq arg (1+ arg)))
-  (while (and (not (eobp)) (> arg 0))
-    (while (and (not (eobp))
-               (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
-                                  nil 'move)
-               (outline-invisible-p (match-beginning 0))))
-    (setq arg (1- arg)))
-  (beginning-of-line))
+  (let (found-heading-p)
+    (while (and (not (bobp)) (< arg 0))
+      (while (and (not (bobp))
+                 (setq found-heading-p
+                       (re-search-backward
+                        (concat "^\\(?:" outline-regexp "\\)")
+                        nil 'move))
+                 (outline-invisible-p)))
+      (setq arg (1+ arg)))
+    (while (and (not (eobp)) (> arg 0))
+      (while (and (not (eobp))
+                 (setq found-heading-p
+                       (re-search-forward
+                        (concat "^\\(?:" outline-regexp "\\)")
+                        nil 'move))
+                 (outline-invisible-p (match-beginning 0))))
+      (setq arg (1- arg)))
+    (if found-heading-p (beginning-of-line))))
 
 (defun outline-previous-visible-heading (arg)
   "Move to the previous heading line.
@@ -689,15 +738,25 @@ This puts point at the start of the current subtree, and mark at the end."
     (goto-char beg)))
 \f
 
+(defvar outline-isearch-open-invisible-function nil
+  "Function called if `isearch' finishes in an invisible overlay.
+The function is called with the overlay as its only argument.
+If nil, `show-entry' is called to reveal the invisible text.")
+
 (put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible)
 (defun outline-flag-region (from to flag)
   "Hide or show lines from FROM to TO, according to FLAG.
 If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
   (remove-overlays from to 'invisible 'outline)
   (when flag
-    (let ((o (make-overlay from to)))
+    ;; We use `front-advance' here because the invisible text begins at the
+    ;; very end of the heading, before the newline, so text inserted at FROM
+    ;; belongs to the heading rather than to the entry.
+    (let ((o (make-overlay from to nil 'front-advance)))
       (overlay-put o 'invisible 'outline)
-      (overlay-put o 'isearch-open-invisible 'outline-isearch-open-invisible)))
+      (overlay-put o 'isearch-open-invisible
+                  (or outline-isearch-open-invisible-function
+                      'outline-isearch-open-invisible))))
   ;; Seems only used by lazy-lock.  I.e. obsolete.
   (run-hooks 'outline-view-change-hook))
 
@@ -837,19 +896,25 @@ Show the heading too, if it is currently invisible."
                 (t 1))))
   (if (< levels 1)
       (error "Must keep at least one level of headers"))
-  (let (outline-view-change-hook)
-    (save-excursion
-      (goto-char (point-min))
-      ;; Skip the prelude, if any.
-      (unless (outline-on-heading-p t) (outline-next-heading))
+  (save-excursion
+    (let* (outline-view-change-hook
+           (beg (progn
+                  (goto-char (point-min))
+                  ;; Skip the prelude, if any.
+                  (unless (outline-on-heading-p t) (outline-next-heading))
+                  (point)))
+           (end (progn
+                  (goto-char (point-max))
+                  ;; Keep empty last line, if available.
+                  (if (bolp) (1- (point)) (point)))))
       ;; First hide everything.
-      (outline-flag-region (point) (point-max) t)
+      (outline-flag-region beg end t)
       ;; Then unhide the top level headers.
       (outline-map-region
        (lambda ()
         (if (<= (funcall outline-level) levels)
             (outline-show-heading)))
-       (point) (point-max))))
+       beg end)))
   (run-hooks 'outline-view-change-hook))
 
 (defun hide-other ()
@@ -893,7 +958,8 @@ Show the heading too, if it is currently invisible."
                (or first (> (funcall outline-level) level)))
       (setq first nil)
       (outline-next-heading))
-    (if (bolp)
+    (if (and (bolp) (not (eolp)))
+       ;; We stopped at a nonempty line (the next heading).
        (progn
          ;; Go to end of line before heading
          (forward-char -1)
@@ -944,8 +1010,8 @@ If INVISIBLE-OK is non-nil, also consider invisible lines."
        (or (eq last-command 'outline-up-heading) (push-mark)))
   (outline-back-to-heading invisible-ok)
   (let ((start-level (funcall outline-level)))
-    (if (eq start-level 1)
-       (error "Already at top level of the outline"))
+    (when (<= start-level 1)
+      (error "Already at top level of the outline"))
     (while (and (> start-level 1) (> arg 0) (not (bobp)))
       (let ((level start-level))
        (while (not (or (< level start-level) (bobp)))
@@ -974,7 +1040,8 @@ Stop at the first and last subheadings of a superior heading."
          (error "No following same-level heading"))))))
 
 (defun outline-get-next-sibling ()
-  "Move to next heading of the same level, and return point or nil if none."
+  "Move to next heading of the same level, and return point.
+If there is no such heading, return nil."
   (let ((level (funcall outline-level)))
     (outline-next-visible-heading 1)
     (while (and (not (eobp)) (> (funcall outline-level) level))
@@ -1000,15 +1067,18 @@ Stop at the first and last subheadings of a superior heading."
          (error "No previous same-level heading"))))))
 
 (defun outline-get-last-sibling ()
-  "Move to previous heading of the same level, and return point or nil if none."
-  (let ((level (funcall outline-level)))
+  "Move to previous heading of the same level, and return point.
+If there is no such heading, return nil."
+  (let ((opoint (point))
+       (level (funcall outline-level)))
     (outline-previous-visible-heading 1)
-    (while (and (> (funcall outline-level) level)
-               (not (bobp)))
-      (outline-previous-visible-heading 1))
-    (if (< (funcall outline-level) level)
-       nil
-        (point))))
+    (when (and (/= (point) opoint) (outline-on-heading-p))
+      (while (and (> (funcall outline-level) level)
+                 (not (bobp)))
+       (outline-previous-visible-heading 1))
+      (if (< (funcall outline-level) level)
+         nil
+        (point)))))
 \f
 (defun outline-headers-as-kill (beg end)
   "Save the visible outline headers in region at the start of the kill ring.