(Fcompute_motion): Doc fix.
[emacs.git] / lisp / allout.el
blob1dd8757b306e368036e4a2741a74d959cc086e44
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.
6 ;;;_ + Provide
7 (provide 'outline)
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.3 1993/06/09 11:51:08 jimb Exp $||
15 ;;;_ - Keywords: outline mode
17 ;;;_ - LCD Archive Entry
19 ;; 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.3 1993/06/09 11:51:08 jimb Exp $||
24 ;;;_ - Description
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
32 ;;;_ - Copyright
33 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
35 ;; This file is part of GNU Emacs.
37 ;; GNU Emacs is distributed in the hope that it will be useful,
38 ;; but WITHOUT ANY WARRANTY. No author or distributor
39 ;; accepts responsibility to anyone for the consequences of using it
40 ;; or for whether it serves any particular purpose or works at all,
41 ;; unless he says so in writing. Refer to the GNU Emacs General Public
42 ;; License for full details.
44 ;; Everyone is granted permission to copy, modify and redistribute
45 ;; GNU Emacs, but only under the conditions described in the
46 ;; GNU Emacs General Public License. A copy of this license is
47 ;; supposed to have been given to you along with GNU Emacs so you
48 ;; can know your rights and responsibilities. It should be in a
49 ;; file named COPYING. Among other things, the copyright notice
50 ;; and this notice must be preserved on all copies.
52 ;;;_ + User Customization variables
54 ;;;_ - Topic Header configuration
56 ;;;_ = outline-header-prefix
57 (defvar outline-header-prefix "."
58 "* Leading string for greater than level 0 topic headers.")
59 (make-variable-buffer-local 'outline-header-prefix)
61 ;;;_ = outline-header-subtraction
62 (defvar outline-header-subtraction (1- (length outline-header-prefix))
63 "* Leading string for greater than level 0 topic headers.")
64 (make-variable-buffer-local 'outline-header-subtraction)
66 ;;;_ = outline-primary-bullet
67 (defvar outline-primary-bullet "*") ;; Changing this var disables any
68 ;; backwards compatibility with
69 ;; the original outline mode.
70 (make-variable-buffer-local 'outline-primary-bullet)
72 ;;;_ = outline-plain-bullets-string
73 (defvar outline-plain-bullets-string ""
74 "* The bullets normally used in outline topic prefixes. See
75 'outline-distinctive-bullets-string' for the other kind of
76 bullets.
78 DO NOT include the close-square-bracket, ']', among any bullets.
80 You must run 'set-outline-regexp' in order for changes to the
81 value of this var to effect outline-mode operation.")
82 (setq outline-plain-bullets-string (concat outline-primary-bullet
83 "+-:.;,"))
84 (make-variable-buffer-local 'outline-plain-bullets-string)
86 ;;;_ = outline-distinctive-bullets-string
87 (defvar outline-distinctive-bullets-string ""
88 "* The bullets used for distinguishing outline topics. These
89 bullets are not offered among the regular rotation, and are not
90 changed when automatically rebulleting, as when shifting the
91 level of a topic. See 'outline-plain-bullets-string' for the
92 other kind of bullets.
94 DO NOT include the close-square-bracket, ']', among any bullets.
96 You must run 'set-outline-regexp' in order for changes
97 to the value of this var to effect outline-mode operation.")
98 (setq outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~")
99 (make-variable-buffer-local 'outline-distinctive-bullets-string)
101 ;;;_ > outline-numbered-bullet ()
102 (defvar outline-numbered-bullet ()
103 "* Bullet signifying outline prefixes which are to be numbered.
104 Leave it nil if you don't want any numbering, or set it to a
105 string with the bullet you want to be used.")
106 (setq outline-numbered-bullet "#")
107 (make-variable-buffer-local 'outline-numbered-bullet)
109 ;;;_ = outline-file-xref-bullet
110 (defvar outline-file-xref-bullet "@"
111 "* Set this var to the bullet you want to use for file cross-references.
112 Set it 'nil' if you want to inhibit this capability.")
114 ;;;_ - Miscellaneous customization
116 ;;;_ = outline-stylish-prefixes
117 (defvar outline-stylish-prefixes t
118 "*A true value for this var makes the topic-prefix creation and modification
119 functions vary the prefix bullet char according to level. Otherwise, only
120 asterisks ('*') and distinctive bullets are used.
122 This is how an outline can look with stylish prefixes:
124 * Top level
125 .* A topic
126 . + One level 3 subtopic
127 . . One level 4 subtopic
128 . + Another level 3 subtopic
129 . . A level 4 subtopic
130 . #2 A distinguished, numbered level 4 subtopic
131 . ! A distinguished ('!') level 4 subtopic
132 . #4 Another numbered level 4 subtopic
134 This would be an outline with stylish prefixes inhibited:
136 * Top level
137 .* A topic
138 .! A distinctive (but measly) subtopic
139 . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*'
141 Stylish and constant prefixes (as well as old-style prefixes) are
142 always respected by the topic maneuvering functions, regardless of
143 this variable setting.
145 The setting of this var is not relevant when outline-old-style-prefixes
146 is t.")
147 (make-variable-buffer-local 'outline-stylish-prefixes)
149 ;;;_ = outline-old-style-prefixes
150 (defvar outline-old-style-prefixes nil
151 "*Setting this var causes the topic-prefix creation and modification
152 functions to make only asterix-padded prefixes, so they look exactly
153 like the old style prefixes.
155 Both old and new style prefixes are always respected by the topic
156 maneuvering functions.")
157 (make-variable-buffer-local 'outline-old-style-prefixes)
159 ;;;_ = outline-enwrap-isearch-mode
160 ; Spiffy dynamic-exposure
161 ; during searches requires
162 ; Dan LaLiberte's isearch-mode:
163 (defvar outline-enwrap-isearch-mode "isearch-mode.el"
164 "* Set this var to the name of the (non-compiled) elisp code for
165 isearch-mode, if you have Dan LaLiberte's 'isearch-mode'
166 stuff and want isearches to reveal hidden stuff encountered in the
167 course of a search, and reconceal it if you go past. Set it nil if
168 you don't have the package, or don't want to use this feature.")
170 ;;;_ = outline-use-hanging-indents
171 (defvar outline-use-hanging-indents t
172 "* Set this var non-nil if you have Kyle E Jones' filladapt stuff,
173 and you want outline to fill topics as hanging indents to the
174 bullets.")
175 (make-variable-buffer-local 'outline-use-hanging-indents)
177 ;;;_ = outline-reindent-bodies
178 (defvar outline-reindent-bodies t
179 "* Set this var non-nil if you want topic depth adjustments to
180 reindent hanging bodies (ie, bodies lines indented to beginning of
181 heading text). The performance hit is small.
183 Avoid this strenuously when using outline mode on program code.
184 It's great for text, though.")
185 (make-variable-buffer-local 'outline-reindent-bodies)
187 ;;;_ = outline-mode-keys
188 ;;; You have to restart outline-mode - '(outline-mode t)' - to have
189 ;;; any changes take hold.
190 (defvar outline-mode-keys ()
191 "Assoc list of outline-mode-keybindings, for common reference in setting
192 up major and minor-mode keybindings.")
193 (setq outline-mode-keys
195 ; Motion commands:
196 ("\C-c\C-n" outline-next-visible-heading)
197 ("\C-c\C-p" outline-previous-visible-heading)
198 ("\C-c\C-u" outline-up-current-level)
199 ("\C-c\C-f" outline-forward-current-level)
200 ("\C-c\C-b" outline-backward-current-level)
201 ("\C-c\C-a" outline-beginning-of-current-entry)
202 ("\C-c\C-e" outline-end-of-current-entry)
203 ; Exposure commands:
204 ("\C-c\C-i" outline-show-current-children)
205 ("\C-c\C-s" outline-show-current-subtree)
206 ("\C-c\C-h" outline-hide-current-subtree)
207 ("\C-c\C-o" outline-show-current-entry)
208 ("\C-c!" outline-show-all)
209 ; Alteration commands:
210 ("\C-c " open-sibtopic)
211 ("\C-c." open-subtopic)
212 ("\C-c," open-supertopic)
213 ("\C-c'" outline-shift-in)
214 ("\C-c>" outline-shift-in)
215 ("\C-c<" outline-shift-out)
216 ("\C-c\C-m" outline-rebullet-topic)
217 ("\C-cb" outline-rebullet-current-heading)
218 ("\C-c#" outline-number-siblings)
219 ("\C-k" outline-kill-line)
220 ("\C-y" outline-yank)
221 ("\M-y" outline-yank-pop)
222 ("\C-c\C-k" outline-kill-topic)
223 ; Miscellaneous commands:
224 ("\C-c@" outline-resolve-xref)
225 ("\C-cc" outline-copy-exposed)))
227 ;;;_ + Code - no user customizations below.
229 ;;;_ #1 Outline Format and Internal Mode Configuration
231 ;;;_ : Topic header format
232 ;;;_ = outline-regexp
233 (defvar outline-regexp ""
234 "* Regular expression to match the beginning of a heading line.
235 Any line whose beginning matches this regexp is considered a
236 heading. This var is set according to the user configuration vars
237 by set-outline-regexp.")
238 (make-variable-buffer-local 'outline-regexp)
239 ;;;_ = outline-bullets-string
240 (defvar outline-bullets-string ""
241 " A string dictating the valid set of outline topic bullets. This
242 var should *not* be set by the user - it is set by 'set-outline-regexp',
243 and is composed from the elements of 'outline-plain-bullets-string'
244 and 'outline-distinctive-bullets-string'.")
245 (make-variable-buffer-local 'outline-bullets-string)
246 ;;;_ = outline-line-boundary-regexp
247 (defvar outline-line-boundary-regexp ()
248 " outline-regexp with outline-style beginning of line anchor (ie,
249 C-j, *or* C-m, for prefixes of hidden topics). This is properly
250 set when outline-regexp is produced by 'set-outline-regexp', so
251 that (match-beginning 2) and (match-end 2) delimit the prefix.")
252 (make-variable-buffer-local 'outline-line-boundary-regexp)
253 ;;;_ = outline-bob-regexp
254 (defvar outline-bob-regexp ()
255 " Like outline-line-boundary-regexp, this is an outline-regexp for
256 outline headers at the beginning of the buffer. (match-beginning 2)
257 and (match-end 2)
258 delimit the prefix.")
259 (make-variable-buffer-local 'outline-line-bob-regexp)
260 ;;;_ > outline-reset-header-lead (header-lead)
261 (defun outline-reset-header-lead (header-lead)
262 "* Reset the leading string used to identify topic headers."
263 (interactive "sNew lead string: ")
264 ;;()
265 (setq outline-header-prefix header-lead)
266 (setq outline-header-subtraction (1- (length outline-header-prefix)))
267 (set-outline-regexp)
269 ;;;_ > outline-lead-with-comment-string (header-lead)
270 (defun outline-lead-with-comment-string (&optional header-lead)
271 "* Set the topic-header leading string to specified string. Useful
272 when for encapsulating outline structure in programming language
273 comments. Returns the leading string."
275 (interactive "P")
276 (if (not (stringp header-lead))
277 (setq header-lead (read-string
278 "String prefix for topic headers: ")))
279 (setq outline-reindent-bodies nil)
280 (outline-reset-header-lead header-lead)
281 header-lead)
282 ;;;_ > set-outline-regexp ()
283 (defun set-outline-regexp ()
284 " Generate proper topic-header regexp form for outline functions, from
285 outline-plain-bullets-string and outline-distinctive-bullets-string."
287 (interactive)
288 ;; Derive outline-bullets-string from user configured components:
289 (setq outline-bullets-string "")
290 (let ((strings (list 'outline-plain-bullets-string
291 'outline-distinctive-bullets-string))
292 cur-string
293 cur-len
294 cur-char-string
295 index
296 new-string)
297 (while strings
298 (setq new-string "") (setq index 0)
299 (setq cur-len (length (setq cur-string (symbol-value (car strings)))))
300 (while (< index cur-len)
301 (setq cur-char (aref cur-string index))
302 (setq outline-bullets-string
303 (concat outline-bullets-string
304 (cond
305 ; Single dash would denote a
306 ; sequence, repeated denotes
307 ; a dash:
308 ((eq cur-char ?-) "--")
309 ; literal close-square-bracket
310 ; doesn't work right in the
311 ; expr, exclude it:
312 ((eq cur-char ?\]) "")
313 (t (regexp-quote (char-to-string cur-char))))))
314 (setq index (1+ index)))
315 (setq strings (cdr strings)))
317 ;; Derive next for repeated use in outline-pending-bullet:
318 (setq outline-plain-bullets-string-len (length outline-plain-bullets-string))
319 (setq outline-header-subtraction (1- (length outline-header-prefix)))
320 ;; Produce the new outline-regexp:
321 (setq outline-regexp (concat "\\(\\"
322 outline-header-prefix
323 "[ \t]*["
324 outline-bullets-string
325 "]\\)\\|\\"
326 outline-primary-bullet
327 "+\\|\^l"))
328 (setq outline-line-boundary-regexp
329 (concat "\\([\C-j\C-m]\\)\\(" outline-regexp "\\)"))
330 (setq outline-bob-regexp
331 (concat "\\(\\`\\)\\(" outline-regexp "\\)"))
334 ;;;_ : Key bindings
335 ;;;_ = Generic minor keybindings control
336 ;;;_ ; Stallman's suggestion
337 (defvar outline-mode-map nil "")
339 (if outline-mode-map
341 (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
342 (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading)
343 (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
344 (define-key outline-mode-map "\C-c\C-i" 'show-children)
345 (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
346 (define-key outline-mode-map "\C-c\C-h" 'hide-subtree)
347 (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
348 (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
349 (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level))
351 (defvar outline-minor-mode nil
352 "Non-nil if using Outline mode as a minor mode of some other mode.")
353 (make-variable-buffer-local 'outline-minor-mode)
354 (put 'outline-minor-mode 'permanent-local t)
355 (setq minor-mode-alist (append minor-mode-alist
356 (list '(outline-minor-mode " Outl"))))
358 (defvar outline-minor-mode-map nil)
359 (if outline-minor-mode-map
361 (setq outline-minor-mode-map (make-sparse-keymap))
362 (define-key outline-minor-mode-map "\C-c"
363 (lookup-key outline-mode-map "\C-c")))
365 (or (assq 'outline-minor-mode minor-mode-map-alist)
366 (setq minor-mode-map-alist
367 (cons (cons 'outline-minor-mode outline-minor-mode-map)
368 minor-mode-map-alist)))
370 (defun outline-minor-mode (&optional arg)
371 "Toggle Outline minor mode.
372 With arg, turn Outline minor mode on if arg is positive, off otherwise.
373 See the command `outline-mode' for more information on this mode."
374 (interactive "P")
375 (setq outline-minor-mode
376 (if (null arg) (not outline-minor-mode)
377 (> (prefix-numeric-value arg) 0)))
378 (if outline-minor-mode
379 (progn
380 (setq selective-display t)
381 (run-hooks 'outline-minor-mode-hook))
382 (setq selective-display nil)))
383 ;;;_ ; minor-bind-keys (keys-assoc)
384 (defun minor-bind-keys (keys-assoc)
385 " Establish BINDINGS assoc list in current buffer, returning a list
386 for subsequent use by minor-unbind-keys to resume overloaded local
387 bindings."
388 (interactive)
389 ;; Cycle thru key list, registering prevailing local binding for key, if
390 ;; any (for prospective resumption by outline-minor-unbind-keys), then
391 ;; overloading it with outline-mode one.
392 (let ((local-map (or (current-local-map)
393 (make-sparse-keymap)))
394 key new-func unbinding-registry prevailing-func)
395 (while keys-assoc
396 (setq curr-key (car (car keys-assoc)))
397 (setq new-func (car (cdr (car keys-assoc))))
398 (setq prevailing-func (local-key-binding curr-key))
399 (if (not (symbolp prevailing-func))
400 (setq prevailing-func nil))
401 ;; Register key being changed, prevailing local binding, & new binding:
402 (setq unbinding-registry
403 (cons (list curr-key (local-key-binding curr-key) new-func)
404 unbinding-registry))
405 ; Make the binding:
407 (define-key local-map curr-key new-func)
408 ; Increment for next iteration:
409 (setq keys-assoc (cdr keys-assoc)))
410 ; Establish modified map:
411 (use-local-map local-map)
412 ; Return the registry:
413 unbinding-registry)
416 ;;;_ ; minor-relinquish-keys (unbinding-registry)
417 (defun minor-relinquish-keys (unbinding-registry)
418 " Given registry of MODAL-BINDINGS, as produced by minor-bind-keys,
419 resume the former local keybindings of those keys that retain the
420 local bindings set by minor-bind-keys. Changed local bindings are
421 left alone, so other minor (user or modal) bindings are not disrupted.
423 Returns a list of those registrations which were not, because of
424 tampering subsequent to the registration by minor-bind-keys, resumed."
425 (interactive)
426 (let (residue curr-item curr-key curr-resume curr-relinquish)
427 (while unbinding-registry
428 (setq curr-item (car unbinding-registry))
429 (setq curr-key (car curr-item))
430 (setq curr-resume (car (cdr curr-item)))
431 (setq curr-relinquish (car (cdr (cdr curr-item))))
432 (if (equal (local-key-binding curr-key) curr-relinquish)
433 (if curr-resume
434 ;; Was a local binding to be resumed - do so:
435 (local-set-key curr-key curr-resume)
436 (local-unset-key curr-key))
437 ;; Bindings been tampered with since registration - leave it be, and
438 ;; register so on residue list:
439 (setq residue (cons residue curr-item)))
440 (setq unbinding-registry (cdr unbinding-registry)))
441 residue)
443 ;;;_ = outline-minor-prior-keys
444 (defvar outline-minor-prior-keys ()
445 "Former key bindings assoc-list, for resumption from outline minor-mode.")
446 (make-variable-buffer-local 'outline-minor-prior-keys)
448 ; Both major and minor mode
449 ; bindings are dictated by
450 ; this list - put your
451 ; settings here.
452 ;;;_ > outline-minor-bind-keys ()
453 (defun outline-minor-bind-keys ()
454 " Establish outline-mode keybindings as MINOR modality of current buffer."
455 (setq outline-minor-prior-keys
456 (minor-bind-keys outline-mode-keys)))
457 ;;;_ > outline-minor-relinquish-keys ()
458 (defun outline-minor-relinquish-keys ()
459 " Resurrect local keybindings as they were before outline-minor-bind-keys."
460 (minor-relinquish-keys outline-minor-prior-keys)
463 ;;;_ : Mode-Specific Variables Maintenance
464 ;;;_ = outline-mode-prior-settings
465 (defvar outline-mode-prior-settings nil
466 "For internal use by outline mode, registers settings to be resumed
467 on mode deactivation.")
468 (make-variable-buffer-local 'outline-mode-prior-settings)
469 ;;;_ > outline-resumptions (name &optional value)
470 (defun outline-resumptions (name &optional value)
472 " Registers information for later reference, or performs resumption of
473 outline-mode specific values. First arg is NAME of variable affected.
474 optional second arg is list containing outline-mode-specific VALUE to
475 be impose on named variable, and to be registered. (It's a list so you
476 can specify registrations of null values.) If no value is specified,
477 the registered value is returned (encapsulated in the list, so the
478 caller can distinguish nil vs no value), and the registration is popped
479 from the list."
481 (let ((on-list (assq name outline-mode-prior-settings))
482 prior-capsule ; By 'capsule' i mean a list
483 ; containing a value, so we can
484 ; distinguish nil from no value.
487 (if value
489 ;; Registering:
490 (progn
491 (if on-list
492 nil ; Already preserved prior value - don't mess with it.
493 ;; Register the old value, or nil if previously unbound:
494 (setq outline-mode-prior-settings
495 (cons (list name
496 (if (boundp name) (list (symbol-value name))))
497 outline-mode-prior-settings)))
498 ; And impose the new value:
499 (set name (car value)))
501 ;; Relinquishing:
502 (if (not on-list)
504 ;; Oops, not registered - leave it be:
507 ;; Some registration:
508 ; reestablish it:
509 (setq prior-capsule (car (cdr on-list)))
510 (if prior-capsule
511 (set name (car prior-capsule)) ; Some prior value - reestablish it.
512 (makunbound name)) ; Previously unbound - demolish var.
513 ; Remove registration:
514 (let (rebuild)
515 (while outline-mode-prior-settings
516 (if (not (eq (car outline-mode-prior-settings)
517 on-list))
518 (setq rebuild
519 (cons (car outline-mode-prior-settings)
520 rebuild)))
521 (setq outline-mode-prior-settings
522 (cdr outline-mode-prior-settings)))
523 (setq outline-mode-prior-settings rebuild)))))
526 ;;;_ : Overall
527 ;;;_ = outline-mode
528 (defvar outline-mode () "Allout outline mode minor-mode flag.")
529 (make-variable-buffer-local 'outline-mode)
530 ;;;_ > outline-mode (&optional toggle)
531 (defun outline-mode (&optional toggle)
532 " Set minor mode for editing outlines with selective display.
534 Look below the description of the bindings for explanation of the
535 terminology use in outline-mode commands.
537 (Note - this is not a proper minor mode, because it does affect key
538 bindings. It's not too improper, however, because it does resurrect
539 any bindings which have not been tampered with since it changed them.)
541 Exposure Commands Movement Commands
542 C-c C-h outline-hide-current-subtree C-c C-n outline-next-visible-heading
543 C-c C-i outline-show-current-children C-c C-p outline-previous-visible-heading
544 C-c C-s outline-show-current-subtree C-c C-u outline-up-current-level
545 C-c C-o outline-show-current-entry C-c C-f outline-forward-current-level
546 C-c ! outline-show-all C-c C-b outline-backward-current-level
547 outline-hide-current-leaves C-c C-e outline-end-of-current-entry
548 C-c C-a outline-beginning-of-current-entry
551 Topic Header Generation Commands
552 C-c<SP> open-sibtopic Create a new sibling after current topic
553 C-c . open-subtopic ... an offspring of current topic
554 C-c , open-supertopic ... a sibling of the current topic's parent
556 Level and Prefix Adjustment Commands
557 C-c > outline-shift-in Shift current topic and all offspring deeper
558 C-c < outline-shift-out ... less deep
559 C-c<CR> outline-rebullet-topic Reconcile bullets of topic and its offspring
560 - distinctive bullets are not changed, all
561 others set suitable according to depth
562 C-c b outline-rebullet-current-heading Prompt for alternate bullet for
563 current topic
564 C-c # outline-number-siblings Number bullets of topic and siblings - the
565 offspring are not affected. With repeat
566 count, revoke numbering.
568 Killing and Yanking - all keep siblings numbering reconciled as appropriate
569 C-k outline-kill-line Regular kill line, but respects numbering ,etc
570 C-c C-k outline-kill-topic Kill current topic, including offspring
571 C-y outline-yank Yank, adjusting depth of yanked topic to
572 depth of heading if yanking into bare topic
573 heading (ie, prefix sans text)
574 M-y outline-yank-pop Is to outline-yank as yank-pop is to yank
576 Misc commands
577 C-c @ outline-resolve-xref pop-to-buffer named by xref (cf
578 outline-file-xref-bullet)
579 C-c c outline-copy-exposed Copy outline sans all hidden stuff to
580 another buffer whose name is derived
581 from the current one - \"XXX exposed\"
582 M-x outlinify-sticky Activate outline mode for current buffer
583 and establish -*- outline -*- mode specifier
584 as well as file local vars to automatically
585 set exposure. Try it.
587 Terminology
589 Topic: A basic cohesive component of an emacs outline, which can
590 be closed (made hidden), opened (revealed), generated,
591 traversed, and shifted as units, using outline-mode functions.
592 A topic is composed of a HEADER, a BODY, and SUBTOPICs (see below).
594 Exposure: Hidden (~closed~) topics are represented by ellipses ('...')
595 at the end of the visible SUPERTOPIC which contains them,
596 rather than by their actual text. Hidden topics are still
597 susceptible to editing and regular movement functions, they
598 just are not displayed normally, effectively collapsed into
599 the ellipses which represent them. Outline mode provides
600 the means to selectively expose topics based on their
601 NESTING.
603 SUBTOPICS of a topic can be hidden and subsequently revealed
604 based on their DEPTH relative to the supertopic from which
605 the exposure is being done.
607 The BODIES of a topic do not generally become visible except
608 during exposure of entire subtrees (see documentation for
609 '-current-subtree'), or when the entry is explicitly exposed
610 with the 'outline-show-entry' function, or (if you have a
611 special version of isearch installed) when encountered by
612 incremental searches.
614 The CURRENT topic is the more recent visible one before or
615 including the text cursor.
617 Header: The initial portion of an outline topic. It is composed of a
618 topic header PREFIX at the beginning of the line, followed by
619 text to the end of the EFFECTIVE LINE.
621 Body: Any subsequent lines of text following a topic header and preceding
622 the next one. This is also referred to as the entry for a topic.
624 Prefix: The text which distinguishes topic headers from normal text
625 lines. There are two forms, both of which start at the beginning
626 of the topic header (EFFECTIVE) line. The length of the prefix
627 represents the DEPTH of the topic. The fundamental sort begins
628 either with solely an asterisk ('*') or else dot ('.') followed
629 by zero or more spaces and then an outline BULLET. [Note - you
630 can now designate your own, arbitrary HEADER-LEAD string, by
631 setting the variable 'outline-header-prefix'.] The second form
632 is for backwards compatibility with the original emacs outline
633 mode, and consists solely of asterisks. Both sorts are
634 recognized by all outline commands. The first sort is generated
635 by outline topic production commands if the emacs variable
636 outline-old-style-prefixes is nil, otherwise the second style is
637 used.
639 Bullet: An outline prefix bullet is one of the characters on either
640 of the outline bullet string vars, 'outline-plain-bullets-string'
641 and 'outline-distinctive-bullets-string'. (See their
642 documentation for more details.) The default choice of bullet
643 for any prefix depends on the DEPTH of the topic.
645 Depth and Nesting:
646 The length of a topic header prefix, from the initial
647 character to the bullet (inclusive), represents the depth of
648 the topic. A topic is considered to contain the subsequent
649 topics of greater depth up to the next topic of the same
650 depth, and the contained topics are recursively considered to
651 be nested within all containing topics. Contained topics are
652 called subtopics. Immediate subtopics are called 'children'.
653 Containing topics are supertopicsimmediate supertopics are
654 'parents'. Contained topics of the same depth are called
655 siblings.
657 Effective line: The regular ascii text in which form outlines are
658 saved are manipulated in outline-mode to engage emacs'
659 selective-display faculty. The upshot is that the
660 effective end of an outline line can be terminated by
661 either a normal Unix newline char, \n, or the special
662 outline-mode eol, ^M. This only matters at the user
663 level when you're doing searches which key on the end of
664 line character."
666 (interactive "P")
668 (let* ((active (and (boundp 'outline-mode) outline-mode))
669 (toggle (and toggle
670 (or (and (listp toggle)(car toggle))
671 toggle)))
672 (explicit-activation (and toggle
673 (or (symbolp toggle)
674 (and (natnump toggle)
675 (not (zerop toggle)))))))
677 (cond
679 ((and (not explicit-activation) (or active toggle))
680 ;; Activation not explicitly requested, and either in active
681 ;; state or deactivation specifically requested:
682 (outline-minor-relinquish-keys)
683 (outline-resumptions 'selective-display)
684 (outline-resumptions 'indent-tabs-mode)
685 (outline-resumptions 'paragraph-start)
686 (outline-resumptions 'paragraph-separate)
687 (setq outline-mode nil))
689 ;; Deactivation *not* indicated.
690 ((not active)
691 ;; Not already active - activate:
692 (outline-minor-bind-keys)
693 (outline-resumptions 'selective-display '(t))
694 (outline-resumptions 'indent-tabs-mode '(nil))
695 (or (assq 'outline-mode minor-mode-alist)
696 (setq minor-mode-alist
697 (cons '(outline-mode " Outline") minor-mode-alist)))
698 (set-outline-regexp)
700 (make-local-variable 'paragraph-start)
701 (outline-resumptions 'paragraph-start
702 (list (concat paragraph-start "\\|^\\("
703 outline-regexp "\\)")))
704 (make-local-variable 'paragraph-separate)
705 (outline-resumptions 'paragraph-separate
706 (list (concat paragraph-separate "\\|^\\("
707 outline-regexp "\\)")))
709 (if outline-enwrap-isearch-mode
710 (outline-enwrap-isearch))
711 (if (and outline-use-hanging-indents
712 (boundp 'filladapt-prefix-table))
713 ;; Add outline-prefix recognition to filladapt - not standard:
714 (progn (setq filladapt-prefix-table
715 (cons (cons (concat "\\(" outline-regexp "\\) ")
716 'filladapt-hanging-list)
717 filladapt-prefix-table))
718 (setq filladapt-hanging-list-prefixes
719 (cons outline-regexp
720 filladapt-hanging-list-prefixes))))
721 (run-hooks 'outline-mode-hook)
722 (setq outline-mode t))
723 ) ; cond
724 ) ; let*
725 ) ; defun
728 ;;;_ #2 Internal Position State-Tracking Variables
729 ;;; All basic outline functions which directly do string matches to
730 ;;; evaluate heading prefix location set the variables
731 ;;; outline-recent-prefix-beginning and outline-recent-prefix-end when
732 ;;; successful. Functions starting with 'outline-recent-' all use
733 ;;; this state, providing the means to avoid redundant searches for
734 ;;; just established data. This optimization can provide significant
735 ;;; speed improvement, but it must be employed carefully.
736 ;;;_ = outline-recent-prefix-beginning
737 (defvar outline-recent-prefix-beginning 0
738 " Buffer point of the start of the last topic prefix encountered.")
739 (make-variable-buffer-local 'outline-recent-prefix-beginning)
740 ;;;_ = outline-recent-prefix-end
741 (defvar outline-recent-prefix-end 0
742 " Buffer point of the end of the last topic prefix encountered.")
743 (make-variable-buffer-local 'outline-recent-prefix-end)
745 ;;;_ #3 Exposure Control
747 ;;;_ : Fundamental
748 ;;;_ > outline-flag-region (from to flag)
749 (defun outline-flag-region (from to flag)
750 " Hides or shows lines from FROM to TO, according to FLAG.
751 Uses emacs selective-display, where text is show if FLAG put at
752 beginning of line is `\\n' (newline character), while text is
753 hidden if FLAG is `\\^M' (control-M).
755 returns nil iff no changes were effected."
756 (let ((buffer-read-only nil))
757 (subst-char-in-region from to
758 (if (= flag ?\n) ?\^M ?\n)
759 flag t)))
760 ;;;_ > outline-flag-current-subtree (flag)
761 (defun outline-flag-current-subtree (flag)
762 (save-excursion
763 (outline-back-to-current-heading)
764 (outline-flag-region (point)
765 (progn (outline-end-of-current-subtree) (point))
766 flag)))
768 ;;;_ : Topic-specific
769 ;;;_ > outline-hide-current-entry ()
770 (defun outline-hide-current-entry ()
771 "Hide the body directly following this heading."
772 (interactive)
773 (outline-back-to-current-heading)
774 (save-excursion
775 (outline-flag-region (point)
776 (progn (outline-end-of-current-entry) (point))
777 ?\^M)))
778 ;;;_ > outline-show-current-entry (&optional arg)
779 (defun outline-show-current-entry (&optional arg)
780 "Show body directly following this heading, or hide it if repeat count."
781 (interactive "P")
782 (if arg
783 (outline-hide-current-entry)
784 (save-excursion
785 (outline-flag-region (point)
786 (progn (outline-end-of-current-entry) (point))
787 ?\n))))
788 ;;;_ > outline-show-entry ()
789 ; outline-show-entry basically for isearch dynamic exposure, as is...
790 (defun outline-show-entry ()
791 " Like outline-show-current-entry, but reveals an entry that is nested
792 within hidden topics."
793 (interactive)
794 (save-excursion
795 (outline-goto-prefix)
796 (outline-flag-region (if (not (bobp)) (1- (point)) (point))
797 (progn (outline-pre-next-preface) (point)) ?\n)))
798 ;;;_ > outline-hide-current-entry-completely ()
799 ; ... outline-hide-current-entry-completely also for isearch dynamic exposure:
800 (defun outline-hide-current-entry-completely ()
801 "Like outline-hide-current-entry, but conceal topic completely."
802 (interactive)
803 (save-excursion
804 (outline-goto-prefix)
805 (outline-flag-region (if (not (bobp)) (1- (point)) (point))
806 (progn (outline-pre-next-preface)
807 (if (looking-at "\C-m")
808 (point)
809 (1- (point))))
810 ?\C-m)))
811 ;;;_ > outline-show-current-subtree ()
812 (defun outline-show-current-subtree ()
813 "Show everything after this heading at deeper levels."
814 (interactive)
815 (outline-flag-current-subtree ?\n))
816 ;;;_ > outline-hide-current-subtree (&optional just-close)
817 (defun outline-hide-current-subtree (&optional just-close)
819 " Hide everything after this heading at deeper levels, or if it's
820 already closed, and optional arg JUST-CLOSE is nil, hide the current
821 level."
823 (interactive)
824 (let ((orig-eol (save-excursion
825 (end-of-line)(outline-goto-prefix)(end-of-line)(point))))
826 (outline-flag-current-subtree ?\^M)
827 (if (and (= orig-eol (save-excursion (goto-char orig-eol)
828 (end-of-line)
829 (point)))
830 ;; Structure didn't change - try hiding current level:
831 (if (not just-close)
832 (outline-up-current-level 1 t)))
833 (outline-hide-current-subtree))))
834 ;;;_ > outline-show-current-branches ()
835 (defun outline-show-current-branches ()
836 "Show all subheadings of this heading, but not their bodies."
837 (interactive)
838 (outline-show-current-children 1000))
839 ;;;_ > outline-hide-current-leaves ()
840 (defun outline-hide-current-leaves ()
841 "Hide all body after this heading at deeper levels."
842 (interactive)
843 (outline-back-to-current-heading)
844 (outline-hide-region-body (point) (progn (outline-end-of-current-subtree)
845 (point))))
846 ;;;_ > outline-show-current-children (&optional level)
847 (defun outline-show-current-children (&optional level)
848 " Show all direct subheadings of this heading. Optional LEVEL specifies
849 how many levels below the current level should be shown."
850 (interactive "p")
851 (or level (setq level 1))
852 (save-excursion
853 (save-restriction
854 (beginning-of-line)
855 (setq level (+ level (progn (outline-back-to-current-heading)
856 (outline-recent-depth))))
857 (narrow-to-region (point)
858 (progn (outline-end-of-current-subtree) (1+ (point))))
859 (goto-char (point-min))
860 (while (and (not (eobp))
861 (outline-next-heading))
862 (if (<= (outline-recent-depth) level)
863 (save-excursion
864 (let ((end (1+ (point))))
865 (forward-char -1)
866 (if (memq (preceding-char) '(?\n ?\^M))
867 (forward-char -1))
868 (outline-flag-region (point) end ?\n))))))))
870 ;;;_ : Region and beyond
871 ;;;_ > outline-show-all ()
872 (defun outline-show-all ()
873 "Show all of the text in the buffer."
874 (interactive)
875 (outline-flag-region (point-min) (point-max) ?\n))
876 ;;;_ > outline-hide-bodies ()
877 (defun outline-hide-bodies ()
878 "Hide all of buffer except headings."
879 (interactive)
880 (outline-hide-region-body (point-min) (point-max)))
881 ;;;_ > outline-hide-region-body (start end)
882 (defun outline-hide-region-body (start end)
883 "Hide all body lines in the region, but not headings."
884 (save-excursion
885 (save-restriction
886 (narrow-to-region start end)
887 (goto-char (point-min))
888 (while (not (eobp))
889 (outline-flag-region (point)
890 (progn (outline-pre-next-preface) (point)) ?\^M)
891 (if (not (eobp))
892 (forward-char
893 (if (looking-at "[\n\^M][\n\^M]")
894 2 1)))))))
895 ;;;_ > outline-expose ()
896 (defun outline-expose (spec &rest followers)
898 "Dictate wholesale exposure scheme for current topic, according to SPEC.
900 SPEC is either a number or a list of specs. Optional successive args
901 dictate exposure for subsequent siblings of current topic.
903 Numbers, the symbols '*' and '+', and the null list dictate different
904 exposure depths for the corresponding topic. Numbers indicate the
905 depth to open, with negative numbers first forcing a close, and then
906 opening to their absolute value. Positive numbers jsut reopen, and 0
907 just closes. '*' completely opens the topic, including bodies, and
908 '+' shows all the sub headers, but not the bodies.
910 If the spec is a list, the first element must be a number which
911 dictates the exposure depth of the topic as a whole. Subsequent
912 elements of the list are nested SPECs, dictating the specific exposure
913 for the corresponding offspring of the topic, as the SPEC as a whole
914 does for the parent topic.
916 Optional FOLLOWER elements dictate exposure for subsequent siblings
917 of the parent topic."
919 (interactive "xExposure spec: ")
920 (save-excursion
921 (let ((start-point (progn (outline-goto-prefix)(point)))
922 done)
923 (cond ((null spec) nil)
924 ((symbolp spec)
925 (if (eq spec '*) (outline-show-current-subtree))
926 (if (eq spec '+) (outline-show-current-branches)))
927 ((numberp spec)
928 (if (zerop spec)
929 ;; Just hide if zero:
930 (outline-hide-current-subtree t)
931 (if (> 0 spec)
932 ;; Close before opening if negative:
933 (progn (outline-hide-current-subtree)
934 (setq spec (* -1 spec))))
935 (outline-show-current-children spec)))
936 ((listp spec)
937 (outline-expose (car spec))
938 (if (and (outline-descend-to-depth (+ (outline-current-depth) 1))
939 (not (outline-hidden-p)))
940 (while (and (setq spec (cdr spec))
941 (not done))
942 (outline-expose (car spec))
943 (setq done (not (outline-next-sibling)))))))))
944 (while (and followers (outline-next-sibling))
945 (outline-expose (car followers))
946 (setq followers (cdr followers)))
948 ;;;_ > outline-exposure '()
949 (defmacro outline-exposure (&rest spec)
950 " Literal frontend for 'outline-expose', passes arguments unevaluated,
951 so you needn't quote them."
952 (cons 'outline-expose (mapcar '(lambda (x) (list 'quote x)) spec)))
954 ;;;_ #4 Navigation
956 ;;;_ : Position Assessment
958 ;;;_ . Residual state - from most recent outline context operation.
959 ;;;_ > outline-recent-depth ()
960 (defun outline-recent-depth ()
961 " Return depth of last heading encountered by an outline maneuvering
962 function.
964 All outline functions which directly do string matches to assess
965 headings set the variables outline-recent-prefix-beginning and
966 outline-recent-prefix-end if successful. This function uses those settings
967 to return the current depth."
969 (max 1
970 (- outline-recent-prefix-end
971 outline-recent-prefix-beginning
972 outline-header-subtraction)))
973 ;;;_ > outline-recent-prefix ()
974 (defun outline-recent-prefix ()
975 " Like outline-recent-depth, but returns text of last encountered prefix.
977 All outline functions which directly do string matches to assess
978 headings set the variables outline-recent-prefix-beginning and
979 outline-recent-prefix-end if successful. This function uses those settings
980 to return the current depth."
981 (buffer-substring outline-recent-prefix-beginning outline-recent-prefix-end))
982 ;;;_ > outline-recent-bullet ()
983 (defun outline-recent-bullet ()
984 " Like outline-recent-prefix, but returns bullet of last encountered
985 prefix.
987 All outline functions which directly do string matches to assess
988 headings set the variables outline-recent-prefix-beginning and
989 outline-recent-prefix-end if successful. This function uses those settings
990 to return the current depth of the most recently matched topic."
991 (buffer-substring (1- outline-recent-prefix-end) outline-recent-prefix-end))
993 ;;;_ . Active position evaluation - if you can't use the residual state.
994 ;;;_ > outline-on-current-heading-p ()
995 (defun outline-on-current-heading-p ()
996 " Return prefix beginning point if point is on same line as current
997 visible topic's header line."
998 (save-excursion
999 (beginning-of-line)
1000 (and (looking-at outline-regexp)
1001 (setq outline-recent-prefix-end (match-end 0)
1002 outline-recent-prefix-beginning (match-beginning 0)))))
1003 ;;;_ > outline-hidden-p ()
1004 (defun outline-hidden-p ()
1005 "True if point is in hidden text."
1006 (interactive)
1007 (save-excursion
1008 (and (re-search-backward "[\C-j\C-m]" (point-min) t)
1009 (looking-at "\C-m"))))
1010 ;;;_ > outline-current-depth ()
1011 (defun outline-current-depth ()
1012 " Return the depth to which the current containing visible topic is
1013 nested in the outline."
1014 (save-excursion
1015 (if (outline-back-to-current-heading)
1016 (max 1
1017 (- outline-recent-prefix-end
1018 outline-recent-prefix-beginning
1019 outline-header-subtraction))
1020 0)))
1021 ;;;_ > outline-depth ()
1022 (defun outline-depth ()
1023 " Like outline-current-depth, but respects hidden as well as visible
1024 topics."
1025 (save-excursion
1026 (if (outline-goto-prefix)
1027 (outline-recent-depth)
1028 (progn
1029 (setq outline-recent-prefix-end (point)
1030 outline-recent-prefix-beginning (point))
1031 0))))
1032 ;;;_ > outline-get-current-prefix ()
1033 (defun outline-get-current-prefix ()
1034 " Topic prefix of the current topic."
1035 (save-excursion
1036 (if (outline-goto-prefix)
1037 (outline-recent-prefix))))
1038 ;;;_ > outline-get-bullet ()
1039 (defun outline-get-bullet ()
1040 " Return bullet of containing topic (visible or not)."
1041 (save-excursion
1042 (and (outline-goto-prefix)
1043 (outline-recent-bullet))))
1044 ;;;_ > outline-current-bullet ()
1045 (defun outline-current-bullet ()
1046 " Return bullet of current (visible) topic heading, or none if none found."
1047 (condition-case err
1048 (save-excursion
1049 (outline-back-to-current-heading)
1050 (buffer-substring (- outline-recent-prefix-end 1)
1051 outline-recent-prefix-end))
1052 ;; Quick and dirty provision, ostensibly for missing bullet:
1053 (args-out-of-range nil))
1055 ;;;_ > outline-get-prefix-bullet (prefix)
1056 (defun outline-get-prefix-bullet (prefix)
1057 " Return the bullet of the header prefix string PREFIX."
1058 ;; Doesn't make sense if we're old-style prefixes, but this just
1059 ;; oughtn't be called then, so forget about it...
1060 (if (string-match outline-regexp prefix)
1061 (substring prefix (1- (match-end 0)) (match-end 0))))
1063 ;;;_ : Within Topic
1064 ;;;_ > outline-goto-prefix ()
1065 (defun outline-goto-prefix ()
1066 " Put point at beginning of outline prefix for current topic, visible
1067 or not.
1069 Returns a list of char address of the beginning of the prefix and the
1070 end of it, or nil if none."
1072 (cond ((and (or (save-excursion (beginning-of-line) (bobp))
1073 (memq (preceding-char) '(?\n ?\^M)))
1074 (looking-at outline-regexp))
1075 (setq outline-recent-prefix-end (match-end 0)
1076 outline-recent-prefix-beginning
1077 (goto-char (match-beginning 0))))
1078 ((re-search-backward outline-line-boundary-regexp
1079 ;; unbounded search,
1080 ;; stay at limit and return nil if failed:
1081 nil 1)
1082 (setq outline-recent-prefix-end (match-end 2)
1083 outline-recent-prefix-beginning
1084 (goto-char (match-beginning 2))))
1085 ;; We should be at the beginning of the buffer if the last
1086 ;; condition failed. line-boundary-regexp doesn't cover topic
1087 ;; at bob - Check for it.
1088 ((looking-at outline-regexp)
1089 (setq outline-recent-prefix-end (match-end 0)
1090 outline-recent-prefix-beginning
1091 (goto-char (match-beginning 0)))))
1093 ;;;_ > outline-end-of-prefix ()
1094 (defun outline-end-of-prefix ()
1095 " Position cursor at beginning of header text."
1096 (if (not (outline-goto-prefix))
1098 (let ((match-data (match-data)))
1099 (goto-char (match-end 0))
1100 (while (looking-at "[0-9]") (forward-char 1))
1101 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))
1102 (store-match-data match-data))
1103 ;; Reestablish where we are:
1104 (outline-current-depth))
1106 ;;;_ > outline-back-to-current-heading ()
1107 (defun outline-back-to-current-heading ()
1108 " Move to heading line of current visible topic, or beginning of heading
1109 if already on visible heading line."
1110 (beginning-of-line)
1111 (prog1 (or (outline-on-current-heading-p)
1112 (and (re-search-backward (concat "^\\(" outline-regexp "\\)")
1114 'move)
1115 (setq outline-recent-prefix-end (match-end 1)
1116 outline-recent-prefix-beginning (match-beginning 1))))
1117 (if (interactive-p) (outline-end-of-prefix))
1120 ;;;_ > outline-pre-next-preface ()
1121 (defun outline-pre-next-preface ()
1122 "Skip forward to just before the next heading line.
1124 Returns that character position."
1126 (if (re-search-forward outline-line-boundary-regexp nil 'move)
1127 (progn (goto-char (match-beginning 0))
1128 (setq outline-recent-prefix-end (match-end 2)
1129 outline-recent-prefix-beginning (match-beginning 2))))
1131 ;;;_ > outline-end-of-current-subtree ()
1132 (defun outline-end-of-current-subtree ()
1133 " Put point at the end of the last leaf in the currently visible topic."
1134 (interactive)
1135 (outline-back-to-current-heading)
1136 (let ((opoint (point))
1137 (level (outline-recent-depth)))
1138 (outline-next-heading)
1139 (while (and (not (eobp))
1140 (> (outline-recent-depth) level))
1141 (outline-next-heading))
1142 (if (not (eobp)) (forward-char -1))
1143 (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1))))
1144 ;;;_ > outline-beginning-of-current-entry ()
1145 (defun outline-beginning-of-current-entry ()
1146 " Position the point at the beginning of the body of the current topic."
1147 (interactive)
1148 (outline-end-of-prefix))
1149 ;;;_ > outline-beginning-of-current-entry ()
1150 (defun outline-end-of-current-entry ()
1151 " Position the point at the end of the current topic's entry."
1152 (interactive)
1153 (outline-show-entry)
1154 (prog1 (outline-pre-next-preface)
1155 (if (and (not (bobp))(looking-at "^$"))
1156 (forward-char -1)))
1159 ;;;_ : Depth-wise
1160 ;;;_ > outline-ascend-to-depth (depth)
1161 (defun outline-ascend-to-depth (depth)
1162 " Ascend to depth DEPTH, returning depth if successful, nil if not."
1163 (if (and (> depth 0)(<= depth (outline-depth)))
1164 (let ((last-good (point)))
1165 (while (and (< depth (outline-depth))
1166 (setq last-good (point))
1167 (outline-beginning-of-level)
1168 (outline-previous-heading)))
1169 (if (= (outline-recent-depth) depth)
1170 (progn (goto-char outline-recent-prefix-beginning)
1171 depth)
1172 (goto-char last-good)
1173 nil))
1174 (if (interactive-p) (outline-end-of-prefix))
1177 ;;;_ > outline-descend-to-depth (depth)
1178 (defun outline-descend-to-depth (depth)
1179 " Descend to depth DEPTH within current topic, returning depth if
1180 successful, nil if not."
1181 (let ((start-point (point))
1182 (start-depth (outline-depth)))
1183 (while
1184 (and (> (outline-depth) 0)
1185 (not (= depth (outline-recent-depth))) ; ... not there yet
1186 (outline-next-heading) ; ... go further
1187 (< start-depth (outline-recent-depth)))) ; ... still in topic
1188 (if (and (> (outline-depth) 0)
1189 (= (outline-recent-depth) depth))
1190 depth
1191 (goto-char start-point)
1192 nil))
1194 ;;;_ > outline-up-current-level (arg &optional dont-complain)
1195 (defun outline-up-current-level (arg &optional dont-complain)
1196 " Move to the heading line of which the present line is a subheading.
1197 With argument, move up ARG levels. Don't return an error if
1198 second, optional argument DONT-COMPLAIN, is non-nil."
1199 (interactive "p")
1200 (outline-back-to-current-heading)
1201 (let ((present-level (outline-recent-depth)))
1202 ;; Loop for iterating arg:
1203 (while (and (> (outline-recent-depth) 1)
1204 (> arg 0)
1205 (not (bobp)))
1206 ;; Loop for going back over current or greater depth:
1207 (while (and (not (< (outline-recent-depth) present-level))
1208 (outline-previous-visible-heading 1)))
1209 (setq present-level (outline-current-depth))
1210 (setq arg (- arg 1)))
1212 (prog1 (if (<= arg 0)
1213 outline-recent-prefix-beginning
1214 (if (interactive-p) (outline-end-of-prefix))
1215 (if (not dont-complain)
1216 (error "Can't ascend past outermost level.")))
1217 (if (interactive-p) (outline-end-of-prefix)))
1220 ;;;_ : Linear
1221 ;;;_ > outline-next-visible-heading (arg)
1222 (defun outline-next-visible-heading (arg)
1223 " Move to the next visible heading line.
1225 With argument, repeats, backward if negative."
1226 (interactive "p")
1227 (if (< arg 0) (beginning-of-line) (end-of-line))
1228 (if (re-search-forward (concat "^\\(" outline-regexp "\\)")
1231 arg)
1232 (progn (outline-end-of-prefix)
1233 (setq outline-recent-prefix-end (match-end 1)
1234 outline-recent-prefix-beginning (match-beginning 1))))
1236 ;;;_ > outline-previous-visible-heading (arg)
1237 (defun outline-previous-visible-heading (arg)
1238 " Move to the previous heading line.
1240 With argument, repeats or can move forward if negative.
1241 A heading line is one that starts with a `*' (or that outline-regexp
1242 matches)."
1243 (interactive "p")
1244 (outline-next-visible-heading (- arg))
1246 ;;;_ > outline-next-heading (&optional backward)
1247 (defun outline-next-heading (&optional backward)
1248 " Move to the heading for the topic (possibly invisible) before this one.
1250 Optional arg BACKWARD means search for most recent prior heading.
1252 Returns the location of the heading, or nil if none found."
1254 (if (and backward (bobp))
1256 (if backward (outline-goto-prefix)
1257 (if (and (bobp) (not (eobp)))
1258 (forward-char 1)))
1260 (if (if backward
1261 ;; searches are unbounded and return nil if failed:
1262 (or (re-search-backward outline-line-boundary-regexp
1265 (looking-at outline-bob-regexp))
1266 (re-search-forward outline-line-boundary-regexp
1269 (progn;; Got some valid location state - set vars:
1270 (setq outline-recent-prefix-end
1271 (or (match-end 2) outline-recent-prefix-end))
1272 (goto-char (setq outline-recent-prefix-beginning
1273 (or (match-beginning 2)
1274 outline-recent-prefix-beginning))))
1278 ;;;_ > outline-previous-heading ()
1279 (defun outline-previous-heading ()
1280 " Move to the next (possibly invisible) heading line.
1282 Optional repeat-count arg means go that number of headings.
1284 Return the location of the beginning of the heading, or nil if not found."
1286 (outline-next-heading t)
1288 ;;;_ > outline-next-sibling (&optional backward)
1289 (defun outline-next-sibling (&optional backward)
1290 " Like outline-forward-current-level, but respects invisible topics.
1292 Go backward if optional arg BACKWARD is non-nil.
1294 Return depth if successful, nil otherwise."
1296 (if (and backward (bobp))
1298 (let ((start-depth (outline-depth))
1299 (start-point (point))
1300 last-good)
1301 (while (and (not (if backward (bobp) (eobp)))
1302 (if backward (outline-previous-heading)
1303 (outline-next-heading))
1304 (> (outline-recent-depth) start-depth)))
1305 (if (and (not (eobp))
1306 (and (> (outline-depth) 0)
1307 (= (outline-recent-depth) start-depth)))
1308 outline-recent-prefix-beginning
1309 (goto-char start-point)
1310 nil)
1314 ;;;_ > outline-previous-sibling (&optional arg)
1315 (defun outline-previous-sibling (&optional arg)
1316 " Like outline-forward-current-level, but goes backwards and respects
1317 invisible topics.
1319 Optional repeat count means go number backward.
1321 Note that the beginning of a level is (currently) defined by this
1322 implementation to be the first of previous successor topics of
1323 equal or greater depth.
1325 Return depth if successful, nil otherwise."
1326 (outline-next-sibling t)
1328 ;;;_ > outline-beginning-of-level ()
1329 (defun outline-beginning-of-level ()
1330 " Go back to the first sibling at this level, visible or not."
1331 (outline-end-of-level 'backward))
1332 ;;;_ > outline-end-of-level (&optional backward)
1333 (defun outline-end-of-level (&optional backward)
1334 " Go to the last sibling at this level, visible or not."
1336 (while (outline-previous-sibling))
1337 (prog1 (outline-recent-depth)
1338 (if (interactive-p) (outline-end-of-prefix)))
1340 ;;;_ > outline-forward-current-level (arg &optional backward)
1341 (defun outline-forward-current-level (arg &optional backward)
1342 " Position the point at the next heading of the same level, taking
1343 optional repeat-count.
1345 Returns that position, else nil if is not found."
1346 (interactive "p")
1347 (outline-back-to-current-heading)
1348 (let ((amt (if arg (if (< arg 0)
1349 ;; Negative arg - invert direction.
1350 (progn (setq backward (not backward))
1351 (abs arg))
1352 arg);; Positive arg - just use it.
1353 1)));; No arg - use 1:
1354 (while (and (> amt 0)
1355 (outline-next-sibling backward))
1356 (setq amt (1- amt)))
1357 (if (interactive-p) (outline-end-of-prefix))
1358 (if (> amt 0)
1359 (error "This is the %s topic on level %d."
1360 (if backward "first" "last")
1361 (outline-current-depth))
1365 ;;;_ > outline-backward-current-level (arg)
1366 (defun outline-backward-current-level (arg)
1367 " Position the point at the previous heading of the same level, taking
1368 optional repeat-count.
1370 Returns that position, else nil if is not found."
1371 (interactive "p")
1372 (unwind-protect
1373 (outline-forward-current-level arg t)
1374 (outline-end-of-prefix))
1377 ;;;_ : Search with Dynamic Exposure (requires isearch-mode)
1378 ;;;_ = outline-search-reconceal
1379 (defvar outline-search-reconceal nil
1380 "Used for outline isearch provisions, to track whether current search
1381 match was concealed outside of search. The value is the location of the
1382 match, if it was concealed, regular if the entire topic was concealed, in
1383 a list if the entry was concealed.")
1384 ;;;_ = outline-search-quitting
1385 (defconst outline-search-quitting nil
1386 "Variable used by isearch-terminate/outline-provisions and
1387 isearch-done/outline-provisions to distinguish between a conclusion
1388 and cancellation of a search.")
1390 ;;;_ > outline-enwrap-isearch ()
1391 (defun outline-enwrap-isearch ()
1392 " Impose isearch-mode wrappers so isearch progressively exposes and
1393 reconceals hidden topics when working in outline mode, but works
1394 elsewhere.
1396 The function checks to ensure that the rebindings are done only once."
1398 ; Should isearch-mode be employed,
1399 (if (or (not outline-enwrap-isearch-mode)
1400 ; or are preparations already done?
1401 (fboundp 'real-isearch-terminate))
1403 ;; ... no - skip this all:
1406 ;; ... yes:
1408 ; Ensure load of isearch-mode:
1409 (if (or (and (fboundp 'isearch-mode)
1410 (fboundp 'isearch-quote-char))
1411 (condition-case error
1412 (load-library outline-enwrap-isearch-mode)
1413 (file-error (message "Skipping isearch-mode provisions - %s '%s'"
1414 (car (cdr error))
1415 (car (cdr (cdr error))))
1416 (sit-for 1)
1417 ;; Inhibit subsequent tries and return nil:
1418 (setq outline-enwrap-isearch-mode nil))))
1419 ;; Isearch-mode loaded, encapsulate specific entry points for
1420 ;; outline dynamic-exposure business:
1421 (progn
1423 ; stash crucial isearch-mode
1424 ; funcs under known, private
1425 ; names, then register wrapper
1426 ; functions under the old
1427 ; names, in their stead:
1428 ; 'isearch-quit' is pre v 1.2:
1429 (fset 'real-isearch-terminate
1430 ; 'isearch-quit is pre v 1.2:
1431 (or (if (fboundp 'isearch-quit)
1432 (symbol-function 'isearch-quit))
1433 (if (fboundp 'isearch-abort)
1434 ; 'isearch-abort' is v 1.2 and on:
1435 (symbol-function 'isearch-abort))))
1436 (fset 'isearch-quit 'isearch-terminate/outline-provisions)
1437 (fset 'isearch-abort 'isearch-terminate/outline-provisions)
1438 (fset 'real-isearch-done (symbol-function 'isearch-done))
1439 (fset 'isearch-done 'isearch-done/outline-provisions)
1440 (fset 'real-isearch-update (symbol-function 'isearch-update))
1441 (fset 'isearch-update 'isearch-update/outline-provisions)
1442 (make-variable-buffer-local 'outline-search-reconceal))
1446 ;;;_ > outline-isearch-arrival-business ()
1447 (defun outline-isearch-arrival-business ()
1448 " Do outline business like exposing current point, if necessary,
1449 registering reconcealment requirements in outline-search-reconceal
1450 accordingly.
1452 Set outline-search-reconceal to nil if current point is not
1453 concealed, to value of point if entire topic is concealed, and a
1454 list containing point if only the topic body is concealed.
1456 This will be used to determine whether outline-hide-current-entry
1457 or outline-hide-current-entry-completely will be necessary to
1458 restore the prior concealment state."
1460 (if (and (boundp 'outline-mode) outline-mode)
1461 (setq outline-search-reconceal
1462 (if (outline-hidden-p)
1463 (save-excursion
1464 (if (re-search-backward outline-line-boundary-regexp nil 1)
1465 ;; Nil value means we got to b-o-b - wouldn't need
1466 ;; to advance.
1467 (forward-char 1))
1468 ; We'll return point or list
1469 ; containing point, depending
1470 ; on concealment state of
1471 ; topic prefix.
1472 (prog1 (if (outline-hidden-p) (point) (list (point)))
1473 ; And reveal the current
1474 ; search target:
1475 (outline-show-entry)))))))
1476 ;;;_ > outline-isearch-advancing-business ()
1477 (defun outline-isearch-advancing-business ()
1478 " Do outline business like deexposing current point, if necessary,
1479 according to reconceal state registration."
1480 (if (and (boundp 'outline-mode) outline-mode outline-search-reconceal)
1481 (save-excursion
1482 (if (listp outline-search-reconceal)
1483 ;; Leave the topic visible:
1484 (progn (goto-char (car outline-search-reconceal))
1485 (outline-hide-current-entry))
1486 ;; Rehide the entire topic:
1487 (goto-char outline-search-reconceal)
1488 (outline-hide-current-entry-completely))))
1490 ;;;_ > isearch-terminate/outline-provisions ()
1491 (defun isearch-terminate/outline-provisions ()
1492 (interactive)
1493 (if (and (boundp 'outline-mode)
1494 outline-mode
1495 outline-enwrap-isearch-mode)
1496 (outline-isearch-advancing-business))
1497 (let ((outline-search-quitting t)
1498 (outline-search-reconceal nil))
1499 (real-isearch-terminate)))
1500 ;;;_ > isearch-done/outline-provisions ()
1501 (defun isearch-done/outline-provisions (&optional nopush)
1502 (interactive)
1503 (if (and (boundp 'outline-mode)
1504 outline-mode
1505 outline-enwrap-isearch-mode)
1506 (progn (save-excursion
1507 (if (and outline-search-reconceal
1508 (not (listp outline-search-reconceal)))
1509 ;; The topic was concealed - reveal it, its siblings,
1510 ;; and any ancestors that are still concealed:
1511 (progn
1512 (message "(exposing destination)")(sit-for 0)
1513 ;; Ensure target topic's siblings are exposed:
1514 (outline-ascend-to-depth (1- (outline-current-depth)))
1515 ;; Ensure that the target topic's ancestors are exposed
1516 (while (outline-hidden-p)
1517 (outline-show-current-children))
1518 (outline-show-current-children)
1519 (outline-show-current-entry)))
1520 (outline-isearch-arrival-business))
1521 (if (not (and (boundp 'outline-search-quitting)
1522 outline-search-quitting))
1523 (outline-show-current-children))))
1524 (if nopush
1525 ;; isearch-done in newer version of isearch mode takes arg:
1526 (real-isearch-done nopush)
1527 (real-isearch-done)))
1528 ;;;_ > isearch-update/outline-provisions ()
1529 (defun isearch-update/outline-provisions ()
1530 " Wrapper around isearch which exposes and conceals hidden outline
1531 portions encountered in the course of searching."
1532 (if (not (and (boundp 'outline-mode)
1533 outline-mode
1534 outline-enwrap-isearch-mode))
1535 ;; Just do the plain business:
1536 (real-isearch-update)
1538 ;; Ah - provide for outline conditions:
1539 (outline-isearch-advancing-business)
1540 (real-isearch-update)
1541 (cond (isearch-success (outline-isearch-arrival-business))
1542 ((not isearch-success) (outline-isearch-advancing-business)))
1546 ;;;_ #5 Manipulation
1548 ;;;_ : Topic Format Assessment
1549 ;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet)
1550 (defun outline-solicit-alternate-bullet (depth &optional current-bullet)
1552 " Prompt for and return a bullet char as an alternative to the
1553 current one, but offer one suitable for current depth DEPTH
1554 as default."
1556 (let* ((default-bullet (or current-bullet
1557 (outline-bullet-for-depth depth)))
1558 (choice (solicit-char-in-string
1559 (format "Select bullet: %s ('%s' default): "
1560 outline-bullets-string
1561 default-bullet)
1562 (string-sans-char outline-bullets-string ?\\)
1563 t)))
1564 (if (string= choice "") default-bullet choice))
1566 ;;;_ > outline-sibling-index (&optional depth)
1567 (defun outline-sibling-index (&optional depth)
1568 " Item number of this prospective topic among it's siblings.
1570 If optional arg depth is greater than current depth, then we're
1571 opening a new level, and return 0.
1573 If less than this depth, ascend to that depth and count..."
1575 (save-excursion
1576 (cond ((and depth (<= depth 0) 0))
1577 ((or (not depth) (= depth (outline-depth)))
1578 (let ((index 1))
1579 (while (outline-previous-sibling) (setq index (1+ index)))
1580 index))
1581 ((< depth (outline-recent-depth))
1582 (outline-ascend-to-depth depth)
1583 (outline-sibling-index))
1584 (0))))
1585 ;;;_ > outline-distinctive-bullet (bullet)
1586 (defun outline-distinctive-bullet (bullet)
1587 " True if bullet is one of those on outline-distinctive-bullets-string."
1588 (string-match (regexp-quote bullet) outline-distinctive-bullets-string))
1589 ;;;_ > outline-numbered-type-prefix (&optional prefix)
1590 (defun outline-numbered-type-prefix (&optional prefix)
1591 " True if current header prefix bullet is numbered bullet."
1592 (and outline-numbered-bullet
1593 (string= outline-numbered-bullet
1594 (if prefix
1595 (outline-get-prefix-bullet prefix)
1596 (outline-get-bullet)))))
1597 ;;;_ > outline-bullet-for-depth (&optional depth)
1598 (defun outline-bullet-for-depth (&optional depth)
1599 " Return outline topic bullet suited to DEPTH, or for current depth if none
1600 specified."
1601 ;; Find bullet in plain-bullets-string modulo DEPTH.
1602 (if outline-stylish-prefixes
1603 (char-to-string (aref outline-plain-bullets-string
1604 (% (max 0 (- depth 2))
1605 outline-plain-bullets-string-len)))
1606 outline-primary-bullet)
1609 ;;;_ : Topic Production
1610 ;;;_ > outline-make-topic-prefix (&optional prior-bullet
1611 (defun outline-make-topic-prefix (&optional prior-bullet
1613 depth
1614 solicit
1615 number-control
1616 index)
1617 ;; Depth null means use current depth, non-null means we're either
1618 ;; opening a new topic after current topic, lower or higher, or we're
1619 ;; changing level of current topic.
1620 ;; Solicit dominates specified bullet-char.
1621 " Generate a topic prefix suitable for optional arg DEPTH, or current
1622 depth if not specified.
1624 All the arguments are optional.
1626 PRIOR-BULLET indicates the bullet of the prefix being changed, or
1627 nil if none. This bullet may be preserved (other options
1628 notwithstanding) if it is on the outline-distinctive-bullets-string,
1629 for instance.
1631 Second arg NEW indicates that a new topic is being opened after the
1632 topic at point, if non-nil. Default bullet for new topics, eg, may
1633 be set (contingent to other args) to numbered bullets if previous
1634 sibling is one. The implication otherwise is that the current topic
1635 is being adjusted - shifted or rebulleted - and we don't consider
1636 bullet or previous sibling.
1638 Third arg DEPTH forces the topic prefix to that depth, regardless of
1639 the current topics' depth.
1641 Fourth arg SOLICIT non-nil provokes solicitation from the user of a
1642 choice among the valid bullets. (This overrides other all the
1643 options, including, eg, a distinctive PRIOR-BULLET.)
1645 Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet'
1646 is non-nil *and* soliciting was not explicitly invoked. Then
1647 NUMBER-CONTROL non-nil forces prefix to either numbered or
1648 denumbered format, depending on the value of the sixth arg, INDEX.
1650 (Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...)
1652 If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then
1653 the prefix of the topic is forced to be numbered. Non-nil
1654 NUMBER-CONTROL and nil INDEX forces non-numbered format on the
1655 bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means
1656 that the index for the numbered prefix will be derived, by counting
1657 siblings back to start of level. If INDEX is a number, then that
1658 number is used as the index for the numbered prefix (allowing, eg,
1659 sequential renumbering to not require this function counting back the
1660 index for each successive sibling)."
1662 ;; The options are ordered in likely frequence of use, most common
1663 ;; highest, least lowest. Ie, more likely to be doing prefix
1664 ;; adjustments than soliciting, and yet more than numbering.
1665 ;; Current prefix is least dominant, but most likely to be commonly
1666 ;; specified...
1668 (let* (body
1669 numbering
1670 denumbering
1671 (depth (or depth (outline-depth)))
1672 (header-lead outline-header-prefix)
1673 (bullet-char
1675 ;; Getting value for bullet char is practically the whole job:
1677 (cond
1678 ; Simplest situation - level 1:
1679 ((<= depth 1) (setq header-lead "") outline-primary-bullet)
1680 ; Simple, too: all asterisks:
1681 (outline-old-style-prefixes
1682 ;; Cheat - make body the whole thing, null out header-lead and
1683 ;; bullet-char:
1684 (setq body (make-string depth
1685 (string-to-char outline-primary-bullet)))
1686 (setq header-lead "")
1689 ;; (Neither level 1 nor old-style, so we're space padding.
1690 ;; Sneak it in the condition of the next case, whatever it is.)
1692 ;; Solicitation overrides numbering and other cases:
1693 ((progn (setq body (make-string (- depth 2) ?\ ))
1694 ;; The actual condition:
1695 solicit)
1696 (let* ((got (outline-solicit-alternate-bullet depth)))
1697 ;; Gotta check whether we're numbering and got a numbered bullet:
1698 (setq numbering (and outline-numbered-bullet
1699 (not (and number-control (not index)))
1700 (string= got outline-numbered-bullet)))
1701 ;; Now return what we got, regardless:
1702 got))
1704 ;; Numbering invoked through args:
1705 ((and outline-numbered-bullet number-control)
1706 (if (setq numbering (not (setq denumbering (not index))))
1707 outline-numbered-bullet
1708 (if (and current-bullet
1709 (not (string= outline-numbered-bullet
1710 current-bullet)))
1711 current-bullet
1712 (outline-bullet-for-depth depth))))
1714 ;;; Neither soliciting nor controlled numbering ;;;
1715 ;;; (may be controlled denumbering, tho) ;;;
1717 ;; Check wrt previous sibling:
1718 ((and new ; only check for new prefixes
1719 (<= depth (outline-depth))
1720 outline-numbered-bullet ; ... & numbering enabled
1721 (not denumbering)
1722 (let ((sibling-bullet
1723 (save-excursion
1724 ;; Locate correct sibling:
1725 (or (>= depth (outline-depth))
1726 (outline-ascend-to-depth depth))
1727 (outline-get-bullet))))
1728 (if (and sibling-bullet
1729 (string= outline-numbered-bullet sibling-bullet))
1730 (setq numbering sibling-bullet)))))
1732 ;; Distinctive prior bullet?
1733 ((and prior-bullet
1734 (outline-distinctive-bullet prior-bullet)
1735 ;; Either non-numbered:
1736 (or (not (and outline-numbered-bullet
1737 (string= prior-bullet outline-numbered-bullet)))
1738 ;; or numbered, and not denumbering:
1739 (setq numbering (not denumbering)))
1740 ;; Here 'tis:
1741 prior-bullet))
1743 ;; Else, standard bullet per depth:
1744 ((outline-bullet-for-depth depth)))))
1746 (concat header-lead
1747 body
1748 bullet-char
1749 (if numbering
1750 (format "%d" (cond ((and index (numberp index)) index)
1751 (new (1+ (outline-sibling-index depth)))
1752 ((outline-sibling-index))))))
1755 ;;;_ > open-topic (relative-depth &optional before)
1756 (defun open-topic (relative-depth &optional before)
1757 " Open a new topic at depth DEPTH. New topic is situated after current
1758 one, unless optional flag BEFORE is non-nil, or unless current line
1759 is complete empty (not even whitespace), in which case open is done
1760 on current line.
1762 Nuances:
1764 - Creation of new topics is with respect to the visible topic
1765 containing the cursor, regardless of intervening concealed ones.
1767 - New headers are generally created after/before the body of a
1768 topic. However, they are created right at cursor location if the
1769 cursor is on a blank line, even if that breaks the current topic
1770 body. This is intentional, to provide a simple means for
1771 deliberately dividing topic bodies.
1773 - Double spacing of topic lists is preserved. Also, the first
1774 level two topic is created double-spaced (and so would be
1775 subsequent siblings, if that's left intact). Otherwise,
1776 single-spacing is used.
1778 - Creation of sibling or nested topics is with respect to the topic
1779 you're starting from, even when creating backwards. This way you
1780 can easily create a sibling in front of the current topic without
1781 having to go to its preceding sibling, and then open forward
1782 from there."
1784 (let* ((depth (+ (outline-current-depth) relative-depth))
1785 (opening-on-blank (if (looking-at "^\$")
1786 (not (setq before nil))))
1787 opening-numbered ; Will get while computing ref-topic, below
1788 ref-depth ; Will get while computing ref-topic, next
1789 (ref-topic (save-excursion
1790 (cond ((< relative-depth 0)
1791 (outline-ascend-to-depth depth))
1792 ((>= relative-depth 1) nil)
1793 (t (outline-back-to-current-heading)))
1794 (setq ref-depth (outline-recent-depth))
1795 (setq opening-numbered
1796 (save-excursion
1797 (and outline-numbered-bullet
1798 (or (<= relative-depth 0)
1799 (outline-descend-to-depth depth))
1800 (if (outline-numbered-type-prefix)
1801 outline-numbered-bullet))))
1802 (point)))
1803 dbl-space
1804 doing-beginning
1807 (if (not opening-on-blank)
1808 ; Positioning and vertical
1809 ; padding - only if not
1810 ; opening-on-blank:
1811 (progn
1812 (goto-char ref-topic)
1813 (setq dbl-space ; Determine double space action:
1814 (or (and (not (> relative-depth 0))
1815 ;; not descending,
1816 (save-excursion
1817 ;; preceded by a blank line?
1818 (forward-line -1)
1819 (looking-at "^\\s-*$")))
1820 (and (= ref-depth 1)
1821 (or before
1822 (= depth 1)
1823 (save-excursion
1824 ;; Don't already have following
1825 ;; vertical padding:
1826 (not (outline-pre-next-preface)))))))
1828 ; Position to prior heading,
1829 ; if inserting backwards:
1830 (if before (progn (outline-back-to-current-heading)
1831 (setq doing-beginning (bobp))
1832 (if (and (not (outline-previous-sibling))
1833 (not (bobp)))
1834 (outline-previous-heading))))
1836 (if (and (<= depth ref-depth)
1837 (= ref-depth (outline-current-depth)))
1838 ;; Not going inwards, don't snug up:
1839 (if doing-beginning
1840 (open-line (if dbl-space 2 1))
1841 (outline-end-of-current-subtree))
1842 ;; Going inwards - double-space if first offspring is,
1843 ;; otherwise snug up.
1844 (end-of-line) ; So we skip any concealed progeny.
1845 (outline-pre-next-preface)
1846 (if (bolp)
1847 ;; Blank lines between current header body and next
1848 ;; header - get to last substantive (non-white-space)
1849 ;; line in body:
1850 (re-search-backward "[^ \t\n]" nil t))
1851 (if (save-excursion
1852 (outline-next-heading)
1853 (if (> (outline-recent-depth) ref-depth)
1854 ;; This is an offspring.
1855 (progn (forward-line -1)
1856 (looking-at "^\\s-*$"))))
1857 (progn (forward-line 1)
1858 (open-line 1)))
1859 (end-of-line))
1860 ;;(if doing-beginning (goto-char doing-beginning))
1861 (if (not (bobp)) (newline (if dbl-space 2 1)))
1863 (insert-string (concat (outline-make-topic-prefix opening-numbered
1865 depth)
1866 " "))
1868 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1))))
1871 (outline-rebullet-heading nil ;;; solicit
1872 depth ;;; depth
1873 nil ;;; number-control
1874 nil ;;; index
1875 t) (end-of-line)
1878 ;;;_ > open-subtopic (arg)
1879 (defun open-subtopic (arg)
1880 " Open new topic header at deeper level than the current one.
1882 Negative universal arg means to open deeper, but place the new topic
1883 prior to the current one."
1884 (interactive "p")
1885 (open-topic 1 (> 0 arg)))
1886 ;;;_ > open-sibtopic (arg)
1887 (defun open-sibtopic (arg)
1888 " Open new topic header at same level as the current one. Negative
1889 universal arg means to place the new topic prior to the current
1890 one."
1891 (interactive "p")
1892 (open-topic 0 (> 0 arg)))
1893 ;;;_ > open-supertopic (arg)
1894 (defun open-supertopic (arg)
1895 " Open new topic header at shallower level than the current one.
1896 Negative universal arg means to open shallower, but place the new
1897 topic prior to the current one."
1899 (interactive "p")
1900 (open-topic -1 (> 0 arg)))
1902 ;;;_ : Outline Alteration
1903 ;;;_ . Topic Form Modification
1904 ;;;_ > outline-reindent-body (old-depth new-depth)
1905 (defun outline-reindent-body (old-depth new-depth)
1906 " Reindent body lines which were indented at old-depth to new-depth.
1908 Note that refill of indented paragraphs is not done, and tabs are
1909 not accommodated. ('untabify' your outline if you want to preserve
1910 hanging body indents.)"
1912 (save-excursion
1913 (save-restriction
1914 (outline-goto-prefix)
1915 (forward-char 1)
1916 (let* ((old-spaces-expr (make-string (1+ old-depth) ?\ ))
1917 (new-spaces-expr (concat (make-string (1+ new-depth) ?\ )
1918 ;; spaces followed by non-space:
1919 "\\1")))
1920 (while (and (re-search-forward "[\C-j\C-m]" nil t)
1921 (not (looking-at outline-regexp)))
1922 (if (looking-at old-spaces-expr)
1923 (replace-match new-spaces-expr)))))))
1924 ;;;_ > outline-rebullet-current-heading (arg)
1925 (defun outline-rebullet-current-heading (arg)
1926 " Like non-interactive version 'outline-rebullet-heading', but work on
1927 (only) visible heading containing point.
1929 With repeat count, solicit for bullet."
1930 (interactive "P")
1931 (save-excursion (outline-back-to-current-heading)
1932 (outline-end-of-prefix)
1933 (outline-rebullet-heading (not arg) ;;; solicit
1934 nil ;;; depth
1935 nil ;;; number-control
1936 nil ;;; index
1937 t) ;;; do-successors
1940 ;;;_ > outline-rebullet-heading (&optional solicit ...)
1941 (defvar current-bullet nil
1942 "Variable local to outline-rebullet-heading,but referenced by
1943 outline-make-topic-prefix, also. Should be resolved with explicitly
1944 parameterized communication between the two, if suitable.")
1945 (defun outline-rebullet-heading (&optional solicit
1946 new-depth
1947 number-control
1948 index
1949 do-successors)
1951 " Adjust bullet of current topic prefix.
1953 All args are optional.
1955 If SOLICIT is non-nil then the choice of bullet is solicited from
1956 user. Otherwise the distinctiveness of the bullet or the topic
1957 depth determines it.
1959 Second arg DEPTH forces the topic prefix to that depth, regardless
1960 of the topic's current depth.
1962 Third arg NUMBER-CONTROL can force the prefix to or away from
1963 numbered form. It has effect only if 'outline-numbered-bullet' is
1964 non-nil and soliciting was not explicitly invoked (via first arg).
1965 Its effect, numbering or denumbering, then depends on the setting
1966 of the forth arg, INDEX.
1968 If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the
1969 prefix of the topic is forced to be non-numbered. Null index and
1970 non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
1971 non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
1972 INDEX is a number, then that number is used for the numbered
1973 prefix. Non-nil and non-number means that the index for the
1974 numbered prefix will be derived by outline-make-topic-prefix.
1976 Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
1977 siblings.
1979 Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes',
1980 and 'outline-numbered-bullet', which all affect the behavior of
1981 this function."
1983 (let* ((current-depth (outline-depth))
1984 (new-depth (or new-depth current-depth))
1985 (mb outline-recent-prefix-beginning)
1986 (me outline-recent-prefix-end)
1987 (current-bullet (buffer-substring (- me 1) me))
1988 (new-prefix (outline-make-topic-prefix current-bullet
1990 new-depth
1991 solicit
1992 number-control
1993 index)))
1995 ;; Don't need to reinsert identical one:
1996 (if (and (= current-depth new-depth)
1997 (string= current-bullet
1998 (substring new-prefix (1- (length new-prefix)))))
2001 ;; New prefix probably different from old:
2002 ;; get rid of old one:
2003 (delete-region mb me)
2004 (goto-char mb)
2005 ;; Dispense with number if numbered-bullet prefix:
2006 (if (and outline-numbered-bullet
2007 (string= outline-numbered-bullet current-bullet)
2008 (looking-at "[0-9]+"))
2009 (delete-region (match-beginning 0)(match-end 0)))
2011 ;; Put in new prefix:
2012 (insert-string new-prefix)
2015 ;; Reindent the body if elected and depth changed:
2016 (if (and outline-reindent-bodies
2017 (not (= new-depth current-depth)))
2018 (outline-reindent-body current-depth new-depth))
2020 ;; Recursively rectify successive siblings if selected:
2021 (if do-successors
2022 (save-excursion
2023 (while (outline-next-sibling)
2024 (setq index
2025 (cond ((numberp index) (1+ index))
2026 ((not number-control) (outline-sibling-index))))
2027 (if (outline-numbered-type-prefix)
2028 (outline-rebullet-heading nil ;;; solicit
2029 new-depth ;;; new-depth
2030 number-control;;; number-control
2031 index ;;; index
2032 nil))))) ;;;(dont!)do-successors
2035 ;;;_ > outline-rebullet-topic (arg)
2036 (defun outline-rebullet-topic (arg)
2037 " Like outline-rebullet-topic-grunt, but start from topic visible at point.
2038 Descends into invisible as well as visible topics, however.
2040 With repeat count, shift topic depth by that amount."
2041 (interactive "P")
2042 (let ((start-col (current-column))
2043 (was-eol (eolp)))
2044 (save-excursion
2045 ;; Normalize arg:
2046 (cond ((null arg) (setq arg 0))
2047 ((listp arg) (setq arg (car arg))))
2048 ;; Fill the user in, in case we're shifting a big topic:
2049 (if (not (zerop arg)) (message "Shifting..."))
2050 (outline-back-to-current-heading)
2051 (if (<= (+ (outline-recent-depth) arg) 0)
2052 (error "Attempt to shift topic below level 1"))
2053 (outline-rebullet-topic-grunt arg)
2054 (if (not (zerop arg)) (message "Shifting... done.")))
2055 (move-to-column (max 0 (+ start-col arg))))
2057 ;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...)
2058 (defun outline-rebullet-topic-grunt (&optional relative-depth
2059 starting-depth
2060 starting-point
2061 index
2062 do-successors)
2064 " Rebullet the topic at point, visible or invisible, and all
2065 contained subtopics. See outline-rebullet-heading for rebulleting
2066 behavior.
2068 All arguments are optional.
2070 First arg RELATIVE-DEPTH means to shift the depth of the entire
2071 topic that amount.
2073 The rest of the args are for internal recursive use by the function
2074 itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX."
2076 (let* ((relative-depth (or relative-depth 0))
2077 (new-depth (outline-depth))
2078 (starting-depth (or starting-depth new-depth))
2079 (on-starting-call (null starting-point))
2080 (index (or index
2081 ;; Leave index null on starting call, so rebullet-heading
2082 ;; calculates it at what might be new depth:
2083 (and (or (zerop relative-depth)
2084 (not on-starting-call))
2085 (outline-sibling-index))))
2086 (moving-outwards (< 0 relative-depth))
2087 (starting-point (or starting-point (point))))
2089 ;; Sanity check for excessive promotion done only on starting call:
2090 (and on-starting-call
2091 moving-outwards
2092 (> 0 (+ starting-depth relative-depth))
2093 (error "Attempt to shift topic out beyond level 1.")) ;;; ====>
2095 (cond ((= starting-depth new-depth)
2096 ;; We're at depth to work on this one:
2097 (outline-rebullet-heading nil ;;; solicit
2098 (+ starting-depth ;;; starting-depth
2099 relative-depth)
2100 nil ;;; number
2101 index ;;; index
2102 ;; Every contained topic will get hit,
2103 ;; and we have to get to outside ones
2104 ;; deliberately:
2105 nil) ;;; do-successors
2106 ;; ... and work on subsequent ones which are at greater depth:
2107 (setq index 0)
2108 (outline-next-heading)
2109 (while (and (not (eobp))
2110 (< starting-depth (outline-recent-depth)))
2111 (setq index (1+ index))
2112 (outline-rebullet-topic-grunt relative-depth ;;; relative-depth
2113 (1+ starting-depth);;;starting-depth
2114 starting-point ;;; starting-point
2115 index))) ;;; index
2117 ((< starting-depth new-depth)
2118 ;; Rare case - subtopic more than one level deeper than parent.
2119 ;; Treat this one at an even deeper level:
2120 (outline-rebullet-topic-grunt relative-depth ;;; relative-depth
2121 new-depth ;;; starting-depth
2122 starting-point ;;; starting-point
2123 index))) ;;; index
2125 (if on-starting-call
2126 (progn
2127 ;; Rectify numbering of former siblings of the adjusted topic,
2128 ;; if topic has changed depth
2129 (if (or do-successors
2130 (and (not (zerop relative-depth))
2131 (or (= (outline-recent-depth) starting-depth)
2132 (= (outline-recent-depth) (+ starting-depth
2133 relative-depth)))))
2134 (outline-rebullet-heading nil nil nil nil t))
2135 ;; Now rectify numbering of new siblings of the adjusted topic,
2136 ;; if depth has been changed:
2137 (progn (goto-char starting-point)
2138 (if (not (zerop relative-depth))
2139 (outline-rebullet-heading nil nil nil nil t)))))
2142 ;;;_ > outline-number-siblings (&optional denumber)
2143 (defun outline-number-siblings (&optional denumber)
2144 " Assign numbered topic prefix to this topic and its siblings.
2146 With universal argument, denumber - assign default bullet to this
2147 topic and its siblings.
2149 With repeated universal argument (`^U^U'), solicit bullet for each
2150 rebulleting each topic at this level."
2152 (interactive "P")
2154 (save-excursion
2155 (outline-back-to-current-heading)
2156 (outline-beginning-of-level)
2157 (let ((index (if (not denumber) 1))
2158 (use-bullet (equal '(16) denumber))
2159 (more t))
2160 (while more
2161 (outline-rebullet-heading use-bullet ;;; solicit
2162 nil ;;; depth
2163 t ;;; number-control
2164 index ;;; index
2165 nil) ;;; do-successors
2166 (if index (setq index (1+ index)))
2167 (setq more (outline-next-sibling)))
2171 ;;;_ > outline-shift-in (arg)
2172 (defun outline-shift-in (arg)
2173 " Decrease prefix depth of current heading and any topics collapsed
2174 within it."
2175 (interactive "p")
2176 (outline-rebullet-topic arg))
2177 ;;;_ > outline-shift-out (arg)
2178 (defun outline-shift-out (arg)
2179 " Decrease prefix depth of current heading and any topics collapsed
2180 within it."
2181 (interactive "p")
2182 (outline-rebullet-topic (* arg -1)))
2183 ;;;_ . Surgery (kill-ring) functions with special provisions for outlines:
2184 ;;;_ > outline-kill-line (&optional arg)
2185 (defun outline-kill-line (&optional arg)
2186 " Kill line, adjusting subsequent lines suitably for outline mode."
2188 (interactive "*P")
2189 (if (not (and
2190 (boundp 'outline-mode) outline-mode ; active outline mode,
2191 outline-numbered-bullet ; numbers may need adjustment,
2192 (bolp) ; may be clipping topic head,
2193 (looking-at outline-regexp))) ; are clipping topic head.
2194 ;; Above conditions do not obtain - just do a regular kill:
2195 (kill-line arg)
2196 ;; Ah, have to watch out for adjustments:
2197 (let* ((depth (outline-depth))
2198 (ascender depth))
2199 (kill-line arg)
2200 (sit-for 0)
2201 (save-excursion
2202 (if (not (looking-at outline-regexp))
2203 (outline-next-heading))
2204 (if (> (outline-depth) depth)
2205 ;; An intervening parent was removed from after a subtree:
2206 (setq depth (outline-recent-depth)))
2207 (while (and (> (outline-depth) 0)
2208 (> (outline-recent-depth) ascender)
2209 (outline-ascend-to-depth (setq ascender
2210 (1- ascender)))))
2211 ;; Have to try going forward until we find another at
2212 ;; desired depth:
2213 (if (and outline-numbered-bullet
2214 (outline-descend-to-depth depth))
2215 (outline-rebullet-heading nil ;;; solicit
2216 depth ;;; depth
2217 nil ;;; number-control
2218 nil ;;; index
2219 t) ;;; do-successors
2225 ;;;_ > outline-kill-topic ()
2226 (defun outline-kill-topic ()
2227 " Kill topic together with subtopics."
2229 ;; Some finagling is done to make complex topic kills appear faster
2230 ;; than they actually are. A redisplay is performed immediately
2231 ;; after the region is disposed of, though the renumbering process
2232 ;; has yet to be performed. This means that there may appear to be
2233 ;; a lag *after* the kill has been performed.
2235 (interactive)
2236 (let* ((beg (outline-back-to-current-heading))
2237 (depth (outline-recent-depth)))
2238 (outline-end-of-current-subtree)
2239 (if (not (eobp))
2240 (forward-char 1))
2241 (kill-region beg (point))
2242 (sit-for 0)
2243 (save-excursion
2244 (if (and outline-numbered-bullet
2245 (outline-descend-to-depth depth))
2246 (outline-rebullet-heading nil ;;; solicit
2247 depth ;;; depth
2248 nil ;;; number-control
2249 nil ;;; index
2250 t) ;;; do-successors
2255 ;;;_ > outline-yank (&optional arg)
2256 (defun outline-yank (&optional arg)
2257 " Like regular yank, except does depth adjustment of yanked topics, when:
2259 1 the stuff being yanked starts with a valid outline header prefix, and
2260 2 it is being yanked at the end of a line which consists of only a valid
2261 topic prefix.
2263 If these two conditions hold then the depth of the yanked topics
2264 are all adjusted the amount it takes to make the first one at the
2265 depth of the header into which it's being yanked.
2267 The point is left in from of yanked, adjusted topics, rather than
2268 at the end (and vice-versa with the mark). Non-adjusted yanks,
2269 however, (ones that don't qualify for adjustment) are handled
2270 exactly like normal yanks.
2272 Outline-yank-pop is used with outline-yank just as normal yank-pop
2273 is used with normal yank in non-outline buffers."
2275 (interactive "*P")
2276 (setq this-command 'yank)
2277 (if (not (and (boundp 'outline-mode) outline-mode))
2279 ;; Outline irrelevant - just do regular yank:
2280 (yank arg)
2282 ;; Outline *is* relevant:
2283 (let ((beginning (point))
2284 topic-yanked
2285 established-depth) ; Depth of the prefix into which we're yanking.
2286 ;; Get current depth and numbering ... Oops, not doing anything
2287 ;; with the number just yet...
2288 (if (and (eolp)
2289 (save-excursion (beginning-of-line)
2290 (looking-at outline-regexp)))
2291 (setq established-depth (- (match-end 0) (match-beginning 0))))
2292 (yank arg)
2293 (exchange-dot-and-mark)
2294 (if (and established-depth ; the established stuff qualifies.
2295 ;; The yanked stuff also qualifies - is topic(s):
2296 (looking-at (concat "\\(" outline-regexp "\\)")))
2297 ;; Ok, adjust the depth of the yanked stuff. Note that the
2298 ;; stuff may have more than a single root, so we have to
2299 ;; iterate over all the top level ones yanked, and do them in
2300 ;; such a way that the adjustment of one new one won't affect
2301 ;; any of the other new ones. We use the focus of the
2302 ;; narrowed region to successively exclude processed siblings.
2303 (let* ((yanked-beg (match-beginning 1))
2304 (yanked-end (match-end 1))
2305 (yanked-bullet (buffer-substring (1- yanked-end) yanked-end))
2306 (yanked-depth (- yanked-end yanked-beg))
2307 (depth-diff (- established-depth yanked-depth))
2308 done
2309 (more t))
2310 (setq topic-yanked t)
2311 (save-excursion
2312 (save-restriction
2313 (narrow-to-region yanked-beg (mark))
2314 ;; First trim off excessive blank line at end, if any:
2315 (goto-char (point-max))
2316 (if (looking-at "^$") (delete-char -1))
2317 (goto-char (point-min))
2318 ;; Work backwards, with each shallowest level,
2319 ;; successively excluding the last processed topic
2320 ;; from the narrow region:
2321 (goto-char (point-max))
2322 (while more
2323 (outline-back-to-current-heading)
2324 ;; go as high as we can in each bunch:
2325 (while (outline-ascend-to-depth
2326 (1- (outline-depth))))
2327 (save-excursion
2328 (outline-rebullet-topic-grunt depth-diff
2329 (outline-depth)
2330 (point)))
2331 (if (setq more (not (bobp)))
2332 (progn (widen)
2333 (forward-char -1)
2334 (narrow-to-region yanked-beg (point)))))))
2335 ;; Preserve new bullet if it's a distinctive one, otherwise
2336 ;; use old one:
2337 (if (string-match yanked-bullet outline-distinctive-bullets-string)
2338 (delete-region (save-excursion
2339 (beginning-of-line)
2340 (point))
2341 yanked-beg)
2342 (delete-region yanked-beg (+ yanked-beg established-depth))
2343 ;; and extraneous digits and a space:
2344 (while (looking-at "[0-9]") (delete-char 1))
2345 (if (looking-at " ") (delete-char 1))
2347 (goto-char yanked-beg)
2349 ;; Not established-depth or looking-at...
2350 (setq topic-yanked (looking-at outline-regexp))
2351 (exchange-dot-and-mark))
2352 (if (and topic-yanked outline-numbered-bullet)
2353 (progn
2354 ;; Renumber, in case necessary:
2355 (sit-for 0)
2356 (save-excursion
2357 (goto-char beginning)
2358 (if (outline-goto-prefix)
2359 (outline-rebullet-heading nil ;;; solicit
2360 (outline-depth) ;;; depth
2361 nil ;;; number-control
2362 nil ;;; index
2363 t) ;;; do-successors
2371 ;;;_ > outline-yank-pop (&optional arg)
2372 (defun outline-yank-pop (&optional arg)
2373 " Just like yank-pop, but works like outline-yank when popping
2374 topics just after fresh outline prefixes. Adapts level of popped
2375 stuff to level of fresh prefix."
2377 (interactive "*p")
2378 (if (not (eq last-command 'yank))
2379 (error "Previous command was not a yank"))
2380 (setq this-command 'yank)
2381 (delete-region (point) (mark))
2382 (rotate-yank-pointer arg)
2383 (outline-yank)
2386 ;;;_ : Specialty bullet functions
2387 ;;;_ . File Cross references
2388 ;;;_ > outline-resolve-xref ()
2389 (defun outline-resolve-xref ()
2390 " Pop to file associated with current heading, if it has an xref bullet
2391 (according to setting of 'outline-file-xref-bullet')."
2392 (interactive)
2393 (if (not outline-file-xref-bullet)
2394 (error
2395 "outline cross references disabled - no 'outline-file-xref-bullet'")
2396 (if (not (string= (outline-current-bullet) outline-file-xref-bullet))
2397 (error "current heading lacks cross-reference bullet '%s'"
2398 outline-file-xref-bullet)
2399 (let (file-name)
2400 (save-excursion
2401 (let* ((text-start outline-recent-prefix-end)
2402 (heading-end (progn (outline-pre-next-preface)
2403 (point))))
2404 (goto-char text-start)
2405 (setq file-name
2406 (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
2407 (buffer-substring (match-beginning 1) (match-end 1))))))
2408 (setq file-name
2409 (if (not (= (aref file-name 0) ?:))
2410 (expand-file-name file-name)
2411 ; A registry-files ref, strip the ':'
2412 ; and try to follow it:
2413 (let ((reg-ref (reference-registered-file
2414 (substring file-name 1) nil t)))
2415 (if reg-ref (car (cdr reg-ref))))))
2416 (if (or (file-exists-p file-name)
2417 (if (file-writable-p file-name)
2418 (y-or-n-p (format "%s not there, create one? "
2419 file-name))
2420 (error "%s not found and can't be created" file-name)))
2421 (condition-case failure
2422 (find-file-other-window file-name)
2423 (error failure))
2424 (error "%s not found" file-name))
2429 ;;;_ > outline-to-entry-end - Unmaintained compatibility - ignore this!
2430 ;-------------------------------------------------------------------
2431 ; Something added solely for use by a "smart menu" package someone got
2432 ; off the net. I have no idea whether this is appropriate code.
2434 (defvar next-entry-exists nil "Used by outline-to-entry-end, dunno why.")
2435 (defun outline-to-entry-end (&optional include-sub-entries curr-entry-level)
2436 " Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil.
2437 CURR-ENTRY-LEVEL is an integer representing the length of the current level
2438 string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil,
2439 CURR-ENTRY-LEVEL is not needed."
2440 (while (and (setq next-entry-exists
2441 (re-search-forward outline-regexp nil t))
2442 include-sub-entries
2443 (save-excursion
2444 (beginning-of-line)
2445 (> (outline-depth) curr-entry-level))))
2446 (if next-entry-exists
2447 (progn (beginning-of-line) (point))
2448 (goto-char (point-max))))
2449 ;;; Outline topic prefix and level adjustment funcs:
2451 ;;;_ #6 miscellaneous
2452 ;;;_ > outline-copy-exposed (&optional workbuf)
2453 (defun outline-copy-exposed (&optional workbuf)
2454 " Duplicate buffer to other buffer, sans hidden stuff.
2456 Without repeat count, this simple-minded function just generates
2457 the new buffer by concatenating the current buffer name with \"
2458 exposed\", and doing a 'get-buffer' on it."
2460 (interactive)
2461 (if (not workbuf) (setq workbuf (concat (buffer-name) " exposed")))
2462 (let ((buf (current-buffer)))
2463 (if (not (get-buffer workbuf))
2464 (generate-new-buffer workbuf))
2465 (pop-to-buffer workbuf)
2466 (erase-buffer)
2467 (insert-buffer buf)
2468 ;; (replace-regexp "\^M[^\^M\^J]*" "")
2469 (while (re-search-forward "\^M[^\^M\^J]*" nil t)
2470 (replace-match "" nil nil))
2471 (goto-char (point-min))
2474 ;;;_ > outlinify-sticky ()
2475 (defun outlinify-sticky (&optional arg)
2476 " Activate outline mode and establish file eval to set initial exposure.
2478 Invoke with a string argument to designate a string to prepend to
2479 topic prefixs, or with a universal argument to be prompted for the
2480 string to be used. Suitable defaults are provided for lisp,
2481 emacs-lisp, c, c++, awk, sh, csh, and perl modes."
2483 (interactive "P") (outline-mode t)
2484 (cond (arg
2485 (if (stringp arg)
2486 ;; Use arg as the header-prefix:
2487 (outline-lead-with-comment-string arg)
2488 ;; Otherwise, let function solicit string:
2489 (setq arg (outline-lead-with-comment-string))))
2490 ((member major-mode '(emacs-lisp-mode lisp-mode))
2491 (setq arg (outline-lead-with-comment-string ";;;_")))
2492 ((member major-mode '(awk-mode csh-mode sh-mode perl-mode))
2493 ;; Bare '#' (ie, not '#_') so we don't break the magic number:
2494 (setq arg (outline-lead-with-comment-string "#")))
2495 ((eq major-mode 'c++-mode)
2496 (setq arg (outline-lead-with-comment-string "//_")))
2497 ((eq major-mode 'c-mode)
2498 ;; User's will have to know to close off the comments:
2499 (setq arg (outline-lead-with-comment-string "/*_"))))
2500 (let* ((lead-prefix (format "%s%s"
2501 (concat outline-header-prefix (if arg " " ""))
2502 outline-primary-bullet))
2503 (lead-line (format "%s%s %s\n%s %s\n %s %s %s"
2504 (if arg outline-header-prefix "")
2505 outline-primary-bullet
2506 "Local emacs vars."
2507 "'(This topic sets initial outline exposure"
2508 "of the file when loaded by emacs,"
2509 "Encapsulate it in comments if"
2510 "file is a program"
2511 "otherwise ignore it,")))
2513 (save-excursion
2514 ; Put a topic at the top, if
2515 ; none there already:
2516 (goto-char (point-min))
2517 (if (not (looking-at outline-regexp))
2518 (insert-string
2519 (if (not arg) outline-primary-bullet
2520 (format "%s%s\n" outline-header-prefix outline-primary-bullet))))
2522 ; File-vars stuff, at the bottom:
2523 (goto-char (point-max))
2524 ; Insert preamble:
2525 (insert-string (format "\n\n%s\n%s %s %s\n%s %s "
2526 lead-line
2527 lead-prefix
2528 "local"
2529 "variables:"
2530 lead-prefix
2531 "eval:"))
2532 ; Insert outline-mode activation:
2533 (insert-string
2534 (format "%s\n\t\t%s\n\t\t\t%s\n"
2535 "(condition-case err"
2536 "(save-excursion"
2537 "(outline-mode t)"))
2538 ; Conditionally insert prefix
2539 ; leader customization:
2540 (if arg (insert-string (format "\t\t\t(%s \"%s\")\n"
2541 "outline-lead-with-comment-string"
2542 arg)))
2543 ; Insert announcement and
2544 ; exposure control:
2545 (insert-string
2546 (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s"
2547 "(message \"Adjusting '%s' visibility\""
2548 "(buffer-name))"
2549 "(goto-char 0)"
2550 "(outline-exposure -1 0))"
2551 "(error (message "
2552 "\"Failed file var 'allout' provisions\")))"))
2553 ; Insert postamble:
2554 (insert-string (format "\n%s End: )\n"
2555 lead-prefix)))))
2556 ;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
2557 (defun solicit-char-in-string (prompt string &optional do-defaulting)
2558 " Solicit (with first arg PROMPT) choice of a character from string STRING.
2560 Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
2562 (let ((new-prompt prompt)
2563 got)
2565 (while (not got)
2566 (message "%s" new-prompt)
2568 ;; We do our own reading here, so we can circumvent, eg, special
2569 ;; treatment for '?' character. (Might oughta change minibuffer
2570 ;; keymap instead, oh well.)
2571 (setq got
2572 (char-to-string (let ((cursor-in-echo-area t)) (read-char))))
2574 (if (null (string-match got string))
2575 (if (and do-defaulting (string= got "\^M"))
2576 ;; We're defaulting, return null string to indicate that:
2577 (setq got "")
2578 ;; Failed match and not defaulting,
2579 ;; set the prompt to give feedback,
2580 (setq new-prompt (concat prompt
2582 " ...pick from: "
2583 string
2584 ""))
2585 ;; and set loop to try again:
2586 (setq got nil))
2587 ;; Got a match - give feedback:
2588 (message "")))
2589 ;; got something out of loop - return it:
2590 got)
2592 ;;;_ > string-sans-char (string char)
2593 (defun string-sans-char (string char)
2594 " Return a copy of STRING that lacks all instances of CHAR."
2595 (cond ((string= string "") "")
2596 ((= (aref string 0) char) (string-sans-char (substring string 1) char))
2597 ((concat (substring string 0 1)
2598 (string-sans-char (substring string 1) char)))))
2600 ;;;_* Local emacs vars.
2602 Local variables:
2603 eval: (save-excursion
2604 (if (not (condition-case err (outline-mode t)
2605 (wrong-number-of-arguments nil)))
2606 (progn
2607 (message
2608 "Allout outline-mode not loaded, not adjusting buffer exposure")
2609 (sit-for 1))
2610 (message "Adjusting '%s' visibility" (buffer-name))
2611 (outline-lead-with-comment-string ";;;_")
2612 (goto-char 0)
2613 (outline-exposure (-1 () () () 1) 0)))
2614 End: