# HG changeset patch # User Stefan Monnier # Date 1047678233 0 # Node ID 8921868c5af30e6947c860ed7f95c6d59b1a5800 # Parent 29efb33d1b33528f0c601eb3d5bac4f8a4076ceb (outline-level): Demote it to defvar. (outline-heading-alist): Document extended semantics. (outline-head-from-level): New fun. (outline-promote, outline-demote): Use it. (outline-show-heading): New fun. (hide-sublevels, show-children): Use it together with outline-map-region. (outline-get-next-sibling): Don't call outline-level at eob. diff -r 29efb33d1b33 -r 8921868c5af3 lisp/textmodes/outline.el --- a/lisp/textmodes/outline.el Fri Mar 14 20:49:04 2003 +0000 +++ b/lisp/textmodes/outline.el Fri Mar 14 21:43:53 2003 +0000 @@ -300,18 +300,30 @@ ;; When turning off outline mode, get rid of any outline hiding. (show-all))) -(defcustom outline-level 'outline-level +(defvar outline-level 'outline-level "*Function of no args to compute a header's nesting level in an outline. It can assume point is at the beginning of a header line and that the match -data reflects the `outline-regexp'." - :type 'function - :group 'outlines) +data reflects the `outline-regexp'.") (defvar outline-heading-alist () "Alist associating a heading for every possible level. Each entry is of the form (HEADING . LEVEL). -This alist is used both to find the heading corresponding to -a given level and to find the level of a given heading.") +This alist is used two ways: to find the heading corresponding to +a given level and to find the level of a given heading. +If a mode or document needs several sets of outline headings (for example +numbered and unnumbered sections), list them set by set and sorted by level +within each set. For example in texinfo mode: + + (setq outline-heading-alist + '((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4) + (\"@subsubsection\" . 5) + (\"@unnumbered\" . 2) (\"@unnumberedsec\" . 3) + (\"@unnumberedsubsec\" . 4) (\"@unnumberedsubsubsec\" . 5) + (\"@appendix\" . 2) (\"@appendixsec\" . 3)... + (\"@appendixsubsec\" . 4) (\"@appendixsubsubsec\" . 5) ..)) + +Instead of sorting the entries in each set, you can also separate the +sets with nil.") (make-variable-buffer-local 'outline-heading-alist) ;; This used to count columns rather than characters, but that made ^L @@ -423,7 +435,7 @@ (outline-back-to-heading t) (let* ((head (match-string 0)) (level (save-match-data (funcall outline-level))) - (up-head (or (car (rassoc (1- level) outline-heading-alist)) + (up-head (or (outline-head-from-level (1- level) head) (save-excursion (save-match-data (outline-up-heading 1 t) @@ -454,20 +466,16 @@ (let* ((head (match-string 0)) (level (save-match-data (funcall outline-level))) (down-head - (or (car (rassoc (1+ level) outline-heading-alist)) + (or (outline-head-from-level (1+ level) head) (save-excursion (save-match-data - (while (and (not (eobp)) - (progn - (outline-next-heading) - (<= (funcall outline-level) level)))) + (while (and (progn (outline-next-heading) (not (eobp))) + (<= (funcall outline-level) level))) (when (eobp) ;; Try again from the beginning of the buffer. (goto-char (point-min)) - (while (and (not (eobp)) - (progn - (outline-next-heading) - (<= (funcall outline-level) level))))) + (while (and (progn (outline-next-heading) (not (eobp))) + (<= (funcall outline-level) level)))) (unless (eobp) (looking-at outline-regexp) (match-string 0)))) @@ -485,6 +493,41 @@ (push (cons head level) outline-heading-alist)) (replace-match down-head nil t))))) +(defun outline-head-from-level (level head &optional alist) + "Get new heading with level LEVEL from ALIST. +If there are no such entries, return nil. +ALIST defaults to `outline-heading-alist'. +Similar to (car (rassoc LEVEL ALIST)). +If there are several different entries with same new level, choose +the one with the smallest distance to the assocation of HEAD in the alist. +This makes it possible for promotion to work in modes with several +independent sets of headings (numbered, unnumbered, appendix...)" + (unless alist (setq alist outline-heading-alist)) + (let ((l (rassoc level alist)) + ll h hl l2 l2l) + (cond + ((null l) nil) + ;; If there's no HEAD after L, any other entry for LEVEL after L + ;; can't be much better than L. + ((null (setq h (assoc head (setq ll (memq l alist))))) (car l)) + ;; If there's no other entry for LEVEL, just keep L. + ((null (setq l2 (rassoc level (cdr ll)))) (car l)) + ;; Now we have L, L2, and H: see if L2 seems better than L. + ;; If H is after L2, L2 is better. + ((memq h (setq l2l (memq l2 (cdr ll)))) + (outline-head-from-level level head l2l)) + ;; Now we have H between L and L2. + ;; If there's a separator between L and H, prefer L2. + ((memq h (memq nil ll)) + (outline-head-from-level level head l2l)) + ;; If there's a separator between L2 and H, prefer L. + ((memq l2 (memq nil (setq hl (memq h ll)))) (car l)) + ;; No separator between L and L2, check the distance. + ((< (* 2 (length hl)) (+ (length ll) (length l2l))) + (outline-head-from-level level head l2l)) + ;; If all else fails, just keep L. + (t (car l))))) + (defun outline-map-region (fun beg end) "Call FUN for every heading between BEG and END. When FUN is called, point is at the beginning of the heading and @@ -719,27 +762,33 @@ (interactive) (outline-flag-subtree nil)) +(defun outline-show-heading () + "Show the current heading and move to its end." + (outline-flag-region (- (point) + (if (bobp) 0 + (if (eq (char-before (1- (point))) ?\n) + 2 1))) + (progn (outline-end-of-heading) (point)) + nil)) + (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)) (let (outline-view-change-hook) (save-excursion (goto-char (point-min)) - ;; 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-end-of-heading) - (outline-flag-region (point) end t) - ;; 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))))) + ;; Skip the prelude, if any. + (unless (outline-on-heading-p t) (outline-next-heading)) + ;; First hide everything. + (outline-flag-region (point) (point-max) t) + ;; Then unhide the top level headers. + (outline-map-region + (lambda () + (if (<= (funcall outline-level) levels) + (outline-show-heading))) + (point) (point-max)))) (run-hooks 'outline-view-change-hook)) (defun hide-other () @@ -812,27 +861,16 @@ (max 1 (- (funcall outline-level) start-level))))))) (let (outline-view-change-hook) (save-excursion - (save-restriction - (outline-back-to-heading) - (setq level (+ level (funcall outline-level))) - (narrow-to-region (point) - (progn (outline-end-of-subtree) - (if (eobp) (point-max) (1+ (point))))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn - (outline-next-heading) - (not (eobp)))) - (if (<= (funcall outline-level) level) - (save-excursion - (outline-flag-region (save-excursion - (forward-char -1) - (if (bolp) - (forward-char -1)) - (point)) - (progn (outline-end-of-heading) (point)) - nil))))))) - (run-hooks 'outline-view-change-hook)) + (outline-back-to-heading) + (setq level (+ level (funcall outline-level))) + (outline-map-region + (lambda () + (if (<= (funcall outline-level) level) + (outline-show-heading))) + (point) + (progn (outline-end-of-subtree) + (if (eobp) (point-max) (1+ (point))))))) + (run-hooks 'outline-view-change-hook)) @@ -876,8 +914,7 @@ "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) - (not (eobp))) + (while (and (not (eobp)) (> (funcall outline-level) level)) (outline-next-visible-heading 1)) (if (or (eobp) (< (funcall outline-level) level)) nil