Mercurial > emacs

comparison lisp/textmodes/outline.el @ 41782:eea433180987

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(outline-mode-prefix-map): Add bindings for outline-promote and outline-demote. (outline-minor-mode-menu-bar-map): New var. (outline-minor-mode): Use it. (outline-heading-alist): New var (renamed from outline-level-heading). (outline-level): Use it. (outline-insert-heading, outline-promote, outline-demote): Update to use outline-heading-alist.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sun, 02 Dec 2001 08:39:39 +0000
parents 83b107455579
children 5d3b861665f0
comparison
equal deleted inserted replaced
41781:31aa13c921e0 41782:eea433180987
59 The recommended way to set this is with a `Local Variables:' list 59 The recommended way to set this is with a `Local Variables:' list
60 in the file it applies to." 60 in the file it applies to."
61 :type 'regexp 61 :type 'regexp
62 :group 'outlines) 62 :group 'outlines)
63 63
64 (defvar outline-mode-prefix-map nil) 64 (defvar outline-mode-prefix-map
65 65 (let ((map (make-sparse-keymap)))
66 (if outline-mode-prefix-map 66 (define-key map "@" 'outline-mark-subtree)
67 nil 67 (define-key map "\C-n" 'outline-next-visible-heading)
68 (setq outline-mode-prefix-map (make-sparse-keymap)) 68 (define-key map "\C-p" 'outline-previous-visible-heading)
69 (define-key outline-mode-prefix-map "@" 'outline-mark-subtree) 69 (define-key map "\C-i" 'show-children)
70 (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading) 70 (define-key map "\C-s" 'show-subtree)
71 (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading) 71 (define-key map "\C-d" 'hide-subtree)
72 (define-key outline-mode-prefix-map "\C-i" 'show-children) 72 (define-key map "\C-u" 'outline-up-heading)
73 (define-key outline-mode-prefix-map "\C-s" 'show-subtree) 73 (define-key map "\C-f" 'outline-forward-same-level)
74 (define-key outline-mode-prefix-map "\C-d" 'hide-subtree) 74 (define-key map "\C-b" 'outline-backward-same-level)
75 (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading) 75 (define-key map "\C-t" 'hide-body)
76 (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level) 76 (define-key map "\C-a" 'show-all)
77 (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level) 77 (define-key map "\C-c" 'hide-entry)
78 (define-key outline-mode-prefix-map "\C-t" 'hide-body) 78 (define-key map "\C-e" 'show-entry)
79 (define-key outline-mode-prefix-map "\C-a" 'show-all) 79 (define-key map "\C-l" 'hide-leaves)
80 (define-key outline-mode-prefix-map "\C-c" 'hide-entry) 80 (define-key map "\C-k" 'show-branches)
81 (define-key outline-mode-prefix-map "\C-e" 'show-entry) 81 (define-key map "\C-q" 'hide-sublevels)
82 (define-key outline-mode-prefix-map "\C-l" 'hide-leaves) 82 (define-key map "\C-o" 'hide-other)
83 (define-key outline-mode-prefix-map "\C-k" 'show-branches) 83 (define-key map "\C-^" 'outline-promote)
84 (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels) 84 (define-key map "\C-v" 'outline-demote)
85 (define-key outline-mode-prefix-map "\C-o" 'hide-other)) 85 map))
86 86
87 (defvar outline-mode-menu-bar-map nil) 87 (defvar outline-mode-menu-bar-map
88 (if outline-mode-menu-bar-map 88 (let ((map (make-sparse-keymap)))
89 nil 89
90 (setq outline-mode-menu-bar-map (make-sparse-keymap)) 90 (define-key map [hide] (cons "Hide" (make-sparse-keymap "Hide")))
91 91
92 (define-key outline-mode-menu-bar-map [hide] 92 (define-key map [hide hide-other] '("Hide Other" . hide-other))
93 (cons "Hide" (make-sparse-keymap "Hide"))) 93 (define-key map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels))
94 94 (define-key map [hide hide-subtree] '("Hide Subtree" . hide-subtree))
95 (define-key outline-mode-menu-bar-map [hide hide-other] 95 (define-key map [hide hide-entry] '("Hide Entry" . hide-entry))
96 '("Hide Other" . hide-other)) 96 (define-key map [hide hide-body] '("Hide Body" . hide-body))
97 (define-key outline-mode-menu-bar-map [hide hide-sublevels] 97 (define-key map [hide hide-leaves] '("Hide Leaves" . hide-leaves))
98 '("Hide Sublevels" . hide-sublevels)) 98
99 (define-key outline-mode-menu-bar-map [hide hide-subtree] 99 (define-key map [show] (cons "Show" (make-sparse-keymap "Show")))
100 '("Hide Subtree" . hide-subtree)) 100
101 (define-key outline-mode-menu-bar-map [hide hide-entry] 101 (define-key map [show show-subtree] '("Show Subtree" . show-subtree))
102 '("Hide Entry" . hide-entry)) 102 (define-key map [show show-children] '("Show Children" . show-children))
103 (define-key outline-mode-menu-bar-map [hide hide-body] 103 (define-key map [show show-branches] '("Show Branches" . show-branches))
104 '("Hide Body" . hide-body)) 104 (define-key map [show show-entry] '("Show Entry" . show-entry))
105 (define-key outline-mode-menu-bar-map [hide hide-leaves] 105 (define-key map [show show-all] '("Show All" . show-all))
106 '("Hide Leaves" . hide-leaves)) 106
107 107 (define-key map [headings]
108 (define-key outline-mode-menu-bar-map [show] 108 (cons "Headings" (make-sparse-keymap "Headings")))
109 (cons "Show" (make-sparse-keymap "Show"))) 109
110 110 (define-key map [headings copy]
111 (define-key outline-mode-menu-bar-map [show show-subtree] 111 '(menu-item "Copy to kill ring" outline-headers-as-kill
112 '("Show Subtree" . show-subtree)) 112 :enable mark-active))
113 (define-key outline-mode-menu-bar-map [show show-children] 113 (define-key map [headings outline-backward-same-level]
114 '("Show Children" . show-children)) 114 '("Previous Same Level" . outline-backward-same-level))
115 (define-key outline-mode-menu-bar-map [show show-branches] 115 (define-key map [headings outline-forward-same-level]
116 '("Show Branches" . show-branches)) 116 '("Next Same Level" . outline-forward-same-level))
117 (define-key outline-mode-menu-bar-map [show show-entry] 117 (define-key map [headings outline-previous-visible-heading]
118 '("Show Entry" . show-entry)) 118 '("Previous" . outline-previous-visible-heading))
119 (define-key outline-mode-menu-bar-map [show show-all] 119 (define-key map [headings outline-next-visible-heading]
120 '("Show All" . show-all)) 120 '("Next" . outline-next-visible-heading))
121 121 (define-key map [headings outline-up-heading]
122 (define-key outline-mode-menu-bar-map [headings] 122 '("Up" . outline-up-heading))
123 (cons "Headings" (make-sparse-keymap "Headings"))) 123 map))
124 124
125 (define-key outline-mode-menu-bar-map [headings copy] 125 (defvar outline-minor-mode-menu-bar-map
126 '(menu-item "Copy to kill ring" outline-headers-as-kill 126 (let ((map (make-sparse-keymap)))
127 :enable mark-active)) 127 (define-key map [outline]
128 (define-key outline-mode-menu-bar-map [headings outline-backward-same-level] 128 (cons "Outline"
129 '("Previous Same Level" . outline-backward-same-level)) 129 (nconc (make-sparse-keymap "Outline")
130 (define-key outline-mode-menu-bar-map [headings outline-forward-same-level] 130 ;; Remove extra separator
131 '("Next Same Level" . outline-forward-same-level)) 131 (cdr
132 (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading] 132 ;; Flatten the major mode's menus into a single menu.
133 '("Previous" . outline-previous-visible-heading)) 133 (apply 'append
134 (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading] 134 (mapcar (lambda (x)
135 '("Next" . outline-next-visible-heading)) 135 (if (consp x)
136 (define-key outline-mode-menu-bar-map [headings outline-up-heading] 136 ;; Add a separator between each
137 '("Up" . outline-up-heading))) 137 ;; part of the unified menu.
138 138 (cons '(--- "---") (cdr x))))
139 (defvar outline-mode-map nil "") 139 outline-mode-menu-bar-map))))))
140 140 map))
141 (if outline-mode-map 141
142 nil 142
143 (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map)) 143 (defvar outline-mode-map
144 (define-key outline-mode-map "\C-c" outline-mode-prefix-map) 144 (let ((map (make-sparse-keymap)))
145 (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map)) 145 (define-key map "\C-c" outline-mode-prefix-map)
146 (define-key map [menu-bar] outline-mode-menu-bar-map)
147 map))
146 148
147 (defvar outline-font-lock-keywords 149 (defvar outline-font-lock-keywords
148 '(;; 150 '(;;
149 ;; Highlight headings according to the level. 151 ;; Highlight headings according to the level.
150 (eval . (list (concat "^" outline-regexp ".+") 152 (eval . (list (concat "^" outline-regexp ".+")
241 ;;;###autoload 243 ;;;###autoload
242 (define-minor-mode outline-minor-mode 244 (define-minor-mode outline-minor-mode
243 "Toggle Outline minor mode. 245 "Toggle Outline minor mode.
244 With arg, turn Outline minor mode on if arg is positive, off otherwise. 246 With arg, turn Outline minor mode on if arg is positive, off otherwise.
245 See the command `outline-mode' for more information on this mode." 247 See the command `outline-mode' for more information on this mode."
246 nil " Outl" (list (cons [menu-bar] outline-mode-menu-bar-map) 248 nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
247 (cons outline-minor-mode-prefix outline-mode-prefix-map)) 249 (cons outline-minor-mode-prefix outline-mode-prefix-map))
248 (if outline-minor-mode 250 (if outline-minor-mode
249 (progn 251 (progn
250 ;; Turn off this mode if we change major modes. 252 ;; Turn off this mode if we change major modes.
251 (add-hook 'change-major-mode-hook 253 (add-hook 'change-major-mode-hook
264 "*Function of no args to compute a header's nesting level in an outline. 266 "*Function of no args to compute a header's nesting level in an outline.
265 It can assume point is at the beginning of a header line." 267 It can assume point is at the beginning of a header line."
266 :type 'function 268 :type 'function
267 :group 'outlines) 269 :group 'outlines)
268 270
271 (defvar outline-heading-alist ()
272 "Alist associating a heading for every possible level.
273 Each entry is of the form (HEADING . LEVEL).
274 This alist is used both to find the heading corresponding to
275 a given level and to find the level of a given heading.")
276 (make-variable-buffer-local 'outline-heading-alist)
277
269 ;; This used to count columns rather than characters, but that made ^L 278 ;; This used to count columns rather than characters, but that made ^L
270 ;; appear to be at level 2 instead of 1. Columns would be better for 279 ;; appear to be at level 2 instead of 1. Columns would be better for
271 ;; tab handling, but the default regexp doesn't use tabs, and anyone 280 ;; tab handling, but the default regexp doesn't use tabs, and anyone
272 ;; who changes the regexp can also redefine the outline-level variable 281 ;; who changes the regexp can also redefine the outline-level variable
273 ;; as appropriate. 282 ;; as appropriate.
274 (defun outline-level () 283 (defun outline-level ()
275 "Return the depth to which a statement is nested in the outline. 284 "Return the depth to which a statement is nested in the outline.
276 Point must be at the beginning of a header line. This is actually 285 Point must be at the beginning of a header line.
277 the number of characters that `outline-regexp' matches." 286 This is actually either the level specified in `outline-heading-alist'
287 or else the number of characters matched by `outline-regexp'."
278 (save-excursion 288 (save-excursion
279 (looking-at outline-regexp) 289 (if (not (looking-at outline-regexp))
280 (- (match-end 0) (match-beginning 0)))) 290 ;; This should never happen
291 1000
292 (or (cdr (assoc (match-string 0) outline-heading-alist))
293 (- (match-end 0) (match-beginning 0))))))
281 294
282 (defun outline-next-preface () 295 (defun outline-next-preface ()
283 "Skip forward to just before the next heading line. 296 "Skip forward to just before the next heading line.
284 If there's no following heading line, stop before the newline 297 If there's no following heading line, stop before the newline
285 at the end of the buffer." 298 at the end of the buffer."
331 (save-excursion 344 (save-excursion
332 (beginning-of-line) 345 (beginning-of-line)
333 (and (bolp) (or invisible-ok (not (outline-invisible-p))) 346 (and (bolp) (or invisible-ok (not (outline-invisible-p)))
334 (looking-at outline-regexp)))) 347 (looking-at outline-regexp))))
335 348
336 (defvar outline-level-heading ()
337 "Alist associating a heading for every possible level.")
338 (make-variable-buffer-local 'outline-level-heading)
339
340 (defun outline-insert-heading () 349 (defun outline-insert-heading ()
341 "Insert a new heading at same depth at point." 350 "Insert a new heading at same depth at point."
342 (interactive) 351 (interactive)
343 (let ((head (save-excursion 352 (let ((head (save-excursion
344 (condition-case nil 353 (condition-case nil
345 (outline-back-to-heading) 354 (outline-back-to-heading)
346 (error (outline-next-heading))) 355 (error (outline-next-heading)))
347 (if (eobp) 356 (if (eobp)
348 (or (cdar outline-level-heading) "") 357 (or (caar outline-heading-alist) "")
349 (match-string 0))))) 358 (match-string 0)))))
350 (unless (or (string-match "[ \t]\\'" head) 359 (unless (or (string-match "[ \t]\\'" head)
351 (not (string-match outline-regexp (concat head " ")))) 360 (not (string-match outline-regexp (concat head " "))))
352 (setq head (concat head " "))) 361 (setq head (concat head " ")))
353 (unless (bolp) (end-of-line) (newline)) 362 (unless (bolp) (end-of-line) (newline))
361 If prefix argument CHILDREN is given, promote also all the children." 370 If prefix argument CHILDREN is given, promote also all the children."
362 (interactive "P") 371 (interactive "P")
363 (outline-back-to-heading) 372 (outline-back-to-heading)
364 (let* ((head (match-string 0)) 373 (let* ((head (match-string 0))
365 (level (save-match-data (funcall outline-level))) 374 (level (save-match-data (funcall outline-level)))
366 (up-head (or (cdr (assoc head outline-level-heading)) 375 (up-head (or (car (rassoc (1- level) outline-heading-alist))
367 (cdr (assoc (1- level) outline-level-heading))
368 (save-excursion 376 (save-excursion
369 (save-match-data 377 (save-match-data
370 (outline-up-heading 1 t) 378 (outline-up-heading 1 t)
371 (match-string 0)))))) 379 (match-string 0))))))
372 380
373 (unless (assoc level outline-level-heading) 381 (unless (rassoc level outline-heading-alist)
374 (push (cons level head) outline-level-heading)) 382 (push (cons head level) outline-heading-alist))
375 383
376 (replace-match up-head nil t) 384 (replace-match up-head nil t)
377 (when children 385 (when children
378 (outline-map-tree 'outline-promote level)))) 386 (outline-map-tree 'outline-promote level))))
379 387
383 (interactive "P") 391 (interactive "P")
384 (outline-back-to-heading) 392 (outline-back-to-heading)
385 (let* ((head (match-string 0)) 393 (let* ((head (match-string 0))
386 (level (save-match-data (funcall outline-level))) 394 (level (save-match-data (funcall outline-level)))
387 (down-head 395 (down-head
388 (or (let ((x (car (rassoc head outline-level-heading)))) 396 (or (car (rassoc (1+ level) outline-heading-alist))
389 (if (stringp x) x))
390 (cdr (assoc (1+ level) outline-level-heading))
391 (save-excursion 397 (save-excursion
392 (save-match-data 398 (save-match-data
393 (while (and (not (eobp)) 399 (while (and (not (eobp))
394 (progn 400 (progn
395 (outline-next-heading) 401 (outline-next-heading)
410 ;; Why bother checking that it is indeed of lower level ? 416 ;; Why bother checking that it is indeed of lower level ?
411 new-head 417 new-head
412 ;; Didn't work: keep it as is so it's still a heading. 418 ;; Didn't work: keep it as is so it's still a heading.
413 head)))))) 419 head))))))
414 420
415 (unless (assoc level outline-level-heading) 421 (unless (rassoc level outline-heading-alist)
416 (push (cons level head) outline-level-heading)) 422 (push (cons head level) outline-heading-alist))
417 423
418 (replace-match down-head nil t) 424 (replace-match down-head nil t)
419 (when children 425 (when children
420 (outline-map-tree 'outline-demote level)))) 426 (outline-map-tree 'outline-demote level))))
421 427