Mercurial > hg > xemacs-beta

comparison lisp/modes/outline.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 4103f0995bd7
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; outline.el --- outline mode commands for Emacs 1 ;;; outline.el --- outline mode commands for Emacs
2 2
3 ;; Copyright (C) 1986, 1993, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1986, 1993, 1994 Free Software Foundation, Inc.
4
5 ;; Maintainer: FSF
4 ;; Keywords: outlines 6 ;; Keywords: outlines
5
6 ;; Maintainer: Tim Bradshaw <tfb@ed.ac.uk>
7 7
8 ;; This file is part of XEmacs. 8 ;; This file is part of XEmacs.
9 9
10 ;; XEmacs is free software; you can redistribute it and/or modify it 10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by 11 ;; under the terms of the GNU General Public License as published by
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 18 ;; General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 ;; 02111-1307, USA.
24
25 ;;; Synched up with: FSF 19.34.
23 26
24 ;;; Commentary: 27 ;;; Commentary:
25 28
26 ;; This package is a major mode for editing outline-format documents. 29 ;; This package is a major mode for editing outline-format documents.
27 ;; An outline can be `abstracted' to show headers at any given level, 30 ;; An outline can be `abstracted' to show headers at any given level,
28 ;; with all stuff below hidden. See the Emacs manual for details. 31 ;; with all stuff below hidden. See the Emacs manual for details.
29
30 ;; This is taken from the FSF 19.23 outline.el and modified to work
31 ;; with XEmacs 19.10+. Changes are marked with a comment with
32 ;; `#+XEmacs' in it. --tfb
33 32
34 ;;; Code: 33 ;;; Code:
35 34
36 ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS. 35 ;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
37 36
44 ;; Can't initialize this in the defvar above -- some major modes have 43 ;; Can't initialize this in the defvar above -- some major modes have
45 ;; already assigned a local value to it. 44 ;; already assigned a local value to it.
46 (or (default-value 'outline-regexp) 45 (or (default-value 'outline-regexp)
47 (setq-default outline-regexp "[*\^L]+")) 46 (setq-default outline-regexp "[*\^L]+"))
48 47
48 ;; XEmacs change
49 (defvar outline-heading-end-regexp (purecopy "[\n\^M]") 49 (defvar outline-heading-end-regexp (purecopy "[\n\^M]")
50 "*Regular expression to match the end of a heading line. 50 "*Regular expression to match the end of a heading line.
51 You can assume that point is at the beginning of a heading when this 51 You can assume that point is at the beginning of a heading when this
52 regexp is searched for. The heading ends at the end of the match. 52 regexp is searched for. The heading ends at the end of the match.
53 The recommended way to set this is with a \"Local Variables:\" list 53 The recommended way to set this is with a \"Local Variables:\" list
54 in the file it applies to.") 54 in the file it applies to.")
55 55
56 ;; XEmacs: There is no point in doing this differently now. -sb
57 (defvar outline-mode-prefix-map nil)
58
59 (if outline-mode-prefix-map
60 nil
61 (setq outline-mode-prefix-map (make-sparse-keymap))
62 (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading)
63 (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading)
64 (define-key outline-mode-prefix-map "\C-i" 'show-children)
65 (define-key outline-mode-prefix-map "\C-s" 'show-subtree)
66 (define-key outline-mode-prefix-map "\C-d" 'hide-subtree)
67 (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading)
68 (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level)
69 (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level)
70 (define-key outline-mode-prefix-map "\C-t" 'hide-body)
71 (define-key outline-mode-prefix-map "\C-a" 'show-all)
72 (define-key outline-mode-prefix-map "\C-c" 'hide-entry)
73 (define-key outline-mode-prefix-map "\C-e" 'show-entry)
74 (define-key outline-mode-prefix-map "\C-l" 'hide-leaves)
75 (define-key outline-mode-prefix-map "\C-k" 'show-branches)
76 (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels)
77 (define-key outline-mode-prefix-map "\C-o" 'hide-other))
78
79 (defvar outline-mode-menu-bar-map nil)
80 (if outline-mode-menu-bar-map
81 nil
82 (setq outline-mode-menu-bar-map (make-sparse-keymap))
83
84 (define-key outline-mode-menu-bar-map [hide]
85 (cons "Hide" (make-sparse-keymap "Hide")))
86
87 (define-key outline-mode-menu-bar-map [hide hide-other]
88 '("Hide Other" . hide-other))
89 (define-key outline-mode-menu-bar-map [hide hide-sublevels]
90 '("Hide Sublevels" . hide-sublevels))
91 (define-key outline-mode-menu-bar-map [hide hide-subtree]
92 '("Hide Subtree" . hide-subtree))
93 (define-key outline-mode-menu-bar-map [hide hide-entry]
94 '("Hide Entry" . hide-entry))
95 (define-key outline-mode-menu-bar-map [hide hide-body]
96 '("Hide Body" . hide-body))
97 (define-key outline-mode-menu-bar-map [hide hide-leaves]
98 '("Hide Leaves" . hide-leaves))
99
100 (define-key outline-mode-menu-bar-map [show]
101 (cons "Show" (make-sparse-keymap "Show")))
102
103 (define-key outline-mode-menu-bar-map [show show-subtree]
104 '("Show Subtree" . show-subtree))
105 (define-key outline-mode-menu-bar-map [show show-children]
106 '("Show Children" . show-children))
107 (define-key outline-mode-menu-bar-map [show show-branches]
108 '("Show Branches" . show-branches))
109 (define-key outline-mode-menu-bar-map [show show-entry]
110 '("Show Entry" . show-entry))
111 (define-key outline-mode-menu-bar-map [show show-all]
112 '("Show All" . show-all))
113
114 (define-key outline-mode-menu-bar-map [headings]
115 (cons "Headings" (make-sparse-keymap "Headings")))
116
117 (define-key outline-mode-menu-bar-map [headings outline-backward-same-level]
118 '("Previous Same Level" . outline-backward-same-level))
119 (define-key outline-mode-menu-bar-map [headings outline-forward-same-level]
120 '("Next Same Level" . outline-forward-same-level))
121 (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading]
122 '("Previous" . outline-previous-visible-heading))
123 (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading]
124 '("Next" . outline-next-visible-heading))
125 (define-key outline-mode-menu-bar-map [headings outline-up-heading]
126 '("Up" . outline-up-heading)))
127
56 (defvar outline-mode-map nil "") 128 (defvar outline-mode-map nil "")
57 129
58 (if outline-mode-map 130 (if outline-mode-map
59 nil 131 nil
60 ;; #+XEmacs: this replaces some horrid nconcing in FSF 132 ;; XEmacs change
61 (setq outline-mode-map (make-sparse-keymap)) 133 ;(setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
62 (set-keymap-name outline-mode-map 'outline-mode-map) 134 (setq outline-mode-map (make-sparse-keymap 'text-mode-map))
63 (set-keymap-parents outline-mode-map (list text-mode-map)) 135 (define-key outline-mode-map "\C-c" outline-mode-prefix-map)
64 (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading) 136 (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map))
65 (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
66 (define-key outline-mode-map "\C-c\C-i" 'show-children)
67 (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
68 (define-key outline-mode-map "\C-c\C-d" 'hide-subtree)
69 (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
70 (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
71 (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level)
72 (define-key outline-mode-map "\C-c\C-t" 'hide-body)
73 (define-key outline-mode-map "\C-c\C-a" 'show-all)
74 (define-key outline-mode-map "\C-c\C-c" 'hide-entry)
75 (define-key outline-mode-map "\C-c\C-e" 'show-entry)
76 (define-key outline-mode-map "\C-c\C-l" 'hide-leaves)
77 (define-key outline-mode-map "\C-c\C-k" 'show-branches)
78 (define-key outline-mode-map "\C-c\C-q" 'hide-sublevels)
79 (define-key outline-mode-map "\C-c\C-o" 'hide-other))
80 137
81 ;;; #+XEmacs 138 ;;; #+XEmacs
82 (defvar outline-mode-menu 139 (defvar outline-mode-menu
83 ;; This is the RB menu which also makes 3 menus in the menubar (like 140 ;; This is the RB menu which also makes 3 menus in the menubar (like
84 ;; FSF rather than because it's good) 141 ;; FSF rather than because it's good)
138 ; (list '(outline-minor-mode " Outl"))))) 195 ; (list '(outline-minor-mode " Outl")))))
139 ;; XEmacs: do it right. 196 ;; XEmacs: do it right.
140 ;;;###autoload 197 ;;;###autoload
141 (add-minor-mode 'outline-minor-mode " Outl") 198 (add-minor-mode 'outline-minor-mode " Outl")
142 199
200 (defvar outline-font-lock-keywords
201 '(;; Highlight headings according to the level.
202 ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$"
203 (1 font-lock-string-face)
204 (2 (let ((len (- (match-end 1) (match-beginning 1))))
205 (or (cdr (assq len '((1 . font-lock-function-name-face)
206 (2 . font-lock-keyword-face)
207 (3 . font-lock-comment-face))))
208 font-lock-variable-name-face))
209 nil t))
210 ;; Highlight citations of the form [1] and [Mar94].
211 ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))
212 "Additional expressions to highlight in Outline mode.")
213
143 ;;;###autoload 214 ;;;###autoload
144 (defun outline-mode () 215 (defun outline-mode ()
145 "Set major mode for editing outlines with selective display. 216 "Set major mode for editing outlines with selective display.
146 Headings are lines which start with asterisks: one for major headings, 217 Headings are lines which start with asterisks: one for major headings,
147 two for subheadings, etc. Lines not starting with asterisks are body lines. 218 two for subheadings, etc. Lines not starting with asterisks are body lines.
188 (setq major-mode 'outline-mode) 259 (setq major-mode 'outline-mode)
189 (define-abbrev-table 'text-mode-abbrev-table ()) 260 (define-abbrev-table 'text-mode-abbrev-table ())
190 (setq local-abbrev-table text-mode-abbrev-table) 261 (setq local-abbrev-table text-mode-abbrev-table)
191 (set-syntax-table text-mode-syntax-table) 262 (set-syntax-table text-mode-syntax-table)
192 (make-local-variable 'paragraph-start) 263 (make-local-variable 'paragraph-start)
193 (setq paragraph-start (concat paragraph-start "\\|^\\(" 264 (setq paragraph-start (concat paragraph-start "\\|\\("
194 outline-regexp "\\)")) 265 outline-regexp "\\)"))
195 ;; Inhibit auto-filling of header lines. 266 ;; Inhibit auto-filling of header lines.
196 (make-local-variable 'auto-fill-inhibit-regexp) 267 (make-local-variable 'auto-fill-inhibit-regexp)
197 (setq auto-fill-inhibit-regexp outline-regexp) 268 (setq auto-fill-inhibit-regexp outline-regexp)
198 (make-local-variable 'paragraph-separate) 269 (make-local-variable 'paragraph-separate)
199 (setq paragraph-separate (concat paragraph-separate "\\|^\\(" 270 (setq paragraph-separate (concat paragraph-separate "\\|\\("
200 outline-regexp "\\)")) 271 outline-regexp "\\)"))
201 ;; #+XEmacs 272 ;; #+XEmacs
202 (outline-install-menubar) 273 (outline-install-menubar)
274 (make-local-variable 'font-lock-defaults)
275 (setq font-lock-defaults '(outline-font-lock-keywords t))
276 (make-local-variable 'change-major-mode-hook)
203 (add-hook 'change-major-mode-hook 'show-all) 277 (add-hook 'change-major-mode-hook 'show-all)
204 (run-hooks 'text-mode-hook 'outline-mode-hook)) 278 (run-hooks 'text-mode-hook 'outline-mode-hook))
205 279
206 (defvar outline-minor-mode-prefix "\C-c\C-o" 280 (defvar outline-minor-mode-prefix "\C-c@"
207 "*Prefix key to use for Outline commands in Outline minor mode.") 281 "*Prefix key to use for Outline commands in Outline minor mode.
282 The value of this variable is checked as part of loading Outline mode.
283 After that, changing the prefix key requires manipulating keymaps.")
208 284
209 (defvar outline-minor-mode-map nil) 285 (defvar outline-minor-mode-map nil)
210 (if outline-minor-mode-map 286 (if outline-minor-mode-map
211 nil 287 nil
212 (setq outline-minor-mode-map (make-sparse-keymap)) 288 (setq outline-minor-mode-map (make-sparse-keymap))
289 (define-key outline-minor-mode-map [menu-bar]
290 outline-mode-menu-bar-map)
213 (define-key outline-minor-mode-map outline-minor-mode-prefix 291 (define-key outline-minor-mode-map outline-minor-mode-prefix
214 (lookup-key outline-mode-map "\C-c"))) 292 outline-mode-prefix-map))
215 293
216 (or (assq 'outline-minor-mode minor-mode-map-alist) 294 (or (assq 'outline-minor-mode minor-mode-map-alist)
217 (setq minor-mode-map-alist 295 (setq minor-mode-map-alist
218 (cons (cons 'outline-minor-mode outline-minor-mode-map) 296 (cons (cons 'outline-minor-mode outline-minor-mode-map)
219 minor-mode-map-alist))) 297 minor-mode-map-alist)))
231 (progn 309 (progn
232 (setq selective-display t) 310 (setq selective-display t)
233 ;; #+XEmacs 311 ;; #+XEmacs
234 (outline-install-menubar) 312 (outline-install-menubar)
235 (run-hooks 'outline-minor-mode-hook)) 313 (run-hooks 'outline-minor-mode-hook))
236 (setq selective-display nil) 314 (setq selective-display nil))
237 ;; When turning off outline mode, get rid of any ^M's. 315 ;; When turning off outline mode, get rid of any ^M's.
238 (or outline-minor-mode 316 (or outline-minor-mode
239 (outline-flag-region (point-min) (point-max) ?\n)) 317 (outline-flag-region (point-min) (point-max) ?\n))
240 (set-buffer-modified-p (buffer-modified-p)) 318 ;; XEmacs change
241 ;; #+XEmacs 319 (set-buffer-modified-p (buffer-modified-p))
242 (outline-install-menubar 'remove))) 320 ;; #+XEmacs
321 (outline-install-menubar 'remove)
322 ;; XEmacs change
323 (redraw-modeline))
243 324
244 (defvar outline-level 'outline-level 325 (defvar outline-level 'outline-level
245 "Function of no args to compute a header's nesting level in an outline. 326 "Function of no args to compute a header's nesting level in an outline.
246 It can assume point is at the beginning of a header line.") 327 It can assume point is at the beginning of a header line.")
247 328
251 ;; who changes the regexp can also redefine the outline-level variable 332 ;; who changes the regexp can also redefine the outline-level variable
252 ;; as appropriate. 333 ;; as appropriate.
253 (defun outline-level () 334 (defun outline-level ()
254 "Return the depth to which a statement is nested in the outline. 335 "Return the depth to which a statement is nested in the outline.
255 Point must be at the beginning of a header line. This is actually 336 Point must be at the beginning of a header line. This is actually
256 the column number of the end of what `outline-regexp' matches." 337 the number of characters that `outline-regexp' matches."
257 (save-excursion 338 (save-excursion
258 (looking-at outline-regexp) 339 (looking-at outline-regexp)
259 (- (match-end 0) (match-beginning 0)))) 340 (- (match-end 0) (match-beginning 0))))
260 341
261 (defun outline-next-preface () 342 (defun outline-next-preface ()
262 "Skip forward to just before the next heading line." 343 "Skip forward to just before the next heading line.
344 If there's no following heading line, stop before the newline
345 at the end of the buffer."
263 (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)") 346 (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
264 nil 'move) 347 nil 'move)
265 (progn 348 (goto-char (match-beginning 0)))
266 (goto-char (match-beginning 0)) 349 (if (memq (preceding-char) '(?\n ?\^M))
267 (if (memq (preceding-char) '(?\n ?\^M)) 350 (forward-char -1)))
268 (forward-char -1)))))
269 351
270 (defun outline-next-heading () 352 (defun outline-next-heading ()
271 "Move to the next (possibly invisible) heading line." 353 "Move to the next (possibly invisible) heading line."
272 (interactive) 354 (interactive)
273 (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)") 355 (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
404 486
405 (defun hide-other () 487 (defun hide-other ()
406 "Hide everything except for the current body and the parent headings." 488 "Hide everything except for the current body and the parent headings."
407 (interactive) 489 (interactive)
408 (hide-sublevels 1) 490 (hide-sublevels 1)
409 (let ((last (point))) 491 (let ((last (point))
492 (pos (point)))
410 (while (save-excursion 493 (while (save-excursion
411 (and (re-search-backward "[\n\r]" nil t) 494 (and (re-search-backward "[\n\r]" nil t)
412 (eq (following-char) ?\r))) 495 (eq (following-char) ?\r)))
413 (save-excursion 496 (save-excursion
414 (beginning-of-line) 497 (beginning-of-line)
427 (progn (outline-end-of-subtree) (point)) 510 (progn (outline-end-of-subtree) (point))
428 flag))) 511 flag)))
429 512
430 (defun outline-end-of-subtree () 513 (defun outline-end-of-subtree ()
431 (outline-back-to-heading) 514 (outline-back-to-heading)
432 (let ((first t) 515 (let ((opoint (point))
516 (first t)
433 (level (funcall outline-level))) 517 (level (funcall outline-level)))
434 (while (and (not (eobp)) 518 (while (and (not (eobp))
435 (or first (> (funcall outline-level) level))) 519 (or first (> (funcall outline-level) level)))
436 (setq first nil) 520 (setq first nil)
437 (outline-next-heading)) 521 (outline-next-heading))