1: ;;; outline.el --- outline mode commands for Emacs
2:
3: ;; Copyright (C) 1986, 1993, 1994 Free Software Foundation, Inc.
4:
5: ;; Maintainer: FSF
6: ;; Keywords: outlines
7:
8: ;; This file is part of GNU Emacs.
9:
10: ;; GNU Emacs is free software; you can redistribute it and/or modify
11: ;; it under the terms of the GNU General Public License as published by
12: ;; the Free Software Foundation; either version 2, or (at your option)
13: ;; any later version.
14:
15: ;; GNU Emacs is distributed in the hope that it will be useful,
16: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: ;; GNU General Public License for more details.
19:
20: ;; You should have received a copy of the GNU General Public License
21: ;; along with GNU Emacs; see the file COPYING. If not, write to the
22: ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23: ;; Boston, MA 02111-1307, USA.
24:
25: ;;; Commentary:
26:
27: ;; This package is a major mode for editing outline-format documents.
28: ;; An outline can be `abstracted' to show headers at any given level,
29: ;; with all stuff below hidden. See the Emacs manual for details.
30:
31: ;;; Code:
32:
33: ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
34:
35: (defvar outline-regexp nil
36: "*Regular expression to match the beginning of a heading.
37: Any line whose beginning matches this regexp is considered to start a heading.
38: The recommended way to set this is with a Local Variables: list
39: in the file it applies to. See also outline-heading-end-regexp.")
40:
41: ;; Can't initialize this in the defvar above -- some major modes have
42: ;; already assigned a local value to it.
43: (or (default-value 'outline-regexp)
44: (setq-default outline-regexp "[*\^L]+"))
45:
46: (defvar outline-heading-end-regexp "[\n\^M]"
47: "*Regular expression to match the end of a heading line.
48: You can assume that point is at the beginning of a heading when this
49: regexp is searched for. The heading ends at the end of the match.
50: The recommended way to set this is with a \"Local Variables:\" list
51: in the file it applies to.")
52:
53: (defvar outline-mode-prefix-map nil)
54:
55: (if outline-mode-prefix-map
56: nil
57: (setq outline-mode-prefix-map (make-sparse-keymap))
58: (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading)
59: (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading)
60: (define-key outline-mode-prefix-map "\C-i" 'show-children)
61: (define-key outline-mode-prefix-map "\C-s" 'show-subtree)
62: (define-key outline-mode-prefix-map "\C-d" 'hide-subtree)
63: (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading)
64: (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level)
65: (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level)
66: (define-key outline-mode-prefix-map "\C-t" 'hide-body)
67: (define-key outline-mode-prefix-map "\C-a" 'show-all)
68: (define-key outline-mode-prefix-map "\C-c" 'hide-entry)
69: (define-key outline-mode-prefix-map "\C-e" 'show-entry)
70: (define-key outline-mode-prefix-map "\C-l" 'hide-leaves)
71: (define-key outline-mode-prefix-map "\C-k" 'show-branches)
72: (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels)
73: (define-key outline-mode-prefix-map "\C-o" 'hide-other))
74:
75: (defvar outline-mode-menu-bar-map nil)
76: (if outline-mode-menu-bar-map
77: nil
78: (setq outline-mode-menu-bar-map (make-sparse-keymap))
79:
80: (define-key outline-mode-menu-bar-map [hide]
81: (cons "Hide" (make-sparse-keymap "Hide")))
82:
83: (define-key outline-mode-menu-bar-map [hide hide-other]
84: '("Hide Other" . hide-other))
85: (define-key outline-mode-menu-bar-map [hide hide-sublevels]
86: '("Hide Sublevels" . hide-sublevels))
87: (define-key outline-mode-menu-bar-map [hide hide-subtree]
88: '("Hide Subtree" . hide-subtree))
89: (define-key outline-mode-menu-bar-map [hide hide-entry]
90: '("Hide Entry" . hide-entry))
91: (define-key outline-mode-menu-bar-map [hide hide-body]
92: '("Hide Body" . hide-body))
93: (define-key outline-mode-menu-bar-map [hide hide-leaves]
94: '("Hide Leaves" . hide-leaves))
95:
96: (define-key outline-mode-menu-bar-map [show]
97: (cons "Show" (make-sparse-keymap "Show")))
98:
99: (define-key outline-mode-menu-bar-map [show show-subtree]
100: '("Show Subtree" . show-subtree))
101: (define-key outline-mode-menu-bar-map [show show-children]
102: '("Show Children" . show-children))
103: (define-key outline-mode-menu-bar-map [show show-branches]
104: '("Show Branches" . show-branches))
105: (define-key outline-mode-menu-bar-map [show show-entry]
106: '("Show Entry" . show-entry))
107: (define-key outline-mode-menu-bar-map [show show-all]
108: '("Show All" . show-all))
109:
110: (define-key outline-mode-menu-bar-map [headings]
111: (cons "Headings" (make-sparse-keymap "Headings")))
112:
113: (define-key outline-mode-menu-bar-map [headings outline-backward-same-level]
114: '("Previous Same Level" . outline-backward-same-level))
115: (define-key outline-mode-menu-bar-map [headings outline-forward-same-level]
116: '("Next Same Level" . outline-forward-same-level))
117: (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading]
118: '("Previous" . outline-previous-visible-heading))
119: (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading]
120: '("Next" . outline-next-visible-heading))
121: (define-key outline-mode-menu-bar-map [headings outline-up-heading]
122: '("Up" . outline-up-heading)))
123:
124: (defvar outline-mode-map nil "")
125:
126: (if outline-mode-map
127: nil
128: (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
129: (define-key outline-mode-map "\C-c" outline-mode-prefix-map)
130: (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map))
131:
132: (defvar outline-minor-mode nil
133: "Non-nil if using Outline mode as a minor mode of some other mode.")
134: (make-variable-buffer-local 'outline-minor-mode)
135: (put 'outline-minor-mode 'permanent-local t)
136: (or (assq 'outline-minor-mode minor-mode-alist)
137: (setq minor-mode-alist (append minor-mode-alist
138: (list '(outline-minor-mode " Outl")))))
139:
140: (defvar outline-font-lock-keywords
141: '(;; Highlight headings according to the level.
142: ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$"
143: (1 font-lock-string-face)
144: (2 (let ((len (- (match-end 1) (match-beginning 1))))
145: (or (cdr (assq len '((1 . font-lock-function-name-face)
146: (2 . font-lock-keyword-face)
147: (3 . font-lock-comment-face))))
148: font-lock-variable-name-face))
149: nil t))
150: ;; Highlight citations of the form [1] and [Mar94].
151: ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))
152: "Additional expressions to highlight in Outline mode.")
153:
154: ;;;###autoload
155: (defun outline-mode ()
156: "Set major mode for editing outlines with selective display.
157: Headings are lines which start with asterisks: one for major headings,
158: two for subheadings, etc. Lines not starting with asterisks are body lines.
159:
160: Body text or subheadings under a heading can be made temporarily
161: invisible, or visible again. Invisible lines are attached to the end
162: of the heading, so they move with it, if the line is killed and yanked
163: back. A heading with text hidden under it is marked with an ellipsis (...).
164:
165: Commands:\\
166: \\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
167: \\[outline-previous-visible-heading] outline-previous-visible-heading
168: \\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
169: \\[outline-backward-same-level] outline-backward-same-level
170: \\[outline-up-heading] outline-up-heading move from subheading to heading
171:
172: \\[hide-body] make all text invisible (not headings).
173: \\[show-all] make everything in buffer visible.
174:
175: The remaining commands are used when point is on a heading line.
176: They apply to some of the body or subheadings of that heading.
177: \\[hide-subtree] hide-subtree make body and subheadings invisible.
178: \\[show-subtree] show-subtree make body and subheadings visible.
179: \\[show-children] show-children make direct subheadings visible.
180: No effect on body, or subheadings 2 or more levels down.
181: With arg N, affects subheadings N levels down.
182: \\[hide-entry] make immediately following body invisible.
183: \\[show-entry] make it visible.
184: \\[hide-leaves] make body under heading and under its subheadings invisible.
185: The subheadings remain visible.
186: \\[show-branches] make all subheadings at all levels visible.
187:
188: The variable `outline-regexp' can be changed to control what is a heading.
189: A line is a heading if `outline-regexp' matches something at the
190: beginning of the line. The longer the match, the deeper the level.
191:
192: Turning on outline mode calls the value of `text-mode-hook' and then of
193: `outline-mode-hook', if they are non-nil."
194: (interactive)
195: (kill-all-local-variables)
196: (setq selective-display t)
197: (use-local-map outline-mode-map)
198: (setq mode-name "Outline")
199: (setq major-mode 'outline-mode)
200: (define-abbrev-table 'text-mode-abbrev-table ())
201: (setq local-abbrev-table text-mode-abbrev-table)
202: (set-syntax-table text-mode-syntax-table)
203: (make-local-variable 'paragraph-start)
204: (setq paragraph-start (concat paragraph-start "\\|\\("
205: outline-regexp "\\)"))
206: ;; Inhibit auto-filling of header lines.
207: (make-local-variable 'auto-fill-inhibit-regexp)
208: (setq auto-fill-inhibit-regexp outline-regexp)
209: (make-local-variable 'paragraph-separate)
210: (setq paragraph-separate (concat paragraph-separate "\\|\\("
211: outline-regexp "\\)"))
212: (make-local-variable 'font-lock-defaults)
213: (setq font-lock-defaults '(outline-font-lock-keywords t))
214: (make-local-variable 'change-major-mode-hook)
215: (add-hook 'change-major-mode-hook 'show-all)
216: (run-hooks 'text-mode-hook 'outline-mode-hook))
217:
218: (defvar outline-minor-mode-prefix "\C-c@"
219: "*Prefix key to use for Outline commands in Outline minor mode.
220: The value of this variable is checked as part of loading Outline mode.
221: After that, changing the prefix key requires manipulating keymaps.")
222:
223: (defvar outline-minor-mode-map nil)
224: (if outline-minor-mode-map
225: nil
226: (setq outline-minor-mode-map (make-sparse-keymap))
227: (define-key outline-minor-mode-map [menu-bar]
228: outline-mode-menu-bar-map)
229: (define-key outline-minor-mode-map outline-minor-mode-prefix
230: outline-mode-prefix-map))
231:
232: (or (assq 'outline-minor-mode minor-mode-map-alist)
233: (setq minor-mode-map-alist
234: (cons (cons 'outline-minor-mode outline-minor-mode-map)
235: minor-mode-map-alist)))
236:
237: ;;;###autoload
238: (defun outline-minor-mode (&optional arg)
239: "Toggle Outline minor mode.
240: With arg, turn Outline minor mode on if arg is positive, off otherwise.
241: See the command `outline-mode' for more information on this mode."
242: (interactive "P")
243: (setq outline-minor-mode
244: (if (null arg) (not outline-minor-mode)
245: (> (prefix-numeric-value arg) 0)))
246: (if outline-minor-mode
247: (progn
248: (setq selective-display t)
249: (run-hooks 'outline-minor-mode-hook))
250: (setq selective-display nil))
251: ;; When turning off outline mode, get rid of any ^M's.
252: (or outline-minor-mode
253: (outline-flag-region (point-min) (point-max) ?\n))
254: (force-mode-line-update))
255:
256: (defvar outline-level 'outline-level
257: "Function of no args to compute a header's nesting level in an outline.
258: It can assume point is at the beginning of a header line.")
259:
260: ;; This used to count columns rather than characters, but that made ^L
261: ;; appear to be at level 2 instead of 1. Columns would be better for
262: ;; tab handling, but the default regexp doesn't use tabs, and anyone
263: ;; who changes the regexp can also redefine the outline-level variable
264: ;; as appropriate.
265: (defun outline-level ()
266: "Return the depth to which a statement is nested in the outline.
267: Point must be at the beginning of a header line. This is actually
268: the number of characters that `outline-regexp' matches."
269: (save-excursion
270: (looking-at outline-regexp)
271: (- (match-end 0) (match-beginning 0))))
272:
273: (defun outline-next-preface ()
274: "Skip forward to just before the next heading line.
275: If there's no following heading line, stop before the newline
276: at the end of the buffer."
277: (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
278: nil 'move)
279: (goto-char (match-beginning 0)))
280: (if (memq (preceding-char) '(?\n ?\^M))
281: (forward-char -1)))
282:
283: (defun outline-next-heading ()
284: "Move to the next (possibly invisible) heading line."
285: (interactive)
286: (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
287: nil 'move)
288: (goto-char (1+ (match-beginning 0)))))
289:
290: (defun outline-back-to-heading ()
291: "Move to previous heading line, or beg of this line if it's a heading.
292: Only visible heading lines are considered."
293: (beginning-of-line)
294: (or (outline-on-heading-p)
295: (re-search-backward (concat "^\\(" outline-regexp "\\)") nil t)
296: (error "before first heading")))
297:
298: (defun outline-on-heading-p ()
299: "Return t if point is on a (visible) heading line."
300: (save-excursion
301: (beginning-of-line)
302: (and (bolp)
303: (looking-at outline-regexp))))
304:
305: (defun outline-end-of-heading ()
306: (if (re-search-forward outline-heading-end-regexp nil 'move)
307: (forward-char -1)))
308:
309: (defun outline-next-visible-heading (arg)
310: "Move to the next visible heading line.
311: With argument, repeats or can move backward if negative.
312: A heading line is one that starts with a `*' (or that
313: `outline-regexp' matches)."
314: (interactive "p")
315: (if (< arg 0)
316: (beginning-of-line)
317: (end-of-line))
318: (or (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t arg)
319: (error ""))
320: (beginning-of-line))
321:
322: (defun outline-previous-visible-heading (arg)
323: "Move to the previous heading line.
324: With argument, repeats or can move forward if negative.
325: A heading line is one that starts with a `*' (or that
326: `outline-regexp' matches)."
327: (interactive "p")
328: (outline-next-visible-heading (- arg)))
329:
330: (defun outline-flag-region (from to flag)
331: "Hides or shows lines from FROM to TO, according to FLAG.
332: If FLAG is `\\n' (newline character) then text is shown,
333: while if FLAG is `\\^M' (control-M) the text is hidden."
334: (let (buffer-read-only)
335: (subst-char-in-region from to
336: (if (= flag ?\n) ?\^M ?\n)
337: flag t)))
338:
339: (defun hide-entry ()
340: "Hide the body directly following this heading."
341: (interactive)
342: (outline-back-to-heading)
343: (outline-end-of-heading)
344: (save-excursion
345: (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
346:
347: (defun show-entry ()
348: "Show the body directly following this heading."
349: (interactive)
350: (save-excursion
351: (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
352:
353: (defun hide-body ()
354: "Hide all of buffer except headings."
355: (interactive)
356: (hide-region-body (point-min) (point-max)))
357:
358: (defun hide-region-body (start end)
359: "Hide all body lines in the region, but not headings."
360: (save-excursion
361: (save-restriction
362: (narrow-to-region start end)
363: (goto-char (point-min))
364: (if (outline-on-heading-p)
365: (outline-end-of-heading))
366: (while (not (eobp))
367: (outline-flag-region (point)
368: (progn (outline-next-preface) (point)) ?\^M)
369: (if (not (eobp))
370: (progn
371: (forward-char
372: (if (looking-at "[\n\^M][\n\^M]")
373: 2 1))
374: (outline-end-of-heading)))))))
375:
376: (defun show-all ()
377: "Show all of the text in the buffer."
378: (interactive)
379: (outline-flag-region (point-min) (point-max) ?\n))
380:
381: (defun hide-subtree ()
382: "Hide everything after this heading at deeper levels."
383: (interactive)
384: (outline-flag-subtree ?\^M))
385:
386: (defun hide-leaves ()
387: "Hide all body after this heading at deeper levels."
388: (interactive)
389: (outline-back-to-heading)
390: (outline-end-of-heading)
391: (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
392:
393: (defun show-subtree ()
394: "Show everything after this heading at deeper levels."
395: (interactive)
396: (outline-flag-subtree ?\n))
397:
398: (defun hide-sublevels (levels)
399: "Hide everything but the top LEVELS levels of headers, in whole buffer."
400: (interactive "p")
401: (if (< levels 1)
402: (error "Must keep at least one level of headers"))
403: (setq levels (1- levels))
404: (save-excursion
405: (goto-char (point-min))
406: ;; Keep advancing to the next top-level heading.
407: (while (or (and (bobp) (outline-on-heading-p))
408: (outline-next-heading))
409: (let ((end (save-excursion (outline-end-of-subtree) (point))))
410: ;; Hide everything under that.
411: (outline-flag-region (point) end ?\^M)
412: ;; Show the first LEVELS levels under that.
413: (if (> levels 0)
414: (show-children levels))
415: ;; Move to the next, since we already found it.
416: (goto-char end)))))
417:
418: (defun hide-other ()
419: "Hide everything except for the current body and the parent headings."
420: (interactive)
421: (hide-sublevels 1)
422: (let ((last (point))
423: (pos (point)))
424: (while (save-excursion
425: (and (re-search-backward "[\n\r]" nil t)
426: (eq (following-char) ?\r)))
427: (save-excursion
428: (beginning-of-line)
429: (if (eq last (point))
430: (progn
431: (outline-next-heading)
432: (outline-flag-region last (point) ?\n))
433: (show-children)
434: (setq last (point)))))))
435:
436: (defun outline-flag-subtree (flag)
437: (save-excursion
438: (outline-back-to-heading)
439: (outline-end-of-heading)
440: (outline-flag-region (point)
441: (progn (outline-end-of-subtree) (point))
442: flag)))
443:
444: (defun outline-end-of-subtree ()
445: (outline-back-to-heading)
446: (let ((opoint (point))
447: (first t)
448: (level (funcall outline-level)))
449: (while (and (not (eobp))
450: (or first (> (funcall outline-level) level)))
451: (setq first nil)
452: (outline-next-heading))
453: (if (and (not (eobp))
454: (memq (preceding-char) '(?\n ?\^M)))
455: (progn
456: ;; Go to end of line before heading
457: (forward-char -1)
458: (if (memq (preceding-char) '(?\n ?\^M))
459: ;; leave blank line before heading
460: (forward-char -1))))))
461:
462: (defun show-branches ()
463: "Show all subheadings of this heading, but not their bodies."
464: (interactive)
465: (show-children 1000))
466:
467: (defun show-children (&optional level)
468: "Show all direct subheadings of this heading.
469: Prefix arg LEVEL is how many levels below the current level should be shown.
470: Default is enough to cause the following heading to appear."
471: (interactive "P")
472: (setq level
473: (if level (prefix-numeric-value level)
474: (save-excursion
475: (outline-back-to-heading)
476: (let ((start-level (funcall outline-level)))
477: (outline-next-heading)
478: (if (eobp)
479: 1
480: (max 1 (- (funcall outline-level) start-level)))))))
481: (save-excursion
482: (save-restriction
483: (outline-back-to-heading)
484: (setq level (+ level (funcall outline-level)))
485: (narrow-to-region (point)
486: (progn (outline-end-of-subtree)
487: (if (eobp) (point-max) (1+ (point)))))
488: (goto-char (point-min))
489: (while (and (not (eobp))
490: (progn
491: (outline-next-heading)
492: (not (eobp))))
493: (if (<= (funcall outline-level) level)
494: (save-excursion
495: (outline-flag-region (save-excursion
496: (forward-char -1)
497: (if (memq (preceding-char) '(?\n ?\^M))
498: (forward-char -1))
499: (point))
500: (progn (outline-end-of-heading) (point))
501: ?\n)))))))
502:
503: (defun outline-up-heading (arg)
504: "Move to the heading line of which the present line is a subheading.
505: With argument, move up ARG levels."
506: (interactive "p")
507: (outline-back-to-heading)
508: (if (eq (funcall outline-level) 1)
509: (error ""))
510: (while (and (> (funcall outline-level) 1)
511: (> arg 0)
512: (not (bobp)))
513: (let ((present-level (funcall outline-level)))
514: (while (not (< (funcall outline-level) present-level))
515: (outline-previous-visible-heading 1))
516: (setq arg (- arg 1)))))
517:
518: (defun outline-forward-same-level (arg)
519: "Move forward to the ARG'th subheading at same level as this one.
520: Stop at the first and last subheadings of a superior heading."
521: (interactive "p")
522: (outline-back-to-heading)
523: (while (> arg 0)
524: (let ((point-to-move-to (save-excursion
525: (outline-get-next-sibling))))
526: (if point-to-move-to
527: (progn
528: (goto-char point-to-move-to)
529: (setq arg (1- arg)))
530: (progn
531: (setq arg 0)
532: (error ""))))))
533:
534: (defun outline-get-next-sibling ()
535: "Move to next heading of the same level, and return point or nil if none."
536: (let ((level (funcall outline-level)))
537: (outline-next-visible-heading 1)
538: (while (and (> (funcall outline-level) level)
539: (not (eobp)))
540: (outline-next-visible-heading 1))
541: (if (< (funcall outline-level) level)
542: nil
543: (point))))
544:
545: (defun outline-backward-same-level (arg)
546: "Move backward to the ARG'th subheading at same level as this one.
547: Stop at the first and last subheadings of a superior heading."
548: (interactive "p")
549: (outline-back-to-heading)
550: (while (> arg 0)
551: (let ((point-to-move-to (save-excursion
552: (outline-get-last-sibling))))
553: (if point-to-move-to
554: (progn
555: (goto-char point-to-move-to)
556: (setq arg (1- arg)))
557: (progn
558: (setq arg 0)
559: (error ""))))))
560:
561: (defun outline-get-last-sibling ()
562: "Move to next heading of the same level, and return point or nil if none."
563: (let ((level (funcall outline-level)))
564: (outline-previous-visible-heading 1)
565: (while (and (> (funcall outline-level) level)
566: (not (bobp)))
567: (outline-previous-visible-heading 1))
568: (if (< (funcall outline-level) level)
569: nil
570: (point))))
571:
572: (provide 'outline)
573:
574: ;;; outline.el ends here