X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/aaef169dc63c4b557374540756865991e1bf6305..b36a53f4be733b326739fdebb2285d106eecbd06:/lisp/outline.el?ds=sidebyside diff --git a/lisp/outline.el b/lisp/outline.el index fdbad00ada..92e521afc9 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -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 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, @@ -46,7 +46,7 @@ :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 `^'. @@ -54,9 +54,10 @@ 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. + "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 @@ -470,19 +471,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 +510,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 +658,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 +701,25 @@ This puts point at the start of the current subtree, and mark at the end." (goto-char beg))) +(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)) @@ -828,22 +850,34 @@ Show the heading too, if it is currently invisible." (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 () @@ -887,7 +921,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) @@ -968,7 +1003,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)) @@ -994,15 +1030,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))))) (defun outline-headers-as-kill (beg end) "Save the visible outline headers in region at the start of the kill ring.