;;; outline.el --- outline mode commands for Emacs
;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
-;; 2003, 2004, 2005 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: outlines
;;; Code:
+(defvar font-lock-warning-face)
+
+
(defgroup outlines nil
"Support for hierarchical outlining."
:prefix "outline-"
: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
(save-excursion (newline-and-indent)))
(run-hooks 'outline-insert-heading-hook)))
+(defun outline-invent-heading (head up)
+ (save-match-data
+ ;; Let's try to invent one by repeating or deleting the last char.
+ (let ((new-head (if up (substring head 0 -1)
+ (concat head (substring head -1)))))
+ (if (string-match (concat "\\`\\(?:" outline-regexp "\\)")
+ new-head)
+ ;; Why bother checking that it is indeed higher/lower level ?
+ new-head
+ ;; Didn't work, so ask what to do.
+ (read-string (format "%s heading for `%s': "
+ (if up "Parent" "Demoted") head)
+ head nil nil t)))))
+
(defun outline-promote (&optional children)
"Promote headings higher up the tree.
If prefix argument CHILDREN is given, promote also all the children.
(outline-up-heading 1 t)
(and (= (1- level) (funcall outline-level))
(match-string-no-properties 0))))
- ;; Bummer!! There is no lower level heading.
- ;; Let's try to invent one by deleting the last char.
- (save-match-data
- (let ((new-head (substring head 0 -1)))
- (if (string-match (concat "\\`\\(?:" outline-regexp "\\)")
- new-head)
- ;; Why bother checking that it is indeed lower level ?
- new-head
- ;; Didn't work, so ask what to do.
- (read-string (format "Parent heading for `%s': "
- head)
- head nil nil t)))))))
+ ;; Bummer!! There is no lower level heading.
+ (outline-invent-heading head 'up))))
(unless (rassoc level outline-heading-alist)
(push (cons head level) outline-heading-alist))
(unless (eobp)
(looking-at outline-regexp)
(match-string-no-properties 0))))
- (save-match-data
- ;; Bummer!! There is no higher-level heading in the buffer.
- ;; Let's try to invent one by repeating the last char.
- (let ((new-head (concat head (substring head -1))))
- (if (string-match (concat "\\`\\(?:" outline-regexp "\\)")
- new-head)
- ;; Why bother checking that it is indeed higher level ?
- new-head
- ;; Didn't work, so ask what to do.
- (read-string (format "Demoted heading for `%s': "
- head)
- head nil nil t)))))))
+ ;; Bummer!! There is no higher-level heading in the buffer.
+ (outline-invent-heading head nil))))
(unless (rassoc level outline-heading-alist)
(push (cons head level) outline-heading-alist))
(defun outline-move-subtree-down (&optional arg)
"Move the currrent subtree down past ARG headlines of the same level."
(interactive "p")
- (let ((re (concat "^\\(?:" outline-regexp "\\)"))
- (movfunc (if (> arg 0) 'outline-get-next-sibling
+ (let ((movfunc (if (> arg 0) 'outline-get-next-sibling
'outline-get-last-sibling))
(ins-point (make-marker))
(cnt (abs arg))
- beg end txt folded)
+ beg end folded)
;; Select the tree
(outline-back-to-heading)
(setq beg (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.
(outline-previous-visible-heading 1))
(setq beg (point))
(outline-end-of-subtree)
- (push-mark (point))
+ (push-mark (point) nil t)
(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.
(when flag
(let ((o (make-overlay from to)))
(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-entry ()
"Hide the body directly following this heading."
(interactive)
- (outline-back-to-heading)
(save-excursion
+ (outline-back-to-heading)
(outline-end-of-heading)
(outline-flag-region (point) (progn (outline-next-preface) (point)) t)))
(outline-flag-subtree t))
(defun hide-leaves ()
- "Hide all body after this heading at deeper levels."
+ "Hide the body after this heading and at deeper levels."
(interactive)
- (outline-back-to-heading)
(save-excursion
- (outline-end-of-heading)
+ (outline-back-to-heading)
+;; Turned off to fix bug reported by Otto Maddox on 22 Nov 2005.
+;; (outline-end-of-heading)
(hide-region-body (point) (progn (outline-end-of-subtree) (point)))))
(defun show-subtree ()
(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)
(defun outline-toggle-children ()
"Show or hide the current subtree depending on its current state."
(interactive)
- (outline-back-to-heading)
- (if (not (outline-invisible-p (line-end-position)))
- (hide-subtree)
- (show-children)
- (show-entry)))
+ (save-excursion
+ (outline-back-to-heading)
+ (if (not (outline-invisible-p (line-end-position)))
+ (hide-subtree)
+ (show-children)
+ (show-entry))))
(defun outline-flag-subtree (flag)
(save-excursion
(defun outline-end-of-subtree ()
(outline-back-to-heading)
- (let ((opoint (point))
- (first t)
+ (let ((first t)
(level (funcall outline-level)))
(while (and (not (eobp))
(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)
(provide 'outline)
(provide 'noutline)
-;;; arch-tag: 1724410e-7d4d-4f46-b801-49e18171e874
+;; arch-tag: 1724410e-7d4d-4f46-b801-49e18171e874
;;; outline.el ends here