;;; 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 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: outlines
;; 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,
:group 'editing)
(defcustom outline-regexp "[*\^L]+"
- "*Regular expression to match the beginning of a heading.
+ "Regular expression to match the beginning of a heading.
Any line whose beginning matches this regexp is considered to start a heading.
Note that Outline mode only checks this regexp at the start of a line,
so the regexp need not (and usually does not) start with `^'.
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.
+ "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
(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))))
(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))))
(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.
(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))
(defun hide-sublevels (levels)
"Hide everything but the top LEVELS levels of headers, in whole buffer."
- (interactive "p")
+ (interactive (list
+ (cond
+ (current-prefix-arg (prefix-numeric-value current-prefix-arg))
+ ((save-excursion (beginning-of-line)
+ (looking-at outline-regexp))
+ (funcall outline-level))
+ (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 ()
(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)
(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))
(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.