1 ;;;_* Allout - An extensive outline-mode for Emacs.
2 ;;; Note - the lines beginning with ';;;_' are outline topic headers.
3 ;;; Load this file (or 'eval-current-buffer') and revisit the
4 ;;; file to give it a whirl.
9 ;;;_ + Package Identification Stuff
11 ;;;_ - Author: Ken Manheimer <klm@nist.gov>
12 ;;;_ - Maintainer: Ken Manheimer <klm@nist.gov>
13 ;;;_ - Created: Dec 1991 - first release to usenet
14 ;;;_ - Version: $Id: allout.el,v 1.4 1993/12/23 04:55:44 rms Exp rms $||
15 ;;;_ - Keywords: outline mode
17 ;;;_ - LCD Archive Entry
20 ;; allout|Ken Manheimer|klm@nist.gov
21 ;; |A more thorough outline-mode
22 ;; |27-May-1993|$Id: allout.el,v 1.4 1993/12/23 04:55:44 rms Exp rms $||
25 ;; A full-fledged outline mode, based on the original rudimentary
26 ;; GNU emacs outline functionality.
28 ;; Ken Manheimer Nat'l Inst of Standards and Technology
29 ;; klm@nist.gov (301)975-3539 (Formerly Nat'l Bureau of Standards)
30 ;; NIST Shared File Service Manager and Developer
33 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
35 ;; This file is part of GNU Emacs.
37 ;; GNU Emacs is free software; you can redistribute it and/or modify
38 ;; it under the terms of the GNU General Public License as published by
39 ;; the Free Software Foundation; either version 2, or (at your option)
42 ;; GNU Emacs is distributed in the hope that it will be useful,
43 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
44 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
45 ;; GNU General Public License for more details.
47 ;; You should have received a copy of the GNU General Public License
48 ;; along with GNU Emacs; see the file COPYING. If not, write to
49 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
51 ;;;_ + User Customization variables
53 ;;;_ - Topic Header configuration
55 ;;;_ = outline-header-prefix
56 (defvar outline-header-prefix
"."
57 "* Leading string for greater than level 0 topic headers.")
58 (make-variable-buffer-local 'outline-header-prefix
)
60 ;;;_ = outline-header-subtraction
61 (defvar outline-header-subtraction
(1- (length outline-header-prefix
))
62 "* Leading string for greater than level 0 topic headers.")
63 (make-variable-buffer-local 'outline-header-subtraction
)
65 ;;;_ = outline-primary-bullet
66 (defvar outline-primary-bullet
"*") ;; Changing this var disables any
67 ;; backwards compatibility with
68 ;; the original outline mode.
69 (make-variable-buffer-local 'outline-primary-bullet
)
71 ;;;_ = outline-plain-bullets-string
72 (defvar outline-plain-bullets-string
""
73 "* The bullets normally used in outline topic prefixes. See
74 'outline-distinctive-bullets-string' for the other kind of
77 DO NOT include the close-square-bracket, ']', among any bullets.
79 You must run 'set-outline-regexp' in order for changes to the
80 value of this var to effect outline-mode operation.")
81 (setq outline-plain-bullets-string
(concat outline-primary-bullet
83 (make-variable-buffer-local 'outline-plain-bullets-string
)
85 ;;;_ = outline-distinctive-bullets-string
86 (defvar outline-distinctive-bullets-string
""
87 "* The bullets used for distinguishing outline topics. These
88 bullets are not offered among the regular rotation, and are not
89 changed when automatically rebulleting, as when shifting the
90 level of a topic. See 'outline-plain-bullets-string' for the
91 other kind of bullets.
93 DO NOT include the close-square-bracket, ']', among any bullets.
95 You must run 'set-outline-regexp' in order for changes
96 to the value of this var to effect outline-mode operation.")
97 (setq outline-distinctive-bullets-string
"=>([{}&!?#%\"X@$~")
98 (make-variable-buffer-local 'outline-distinctive-bullets-string
)
100 ;;;_ > outline-numbered-bullet ()
101 (defvar outline-numbered-bullet
()
102 "* Bullet signifying outline prefixes which are to be numbered.
103 Leave it nil if you don't want any numbering, or set it to a
104 string with the bullet you want to be used.")
105 (setq outline-numbered-bullet
"#")
106 (make-variable-buffer-local 'outline-numbered-bullet
)
108 ;;;_ = outline-file-xref-bullet
109 (defvar outline-file-xref-bullet
"@"
110 "* Set this var to the bullet you want to use for file cross-references.
111 Set it 'nil' if you want to inhibit this capability.")
113 ;;;_ - Miscellaneous customization
115 ;;;_ = outline-stylish-prefixes
116 (defvar outline-stylish-prefixes t
117 "*A true value for this var makes the topic-prefix creation and modification
118 functions vary the prefix bullet char according to level. Otherwise, only
119 asterisks ('*') and distinctive bullets are used.
121 This is how an outline can look with stylish prefixes:
125 . + One level 3 subtopic
126 . . One level 4 subtopic
127 . + Another level 3 subtopic
128 . . A level 4 subtopic
129 . #2 A distinguished, numbered level 4 subtopic
130 . ! A distinguished ('!') level 4 subtopic
131 . #4 Another numbered level 4 subtopic
133 This would be an outline with stylish prefixes inhibited:
137 .! A distinctive (but measly) subtopic
138 . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*'
140 Stylish and constant prefixes (as well as old-style prefixes) are
141 always respected by the topic maneuvering functions, regardless of
142 this variable setting.
144 The setting of this var is not relevant when outline-old-style-prefixes
146 (make-variable-buffer-local 'outline-stylish-prefixes
)
148 ;;;_ = outline-old-style-prefixes
149 (defvar outline-old-style-prefixes nil
150 "*Setting this var causes the topic-prefix creation and modification
151 functions to make only asterix-padded prefixes, so they look exactly
152 like the old style prefixes.
154 Both old and new style prefixes are always respected by the topic
155 maneuvering functions.")
156 (make-variable-buffer-local 'outline-old-style-prefixes
)
158 ;;;_ = outline-enwrap-isearch-mode
159 ; Spiffy dynamic-exposure
160 ; during searches requires
161 ; Dan LaLiberte's isearch-mode:
162 (defvar outline-enwrap-isearch-mode
"isearch-mode.el"
163 "* Set this var to the name of the (non-compiled) elisp code for
164 isearch-mode, if you have Dan LaLiberte's 'isearch-mode'
165 stuff and want isearches to reveal hidden stuff encountered in the
166 course of a search, and reconceal it if you go past. Set it nil if
167 you don't have the package, or don't want to use this feature.")
169 ;;;_ = outline-use-hanging-indents
170 (defvar outline-use-hanging-indents t
171 "* Set this var non-nil if you have Kyle E Jones' filladapt stuff,
172 and you want outline to fill topics as hanging indents to the
174 (make-variable-buffer-local 'outline-use-hanging-indents
)
176 ;;;_ = outline-reindent-bodies
177 (defvar outline-reindent-bodies t
178 "* Set this var non-nil if you want topic depth adjustments to
179 reindent hanging bodies (ie, bodies lines indented to beginning of
180 heading text). The performance hit is small.
182 Avoid this strenuously when using outline mode on program code.
183 It's great for text, though.")
184 (make-variable-buffer-local 'outline-reindent-bodies
)
186 ;;;_ = outline-mode-keys
187 ;;; You have to restart outline-mode - '(outline-mode t)' - to have
188 ;;; any changes take hold.
189 (defvar outline-mode-keys
()
190 "Assoc list of outline-mode-keybindings, for common reference in setting
191 up major and minor-mode keybindings.")
192 (setq outline-mode-keys
195 ("\C-c\C-n" outline-next-visible-heading
)
196 ("\C-c\C-p" outline-previous-visible-heading
)
197 ("\C-c\C-u" outline-up-current-level
)
198 ("\C-c\C-f" outline-forward-current-level
)
199 ("\C-c\C-b" outline-backward-current-level
)
200 ("\C-c\C-a" outline-beginning-of-current-entry
)
201 ("\C-c\C-e" outline-end-of-current-entry
)
203 ("\C-c\C-i" outline-show-current-children
)
204 ("\C-c\C-s" outline-show-current-subtree
)
205 ("\C-c\C-h" outline-hide-current-subtree
)
206 ("\C-c\C-o" outline-show-current-entry
)
207 ("\C-c!" outline-show-all
)
208 ; Alteration commands:
209 ("\C-c " open-sibtopic
)
210 ("\C-c." open-subtopic
)
211 ("\C-c," open-supertopic
)
212 ("\C-c'" outline-shift-in
)
213 ("\C-c>" outline-shift-in
)
214 ("\C-c<" outline-shift-out
)
215 ("\C-c\C-m" outline-rebullet-topic
)
216 ("\C-cb" outline-rebullet-current-heading
)
217 ("\C-c#" outline-number-siblings
)
218 ("\C-k" outline-kill-line
)
219 ("\C-y" outline-yank
)
220 ("\M-y" outline-yank-pop
)
221 ("\C-c\C-k" outline-kill-topic
)
222 ; Miscellaneous commands:
223 ("\C-c@" outline-resolve-xref
)
224 ("\C-cc" outline-copy-exposed
)))
226 ;;;_ + Code - no user customizations below.
228 ;;;_ #1 Outline Format and Internal Mode Configuration
230 ;;;_ : Topic header format
231 ;;;_ = outline-regexp
232 (defvar outline-regexp
""
233 "* Regular expression to match the beginning of a heading line.
234 Any line whose beginning matches this regexp is considered a
235 heading. This var is set according to the user configuration vars
236 by set-outline-regexp.")
237 (make-variable-buffer-local 'outline-regexp
)
238 ;;;_ = outline-bullets-string
239 (defvar outline-bullets-string
""
240 " A string dictating the valid set of outline topic bullets. This
241 var should *not* be set by the user - it is set by 'set-outline-regexp',
242 and is composed from the elements of 'outline-plain-bullets-string'
243 and 'outline-distinctive-bullets-string'.")
244 (make-variable-buffer-local 'outline-bullets-string
)
245 ;;;_ = outline-line-boundary-regexp
246 (defvar outline-line-boundary-regexp
()
247 " outline-regexp with outline-style beginning of line anchor (ie,
248 C-j, *or* C-m, for prefixes of hidden topics). This is properly
249 set when outline-regexp is produced by 'set-outline-regexp', so
250 that (match-beginning 2) and (match-end 2) delimit the prefix.")
251 (make-variable-buffer-local 'outline-line-boundary-regexp
)
252 ;;;_ = outline-bob-regexp
253 (defvar outline-bob-regexp
()
254 " Like outline-line-boundary-regexp, this is an outline-regexp for
255 outline headers at the beginning of the buffer. (match-beginning 2)
257 delimit the prefix.")
258 (make-variable-buffer-local 'outline-line-bob-regexp
)
259 ;;;_ > outline-reset-header-lead (header-lead)
260 (defun outline-reset-header-lead (header-lead)
261 "* Reset the leading string used to identify topic headers."
262 (interactive "sNew lead string: ")
264 (setq outline-header-prefix header-lead
)
265 (setq outline-header-subtraction
(1- (length outline-header-prefix
)))
268 ;;;_ > outline-lead-with-comment-string (header-lead)
269 (defun outline-lead-with-comment-string (&optional header-lead
)
270 "* Set the topic-header leading string to specified string. Useful
271 when for encapsulating outline structure in programming language
272 comments. Returns the leading string."
275 (if (not (stringp header-lead
))
276 (setq header-lead
(read-string
277 "String prefix for topic headers: ")))
278 (setq outline-reindent-bodies nil
)
279 (outline-reset-header-lead header-lead
)
281 ;;;_ > set-outline-regexp ()
282 (defun set-outline-regexp ()
283 " Generate proper topic-header regexp form for outline functions, from
284 outline-plain-bullets-string and outline-distinctive-bullets-string."
287 ;; Derive outline-bullets-string from user configured components:
288 (setq outline-bullets-string
"")
289 (let ((strings (list 'outline-plain-bullets-string
290 'outline-distinctive-bullets-string
))
297 (setq new-string
"") (setq index
0)
298 (setq cur-len
(length (setq cur-string
(symbol-value (car strings
)))))
299 (while (< index cur-len
)
300 (setq cur-char
(aref cur-string index
))
301 (setq outline-bullets-string
302 (concat outline-bullets-string
304 ; Single dash would denote a
305 ; sequence, repeated denotes
307 ((eq cur-char ?-
) "--")
308 ; literal close-square-bracket
309 ; doesn't work right in the
311 ((eq cur-char ?\
]) "")
312 (t (regexp-quote (char-to-string cur-char
))))))
313 (setq index
(1+ index
)))
314 (setq strings
(cdr strings
)))
316 ;; Derive next for repeated use in outline-pending-bullet:
317 (setq outline-plain-bullets-string-len
(length outline-plain-bullets-string
))
318 (setq outline-header-subtraction
(1- (length outline-header-prefix
)))
319 ;; Produce the new outline-regexp:
320 (setq outline-regexp
(concat "\\(\\"
321 outline-header-prefix
323 outline-bullets-string
325 outline-primary-bullet
327 (setq outline-line-boundary-regexp
328 (concat "\\([\C-j\C-m]\\)\\(" outline-regexp
"\\)"))
329 (setq outline-bob-regexp
330 (concat "\\(\\`\\)\\(" outline-regexp
"\\)"))
334 ;;;_ = Generic minor keybindings control
335 ;;;_ ; Stallman's suggestion
336 (defvar outline-mode-map nil
"")
340 (setq outline-mode-map
(nconc (make-sparse-keymap) text-mode-map
))
341 (define-key outline-mode-map
"\C-c\C-n" 'outline-next-visible-heading
)
342 (define-key outline-mode-map
"\C-c\C-p" 'outline-previous-visible-heading
)
343 (define-key outline-mode-map
"\C-c\C-i" 'show-children
)
344 (define-key outline-mode-map
"\C-c\C-s" 'show-subtree
)
345 (define-key outline-mode-map
"\C-c\C-h" 'hide-subtree
)
346 (define-key outline-mode-map
"\C-c\C-u" 'outline-up-heading
)
347 (define-key outline-mode-map
"\C-c\C-f" 'outline-forward-same-level
)
348 (define-key outline-mode-map
"\C-c\C-b" 'outline-backward-same-level
))
350 (defvar outline-minor-mode nil
351 "Non-nil if using Outline mode as a minor mode of some other mode.")
352 (make-variable-buffer-local 'outline-minor-mode
)
353 (put 'outline-minor-mode
'permanent-local t
)
354 (setq minor-mode-alist
(append minor-mode-alist
355 (list '(outline-minor-mode " Outl"))))
357 (defvar outline-minor-mode-map nil
)
358 (if outline-minor-mode-map
360 (setq outline-minor-mode-map
(make-sparse-keymap))
361 (define-key outline-minor-mode-map
"\C-c"
362 (lookup-key outline-mode-map
"\C-c")))
364 (or (assq 'outline-minor-mode minor-mode-map-alist
)
365 (setq minor-mode-map-alist
366 (cons (cons 'outline-minor-mode outline-minor-mode-map
)
367 minor-mode-map-alist
)))
369 (defun outline-minor-mode (&optional arg
)
370 "Toggle Outline minor mode.
371 With arg, turn Outline minor mode on if arg is positive, off otherwise.
372 See the command `outline-mode' for more information on this mode."
374 (setq outline-minor-mode
375 (if (null arg
) (not outline-minor-mode
)
376 (> (prefix-numeric-value arg
) 0)))
377 (if outline-minor-mode
379 (setq selective-display t
)
380 (run-hooks 'outline-minor-mode-hook
))
381 (setq selective-display nil
)))
382 ;;;_ ; minor-bind-keys (keys-assoc)
383 (defun minor-bind-keys (keys-assoc)
384 " Establish BINDINGS assoc list in current buffer, returning a list
385 for subsequent use by minor-unbind-keys to resume overloaded local
388 ;; Cycle thru key list, registering prevailing local binding for key, if
389 ;; any (for prospective resumption by outline-minor-unbind-keys), then
390 ;; overloading it with outline-mode one.
391 (let ((local-map (or (current-local-map)
392 (make-sparse-keymap)))
393 key new-func unbinding-registry prevailing-func
)
395 (setq curr-key
(car (car keys-assoc
)))
396 (setq new-func
(car (cdr (car keys-assoc
))))
397 (setq prevailing-func
(local-key-binding curr-key
))
398 (if (not (symbolp prevailing-func
))
399 (setq prevailing-func nil
))
400 ;; Register key being changed, prevailing local binding, & new binding:
401 (setq unbinding-registry
402 (cons (list curr-key
(local-key-binding curr-key
) new-func
)
406 (define-key local-map curr-key new-func
)
407 ; Increment for next iteration:
408 (setq keys-assoc
(cdr keys-assoc
)))
409 ; Establish modified map:
410 (use-local-map local-map
)
411 ; Return the registry:
415 ;;;_ ; minor-relinquish-keys (unbinding-registry)
416 (defun minor-relinquish-keys (unbinding-registry)
417 " Given registry of MODAL-BINDINGS, as produced by minor-bind-keys,
418 resume the former local keybindings of those keys that retain the
419 local bindings set by minor-bind-keys. Changed local bindings are
420 left alone, so other minor (user or modal) bindings are not disrupted.
422 Returns a list of those registrations which were not, because of
423 tampering subsequent to the registration by minor-bind-keys, resumed."
425 (let (residue curr-item curr-key curr-resume curr-relinquish
)
426 (while unbinding-registry
427 (setq curr-item
(car unbinding-registry
))
428 (setq curr-key
(car curr-item
))
429 (setq curr-resume
(car (cdr curr-item
)))
430 (setq curr-relinquish
(car (cdr (cdr curr-item
))))
431 (if (equal (local-key-binding curr-key
) curr-relinquish
)
433 ;; Was a local binding to be resumed - do so:
434 (local-set-key curr-key curr-resume
)
435 (local-unset-key curr-key
))
436 ;; Bindings been tampered with since registration - leave it be, and
437 ;; register so on residue list:
438 (setq residue
(cons residue curr-item
)))
439 (setq unbinding-registry
(cdr unbinding-registry
)))
442 ;;;_ = outline-minor-prior-keys
443 (defvar outline-minor-prior-keys
()
444 "Former key bindings assoc-list, for resumption from outline minor-mode.")
445 (make-variable-buffer-local 'outline-minor-prior-keys
)
447 ; Both major and minor mode
448 ; bindings are dictated by
449 ; this list - put your
451 ;;;_ > outline-minor-bind-keys ()
452 (defun outline-minor-bind-keys ()
453 " Establish outline-mode keybindings as MINOR modality of current buffer."
454 (setq outline-minor-prior-keys
455 (minor-bind-keys outline-mode-keys
)))
456 ;;;_ > outline-minor-relinquish-keys ()
457 (defun outline-minor-relinquish-keys ()
458 " Resurrect local keybindings as they were before outline-minor-bind-keys."
459 (minor-relinquish-keys outline-minor-prior-keys
)
462 ;;;_ : Mode-Specific Variables Maintenance
463 ;;;_ = outline-mode-prior-settings
464 (defvar outline-mode-prior-settings nil
465 "For internal use by outline mode, registers settings to be resumed
466 on mode deactivation.")
467 (make-variable-buffer-local 'outline-mode-prior-settings
)
468 ;;;_ > outline-resumptions (name &optional value)
469 (defun outline-resumptions (name &optional value
)
471 " Registers information for later reference, or performs resumption of
472 outline-mode specific values. First arg is NAME of variable affected.
473 optional second arg is list containing outline-mode-specific VALUE to
474 be impose on named variable, and to be registered. (It's a list so you
475 can specify registrations of null values.) If no value is specified,
476 the registered value is returned (encapsulated in the list, so the
477 caller can distinguish nil vs no value), and the registration is popped
480 (let ((on-list (assq name outline-mode-prior-settings
))
481 prior-capsule
; By 'capsule' i mean a list
482 ; containing a value, so we can
483 ; distinguish nil from no value.
491 nil
; Already preserved prior value - don't mess with it.
492 ;; Register the old value, or nil if previously unbound:
493 (setq outline-mode-prior-settings
495 (if (boundp name
) (list (symbol-value name
))))
496 outline-mode-prior-settings
)))
497 ; And impose the new value:
498 (set name
(car value
)))
503 ;; Oops, not registered - leave it be:
506 ;; Some registration:
508 (setq prior-capsule
(car (cdr on-list
)))
510 (set name
(car prior-capsule
)) ; Some prior value - reestablish it.
511 (makunbound name
)) ; Previously unbound - demolish var.
512 ; Remove registration:
514 (while outline-mode-prior-settings
515 (if (not (eq (car outline-mode-prior-settings
)
518 (cons (car outline-mode-prior-settings
)
520 (setq outline-mode-prior-settings
521 (cdr outline-mode-prior-settings
)))
522 (setq outline-mode-prior-settings rebuild
)))))
527 (defvar outline-mode
() "Allout outline mode minor-mode flag.")
528 (make-variable-buffer-local 'outline-mode
)
529 ;;;_ > outline-mode (&optional toggle)
530 (defun outline-mode (&optional toggle
)
531 " Set minor mode for editing outlines with selective display.
533 Look below the description of the bindings for explanation of the
534 terminology use in outline-mode commands.
536 (Note - this is not a proper minor mode, because it does affect key
537 bindings. It's not too improper, however, because it does resurrect
538 any bindings which have not been tampered with since it changed them.)
540 Exposure Commands Movement Commands
541 C-c C-h outline-hide-current-subtree C-c C-n outline-next-visible-heading
542 C-c C-i outline-show-current-children C-c C-p outline-previous-visible-heading
543 C-c C-s outline-show-current-subtree C-c C-u outline-up-current-level
544 C-c C-o outline-show-current-entry C-c C-f outline-forward-current-level
545 C-c ! outline-show-all C-c C-b outline-backward-current-level
546 outline-hide-current-leaves C-c C-e outline-end-of-current-entry
547 C-c C-a outline-beginning-of-current-entry
550 Topic Header Generation Commands
551 C-c<SP> open-sibtopic Create a new sibling after current topic
552 C-c . open-subtopic ... an offspring of current topic
553 C-c , open-supertopic ... a sibling of the current topic's parent
555 Level and Prefix Adjustment Commands
556 C-c > outline-shift-in Shift current topic and all offspring deeper
557 C-c < outline-shift-out ... less deep
558 C-c<CR> outline-rebullet-topic Reconcile bullets of topic and its offspring
559 - distinctive bullets are not changed, all
560 others set suitable according to depth
561 C-c b outline-rebullet-current-heading Prompt for alternate bullet for
563 C-c # outline-number-siblings Number bullets of topic and siblings - the
564 offspring are not affected. With repeat
565 count, revoke numbering.
567 Killing and Yanking - all keep siblings numbering reconciled as appropriate
568 C-k outline-kill-line Regular kill line, but respects numbering ,etc
569 C-c C-k outline-kill-topic Kill current topic, including offspring
570 C-y outline-yank Yank, adjusting depth of yanked topic to
571 depth of heading if yanking into bare topic
572 heading (ie, prefix sans text)
573 M-y outline-yank-pop Is to outline-yank as yank-pop is to yank
576 C-c @ outline-resolve-xref pop-to-buffer named by xref (cf
577 outline-file-xref-bullet)
578 C-c c outline-copy-exposed Copy outline sans all hidden stuff to
579 another buffer whose name is derived
580 from the current one - \"XXX exposed\"
581 M-x outlinify-sticky Activate outline mode for current buffer
582 and establish -*- outline -*- mode specifier
583 as well as file local vars to automatically
584 set exposure. Try it.
588 Topic: A basic cohesive component of an emacs outline, which can
589 be closed (made hidden), opened (revealed), generated,
590 traversed, and shifted as units, using outline-mode functions.
591 A topic is composed of a HEADER, a BODY, and SUBTOPICs (see below).
593 Exposure: Hidden (~closed~) topics are represented by ellipses ('...')
594 at the end of the visible SUPERTOPIC which contains them,
595 rather than by their actual text. Hidden topics are still
596 susceptible to editing and regular movement functions, they
597 just are not displayed normally, effectively collapsed into
598 the ellipses which represent them. Outline mode provides
599 the means to selectively expose topics based on their
602 SUBTOPICS of a topic can be hidden and subsequently revealed
603 based on their DEPTH relative to the supertopic from which
604 the exposure is being done.
606 The BODIES of a topic do not generally become visible except
607 during exposure of entire subtrees (see documentation for
608 '-current-subtree'), or when the entry is explicitly exposed
609 with the 'outline-show-entry' function, or (if you have a
610 special version of isearch installed) when encountered by
611 incremental searches.
613 The CURRENT topic is the more recent visible one before or
614 including the text cursor.
616 Header: The initial portion of an outline topic. It is composed of a
617 topic header PREFIX at the beginning of the line, followed by
618 text to the end of the EFFECTIVE LINE.
620 Body: Any subsequent lines of text following a topic header and preceding
621 the next one. This is also referred to as the entry for a topic.
623 Prefix: The text which distinguishes topic headers from normal text
624 lines. There are two forms, both of which start at the beginning
625 of the topic header (EFFECTIVE) line. The length of the prefix
626 represents the DEPTH of the topic. The fundamental sort begins
627 either with solely an asterisk ('*') or else dot ('.') followed
628 by zero or more spaces and then an outline BULLET. [Note - you
629 can now designate your own, arbitrary HEADER-LEAD string, by
630 setting the variable 'outline-header-prefix'.] The second form
631 is for backwards compatibility with the original emacs outline
632 mode, and consists solely of asterisks. Both sorts are
633 recognized by all outline commands. The first sort is generated
634 by outline topic production commands if the emacs variable
635 outline-old-style-prefixes is nil, otherwise the second style is
638 Bullet: An outline prefix bullet is one of the characters on either
639 of the outline bullet string vars, 'outline-plain-bullets-string'
640 and 'outline-distinctive-bullets-string'. (See their
641 documentation for more details.) The default choice of bullet
642 for any prefix depends on the DEPTH of the topic.
645 The length of a topic header prefix, from the initial
646 character to the bullet (inclusive), represents the depth of
647 the topic. A topic is considered to contain the subsequent
648 topics of greater depth up to the next topic of the same
649 depth, and the contained topics are recursively considered to
650 be nested within all containing topics. Contained topics are
651 called subtopics. Immediate subtopics are called 'children'.
652 Containing topics are supertopicsimmediate supertopics are
653 'parents'. Contained topics of the same depth are called
656 Effective line: The regular ascii text in which form outlines are
657 saved are manipulated in outline-mode to engage emacs'
658 selective-display faculty. The upshot is that the
659 effective end of an outline line can be terminated by
660 either a normal Unix newline char, \n, or the special
661 outline-mode eol, ^M. This only matters at the user
662 level when you're doing searches which key on the end of
667 (let* ((active (and (boundp 'outline-mode
) outline-mode
))
669 (or (and (listp toggle
)(car toggle
))
671 (explicit-activation (and toggle
673 (and (natnump toggle
)
674 (not (zerop toggle
)))))))
678 ((and (not explicit-activation
) (or active toggle
))
679 ;; Activation not explicitly requested, and either in active
680 ;; state or deactivation specifically requested:
681 (outline-minor-relinquish-keys)
682 (outline-resumptions 'selective-display
)
683 (outline-resumptions 'indent-tabs-mode
)
684 (outline-resumptions 'paragraph-start
)
685 (outline-resumptions 'paragraph-separate
)
686 (setq outline-mode nil
))
688 ;; Deactivation *not* indicated.
690 ;; Not already active - activate:
691 (outline-minor-bind-keys)
692 (outline-resumptions 'selective-display
'(t))
693 (outline-resumptions 'indent-tabs-mode
'(nil))
694 (or (assq 'outline-mode minor-mode-alist
)
695 (setq minor-mode-alist
696 (cons '(outline-mode " Outline") minor-mode-alist
)))
699 (make-local-variable 'paragraph-start
)
700 (outline-resumptions 'paragraph-start
701 (list (concat paragraph-start
"\\|^\\("
702 outline-regexp
"\\)")))
703 (make-local-variable 'paragraph-separate
)
704 (outline-resumptions 'paragraph-separate
705 (list (concat paragraph-separate
"\\|^\\("
706 outline-regexp
"\\)")))
708 (if outline-enwrap-isearch-mode
709 (outline-enwrap-isearch))
710 (if (and outline-use-hanging-indents
711 (boundp 'filladapt-prefix-table
))
712 ;; Add outline-prefix recognition to filladapt - not standard:
713 (progn (setq filladapt-prefix-table
714 (cons (cons (concat "\\(" outline-regexp
"\\) ")
715 'filladapt-hanging-list
)
716 filladapt-prefix-table
))
717 (setq filladapt-hanging-list-prefixes
719 filladapt-hanging-list-prefixes
))))
720 (run-hooks 'outline-mode-hook
)
721 (setq outline-mode t
))
727 ;;;_ #2 Internal Position State-Tracking Variables
728 ;;; All basic outline functions which directly do string matches to
729 ;;; evaluate heading prefix location set the variables
730 ;;; outline-recent-prefix-beginning and outline-recent-prefix-end when
731 ;;; successful. Functions starting with 'outline-recent-' all use
732 ;;; this state, providing the means to avoid redundant searches for
733 ;;; just established data. This optimization can provide significant
734 ;;; speed improvement, but it must be employed carefully.
735 ;;;_ = outline-recent-prefix-beginning
736 (defvar outline-recent-prefix-beginning
0
737 " Buffer point of the start of the last topic prefix encountered.")
738 (make-variable-buffer-local 'outline-recent-prefix-beginning
)
739 ;;;_ = outline-recent-prefix-end
740 (defvar outline-recent-prefix-end
0
741 " Buffer point of the end of the last topic prefix encountered.")
742 (make-variable-buffer-local 'outline-recent-prefix-end
)
744 ;;;_ #3 Exposure Control
747 ;;;_ > outline-flag-region (from to flag)
748 (defun outline-flag-region (from to flag
)
749 " Hides or shows lines from FROM to TO, according to FLAG.
750 Uses emacs selective-display, where text is show if FLAG put at
751 beginning of line is `\\n' (newline character), while text is
752 hidden if FLAG is `\\^M' (control-M).
754 returns nil iff no changes were effected."
755 (let ((buffer-read-only nil
))
756 (subst-char-in-region from to
757 (if (= flag ?
\n) ?\^M ?
\n)
759 ;;;_ > outline-flag-current-subtree (flag)
760 (defun outline-flag-current-subtree (flag)
762 (outline-back-to-current-heading)
763 (outline-flag-region (point)
764 (progn (outline-end-of-current-subtree) (point))
767 ;;;_ : Topic-specific
768 ;;;_ > outline-hide-current-entry ()
769 (defun outline-hide-current-entry ()
770 "Hide the body directly following this heading."
772 (outline-back-to-current-heading)
774 (outline-flag-region (point)
775 (progn (outline-end-of-current-entry) (point))
777 ;;;_ > outline-show-current-entry (&optional arg)
778 (defun outline-show-current-entry (&optional arg
)
779 "Show body directly following this heading, or hide it if repeat count."
782 (outline-hide-current-entry)
784 (outline-flag-region (point)
785 (progn (outline-end-of-current-entry) (point))
787 ;;;_ > outline-show-entry ()
788 ; outline-show-entry basically for isearch dynamic exposure, as is...
789 (defun outline-show-entry ()
790 " Like outline-show-current-entry, but reveals an entry that is nested
791 within hidden topics."
794 (outline-goto-prefix)
795 (outline-flag-region (if (not (bobp)) (1- (point)) (point))
796 (progn (outline-pre-next-preface) (point)) ?
\n)))
797 ;;;_ > outline-hide-current-entry-completely ()
798 ; ... outline-hide-current-entry-completely also for isearch dynamic exposure:
799 (defun outline-hide-current-entry-completely ()
800 "Like outline-hide-current-entry, but conceal topic completely."
803 (outline-goto-prefix)
804 (outline-flag-region (if (not (bobp)) (1- (point)) (point))
805 (progn (outline-pre-next-preface)
806 (if (looking-at "\C-m")
810 ;;;_ > outline-show-current-subtree ()
811 (defun outline-show-current-subtree ()
812 "Show everything after this heading at deeper levels."
814 (outline-flag-current-subtree ?
\n))
815 ;;;_ > outline-hide-current-subtree (&optional just-close)
816 (defun outline-hide-current-subtree (&optional just-close
)
818 " Hide everything after this heading at deeper levels, or if it's
819 already closed, and optional arg JUST-CLOSE is nil, hide the current
823 (let ((orig-eol (save-excursion
824 (end-of-line)(outline-goto-prefix)(end-of-line)(point))))
825 (outline-flag-current-subtree ?\^M
)
826 (if (and (= orig-eol
(save-excursion (goto-char orig-eol
)
829 ;; Structure didn't change - try hiding current level:
831 (outline-up-current-level 1 t
)))
832 (outline-hide-current-subtree))))
833 ;;;_ > outline-show-current-branches ()
834 (defun outline-show-current-branches ()
835 "Show all subheadings of this heading, but not their bodies."
837 (outline-show-current-children 1000))
838 ;;;_ > outline-hide-current-leaves ()
839 (defun outline-hide-current-leaves ()
840 "Hide all body after this heading at deeper levels."
842 (outline-back-to-current-heading)
843 (outline-hide-region-body (point) (progn (outline-end-of-current-subtree)
845 ;;;_ > outline-show-current-children (&optional level)
846 (defun outline-show-current-children (&optional level
)
847 " Show all direct subheadings of this heading. Optional LEVEL specifies
848 how many levels below the current level should be shown."
850 (or level
(setq level
1))
854 (setq level
(+ level
(progn (outline-back-to-current-heading)
855 (outline-recent-depth))))
856 (narrow-to-region (point)
857 (progn (outline-end-of-current-subtree) (1+ (point))))
858 (goto-char (point-min))
859 (while (and (not (eobp))
860 (outline-next-heading))
861 (if (<= (outline-recent-depth) level
)
863 (let ((end (1+ (point))))
865 (if (memq (preceding-char) '(?
\n ?\^M
))
867 (outline-flag-region (point) end ?
\n))))))))
869 ;;;_ : Region and beyond
870 ;;;_ > outline-show-all ()
871 (defun outline-show-all ()
872 "Show all of the text in the buffer."
874 (outline-flag-region (point-min) (point-max) ?
\n))
875 ;;;_ > outline-hide-bodies ()
876 (defun outline-hide-bodies ()
877 "Hide all of buffer except headings."
879 (outline-hide-region-body (point-min) (point-max)))
880 ;;;_ > outline-hide-region-body (start end)
881 (defun outline-hide-region-body (start end
)
882 "Hide all body lines in the region, but not headings."
885 (narrow-to-region start end
)
886 (goto-char (point-min))
888 (outline-flag-region (point)
889 (progn (outline-pre-next-preface) (point)) ?\^M
)
892 (if (looking-at "[\n\^M][\n\^M]")
894 ;;;_ > outline-expose ()
895 (defun outline-expose (spec &rest followers
)
897 "Dictate wholesale exposure scheme for current topic, according to SPEC.
899 SPEC is either a number or a list of specs. Optional successive args
900 dictate exposure for subsequent siblings of current topic.
902 Numbers, the symbols '*' and '+', and the null list dictate different
903 exposure depths for the corresponding topic. Numbers indicate the
904 depth to open, with negative numbers first forcing a close, and then
905 opening to their absolute value. Positive numbers jsut reopen, and 0
906 just closes. '*' completely opens the topic, including bodies, and
907 '+' shows all the sub headers, but not the bodies.
909 If the spec is a list, the first element must be a number which
910 dictates the exposure depth of the topic as a whole. Subsequent
911 elements of the list are nested SPECs, dictating the specific exposure
912 for the corresponding offspring of the topic, as the SPEC as a whole
913 does for the parent topic.
915 Optional FOLLOWER elements dictate exposure for subsequent siblings
916 of the parent topic."
918 (interactive "xExposure spec: ")
920 (let ((start-point (progn (outline-goto-prefix)(point)))
922 (cond ((null spec
) nil
)
924 (if (eq spec
'*) (outline-show-current-subtree))
925 (if (eq spec
'+) (outline-show-current-branches)))
928 ;; Just hide if zero:
929 (outline-hide-current-subtree t
)
931 ;; Close before opening if negative:
932 (progn (outline-hide-current-subtree)
933 (setq spec
(* -
1 spec
))))
934 (outline-show-current-children spec
)))
936 (outline-expose (car spec
))
937 (if (and (outline-descend-to-depth (+ (outline-current-depth) 1))
938 (not (outline-hidden-p)))
939 (while (and (setq spec
(cdr spec
))
941 (outline-expose (car spec
))
942 (setq done
(not (outline-next-sibling)))))))))
943 (while (and followers
(outline-next-sibling))
944 (outline-expose (car followers
))
945 (setq followers
(cdr followers
)))
947 ;;;_ > outline-exposure '()
948 (defmacro outline-exposure
(&rest spec
)
949 " Literal frontend for 'outline-expose', passes arguments unevaluated,
950 so you needn't quote them."
951 (cons 'outline-expose
(mapcar '(lambda (x) (list 'quote x
)) spec
)))
955 ;;;_ : Position Assessment
957 ;;;_ . Residual state - from most recent outline context operation.
958 ;;;_ > outline-recent-depth ()
959 (defun outline-recent-depth ()
960 " Return depth of last heading encountered by an outline maneuvering
963 All outline functions which directly do string matches to assess
964 headings set the variables outline-recent-prefix-beginning and
965 outline-recent-prefix-end if successful. This function uses those settings
966 to return the current depth."
969 (- outline-recent-prefix-end
970 outline-recent-prefix-beginning
971 outline-header-subtraction
)))
972 ;;;_ > outline-recent-prefix ()
973 (defun outline-recent-prefix ()
974 " Like outline-recent-depth, but returns text of last encountered prefix.
976 All outline functions which directly do string matches to assess
977 headings set the variables outline-recent-prefix-beginning and
978 outline-recent-prefix-end if successful. This function uses those settings
979 to return the current depth."
980 (buffer-substring outline-recent-prefix-beginning outline-recent-prefix-end
))
981 ;;;_ > outline-recent-bullet ()
982 (defun outline-recent-bullet ()
983 " Like outline-recent-prefix, but returns bullet of last encountered
986 All outline functions which directly do string matches to assess
987 headings set the variables outline-recent-prefix-beginning and
988 outline-recent-prefix-end if successful. This function uses those settings
989 to return the current depth of the most recently matched topic."
990 (buffer-substring (1- outline-recent-prefix-end
) outline-recent-prefix-end
))
992 ;;;_ . Active position evaluation - if you can't use the residual state.
993 ;;;_ > outline-on-current-heading-p ()
994 (defun outline-on-current-heading-p ()
995 " Return prefix beginning point if point is on same line as current
996 visible topic's header line."
999 (and (looking-at outline-regexp
)
1000 (setq outline-recent-prefix-end
(match-end 0)
1001 outline-recent-prefix-beginning
(match-beginning 0)))))
1002 ;;;_ > outline-hidden-p ()
1003 (defun outline-hidden-p ()
1004 "True if point is in hidden text."
1007 (and (re-search-backward "[\C-j\C-m]" (point-min) t
)
1008 (looking-at "\C-m"))))
1009 ;;;_ > outline-current-depth ()
1010 (defun outline-current-depth ()
1011 " Return the depth to which the current containing visible topic is
1012 nested in the outline."
1014 (if (outline-back-to-current-heading)
1016 (- outline-recent-prefix-end
1017 outline-recent-prefix-beginning
1018 outline-header-subtraction
))
1020 ;;;_ > outline-depth ()
1021 (defun outline-depth ()
1022 " Like outline-current-depth, but respects hidden as well as visible
1025 (if (outline-goto-prefix)
1026 (outline-recent-depth)
1028 (setq outline-recent-prefix-end
(point)
1029 outline-recent-prefix-beginning
(point))
1031 ;;;_ > outline-get-current-prefix ()
1032 (defun outline-get-current-prefix ()
1033 " Topic prefix of the current topic."
1035 (if (outline-goto-prefix)
1036 (outline-recent-prefix))))
1037 ;;;_ > outline-get-bullet ()
1038 (defun outline-get-bullet ()
1039 " Return bullet of containing topic (visible or not)."
1041 (and (outline-goto-prefix)
1042 (outline-recent-bullet))))
1043 ;;;_ > outline-current-bullet ()
1044 (defun outline-current-bullet ()
1045 " Return bullet of current (visible) topic heading, or none if none found."
1048 (outline-back-to-current-heading)
1049 (buffer-substring (- outline-recent-prefix-end
1)
1050 outline-recent-prefix-end
))
1051 ;; Quick and dirty provision, ostensibly for missing bullet:
1052 (args-out-of-range nil
))
1054 ;;;_ > outline-get-prefix-bullet (prefix)
1055 (defun outline-get-prefix-bullet (prefix)
1056 " Return the bullet of the header prefix string PREFIX."
1057 ;; Doesn't make sense if we're old-style prefixes, but this just
1058 ;; oughtn't be called then, so forget about it...
1059 (if (string-match outline-regexp prefix
)
1060 (substring prefix
(1- (match-end 0)) (match-end 0))))
1063 ;;;_ > outline-goto-prefix ()
1064 (defun outline-goto-prefix ()
1065 " Put point at beginning of outline prefix for current topic, visible
1068 Returns a list of char address of the beginning of the prefix and the
1069 end of it, or nil if none."
1071 (cond ((and (or (save-excursion (beginning-of-line) (bobp))
1072 (memq (preceding-char) '(?
\n ?\^M
)))
1073 (looking-at outline-regexp
))
1074 (setq outline-recent-prefix-end
(match-end 0)
1075 outline-recent-prefix-beginning
1076 (goto-char (match-beginning 0))))
1077 ((re-search-backward outline-line-boundary-regexp
1078 ;; unbounded search,
1079 ;; stay at limit and return nil if failed:
1081 (setq outline-recent-prefix-end
(match-end 2)
1082 outline-recent-prefix-beginning
1083 (goto-char (match-beginning 2))))
1084 ;; We should be at the beginning of the buffer if the last
1085 ;; condition failed. line-boundary-regexp doesn't cover topic
1086 ;; at bob - Check for it.
1087 ((looking-at outline-regexp
)
1088 (setq outline-recent-prefix-end
(match-end 0)
1089 outline-recent-prefix-beginning
1090 (goto-char (match-beginning 0)))))
1092 ;;;_ > outline-end-of-prefix ()
1093 (defun outline-end-of-prefix ()
1094 " Position cursor at beginning of header text."
1095 (if (not (outline-goto-prefix))
1097 (let ((match-data (match-data)))
1098 (goto-char (match-end 0))
1099 (while (looking-at "[0-9]") (forward-char 1))
1100 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))
1101 (store-match-data match-data
))
1102 ;; Reestablish where we are:
1103 (outline-current-depth))
1105 ;;;_ > outline-back-to-current-heading ()
1106 (defun outline-back-to-current-heading ()
1107 " Move to heading line of current visible topic, or beginning of heading
1108 if already on visible heading line."
1110 (prog1 (or (outline-on-current-heading-p)
1111 (and (re-search-backward (concat "^\\(" outline-regexp
"\\)")
1114 (setq outline-recent-prefix-end
(match-end 1)
1115 outline-recent-prefix-beginning
(match-beginning 1))))
1116 (if (interactive-p) (outline-end-of-prefix))
1119 ;;;_ > outline-pre-next-preface ()
1120 (defun outline-pre-next-preface ()
1121 "Skip forward to just before the next heading line.
1123 Returns that character position."
1125 (if (re-search-forward outline-line-boundary-regexp nil
'move
)
1126 (progn (goto-char (match-beginning 0))
1127 (setq outline-recent-prefix-end
(match-end 2)
1128 outline-recent-prefix-beginning
(match-beginning 2))))
1130 ;;;_ > outline-end-of-current-subtree ()
1131 (defun outline-end-of-current-subtree ()
1132 " Put point at the end of the last leaf in the currently visible topic."
1134 (outline-back-to-current-heading)
1135 (let ((opoint (point))
1136 (level (outline-recent-depth)))
1137 (outline-next-heading)
1138 (while (and (not (eobp))
1139 (> (outline-recent-depth) level
))
1140 (outline-next-heading))
1141 (if (not (eobp)) (forward-char -
1))
1142 (if (memq (preceding-char) '(?
\n ?\^M
)) (forward-char -
1))))
1143 ;;;_ > outline-beginning-of-current-entry ()
1144 (defun outline-beginning-of-current-entry ()
1145 " Position the point at the beginning of the body of the current topic."
1147 (outline-end-of-prefix))
1148 ;;;_ > outline-beginning-of-current-entry ()
1149 (defun outline-end-of-current-entry ()
1150 " Position the point at the end of the current topic's entry."
1152 (outline-show-entry)
1153 (prog1 (outline-pre-next-preface)
1154 (if (and (not (bobp))(looking-at "^$"))
1159 ;;;_ > outline-ascend-to-depth (depth)
1160 (defun outline-ascend-to-depth (depth)
1161 " Ascend to depth DEPTH, returning depth if successful, nil if not."
1162 (if (and (> depth
0)(<= depth
(outline-depth)))
1163 (let ((last-good (point)))
1164 (while (and (< depth
(outline-depth))
1165 (setq last-good
(point))
1166 (outline-beginning-of-level)
1167 (outline-previous-heading)))
1168 (if (= (outline-recent-depth) depth
)
1169 (progn (goto-char outline-recent-prefix-beginning
)
1171 (goto-char last-good
)
1173 (if (interactive-p) (outline-end-of-prefix))
1176 ;;;_ > outline-descend-to-depth (depth)
1177 (defun outline-descend-to-depth (depth)
1178 " Descend to depth DEPTH within current topic, returning depth if
1179 successful, nil if not."
1180 (let ((start-point (point))
1181 (start-depth (outline-depth)))
1183 (and (> (outline-depth) 0)
1184 (not (= depth
(outline-recent-depth))) ; ... not there yet
1185 (outline-next-heading) ; ... go further
1186 (< start-depth
(outline-recent-depth)))) ; ... still in topic
1187 (if (and (> (outline-depth) 0)
1188 (= (outline-recent-depth) depth
))
1190 (goto-char start-point
)
1193 ;;;_ > outline-up-current-level (arg &optional dont-complain)
1194 (defun outline-up-current-level (arg &optional dont-complain
)
1195 " Move to the heading line of which the present line is a subheading.
1196 With argument, move up ARG levels. Don't return an error if
1197 second, optional argument DONT-COMPLAIN, is non-nil."
1199 (outline-back-to-current-heading)
1200 (let ((present-level (outline-recent-depth)))
1201 ;; Loop for iterating arg:
1202 (while (and (> (outline-recent-depth) 1)
1205 ;; Loop for going back over current or greater depth:
1206 (while (and (not (< (outline-recent-depth) present-level
))
1207 (outline-previous-visible-heading 1)))
1208 (setq present-level
(outline-current-depth))
1209 (setq arg
(- arg
1)))
1211 (prog1 (if (<= arg
0)
1212 outline-recent-prefix-beginning
1213 (if (interactive-p) (outline-end-of-prefix))
1214 (if (not dont-complain
)
1215 (error "Can't ascend past outermost level.")))
1216 (if (interactive-p) (outline-end-of-prefix)))
1220 ;;;_ > outline-next-visible-heading (arg)
1221 (defun outline-next-visible-heading (arg)
1222 " Move to the next visible heading line.
1224 With argument, repeats, backward if negative."
1226 (if (< arg
0) (beginning-of-line) (end-of-line))
1227 (if (re-search-forward (concat "^\\(" outline-regexp
"\\)")
1231 (progn (outline-end-of-prefix)
1232 (setq outline-recent-prefix-end
(match-end 1)
1233 outline-recent-prefix-beginning
(match-beginning 1))))
1235 ;;;_ > outline-previous-visible-heading (arg)
1236 (defun outline-previous-visible-heading (arg)
1237 " Move to the previous heading line.
1239 With argument, repeats or can move forward if negative.
1240 A heading line is one that starts with a `*' (or that outline-regexp
1243 (outline-next-visible-heading (- arg
))
1245 ;;;_ > outline-next-heading (&optional backward)
1246 (defun outline-next-heading (&optional backward
)
1247 " Move to the heading for the topic (possibly invisible) before this one.
1249 Optional arg BACKWARD means search for most recent prior heading.
1251 Returns the location of the heading, or nil if none found."
1253 (if (and backward
(bobp))
1255 (if backward
(outline-goto-prefix)
1256 (if (and (bobp) (not (eobp)))
1260 ;; searches are unbounded and return nil if failed:
1261 (or (re-search-backward outline-line-boundary-regexp
1264 (looking-at outline-bob-regexp
))
1265 (re-search-forward outline-line-boundary-regexp
1268 (progn;; Got some valid location state - set vars:
1269 (setq outline-recent-prefix-end
1270 (or (match-end 2) outline-recent-prefix-end
))
1271 (goto-char (setq outline-recent-prefix-beginning
1272 (or (match-beginning 2)
1273 outline-recent-prefix-beginning
))))
1277 ;;;_ > outline-previous-heading ()
1278 (defun outline-previous-heading ()
1279 " Move to the next (possibly invisible) heading line.
1281 Optional repeat-count arg means go that number of headings.
1283 Return the location of the beginning of the heading, or nil if not found."
1285 (outline-next-heading t
)
1287 ;;;_ > outline-next-sibling (&optional backward)
1288 (defun outline-next-sibling (&optional backward
)
1289 " Like outline-forward-current-level, but respects invisible topics.
1291 Go backward if optional arg BACKWARD is non-nil.
1293 Return depth if successful, nil otherwise."
1295 (if (and backward
(bobp))
1297 (let ((start-depth (outline-depth))
1298 (start-point (point))
1300 (while (and (not (if backward
(bobp) (eobp)))
1301 (if backward
(outline-previous-heading)
1302 (outline-next-heading))
1303 (> (outline-recent-depth) start-depth
)))
1304 (if (and (not (eobp))
1305 (and (> (outline-depth) 0)
1306 (= (outline-recent-depth) start-depth
)))
1307 outline-recent-prefix-beginning
1308 (goto-char start-point
)
1313 ;;;_ > outline-previous-sibling (&optional arg)
1314 (defun outline-previous-sibling (&optional arg
)
1315 " Like outline-forward-current-level, but goes backwards and respects
1318 Optional repeat count means go number backward.
1320 Note that the beginning of a level is (currently) defined by this
1321 implementation to be the first of previous successor topics of
1322 equal or greater depth.
1324 Return depth if successful, nil otherwise."
1325 (outline-next-sibling t
)
1327 ;;;_ > outline-beginning-of-level ()
1328 (defun outline-beginning-of-level ()
1329 " Go back to the first sibling at this level, visible or not."
1330 (outline-end-of-level 'backward
))
1331 ;;;_ > outline-end-of-level (&optional backward)
1332 (defun outline-end-of-level (&optional backward
)
1333 " Go to the last sibling at this level, visible or not."
1335 (while (outline-previous-sibling))
1336 (prog1 (outline-recent-depth)
1337 (if (interactive-p) (outline-end-of-prefix)))
1339 ;;;_ > outline-forward-current-level (arg &optional backward)
1340 (defun outline-forward-current-level (arg &optional backward
)
1341 " Position the point at the next heading of the same level, taking
1342 optional repeat-count.
1344 Returns that position, else nil if is not found."
1346 (outline-back-to-current-heading)
1347 (let ((amt (if arg
(if (< arg
0)
1348 ;; Negative arg - invert direction.
1349 (progn (setq backward
(not backward
))
1351 arg
);; Positive arg - just use it.
1352 1)));; No arg - use 1:
1353 (while (and (> amt
0)
1354 (outline-next-sibling backward
))
1355 (setq amt
(1- amt
)))
1356 (if (interactive-p) (outline-end-of-prefix))
1358 (error "This is the %s topic on level %d."
1359 (if backward
"first" "last")
1360 (outline-current-depth))
1364 ;;;_ > outline-backward-current-level (arg)
1365 (defun outline-backward-current-level (arg)
1366 " Position the point at the previous heading of the same level, taking
1367 optional repeat-count.
1369 Returns that position, else nil if is not found."
1372 (outline-forward-current-level arg t
)
1373 (outline-end-of-prefix))
1376 ;;;_ : Search with Dynamic Exposure (requires isearch-mode)
1377 ;;;_ = outline-search-reconceal
1378 (defvar outline-search-reconceal nil
1379 "Used for outline isearch provisions, to track whether current search
1380 match was concealed outside of search. The value is the location of the
1381 match, if it was concealed, regular if the entire topic was concealed, in
1382 a list if the entry was concealed.")
1383 ;;;_ = outline-search-quitting
1384 (defconst outline-search-quitting nil
1385 "Variable used by isearch-terminate/outline-provisions and
1386 isearch-done/outline-provisions to distinguish between a conclusion
1387 and cancellation of a search.")
1389 ;;;_ > outline-enwrap-isearch ()
1390 (defun outline-enwrap-isearch ()
1391 " Impose isearch-mode wrappers so isearch progressively exposes and
1392 reconceals hidden topics when working in outline mode, but works
1395 The function checks to ensure that the rebindings are done only once."
1397 ; Should isearch-mode be employed,
1398 (if (or (not outline-enwrap-isearch-mode
)
1399 ; or are preparations already done?
1400 (fboundp 'real-isearch-terminate
))
1402 ;; ... no - skip this all:
1407 ; Ensure load of isearch-mode:
1408 (if (or (and (fboundp 'isearch-mode
)
1409 (fboundp 'isearch-quote-char
))
1410 (condition-case error
1411 (load-library outline-enwrap-isearch-mode
)
1412 (file-error (message "Skipping isearch-mode provisions - %s '%s'"
1414 (car (cdr (cdr error
))))
1416 ;; Inhibit subsequent tries and return nil:
1417 (setq outline-enwrap-isearch-mode nil
))))
1418 ;; Isearch-mode loaded, encapsulate specific entry points for
1419 ;; outline dynamic-exposure business:
1422 ; stash crucial isearch-mode
1423 ; funcs under known, private
1424 ; names, then register wrapper
1425 ; functions under the old
1426 ; names, in their stead:
1427 ; 'isearch-quit' is pre v 1.2:
1428 (fset 'real-isearch-terminate
1429 ; 'isearch-quit is pre v 1.2:
1430 (or (if (fboundp 'isearch-quit
)
1431 (symbol-function 'isearch-quit
))
1432 (if (fboundp 'isearch-abort
)
1433 ; 'isearch-abort' is v 1.2 and on:
1434 (symbol-function 'isearch-abort
))))
1435 (fset 'isearch-quit
'isearch-terminate
/outline-provisions
)
1436 (fset 'isearch-abort
'isearch-terminate
/outline-provisions
)
1437 (fset 'real-isearch-done
(symbol-function 'isearch-done
))
1438 (fset 'isearch-done
'isearch-done
/outline-provisions
)
1439 (fset 'real-isearch-update
(symbol-function 'isearch-update
))
1440 (fset 'isearch-update
'isearch-update
/outline-provisions
)
1441 (make-variable-buffer-local 'outline-search-reconceal
))
1445 ;;;_ > outline-isearch-arrival-business ()
1446 (defun outline-isearch-arrival-business ()
1447 " Do outline business like exposing current point, if necessary,
1448 registering reconcealment requirements in outline-search-reconceal
1451 Set outline-search-reconceal to nil if current point is not
1452 concealed, to value of point if entire topic is concealed, and a
1453 list containing point if only the topic body is concealed.
1455 This will be used to determine whether outline-hide-current-entry
1456 or outline-hide-current-entry-completely will be necessary to
1457 restore the prior concealment state."
1459 (if (and (boundp 'outline-mode
) outline-mode
)
1460 (setq outline-search-reconceal
1461 (if (outline-hidden-p)
1463 (if (re-search-backward outline-line-boundary-regexp nil
1)
1464 ;; Nil value means we got to b-o-b - wouldn't need
1467 ; We'll return point or list
1468 ; containing point, depending
1469 ; on concealment state of
1471 (prog1 (if (outline-hidden-p) (point) (list (point)))
1472 ; And reveal the current
1474 (outline-show-entry)))))))
1475 ;;;_ > outline-isearch-advancing-business ()
1476 (defun outline-isearch-advancing-business ()
1477 " Do outline business like deexposing current point, if necessary,
1478 according to reconceal state registration."
1479 (if (and (boundp 'outline-mode
) outline-mode outline-search-reconceal
)
1481 (if (listp outline-search-reconceal
)
1482 ;; Leave the topic visible:
1483 (progn (goto-char (car outline-search-reconceal
))
1484 (outline-hide-current-entry))
1485 ;; Rehide the entire topic:
1486 (goto-char outline-search-reconceal
)
1487 (outline-hide-current-entry-completely))))
1489 ;;;_ > isearch-terminate/outline-provisions ()
1490 (defun isearch-terminate/outline-provisions
()
1492 (if (and (boundp 'outline-mode
)
1494 outline-enwrap-isearch-mode
)
1495 (outline-isearch-advancing-business))
1496 (let ((outline-search-quitting t
)
1497 (outline-search-reconceal nil
))
1498 (real-isearch-terminate)))
1499 ;;;_ > isearch-done/outline-provisions ()
1500 (defun isearch-done/outline-provisions
(&optional nopush
)
1502 (if (and (boundp 'outline-mode
)
1504 outline-enwrap-isearch-mode
)
1505 (progn (save-excursion
1506 (if (and outline-search-reconceal
1507 (not (listp outline-search-reconceal
)))
1508 ;; The topic was concealed - reveal it, its siblings,
1509 ;; and any ancestors that are still concealed:
1511 (message "(exposing destination)")(sit-for 0)
1512 ;; Ensure target topic's siblings are exposed:
1513 (outline-ascend-to-depth (1- (outline-current-depth)))
1514 ;; Ensure that the target topic's ancestors are exposed
1515 (while (outline-hidden-p)
1516 (outline-show-current-children))
1517 (outline-show-current-children)
1518 (outline-show-current-entry)))
1519 (outline-isearch-arrival-business))
1520 (if (not (and (boundp 'outline-search-quitting
)
1521 outline-search-quitting
))
1522 (outline-show-current-children))))
1524 ;; isearch-done in newer version of isearch mode takes arg:
1525 (real-isearch-done nopush
)
1526 (real-isearch-done)))
1527 ;;;_ > isearch-update/outline-provisions ()
1528 (defun isearch-update/outline-provisions
()
1529 " Wrapper around isearch which exposes and conceals hidden outline
1530 portions encountered in the course of searching."
1531 (if (not (and (boundp 'outline-mode
)
1533 outline-enwrap-isearch-mode
))
1534 ;; Just do the plain business:
1535 (real-isearch-update)
1537 ;; Ah - provide for outline conditions:
1538 (outline-isearch-advancing-business)
1539 (real-isearch-update)
1540 (cond (isearch-success (outline-isearch-arrival-business))
1541 ((not isearch-success
) (outline-isearch-advancing-business)))
1545 ;;;_ #5 Manipulation
1547 ;;;_ : Topic Format Assessment
1548 ;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet)
1549 (defun outline-solicit-alternate-bullet (depth &optional current-bullet
)
1551 " Prompt for and return a bullet char as an alternative to the
1552 current one, but offer one suitable for current depth DEPTH
1555 (let* ((default-bullet (or current-bullet
1556 (outline-bullet-for-depth depth
)))
1557 (choice (solicit-char-in-string
1558 (format "Select bullet: %s ('%s' default): "
1559 outline-bullets-string
1561 (string-sans-char outline-bullets-string ?
\\)
1563 (if (string= choice
"") default-bullet choice
))
1565 ;;;_ > outline-sibling-index (&optional depth)
1566 (defun outline-sibling-index (&optional depth
)
1567 " Item number of this prospective topic among it's siblings.
1569 If optional arg depth is greater than current depth, then we're
1570 opening a new level, and return 0.
1572 If less than this depth, ascend to that depth and count..."
1575 (cond ((and depth
(<= depth
0) 0))
1576 ((or (not depth
) (= depth
(outline-depth)))
1578 (while (outline-previous-sibling) (setq index
(1+ index
)))
1580 ((< depth
(outline-recent-depth))
1581 (outline-ascend-to-depth depth
)
1582 (outline-sibling-index))
1584 ;;;_ > outline-distinctive-bullet (bullet)
1585 (defun outline-distinctive-bullet (bullet)
1586 " True if bullet is one of those on outline-distinctive-bullets-string."
1587 (string-match (regexp-quote bullet
) outline-distinctive-bullets-string
))
1588 ;;;_ > outline-numbered-type-prefix (&optional prefix)
1589 (defun outline-numbered-type-prefix (&optional prefix
)
1590 " True if current header prefix bullet is numbered bullet."
1591 (and outline-numbered-bullet
1592 (string= outline-numbered-bullet
1594 (outline-get-prefix-bullet prefix
)
1595 (outline-get-bullet)))))
1596 ;;;_ > outline-bullet-for-depth (&optional depth)
1597 (defun outline-bullet-for-depth (&optional depth
)
1598 " Return outline topic bullet suited to DEPTH, or for current depth if none
1600 ;; Find bullet in plain-bullets-string modulo DEPTH.
1601 (if outline-stylish-prefixes
1602 (char-to-string (aref outline-plain-bullets-string
1603 (%
(max 0 (- depth
2))
1604 outline-plain-bullets-string-len
)))
1605 outline-primary-bullet
)
1608 ;;;_ : Topic Production
1609 ;;;_ > outline-make-topic-prefix (&optional prior-bullet
1610 (defun outline-make-topic-prefix (&optional prior-bullet
1616 ;; Depth null means use current depth, non-null means we're either
1617 ;; opening a new topic after current topic, lower or higher, or we're
1618 ;; changing level of current topic.
1619 ;; Solicit dominates specified bullet-char.
1620 " Generate a topic prefix suitable for optional arg DEPTH, or current
1621 depth if not specified.
1623 All the arguments are optional.
1625 PRIOR-BULLET indicates the bullet of the prefix being changed, or
1626 nil if none. This bullet may be preserved (other options
1627 notwithstanding) if it is on the outline-distinctive-bullets-string,
1630 Second arg NEW indicates that a new topic is being opened after the
1631 topic at point, if non-nil. Default bullet for new topics, eg, may
1632 be set (contingent to other args) to numbered bullets if previous
1633 sibling is one. The implication otherwise is that the current topic
1634 is being adjusted - shifted or rebulleted - and we don't consider
1635 bullet or previous sibling.
1637 Third arg DEPTH forces the topic prefix to that depth, regardless of
1638 the current topics' depth.
1640 Fourth arg SOLICIT non-nil provokes solicitation from the user of a
1641 choice among the valid bullets. (This overrides other all the
1642 options, including, eg, a distinctive PRIOR-BULLET.)
1644 Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet'
1645 is non-nil *and* soliciting was not explicitly invoked. Then
1646 NUMBER-CONTROL non-nil forces prefix to either numbered or
1647 denumbered format, depending on the value of the sixth arg, INDEX.
1649 (Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...)
1651 If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then
1652 the prefix of the topic is forced to be numbered. Non-nil
1653 NUMBER-CONTROL and nil INDEX forces non-numbered format on the
1654 bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means
1655 that the index for the numbered prefix will be derived, by counting
1656 siblings back to start of level. If INDEX is a number, then that
1657 number is used as the index for the numbered prefix (allowing, eg,
1658 sequential renumbering to not require this function counting back the
1659 index for each successive sibling)."
1661 ;; The options are ordered in likely frequence of use, most common
1662 ;; highest, least lowest. Ie, more likely to be doing prefix
1663 ;; adjustments than soliciting, and yet more than numbering.
1664 ;; Current prefix is least dominant, but most likely to be commonly
1670 (depth (or depth
(outline-depth)))
1671 (header-lead outline-header-prefix
)
1674 ;; Getting value for bullet char is practically the whole job:
1677 ; Simplest situation - level 1:
1678 ((<= depth
1) (setq header-lead
"") outline-primary-bullet
)
1679 ; Simple, too: all asterisks:
1680 (outline-old-style-prefixes
1681 ;; Cheat - make body the whole thing, null out header-lead and
1683 (setq body
(make-string depth
1684 (string-to-char outline-primary-bullet
)))
1685 (setq header-lead
"")
1688 ;; (Neither level 1 nor old-style, so we're space padding.
1689 ;; Sneak it in the condition of the next case, whatever it is.)
1691 ;; Solicitation overrides numbering and other cases:
1692 ((progn (setq body
(make-string (- depth
2) ?\
))
1693 ;; The actual condition:
1695 (let* ((got (outline-solicit-alternate-bullet depth
)))
1696 ;; Gotta check whether we're numbering and got a numbered bullet:
1697 (setq numbering
(and outline-numbered-bullet
1698 (not (and number-control
(not index
)))
1699 (string= got outline-numbered-bullet
)))
1700 ;; Now return what we got, regardless:
1703 ;; Numbering invoked through args:
1704 ((and outline-numbered-bullet number-control
)
1705 (if (setq numbering
(not (setq denumbering
(not index
))))
1706 outline-numbered-bullet
1707 (if (and current-bullet
1708 (not (string= outline-numbered-bullet
1711 (outline-bullet-for-depth depth
))))
1713 ;;; Neither soliciting nor controlled numbering ;;;
1714 ;;; (may be controlled denumbering, tho) ;;;
1716 ;; Check wrt previous sibling:
1717 ((and new
; only check for new prefixes
1718 (<= depth
(outline-depth))
1719 outline-numbered-bullet
; ... & numbering enabled
1721 (let ((sibling-bullet
1723 ;; Locate correct sibling:
1724 (or (>= depth
(outline-depth))
1725 (outline-ascend-to-depth depth
))
1726 (outline-get-bullet))))
1727 (if (and sibling-bullet
1728 (string= outline-numbered-bullet sibling-bullet
))
1729 (setq numbering sibling-bullet
)))))
1731 ;; Distinctive prior bullet?
1733 (outline-distinctive-bullet prior-bullet
)
1734 ;; Either non-numbered:
1735 (or (not (and outline-numbered-bullet
1736 (string= prior-bullet outline-numbered-bullet
)))
1737 ;; or numbered, and not denumbering:
1738 (setq numbering
(not denumbering
)))
1742 ;; Else, standard bullet per depth:
1743 ((outline-bullet-for-depth depth
)))))
1749 (format "%d" (cond ((and index
(numberp index
)) index
)
1750 (new (1+ (outline-sibling-index depth
)))
1751 ((outline-sibling-index))))))
1754 ;;;_ > open-topic (relative-depth &optional before)
1755 (defun open-topic (relative-depth &optional before
)
1756 " Open a new topic at depth DEPTH. New topic is situated after current
1757 one, unless optional flag BEFORE is non-nil, or unless current line
1758 is complete empty (not even whitespace), in which case open is done
1763 - Creation of new topics is with respect to the visible topic
1764 containing the cursor, regardless of intervening concealed ones.
1766 - New headers are generally created after/before the body of a
1767 topic. However, they are created right at cursor location if the
1768 cursor is on a blank line, even if that breaks the current topic
1769 body. This is intentional, to provide a simple means for
1770 deliberately dividing topic bodies.
1772 - Double spacing of topic lists is preserved. Also, the first
1773 level two topic is created double-spaced (and so would be
1774 subsequent siblings, if that's left intact). Otherwise,
1775 single-spacing is used.
1777 - Creation of sibling or nested topics is with respect to the topic
1778 you're starting from, even when creating backwards. This way you
1779 can easily create a sibling in front of the current topic without
1780 having to go to its preceding sibling, and then open forward
1783 (let* ((depth (+ (outline-current-depth) relative-depth
))
1784 (opening-on-blank (if (looking-at "^\$")
1785 (not (setq before nil
))))
1786 opening-numbered
; Will get while computing ref-topic, below
1787 ref-depth
; Will get while computing ref-topic, next
1788 (ref-topic (save-excursion
1789 (cond ((< relative-depth
0)
1790 (outline-ascend-to-depth depth
))
1791 ((>= relative-depth
1) nil
)
1792 (t (outline-back-to-current-heading)))
1793 (setq ref-depth
(outline-recent-depth))
1794 (setq opening-numbered
1796 (and outline-numbered-bullet
1797 (or (<= relative-depth
0)
1798 (outline-descend-to-depth depth
))
1799 (if (outline-numbered-type-prefix)
1800 outline-numbered-bullet
))))
1806 (if (not opening-on-blank
)
1807 ; Positioning and vertical
1808 ; padding - only if not
1811 (goto-char ref-topic
)
1812 (setq dbl-space
; Determine double space action:
1813 (or (and (not (> relative-depth
0))
1816 ;; preceded by a blank line?
1818 (looking-at "^\\s-*$")))
1819 (and (= ref-depth
1)
1823 ;; Don't already have following
1824 ;; vertical padding:
1825 (not (outline-pre-next-preface)))))))
1827 ; Position to prior heading,
1828 ; if inserting backwards:
1829 (if before
(progn (outline-back-to-current-heading)
1830 (setq doing-beginning
(bobp))
1831 (if (and (not (outline-previous-sibling))
1833 (outline-previous-heading))))
1835 (if (and (<= depth ref-depth
)
1836 (= ref-depth
(outline-current-depth)))
1837 ;; Not going inwards, don't snug up:
1839 (open-line (if dbl-space
2 1))
1840 (outline-end-of-current-subtree))
1841 ;; Going inwards - double-space if first offspring is,
1842 ;; otherwise snug up.
1843 (end-of-line) ; So we skip any concealed progeny.
1844 (outline-pre-next-preface)
1846 ;; Blank lines between current header body and next
1847 ;; header - get to last substantive (non-white-space)
1849 (re-search-backward "[^ \t\n]" nil t
))
1851 (outline-next-heading)
1852 (if (> (outline-recent-depth) ref-depth
)
1853 ;; This is an offspring.
1854 (progn (forward-line -
1)
1855 (looking-at "^\\s-*$"))))
1856 (progn (forward-line 1)
1859 ;;(if doing-beginning (goto-char doing-beginning))
1860 (if (not (bobp)) (newline (if dbl-space
2 1)))
1862 (insert-string (concat (outline-make-topic-prefix opening-numbered
1867 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1))))
1870 (outline-rebullet-heading nil
;;; solicit
1872 nil
;;; number-control
1877 ;;;_ > open-subtopic (arg)
1878 (defun open-subtopic (arg)
1879 " Open new topic header at deeper level than the current one.
1881 Negative universal arg means to open deeper, but place the new topic
1882 prior to the current one."
1884 (open-topic 1 (> 0 arg
)))
1885 ;;;_ > open-sibtopic (arg)
1886 (defun open-sibtopic (arg)
1887 " Open new topic header at same level as the current one. Negative
1888 universal arg means to place the new topic prior to the current
1891 (open-topic 0 (> 0 arg
)))
1892 ;;;_ > open-supertopic (arg)
1893 (defun open-supertopic (arg)
1894 " Open new topic header at shallower level than the current one.
1895 Negative universal arg means to open shallower, but place the new
1896 topic prior to the current one."
1899 (open-topic -
1 (> 0 arg
)))
1901 ;;;_ : Outline Alteration
1902 ;;;_ . Topic Form Modification
1903 ;;;_ > outline-reindent-body (old-depth new-depth)
1904 (defun outline-reindent-body (old-depth new-depth
)
1905 " Reindent body lines which were indented at old-depth to new-depth.
1907 Note that refill of indented paragraphs is not done, and tabs are
1908 not accommodated. ('untabify' your outline if you want to preserve
1909 hanging body indents.)"
1913 (outline-goto-prefix)
1915 (let* ((old-spaces-expr (make-string (1+ old-depth
) ?\
))
1916 (new-spaces-expr (concat (make-string (1+ new-depth
) ?\
)
1917 ;; spaces followed by non-space:
1919 (while (and (re-search-forward "[\C-j\C-m]" nil t
)
1920 (not (looking-at outline-regexp
)))
1921 (if (looking-at old-spaces-expr
)
1922 (replace-match new-spaces-expr
)))))))
1923 ;;;_ > outline-rebullet-current-heading (arg)
1924 (defun outline-rebullet-current-heading (arg)
1925 " Like non-interactive version 'outline-rebullet-heading', but work on
1926 (only) visible heading containing point.
1928 With repeat count, solicit for bullet."
1930 (save-excursion (outline-back-to-current-heading)
1931 (outline-end-of-prefix)
1932 (outline-rebullet-heading (not arg
) ;;; solicit
1934 nil
;;; number-control
1936 t
) ;;; do-successors
1939 ;;;_ > outline-rebullet-heading (&optional solicit ...)
1940 (defvar current-bullet nil
1941 "Variable local to outline-rebullet-heading,but referenced by
1942 outline-make-topic-prefix, also. Should be resolved with explicitly
1943 parameterized communication between the two, if suitable.")
1944 (defun outline-rebullet-heading (&optional solicit
1950 " Adjust bullet of current topic prefix.
1952 All args are optional.
1954 If SOLICIT is non-nil then the choice of bullet is solicited from
1955 user. Otherwise the distinctiveness of the bullet or the topic
1956 depth determines it.
1958 Second arg DEPTH forces the topic prefix to that depth, regardless
1959 of the topic's current depth.
1961 Third arg NUMBER-CONTROL can force the prefix to or away from
1962 numbered form. It has effect only if 'outline-numbered-bullet' is
1963 non-nil and soliciting was not explicitly invoked (via first arg).
1964 Its effect, numbering or denumbering, then depends on the setting
1965 of the forth arg, INDEX.
1967 If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the
1968 prefix of the topic is forced to be non-numbered. Null index and
1969 non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
1970 non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
1971 INDEX is a number, then that number is used for the numbered
1972 prefix. Non-nil and non-number means that the index for the
1973 numbered prefix will be derived by outline-make-topic-prefix.
1975 Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
1978 Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes',
1979 and 'outline-numbered-bullet', which all affect the behavior of
1982 (let* ((current-depth (outline-depth))
1983 (new-depth (or new-depth current-depth
))
1984 (mb outline-recent-prefix-beginning
)
1985 (me outline-recent-prefix-end
)
1986 (current-bullet (buffer-substring (- me
1) me
))
1987 (new-prefix (outline-make-topic-prefix current-bullet
1994 ;; Don't need to reinsert identical one:
1995 (if (and (= current-depth new-depth
)
1996 (string= current-bullet
1997 (substring new-prefix
(1- (length new-prefix
)))))
2000 ;; New prefix probably different from old:
2001 ;; get rid of old one:
2002 (delete-region mb me
)
2004 ;; Dispense with number if numbered-bullet prefix:
2005 (if (and outline-numbered-bullet
2006 (string= outline-numbered-bullet current-bullet
)
2007 (looking-at "[0-9]+"))
2008 (delete-region (match-beginning 0)(match-end 0)))
2010 ;; Put in new prefix:
2011 (insert-string new-prefix
)
2014 ;; Reindent the body if elected and depth changed:
2015 (if (and outline-reindent-bodies
2016 (not (= new-depth current-depth
)))
2017 (outline-reindent-body current-depth new-depth
))
2019 ;; Recursively rectify successive siblings if selected:
2022 (while (outline-next-sibling)
2024 (cond ((numberp index
) (1+ index
))
2025 ((not number-control
) (outline-sibling-index))))
2026 (if (outline-numbered-type-prefix)
2027 (outline-rebullet-heading nil
;;; solicit
2028 new-depth
;;; new-depth
2029 number-control
;;; number-control
2031 nil
))))) ;;;(dont!)do-successors
2034 ;;;_ > outline-rebullet-topic (arg)
2035 (defun outline-rebullet-topic (arg)
2036 " Like outline-rebullet-topic-grunt, but start from topic visible at point.
2037 Descends into invisible as well as visible topics, however.
2039 With repeat count, shift topic depth by that amount."
2041 (let ((start-col (current-column))
2045 (cond ((null arg
) (setq arg
0))
2046 ((listp arg
) (setq arg
(car arg
))))
2047 ;; Fill the user in, in case we're shifting a big topic:
2048 (if (not (zerop arg
)) (message "Shifting..."))
2049 (outline-back-to-current-heading)
2050 (if (<= (+ (outline-recent-depth) arg
) 0)
2051 (error "Attempt to shift topic below level 1"))
2052 (outline-rebullet-topic-grunt arg
)
2053 (if (not (zerop arg
)) (message "Shifting... done.")))
2054 (move-to-column (max 0 (+ start-col arg
))))
2056 ;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...)
2057 (defun outline-rebullet-topic-grunt (&optional relative-depth
2063 " Rebullet the topic at point, visible or invisible, and all
2064 contained subtopics. See outline-rebullet-heading for rebulleting
2067 All arguments are optional.
2069 First arg RELATIVE-DEPTH means to shift the depth of the entire
2072 The rest of the args are for internal recursive use by the function
2073 itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX."
2075 (let* ((relative-depth (or relative-depth
0))
2076 (new-depth (outline-depth))
2077 (starting-depth (or starting-depth new-depth
))
2078 (on-starting-call (null starting-point
))
2080 ;; Leave index null on starting call, so rebullet-heading
2081 ;; calculates it at what might be new depth:
2082 (and (or (zerop relative-depth
)
2083 (not on-starting-call
))
2084 (outline-sibling-index))))
2085 (moving-outwards (< 0 relative-depth
))
2086 (starting-point (or starting-point
(point))))
2088 ;; Sanity check for excessive promotion done only on starting call:
2089 (and on-starting-call
2091 (> 0 (+ starting-depth relative-depth
))
2092 (error "Attempt to shift topic out beyond level 1.")) ;;; ====>
2094 (cond ((= starting-depth new-depth
)
2095 ;; We're at depth to work on this one:
2096 (outline-rebullet-heading nil
;;; solicit
2097 (+ starting-depth
;;; starting-depth
2101 ;; Every contained topic will get hit,
2102 ;; and we have to get to outside ones
2104 nil
) ;;; do-successors
2105 ;; ... and work on subsequent ones which are at greater depth:
2107 (outline-next-heading)
2108 (while (and (not (eobp))
2109 (< starting-depth
(outline-recent-depth)))
2110 (setq index
(1+ index
))
2111 (outline-rebullet-topic-grunt relative-depth
;;; relative-depth
2112 (1+ starting-depth
);;;starting-depth
2113 starting-point
;;; starting-point
2116 ((< starting-depth new-depth
)
2117 ;; Rare case - subtopic more than one level deeper than parent.
2118 ;; Treat this one at an even deeper level:
2119 (outline-rebullet-topic-grunt relative-depth
;;; relative-depth
2120 new-depth
;;; starting-depth
2121 starting-point
;;; starting-point
2124 (if on-starting-call
2126 ;; Rectify numbering of former siblings of the adjusted topic,
2127 ;; if topic has changed depth
2128 (if (or do-successors
2129 (and (not (zerop relative-depth
))
2130 (or (= (outline-recent-depth) starting-depth
)
2131 (= (outline-recent-depth) (+ starting-depth
2133 (outline-rebullet-heading nil nil nil nil t
))
2134 ;; Now rectify numbering of new siblings of the adjusted topic,
2135 ;; if depth has been changed:
2136 (progn (goto-char starting-point
)
2137 (if (not (zerop relative-depth
))
2138 (outline-rebullet-heading nil nil nil nil t
)))))
2141 ;;;_ > outline-number-siblings (&optional denumber)
2142 (defun outline-number-siblings (&optional denumber
)
2143 " Assign numbered topic prefix to this topic and its siblings.
2145 With universal argument, denumber - assign default bullet to this
2146 topic and its siblings.
2148 With repeated universal argument (`^U^U'), solicit bullet for each
2149 rebulleting each topic at this level."
2154 (outline-back-to-current-heading)
2155 (outline-beginning-of-level)
2156 (let ((index (if (not denumber
) 1))
2157 (use-bullet (equal '(16) denumber
))
2160 (outline-rebullet-heading use-bullet
;;; solicit
2162 t
;;; number-control
2164 nil
) ;;; do-successors
2165 (if index
(setq index
(1+ index
)))
2166 (setq more
(outline-next-sibling)))
2170 ;;;_ > outline-shift-in (arg)
2171 (defun outline-shift-in (arg)
2172 " Decrease prefix depth of current heading and any topics collapsed
2175 (outline-rebullet-topic arg
))
2176 ;;;_ > outline-shift-out (arg)
2177 (defun outline-shift-out (arg)
2178 " Decrease prefix depth of current heading and any topics collapsed
2181 (outline-rebullet-topic (* arg -
1)))
2182 ;;;_ . Surgery (kill-ring) functions with special provisions for outlines:
2183 ;;;_ > outline-kill-line (&optional arg)
2184 (defun outline-kill-line (&optional arg
)
2185 " Kill line, adjusting subsequent lines suitably for outline mode."
2189 (boundp 'outline-mode
) outline-mode
; active outline mode,
2190 outline-numbered-bullet
; numbers may need adjustment,
2191 (bolp) ; may be clipping topic head,
2192 (looking-at outline-regexp
))) ; are clipping topic head.
2193 ;; Above conditions do not obtain - just do a regular kill:
2195 ;; Ah, have to watch out for adjustments:
2196 (let* ((depth (outline-depth))
2201 (if (not (looking-at outline-regexp
))
2202 (outline-next-heading))
2203 (if (> (outline-depth) depth
)
2204 ;; An intervening parent was removed from after a subtree:
2205 (setq depth
(outline-recent-depth)))
2206 (while (and (> (outline-depth) 0)
2207 (> (outline-recent-depth) ascender
)
2208 (outline-ascend-to-depth (setq ascender
2210 ;; Have to try going forward until we find another at
2212 (if (and outline-numbered-bullet
2213 (outline-descend-to-depth depth
))
2214 (outline-rebullet-heading nil
;;; solicit
2216 nil
;;; number-control
2218 t
) ;;; do-successors
2224 ;;;_ > outline-kill-topic ()
2225 (defun outline-kill-topic ()
2226 " Kill topic together with subtopics."
2228 ;; Some finagling is done to make complex topic kills appear faster
2229 ;; than they actually are. A redisplay is performed immediately
2230 ;; after the region is disposed of, though the renumbering process
2231 ;; has yet to be performed. This means that there may appear to be
2232 ;; a lag *after* the kill has been performed.
2235 (let* ((beg (outline-back-to-current-heading))
2236 (depth (outline-recent-depth)))
2237 (outline-end-of-current-subtree)
2240 (kill-region beg
(point))
2243 (if (and outline-numbered-bullet
2244 (outline-descend-to-depth depth
))
2245 (outline-rebullet-heading nil
;;; solicit
2247 nil
;;; number-control
2249 t
) ;;; do-successors
2254 ;;;_ > outline-yank (&optional arg)
2255 (defun outline-yank (&optional arg
)
2256 " Like regular yank, except does depth adjustment of yanked topics, when:
2258 1 the stuff being yanked starts with a valid outline header prefix, and
2259 2 it is being yanked at the end of a line which consists of only a valid
2262 If these two conditions hold then the depth of the yanked topics
2263 are all adjusted the amount it takes to make the first one at the
2264 depth of the header into which it's being yanked.
2266 The point is left in from of yanked, adjusted topics, rather than
2267 at the end (and vice-versa with the mark). Non-adjusted yanks,
2268 however, (ones that don't qualify for adjustment) are handled
2269 exactly like normal yanks.
2271 Outline-yank-pop is used with outline-yank just as normal yank-pop
2272 is used with normal yank in non-outline buffers."
2275 (setq this-command
'yank
)
2276 (if (not (and (boundp 'outline-mode
) outline-mode
))
2278 ;; Outline irrelevant - just do regular yank:
2281 ;; Outline *is* relevant:
2282 (let ((beginning (point))
2284 established-depth
) ; Depth of the prefix into which we're yanking.
2285 ;; Get current depth and numbering ... Oops, not doing anything
2286 ;; with the number just yet...
2288 (save-excursion (beginning-of-line)
2289 (looking-at outline-regexp
)))
2290 (setq established-depth
(- (match-end 0) (match-beginning 0))))
2292 (exchange-dot-and-mark)
2293 (if (and established-depth
; the established stuff qualifies.
2294 ;; The yanked stuff also qualifies - is topic(s):
2295 (looking-at (concat "\\(" outline-regexp
"\\)")))
2296 ;; Ok, adjust the depth of the yanked stuff. Note that the
2297 ;; stuff may have more than a single root, so we have to
2298 ;; iterate over all the top level ones yanked, and do them in
2299 ;; such a way that the adjustment of one new one won't affect
2300 ;; any of the other new ones. We use the focus of the
2301 ;; narrowed region to successively exclude processed siblings.
2302 (let* ((yanked-beg (match-beginning 1))
2303 (yanked-end (match-end 1))
2304 (yanked-bullet (buffer-substring (1- yanked-end
) yanked-end
))
2305 (yanked-depth (- yanked-end yanked-beg
))
2306 (depth-diff (- established-depth yanked-depth
))
2309 (setq topic-yanked t
)
2312 (narrow-to-region yanked-beg
(mark))
2313 ;; First trim off excessive blank line at end, if any:
2314 (goto-char (point-max))
2315 (if (looking-at "^$") (delete-char -
1))
2316 (goto-char (point-min))
2317 ;; Work backwards, with each shallowest level,
2318 ;; successively excluding the last processed topic
2319 ;; from the narrow region:
2320 (goto-char (point-max))
2322 (outline-back-to-current-heading)
2323 ;; go as high as we can in each bunch:
2324 (while (outline-ascend-to-depth
2325 (1- (outline-depth))))
2327 (outline-rebullet-topic-grunt depth-diff
2330 (if (setq more
(not (bobp)))
2333 (narrow-to-region yanked-beg
(point)))))))
2334 ;; Preserve new bullet if it's a distinctive one, otherwise
2336 (if (string-match yanked-bullet outline-distinctive-bullets-string
)
2337 (delete-region (save-excursion
2341 (delete-region yanked-beg
(+ yanked-beg established-depth
))
2342 ;; and extraneous digits and a space:
2343 (while (looking-at "[0-9]") (delete-char 1))
2344 (if (looking-at " ") (delete-char 1))
2346 (goto-char yanked-beg
)
2348 ;; Not established-depth or looking-at...
2349 (setq topic-yanked
(looking-at outline-regexp
))
2350 (exchange-dot-and-mark))
2351 (if (and topic-yanked outline-numbered-bullet
)
2353 ;; Renumber, in case necessary:
2356 (goto-char beginning
)
2357 (if (outline-goto-prefix)
2358 (outline-rebullet-heading nil
;;; solicit
2359 (outline-depth) ;;; depth
2360 nil
;;; number-control
2362 t
) ;;; do-successors
2370 ;;;_ > outline-yank-pop (&optional arg)
2371 (defun outline-yank-pop (&optional arg
)
2372 " Just like yank-pop, but works like outline-yank when popping
2373 topics just after fresh outline prefixes. Adapts level of popped
2374 stuff to level of fresh prefix."
2377 (if (not (eq last-command
'yank
))
2378 (error "Previous command was not a yank"))
2379 (setq this-command
'yank
)
2380 (delete-region (point) (mark))
2381 (rotate-yank-pointer arg
)
2385 ;;;_ : Specialty bullet functions
2386 ;;;_ . File Cross references
2387 ;;;_ > outline-resolve-xref ()
2388 (defun outline-resolve-xref ()
2389 " Pop to file associated with current heading, if it has an xref bullet
2390 (according to setting of 'outline-file-xref-bullet')."
2392 (if (not outline-file-xref-bullet
)
2394 "outline cross references disabled - no 'outline-file-xref-bullet'")
2395 (if (not (string= (outline-current-bullet) outline-file-xref-bullet
))
2396 (error "current heading lacks cross-reference bullet '%s'"
2397 outline-file-xref-bullet
)
2400 (let* ((text-start outline-recent-prefix-end
)
2401 (heading-end (progn (outline-pre-next-preface)
2403 (goto-char text-start
)
2405 (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t
)
2406 (buffer-substring (match-beginning 1) (match-end 1))))))
2408 (if (not (= (aref file-name
0) ?
:))
2409 (expand-file-name file-name
)
2410 ; A registry-files ref, strip the ':'
2411 ; and try to follow it:
2412 (let ((reg-ref (reference-registered-file
2413 (substring file-name
1) nil t
)))
2414 (if reg-ref
(car (cdr reg-ref
))))))
2415 (if (or (file-exists-p file-name
)
2416 (if (file-writable-p file-name
)
2417 (y-or-n-p (format "%s not there, create one? "
2419 (error "%s not found and can't be created" file-name
)))
2420 (condition-case failure
2421 (find-file-other-window file-name
)
2423 (error "%s not found" file-name
))
2428 ;;;_ > outline-to-entry-end - Unmaintained compatibility - ignore this!
2429 ;-------------------------------------------------------------------
2430 ; Something added solely for use by a "smart menu" package someone got
2431 ; off the net. I have no idea whether this is appropriate code.
2433 (defvar next-entry-exists nil
"Used by outline-to-entry-end, dunno why.")
2434 (defun outline-to-entry-end (&optional include-sub-entries curr-entry-level
)
2435 " Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil.
2436 CURR-ENTRY-LEVEL is an integer representing the length of the current level
2437 string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil,
2438 CURR-ENTRY-LEVEL is not needed."
2439 (while (and (setq next-entry-exists
2440 (re-search-forward outline-regexp nil t
))
2444 (> (outline-depth) curr-entry-level
))))
2445 (if next-entry-exists
2446 (progn (beginning-of-line) (point))
2447 (goto-char (point-max))))
2448 ;;; Outline topic prefix and level adjustment funcs:
2450 ;;;_ #6 miscellaneous
2451 ;;;_ > outline-copy-exposed (&optional workbuf)
2452 (defun outline-copy-exposed (&optional workbuf
)
2453 " Duplicate buffer to other buffer, sans hidden stuff.
2455 Without repeat count, this simple-minded function just generates
2456 the new buffer by concatenating the current buffer name with \"
2457 exposed\", and doing a 'get-buffer' on it."
2460 (if (not workbuf
) (setq workbuf
(concat (buffer-name) " exposed")))
2461 (let ((buf (current-buffer)))
2462 (if (not (get-buffer workbuf
))
2463 (generate-new-buffer workbuf
))
2464 (pop-to-buffer workbuf
)
2467 ;; (replace-regexp "\^M[^\^M\^J]*" "")
2468 (while (re-search-forward "\^M[^\^M\^J]*" nil t
)
2469 (replace-match "" nil nil
))
2470 (goto-char (point-min))
2473 ;;;_ > outlinify-sticky ()
2474 (defun outlinify-sticky (&optional arg
)
2475 " Activate outline mode and establish file eval to set initial exposure.
2477 Invoke with a string argument to designate a string to prepend to
2478 topic prefixs, or with a universal argument to be prompted for the
2479 string to be used. Suitable defaults are provided for lisp,
2480 emacs-lisp, c, c++, awk, sh, csh, and perl modes."
2482 (interactive "P") (outline-mode t
)
2485 ;; Use arg as the header-prefix:
2486 (outline-lead-with-comment-string arg
)
2487 ;; Otherwise, let function solicit string:
2488 (setq arg
(outline-lead-with-comment-string))))
2489 ((member major-mode
'(emacs-lisp-mode lisp-mode
))
2490 (setq arg
(outline-lead-with-comment-string ";;;_")))
2491 ((member major-mode
'(awk-mode csh-mode sh-mode perl-mode
))
2492 ;; Bare '#' (ie, not '#_') so we don't break the magic number:
2493 (setq arg
(outline-lead-with-comment-string "#")))
2494 ((eq major-mode
'c
++-mode
)
2495 (setq arg
(outline-lead-with-comment-string "//_")))
2496 ((eq major-mode
'c-mode
)
2497 ;; User's will have to know to close off the comments:
2498 (setq arg
(outline-lead-with-comment-string "/*_"))))
2499 (let* ((lead-prefix (format "%s%s"
2500 (concat outline-header-prefix
(if arg
" " ""))
2501 outline-primary-bullet
))
2502 (lead-line (format "%s%s %s\n%s %s\n %s %s %s"
2503 (if arg outline-header-prefix
"")
2504 outline-primary-bullet
2506 "'(This topic sets initial outline exposure"
2507 "of the file when loaded by emacs,"
2508 "Encapsulate it in comments if"
2510 "otherwise ignore it,")))
2513 ; Put a topic at the top, if
2514 ; none there already:
2515 (goto-char (point-min))
2516 (if (not (looking-at outline-regexp
))
2518 (if (not arg
) outline-primary-bullet
2519 (format "%s%s\n" outline-header-prefix outline-primary-bullet
))))
2521 ; File-vars stuff, at the bottom:
2522 (goto-char (point-max))
2524 (insert-string (format "\n\n%s\n%s %s %s\n%s %s "
2531 ; Insert outline-mode activation:
2533 (format "%s\n\t\t%s\n\t\t\t%s\n"
2534 "(condition-case err"
2536 "(outline-mode t)"))
2537 ; Conditionally insert prefix
2538 ; leader customization:
2539 (if arg
(insert-string (format "\t\t\t(%s \"%s\")\n"
2540 "outline-lead-with-comment-string"
2542 ; Insert announcement and
2545 (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s"
2546 "(message \"Adjusting '%s' visibility\""
2549 "(outline-exposure -1 0))"
2551 "\"Failed file var 'allout' provisions\")))"))
2553 (insert-string (format "\n%s End: )\n"
2555 ;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
2556 (defun solicit-char-in-string (prompt string
&optional do-defaulting
)
2557 " Solicit (with first arg PROMPT) choice of a character from string STRING.
2559 Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
2561 (let ((new-prompt prompt
)
2565 (message "%s" new-prompt
)
2567 ;; We do our own reading here, so we can circumvent, eg, special
2568 ;; treatment for '?' character. (Might oughta change minibuffer
2569 ;; keymap instead, oh well.)
2571 (char-to-string (let ((cursor-in-echo-area t
)) (read-char))))
2573 (if (null (string-match got string
))
2574 (if (and do-defaulting
(string= got
"\^M"))
2575 ;; We're defaulting, return null string to indicate that:
2577 ;; Failed match and not defaulting,
2578 ;; set the prompt to give feedback,
2579 (setq new-prompt
(concat prompt
2584 ;; and set loop to try again:
2586 ;; Got a match - give feedback:
2588 ;; got something out of loop - return it:
2591 ;;;_ > string-sans-char (string char)
2592 (defun string-sans-char (string char
)
2593 " Return a copy of STRING that lacks all instances of CHAR."
2594 (cond ((string= string
"") "")
2595 ((= (aref string
0) char
) (string-sans-char (substring string
1) char
))
2596 ((concat (substring string
0 1)
2597 (string-sans-char (substring string
1) char
)))))
2599 ;;;_* Local emacs vars.
2602 eval
: (save-excursion
2603 (if (not (condition-case err
(outline-mode t
)
2604 (wrong-number-of-arguments nil
)))
2607 "Allout outline-mode not loaded, not adjusting buffer exposure")
2609 (message "Adjusting '%s' visibility" (buffer-name))
2610 (outline-lead-with-comment-string ";;;_")
2612 (outline-exposure (-1 () () () 1) 0)))