1 ;;; allout.el --- extensive outline mode for use alone and with other modes
3 ;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
7 ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
8 ;; Created: Dec 1991 -- first release to usenet
10 ;; Keywords: outlines wp languages
11 ;; Website: http://myriadicity.net/Sundry/EmacsAllout
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30 ;; Allout outline minor mode provides extensive outline formatting and
31 ;; and manipulation beyond standard emacs outline mode. Some features:
33 ;; - Classic outline-mode topic-oriented navigation and exposure adjustment
34 ;; - Topic-oriented editing including coherent topic and subtopic
35 ;; creation, promotion, demotion, cut/paste across depths, etc.
36 ;; - Incremental search with dynamic exposure and reconcealment of text
37 ;; - Customizable bullet format -- enables programming-language specific
38 ;; outlining, for code-folding editing. (Allout code itself is to try it;
39 ;; formatted as an outline -- do ESC-x eval-buffer in allout.el; but
40 ;; emacs local file variables need to be enabled when the
41 ;; file was visited -- see `enable-local-variables'.)
42 ;; - Configurable per-file initial exposure settings
43 ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase
44 ;; mnemonic support, with verification against an established passphrase
45 ;; (using a stashed encrypted dummy string) and user-supplied hint
46 ;; maintenance. (See allout-toggle-current-subtree-encryption docstring.
47 ;; Currently only GnuPG encryption is supported, and integration
48 ;; with gpg-agent is not yet implemented.)
49 ;; - Automatic topic-number maintenance
50 ;; - "Hot-spot" operation, for single-keystroke maneuvering and
51 ;; exposure control (see the allout-mode docstring)
52 ;; - Easy rendering of exposed portions into numbered, latex, indented, etc
54 ;; - Careful attention to whitespace -- enabling blank lines between items
55 ;; and maintenance of hanging indentation (in paragraph auto-fill and
56 ;; across topic promotion and demotion) of topic bodies consistent with
57 ;; indentation of their topic header.
61 ;; See the `allout-mode' function's docstring for an introduction to the
64 ;; The latest development version and helpful notes are available at
65 ;; http://myriadicity.net/Sundry/EmacsAllout .
67 ;; The outline menubar additions provide quick reference to many of
68 ;; the features, and see the docstring of the variable `allout-init'
69 ;; for instructions on priming your Emacs session for automatic
70 ;; activation of allout-mode.
72 ;; See the docstring of the variables `allout-layout' and
73 ;; `allout-auto-activation' for details on automatic activation of
74 ;; `allout-mode' as a minor mode. (It has changed since allout
75 ;; 3.x, for those of you that depend on the old method.)
77 ;; Note -- the lines beginning with `;;;_' are outline topic headers.
78 ;; Just `ESC-x eval-buffer' to give it a whirl.
80 ;; ken manheimer (ken dot manheimer at gmail dot com)
84 ;;;_* Dependency autoloads
87 ;; Most of the requires here are for stuff covered by autoloads.
88 ;; Since just byte-compiling doesn't trigger autoloads, so that
89 ;; "function not found" warnings would occur without these requires.
93 ;; `cl' is required for `assert'. `assert' is not covered by a standard
94 ;; autoload, but it is a macro, so that eval-when-compile is sufficient
95 ;; to byte-compile it in, or to do the require when the buffer evalled.
99 ;;;_* USER CUSTOMIZATION VARIABLES:
101 ;;;_ > defgroup allout, allout-keybindings
103 "Extensive outline mode for use alone and with other modes."
106 (defgroup allout-keybindings nil
107 "Allout outline mode keyboard bindings configuration."
110 ;;;_ + Layout, Mode, and Topic Header Configuration
112 (defvar allout-command-prefix
) ; defined below
113 (defvar allout-mode-map
)
115 ;;;_ > allout-keybindings incidentals:
116 ;;;_ > allout-bind-keys &optional varname value
117 (defun allout-bind-keys (&optional varname value
)
118 "Rebuild the `allout-mode-map' according to the keybinding specs.
120 Useful standalone, to init the map, or in customizing the
121 respective allout-mode keybinding variables, `allout-command-prefix',
122 `allout-prefixed-keybindings', and `allout-unprefixed-keybindings'"
123 ;; Set the customization variable, if any:
125 (set-default varname value
))
126 (let ((map (make-sparse-keymap))
128 (when (boundp 'allout-prefixed-keybindings
)
129 ;; Be tolerant of the moments when the variables are first being defined.
130 (dolist (entry allout-prefixed-keybindings
)
132 ;; XXX vector vs non-vector key descriptions?
133 (vconcat allout-command-prefix
134 (car (read-from-string (car entry
))))
136 (when (boundp 'allout-unprefixed-keybindings
)
137 (dolist (entry allout-unprefixed-keybindings
)
138 (define-key map
(car (read-from-string (car entry
))) (cadr entry
))))
139 (setq allout-mode-map map
)
142 ;;;_ = allout-command-prefix
143 (defcustom allout-command-prefix
"\C-c "
144 "Key sequence to be used as prefix for outline mode command key bindings.
146 Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
147 willing to let allout use a bunch of \C-c keybindings."
149 :group
'allout-keybindings
150 :set
'allout-bind-keys
)
151 ;;;_ = allout-keybindings-binding
152 (define-widget 'allout-keybindings-binding
'lazy
153 "Structure of allout keybindings customization items."
155 (list (string :tag
"Key" :value
"[(meta control shift ?f)]")
156 (function :tag
"Function name"
157 :value allout-forward-current-level
))))
158 ;;;_ = allout-prefixed-keybindings
159 (defcustom allout-prefixed-keybindings
160 '(("[(control ?n)]" allout-next-visible-heading
)
161 ("[(control ?p)]" allout-previous-visible-heading
)
162 ;; ("[(control ?u)]" allout-up-current-level)
163 ("[(control ?f)]" allout-forward-current-level
)
164 ("[(control ?b)]" allout-backward-current-level
)
165 ("[(control ?a)]" allout-beginning-of-current-entry
)
166 ("[(control ?e)]" allout-end-of-entry
)
167 ("[(control ?i)]" allout-show-children
)
168 ("[(control ?i)]" allout-show-children
)
169 ("[(control ?s)]" allout-show-current-subtree
)
170 ("[(control ?t)]" allout-toggle-current-subtree-exposure
)
171 ("[(control ?h)]" allout-hide-current-subtree
)
172 ("[?h]" allout-hide-current-subtree
)
173 ("[(control ?o)]" allout-show-current-entry
)
174 ("[?!]" allout-show-all
)
175 ("[?x]" allout-toggle-current-subtree-encryption
)
176 ("[? ]" allout-open-sibtopic
)
177 ("[?.]" allout-open-subtopic
)
178 ("[?,]" allout-open-supertopic
)
179 ("[?']" allout-shift-in
)
180 ("[?>]" allout-shift-in
)
181 ("[?<]" allout-shift-out
)
182 ("[(control ?m)]" allout-rebullet-topic
)
183 ("[?*]" allout-rebullet-current-heading
)
184 ("[?']" allout-number-siblings
)
185 ("[(control ?k)]" allout-kill-topic
)
186 ("[??]" allout-copy-topic-as-kill
)
187 ("[?@]" allout-resolve-xref
)
188 ("[?=?c]" allout-copy-exposed-to-buffer
)
189 ("[?=?i]" allout-indented-exposed-to-buffer
)
190 ("[?=?t]" allout-latexify-exposed
)
191 ("[?=?p]" allout-flatten-exposed-to-buffer
)
193 "Allout-mode key bindings that are prefixed with `allout-command-prefix'.
195 See `allout-unprefixed-keybindings' for the list of keybindings
196 that are not prefixed.
198 Use vector format for the keys:
199 - put literal keys after a '?' question mark, eg: '?a', '?.'
200 - enclose control, shift, or meta-modified keys as sequences within
201 parentheses, with the literal key, as above, preceded by the name(s)
202 of the modifers, eg: [(control ?a)]
203 See the existing keys for examples.
205 Functions can be bound to multiple keys, but binding keys to
206 multiple functions will not work - the last binding for a key
208 :type
'allout-keybindings-binding
209 :group
'allout-keybindings
210 :set
'allout-bind-keys
212 ;;;_ = allout-unprefixed-keybindings
213 (defcustom allout-unprefixed-keybindings
214 '(("[(control ?k)]" allout-kill-line
)
215 ("[??(meta ?k)]" allout-copy-line-as-kill
)
216 ("[(control ?y)]" allout-yank
)
217 ("[??(meta ?y)]" allout-yank-pop
)
219 "Allout-mode functions bound to keys without any added prefix.
221 This is in contrast to the majority of allout-mode bindings on
222 `allout-prefixed-bindings', whose bindings are created with a
223 preceeding command key.
225 Use vector format for the keys:
226 - put literal keys after a '?' question mark, eg: '?a', '?.'
227 - enclose control, shift, or meta-modified keys as sequences within
228 parentheses, with the literal key, as above, preceded by the name(s)
229 of the modifers, eg: [(control ?a)]
230 See the existing keys for examples."
231 :type
'allout-keybindings-binding
232 :group
'allout-keybindings
233 :set
'allout-bind-keys
236 ;;;_ = allout-preempt-trailing-ctrl-h
237 (defcustom allout-preempt-trailing-ctrl-h nil
238 "Use <prefix>-\C-h, instead of leaving it for describe-prefix-bindings?"
242 ;;;_ = allout-keybindings-list
243 ;;; You have to reactivate allout-mode -- `(allout-mode t)' -- to
244 ;;; institute changes to this var.
245 (defvar allout-keybindings-list
()
246 "*List of `allout-mode' key / function bindings, for `allout-mode-map'.
247 String or vector key will be prefaced with `allout-command-prefix',
248 unless optional third, non-nil element is present.")
249 (setq allout-keybindings-list
252 ("\C-n" allout-next-visible-heading
)
253 ("\C-p" allout-previous-visible-heading
)
254 ("\C-u" allout-up-current-level
)
255 ("\C-f" allout-forward-current-level
)
256 ("\C-b" allout-backward-current-level
)
257 ("\C-a" allout-beginning-of-current-entry
)
258 ("\C-e" allout-end-of-entry
)
260 ([(control i
)] allout-show-children
) ; xemacs translates "\C-i" to tab
261 ("\C-i" allout-show-children
) ; but we still need this for hotspot
262 ("\C-s" allout-show-current-subtree
)
263 ;; binding to \C-h is included if allout-preempt-trailing-ctrl-h,
264 ;; so user controls whether or not to preempt the conventional ^H
265 ;; binding to help-command.
266 ("\C-h" allout-hide-current-subtree
)
267 ("\C-t" allout-toggle-current-subtree-exposure
)
268 ("h" allout-hide-current-subtree
)
269 ("\C-o" allout-show-current-entry
)
270 ("!" allout-show-all
)
271 ("x" allout-toggle-current-subtree-encryption
)
272 ; Alteration commands:
273 (" " allout-open-sibtopic
)
274 ("." allout-open-subtopic
)
275 ("," allout-open-supertopic
)
276 ("'" allout-shift-in
)
277 (">" allout-shift-in
)
278 ("<" allout-shift-out
)
279 ("\C-m" allout-rebullet-topic
)
280 ("*" allout-rebullet-current-heading
)
281 ("#" allout-number-siblings
)
282 ("\C-k" allout-kill-line t
)
283 ([?\M-k
] allout-copy-line-as-kill t
)
284 ("\C-y" allout-yank t
)
285 ([?\M-y
] allout-yank-pop t
)
286 ("\C-k" allout-kill-topic
)
287 ([?\M-k
] allout-copy-topic-as-kill
)
288 ; Miscellaneous commands:
289 ;([?\C-\ ] allout-mark-topic)
290 ("@" allout-resolve-xref
)
291 ("=c" allout-copy-exposed-to-buffer
)
292 ("=i" allout-indented-exposed-to-buffer
)
293 ("=t" allout-latexify-exposed
)
294 ("=p" allout-flatten-exposed-to-buffer
)))
296 ;;;_ = allout-auto-activation
297 (defcustom allout-auto-activation nil
298 "Regulates auto-activation modality of allout outlines -- see `allout-init'.
300 Setq-default by `allout-init' to regulate whether or not allout
301 outline mode is automatically activated when the buffer-specific
302 variable `allout-layout' is non-nil, and whether or not the layout
303 dictated by `allout-layout' should be imposed on mode activation.
305 With value t, auto-mode-activation and auto-layout are enabled.
306 \(This also depends on `allout-find-file-hook' being installed in
307 `find-file-hook', which is also done by `allout-init'.)
309 With value `ask', auto-mode-activation is enabled, and endorsement for
310 performing auto-layout is asked of the user each time.
312 With value `activate', only auto-mode-activation is enabled,
315 With value nil, neither auto-mode-activation nor auto-layout are
318 See the docstring for `allout-init' for the proper interface to
320 :type
'(choice (const :tag
"On" t
)
321 (const :tag
"Ask about layout" "ask")
322 (const :tag
"Mode only" "activate")
323 (const :tag
"Off" nil
))
325 ;;;_ = allout-default-layout
326 (defcustom allout-default-layout
'(-2 : 0)
327 "Default allout outline layout specification.
329 This setting specifies the outline exposure to use when
330 `allout-layout' has the local value `t'. This docstring describes the
331 layout specifications.
333 A list value specifies a default layout for the current buffer,
334 to be applied upon activation of `allout-mode'. Any non-nil
335 value will automatically trigger `allout-mode', provided
336 `allout-init' has been called to enable this behavior.
338 The types of elements in the layout specification are:
340 INTEGER -- dictate the relative depth to open the corresponding topic(s),
342 -- negative numbers force the topic to be closed before opening
343 to the absolute value of the number, so all siblings are open
345 -- positive numbers open to the relative depth indicated by the
346 number, but do not force already opened subtopics to be closed.
347 -- 0 means to close topic -- hide all subitems.
348 : -- repeat spec -- apply the preceeding element to all siblings at
349 current level, *up to* those siblings that would be covered by specs
350 following the `:' on the list. Ie, apply to all topics at level but
351 trailing ones accounted for by trailing specs. (Only the first of
352 multiple colons at the same level is honored -- later ones are ignored.)
353 * -- completely exposes the topic, including bodies
354 + -- exposes all subtopics, but not the bodies
355 - -- exposes the body of the corresponding topic, but not subtopics
356 LIST -- a nested layout spec, to be applied intricately to its
357 corresponding item(s)
361 Collapse the top-level topics to show their children and
362 grandchildren, but completely collapse the final top-level topic.
364 Close the first topic so only the immediate subtopics are shown,
365 leave the subsequent topics exposed as they are until the second
366 second to last topic, which is exposed at least one level, and
367 completely close the last topic.
369 Expose children and grandchildren of all topics at current
370 level except the last two; expose children of the second to
371 last and completely expose the last one, including its subtopics.
373 See `allout-expose-topic' for more about the exposure process.
375 Also, allout's mode-specific provisions will make topic prefixes default
376 to the comment-start string, if any, of the language of the file. This
377 is modulo the setting of `allout-use-mode-specific-leader', which see."
378 :type
'allout-layout-type
380 ;;;_ : allout-layout-type
381 (define-widget 'allout-layout-type
'lazy
382 "Allout layout format customization basic building blocks."
384 (choice (integer :tag
"integer (<= zero is strict)")
385 (const :tag
": (repeat prior)" :)
386 (const :tag
"* (completely expose)" *)
387 (const :tag
"+ (expose all offspring, headlines only)" +)
388 (const :tag
"- (expose topic body but not offspring)" -
)
389 (allout-layout-type :tag
"<Nested layout>"))))
391 ;;;_ = allout-inhibit-auto-fill
392 (defcustom allout-inhibit-auto-fill nil
393 "If non-nil, auto-fill will be inhibited in the allout buffers.
395 You can customize this setting to set it for all allout buffers, or set it
396 in individual buffers if you want to inhibit auto-fill only in particular
397 buffers. (You could use a function on `allout-mode-hook' to inhibit
398 auto-fill according, eg, to the major mode.)
400 If you don't set this and auto-fill-mode is enabled, allout will use the
401 value that `normal-auto-fill-function', if any, when allout mode starts, or
402 else allout's special hanging-indent maintaining auto-fill function,
406 (make-variable-buffer-local 'allout-inhibit-auto-fill
)
407 ;;;_ = allout-use-hanging-indents
408 (defcustom allout-use-hanging-indents t
409 "If non-nil, topic body text auto-indent defaults to indent of the header.
410 Ie, it is indented to be just past the header prefix. This is
411 relevant mostly for use with `indented-text-mode', or other situations
412 where auto-fill occurs."
415 (make-variable-buffer-local 'allout-use-hanging-indents
)
417 (put 'allout-use-hanging-indents
'safe-local-variable
418 (if (fboundp 'booleanp
) 'booleanp
'(lambda (x) (member x
'(t nil
)))))
419 ;;;_ = allout-reindent-bodies
420 (defcustom allout-reindent-bodies
(if allout-use-hanging-indents
422 "Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
424 When active, topic body lines that are indented even with or beyond
425 their topic header are reindented to correspond with depth shifts of
428 A value of t enables reindent in non-programming-code buffers, ie
429 those that do not have the variable `comment-start' set. A value of
430 `force' enables reindent whether or not `comment-start' is set."
431 :type
'(choice (const nil
) (const t
) (const text
) (const force
))
434 (make-variable-buffer-local 'allout-reindent-bodies
)
436 (put 'allout-reindent-bodies
'safe-local-variable
437 '(lambda (x) (memq x
'(nil t text force
))))
439 ;;;_ = allout-show-bodies
440 (defcustom allout-show-bodies nil
441 "If non-nil, show entire body when exposing a topic, rather than
445 (make-variable-buffer-local 'allout-show-bodies
)
447 (put 'allout-show-bodies
'safe-local-variable
448 (if (fboundp 'booleanp
) 'booleanp
'(lambda (x) (member x
'(t nil
)))))
450 ;;;_ = allout-beginning-of-line-cycles
451 (defcustom allout-beginning-of-line-cycles t
452 "If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options.
454 Cycling only happens on when the command is repeated, not when it
455 follows a different command.
457 Smart-placement means that repeated calls to this function will
460 - if the cursor is on a non-headline body line and not on the first column:
461 then it goes to the first column
462 - if the cursor is on the first column of a non-headline body line:
463 then it goes to the start of the headline within the item body
464 - if the cursor is on the headline and not the start of the headline:
465 then it goes to the start of the headline
466 - if the cursor is on the start of the headline:
467 then it goes to the bullet character (for hotspot navigation)
468 - if the cursor is on the bullet character:
469 then it goes to the first column of that line (the headline)
470 - if the cursor is on the first column of the headline:
471 then it goes to the start of the headline within the item body.
473 In this fashion, you can use the beginning-of-line command to do
474 its normal job and then, when repeated, advance through the
475 entry, cycling back to start.
477 If this configuration variable is nil, then the cursor is just
478 advanced to the beginning of the line and remains there on
480 :type
'boolean
:group
'allout
)
481 ;;;_ = allout-end-of-line-cycles
482 (defcustom allout-end-of-line-cycles t
483 "If non-nil, \\[allout-end-of-line] will cycle through smart-placement options.
485 Cycling only happens on when the command is repeated, not when it
486 follows a different command.
488 Smart placement means that repeated calls to this function will
491 - if the cursor is not on the end-of-line,
492 then it goes to the end-of-line
493 - if the cursor is on the end-of-line but not the end-of-entry,
494 then it goes to the end-of-entry, exposing it if necessary
495 - if the cursor is on the end-of-entry,
496 then it goes to the end of the head line
498 In this fashion, you can use the end-of-line command to do its
499 normal job and then, when repeated, advance through the entry,
500 cycling back to start.
502 If this configuration variable is nil, then the cursor is just
503 advanced to the end of the line and remains there on repeated
505 :type
'boolean
:group
'allout
)
507 ;;;_ = allout-header-prefix
508 (defcustom allout-header-prefix
"."
509 ;; this string is treated as literal match. it will be `regexp-quote'd, so
510 ;; one cannot use regular expressions to match varying header prefixes.
511 "Leading string which helps distinguish topic headers.
513 Outline topic header lines are identified by a leading topic
514 header prefix, which mostly have the value of this var at their front.
515 Level 1 topics are exceptions. They consist of only a single
516 character, which is typically set to the `allout-primary-bullet'."
519 (make-variable-buffer-local 'allout-header-prefix
)
521 (put 'allout-header-prefix
'safe-local-variable
'stringp
)
522 ;;;_ = allout-primary-bullet
523 (defcustom allout-primary-bullet
"*"
524 "Bullet used for top-level outline topics.
526 Outline topic header lines are identified by a leading topic header
527 prefix, which is concluded by bullets that includes the value of this
528 var and the respective allout-*-bullets-string vars.
530 The value of an asterisk (`*') provides for backwards compatibility
531 with the original Emacs outline mode. See `allout-plain-bullets-string'
532 and `allout-distinctive-bullets-string' for the range of available
536 (make-variable-buffer-local 'allout-primary-bullet
)
538 (put 'allout-primary-bullet
'safe-local-variable
'stringp
)
539 ;;;_ = allout-plain-bullets-string
540 (defcustom allout-plain-bullets-string
".,"
541 "The bullets normally used in outline topic prefixes.
543 See `allout-distinctive-bullets-string' for the other kind of
546 DO NOT include the close-square-bracket, `]', as a bullet.
548 Outline mode has to be reactivated in order for changes to the value
549 of this var to take effect."
552 (make-variable-buffer-local 'allout-plain-bullets-string
)
554 (put 'allout-plain-bullets-string
'safe-local-variable
'stringp
)
555 ;;;_ = allout-distinctive-bullets-string
556 (defcustom allout-distinctive-bullets-string
"*+-=>()[{}&!?#%\"X@$~_\\:;^"
557 "Persistent outline header bullets used to distinguish special topics.
559 These bullets are distinguish topics with particular character.
560 They are not used by default in the topic creation routines, but
561 are offered as options when you modify topic creation with a
562 universal argument \(\\[universal-argument]), or during rebulleting \(\\[allout-rebullet-current-heading]).
564 Distinctive bullets are not cycled when topics are shifted or
565 otherwise automatically rebulleted, so their marking is
566 persistent until deliberately changed. Their significance is
567 purely by convention, however. Some conventions suggest
570 `(' - open paren -- an aside or incidental point
571 `?' - question mark -- uncertain or outright question
572 `!' - exclamation point/bang -- emphatic
573 `[' - open square bracket -- meta-note, about item instead of item's subject
574 `\"' - double quote -- a quotation or other citation
575 `=' - equal sign -- an assignement, equating a name with some connotation
576 `^' - carat -- relates to something above
578 Some are more elusive, but their rationale may be recognizable:
580 `+' - plus -- pending consideration, completion
581 `_' - underscore -- done, completed
582 `&' - ampersand -- addendum, furthermore
584 \(Some other non-plain bullets have special meaning to the
585 software. By default:
587 `~' marks encryptable topics -- see `allout-topic-encryption-bullet'
588 `#' marks auto-numbered bullets -- see `allout-numbered-bullet'.)
590 See `allout-plain-bullets-string' for the standard, alternating
593 You must run `set-allout-regexp' in order for outline mode to
594 adopt changes of this value.
596 DO NOT include the close-square-bracket, `]', on either of the bullet
600 (make-variable-buffer-local 'allout-distinctive-bullets-string
)
602 (put 'allout-distinctive-bullets-string
'safe-local-variable
'stringp
)
604 ;;;_ = allout-use-mode-specific-leader
605 (defcustom allout-use-mode-specific-leader t
606 "When non-nil, use mode-specific topic-header prefixes.
608 Allout outline mode will use the mode-specific `allout-mode-leaders' or
609 comment-start string, if any, to lead the topic prefix string, so topic
610 headers look like comments in the programming language. It will also use
611 the comment-start string, with an '_' appended, for `allout-primary-bullet'.
613 String values are used as literals, not regular expressions, so
614 do not escape any regulare-expression characters.
616 Value t means to first check for assoc value in `allout-mode-leaders'
617 alist, then use comment-start string, if any, then use default (`.').
618 \(See note about use of comment-start strings, below.)
620 Set to the symbol for either of `allout-mode-leaders' or
621 `comment-start' to use only one of them, respectively.
623 Value nil means to always use the default (`.') and leave
624 `allout-primary-bullet' unaltered.
626 comment-start strings that do not end in spaces are tripled in
627 the header-prefix, and an `_' underscore is tacked on the end, to
628 distinguish them from regular comment strings. comment-start
629 strings that do end in spaces are not tripled, but an underscore
630 is substituted for the space. [This presumes that the space is
631 for appearance, not comment syntax. You can use
632 `allout-mode-leaders' to override this behavior, when
634 :type
'(choice (const t
) (const nil
) string
635 (const allout-mode-leaders
)
636 (const comment-start
))
639 (put 'allout-use-mode-specific-leader
'safe-local-variable
640 '(lambda (x) (or (memq x
'(t nil allout-mode-leaders comment-start
))
642 ;;;_ = allout-mode-leaders
643 (defvar allout-mode-leaders
'()
644 "Specific allout-prefix leading strings per major modes.
646 Use this if the mode's comment-start string isn't what you
647 prefer, or if the mode lacks a comment-start string. See
648 `allout-use-mode-specific-leader' for more details.
650 If you're constructing a string that will comment-out outline
651 structuring so it can be included in program code, append an extra
652 character, like an \"_\" underscore, to distinguish the lead string
653 from regular comments that start at the beginning-of-line.")
655 ;;;_ = allout-old-style-prefixes
656 (defcustom allout-old-style-prefixes nil
657 "When non-nil, use only old-and-crusty `outline-mode' `*' topic prefixes.
659 Non-nil restricts the topic creation and modification
660 functions to asterix-padded prefixes, so they look exactly
661 like the original Emacs-outline style prefixes.
663 Whatever the setting of this variable, both old and new style prefixes
664 are always respected by the topic maneuvering functions."
667 (make-variable-buffer-local 'allout-old-style-prefixes
)
669 (put 'allout-old-style-prefixes
'safe-local-variable
670 (if (fboundp 'booleanp
) 'booleanp
'(lambda (x) (member x
'(t nil
)))))
671 ;;;_ = allout-stylish-prefixes -- alternating bullets
672 (defcustom allout-stylish-prefixes t
673 "Do fancy stuff with topic prefix bullets according to level, etc.
675 Non-nil enables topic creation, modification, and repositioning
676 functions to vary the topic bullet char (the char that marks the topic
677 depth) just preceding the start of the topic text) according to level.
678 Otherwise, only asterisks (`*') and distinctive bullets are used.
680 This is how an outline can look (but sans indentation) with stylish
685 . + One level 3 subtopic
686 . . One level 4 subtopic
687 . . A second 4 subtopic
688 . + Another level 3 subtopic
689 . #1 A numbered level 4 subtopic
691 . ! Another level 4 subtopic with a different distinctive bullet
692 . #4 And another numbered level 4 subtopic
694 This would be an outline with stylish prefixes inhibited (but the
695 numbered and other distinctive bullets retained):
699 . * One level 3 subtopic
700 . * One level 4 subtopic
701 . * A second 4 subtopic
702 . * Another level 3 subtopic
703 . #1 A numbered level 4 subtopic
705 . ! Another level 4 subtopic with a different distinctive bullet
706 . #4 And another numbered level 4 subtopic
708 Stylish and constant prefixes (as well as old-style prefixes) are
709 always respected by the topic maneuvering functions, regardless of
710 this variable setting.
712 The setting of this var is not relevant when `allout-old-style-prefixes'
716 (make-variable-buffer-local 'allout-stylish-prefixes
)
718 (put 'allout-stylish-prefixes
'safe-local-variable
719 (if (fboundp 'booleanp
) 'booleanp
'(lambda (x) (member x
'(t nil
)))))
721 ;;;_ = allout-numbered-bullet
722 (defcustom allout-numbered-bullet
"#"
723 "String designating bullet of topics that have auto-numbering; nil for none.
725 Topics having this bullet have automatic maintenance of a sibling
726 sequence-number tacked on, just after the bullet. Conventionally set
727 to \"#\", you can set it to a bullet of your choice. A nil value
728 disables numbering maintenance."
729 :type
'(choice (const nil
) string
)
731 (make-variable-buffer-local 'allout-numbered-bullet
)
733 (put 'allout-numbered-bullet
'safe-local-variable
734 (if (fboundp 'string-or-null-p
)
736 '(lambda (x) (or (stringp x
) (null x
)))))
737 ;;;_ = allout-file-xref-bullet
738 (defcustom allout-file-xref-bullet
"@"
739 "Bullet signifying file cross-references, for `allout-resolve-xref'.
741 Set this var to the bullet you want to use for file cross-references."
742 :type
'(choice (const nil
) string
)
745 (put 'allout-file-xref-bullet
'safe-local-variable
746 (if (fboundp 'string-or-null-p
)
748 '(lambda (x) (or (stringp x
) (null x
)))))
749 ;;;_ = allout-presentation-padding
750 (defcustom allout-presentation-padding
2
751 "Presentation-format white-space padding factor, for greater indent."
755 (make-variable-buffer-local 'allout-presentation-padding
)
757 (put 'allout-presentation-padding
'safe-local-variable
'integerp
)
759 ;;;_ = allout-abbreviate-flattened-numbering
760 (defcustom allout-abbreviate-flattened-numbering nil
761 "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic
762 numbers to minimal amount with some context. Otherwise, entire
763 numbers are always used."
767 ;;;_ + LaTeX formatting
768 ;;;_ - allout-number-pages
769 (defcustom allout-number-pages nil
770 "Non-nil turns on page numbering for LaTeX formatting of an outline."
773 ;;;_ - allout-label-style
774 (defcustom allout-label-style
"\\large\\bf"
775 "Font and size of labels for LaTeX formatting of an outline."
778 ;;;_ - allout-head-line-style
779 (defcustom allout-head-line-style
"\\large\\sl "
780 "Font and size of entries for LaTeX formatting of an outline."
783 ;;;_ - allout-body-line-style
784 (defcustom allout-body-line-style
" "
785 "Font and size of entries for LaTeX formatting of an outline."
788 ;;;_ - allout-title-style
789 (defcustom allout-title-style
"\\Large\\bf"
790 "Font and size of titles for LaTeX formatting of an outline."
794 (defcustom allout-title
'(or buffer-file-name
(buffer-name))
795 "Expression to be evaluated to determine the title for LaTeX
799 ;;;_ - allout-line-skip
800 (defcustom allout-line-skip
".05cm"
801 "Space between lines for LaTeX formatting of an outline."
805 (defcustom allout-indent
".3cm"
806 "LaTeX formatted depth-indent spacing."
810 ;;;_ + Topic encryption
811 ;;;_ = allout-encryption group
812 (defgroup allout-encryption nil
813 "Settings for topic encryption features of allout outliner."
815 ;;;_ = allout-topic-encryption-bullet
816 (defcustom allout-topic-encryption-bullet
"~"
817 "Bullet signifying encryption of the entry's body."
818 :type
'(choice (const nil
) string
)
820 :group
'allout-encryption
)
821 ;;;_ = allout-passphrase-verifier-handling
822 (defcustom allout-passphrase-verifier-handling t
823 "Enable use of symmetric encryption passphrase verifier if non-nil.
825 See the docstring for the `allout-enable-file-variable-adjustment'
826 variable for details about allout ajustment of file variables."
829 :group
'allout-encryption
)
830 (make-variable-buffer-local 'allout-passphrase-verifier-handling
)
831 ;;;_ = allout-passphrase-hint-handling
832 (defcustom allout-passphrase-hint-handling
'always
833 "Dictate outline encryption passphrase reminder handling:
835 always -- always show reminder when prompting
836 needed -- show reminder on passphrase entry failure
837 disabled -- never present or adjust reminder
839 See the docstring for the `allout-enable-file-variable-adjustment'
840 variable for details about allout ajustment of file variables."
841 :type
'(choice (const always
)
845 :group
'allout-encryption
)
846 (make-variable-buffer-local 'allout-passphrase-hint-handling
)
847 ;;;_ = allout-encrypt-unencrypted-on-saves
848 (defcustom allout-encrypt-unencrypted-on-saves t
849 "When saving, should topics pending encryption be encrypted?
851 The idea is to prevent file-system exposure of any un-encrypted stuff, and
852 mostly covers both deliberate file writes and auto-saves.
854 - Yes: encrypt all topics pending encryption, even if it's the one
855 currently being edited. (In that case, the currently edited topic
856 will be automatically decrypted before any user interaction, so they
857 can continue editing but the copy on the file system will be
859 Auto-saves will use the \"All except current topic\" mode if this
860 one is selected, to avoid practical difficulties -- see below.
861 - All except current topic: skip the topic currently being edited, even if
862 it's pending encryption. This may expose the current topic on the
863 file sytem, but avoids the nuisance of prompts for the encryption
864 passphrase in the middle of editing for, eg, autosaves.
865 This mode is used for auto-saves for both this option and \"Yes\".
866 - No: leave it to the user to encrypt any unencrypted topics.
868 For practical reasons, auto-saves always use the 'except-current policy
869 when auto-encryption is enabled. (Otherwise, spurious passphrase prompts
870 and unavoidable timing collisions are too disruptive.) If security for a
871 file requires that even the current topic is never auto-saved in the clear,
872 disable auto-saves for that file."
874 :type
'(choice (const :tag
"Yes" t
)
875 (const :tag
"All except current topic" except-current
)
876 (const :tag
"No" nil
))
878 :group
'allout-encryption
)
879 (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves
)
882 ;;;_ = allout-developer group
883 (defgroup allout-developer nil
884 "Allout settings developers care about, including topic encryption and more."
886 ;;;_ = allout-run-unit-tests-on-load
887 (defcustom allout-run-unit-tests-on-load nil
888 "When non-nil, unit tests will be run at end of loading the allout module.
890 Generally, allout code developers are the only ones who'll want to set this.
892 \(If set, this makes it an even better practice to exercise changes by
893 doing byte-compilation with a repeat count, so the file is loaded after
896 See `allout-run-unit-tests' to see what's run."
898 :group
'allout-developer
)
900 ;;;_ + Miscellaneous customization
902 ;;;_ = allout-enable-file-variable-adjustment
903 (defcustom allout-enable-file-variable-adjustment t
904 "If non-nil, some allout outline actions edit Emacs local file var text.
906 This can range from changes to existing entries, addition of new ones,
907 and creation of a new local variables section when necessary.
909 Emacs file variables adjustments are also inhibited if `enable-local-variables'
912 Operations potentially causing edits include allout encryption routines.
913 For details, see `allout-toggle-current-subtree-encryption's docstring."
916 (make-variable-buffer-local 'allout-enable-file-variable-adjustment
)
918 ;;;_* CODE -- no user customizations below.
920 ;;;_ #1 Internal Outline Formatting and Configuration
922 ;;;_ = allout-version
923 (defvar allout-version
"2.2.2"
924 "Version of currently loaded outline package. (allout.el)")
925 ;;;_ > allout-version
926 (defun allout-version (&optional here
)
927 "Return string describing the loaded outline version."
929 (let ((msg (concat "Allout Outline Mode v " allout-version
)))
930 (if here
(insert msg
))
933 ;;;_ : Mode activation (defined here because it's referenced early)
935 (defvar allout-mode nil
"Allout outline mode minor-mode flag.")
936 (make-variable-buffer-local 'allout-mode
)
937 ;;;_ = allout-layout nil
938 (defvar allout-layout nil
; LEAVE GLOBAL VALUE NIL -- see docstring.
939 "Buffer-specific setting for allout layout.
941 In buffers where this is non-nil (and if `allout-init' has been run, to
942 enable this behavior), `allout-mode' will be automatically activated. The
943 layout dictated by the value will be used to set the initial exposure when
944 `allout-mode' is activated.
946 \*You should not setq-default this variable non-nil unless you want every
947 visited file to be treated as an allout file.*
949 The value would typically be set by a file local variable. For
950 example, the following lines at the bottom of an Emacs Lisp file:
953 ;;;allout-layout: (0 : -1 -1 0)
956 dictate activation of `allout-mode' mode when the file is visited
957 \(presuming allout-init was already run), followed by the
958 equivalent of `(allout-expose-topic 0 : -1 -1 0)'. (This is
959 the layout used for the allout.el source file.)
961 `allout-default-layout' describes the specification format.
962 `allout-layout' can additionally have the value `t', in which
963 case the value of `allout-default-layout' is used.")
964 (make-variable-buffer-local 'allout-layout
)
966 (put 'allout-layout
'safe-local-variable
967 '(lambda (x) (or (numberp x
) (listp x
) (memq x
'(: * + -
)))))
969 ;;;_ : Topic header format
971 (defvar allout-regexp
""
972 "*Regular expression to match the beginning of a heading line.
974 Any line whose beginning matches this regexp is considered a
975 heading. This var is set according to the user configuration vars
976 by `set-allout-regexp'.")
977 (make-variable-buffer-local 'allout-regexp
)
978 ;;;_ = allout-bullets-string
979 (defvar allout-bullets-string
""
980 "A string dictating the valid set of outline topic bullets.
982 This var should *not* be set by the user -- it is set by `set-allout-regexp',
983 and is produced from the elements of `allout-plain-bullets-string'
984 and `allout-distinctive-bullets-string'.")
985 (make-variable-buffer-local 'allout-bullets-string
)
986 ;;;_ = allout-bullets-string-len
987 (defvar allout-bullets-string-len
0
988 "Length of current buffers' `allout-plain-bullets-string'.")
989 (make-variable-buffer-local 'allout-bullets-string-len
)
990 ;;;_ = allout-depth-specific-regexp
991 (defvar allout-depth-specific-regexp
""
992 "*Regular expression to match a heading line prefix for a particular depth.
994 This expression is used to search for depth-specific topic
995 headers at depth 2 and greater. Use `allout-depth-one-regexp'
996 for to seek topics at depth one.
998 This var is set according to the user configuration vars by
999 `set-allout-regexp'. It is prepared with format strings for two
1000 decimal numbers, which should each be one less than the depth of the
1001 topic prefix to be matched.")
1002 (make-variable-buffer-local 'allout-depth-specific-regexp
)
1003 ;;;_ = allout-depth-one-regexp
1004 (defvar allout-depth-one-regexp
""
1005 "*Regular expression to match a heading line prefix for depth one.
1007 This var is set according to the user configuration vars by
1008 `set-allout-regexp'. It is prepared with format strings for two
1009 decimal numbers, which should each be one less than the depth of the
1010 topic prefix to be matched.")
1011 (make-variable-buffer-local 'allout-depth-one-regexp
)
1012 ;;;_ = allout-line-boundary-regexp
1013 (defvar allout-line-boundary-regexp
()
1014 "`allout-regexp' prepended with a newline for the search target.
1016 This is properly set by `set-allout-regexp'.")
1017 (make-variable-buffer-local 'allout-line-boundary-regexp
)
1018 ;;;_ = allout-bob-regexp
1019 (defvar allout-bob-regexp
()
1020 "Like `allout-line-boundary-regexp', for headers at beginning of buffer.")
1021 (make-variable-buffer-local 'allout-bob-regexp
)
1022 ;;;_ = allout-header-subtraction
1023 (defvar allout-header-subtraction
(1- (length allout-header-prefix
))
1024 "Allout-header prefix length to subtract when computing topic depth.")
1025 (make-variable-buffer-local 'allout-header-subtraction
)
1026 ;;;_ = allout-plain-bullets-string-len
1027 (defvar allout-plain-bullets-string-len
(length allout-plain-bullets-string
)
1028 "Length of `allout-plain-bullets-string', updated by `set-allout-regexp'.")
1029 (make-variable-buffer-local 'allout-plain-bullets-string-len
)
1031 ;;;_ = allout-doublecheck-at-and-shallower
1032 (defconst allout-doublecheck-at-and-shallower
3
1033 "Validate apparent topics of this depth and shallower as being non-aberrant.
1035 Verified with `allout-aberrant-container-p'. The usefulness of
1036 this check is limited to shallow depths, because the
1037 determination of aberrance is according to the mistaken item
1038 being followed by a legitimate item of excessively greater depth.
1040 The classic example of a mistaken item, for a standard allout
1041 outline configuration, is a body line that begins with an '...'
1042 ellipsis. This happens to contain a legitimate depth-2 header
1043 prefix, constituted by two '..' dots at the beginning of the
1044 line. The only thing that can distinguish it *in principle* from
1045 a legitimate one is if the following real header is at a depth
1046 that is discontinuous from the depth of 2 implied by the
1047 ellipsis, ie depth 4 or more. As the depth being tested gets
1048 greater, the likelihood of this kind of disqualification is
1049 lower, and the usefulness of this test is lower.
1051 Extending the depth of the doublecheck increases the amount it is
1052 applied, increasing the cost of the test - on casual estimation,
1053 for outlines with many deep topics, geometrically (O(n)?).
1054 Taken together with decreasing likelihood that the test will be
1055 useful at greater depths, more modest doublecheck limits are more
1056 suitably economical.")
1057 ;;;_ X allout-reset-header-lead (header-lead)
1058 (defun allout-reset-header-lead (header-lead)
1059 "Reset the leading string used to identify topic headers."
1060 (interactive "sNew lead string: ")
1061 (setq allout-header-prefix header-lead
)
1062 (setq allout-header-subtraction
(1- (length allout-header-prefix
)))
1063 (set-allout-regexp))
1064 ;;;_ X allout-lead-with-comment-string (header-lead)
1065 (defun allout-lead-with-comment-string (&optional header-lead
)
1066 "Set the topic-header leading string to specified string.
1068 Useful when for encapsulating outline structure in programming
1069 language comments. Returns the leading string."
1072 (if (not (stringp header-lead
))
1073 (setq header-lead
(read-string
1074 "String prefix for topic headers: ")))
1075 (setq allout-reindent-bodies nil
)
1076 (allout-reset-header-lead header-lead
)
1078 ;;;_ > allout-infer-header-lead-and-primary-bullet ()
1079 (defun allout-infer-header-lead-and-primary-bullet ()
1080 "Determine appropriate `allout-header-prefix' and `allout-primary-bullet'.
1082 Works according to settings of:
1085 `allout-header-prefix' (default)
1086 `allout-use-mode-specific-leader'
1087 and `allout-mode-leaders'.
1089 Apply this via (re)activation of `allout-mode', rather than
1090 invoking it directly."
1091 (let* ((use-leader (and (boundp 'allout-use-mode-specific-leader
)
1092 (if (or (stringp allout-use-mode-specific-leader
)
1093 (memq allout-use-mode-specific-leader
1094 '(allout-mode-leaders
1097 allout-use-mode-specific-leader
1098 ;; Oops -- garbled value, equate with effect of t:
1102 ((not use-leader
) nil
)
1103 ;; Use the explicitly designated leader:
1104 ((stringp use-leader
) use-leader
)
1105 (t (or (and (memq use-leader
'(t allout-mode-leaders
))
1106 ;; Get it from outline mode leaders?
1107 (cdr (assq major-mode allout-mode-leaders
)))
1108 ;; ... didn't get from allout-mode-leaders...
1109 (and (memq use-leader
'(t comment-start
))
1111 ;; Use comment-start, maybe tripled, and with
1115 (substring comment-start
1116 (1- (length comment-start
))))
1117 ;; Use comment-start, sans trailing space:
1118 (substring comment-start
0 -
1)
1119 (concat comment-start comment-start comment-start
))
1120 ;; ... and append underscore, whichever:
1124 (setq allout-header-prefix leader
)
1125 (if (not allout-old-style-prefixes
)
1126 ;; setting allout-primary-bullet makes the top level topics use --
1127 ;; actually, be -- the special prefix:
1128 (setq allout-primary-bullet leader
))
1129 allout-header-prefix
)))
1130 (defalias 'allout-infer-header-lead
1131 'allout-infer-header-lead-and-primary-bullet
)
1132 ;;;_ > allout-infer-body-reindent ()
1133 (defun allout-infer-body-reindent ()
1134 "Determine proper setting for `allout-reindent-bodies'.
1136 Depends on default setting of `allout-reindent-bodies' (which see)
1137 and presence of setting for `comment-start', to tell whether the
1138 file is programming code."
1139 (if (and allout-reindent-bodies
1141 (not (eq 'force allout-reindent-bodies
)))
1142 (setq allout-reindent-bodies nil
)))
1143 ;;;_ > set-allout-regexp ()
1144 (defun set-allout-regexp ()
1145 "Generate proper topic-header regexp form for outline functions.
1147 Works with respect to `allout-plain-bullets-string' and
1148 `allout-distinctive-bullets-string'.
1150 Also refresh various data structures that hinge on the regexp."
1153 ;; Derive allout-bullets-string from user configured components:
1154 (setq allout-bullets-string
"")
1155 (let ((strings (list 'allout-plain-bullets-string
1156 'allout-distinctive-bullets-string
1157 'allout-primary-bullet
))
1164 (setq cur-len
(length (setq cur-string
(symbol-value (car strings
)))))
1165 (while (< index cur-len
)
1166 (setq cur-char
(aref cur-string index
))
1167 (setq allout-bullets-string
1168 (concat allout-bullets-string
1170 ; Single dash would denote a
1171 ; sequence, repeated denotes
1173 ((eq cur-char ?-
) "--")
1174 ; literal close-square-bracket
1175 ; doesn't work right in the
1177 ((eq cur-char ?\
]) "")
1178 (t (regexp-quote (char-to-string cur-char
))))))
1179 (setq index
(1+ index
)))
1180 (setq strings
(cdr strings
)))
1182 ;; Derive next for repeated use in allout-pending-bullet:
1183 (setq allout-plain-bullets-string-len
(length allout-plain-bullets-string
))
1184 (setq allout-header-subtraction
(1- (length allout-header-prefix
)))
1186 (let (new-part old-part formfeed-part
)
1187 (setq new-part
(concat "\\("
1188 (regexp-quote allout-header-prefix
)
1190 ;; already regexp-quoted in a custom way:
1191 "[" allout-bullets-string
"]"
1193 old-part
(concat "\\("
1194 (regexp-quote allout-primary-bullet
)
1196 (regexp-quote allout-header-prefix
)
1199 " ?[^" allout-primary-bullet
"]")
1200 formfeed-part
"\\(\^L\\)"
1202 allout-regexp
(concat new-part
1208 allout-line-boundary-regexp
(concat "\n" new-part
1214 allout-bob-regexp
(concat "\\`" new-part
1221 (setq allout-depth-specific-regexp
1222 (concat "\\(^\\|\\`\\)"
1225 ;; new-style spacers-then-bullet string:
1227 (allout-format-quote (regexp-quote allout-header-prefix
))
1229 "[" (allout-format-quote allout-bullets-string
) "]"
1232 ;; old-style all-bullets string, if primary not multi-char:
1233 (if (< 0 allout-header-subtraction
)
1236 (allout-format-quote
1237 (regexp-quote allout-primary-bullet
))
1238 (allout-format-quote
1239 (regexp-quote allout-primary-bullet
))
1240 (allout-format-quote
1241 (regexp-quote allout-primary-bullet
))
1243 ;; disqualify greater depths:
1245 (allout-format-quote allout-primary-bullet
)
1250 (setq allout-depth-one-regexp
1251 (concat "\\(^\\|\\`\\)"
1255 (regexp-quote allout-header-prefix
)
1256 ;; disqualify any bullet char following any amount of
1257 ;; intervening whitespace:
1259 (concat "[^ " allout-bullets-string
"]")
1261 (if (< 0 allout-header-subtraction
)
1262 ;; Need not support anything like the old
1263 ;; bullet style if the prefix is multi-char.
1266 (regexp-quote allout-primary-bullet
)
1267 ;; disqualify deeper primary-bullet sequences:
1268 "[^" allout-primary-bullet
"]"))
1272 ;;;_ = allout-mode-map
1273 (defvar allout-mode-map nil
"Keybindings for (allout) outline minor mode.")
1274 ;;;_ > produce-allout-mode-map (keymap-alist &optional base-map)
1275 (defun produce-allout-mode-map (keymap-list &optional base-map
)
1276 "Produce keymap for use as `allout-mode-map', from KEYMAP-LIST.
1278 Built on top of optional BASE-MAP, or empty sparse map if none specified.
1279 See doc string for `allout-keybindings-list' for format of binding list."
1280 (let ((map (or base-map
(make-sparse-keymap)))
1281 (pref (list allout-command-prefix
)))
1284 (let ((add-pref (null (cdr (cdr cell
))))
1285 (key-suff (list (car cell
))))
1288 (apply 'vconcat
(if add-pref
1289 (append pref key-suff
)
1291 (car (cdr cell
)))))))
1294 ;;;_ > allout-mode-map-adjustments (base-map)
1295 (defun allout-mode-map-adjustments (base-map)
1296 "Do conditional additions to specified base-map, like inclusion of \\C-h."
1297 (if allout-preempt-trailing-ctrl-h
1298 (cons '("\C-h" allout-hide-current-subtree
) base-map
)
1302 (defvar allout-mode-exposure-menu
)
1303 (defvar allout-mode-editing-menu
)
1304 (defvar allout-mode-navigation-menu
)
1305 (defvar allout-mode-misc-menu
)
1306 (defun produce-allout-mode-menubar-entries ()
1308 (easy-menu-define allout-mode-exposure-menu
1310 "Allout outline exposure menu."
1312 ["Show Entry" allout-show-current-entry t
]
1313 ["Show Children" allout-show-children t
]
1314 ["Show Subtree" allout-show-current-subtree t
]
1315 ["Hide Subtree" allout-hide-current-subtree t
]
1316 ["Hide Leaves" allout-hide-current-leaves t
]
1318 ["Show All" allout-show-all t
]))
1319 (easy-menu-define allout-mode-editing-menu
1321 "Allout outline editing menu."
1323 ["Open Sibling" allout-open-sibtopic t
]
1324 ["Open Subtopic" allout-open-subtopic t
]
1325 ["Open Supertopic" allout-open-supertopic t
]
1327 ["Shift Topic In" allout-shift-in t
]
1328 ["Shift Topic Out" allout-shift-out t
]
1329 ["Rebullet Topic" allout-rebullet-topic t
]
1330 ["Rebullet Heading" allout-rebullet-current-heading t
]
1331 ["Number Siblings" allout-number-siblings t
]
1333 ["Toggle Topic Encryption"
1334 allout-toggle-current-subtree-encryption
1335 (> (allout-current-depth) 1)]))
1336 (easy-menu-define allout-mode-navigation-menu
1338 "Allout outline navigation menu."
1340 ["Next Visible Heading" allout-next-visible-heading t
]
1341 ["Previous Visible Heading"
1342 allout-previous-visible-heading t
]
1344 ["Up Level" allout-up-current-level t
]
1345 ["Forward Current Level" allout-forward-current-level t
]
1346 ["Backward Current Level"
1347 allout-backward-current-level t
]
1349 ["Beginning of Entry"
1350 allout-beginning-of-current-entry t
]
1351 ["End of Entry" allout-end-of-entry t
]
1352 ["End of Subtree" allout-end-of-current-subtree t
]))
1353 (easy-menu-define allout-mode-misc-menu
1355 "Allout outlines miscellaneous bindings."
1357 ["Version" allout-version t
]
1359 ["Duplicate Exposed" allout-copy-exposed-to-buffer t
]
1360 ["Duplicate Exposed, numbered"
1361 allout-flatten-exposed-to-buffer t
]
1362 ["Duplicate Exposed, indented"
1363 allout-indented-exposed-to-buffer t
]
1365 ["Set Header Lead" allout-reset-header-lead t
]
1366 ["Set New Exposure" allout-expose-topic t
])))
1367 ;;;_ : Allout Modal-Variables Utilities
1368 ;;;_ = allout-mode-prior-settings
1369 (defvar allout-mode-prior-settings nil
1370 "Internal `allout-mode' use; settings to be resumed on mode deactivation.
1372 See `allout-add-resumptions' and `allout-do-resumptions'.")
1373 (make-variable-buffer-local 'allout-mode-prior-settings
)
1374 ;;;_ > allout-add-resumptions (&rest pairs)
1375 (defun allout-add-resumptions (&rest pairs
)
1376 "Set name/value PAIRS.
1378 Old settings are preserved for later resumption using `allout-do-resumptions'.
1380 The new values are set as a buffer local. On resumption, the prior buffer
1381 scope of the variable is restored along with its value. If it was a void
1382 buffer-local value, then it is left as nil on resumption.
1384 The pairs are lists whose car is the name of the variable and car of the
1385 cdr is the new value: '(some-var some-value)'. The pairs can actually be
1386 triples, where the third element qualifies the disposition of the setting,
1387 as described further below.
1389 If the optional third element is the symbol 'extend, then the new value
1390 created by `cons'ing the second element of the pair onto the front of the
1393 If the optional third element is the symbol 'append, then the new value is
1394 extended from the existing one by `append'ing a list containing the second
1395 element of the pair onto the end of the existing value.
1397 Extension, and resumptions in general, should not be used for hook
1398 functions -- use the 'local mode of `add-hook' for that, instead.
1400 The settings are stored on `allout-mode-prior-settings'."
1402 (let* ((pair (pop pairs
))
1405 (qualifier (if (> (length pair
) 2)
1408 (if (not (symbolp name
))
1409 (error "Pair's name, %S, must be a symbol, not %s"
1410 name
(type-of name
)))
1411 (setq prior-value
(condition-case nil
1413 (void-variable nil
)))
1414 (when (not (assoc name allout-mode-prior-settings
))
1415 ;; Not already added as a resumption, create the prior setting entry.
1416 (if (local-variable-p name
(current-buffer))
1417 ;; is already local variable -- preserve the prior value:
1418 (push (list name prior-value
) allout-mode-prior-settings
)
1419 ;; wasn't local variable, indicate so for resumption by killing
1420 ;; local value, and make it local:
1421 (push (list name
) allout-mode-prior-settings
)
1422 (make-local-variable name
)))
1424 (cond ((eq qualifier
'extend
)
1425 (if (not (listp prior-value
))
1426 (error "extension of non-list prior value attempted")
1427 (set name
(cons value prior-value
))))
1428 ((eq qualifier
'append
)
1429 (if (not (listp prior-value
))
1430 (error "appending of non-list prior value attempted")
1431 (set name
(append prior-value
(list value
)))))
1432 (t (error "unrecognized setting qualifier `%s' encountered"
1434 (set name value
)))))
1435 ;;;_ > allout-do-resumptions ()
1436 (defun allout-do-resumptions ()
1437 "Resume all name/value settings registered by `allout-add-resumptions'.
1439 This is used when concluding allout-mode, to resume selected variables to
1440 their settings before allout-mode was started."
1442 (while allout-mode-prior-settings
1443 (let* ((pair (pop allout-mode-prior-settings
))
1445 (value-cell (cdr pair
)))
1446 (if (not value-cell
)
1447 ;; Prior value was global:
1448 (kill-local-variable name
)
1449 ;; Prior value was explicit:
1450 (set name
(car value-cell
))))))
1451 ;;;_ : Mode-specific incidentals
1452 ;;;_ > allout-unprotected (expr)
1453 (defmacro allout-unprotected
(expr)
1454 "Enable internal outline operations to alter invisible text."
1455 `(let ((inhibit-read-only (if (not buffer-read-only
) t
))
1456 (inhibit-field-text-motion t
))
1458 ;;;_ = allout-mode-hook
1459 (defvar allout-mode-hook nil
1460 "*Hook that's run when allout mode starts.")
1461 ;;;_ = allout-mode-deactivate-hook
1462 (defvar allout-mode-deactivate-hook nil
1463 "*Hook that's run when allout mode ends.")
1464 ;;;_ = allout-exposure-category
1465 (defvar allout-exposure-category nil
1466 "Symbol for use as allout invisible-text overlay category.")
1467 ;;;_ x allout-view-change-hook
1468 (defvar allout-view-change-hook nil
1469 "*(Deprecated) A hook run after allout outline exposure changes.
1471 Switch to using `allout-exposure-change-hook' instead. Both hooks are
1472 currently respected, but the other conveys the details of the exposure
1473 change via explicit parameters, and this one will eventually be disabled in
1474 a subsequent allout version.")
1475 ;;;_ = allout-exposure-change-hook
1476 (defvar allout-exposure-change-hook nil
1477 "*Hook that's run after allout outline subtree exposure changes.
1479 It is run at the conclusion of `allout-flag-region'.
1481 Functions on the hook must take three arguments:
1483 - FROM -- integer indicating the point at the start of the change.
1484 - TO -- integer indicating the point of the end of the change.
1485 - FLAG -- change mode: nil for exposure, otherwise concealment.
1487 This hook might be invoked multiple times by a single command.
1489 This hook is replacing `allout-view-change-hook', which is being deprecated
1490 and eventually will not be invoked.")
1491 ;;;_ = allout-structure-added-hook
1492 (defvar allout-structure-added-hook nil
1493 "*Hook that's run after addition of items to the outline.
1495 Functions on the hook should take two arguments:
1497 - NEW-START -- integer indicating position of start of the first new item.
1498 - NEW-END -- integer indicating position of end of the last new item.
1500 Some edits that introduce new items may missed by this hook:
1501 specifically edits that native allout routines do not control.
1503 This hook might be invoked multiple times by a single command.")
1504 ;;;_ = allout-structure-deleted-hook
1505 (defvar allout-structure-deleted-hook nil
1506 "*Hook that's run after disciplined deletion of subtrees from the outline.
1508 Functions on the hook must take two arguments:
1510 - DEPTH -- integer indicating the depth of the subtree that was deleted.
1511 - REMOVED-FROM -- integer indicating the point where the subtree was removed.
1513 Some edits that remove or invalidate items may missed by this hook:
1514 specifically edits that native allout routines do not control.
1516 This hook might be invoked multiple times by a single command.")
1517 ;;;_ = allout-structure-shifted-hook
1518 (defvar allout-structure-shifted-hook nil
1519 "*Hook that's run after shifting of items in the outline.
1521 Functions on the hook should take two arguments:
1523 - DEPTH-CHANGE -- integer indicating depth increase, negative for decrease
1524 - START -- integer indicating the start point of the shifted parent item.
1526 Some edits that shift items can be missed by this hook: specifically edits
1527 that native allout routines do not control.
1529 This hook might be invoked multiple times by a single command.")
1530 ;;;_ = allout-outside-normal-auto-fill-function
1531 (defvar allout-outside-normal-auto-fill-function nil
1532 "Value of normal-auto-fill-function outside of allout mode.
1534 Used by allout-auto-fill to do the mandated normal-auto-fill-function
1535 wrapped within allout's automatic fill-prefix setting.")
1536 (make-variable-buffer-local 'allout-outside-normal-auto-fill-function
)
1537 ;;;_ = file-var-bug hack
1538 (defvar allout-v18
/19-file-var-hack nil
1539 "Horrible hack used to prevent invalid multiple triggering of outline
1540 mode from prop-line file-var activation. Used by `allout-mode' function
1542 ;;;_ = allout-passphrase-verifier-string
1543 (defvar allout-passphrase-verifier-string nil
1544 "Setting used to test solicited encryption passphrases against the one
1545 already associated with a file.
1547 It consists of an encrypted random string useful only to verify that a
1548 passphrase entered by the user is effective for decryption. The passphrase
1549 itself is \*not* recorded in the file anywhere, and the encrypted contents
1550 are random binary characters to avoid exposing greater susceptibility to
1553 The verifier string is retained as an Emacs file variable, as well as in
1554 the Emacs buffer state, if file variable adjustments are enabled. See
1555 `allout-enable-file-variable-adjustment' for details about that.")
1556 (make-variable-buffer-local 'allout-passphrase-verifier-string
)
1558 (put 'allout-passphrase-verifier-string
'safe-local-variable
'stringp
)
1559 ;;;_ = allout-passphrase-hint-string
1560 (defvar allout-passphrase-hint-string
""
1561 "Variable used to retain reminder string for file's encryption passphrase.
1563 See the description of `allout-passphrase-hint-handling' for details about how
1564 the reminder is deployed.
1566 The hint is retained as an Emacs file variable, as well as in the Emacs buffer
1567 state, if file variable adjustments are enabled. See
1568 `allout-enable-file-variable-adjustment' for details about that.")
1569 (make-variable-buffer-local 'allout-passphrase-hint-string
)
1570 (setq-default allout-passphrase-hint-string
"")
1572 (put 'allout-passphrase-hint-string
'safe-local-variable
'stringp
)
1573 ;;;_ = allout-after-save-decrypt
1574 (defvar allout-after-save-decrypt nil
1575 "Internal variable, is nil or has the value of two points:
1577 - the location of a topic to be decrypted after saving is done
1578 - where to situate the cursor after the decryption is performed
1580 This is used to decrypt the topic that was currently being edited, if it
1581 was encrypted automatically as part of a file write or autosave.")
1582 (make-variable-buffer-local 'allout-after-save-decrypt
)
1583 ;;;_ = allout-encryption-plaintext-sanitization-regexps
1584 (defvar allout-encryption-plaintext-sanitization-regexps nil
1585 "List of regexps whose matches are removed from plaintext before encryption.
1587 This is for the sake of removing artifacts, like escapes, that are added on
1588 and not actually part of the original plaintext. The removal is done just
1589 prior to encryption.
1591 Entries must be symbols that are bound to the desired values.
1593 Each value can be a regexp or a list with a regexp followed by a
1594 substitution string. If it's just a regexp, all its matches are removed
1595 before the text is encrypted. If it's a regexp and a substitution, the
1596 substition is used against the regexp matches, a la `replace-match'.")
1597 (make-variable-buffer-local 'allout-encryption-text-removal-regexps
)
1598 ;;;_ = allout-encryption-ciphertext-rejection-regexps
1599 (defvar allout-encryption-ciphertext-rejection-regexps nil
1600 "Variable for regexps matching plaintext to remove before encryption.
1602 This is for the sake of redoing encryption in cases where the ciphertext
1603 incidentally contains strings that would disrupt mode operation --
1604 for example, a line that happens to look like an allout-mode topic prefix.
1606 Entries must be symbols that are bound to the desired regexp values.
1608 The encryption will be retried up to
1609 `allout-encryption-ciphertext-rejection-limit' times, after which an error
1612 (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps
)
1613 ;;;_ = allout-encryption-ciphertext-rejection-ceiling
1614 (defvar allout-encryption-ciphertext-rejection-ceiling
5
1615 "Limit on number of times encryption ciphertext is rejected.
1617 See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
1618 (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling
)
1619 ;;;_ > allout-mode-p ()
1620 ;; Must define this macro above any uses, or byte compilation will lack
1621 ;; proper def, if file isn't loaded -- eg, during emacs build!
1622 (defmacro allout-mode-p
()
1623 "Return t if `allout-mode' is active in current buffer."
1625 ;;;_ > allout-write-file-hook-handler ()
1626 (defun allout-write-file-hook-handler ()
1627 "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes."
1629 (if (or (not (allout-mode-p))
1630 (not (boundp 'allout-encrypt-unencrypted-on-saves
))
1631 (not allout-encrypt-unencrypted-on-saves
))
1633 (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves
1636 (if (save-excursion (goto-char (point-min))
1637 (allout-next-topic-pending-encryption except-mark
))
1639 (message "auto-encrypting pending topics")
1641 (condition-case failure
1642 (setq allout-after-save-decrypt
1643 (allout-encrypt-decrypted except-mark
))
1645 "allout-write-file-hook-handler suppressing error %s"
1650 ;;;_ > allout-auto-save-hook-handler ()
1651 (defun allout-auto-save-hook-handler ()
1652 "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save."
1654 (if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves
)
1655 ;; Always implement 'except-current policy when enabled.
1656 (let ((allout-encrypt-unencrypted-on-saves 'except-current
))
1657 (allout-write-file-hook-handler))))
1658 ;;;_ > allout-after-saves-handler ()
1659 (defun allout-after-saves-handler ()
1660 "Decrypt topic encrypted for save, if it's currently being edited.
1662 Ie, if it was pending encryption and contained the point in its body before
1665 We use values stored in `allout-after-save-decrypt' to locate the topic
1666 and the place for the cursor after the decryption is done."
1667 (if (not (and (allout-mode-p)
1668 (boundp 'allout-after-save-decrypt
)
1669 allout-after-save-decrypt
))
1671 (goto-char (car allout-after-save-decrypt
))
1672 (let ((was-modified (buffer-modified-p)))
1673 (allout-toggle-subtree-encryption)
1674 (if (not was-modified
)
1675 (set-buffer-modified-p nil
)))
1676 (goto-char (cadr allout-after-save-decrypt
))
1677 (setq allout-after-save-decrypt nil
))
1679 ;;;_ > allout-called-interactively-p ()
1680 (defmacro allout-called-interactively-p
()
1681 "A version of called-interactively-p independent of emacs version."
1682 ;; ... to ease maintenance of allout without betraying deprecation.
1683 (if (equal (subr-arity (symbol-function 'called-interactively-p
))
1685 '(called-interactively-p)
1686 '(called-interactively-p 'interactive
)))
1687 ;;;_ = allout-inhibit-aberrance-doublecheck nil
1688 ;; In some exceptional moments, disparate topic depths need to be allowed
1689 ;; momentarily, eg when one topic is being yanked into another and they're
1690 ;; about to be reconciled. let-binding allout-inhibit-aberrance-doublecheck
1691 ;; prevents the aberrance doublecheck to allow, eg, the reconciliation
1692 ;; processing to happen in the presence of such discrepancies. It should
1693 ;; almost never be needed, however.
1694 (defvar allout-inhibit-aberrance-doublecheck nil
1695 "Internal state, for momentarily inhibits aberrance doublecheck.
1697 This should only be momentarily let-bound non-nil, not set
1698 non-nil in a lasting way.")
1700 ;;;_ #2 Mode environment and activation
1701 ;;;_ = allout-explicitly-deactivated
1702 (defvar allout-explicitly-deactivated nil
1703 "If t, `allout-mode's last deactivation was deliberate.
1704 So `allout-post-command-business' should not reactivate it...")
1705 (make-variable-buffer-local 'allout-explicitly-deactivated
)
1706 ;;;_ > allout-init (&optional mode)
1707 (defun allout-init (&optional mode
)
1708 "Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'.
1710 MODE is one of the following symbols:
1712 - nil (or no argument) deactivate auto-activation/layout;
1713 - `activate', enable auto-activation only;
1714 - `ask', enable auto-activation, and enable auto-layout but with
1715 confirmation for layout operation solicited from user each time;
1716 - `report', just report and return the current auto-activation state;
1717 - anything else (eg, t) for auto-activation and auto-layout, without
1718 any confirmation check.
1720 Use this function to setup your Emacs session for automatic activation
1721 of allout outline mode, contingent to the buffer-specific setting of
1722 the `allout-layout' variable. (See `allout-layout' and
1723 `allout-expose-topic' docstrings for more details on auto layout).
1725 `allout-init' works by setting up (or removing) the `allout-mode'
1726 find-file-hook, and giving `allout-auto-activation' a suitable
1729 To prime your Emacs session for full auto-outline operation, include
1730 the following two lines in your Emacs init file:
1736 (if (allout-called-interactively-p)
1740 (concat "Select outline auto setup mode "
1741 "(empty for report, ? for options) ")
1742 '(("nil")("full")("activate")("deactivate")
1743 ("ask") ("report") (""))
1746 (if (string= mode
"")
1748 (setq mode
(intern-soft mode
)))))
1750 ;; convenience aliases, for consistent ref to respective vars:
1751 ((hook 'allout-find-file-hook
)
1752 (find-file-hook-var-name (if (boundp 'find-file-hook
)
1755 (curr-mode 'allout-auto-activation
))
1758 (set find-file-hook-var-name
1759 (delq hook
(symbol-value find-file-hook-var-name
)))
1760 (if (allout-called-interactively-p)
1761 (message "Allout outline mode auto-activation inhibited.")))
1763 (if (not (memq hook
(symbol-value find-file-hook-var-name
)))
1765 ;; Just punt and use the reports from each of the modes:
1766 (allout-init (symbol-value curr-mode
))))
1767 (t (add-hook find-file-hook-var-name hook
)
1768 (set curr-mode
; `set', not `setq'!
1769 (cond ((eq mode
'activate
)
1771 "Outline mode auto-activation enabled.")
1774 ;; Return the current mode setting:
1778 (concat "Outline mode auto-activation and "
1779 "-layout (upon confirmation) enabled."))
1782 "Outline mode auto-activation and -layout enabled.")
1784 ;;;_ > allout-setup-menubar ()
1785 (defun allout-setup-menubar ()
1786 "Populate the current buffer's menubar with `allout-mode' stuff."
1787 (let ((menus (list allout-mode-exposure-menu
1788 allout-mode-editing-menu
1789 allout-mode-navigation-menu
1790 allout-mode-misc-menu
))
1793 (setq cur
(car menus
)
1795 (easy-menu-add cur
))))
1796 ;;;_ > allout-overlay-preparations
1797 (defun allout-overlay-preparations ()
1798 "Set the properties of the allout invisible-text overlay and others."
1799 (setplist 'allout-exposure-category nil
)
1800 (put 'allout-exposure-category
'invisible
'allout
)
1801 (put 'allout-exposure-category
'evaporate t
)
1802 ;; ??? We use isearch-open-invisible *and* isearch-mode-end-hook. The
1803 ;; latter would be sufficient, but it seems that a separate behavior --
1804 ;; the _transient_ opening of invisible text during isearch -- is keyed to
1805 ;; presence of the isearch-open-invisible property -- even though this
1806 ;; property controls the isearch _arrival_ behavior. This is the case at
1807 ;; least in emacs 21, 22.1, and xemacs 21.4.
1808 (put 'allout-exposure-category
'isearch-open-invisible
1809 'allout-isearch-end-handler
)
1810 (if (featurep 'xemacs
)
1811 (put 'allout-exposure-category
'start-open t
)
1812 (put 'allout-exposure-category
'insert-in-front-hooks
1813 '(allout-overlay-insert-in-front-handler)))
1814 (put 'allout-exposure-category
'modification-hooks
1815 '(allout-overlay-interior-modification-handler)))
1816 ;;;_ > allout-mode (&optional toggle)
1819 (defun allout-mode (&optional toggle
)
1821 "Toggle minor mode for controlling exposure and editing of text outlines.
1824 Optional prefix argument TOGGLE forces the mode to re-initialize
1825 if it is positive, otherwise it turns the mode off. Allout
1826 outline mode always runs as a minor mode.
1828 Allout outline mode provides extensive outline oriented formatting and
1829 manipulation. It enables structural editing of outlines, as well as
1830 navigation and exposure. It also is specifically aimed at
1831 accommodating syntax-sensitive text like programming languages. (For
1832 an example, see the allout code itself, which is organized as an allout
1835 In addition to typical outline navigation and exposure, allout includes:
1837 - topic-oriented authoring, including keystroke-based topic creation,
1838 repositioning, promotion/demotion, cut, and paste
1839 - incremental search with dynamic exposure and reconcealment of hidden text
1840 - adjustable format, so programming code can be developed in outline-structure
1841 - easy topic encryption and decryption
1842 - \"Hot-spot\" operation, for single-keystroke maneuvering and exposure control
1843 - integral outline layout, for automatic initial exposure when visiting a file
1844 - independent extensibility, using comprehensive exposure and authoring hooks
1846 and many other features.
1848 Below is a description of the key bindings, and then explanation of
1849 special `allout-mode' features and terminology. See also the outline
1850 menubar additions for quick reference to many of the features, and see
1851 the docstring of the function `allout-init' for instructions on
1852 priming your emacs session for automatic activation of `allout-mode'.
1854 The bindings are dictated by the customizable `allout-keybindings-list'
1855 variable. We recommend customizing `allout-command-prefix' to use just
1856 `\\C-c' as the command prefix, if the allout bindings don't conflict with
1857 any personal bindings you have on \\C-c. In any case, outline structure
1858 navigation and authoring is simplified by positioning the cursor on an
1859 item's bullet character, the \"hot-spot\" -- then you can invoke allout
1860 commands with just the un-prefixed, un-control-shifted command letters.
1861 This is described further in the HOT-SPOT Operation section.
1865 \\[allout-hide-current-subtree] `allout-hide-current-subtree'
1866 \\[allout-show-children] `allout-show-children'
1867 \\[allout-show-current-subtree] `allout-show-current-subtree'
1868 \\[allout-show-current-entry] `allout-show-current-entry'
1869 \\[allout-show-all] `allout-show-all'
1873 \\[allout-next-visible-heading] `allout-next-visible-heading'
1874 \\[allout-previous-visible-heading] `allout-previous-visible-heading'
1875 \\[allout-up-current-level] `allout-up-current-level'
1876 \\[allout-forward-current-level] `allout-forward-current-level'
1877 \\[allout-backward-current-level] `allout-backward-current-level'
1878 \\[allout-end-of-entry] `allout-end-of-entry'
1879 \\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot)
1880 \\[allout-beginning-of-line] `allout-beginning-of-line' -- like regular beginning-of-line, but
1881 if immediately repeated cycles to the beginning of the current item
1882 and then to the hot-spot (if `allout-beginning-of-line-cycles' is set).
1885 Topic Header Production:
1886 -----------------------
1887 \\[allout-open-sibtopic] `allout-open-sibtopic' Create a new sibling after current topic.
1888 \\[allout-open-subtopic] `allout-open-subtopic' ... an offspring of current topic.
1889 \\[allout-open-supertopic] `allout-open-supertopic' ... a sibling of the current topic's parent.
1891 Topic Level and Prefix Adjustment:
1892 ---------------------------------
1893 \\[allout-shift-in] `allout-shift-in' Shift current topic and all offspring deeper
1894 \\[allout-shift-out] `allout-shift-out' ... less deep
1895 \\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for
1897 \\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and
1898 its' offspring -- distinctive bullets are not changed, others
1899 are alternated according to nesting depth.
1900 \\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings --
1901 the offspring are not affected.
1902 With repeat count, revoke numbering.
1904 Topic-oriented Killing and Yanking:
1905 ----------------------------------
1906 \\[allout-kill-topic] `allout-kill-topic' Kill current topic, including offspring.
1907 \\[allout-copy-topic-as-kill] `allout-copy-topic-as-kill' Copy current topic, including offspring.
1908 \\[allout-kill-line] `allout-kill-line' kill-line, attending to outline structure.
1909 \\[allout-copy-line-as-kill] `allout-copy-line-as-kill' Copy line but don't delete it.
1910 \\[allout-yank] `allout-yank' Yank, adjusting depth of yanked topic to
1911 depth of heading if yanking into bare topic
1912 heading (ie, prefix sans text).
1913 \\[allout-yank-pop] `allout-yank-pop' Is to allout-yank as yank-pop is to yank
1915 Topic-oriented Encryption:
1916 -------------------------
1917 \\[allout-toggle-current-subtree-encryption] `allout-toggle-current-subtree-encryption'
1918 Encrypt/Decrypt topic content
1922 M-x outlineify-sticky Activate outline mode for current buffer,
1923 and establish a default file-var setting
1924 for `allout-layout'.
1925 \\[allout-mark-topic] `allout-mark-topic'
1926 \\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer'
1927 Duplicate outline, sans concealed text, to
1928 buffer with name derived from derived from that
1929 of current buffer -- \"*BUFFERNAME exposed*\".
1930 \\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer'
1931 Like above 'copy-exposed', but convert topic
1932 prefixes to section.subsection... numeric
1934 \\[eval-expression] (allout-init t) Setup Emacs session for outline mode
1939 Outline mode supports gpg encryption of topics, with support for
1940 symmetric and key-pair modes, passphrase timeout, passphrase
1941 consistency checking, user-provided hinting for symmetric key
1942 mode, and auto-encryption of topics pending encryption on save.
1944 Topics pending encryption are, by default, automatically
1945 encrypted during file saves. If the contents of the topic
1946 containing the cursor was encrypted for a save, it is
1947 automatically decrypted for continued editing.
1949 The aim of these measures is reliable topic privacy while
1950 preventing accidents like neglected encryption before saves,
1951 forgetting which passphrase was used, and other practical
1954 See `allout-toggle-current-subtree-encryption' function docstring
1955 and `allout-encrypt-unencrypted-on-saves' customization variable
1960 Hot-spot operation provides a means for easy, single-keystroke outline
1961 navigation and exposure control.
1963 When the text cursor is positioned directly on the bullet character of
1964 a topic, regular characters (a to z) invoke the commands of the
1965 corresponding allout-mode keymap control chars. For example, \"f\"
1966 would invoke the command typically bound to \"C-c<space>C-f\"
1967 \(\\[allout-forward-current-level] `allout-forward-current-level').
1969 Thus, by positioning the cursor on a topic bullet, you can
1970 execute the outline navigation and manipulation commands with a
1971 single keystroke. Regular navigation keys (eg, \\[forward-char], \\[next-line]) don't get
1972 this special translation, so you can use them to get out of the
1973 hot-spot and back to normal editing operation.
1975 In allout-mode, the normal beginning-of-line command (\\[allout-beginning-of-line]) is
1976 replaced with one that makes it easy to get to the hot-spot. If you
1977 repeat it immediately it cycles (if `allout-beginning-of-line-cycles'
1978 is set) to the beginning of the item and then, if you hit it again
1979 immediately, to the hot-spot. Similarly, `allout-beginning-of-current-entry'
1980 \(\\[allout-beginning-of-current-entry]) moves to the hot-spot when the cursor is already located
1981 at the beginning of the current entry.
1985 Allout exposure and authoring activites all have associated
1986 hooks, by which independent code can cooperate with allout
1987 without changes to the allout core. Here are key ones:
1990 `allout-mode-deactivate-hook'
1991 `allout-exposure-change-hook'
1992 `allout-structure-added-hook'
1993 `allout-structure-deleted-hook'
1994 `allout-structure-shifted-hook'
1998 Topic hierarchy constituents -- TOPICS and SUBTOPICS:
2000 ITEM: A unitary outline element, including the HEADER and ENTRY text.
2001 TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH
2002 and with no intervening items of lower DEPTH than the container.
2004 The visible ITEM most immediately containing the cursor.
2005 DEPTH: The degree of nesting of an ITEM; it increases with containment.
2006 The DEPTH is determined by the HEADER PREFIX. The DEPTH is also
2008 LEVEL: The same as DEPTH.
2011 Those ITEMs whose TOPICs contain an ITEM.
2012 PARENT: An ITEM's immediate ANCESTOR. It has a DEPTH one less than that
2015 The ITEMs contained within an ITEM's TOPIC.
2017 An OFFSPRING of its ANCESTOR TOPICs.
2019 An immediate SUBTOPIC of its PARENT.
2021 TOPICs having the same PARENT and DEPTH.
2023 Topic text constituents:
2025 HEADER: The first line of an ITEM, include the ITEM PREFIX and HEADER
2027 ENTRY: The text content of an ITEM, before any OFFSPRING, but including
2028 the HEADER text and distinct from the ITEM PREFIX.
2029 BODY: Same as ENTRY.
2030 PREFIX: The leading text of an ITEM which distinguishes it from normal
2031 ENTRY text. Allout recognizes the outline structure according
2032 to the strict PREFIX format. It consists of a PREFIX-LEAD string,
2033 PREFIX-PADDING, and a BULLET. The BULLET might be followed by a
2034 number, indicating the ordinal number of the topic among its
2035 siblings, or an asterisk indicating encryption, plus an optional
2036 space. After that is the ITEM HEADER text, which is not part of
2039 The relative length of the PREFIX determines the nesting DEPTH
2042 The string at the beginning of a HEADER PREFIX, by default a `.'.
2043 It can be customized by changing the setting of
2044 `allout-header-prefix' and then reinitializing `allout-mode'.
2046 When the PREFIX-LEAD is set to the comment-string of a
2047 programming language, outline structuring can be embedded in
2048 program code without interfering with processing of the text
2049 (by emacs or the language processor) as program code. This
2050 setting happens automatically when allout mode is used in
2051 programming-mode buffers. See `allout-use-mode-specific-leader'
2052 docstring for more detail.
2054 Spaces or asterisks which separate the PREFIX-LEAD and the
2055 bullet, determining the ITEM's DEPTH.
2056 BULLET: A character at the end of the ITEM PREFIX, it must be one of
2057 the characters listed on `allout-plain-bullets-string' or
2058 `allout-distinctive-bullets-string'. When creating a TOPIC,
2059 plain BULLETs are by default used, according to the DEPTH of the
2060 TOPIC. Choice among the distinctive BULLETs is offered when you
2061 provide a universal argugment \(\\[universal-argument]) to the
2062 TOPIC creation command, or when explictly rebulleting a TOPIC. The
2063 significance of the various distinctive bullets is purely by
2064 convention. See the documentation for the above bullet strings for
2067 The state of a TOPIC which determines the on-screen visibility
2068 of its OFFSPRING and contained ENTRY text.
2070 TOPICs and ENTRY text whose EXPOSURE is inhibited. Concealed
2071 text is represented by \"...\" ellipses.
2073 CONCEALED TOPICs are effectively collapsed within an ANCESTOR.
2074 CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED.
2075 OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
2079 (let* ((active (and (not (equal major-mode
'outline
))
2081 ; Massage universal-arg `toggle' val:
2083 (or (and (listp toggle
)(car toggle
))
2085 ; Activation specifically demanded?
2086 (explicit-activation (and toggle
2087 (or (symbolp toggle
)
2088 (and (wholenump toggle
)
2089 (not (zerop toggle
))))))
2090 ;; allout-mode already called once during this complex command?
2091 (same-complex-command (eq allout-v18
/19-file-var-hack
2092 (car command-history
)))
2093 (write-file-hook-var-name (cond ((boundp 'write-file-functions
)
2094 'write-file-functions
)
2095 ((boundp 'write-file-hooks
)
2097 (t 'local-write-file-hooks
)))
2101 ; See comments below re v19.18,.19 bug.
2102 (setq allout-v18
/19-file-var-hack
(car command-history
))
2106 ;; Provision for v19.18, 19.19 bug --
2107 ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated
2108 ;; modes twice when file is visited. We have to avoid toggling mode
2109 ;; off on second invocation, so we detect it as best we can, and
2111 ((and same-complex-command
; Still in same complex command
2112 ; as last time `allout-mode' invoked.
2113 active
; Already activated.
2114 (not explicit-activation
) ; Prop-line file-vars don't have args.
2115 (string-match "^19.1[89]" ; Bug only known to be in v19.18 and
2116 emacs-version
)); 19.19.
2120 ((and (not explicit-activation
)
2122 ; Activation not explicitly
2123 ; requested, and either in
2124 ; active state or *de*activation
2125 ; specifically requested:
2126 (setq allout-explicitly-deactivated t
)
2128 (allout-do-resumptions)
2130 (remove-from-invisibility-spec '(allout . t
))
2131 (remove-hook 'pre-command-hook
'allout-pre-command-business t
)
2132 (remove-hook 'post-command-hook
'allout-post-command-business t
)
2133 (remove-hook 'before-change-functions
'allout-before-change-handler t
)
2134 (remove-hook 'isearch-mode-end-hook
'allout-isearch-end-handler t
)
2135 (remove-hook write-file-hook-var-name
'allout-write-file-hook-handler t
)
2136 (remove-hook 'auto-save-hook
'allout-auto-save-hook-handler t
)
2138 (remove-overlays (point-min) (point-max)
2139 'category
'allout-exposure-category
)
2141 (setq allout-mode nil
)
2142 (run-hooks 'allout-mode-deactivate-hook
))
2146 (setq allout-explicitly-deactivated nil
)
2147 (if allout-old-style-prefixes
2148 ;; Inhibit all the fancy formatting:
2149 (allout-add-resumptions '(allout-primary-bullet "*")))
2151 (allout-overlay-preparations) ; Doesn't hurt to redo this.
2153 (allout-infer-header-lead-and-primary-bullet)
2154 (allout-infer-body-reindent)
2157 (allout-add-resumptions
2158 '(allout-encryption-ciphertext-rejection-regexps
2159 allout-line-boundary-regexp
2161 '(allout-encryption-ciphertext-rejection-regexps
2165 ;; Produce map from current version of allout-keybindings-list:
2166 (allout-setup-mode-map)
2167 (produce-allout-mode-menubar-entries)
2169 ;; Include on minor-mode-map-alist, if not already there:
2170 (if (not (member '(allout-mode . allout-mode-map
)
2171 minor-mode-map-alist
))
2172 (setq minor-mode-map-alist
2173 (cons '(allout-mode . allout-mode-map
)
2174 minor-mode-map-alist
)))
2176 (add-to-invisibility-spec '(allout . t
))
2178 (allout-add-resumptions '(line-move-ignore-invisible t
))
2179 (add-hook 'pre-command-hook
'allout-pre-command-business nil t
)
2180 (add-hook 'post-command-hook
'allout-post-command-business nil t
)
2181 (add-hook 'before-change-functions
'allout-before-change-handler
2183 (add-hook 'isearch-mode-end-hook
'allout-isearch-end-handler nil t
)
2184 (add-hook write-file-hook-var-name
'allout-write-file-hook-handler
2186 (add-hook 'auto-save-hook
'allout-auto-save-hook-handler
2189 ;; Stash auto-fill settings and adjust so custom allout auto-fill
2190 ;; func will be used if auto-fill is active or activated. (The
2191 ;; custom func respects topic headline, maintains hanging-indents,
2193 (if (and auto-fill-function
(not allout-inhibit-auto-fill
))
2194 ;; allout-auto-fill will use the stashed values and so forth.
2195 (allout-add-resumptions '(auto-fill-function allout-auto-fill
)))
2196 (allout-add-resumptions (list 'allout-former-auto-filler
2198 ;; Register allout-auto-fill to be used if
2199 ;; filling is active:
2200 (list 'allout-outside-normal-auto-fill-function
2201 normal-auto-fill-function
)
2202 '(normal-auto-fill-function allout-auto-fill
)
2203 ;; Paragraphs are broken by topic headlines.
2204 (list 'paragraph-start
2205 (concat paragraph-start
"\\|^\\("
2206 allout-regexp
"\\)"))
2207 (list 'paragraph-separate
2208 (concat paragraph-separate
"\\|^\\("
2209 allout-regexp
"\\)")))
2210 (or (assq 'allout-mode minor-mode-alist
)
2211 (setq minor-mode-alist
2212 (cons '(allout-mode " Allout") minor-mode-alist
)))
2214 (allout-setup-menubar)
2219 (setq allout-mode t
)
2220 (run-hooks 'allout-mode-hook
))
2224 (allout-infer-body-reindent))
2225 ) ;; end of activation-mode cases.
2227 ;; Do auto layout if warranted:
2228 (let ((use-layout (if (listp allout-layout
)
2230 allout-default-layout
)))
2232 allout-auto-activation
2234 (and (not (eq allout-auto-activation
'activate
))
2235 (if (eq allout-auto-activation
'ask
)
2236 (if (y-or-n-p (format "Expose %s with layout '%s'? "
2240 (message "Skipped %s layout." (buffer-name))
2244 (message "Adjusting '%s' exposure..." (buffer-name))
2246 (allout-this-or-next-heading)
2249 (apply 'allout-expose-topic
(list use-layout
))
2250 (message "Adjusting '%s' exposure... done." (buffer-name)))
2251 ;; Problem applying exposure -- notify user, but don't
2252 ;; interrupt, eg, file visit:
2253 (error (message "%s" (car (cdr err
)))
2259 (defun allout-setup-mode-map ()
2260 "Establish allout-mode bindings."
2261 (setq-default allout-mode-map
2262 (produce-allout-mode-map
2263 (allout-mode-map-adjustments allout-keybindings-list
)))
2264 (setq allout-mode-map
2265 (produce-allout-mode-map
2266 (allout-mode-map-adjustments allout-keybindings-list
)))
2267 (substitute-key-definition 'beginning-of-line
2268 'allout-beginning-of-line
2269 allout-mode-map global-map
)
2270 (substitute-key-definition 'move-beginning-of-line
2271 'allout-beginning-of-line
2272 allout-mode-map global-map
)
2273 (substitute-key-definition 'end-of-line
2275 allout-mode-map global-map
)
2276 (substitute-key-definition 'move-end-of-line
2278 allout-mode-map global-map
)
2279 (fset 'allout-mode-map allout-mode-map
))
2281 ;; ensure that allout-mode-map has some setting even if allout-mode hasn't
2283 (allout-setup-mode-map)
2285 ;;;_ > allout-minor-mode
2286 (defalias 'allout-minor-mode
'allout-mode
)
2288 ;;;_ > allout-unload-function
2289 (defun allout-unload-function ()
2290 "Unload the allout outline library."
2291 (save-current-buffer
2292 (dolist (buffer (buffer-list))
2294 (when allout-mode
(allout-mode -
1))))
2295 ;; continue standard unloading
2298 ;;;_ - Position Assessment
2299 ;;;_ > allout-hidden-p (&optional pos)
2300 (defsubst allout-hidden-p
(&optional pos
)
2301 "Non-nil if the character after point was made invisible by allout."
2302 (eq (get-char-property (or pos
(point)) 'invisible
) 'allout
))
2304 ;;;_ > allout-overlay-insert-in-front-handler (ol after beg end
2305 ;;; &optional prelen)
2306 (defun allout-overlay-insert-in-front-handler (ol after beg end
2308 "Shift the overlay so stuff inserted in front of it is excluded."
2310 ;; ??? Shouldn't moving the overlay should be unnecessary, if overlay
2311 ;; front-advance on the overlay worked as expected?
2312 (move-overlay ol
(1+ beg
) (overlay-end ol
))))
2313 ;;;_ > allout-overlay-interior-modification-handler (ol after beg end
2314 ;;; &optional prelen)
2315 (defun allout-overlay-interior-modification-handler (ol after beg end
2317 "Get confirmation before making arbitrary changes to invisible text.
2319 We expose the invisible text and ask for confirmation. Refusal or
2320 `keyboard-quit' abandons the changes, with keyboard-quit additionally
2321 reclosing the opened text.
2323 No confirmation is necessary when `inhibit-read-only' is set -- eg, allout
2324 internal functions use this feature cohesively bunch changes."
2326 (when (and (not inhibit-read-only
) (not after
))
2327 (let ((start (point))
2328 (ol-start (overlay-start ol
))
2329 (ol-end (overlay-end ol
))
2332 (while (< (point) end
)
2333 (when (allout-hidden-p)
2334 (allout-show-to-offshoot)
2335 (if (allout-hidden-p)
2336 (save-excursion (forward-char 1)
2337 (allout-show-to-offshoot)))
2339 (setq first
(point))))
2340 (goto-char (if (featurep 'xemacs
)
2341 (next-property-change (1+ (point)) nil end
)
2342 (next-char-property-change (1+ (point)) end
))))
2348 (substitute-command-keys
2349 (concat "Modify concealed text? (\"no\" just aborts,"
2350 " \\[keyboard-quit] also reconceals) "))))
2351 (progn (goto-char start
)
2352 (error "Concealed-text change refused")))
2353 (quit (allout-flag-region ol-start ol-end nil
)
2354 (allout-flag-region ol-start ol-end t
)
2355 (error "Concealed-text change abandoned, text reconcealed"))))
2356 (goto-char start
))))
2357 ;;;_ > allout-before-change-handler (beg end)
2358 (defun allout-before-change-handler (beg end
)
2359 "Protect against changes to invisible text.
2361 See `allout-overlay-interior-modification-handler' for details."
2363 (if (and (allout-mode-p) undo-in-progress
(allout-hidden-p))
2364 (allout-show-to-offshoot))
2366 ;; allout-overlay-interior-modification-handler on an overlay handles
2367 ;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
2368 (when (and (featurep 'xemacs
) (allout-mode-p))
2369 ;; process all of the pending overlays:
2372 (let ((overlay (allout-get-invisibility-overlay)))
2374 (allout-overlay-interior-modification-handler
2375 overlay nil beg end nil
))))))
2376 ;;;_ > allout-isearch-end-handler (&optional overlay)
2377 (defun allout-isearch-end-handler (&optional overlay
)
2378 "Reconcile allout outline exposure on arriving in hidden text after isearch.
2380 Optional OVERLAY parameter is for when this function is used by
2381 `isearch-open-invisible' overlay property. It is otherwise unused, so this
2382 function can also be used as an `isearch-mode-end-hook'."
2384 (if (and (allout-mode-p) (allout-hidden-p))
2385 (allout-show-to-offshoot)))
2387 ;;;_ #3 Internal Position State-Tracking -- "allout-recent-*" funcs
2388 ;; All the basic outline functions that directly do string matches to
2389 ;; evaluate heading prefix location set the variables
2390 ;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end'
2391 ;; when successful. Functions starting with `allout-recent-' all
2392 ;; use this state, providing the means to avoid redundant searches
2393 ;; for just-established data. This optimization can provide
2394 ;; significant speed improvement, but it must be employed carefully.
2395 ;;;_ = allout-recent-prefix-beginning
2396 (defvar allout-recent-prefix-beginning
0
2397 "Buffer point of the start of the last topic prefix encountered.")
2398 (make-variable-buffer-local 'allout-recent-prefix-beginning
)
2399 ;;;_ = allout-recent-prefix-end
2400 (defvar allout-recent-prefix-end
0
2401 "Buffer point of the end of the last topic prefix encountered.")
2402 (make-variable-buffer-local 'allout-recent-prefix-end
)
2403 ;;;_ = allout-recent-depth
2404 (defvar allout-recent-depth
0
2405 "Depth of the last topic prefix encountered.")
2406 (make-variable-buffer-local 'allout-recent-depth
)
2407 ;;;_ = allout-recent-end-of-subtree
2408 (defvar allout-recent-end-of-subtree
0
2409 "Buffer point last returned by `allout-end-of-current-subtree'.")
2410 (make-variable-buffer-local 'allout-recent-end-of-subtree
)
2411 ;;;_ > allout-prefix-data ()
2412 (defsubst allout-prefix-data
()
2413 "Register allout-prefix state data.
2415 For reference by `allout-recent' funcs. Return
2416 the new value of `allout-recent-prefix-beginning'."
2417 (setq allout-recent-prefix-end
(or (match-end 1) (match-end 2) (match-end 3))
2418 allout-recent-prefix-beginning
(or (match-beginning 1)
2420 (match-beginning 3))
2421 allout-recent-depth
(max 1 (- allout-recent-prefix-end
2422 allout-recent-prefix-beginning
2423 allout-header-subtraction
)))
2424 allout-recent-prefix-beginning
)
2425 ;;;_ > nullify-allout-prefix-data ()
2426 (defsubst nullify-allout-prefix-data
()
2427 "Mark allout prefix data as being uninformative."
2428 (setq allout-recent-prefix-end
(point)
2429 allout-recent-prefix-beginning
(point)
2430 allout-recent-depth
0)
2431 allout-recent-prefix-beginning
)
2432 ;;;_ > allout-recent-depth ()
2433 (defsubst allout-recent-depth
()
2434 "Return depth of last heading encountered by an outline maneuvering function.
2436 All outline functions which directly do string matches to assess
2437 headings set the variables `allout-recent-prefix-beginning' and
2438 `allout-recent-prefix-end' if successful. This function uses those settings
2439 to return the current depth."
2441 allout-recent-depth
)
2442 ;;;_ > allout-recent-prefix ()
2443 (defsubst allout-recent-prefix
()
2444 "Like `allout-recent-depth', but returns text of last encountered prefix.
2446 All outline functions which directly do string matches to assess
2447 headings set the variables `allout-recent-prefix-beginning' and
2448 `allout-recent-prefix-end' if successful. This function uses those settings
2449 to return the current prefix."
2450 (buffer-substring-no-properties allout-recent-prefix-beginning
2451 allout-recent-prefix-end
))
2452 ;;;_ > allout-recent-bullet ()
2453 (defmacro allout-recent-bullet
()
2454 "Like allout-recent-prefix, but returns bullet of last encountered prefix.
2456 All outline functions which directly do string matches to assess
2457 headings set the variables `allout-recent-prefix-beginning' and
2458 `allout-recent-prefix-end' if successful. This function uses those settings
2459 to return the current depth of the most recently matched topic."
2460 '(buffer-substring-no-properties (1- allout-recent-prefix-end
)
2461 allout-recent-prefix-end
))
2465 ;;;_ - Position Assessment
2466 ;;;_ : Location Predicates
2467 ;;;_ > allout-do-doublecheck ()
2468 (defsubst allout-do-doublecheck
()
2469 "True if current item conditions qualify for checking on topic aberrance."
2471 ;; presume integrity of outline and yanked content during yank -- necessary
2472 ;; to allow for level disparity of yank location and yanked text:
2473 (not allout-inhibit-aberrance-doublecheck
)
2474 ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck:
2475 (<= allout-recent-depth allout-doublecheck-at-and-shallower
)))
2476 ;;;_ > allout-aberrant-container-p ()
2477 (defun allout-aberrant-container-p ()
2478 "True if topic, or next sibling with children, contains them discontinuously.
2480 Discontinuous means an immediate offspring that is nested more
2481 than one level deeper than the topic.
2483 If topic has no offspring, then the next sibling with offspring will
2484 determine whether or not this one is determined to be aberrant.
2486 If true, then the allout-recent-* settings are calibrated on the
2487 offspring that qaulifies it as aberrant, ie with depth that
2488 exceeds the topic by more than one."
2490 ;; This is most clearly understood when considering standard-prefix-leader
2491 ;; low-level topics, which can all too easily match text not intended as
2492 ;; headers. For example, any line with a leading '.' or '*' and lacking a
2493 ;; following bullet qualifies without this protection. (A sequence of
2494 ;; them can occur naturally, eg a typical textual bullet list.) We
2495 ;; disqualify such low-level sequences when they are followed by a
2496 ;; discontinuously contained child, inferring that the sequences are not
2497 ;; actually connected with their prospective context.
2499 (let ((depth (allout-depth))
2500 (start-point (point))
2504 (while (and (not done
)
2505 (re-search-forward allout-line-boundary-regexp nil
0))
2506 (allout-prefix-data)
2507 (goto-char allout-recent-prefix-beginning
)
2509 ;; sibling -- continue:
2510 ((eq allout-recent-depth depth
))
2511 ;; first offspring is excessive -- aberrant:
2512 ((> allout-recent-depth
(1+ depth
))
2513 (setq done t aberrant t
))
2514 ;; next non-sibling is lower-depth -- not aberrant:
2515 (t (setq done t
))))))
2518 (goto-char start-point
)
2519 ;; recalibrate allout-recent-*
2522 ;;;_ > allout-on-current-heading-p ()
2523 (defun allout-on-current-heading-p ()
2524 "Return non-nil if point is on current visible topics' header line.
2526 Actually, returns prefix beginning point."
2528 (allout-beginning-of-current-line)
2530 (and (looking-at allout-regexp
)
2531 (allout-prefix-data)
2532 (or (not (allout-do-doublecheck))
2533 (not (allout-aberrant-container-p)))))))
2534 ;;;_ > allout-on-heading-p ()
2535 (defalias 'allout-on-heading-p
'allout-on-current-heading-p
)
2536 ;;;_ > allout-e-o-prefix-p ()
2537 (defun allout-e-o-prefix-p ()
2538 "True if point is located where current topic prefix ends, heading begins."
2539 (and (save-match-data
2540 (save-excursion (let ((inhibit-field-text-motion t
))
2541 (beginning-of-line))
2542 (looking-at allout-regexp
))
2543 (= (point) (save-excursion (allout-end-of-prefix)(point))))))
2544 ;;;_ : Location attributes
2545 ;;;_ > allout-depth ()
2546 (defun allout-depth ()
2547 "Return depth of topic most immediately containing point.
2549 Does not do doublecheck for aberrant topic header.
2551 Return zero if point is not within any topic.
2553 Like `allout-current-depth', but respects hidden as well as visible topics."
2555 (let ((start-point (point)))
2556 (if (and (allout-goto-prefix)
2557 (not (< start-point
(point))))
2560 ;; Oops, no prefix, nullify it:
2561 (nullify-allout-prefix-data)
2562 ;; ... and return 0:
2564 ;;;_ > allout-current-depth ()
2565 (defun allout-current-depth ()
2566 "Return depth of visible topic most immediately containing point.
2568 Return zero if point is not within any topic."
2570 (if (allout-back-to-current-heading)
2572 (- allout-recent-prefix-end
2573 allout-recent-prefix-beginning
2574 allout-header-subtraction
))
2576 ;;;_ > allout-get-current-prefix ()
2577 (defun allout-get-current-prefix ()
2578 "Topic prefix of the current topic."
2580 (if (allout-goto-prefix)
2581 (allout-recent-prefix))))
2582 ;;;_ > allout-get-bullet ()
2583 (defun allout-get-bullet ()
2584 "Return bullet of containing topic (visible or not)."
2586 (and (allout-goto-prefix)
2587 (allout-recent-bullet))))
2588 ;;;_ > allout-current-bullet ()
2589 (defun allout-current-bullet ()
2590 "Return bullet of current (visible) topic heading, or none if none found."
2593 (allout-back-to-current-heading)
2594 (buffer-substring-no-properties (- allout-recent-prefix-end
1)
2595 allout-recent-prefix-end
))
2596 ;; Quick and dirty provision, ostensibly for missing bullet:
2597 (args-out-of-range nil
))
2599 ;;;_ > allout-get-prefix-bullet (prefix)
2600 (defun allout-get-prefix-bullet (prefix)
2601 "Return the bullet of the header prefix string PREFIX."
2602 ;; Doesn't make sense if we're old-style prefixes, but this just
2603 ;; oughtn't be called then, so forget about it...
2604 (if (string-match allout-regexp prefix
)
2605 (substring prefix
(1- (match-end 2)) (match-end 2))))
2606 ;;;_ > allout-sibling-index (&optional depth)
2607 (defun allout-sibling-index (&optional depth
)
2608 "Item number of this prospective topic among its siblings.
2610 If optional arg DEPTH is greater than current depth, then we're
2611 opening a new level, and return 0.
2613 If less than this depth, ascend to that depth and count..."
2616 (cond ((and depth
(<= depth
0) 0))
2617 ((or (null depth
) (= depth
(allout-depth)))
2619 (while (allout-previous-sibling allout-recent-depth nil
)
2620 (setq index
(1+ index
)))
2622 ((< depth allout-recent-depth
)
2623 (allout-ascend-to-depth depth
)
2624 (allout-sibling-index))
2626 ;;;_ > allout-topic-flat-index ()
2627 (defun allout-topic-flat-index ()
2628 "Return a list indicating point's numeric section.subsect.subsubsect...
2629 Outermost is first."
2630 (let* ((depth (allout-depth))
2631 (next-index (allout-sibling-index depth
))
2633 (while (> next-index
0)
2634 (setq rev-sibls
(cons next-index rev-sibls
))
2635 (setq depth
(1- depth
))
2636 (setq next-index
(allout-sibling-index depth
)))
2640 ;;;_ - Navigation routines
2641 ;;;_ > allout-beginning-of-current-line ()
2642 (defun allout-beginning-of-current-line ()
2643 "Like beginning of line, but to visible text."
2645 ;; This combination of move-beginning-of-line and beginning-of-line is
2646 ;; deliberate, but the (beginning-of-line) may now be superfluous.
2647 (let ((inhibit-field-text-motion t
))
2648 (move-beginning-of-line 1)
2650 (while (and (not (bobp)) (or (not (bolp)) (allout-hidden-p)))
2652 (if (or (allout-hidden-p) (not (bolp)))
2653 (forward-char -
1)))))
2654 ;;;_ > allout-end-of-current-line ()
2655 (defun allout-end-of-current-line ()
2656 "Move to the end of line, past concealed text if any."
2657 ;; This is for symmetry with `allout-beginning-of-current-line' --
2658 ;; `move-end-of-line' doesn't suffer the same problem as
2659 ;; `move-beginning-of-line'.
2660 (let ((inhibit-field-text-motion t
))
2662 (while (allout-hidden-p)
2664 (if (allout-hidden-p) (forward-char 1)))))
2665 ;;;_ > allout-beginning-of-line ()
2666 (defun allout-beginning-of-line ()
2667 "Beginning-of-line with `allout-beginning-of-line-cycles' behavior, if set."
2671 (if (or (not allout-beginning-of-line-cycles
)
2672 (not (equal last-command this-command
)))
2674 (if (and (not (bolp))
2675 (allout-hidden-p (1- (point))))
2676 (goto-char (allout-previous-single-char-property-change
2677 (1- (point)) 'invisible
)))
2678 (move-beginning-of-line 1))
2680 (let ((beginning-of-body
2682 (while (and (allout-do-doublecheck)
2683 (allout-aberrant-container-p)
2684 (allout-previous-visible-heading 1)))
2685 (allout-beginning-of-current-entry)
2687 (cond ((= (current-column) 0)
2688 (goto-char beginning-of-body
))
2689 ((< (point) beginning-of-body
)
2690 (allout-beginning-of-current-line))
2691 ((= (point) beginning-of-body
)
2692 (goto-char (allout-current-bullet-pos)))
2693 (t (allout-beginning-of-current-line)
2694 (if (< (point) beginning-of-body
)
2695 ;; we were on the headline after its start:
2696 (goto-char beginning-of-body
)))))))
2697 ;;;_ > allout-end-of-line ()
2698 (defun allout-end-of-line ()
2699 "End-of-line with `allout-end-of-line-cycles' behavior, if set."
2703 (if (or (not allout-end-of-line-cycles
)
2704 (not (equal last-command this-command
)))
2705 (allout-end-of-current-line)
2706 (let ((end-of-entry (save-excursion
2707 (allout-end-of-entry)
2710 (allout-end-of-current-line))
2711 ((or (allout-hidden-p) (save-excursion
2714 (allout-back-to-current-heading)
2715 (allout-show-current-entry)
2716 (allout-show-children)
2717 (allout-end-of-entry))
2718 ((>= (point) end-of-entry
)
2719 (allout-back-to-current-heading)
2720 (allout-end-of-current-line))
2722 (if (not (allout-mark-active-p))
2724 (allout-end-of-entry))))))
2725 ;;;_ > allout-mark-active-p ()
2726 (defun allout-mark-active-p ()
2727 "True if the mark is currently or always active."
2728 ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler
2729 ;; provisions, at least in fsf emacs to prevent warnings about lack of,
2730 ;; eg, region-active-p.
2731 (cond ((boundp 'mark-active
)
2733 ((fboundp 'region-active-p
)
2736 ;;;_ > allout-next-heading ()
2737 (defsubst allout-next-heading
()
2738 "Move to the heading for the topic (possibly invisible) after this one.
2740 Returns the location of the heading, or nil if none found.
2742 We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
2745 (if (looking-at allout-regexp
)
2748 (when (re-search-forward allout-line-boundary-regexp nil
0)
2749 (allout-prefix-data)
2750 (goto-char allout-recent-prefix-beginning
)
2753 (and (allout-do-doublecheck)
2754 ;; this will set allout-recent-* on the first non-aberrant topic,
2755 ;; whether it's the current one or one that disqualifies it:
2756 (allout-aberrant-container-p))
2757 ;; this may or may not be the same as above depending on doublecheck:
2758 (goto-char allout-recent-prefix-beginning
))))
2759 ;;;_ > allout-this-or-next-heading
2760 (defun allout-this-or-next-heading ()
2761 "Position cursor on current or next heading."
2762 ;; A throwaway non-macro that is defined after allout-next-heading
2763 ;; and usable by allout-mode.
2764 (if (not (allout-goto-prefix-doublechecked)) (allout-next-heading)))
2765 ;;;_ > allout-previous-heading ()
2766 (defun allout-previous-heading ()
2767 "Move to the prior (possibly invisible) heading line.
2769 Return the location of the beginning of the heading, or nil if not found.
2771 We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
2775 (let ((start-point (point)))
2776 ;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
2777 (allout-goto-prefix)
2779 (when (or (re-search-backward allout-line-boundary-regexp nil
0)
2780 (looking-at allout-bob-regexp
))
2781 (goto-char (allout-prefix-data))
2782 (if (and (allout-do-doublecheck)
2783 (allout-aberrant-container-p))
2784 (or (allout-previous-heading)
2785 (and (goto-char start-point
)
2786 ;; recalibrate allout-recent-*:
2790 ;;;_ > allout-get-invisibility-overlay ()
2791 (defun allout-get-invisibility-overlay ()
2792 "Return the overlay at point that dictates allout invisibility."
2793 (let ((overlays (overlays-at (point)))
2795 (while (and overlays
(not got
))
2796 (if (equal (overlay-get (car overlays
) 'invisible
) 'allout
)
2797 (setq got
(car overlays
))
2800 ;;;_ > allout-back-to-visible-text ()
2801 (defun allout-back-to-visible-text ()
2802 "Move to most recent prior character that is visible, and return point."
2803 (if (allout-hidden-p)
2804 (goto-char (overlay-start (allout-get-invisibility-overlay))))
2807 ;;;_ - Subtree Charting
2808 ;;;_ " These routines either produce or assess charts, which are
2809 ;;; nested lists of the locations of topics within a subtree.
2811 ;;; Charts enable efficient subtree navigation by providing a reusable basis
2812 ;;; for elaborate, compound assessment and adjustment of a subtree.
2814 ;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
2815 (defun allout-chart-subtree (&optional levels visible orig-depth prev-depth
)
2816 "Produce a location \"chart\" of subtopics of the containing topic.
2818 Optional argument LEVELS specifies a depth limit (relative to start
2819 depth) for the chart. Null LEVELS means no limit.
2821 When optional argument VISIBLE is non-nil, the chart includes
2822 only the visible subelements of the charted subjects.
2824 The remaining optional args are for internal use by the function.
2826 Point is left at the end of the subtree.
2828 Charts are used to capture outline structure, so that outline-altering
2829 routines need assess the structure only once, and then use the chart
2830 for their elaborate manipulations.
2832 The chart entries for the topics are in reverse order, so the
2833 last topic is listed first. The entry for each topic consists of
2834 an integer indicating the point at the beginning of the topic
2835 prefix. Charts for offspring consists of a list containing,
2836 recursively, the charts for the respective subtopics. The chart
2837 for a topics' offspring precedes the entry for the topic itself.
2839 The other function parameters are for internal recursion, and should
2840 not be specified by external callers. ORIG-DEPTH is depth of topic at
2841 starting point, and PREV-DEPTH is depth of prior topic."
2843 (let ((original (not orig-depth
)) ; `orig-depth' set only in recursion.
2846 (if original
; Just starting?
2847 ; Register initial settings and
2848 ; position to first offspring:
2849 (progn (setq orig-depth
(allout-depth))
2850 (or prev-depth
(setq prev-depth
(1+ orig-depth
)))
2852 (allout-next-visible-heading 1)
2853 (allout-next-heading))))
2855 ;; Loop over the current levels' siblings. Besides being more
2856 ;; efficient than tail-recursing over a level, it avoids exceeding
2857 ;; the typically quite constrained Emacs max-lisp-eval-depth.
2859 ;; Probably would speed things up to implement loop-based stack
2860 ;; operation rather than recursing for lower levels. Bah.
2862 (while (and (not (eobp))
2863 ; Still within original topic?
2864 (< orig-depth
(setq curr-depth allout-recent-depth
))
2865 (cond ((= prev-depth curr-depth
)
2866 ;; Register this one and move on:
2867 (setq chart
(cons allout-recent-prefix-beginning chart
))
2868 (if (and levels
(<= levels
1))
2869 ;; At depth limit -- skip sublevels:
2870 (or (allout-next-sibling curr-depth
)
2871 ;; or no more siblings -- proceed to
2872 ;; next heading at lesser depth:
2873 (while (and (<= curr-depth
2874 allout-recent-depth
)
2876 (allout-next-visible-heading 1)
2877 (allout-next-heading)))))
2879 (allout-next-visible-heading 1)
2880 (allout-next-heading))))
2882 ((and (< prev-depth curr-depth
)
2885 ;; Recurse on deeper level of curr topic:
2887 (cons (allout-chart-subtree (and levels
2893 ;; ... then continue with this one.
2896 ;; ... else nil if we've ascended back to prev-depth.
2900 (if original
; We're at the last sibling on
2901 ; the original level. Position
2903 (progn (and (not (eobp)) (forward-char -
1))
2904 (and (= (preceding-char) ?
\n)
2905 (= (aref (buffer-substring (max 1 (- (point) 3))
2910 (setq allout-recent-end-of-subtree
(point))))
2912 chart
; (nreverse chart) not necessary,
2913 ; and maybe not preferable.
2915 ;;;_ > allout-chart-siblings (&optional start end)
2916 (defun allout-chart-siblings (&optional start end
)
2917 "Produce a list of locations of this and succeeding sibling topics.
2918 Effectively a top-level chart of siblings. See `allout-chart-subtree'
2919 for an explanation of charts."
2921 (when (allout-goto-prefix-doublechecked)
2922 (let ((chart (list (point))))
2923 (while (allout-next-sibling)
2924 (setq chart
(cons (point) chart
)))
2925 (if chart
(setq chart
(nreverse chart
)))))))
2926 ;;;_ > allout-chart-to-reveal (chart depth)
2927 (defun allout-chart-to-reveal (chart depth
)
2929 "Return a flat list of hidden points in subtree CHART, up to DEPTH.
2931 If DEPTH is nil, include hidden points at any depth.
2933 Note that point can be left at any of the points on chart, or at the
2937 (while (and (or (null depth
) (> depth
0))
2939 (setq here
(car chart
))
2941 (let ((further (allout-chart-to-reveal here
(if (null depth
)
2944 ;; We're on the start of a subtree -- recurse with it, if there's
2945 ;; more depth to go:
2946 (if further
(setq result
(append further result
)))
2947 (setq chart
(cdr chart
)))
2949 (if (allout-hidden-p)
2950 (setq result
(cons here result
)))
2951 (setq chart
(cdr chart
))))
2953 ;;;_ X allout-chart-spec (chart spec &optional exposing)
2954 ;; (defun allout-chart-spec (chart spec &optional exposing)
2955 ;; "Not yet (if ever) implemented.
2957 ;; Produce exposure directives given topic/subtree CHART and an exposure SPEC.
2959 ;; Exposure spec indicates the locations to be exposed and the prescribed
2960 ;; exposure status. Optional arg EXPOSING is an integer, with 0
2961 ;; indicating pending concealment, anything higher indicating depth to
2962 ;; which subtopic headers should be exposed, and negative numbers
2963 ;; indicating (negative of) the depth to which subtopic headers and
2964 ;; bodies should be exposed.
2966 ;; The produced list can have two types of entries. Bare numbers
2967 ;; indicate points in the buffer where topic headers that should be
2970 ;; - bare negative numbers indicates that the topic starting at the
2971 ;; point which is the negative of the number should be opened,
2972 ;; including their entries.
2973 ;; - bare positive values indicate that this topic header should be
2975 ;; - Lists signify the beginning and end points of regions that should
2976 ;; be flagged, and the flag to employ. (For concealment: `(\?r)', and
2979 ;; (cond ((listp spec)
2982 ;; (setq spec (cdr spec)))
2986 ;;;_ > allout-goto-prefix ()
2987 (defun allout-goto-prefix ()
2988 "Put point at beginning of immediately containing outline topic.
2990 Goes to most immediate subsequent topic if none immediately containing.
2992 Not sensitive to topic visibility.
2994 Returns the point at the beginning of the prefix, or nil if none."
2998 (while (and (not done
)
2999 (search-backward "\n" nil
1))
3001 (if (looking-at allout-regexp
)
3002 (setq done
(allout-prefix-data))
3005 (cond ((looking-at allout-regexp
)
3006 (allout-prefix-data))
3007 ((allout-next-heading))
3010 ;;;_ > allout-goto-prefix-doublechecked ()
3011 (defun allout-goto-prefix-doublechecked ()
3012 "Put point at beginning of immediately containing outline topic.
3014 Like `allout-goto-prefix', but shallow topics (according to
3015 `allout-doublecheck-at-and-shallower') are checked and
3016 disqualified for child containment discontinuity, according to
3017 `allout-aberrant-container-p'."
3018 (if (allout-goto-prefix)
3019 (if (and (allout-do-doublecheck)
3020 (allout-aberrant-container-p))
3021 (allout-previous-heading)
3024 ;;;_ > allout-end-of-prefix ()
3025 (defun allout-end-of-prefix (&optional ignore-decorations
)
3026 "Position cursor at beginning of header text.
3028 If optional IGNORE-DECORATIONS is non-nil, put just after bullet,
3029 otherwise skip white space between bullet and ensuing text."
3031 (if (not (allout-goto-prefix-doublechecked))
3033 (goto-char allout-recent-prefix-end
)
3035 (if ignore-decorations
3037 (while (looking-at "[0-9]") (forward-char 1))
3038 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))))
3039 ;; Reestablish where we are:
3040 (allout-current-depth)))
3041 ;;;_ > allout-current-bullet-pos ()
3042 (defun allout-current-bullet-pos ()
3043 "Return position of current (visible) topic's bullet."
3045 (if (not (allout-current-depth))
3047 (1- allout-recent-prefix-end
)))
3048 ;;;_ > allout-back-to-current-heading (&optional interactive)
3049 (defun allout-back-to-current-heading (&optional interactive
)
3050 "Move to heading line of current topic, or beginning if not in a topic.
3052 If interactive, we position at the end of the prefix.
3054 Return value of resulting point, unless we started outside
3055 of (before any) topics, in which case we return nil."
3059 (allout-beginning-of-current-line)
3060 (let ((bol-point (point)))
3061 (if (allout-goto-prefix-doublechecked)
3062 (if (<= (point) bol-point
)
3064 (allout-end-of-prefix)
3066 (goto-char (point-min))
3068 ;;;_ > allout-back-to-heading ()
3069 (defalias 'allout-back-to-heading
'allout-back-to-current-heading
)
3070 ;;;_ > allout-pre-next-prefix ()
3071 (defun allout-pre-next-prefix ()
3072 "Skip forward to just before the next heading line.
3074 Returns that character position."
3076 (if (allout-next-heading)
3077 (goto-char (1- allout-recent-prefix-beginning
))))
3078 ;;;_ > allout-end-of-subtree (&optional current include-trailing-blank)
3079 (defun allout-end-of-subtree (&optional current include-trailing-blank
)
3080 "Put point at the end of the last leaf in the containing topic.
3082 Optional CURRENT means put point at the end of the containing
3085 Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if
3086 any, as part of the subtree. Otherwise, that trailing blank will be
3087 excluded as delimiting whitespace between topics.
3089 Returns the value of point."
3092 (allout-back-to-current-heading)
3093 (allout-goto-prefix-doublechecked))
3094 (let ((level allout-recent-depth
))
3095 (allout-next-heading)
3096 (while (and (not (eobp))
3097 (> allout-recent-depth level
))
3098 (allout-next-heading))
3100 (allout-end-of-entry)
3102 (if (and (not include-trailing-blank
) (= ?
\n (preceding-char)))
3104 (setq allout-recent-end-of-subtree
(point))))
3105 ;;;_ > allout-end-of-current-subtree (&optional include-trailing-blank)
3106 (defun allout-end-of-current-subtree (&optional include-trailing-blank
)
3108 "Put point at end of last leaf in currently visible containing topic.
3110 Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if
3111 any, as part of the subtree. Otherwise, that trailing blank will be
3112 excluded as delimiting whitespace between topics.
3114 Returns the value of point."
3116 (allout-end-of-subtree t include-trailing-blank
))
3117 ;;;_ > allout-beginning-of-current-entry (&optional interactive)
3118 (defun allout-beginning-of-current-entry (&optional interactive
)
3119 "When not already there, position point at beginning of current topic header.
3121 If already there, move cursor to bullet for hot-spot operation.
3122 \(See `allout-mode' doc string for details of hot-spot operation.)"
3124 (let ((start-point (point)))
3125 (move-beginning-of-line 1)
3126 (if (< 0 (allout-current-depth))
3127 (goto-char allout-recent-prefix-end
)
3128 (goto-char (point-min)))
3129 (allout-end-of-prefix)
3130 (if (and interactive
3131 (= (point) start-point
))
3132 (goto-char (allout-current-bullet-pos)))))
3133 ;;;_ > allout-end-of-entry (&optional inclusive)
3134 (defun allout-end-of-entry (&optional inclusive
)
3135 "Position the point at the end of the current topics' entry.
3137 Optional INCLUSIVE means also include trailing empty line, if any. When
3138 unset, whitespace between items separates them even when the items are
3141 (allout-pre-next-prefix)
3142 (if (and (not inclusive
) (not (bobp)) (= ?
\n (preceding-char)))
3145 ;;;_ > allout-end-of-current-heading ()
3146 (defun allout-end-of-current-heading ()
3148 (allout-beginning-of-current-entry)
3149 (search-forward "\n" nil t
)
3151 (defalias 'allout-end-of-heading
'allout-end-of-current-heading
)
3152 ;;;_ > allout-get-body-text ()
3153 (defun allout-get-body-text ()
3154 "Return the unmangled body text of the topic immediately containing point."
3156 (allout-end-of-prefix)
3157 (if (not (search-forward "\n" nil t
))
3160 (let ((pre-body (point)))
3163 (allout-end-of-entry t
)
3164 (if (not (= pre-body
(point)))
3165 (buffer-substring-no-properties (1+ pre-body
) (point))))
3172 ;;;_ > allout-ascend-to-depth (depth)
3173 (defun allout-ascend-to-depth (depth)
3174 "Ascend to depth DEPTH, returning depth if successful, nil if not."
3175 (if (and (> depth
0)(<= depth
(allout-depth)))
3176 (let (last-ascended)
3177 (while (and (< depth allout-recent-depth
)
3178 (setq last-ascended
(allout-ascend))))
3179 (goto-char allout-recent-prefix-beginning
)
3180 (if (allout-called-interactively-p) (allout-end-of-prefix))
3181 (and last-ascended allout-recent-depth
))))
3182 ;;;_ > allout-ascend (&optional dont-move-if-unsuccessful)
3183 (defun allout-ascend (&optional dont-move-if-unsuccessful
)
3184 "Ascend one level, returning resulting depth if successful, nil if not.
3186 Point is left at the beginning of the level whether or not
3187 successful, unless optional DONT-MOVE-IF-UNSUCCESSFUL is set, in
3188 which case point is returned to its original starting location."
3189 (if dont-move-if-unsuccessful
3190 (setq dont-move-if-unsuccessful
(point)))
3192 (if (allout-beginning-of-level)
3193 (let ((bolevel (point))
3194 (bolevel-depth allout-recent-depth
))
3195 (allout-previous-heading)
3196 (cond ((< allout-recent-depth bolevel-depth
)
3197 allout-recent-depth
)
3198 ((= allout-recent-depth bolevel-depth
)
3199 (if dont-move-if-unsuccessful
3200 (goto-char dont-move-if-unsuccessful
))
3204 ;; some topic after very first is lower depth than first:
3208 (if (allout-called-interactively-p) (allout-end-of-prefix))))
3209 ;;;_ > allout-descend-to-depth (depth)
3210 (defun allout-descend-to-depth (depth)
3211 "Descend to depth DEPTH within current topic.
3213 Returning depth if successful, nil if not."
3214 (let ((start-point (point))
3215 (start-depth (allout-depth)))
3217 (and (> (allout-depth) 0)
3218 (not (= depth allout-recent-depth
)) ; ... not there yet
3219 (allout-next-heading) ; ... go further
3220 (< start-depth allout-recent-depth
))) ; ... still in topic
3221 (if (and (> (allout-depth) 0)
3222 (= allout-recent-depth depth
))
3224 (goto-char start-point
)
3227 ;;;_ > allout-up-current-level (arg)
3228 (defun allout-up-current-level (arg)
3229 "Move out ARG levels from current visible topic."
3231 (let ((start-point (point)))
3232 (allout-back-to-current-heading)
3233 (if (not (allout-ascend))
3234 (progn (goto-char start-point
)
3235 (error "Can't ascend past outermost level"))
3236 (if (allout-called-interactively-p) (allout-end-of-prefix))
3237 allout-recent-prefix-beginning
)))
3240 ;;;_ > allout-next-sibling (&optional depth backward)
3241 (defun allout-next-sibling (&optional depth backward
)
3242 "Like `allout-forward-current-level', but respects invisible topics.
3244 Traverse at optional DEPTH, or current depth if none specified.
3246 Go backward if optional arg BACKWARD is non-nil.
3248 Return the start point of the new topic if successful, nil otherwise."
3250 (if (if backward
(bobp) (eobp))
3252 (let ((target-depth (or depth
(allout-depth)))
3253 (start-point (point))
3254 (start-prefix-beginning allout-recent-prefix-beginning
)
3259 ;; done too few single steps to resort to the leap routine:
3262 (not (if backward
(bobp) (eobp)))
3263 ;; still traversable:
3264 (if backward
(allout-previous-heading) (allout-next-heading))
3265 ;; we're below the target depth
3266 (> (setq last-depth allout-recent-depth
) target-depth
))
3267 (setq count
(1+ count
))
3268 (if (> count
7) ; lists are commonly 7 +- 2, right?-)
3271 (or (allout-next-sibling-leap target-depth backward
)
3273 (goto-char start-point
)
3274 (if depth
(allout-depth) target-depth
)
3277 (and (> (or last-depth
(allout-depth)) 0)
3278 (= allout-recent-depth target-depth
))
3279 (not (= start-prefix-beginning
3280 allout-recent-prefix-beginning
)))
3281 allout-recent-prefix-beginning
)
3283 (goto-char start-point
)
3284 (if depth
(allout-depth) target-depth
)
3286 ;;;_ > allout-next-sibling-leap (&optional depth backward)
3287 (defun allout-next-sibling-leap (&optional depth backward
)
3288 "Like `allout-next-sibling', but by direct search for topic at depth.
3290 Traverse at optional DEPTH, or current depth if none specified.
3292 Go backward if optional arg BACKWARD is non-nil.
3294 Return the start point of the new topic if successful, nil otherwise.
3296 Costs more than regular `allout-next-sibling' for short traversals:
3298 - we have to check the prior (next, if travelling backwards)
3299 item to confirm connectivity with the prior topic, and
3300 - if confirmed, we have to reestablish the allout-recent-* settings with
3301 some extra navigation
3302 - if confirmation fails, we have to do more work to recover
3304 It is an increasingly big win when there are many intervening
3305 offspring before the next sibling, however, so
3306 `allout-next-sibling' resorts to this if it finds itself in that
3309 (if (if backward
(bobp) (eobp))
3311 (let* ((start-point (point))
3312 (target-depth (or depth
(allout-depth)))
3313 (search-whitespace-regexp nil
)
3314 (depth-biased (- target-depth
2))
3315 (expression (if (<= target-depth
1)
3316 allout-depth-one-regexp
3317 (format allout-depth-specific-regexp
3318 depth-biased depth-biased
)))
3322 (setq found
(save-match-data
3324 (re-search-backward expression nil
'to-limit
)
3326 (re-search-forward expression nil
'to-limit
))))
3327 (if (and found
(allout-aberrant-container-p))
3329 (setq done
(or found
(if backward
(bobp) (eobp)))))
3331 (progn (goto-char start-point
)
3333 ;; rationale: if any intervening items were at a lower depth, we
3334 ;; would now be on the first offspring at the target depth -- ie,
3335 ;; the preceeding item (per the search direction) must be at a
3336 ;; lesser depth. that's all we need to check.
3337 (if backward
(allout-next-heading) (allout-previous-heading))
3338 (if (< allout-recent-depth target-depth
)
3339 ;; return to start and reestablish allout-recent-*:
3341 (goto-char start-point
)
3345 ;; locate cursor and set allout-recent-*:
3346 (allout-goto-prefix))))))
3347 ;;;_ > allout-previous-sibling (&optional depth backward)
3348 (defun allout-previous-sibling (&optional depth backward
)
3349 "Like `allout-forward-current-level' backwards, respecting invisible topics.
3351 Optional DEPTH specifies depth to traverse, default current depth.
3353 Optional BACKWARD reverses direction.
3355 Return depth if successful, nil otherwise."
3356 (allout-next-sibling depth
(not backward
))
3358 ;;;_ > allout-snug-back ()
3359 (defun allout-snug-back ()
3360 "Position cursor at end of previous topic.
3362 Presumes point is at the start of a topic prefix."
3363 (if (or (bobp) (eobp))
3366 (if (or (bobp) (not (= ?
\n (preceding-char))))
3370 ;;;_ > allout-beginning-of-level ()
3371 (defun allout-beginning-of-level ()
3372 "Go back to the first sibling at this level, visible or not."
3373 (allout-end-of-level 'backward
))
3374 ;;;_ > allout-end-of-level (&optional backward)
3375 (defun allout-end-of-level (&optional backward
)
3376 "Go to the last sibling at this level, visible or not."
3378 (let ((depth (allout-depth)))
3379 (while (allout-previous-sibling depth nil
))
3380 (prog1 allout-recent-depth
3381 (if (allout-called-interactively-p) (allout-end-of-prefix)))))
3382 ;;;_ > allout-next-visible-heading (arg)
3383 (defun allout-next-visible-heading (arg)
3384 "Move to the next ARG'th visible heading line, backward if arg is negative.
3386 Move to buffer limit in indicated direction if headings are exhausted."
3389 (let* ((inhibit-field-text-motion t
)
3390 (backward (if (< arg
0) (setq arg
(* -
1 arg
))))
3391 (step (if backward -
1 1))
3396 ;; Boundary condition:
3397 (not (if backward
(bobp)(eobp)))
3398 ;; Move, skipping over all concealed lines in one fell swoop:
3399 (prog1 (condition-case nil
(or (line-move step
) t
)
3401 (allout-beginning-of-current-line))
3402 ;; Deal with apparent header line:
3404 (if (not (looking-at allout-regexp
))
3405 ;; not a header line, keep looking:
3407 (allout-prefix-data)
3408 (if (and (allout-do-doublecheck)
3409 (allout-aberrant-container-p))
3410 ;; skip this aberrant prospective header line:
3412 ;; this prospective headerline qualifies -- register:
3413 (setq got allout-recent-prefix-beginning
)
3414 ;; and break the loop:
3416 ;; Register this got, it may be the last:
3417 (if got
(setq prev got
))
3418 (setq arg
(1- arg
)))
3419 (cond (got ; Last move was to a prefix:
3420 (allout-end-of-prefix))
3421 (prev ; Last move wasn't, but prev was:
3423 (allout-end-of-prefix))
3424 ((not backward
) (end-of-line) nil
))))
3425 ;;;_ > allout-previous-visible-heading (arg)
3426 (defun allout-previous-visible-heading (arg)
3427 "Move to the previous heading line.
3429 With argument, repeats or can move forward if negative.
3430 A heading line is one that starts with a `*' (or that `allout-regexp'
3433 (prog1 (allout-next-visible-heading (- arg
))
3434 (if (allout-called-interactively-p) (allout-end-of-prefix))))
3435 ;;;_ > allout-forward-current-level (arg)
3436 (defun allout-forward-current-level (arg)
3437 "Position point at the next heading of the same level.
3439 Takes optional repeat-count, goes backward if count is negative.
3441 Returns resulting position, else nil if none found."
3443 (let ((start-depth (allout-current-depth))
3445 (backward (> 0 arg
)))
3446 (if (= 0 start-depth
)
3447 (error "No siblings, not in a topic..."))
3448 (if backward
(setq arg
(* -
1 arg
)))
3449 (allout-back-to-current-heading)
3450 (while (and (not (zerop arg
))
3452 (allout-previous-sibling)
3453 (allout-next-sibling)))
3454 (setq arg
(1- arg
)))
3455 (if (not (allout-called-interactively-p))
3457 (allout-end-of-prefix)
3458 (if (not (zerop arg
))
3459 (error "Hit %s level %d topic, traversed %d of %d requested"
3460 (if backward
"first" "last")
3462 (- (abs start-arg
) arg
)
3463 (abs start-arg
))))))
3464 ;;;_ > allout-backward-current-level (arg)
3465 (defun allout-backward-current-level (arg)
3466 "Inverse of `allout-forward-current-level'."
3468 (if (allout-called-interactively-p)
3469 (let ((current-prefix-arg (* -
1 arg
)))
3470 (call-interactively 'allout-forward-current-level
))
3471 (allout-forward-current-level (* -
1 arg
))))
3476 ;;;_ = allout-post-goto-bullet
3477 (defvar allout-post-goto-bullet nil
3478 "Outline internal var, for `allout-pre-command-business' hot-spot operation.
3480 When set, tells post-processing to reposition on topic bullet, and
3481 then unset it. Set by `allout-pre-command-business' when implementing
3482 hot-spot operation, where literal characters typed over a topic bullet
3483 are mapped to the command of the corresponding control-key on the
3484 `allout-mode-map'.")
3485 (make-variable-buffer-local 'allout-post-goto-bullet
)
3486 ;;;_ = allout-command-counter
3487 (defvar allout-command-counter
0
3488 "Counter that monotonically increases in allout-mode buffers.
3490 Set by `allout-pre-command-business', to support allout addons in
3491 coordinating with allout activity.")
3492 (make-variable-buffer-local 'allout-command-counter
)
3493 ;;;_ > allout-post-command-business ()
3494 (defun allout-post-command-business ()
3495 "Outline `post-command-hook' function.
3497 - Implement (and clear) `allout-post-goto-bullet', for hot-spot
3500 - Decrypt topic currently being edited if it was encrypted for a save."
3502 ; Apply any external change func:
3503 (if (not (allout-mode-p)) ; In allout-mode.
3506 (if (and (boundp 'allout-after-save-decrypt
)
3507 allout-after-save-decrypt
)
3508 (allout-after-saves-handler))
3510 ;; Implement allout-post-goto-bullet, if set:
3511 (if (and allout-post-goto-bullet
3512 (allout-current-bullet-pos))
3513 (progn (goto-char (allout-current-bullet-pos))
3514 (setq allout-post-goto-bullet nil
)))
3516 ;;;_ > allout-pre-command-business ()
3517 (defun allout-pre-command-business ()
3518 "Outline `pre-command-hook' function for outline buffers.
3520 Among other things, implements special behavior when the cursor is on the
3521 topic bullet character.
3523 When the cursor is on the bullet character, self-insert characters are
3524 reinterpreted as the corresponding control-character in the
3525 `allout-mode-map'. The `allout-mode' `post-command-hook' insures that
3526 the cursor which has moved as a result of such reinterpretation is
3527 positioned on the bullet character of the destination topic.
3529 The upshot is that you can get easy, single (ie, unmodified) key
3530 outline maneuvering operations by positioning the cursor on the bullet
3531 char. When in this mode you can use regular cursor-positioning
3532 command/keystrokes to relocate the cursor off of a bullet character to
3533 return to regular interpretation of self-insert characters."
3535 (if (not (allout-mode-p))
3537 ;; Increment allout-command-counter
3538 (setq allout-command-counter
(1+ allout-command-counter
))
3539 ;; Do hot-spot navigation.
3540 (if (and (eq this-command
'self-insert-command
)
3541 (eq (point)(allout-current-bullet-pos)))
3542 (allout-hotspot-key-handler))))
3543 ;;;_ > allout-hotspot-key-handler ()
3544 (defun allout-hotspot-key-handler ()
3545 "Catchall handling of key bindings in hot-spots.
3547 Translates unmodified keystrokes to corresponding allout commands, when
3548 they would qualify if prefixed with the allout-command-prefix, and sets
3549 this-command accordingly.
3551 Returns the qualifying command, if any, else nil."
3553 (let* ((modified (event-modifiers last-command-event
))
3554 (key-string (if (numberp last-command-event
)
3556 (event-basic-type last-command-event
))))
3557 (key-num (cond ((numberp last-command-event
) last-command-event
)
3558 ;; for XEmacs character type:
3559 ((and (fboundp 'characterp
)
3560 (apply 'characterp
(list last-command-event
)))
3561 (apply 'char-to-int
(list last-command-event
)))
3569 ;; exclude control chars and escape:
3572 (setq mapped-binding
3573 (or (and (assoc key-string allout-keybindings-list
)
3574 ;; translate literal membership on list:
3575 (cadr (assoc key-string allout-keybindings-list
)))
3576 ;; translate as a keybinding:
3577 (key-binding (vconcat allout-command-prefix
3579 (if (and (<= 97 key-num
) ; "a"
3580 (>= 122 key-num
)) ; "z"
3581 (- key-num
96) key-num
)))
3583 ;; Qualified as an allout command -- do hot-spot operation.
3584 (setq allout-post-goto-bullet t
)
3585 ;; accept-defaults nil, or else we get allout-item-icon-key-handler.
3586 (setq mapped-binding
(key-binding (vector key-num
))))
3588 (while (keymapp mapped-binding
)
3589 (setq mapped-binding
3590 (lookup-key mapped-binding
(vector (read-char)))))
3592 (when mapped-binding
3593 (setq this-command mapped-binding
)))))
3595 ;;;_ > allout-find-file-hook ()
3596 (defun allout-find-file-hook ()
3597 "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'.
3599 See `allout-init' for setup instructions."
3600 (if (and allout-auto-activation
3601 (not (allout-mode-p))
3605 ;;;_ - Topic Format Assessment
3606 ;;;_ > allout-solicit-alternate-bullet (depth &optional current-bullet)
3607 (defun allout-solicit-alternate-bullet (depth &optional current-bullet
)
3609 "Prompt for and return a bullet char as an alternative to the current one.
3611 Offer one suitable for current depth DEPTH as default."
3613 (let* ((default-bullet (or (and (stringp current-bullet
) current-bullet
)
3614 (allout-bullet-for-depth depth
)))
3615 (sans-escapes (regexp-sans-escapes allout-bullets-string
))
3618 (goto-char (allout-current-bullet-pos))
3619 (setq choice
(solicit-char-in-string
3620 (format "Select bullet: %s ('%s' default): "
3622 (allout-substring-no-properties default-bullet
))
3626 (if (string= choice
"") default-bullet choice
))
3628 ;;;_ > allout-distinctive-bullet (bullet)
3629 (defun allout-distinctive-bullet (bullet)
3630 "True if BULLET is one of those on `allout-distinctive-bullets-string'."
3631 (string-match (regexp-quote bullet
) allout-distinctive-bullets-string
))
3632 ;;;_ > allout-numbered-type-prefix (&optional prefix)
3633 (defun allout-numbered-type-prefix (&optional prefix
)
3634 "True if current header prefix bullet is numbered bullet."
3635 (and allout-numbered-bullet
3636 (string= allout-numbered-bullet
3638 (allout-get-prefix-bullet prefix
)
3639 (allout-get-bullet)))))
3640 ;;;_ > allout-encrypted-type-prefix (&optional prefix)
3641 (defun allout-encrypted-type-prefix (&optional prefix
)
3642 "True if current header prefix bullet is for an encrypted entry (body)."
3643 (and allout-topic-encryption-bullet
3644 (string= allout-topic-encryption-bullet
3646 (allout-get-prefix-bullet prefix
)
3647 (allout-get-bullet)))))
3648 ;;;_ > allout-bullet-for-depth (&optional depth)
3649 (defun allout-bullet-for-depth (&optional depth
)
3650 "Return outline topic bullet suited to optional DEPTH, or current depth."
3651 ;; Find bullet in plain-bullets-string modulo DEPTH.
3652 (if allout-stylish-prefixes
3653 (char-to-string (aref allout-plain-bullets-string
3654 (%
(max 0 (- depth
2))
3655 allout-plain-bullets-string-len
)))
3656 allout-primary-bullet
)
3659 ;;;_ - Topic Production
3660 ;;;_ > allout-make-topic-prefix (&optional prior-bullet
3661 (defun allout-make-topic-prefix (&optional prior-bullet
3667 ;; Depth null means use current depth, non-null means we're either
3668 ;; opening a new topic after current topic, lower or higher, or we're
3669 ;; changing level of current topic.
3670 ;; Solicit dominates specified bullet-char.
3672 "Generate a topic prefix suitable for optional arg DEPTH, or current depth.
3674 All the arguments are optional.
3676 PRIOR-BULLET indicates the bullet of the prefix being changed, or
3677 nil if none. This bullet may be preserved (other options
3678 notwithstanding) if it is on the `allout-distinctive-bullets-string',
3681 Second arg NEW indicates that a new topic is being opened after the
3682 topic at point, if non-nil. Default bullet for new topics, eg, may
3683 be set (contingent to other args) to numbered bullets if previous
3684 sibling is one. The implication otherwise is that the current topic
3685 is being adjusted -- shifted or rebulleted -- and we don't consider
3686 bullet or previous sibling.
3688 Third arg DEPTH forces the topic prefix to that depth, regardless of
3689 the current topics' depth.
3691 If SOLICIT is non-nil, then the choice of bullet is solicited from
3692 user. If it's a character, then that character is offered as the
3693 default, otherwise the one suited to the context (according to
3694 distinction or depth) is offered. (This overrides other options,
3695 including, eg, a distinctive PRIOR-BULLET.) If non-nil, then the
3696 context-specific bullet is used.
3698 Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet'
3699 is non-nil *and* soliciting was not explicitly invoked. Then
3700 NUMBER-CONTROL non-nil forces prefix to either numbered or
3701 denumbered format, depending on the value of the sixth arg, INDEX.
3703 \(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...)
3705 If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then
3706 the prefix of the topic is forced to be numbered. Non-nil
3707 NUMBER-CONTROL and nil INDEX forces non-numbered format on the
3708 bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means
3709 that the index for the numbered prefix will be derived, by counting
3710 siblings back to start of level. If INDEX is a number, then that
3711 number is used as the index for the numbered prefix (allowing, eg,
3712 sequential renumbering to not require this function counting back the
3713 index for each successive sibling)."
3715 ;; The options are ordered in likely frequence of use, most common
3716 ;; highest, least lowest. Ie, more likely to be doing prefix
3717 ;; adjustments than soliciting, and yet more than numbering.
3718 ;; Current prefix is least dominant, but most likely to be commonly
3724 (depth (or depth
(allout-depth)))
3725 (header-lead allout-header-prefix
)
3728 ;; Getting value for bullet char is practically the whole job:
3731 ; Simplest situation -- level 1:
3732 ((<= depth
1) (setq header-lead
"") allout-primary-bullet
)
3733 ; Simple, too: all asterisks:
3734 (allout-old-style-prefixes
3735 ;; Cheat -- make body the whole thing, null out header-lead and
3737 (setq body
(make-string depth
3738 (string-to-char allout-primary-bullet
)))
3739 (setq header-lead
"")
3742 ;; (Neither level 1 nor old-style, so we're space padding.
3743 ;; Sneak it in the condition of the next case, whatever it is.)
3745 ;; Solicitation overrides numbering and other cases:
3746 ((progn (setq body
(make-string (- depth
2) ?\
))
3747 ;; The actual condition:
3749 (let* ((got (allout-solicit-alternate-bullet depth solicit
)))
3750 ;; Gotta check whether we're numbering and got a numbered bullet:
3751 (setq numbering
(and allout-numbered-bullet
3752 (not (and number-control
(not index
)))
3753 (string= got allout-numbered-bullet
)))
3754 ;; Now return what we got, regardless:
3757 ;; Numbering invoked through args:
3758 ((and allout-numbered-bullet number-control
)
3759 (if (setq numbering
(not (setq denumbering
(not index
))))
3760 allout-numbered-bullet
3761 (if (and prior-bullet
3762 (not (string= allout-numbered-bullet
3765 (allout-bullet-for-depth depth
))))
3767 ;;; Neither soliciting nor controlled numbering ;;;
3768 ;;; (may be controlled denumbering, tho) ;;;
3770 ;; Check wrt previous sibling:
3771 ((and new
; only check for new prefixes
3772 (<= depth
(allout-depth))
3773 allout-numbered-bullet
; ... & numbering enabled
3775 (let ((sibling-bullet
3777 ;; Locate correct sibling:
3778 (or (>= depth
(allout-depth))
3779 (allout-ascend-to-depth depth
))
3780 (allout-get-bullet))))
3781 (if (and sibling-bullet
3782 (string= allout-numbered-bullet sibling-bullet
))
3783 (setq numbering sibling-bullet
)))))
3785 ;; Distinctive prior bullet?
3787 (allout-distinctive-bullet prior-bullet
)
3788 ;; Either non-numbered:
3789 (or (not (and allout-numbered-bullet
3790 (string= prior-bullet allout-numbered-bullet
)))
3791 ;; or numbered, and not denumbering:
3792 (setq numbering
(not denumbering
)))
3796 ;; Else, standard bullet per depth:
3797 ((allout-bullet-for-depth depth
)))))
3803 (format "%d" (cond ((and index
(numberp index
)) index
)
3804 (new (1+ (allout-sibling-index depth
)))
3805 ((allout-sibling-index))))))
3808 ;;;_ > allout-open-topic (relative-depth &optional before offer-recent-bullet)
3809 (defun allout-open-topic (relative-depth &optional before offer-recent-bullet
)
3810 "Open a new topic at depth DEPTH.
3812 New topic is situated after current one, unless optional flag BEFORE
3813 is non-nil, or unless current line is completely empty -- lacking even
3814 whitespace -- in which case open is done on the current line.
3816 When adding an offspring, it will be added immediately after the parent if
3817 the other offspring are exposed, or after the last child if the offspring
3818 are hidden. (The intervening offspring will be exposed in the latter
3821 If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
3825 - Creation of new topics is with respect to the visible topic
3826 containing the cursor, regardless of intervening concealed ones.
3828 - New headers are generally created after/before the body of a
3829 topic. However, they are created right at cursor location if the
3830 cursor is on a blank line, even if that breaks the current topic
3831 body. This is intentional, to provide a simple means for
3832 deliberately dividing topic bodies.
3834 - Double spacing of topic lists is preserved. Also, the first
3835 level two topic is created double-spaced (and so would be
3836 subsequent siblings, if that's left intact). Otherwise,
3837 single-spacing is used.
3839 - Creation of sibling or nested topics is with respect to the topic
3840 you're starting from, even when creating backwards. This way you
3841 can easily create a sibling in front of the current topic without
3842 having to go to its preceding sibling, and then open forward
3845 (allout-beginning-of-current-line)
3847 (let* ((inhibit-field-text-motion t
)
3848 (depth (+ (allout-current-depth) relative-depth
))
3849 (opening-on-blank (if (looking-at "^\$")
3850 (not (setq before nil
))))
3851 ;; bunch o vars set while computing ref-topic
3855 (ref-topic (save-excursion
3856 (cond ((< relative-depth
0)
3857 (allout-ascend-to-depth depth
))
3858 ((>= relative-depth
1) nil
)
3859 (t (allout-back-to-current-heading)))
3860 (setq ref-depth allout-recent-depth
)
3862 (if (> allout-recent-prefix-end
1)
3863 (allout-recent-bullet)
3865 (setq opening-numbered
3867 (and allout-numbered-bullet
3868 (or (<= relative-depth
0)
3869 (allout-descend-to-depth depth
))
3870 (if (allout-numbered-type-prefix)
3871 allout-numbered-bullet
))))
3877 (if (not opening-on-blank
)
3878 ; Positioning and vertical
3879 ; padding -- only if not
3882 (goto-char ref-topic
)
3883 (setq dbl-space
; Determine double space action:
3884 (or (and (<= relative-depth
0) ; not descending;
3886 ;; at b-o-b or preceded by a blank line?
3887 (or (> 0 (forward-line -
1))
3888 (looking-at "^\\s-*$")
3891 ;; succeeded by a blank line?
3892 (allout-end-of-current-subtree)
3893 (looking-at "\n\n")))
3894 (and (= ref-depth
1)
3898 ;; Don't already have following
3899 ;; vertical padding:
3900 (not (allout-pre-next-prefix)))))))
3902 ;; Position to prior heading, if inserting backwards, and not
3904 (if (and before
(>= relative-depth
0))
3905 (progn (allout-back-to-current-heading)
3906 (setq doing-beginning
(bobp))
3908 (allout-previous-heading)))
3909 (if (and before
(bobp))
3912 (if (<= relative-depth
0)
3913 ;; Not going inwards, don't snug up:
3919 (progn (end-of-line)
3920 (allout-pre-next-prefix)
3921 (while (and (= ?
\n (following-char))
3926 (if (not (looking-at "^$"))
3928 (allout-end-of-current-subtree)
3929 (if (looking-at "\n\n") (forward-char 1))))
3930 ;; Going inwards -- double-space if first offspring is
3931 ;; double-spaced, otherwise snug up.
3932 (allout-end-of-entry)
3936 (allout-beginning-of-current-line)
3939 ;; Blank lines between current header body and next
3940 ;; header -- get to last substantive (non-white-space)
3942 (progn (setq dbl-space t
)
3943 (re-search-backward "[^ \t\n]" nil t
)))
3944 (if (looking-at "\n\n")
3947 (allout-next-heading)
3948 (when (> allout-recent-depth ref-depth
)
3949 ;; This is an offspring.
3951 (looking-at "^\\s-*$")))
3952 (progn (forward-line 1)
3955 (allout-end-of-current-line))
3957 ;;(if doing-beginning (goto-char doing-beginning))
3959 ;; We insert a newline char rather than using open-line to
3960 ;; avoid rear-stickiness inheritence of read-only property.
3961 (progn (if (and (not (> depth ref-depth
))
3964 (if (and (not dbl-space
) (> depth ref-depth
))
3970 (if (and dbl-space
(not (> relative-depth
0)))
3972 (if (and (not (eobp))
3975 ;; bolp doesnt detect concealed
3976 ;; trailing newlines, compensate:
3979 (allout-hidden-p)))))
3982 (setq start
(point))
3983 (insert (concat (allout-make-topic-prefix opening-numbered t depth
)
3985 (setq end
(1+ (point)))
3987 (allout-rebullet-heading (and offer-recent-bullet ref-bullet
)
3989 (if (> relative-depth
0)
3990 (save-excursion (goto-char ref-topic
)
3991 (allout-show-children)))
3994 (run-hook-with-args 'allout-structure-added-hook start end
)
3998 ;;;_ > allout-open-subtopic (arg)
3999 (defun allout-open-subtopic (arg)
4000 "Open new topic header at deeper level than the current one.
4002 Negative universal arg means to open deeper, but place the new topic
4003 prior to the current one."
4005 (allout-open-topic 1 (> 0 arg
) (< 1 arg
)))
4006 ;;;_ > allout-open-sibtopic (arg)
4007 (defun allout-open-sibtopic (arg)
4008 "Open new topic header at same level as the current one.
4010 Positive universal arg means to use the bullet of the prior sibling.
4012 Negative universal arg means to place the new topic prior to the current
4015 (allout-open-topic 0 (> 0 arg
) (not (= 1 arg
))))
4016 ;;;_ > allout-open-supertopic (arg)
4017 (defun allout-open-supertopic (arg)
4018 "Open new topic header at shallower level than the current one.
4020 Negative universal arg means to open shallower, but place the new
4021 topic prior to the current one."
4024 (allout-open-topic -
1 (> 0 arg
) (< 1 arg
)))
4026 ;;;_ - Outline Alteration
4027 ;;;_ : Topic Modification
4028 ;;;_ = allout-former-auto-filler
4029 (defvar allout-former-auto-filler nil
4030 "Name of modal fill function being wrapped by `allout-auto-fill'.")
4031 ;;;_ > allout-auto-fill ()
4032 (defun allout-auto-fill ()
4033 "`allout-mode' autofill function.
4035 Maintains outline hanging topic indentation if
4036 `allout-use-hanging-indents' is set."
4038 (when (not allout-inhibit-auto-fill
)
4039 (let ((fill-prefix (if allout-use-hanging-indents
4040 ;; Check for topic header indentation:
4044 (if (looking-at allout-regexp
)
4045 ;; ... construct indentation to account for
4046 ;; length of topic prefix:
4047 (make-string (progn (allout-end-of-prefix)
4050 (use-auto-fill-function (or allout-outside-normal-auto-fill-function
4053 (if (or allout-former-auto-filler allout-use-hanging-indents
)
4054 (funcall use-auto-fill-function
)))))
4055 ;;;_ > allout-reindent-body (old-depth new-depth &optional number)
4056 (defun allout-reindent-body (old-depth new-depth
&optional number
)
4057 "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH.
4059 Optional arg NUMBER indicates numbering is being added, and it must
4062 Note that refill of indented paragraphs is not done."
4065 (allout-end-of-prefix)
4066 (let* ((new-margin (current-column))
4067 excess old-indent-begin old-indent-end
4068 ;; We want the column where the header-prefix text started
4069 ;; *before* the prefix was changed, so we infer it relative
4070 ;; to the new margin and the shift in depth:
4071 (old-margin (+ old-depth
(- new-margin new-depth
))))
4073 ;; Process lines up to (but excluding) next topic header:
4077 (and (re-search-forward "\n\\(\\s-*\\)"
4080 ;; Register the indent data, before we reset the
4081 ;; match data with a subsequent `looking-at':
4082 (setq old-indent-begin
(match-beginning 1)
4083 old-indent-end
(match-end 1))
4084 (not (looking-at allout-regexp
)))
4085 (if (> 0 (setq excess
(- (- old-indent-end old-indent-begin
)
4087 ;; Text starts left of old margin -- don't adjust:
4089 ;; Text was hanging at or right of old left margin --
4090 ;; reindent it, preserving its existing indentation
4091 ;; beyond the old margin:
4092 (delete-region old-indent-begin old-indent-end
)
4093 (indent-to (+ new-margin excess
(current-column))))))))))
4094 ;;;_ > allout-rebullet-current-heading (arg)
4095 (defun allout-rebullet-current-heading (arg)
4096 "Solicit new bullet for current visible heading."
4098 (let ((initial-col (current-column))
4099 (on-bullet (eq (point)(allout-current-bullet-pos)))
4101 (backwards (if (< arg
0)
4102 (setq arg
(* arg -
1)))))
4104 (save-excursion (allout-back-to-current-heading)
4105 (allout-end-of-prefix)
4106 (setq from allout-recent-prefix-beginning
4107 to allout-recent-prefix-end
)
4108 (allout-rebullet-heading t
;;; solicit
4110 nil
;;; number-control
4112 t
) ;;; do-successors
4113 (run-hook-with-args 'allout-exposure-change-hook
4118 (setq initial-col nil
) ; Override positioning back to init col
4120 (allout-next-visible-heading 1)
4121 (allout-goto-prefix-doublechecked)
4122 (allout-next-visible-heading -
1))))
4124 (cond (on-bullet (goto-char (allout-current-bullet-pos)))
4125 (initial-col (move-to-column initial-col
)))))
4126 ;;;_ > allout-rebullet-heading (&optional solicit ...)
4127 (defun allout-rebullet-heading (&optional solicit
4133 "Adjust bullet of current topic prefix.
4135 All args are optional.
4137 If SOLICIT is non-nil, then the choice of bullet is solicited from
4138 user. If it's a character, then that character is offered as the
4139 default, otherwise the one suited to the context (according to
4140 distinction or depth) is offered. If non-nil, then the
4141 context-specific bullet is just used.
4143 Second arg DEPTH forces the topic prefix to that depth, regardless
4144 of the topic's current depth.
4146 Third arg NUMBER-CONTROL can force the prefix to or away from
4147 numbered form. It has effect only if `allout-numbered-bullet' is
4148 non-nil and soliciting was not explicitly invoked (via first arg).
4149 Its effect, numbering or denumbering, then depends on the setting
4150 of the fourth arg, INDEX.
4152 If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the
4153 prefix of the topic is forced to be non-numbered. Null index and
4154 non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
4155 non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
4156 INDEX is a number, then that number is used for the numbered
4157 prefix. Non-nil and non-number means that the index for the
4158 numbered prefix will be derived by allout-make-topic-prefix.
4160 Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
4163 Cf vars `allout-stylish-prefixes', `allout-old-style-prefixes',
4164 and `allout-numbered-bullet', which all affect the behavior of
4167 (let* ((current-depth (allout-depth))
4168 (new-depth (or new-depth current-depth
))
4169 (mb allout-recent-prefix-beginning
)
4170 (me allout-recent-prefix-end
)
4171 (current-bullet (buffer-substring-no-properties (- me
1) me
))
4172 (has-annotation (get-text-property mb
'allout-was-hidden
))
4173 (new-prefix (allout-make-topic-prefix current-bullet
4180 ;; Is new one is identical to old?
4181 (if (and (= current-depth new-depth
)
4182 (string= current-bullet
4183 (substring new-prefix
(1- (length new-prefix
)))))
4187 ;; New prefix probably different from old:
4188 ; get rid of old one:
4189 (allout-unprotected (delete-region mb me
))
4191 ; Dispense with number if
4192 ; numbered-bullet prefix:
4194 (if (and allout-numbered-bullet
4195 (string= allout-numbered-bullet current-bullet
)
4196 (looking-at "[0-9]+"))
4198 (delete-region (match-beginning 0)(match-end 0)))))
4200 ;; convey 'allout-was-hidden annotation, if original had it:
4202 (put-text-property 0 (length new-prefix
) 'allout-was-hidden t
4205 ; Put in new prefix:
4206 (allout-unprotected (insert new-prefix
))
4208 ;; Reindent the body if elected, margin changed, and not encrypted body:
4209 (if (and allout-reindent-bodies
4210 (not (= new-depth current-depth
))
4211 (not (allout-encrypted-topic-p)))
4212 (allout-reindent-body current-depth new-depth
))
4214 ;; Recursively rectify successive siblings of orig topic if
4215 ;; caller elected for it:
4218 (while (allout-next-sibling new-depth nil
)
4220 (cond ((numberp index
) (1+ index
))
4221 ((not number-control
) (allout-sibling-index))))
4222 (if (allout-numbered-type-prefix)
4223 (allout-rebullet-heading nil
;;; solicit
4224 new-depth
;;; new-depth
4225 number-control
;;; number-control
4227 nil
))))) ;;;(dont!)do-successors
4228 ) ; (if (and (= current-depth new-depth)...))
4229 ) ; let* ((current-depth (allout-depth))...)
4231 ;;;_ > allout-rebullet-topic (arg)
4232 (defun allout-rebullet-topic (arg &optional sans-offspring
)
4233 "Rebullet the visible topic containing point and all contained subtopics.
4235 Descends into invisible as well as visible topics, however.
4237 When optional SANS-OFFSPRING is non-nil, subtopics are not
4238 shifted. (Shifting a topic outwards without shifting its
4239 offspring is disallowed, since this would create a \"containment
4240 discontinuity\", where the depth difference between a topic and
4241 its immediate offspring is greater than one.)
4243 With repeat count, shift topic depth by that amount."
4245 (let ((start-col (current-column)))
4248 (cond ((null arg
) (setq arg
0))
4249 ((listp arg
) (setq arg
(car arg
))))
4250 ;; Fill the user in, in case we're shifting a big topic:
4251 (if (not (zerop arg
)) (message "Shifting..."))
4252 (allout-back-to-current-heading)
4253 (if (<= (+ allout-recent-depth arg
) 0)
4254 (error "Attempt to shift topic below level 1"))
4255 (allout-rebullet-topic-grunt arg nil nil nil nil sans-offspring
)
4256 (if (not (zerop arg
)) (message "Shifting... done.")))
4257 (move-to-column (max 0 (+ start-col arg
)))))
4258 ;;;_ > allout-rebullet-topic-grunt (&optional relative-depth ...)
4259 (defun allout-rebullet-topic-grunt (&optional relative-depth
4265 "Like `allout-rebullet-topic', but on nearest containing topic
4268 See `allout-rebullet-heading' for rebulleting behavior.
4270 All arguments are optional.
4272 First arg RELATIVE-DEPTH means to shift the depth of the entire
4275 Several subsequent args are for internal recursive use by the function
4276 itself: STARTING-DEPTH, STARTING-POINT, and INDEX.
4278 Finally, if optional SANS-OFFSPRING is non-nil then the offspring
4279 are not shifted. (Shifting a topic outwards without shifting
4280 its offspring is disallowed, since this would create a
4281 \"containment discontinuity\", where the depth difference between
4282 a topic and its immediate offspring is greater than one.)"
4284 ;; XXX the recursion here is peculiar, and in general the routine may
4285 ;; need simplification with refactoring.
4287 (if (and sans-offspring
4289 (< relative-depth
0))
4290 (error (concat "Attempt to shift topic outwards without offspring,"
4291 " would cause containment discontinuity.")))
4293 (let* ((relative-depth (or relative-depth
0))
4294 (new-depth (allout-depth))
4295 (starting-depth (or starting-depth new-depth
))
4296 (on-starting-call (null starting-point
))
4298 ;; Leave index null on starting call, so rebullet-heading
4299 ;; calculates it at what might be new depth:
4300 (and (or (zerop relative-depth
)
4301 (not on-starting-call
))
4302 (allout-sibling-index))))
4303 (starting-index index
)
4304 (moving-outwards (< 0 relative-depth
))
4305 (starting-point (or starting-point
(point)))
4306 (local-point (point)))
4308 ;; Sanity check for excessive promotion done only on starting call:
4309 (and on-starting-call
4311 (> 0 (+ starting-depth relative-depth
))
4312 (error "Attempt to shift topic out beyond level 1"))
4314 (cond ((= starting-depth new-depth
)
4315 ;; We're at depth to work on this one.
4317 ;; When shifting out we work on the children before working on
4318 ;; the parent to avoid interim `allout-aberrant-container-p'
4319 ;; aberrancy, and vice-versa when shifting in:
4320 (if (>= relative-depth
0)
4321 (allout-rebullet-heading nil
4322 (+ starting-depth relative-depth
)
4325 nil
)) ;;; do-successors
4326 (when (not sans-offspring
)
4327 ;; ... and work on subsequent ones which are at greater depth:
4329 (allout-next-heading)
4330 (while (and (not (eobp))
4331 (< starting-depth
(allout-depth)))
4332 (setq index
(1+ index
))
4333 (allout-rebullet-topic-grunt relative-depth
4337 (when (< relative-depth
0)
4339 (goto-char local-point
)
4340 (allout-rebullet-heading nil
;;; solicit
4341 (+ starting-depth relative-depth
)
4344 nil
)))) ;;; do-successors
4346 ((< starting-depth new-depth
)
4347 ;; Rare case -- subtopic more than one level deeper than parent.
4348 ;; Treat this one at an even deeper level:
4349 (allout-rebullet-topic-grunt relative-depth
4355 (if on-starting-call
4357 ;; Rectify numbering of former siblings of the adjusted topic,
4358 ;; if topic has changed depth
4359 (if (or do-successors
4360 (and (not (zerop relative-depth
))
4361 (or (= allout-recent-depth starting-depth
)
4362 (= allout-recent-depth
(+ starting-depth
4364 (allout-rebullet-heading nil nil nil nil t
))
4365 ;; Now rectify numbering of new siblings of the adjusted topic,
4366 ;; if depth has been changed:
4367 (progn (goto-char starting-point
)
4368 (if (not (zerop relative-depth
))
4369 (allout-rebullet-heading nil nil nil nil t
)))))
4372 ;;;_ > allout-renumber-to-depth (&optional depth)
4373 (defun allout-renumber-to-depth (&optional depth
)
4374 "Renumber siblings at current depth.
4376 Affects superior topics if optional arg DEPTH is less than current depth.
4378 Returns final depth."
4380 ;; Proceed by level, processing subsequent siblings on each,
4381 ;; ascending until we get shallower than the start depth:
4383 (let ((ascender (allout-depth))
4385 (while (and (not (eobp))
4387 (>= allout-recent-depth depth
)
4388 (>= ascender depth
))
4389 ; Skip over all topics at
4390 ; lesser depths, which can not
4391 ; have been disturbed:
4392 (while (and (not (setq was-eobp
(eobp)))
4393 (> allout-recent-depth ascender
))
4394 (allout-next-heading))
4395 ; Prime ascender for ascension:
4396 (setq ascender
(1- allout-recent-depth
))
4397 (if (>= allout-recent-depth depth
)
4398 (allout-rebullet-heading nil
;;; solicit
4400 nil
;;; number-control
4402 t
)) ;;; do-successors
4403 (if was-eobp
(goto-char (point-max)))))
4404 allout-recent-depth
)
4405 ;;;_ > allout-number-siblings (&optional denumber)
4406 (defun allout-number-siblings (&optional denumber
)
4407 "Assign numbered topic prefix to this topic and its siblings.
4409 With universal argument, denumber -- assign default bullet to this
4410 topic and its siblings.
4412 With repeated universal argument (`^U^U'), solicit bullet for each
4413 rebulleting each topic at this level."
4418 (allout-back-to-current-heading)
4419 (allout-beginning-of-level)
4420 (let ((depth allout-recent-depth
)
4421 (index (if (not denumber
) 1))
4422 (use-bullet (equal '(16) denumber
))
4425 (allout-rebullet-heading use-bullet
;;; solicit
4427 t
;;; number-control
4429 nil
) ;;; do-successors
4430 (if index
(setq index
(1+ index
)))
4431 (setq more
(allout-next-sibling depth nil
))))))
4432 ;;;_ > allout-shift-in (arg)
4433 (defun allout-shift-in (arg)
4434 "Increase depth of current heading and any items collapsed within it.
4436 With a negative argument, the item is shifted out using
4437 `allout-shift-out', instead.
4439 With an argument greater than one, shift-in the item but not its
4440 offspring, making the item into a sibling of its former children,
4441 and a child of sibling that formerly preceeded it.
4443 You are not allowed to shift the first offspring of a topic
4444 inwards, because that would yield a \"containment
4445 discontinuity\", where the depth difference between a topic and
4446 its immediate offspring is greater than one. The first topic in
4447 the file can be adjusted to any positive depth, however."
4451 (allout-shift-out (* arg -
1))
4452 ;; refuse to create a containment discontinuity:
4454 (allout-back-to-current-heading)
4456 (let* ((current-depth allout-recent-depth
)
4457 (start-point (point))
4458 (predecessor-depth (progn
4460 (allout-goto-prefix-doublechecked)
4461 (if (< (point) start-point
)
4464 (if (and (> predecessor-depth
0)
4465 (> (1+ current-depth
)
4466 (1+ predecessor-depth
)))
4467 (error (concat "Disallowed shift deeper than"
4468 " containing topic's children."))
4469 (allout-back-to-current-heading)
4470 (if (< allout-recent-depth
(1+ current-depth
))
4471 (allout-show-children))))))
4472 (let ((where (point)))
4473 (allout-rebullet-topic 1 (and (> arg
1) 'sans-offspring
))
4474 (run-hook-with-args 'allout-structure-shifted-hook arg where
))))
4475 ;;;_ > allout-shift-out (arg)
4476 (defun allout-shift-out (arg)
4477 "Decrease depth of current heading and any topics collapsed within it.
4478 This will make the item a sibling of its former container.
4480 With a negative argument, the item is shifted in using
4481 `allout-shift-in', instead.
4483 With an argument greater than one, shift-out the item's offspring
4484 but not the item itself, making the former children siblings of
4487 With an argument greater than 1, the item's offspring are shifted
4488 out without shifting the item. This will make the immediate
4489 subtopics into siblings of the item."
4492 (allout-shift-in (* arg -
1))
4493 ;; Get proper exposure in this area:
4494 (save-excursion (if (allout-ascend)
4495 (allout-show-children)))
4496 ;; Show collapsed children if there's a successor which will become
4498 (if (and (allout-current-topic-collapsed-p)
4499 (save-excursion (allout-next-sibling)))
4500 (allout-show-children))
4501 (let ((where (and (allout-depth) allout-recent-prefix-beginning
)))
4504 ;; Shift the offspring but not the topic:
4505 (let ((children-chart (allout-chart-subtree 1)))
4506 (if (listp (car children-chart
))
4508 (setq children-chart
(allout-flatten children-chart
)))
4510 (dolist (child-point children-chart
)
4511 (goto-char child-point
)
4512 (allout-shift-out 1))))
4513 (allout-rebullet-topic (* arg -
1))))
4514 (run-hook-with-args 'allout-structure-shifted-hook
(* arg -
1) where
))))
4515 ;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
4516 ;;;_ > allout-kill-line (&optional arg)
4517 (defun allout-kill-line (&optional arg
)
4518 "Kill line, adjusting subsequent lines suitably for outline mode."
4522 (if (or (not (allout-mode-p))
4524 (not (save-match-data (looking-at allout-regexp
))))
4525 ;; Just do a regular kill:
4527 ;; Ah, have to watch out for adjustments:
4528 (let* ((beg (point))
4530 (beg-hidden (allout-hidden-p))
4531 (end-hidden (save-excursion (allout-end-of-current-line)
4534 (depth (allout-depth)))
4536 (allout-annotate-hidden beg end
)
4537 (if (and (not beg-hidden
) (not end-hidden
))
4538 (allout-unprotected (kill-line arg
))
4540 (allout-deannotate-hidden beg end
)
4542 (if allout-numbered-bullet
4543 (save-excursion ; Renumber subsequent topics if needed:
4544 (if (not (save-match-data (looking-at allout-regexp
)))
4545 (allout-next-heading))
4546 (allout-renumber-to-depth depth
)))
4547 (run-hook-with-args 'allout-structure-deleted-hook depth
(point)))))
4548 ;;;_ > allout-copy-line-as-kill ()
4549 (defun allout-copy-line-as-kill ()
4550 "Like allout-kill-topic, but save to kill ring instead of deleting."
4552 (let ((buffer-read-only t
))
4555 (buffer-read-only nil
))))
4556 ;;;_ > allout-kill-topic ()
4557 (defun allout-kill-topic ()
4558 "Kill topic together with subtopics.
4560 Trailing whitespace is killed with a topic if that whitespace:
4562 - would separate the topic from a subsequent sibling
4563 - would separate the topic from the end of buffer
4564 - would not be added to whitespace already separating the topic from the
4567 Topic exposure is marked with text-properties, to be used by
4568 `allout-yank-processing' for exposure recovery."
4571 (let* ((inhibit-field-text-motion t
)
4572 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
4574 (depth allout-recent-depth
))
4575 (allout-end-of-current-subtree)
4576 (if (and (/= (current-column) 0) (not (eobp)))
4579 (if (and (save-match-data (looking-at "\n"))
4581 (or (not (allout-next-heading))
4582 (= depth allout-recent-depth
)))
4583 (and (> (- beg
(point-min)) 3)
4584 (string= (buffer-substring (- beg
2) beg
) "\n\n"))))
4587 (allout-annotate-hidden beg
(setq end
(point)))
4589 (allout-unprotected (kill-region beg end
))
4590 (if buffer-read-only
4591 ;; eg, during copy-as-kill.
4592 (allout-deannotate-hidden beg end
)))
4595 (allout-renumber-to-depth depth
))
4596 (run-hook-with-args 'allout-structure-deleted-hook depth
(point))))
4597 ;;;_ > allout-copy-topic-as-kill ()
4598 (defun allout-copy-topic-as-kill ()
4599 "Like `allout-kill-topic', but save to kill ring instead of deleting."
4601 (let ((buffer-read-only t
))
4604 (buffer-read-only (message "Topic copied...")))))
4605 ;;;_ > allout-annotate-hidden (begin end)
4606 (defun allout-annotate-hidden (begin end
)
4607 "Qualify text with properties to indicate exposure status."
4609 (let ((was-modified (buffer-modified-p))
4610 (buffer-read-only nil
))
4611 (allout-deannotate-hidden begin end
)
4614 (let (done next prev overlay
)
4616 ;; at or advance to start of next hidden region:
4617 (if (not (allout-hidden-p))
4620 (allout-next-single-char-property-change (point)
4623 (if (or (not next
) (eq prev next
))
4624 ;; still not at start of hidden area -- must not be any left.
4628 (if (not (allout-hidden-p))
4629 ;; still not at start of hidden area.
4631 (setq overlay
(allout-get-invisibility-overlay))
4632 (setq next
(overlay-end overlay
)
4634 ;; advance to end of this hidden area:
4638 (let ((buffer-undo-list t
))
4639 (put-text-property (overlay-start overlay
) next
4640 'allout-was-hidden t
)))))))))
4641 (set-buffer-modified-p was-modified
)))
4642 ;;;_ > allout-deannotate-hidden (begin end)
4643 (defun allout-deannotate-hidden (begin end
)
4644 "Remove allout hidden-text annotation between BEGIN and END."
4647 (let ((inhibit-read-only t
)
4648 (buffer-undo-list t
))
4649 ;(remove-text-properties begin end '(allout-was-hidden t))
4651 ;;;_ > allout-hide-by-annotation (begin end)
4652 (defun allout-hide-by-annotation (begin end
)
4653 "Translate text properties indicating exposure status into actual exposure."
4656 (let ((was-modified (buffer-modified-p))
4659 ;; at or advance to start of next annotation:
4660 (if (not (get-text-property (point) 'allout-was-hidden
))
4661 (setq next
(allout-next-single-char-property-change
4662 (point) 'allout-was-hidden nil end
)))
4663 (if (or (not next
) (eq prev next
))
4664 ;; no more or not advancing -- must not be any left.
4668 (if (not (get-text-property (point) 'allout-was-hidden
))
4669 ;; still not at start of annotation.
4671 ;; advance to just after end of this annotation:
4672 (setq next
(allout-next-single-char-property-change
4673 (point) 'allout-was-hidden nil end
))
4674 (overlay-put (make-overlay prev next nil
'front-advance
)
4675 'category
'allout-exposure-category
)
4676 (allout-deannotate-hidden prev next
)
4678 (if next
(goto-char next
)))))
4679 (set-buffer-modified-p was-modified
))))
4680 ;;;_ > allout-yank-processing ()
4681 (defun allout-yank-processing (&optional arg
)
4683 "Incidental allout-specific business to be done just after text yanks.
4685 Does depth adjustment of yanked topics, when:
4687 1 the stuff being yanked starts with a valid outline header prefix, and
4688 2 it is being yanked at the end of a line which consists of only a valid
4691 Also, adjusts numbering of subsequent siblings when appropriate.
4693 Depth adjustment alters the depth of all the topics being yanked
4694 the amount it takes to make the first topic have the depth of the
4695 header into which it's being yanked.
4697 The point is left in front of yanked, adjusted topics, rather than
4698 at the end (and vice-versa with the mark). Non-adjusted yanks,
4699 however, are left exactly like normal, non-allout-specific yanks."
4702 ; Get to beginning, leaving
4703 ; region around subject:
4704 (if (< (allout-mark-marker t
) (point))
4705 (exchange-point-and-mark))
4707 (let* ((subj-beg (point))
4709 (subj-end (allout-mark-marker t
))
4710 ;; 'resituate' if yanking an entire topic into topic header:
4711 (resituate (and (let ((allout-inhibit-aberrance-doublecheck t
))
4712 (allout-e-o-prefix-p))
4713 (looking-at allout-regexp
)
4714 (allout-prefix-data)))
4715 ;; `rectify-numbering' if resituating (where several topics may
4716 ;; be resituating) or yanking a topic into a topic slot (bol):
4717 (rectify-numbering (or resituate
4718 (and into-bol
(looking-at allout-regexp
)))))
4720 ;; Yanking a topic into the start of a topic -- reconcile to fit:
4721 (let* ((inhibit-field-text-motion t
)
4722 (prefix-len (if (not (match-end 1))
4724 (- (match-end 1) subj-beg
)))
4725 (subj-depth allout-recent-depth
)
4726 (prefix-bullet (allout-recent-bullet))
4728 ;; Nil if adjustment unnecessary, otherwise depth to which
4729 ;; adjustment should be made:
4731 (and (goto-char subj-end
)
4733 (goto-char subj-beg
)
4734 (and (looking-at allout-regexp
)
4737 (not (= (point) subj-beg
)))
4738 (looking-at allout-regexp
)
4739 (allout-prefix-data))
4740 allout-recent-depth
)))
4742 (setq rectify-numbering allout-numbered-bullet
)
4744 ; Do the adjustment:
4747 (narrow-to-region subj-beg subj-end
)
4748 ; Trim off excessive blank
4749 ; line at end, if any:
4750 (goto-char (point-max))
4751 (if (looking-at "^$")
4752 (allout-unprotected (delete-char -
1)))
4753 ; Work backwards, with each
4755 ; successively excluding the
4756 ; last processed topic from
4757 ; the narrow region:
4759 (allout-back-to-current-heading)
4760 ; go as high as we can in each bunch:
4761 (while (allout-ascend t
))
4764 (allout-rebullet-topic-grunt (- adjust-to-depth
4767 (if (setq more
(not (bobp)))
4770 (narrow-to-region subj-beg
(point))))))
4771 ;; Preserve new bullet if it's a distinctive one, otherwise
4773 (if (string-match (regexp-quote prefix-bullet
)
4774 allout-distinctive-bullets-string
)
4775 ; Delete from bullet of old to
4776 ; before bullet of new:
4780 (delete-region (point) subj-beg
))
4781 (set-marker (allout-mark-marker t
) subj-end
)
4782 (goto-char subj-beg
)
4783 (allout-end-of-prefix))
4784 ; Delete base subj prefix,
4788 (delete-region (point) (+ (point)
4792 ; and delete residual subj
4793 ; prefix digits and space:
4794 (while (looking-at "[0-9]") (delete-char 1))
4795 (if (looking-at " ")
4796 (delete-char 1))))))
4797 (exchange-point-and-mark))))
4798 (if rectify-numbering
4801 ; Give some preliminary feedback:
4802 (message "... reconciling numbers")
4803 ; ... and renumber, in case necessary:
4804 (goto-char subj-beg
)
4805 (if (allout-goto-prefix-doublechecked)
4807 (allout-rebullet-heading nil
;;; solicit
4808 (allout-depth) ;;; depth
4809 nil
;;; number-control
4813 (if (or into-bol resituate
)
4814 (allout-hide-by-annotation (point) (allout-mark-marker t
))
4815 (allout-deannotate-hidden (allout-mark-marker t
) (point)))
4817 (exchange-point-and-mark))
4818 (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end
))))
4819 ;;;_ > allout-yank (&optional arg)
4820 (defun allout-yank (&optional arg
)
4821 "`allout-mode' yank, with depth and numbering adjustment of yanked topics.
4823 Non-topic yanks work no differently than normal yanks.
4825 If a topic is being yanked into a bare topic prefix, the depth of the
4826 yanked topic is adjusted to the depth of the topic prefix.
4828 1 we're yanking in an `allout-mode' buffer
4829 2 the stuff being yanked starts with a valid outline header prefix, and
4830 3 it is being yanked at the end of a line which consists of only a valid
4833 If these conditions hold then the depth of the yanked topics are all
4834 adjusted the amount it takes to make the first one at the depth of the
4835 header into which it's being yanked.
4837 The point is left in front of yanked, adjusted topics, rather than
4838 at the end (and vice-versa with the mark). Non-adjusted yanks,
4839 however, (ones that don't qualify for adjustment) are handled
4840 exactly like normal yanks.
4842 Numbering of yanked topics, and the successive siblings at the depth
4843 into which they're being yanked, is adjusted.
4845 `allout-yank-pop' works with `allout-yank' just like normal `yank-pop'
4846 works with normal `yank' in non-outline buffers."
4849 (setq this-command
'yank
)
4853 (allout-yank-processing)))
4854 ;;;_ > allout-yank-pop (&optional arg)
4855 (defun allout-yank-pop (&optional arg
)
4856 "Yank-pop like `allout-yank' when popping to bare outline prefixes.
4858 Adapts level of popped topics to level of fresh prefix.
4860 Note -- prefix changes to distinctive bullets will stick, if followed
4861 by pops to non-distinctive yanks. Bug..."
4864 (setq this-command
'yank
)
4867 (allout-yank-processing)))
4869 ;;;_ - Specialty bullet functions
4870 ;;;_ : File Cross references
4871 ;;;_ > allout-resolve-xref ()
4872 (defun allout-resolve-xref ()
4873 "Pop to file associated with current heading, if it has an xref bullet.
4875 \(Works according to setting of `allout-file-xref-bullet')."
4877 (if (not allout-file-xref-bullet
)
4879 "Outline cross references disabled -- no `allout-file-xref-bullet'")
4880 (if (not (string= (allout-current-bullet) allout-file-xref-bullet
))
4881 (error "Current heading lacks cross-reference bullet `%s'"
4882 allout-file-xref-bullet
)
4883 (let ((inhibit-field-text-motion t
)
4887 (let* ((text-start allout-recent-prefix-end
)
4888 (heading-end (point-at-eol)))
4889 (goto-char text-start
)
4891 (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t
)
4892 (buffer-substring (match-beginning 1)
4894 (setq file-name
(expand-file-name file-name
))
4895 (if (or (file-exists-p file-name
)
4896 (if (file-writable-p file-name
)
4897 (y-or-n-p (format "%s not there, create one? "
4899 (error "%s not found and can't be created" file-name
)))
4900 (condition-case failure
4901 (find-file-other-window file-name
)
4903 (error "%s not found" file-name
))
4909 ;;;_ #6 Exposure Control
4912 ;;;_ > allout-flag-region (from to flag)
4913 (defun allout-flag-region (from to flag
)
4914 "Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
4916 Exposure-change hook `allout-exposure-change-hook' is run with the same
4917 arguments as this function, after the exposure changes are made. (The old
4918 `allout-view-change-hook' is being deprecated, and eventually will not be
4921 ;; We use outline invisibility spec.
4922 (remove-overlays from to
'category
'allout-exposure-category
)
4924 (let ((o (make-overlay from to nil
'front-advance
)))
4925 (overlay-put o
'category
'allout-exposure-category
)
4926 (when (featurep 'xemacs
)
4927 (let ((props (symbol-plist 'allout-exposure-category
)))
4930 ;; as of 2008-02-27, xemacs lacks modification-hooks
4931 (overlay-put o
(pop props
) (pop props
))
4933 (run-hooks 'allout-view-change-hook
)
4934 (run-hook-with-args 'allout-exposure-change-hook from to flag
))
4935 ;;;_ > allout-flag-current-subtree (flag)
4936 (defun allout-flag-current-subtree (flag)
4937 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
4940 (allout-back-to-current-heading)
4941 (let ((inhibit-field-text-motion t
))
4943 (allout-flag-region (point)
4944 ;; Exposing must not leave trailing blanks hidden,
4945 ;; but can leave them exposed when hiding, so we
4946 ;; can use flag's inverse as the
4947 ;; include-trailing-blank cue:
4948 (allout-end-of-current-subtree (not flag
))
4951 ;;;_ - Topic-specific
4952 ;;;_ > allout-show-entry ()
4953 (defun allout-show-entry ()
4954 "Like `allout-show-current-entry', but reveals entries in hidden topics.
4956 This is a way to give restricted peek at a concealed locality without the
4957 expense of exposing its context, but can leave the outline with aberrant
4958 exposure. `allout-show-offshoot' should be used after the peek to rectify
4964 (allout-goto-prefix-doublechecked)
4965 (setq beg
(if (allout-hidden-p) (1- (point)) (point)))
4966 (setq end
(allout-pre-next-prefix))
4967 (allout-flag-region beg end nil
)
4969 ;;;_ > allout-show-children (&optional level strict)
4970 (defun allout-show-children (&optional level strict
)
4972 "If point is visible, show all direct subheadings of this heading.
4974 Otherwise, do `allout-show-to-offshoot', and then show subheadings.
4976 Optional LEVEL specifies how many levels below the current level
4977 should be shown, or all levels if t. Default is 1.
4979 Optional STRICT means don't resort to -show-to-offshoot, no matter
4980 what. This is basically so -show-to-offshoot, which is called by
4981 this function, can employ the pure offspring-revealing capabilities of
4984 Returns point at end of subtree that was opened, if any. (May get a
4985 point of non-opened subtree?)"
4988 (let ((start-point (point)))
4989 (if (and (not strict
)
4992 (progn (allout-show-to-offshoot) ; Point's concealed, open to
4994 ;; Then recurse, but with "strict" set so we don't
4995 ;; infinite regress:
4996 (allout-show-children level t
))
4999 (allout-beginning-of-current-line)
5002 ;; translate the level spec for this routine to the ones
5003 ;; used by -chart-subtree and -chart-to-reveal:
5004 (chart-level (cond ((not level
) 1)
5007 (chart (allout-chart-subtree chart-level
))
5008 (to-reveal (or (allout-chart-to-reveal chart chart-level
)
5009 ;; interactive, show discontinuous children:
5011 (allout-called-interactively-p)
5013 (allout-back-to-current-heading)
5014 (setq depth
(allout-current-depth))
5015 (and (allout-next-heading)
5016 (> allout-recent-depth
5019 "Discontinuous offspring; use `%s %s'%s."
5020 (substitute-command-keys
5021 "\\[universal-argument]")
5022 (substitute-command-keys
5023 "\\[allout-shift-out]")
5024 " to elevate them.")
5025 (allout-chart-to-reveal
5026 chart
(- allout-recent-depth depth
))))))
5027 (goto-char start-point
)
5028 (when (and strict
(allout-hidden-p))
5029 ;; Concealed root would already have been taken care of,
5030 ;; unless strict was set.
5031 (allout-flag-region (point) (allout-snug-back) nil
)
5032 (when allout-show-bodies
5033 (goto-char (car to-reveal
))
5034 (allout-show-current-entry)))
5036 (goto-char (car to-reveal
))
5037 (allout-flag-region (save-excursion (allout-snug-back) (point))
5038 (progn (search-forward "\n" nil t
)
5041 (when allout-show-bodies
5042 (goto-char (car to-reveal
))
5043 (allout-show-current-entry))
5044 (setq to-reveal
(cdr to-reveal
)))))))
5045 ;; Compensate for `save-excursion's maintenance of point
5046 ;; within invisible text:
5047 (goto-char start-point
)))
5048 ;;;_ > allout-show-to-offshoot ()
5049 (defun allout-show-to-offshoot ()
5050 "Like `allout-show-entry', but reveals all concealed ancestors, as well.
5052 Useful for coherently exposing to a random point in a hidden region."
5055 (let ((inhibit-field-text-motion t
)
5057 (orig-pref (allout-goto-prefix-doublechecked))
5060 (while (or (> bag-it
1) (allout-hidden-p))
5061 (while (allout-hidden-p)
5062 (move-beginning-of-line 1)
5063 (if (allout-hidden-p) (forward-char -
1)))
5064 (if (= last-at
(setq last-at
(point)))
5065 ;; Oops, we're not making any progress! Show the current topic
5066 ;; completely, and try one more time here, if we haven't already.
5067 (progn (beginning-of-line)
5068 (allout-show-current-subtree)
5070 (setq bag-it
(1+ bag-it
))
5072 (error "allout-show-to-offshoot: %s"
5073 "Stumped by aberrant nesting.")))
5074 (if (> bag-it
0) (setq bag-it
0))
5075 (allout-show-children)
5076 (goto-char orig-pref
)))
5077 (goto-char orig-pt
)))
5078 (if (allout-hidden-p)
5079 (allout-show-entry)))
5080 ;;;_ > allout-hide-current-entry ()
5081 (defun allout-hide-current-entry ()
5082 "Hide the body directly following this heading."
5084 (allout-back-to-current-heading)
5086 (let ((inhibit-field-text-motion t
))
5088 (allout-flag-region (point)
5089 (progn (allout-end-of-entry) (point))
5091 ;;;_ > allout-show-current-entry (&optional arg)
5092 (defun allout-show-current-entry (&optional arg
)
5093 "Show body following current heading, or hide entry with universal argument."
5097 (allout-hide-current-entry)
5098 (save-excursion (allout-show-to-offshoot))
5100 (allout-flag-region (point)
5101 (progn (allout-end-of-entry t
) (point))
5104 ;;;_ > allout-show-current-subtree (&optional arg)
5105 (defun allout-show-current-subtree (&optional arg
)
5106 "Show everything within the current topic.
5107 With a repeat-count, expose this topic and its siblings."
5110 (if (<= (allout-current-depth) 0)
5111 ;; Outside any topics -- try to get to the first:
5112 (if (not (allout-next-heading))
5114 ;; got to first, outermost topic -- set to expose it and siblings:
5115 (message "Above outermost topic -- exposing all.")
5116 (allout-flag-region (point-min)(point-max) nil
))
5117 (allout-beginning-of-current-line)
5119 (allout-flag-current-subtree nil
)
5120 (allout-beginning-of-level)
5121 (allout-expose-topic '(* :))))))
5122 ;;;_ > allout-current-topic-collapsed-p (&optional include-single-liners)
5123 (defun allout-current-topic-collapsed-p (&optional include-single-liners
)
5124 "True if the currently visible containing topic is already collapsed.
5126 Single line topics intrinsically can be considered as being both
5127 collapsed and uncollapsed. If optional INCLUDE-SINGLE-LINERS is
5128 true, then single-line topics are considered to be collapsed. By
5129 default, they are treated as being uncollapsed."
5133 ;; Is the topic all on one line (allowing for trailing blank line)?
5134 (>= (progn (allout-back-to-current-heading)
5135 (move-end-of-line 1)
5137 (allout-end-of-current-subtree (not (looking-at "\n\n"))))
5139 (or include-single-liners
5140 (progn (backward-char 1) (allout-hidden-p)))))))
5141 ;;;_ > allout-hide-current-subtree (&optional just-close)
5142 (defun allout-hide-current-subtree (&optional just-close
)
5143 "Close the current topic, or containing topic if this one is already closed.
5145 If this topic is closed and it's a top level topic, close this topic
5148 If optional arg JUST-CLOSE is non-nil, do not close the parent or
5149 siblings, even if the target topic is already closed."
5152 (let* ((from (point))
5153 (sibs-msg "Top-level topic already closed -- closing siblings...")
5154 (current-exposed (not (allout-current-topic-collapsed-p t
))))
5155 (cond (current-exposed (allout-flag-current-subtree t
))
5157 ((allout-ascend) (allout-hide-current-subtree))
5160 (allout-goto-prefix-doublechecked)
5161 (allout-expose-topic '(0 :))
5162 (message (concat sibs-msg
" Done."))))
5164 ;;;_ > allout-toggle-current-subtree-exposure
5165 (defun allout-toggle-current-subtree-exposure ()
5166 "Show or hide the current subtree depending on its current state."
5167 ;; thanks to tassilo for suggesting this.
5170 (allout-back-to-heading)
5171 (if (allout-hidden-p (point-at-eol))
5172 (allout-show-current-subtree)
5173 (allout-hide-current-subtree))))
5174 ;;;_ > allout-show-current-branches ()
5175 (defun allout-show-current-branches ()
5176 "Show all subheadings of this heading, but not their bodies."
5178 (let ((inhibit-field-text-motion t
))
5179 (beginning-of-line))
5180 (allout-show-children t
))
5181 ;;;_ > allout-hide-current-leaves ()
5182 (defun allout-hide-current-leaves ()
5183 "Hide the bodies of the current topic and all its offspring."
5185 (allout-back-to-current-heading)
5186 (allout-hide-region-body (point) (progn (allout-end-of-current-subtree)
5189 ;;;_ - Region and beyond
5190 ;;;_ > allout-show-all ()
5191 (defun allout-show-all ()
5192 "Show all of the text in the buffer."
5194 (message "Exposing entire buffer...")
5195 (allout-flag-region (point-min) (point-max) nil
)
5196 (message "Exposing entire buffer... Done."))
5197 ;;;_ > allout-hide-bodies ()
5198 (defun allout-hide-bodies ()
5199 "Hide all of buffer except headings."
5201 (allout-hide-region-body (point-min) (point-max)))
5202 ;;;_ > allout-hide-region-body (start end)
5203 (defun allout-hide-region-body (start end
)
5204 "Hide all body lines in the region, but not headings."
5208 (narrow-to-region start end
)
5209 (goto-char (point-min))
5210 (let ((inhibit-field-text-motion t
))
5213 (allout-flag-region (point) (allout-end-of-entry) t
)
5216 (if (looking-at "\n\n")
5219 ;;;_ > allout-expose-topic (spec)
5220 (defun allout-expose-topic (spec)
5221 "Apply exposure specs to successive outline topic items.
5223 Use the more convenient frontend, `allout-new-exposure', if you don't
5224 need evaluation of the arguments, or even better, the `allout-layout'
5225 variable-keyed mode-activation/auto-exposure feature of allout outline
5226 mode. See the respective documentation strings for more details.
5228 Cursor is left at start position.
5230 SPEC is either a number or a list.
5232 Successive specs on a list are applied to successive sibling topics.
5234 A simple spec (either a number, one of a few symbols, or the null
5235 list) dictates the exposure for the corresponding topic.
5237 Non-null lists recursively designate exposure specs for respective
5238 subtopics of the current topic.
5240 The `:' repeat spec is used to specify exposure for any number of
5241 successive siblings, up to the trailing ones for which there are
5242 explicit specs following the `:'.
5244 Simple (numeric and null-list) specs are interpreted as follows:
5246 Numbers indicate the relative depth to open the corresponding topic.
5247 - negative numbers force the topic to be closed before opening to the
5248 absolute value of the number, so all siblings are open only to
5250 - positive numbers open to the relative depth indicated by the
5251 number, but do not force already opened subtopics to be closed.
5252 - 0 means to close topic -- hide all offspring.
5254 apply prior element to all siblings at current level, *up to*
5255 those siblings that would be covered by specs following the `:'
5256 on the list. Ie, apply to all topics at level but the last
5257 ones. (Only first of multiple colons at same level is
5258 respected -- subsequent ones are discarded.)
5259 * - completely opens the topic, including bodies.
5260 + - shows all the sub headers, but not the bodies
5261 - - exposes the body of the corresponding topic.
5264 \(allout-expose-topic '(-1 : 0))
5265 Close this and all following topics at current level, exposing
5266 only their immediate children, but close down the last topic
5267 at this current level completely.
5268 \(allout-expose-topic '(-1 () : 1 0))
5269 Close current topic so only the immediate subtopics are shown;
5270 show the children in the second to last topic, and completely
5272 \(allout-expose-topic '(-2 : -1 *))
5273 Expose children and grandchildren of all topics at current
5274 level except the last two; expose children of the second to
5275 last and completely open the last one."
5277 (interactive "xExposure spec: ")
5278 (if (not (listp spec
))
5280 (let ((depth (allout-depth))
5285 (setq prev-elem curr-elem
5286 curr-elem
(car spec
)
5288 (cond ; Do current element:
5289 ((null curr-elem
) nil
)
5290 ((symbolp curr-elem
)
5291 (cond ((eq curr-elem
'*) (allout-show-current-subtree)
5292 (if (> allout-recent-end-of-subtree max-pos
)
5293 (setq max-pos allout-recent-end-of-subtree
)))
5295 (if (not (allout-hidden-p))
5296 (save-excursion (allout-hide-current-subtree t
)))
5297 (allout-show-current-branches)
5298 (if (> allout-recent-end-of-subtree max-pos
)
5299 (setq max-pos allout-recent-end-of-subtree
)))
5300 ((eq curr-elem
'-
) (allout-show-current-entry))
5303 ;; Expand the `repeat' spec to an explicit version,
5304 ;; w.r.t. remaining siblings:
5305 (let ((residue ; = # of sibs not covered by remaining spec
5306 ;; Dang, could be nice to make use of the chart, sigh:
5307 (- (length (allout-chart-siblings))
5310 ;; Some residue -- cover it with prev-elem:
5311 (setq spec
(append (make-list residue prev-elem
)
5313 ((numberp curr-elem
)
5314 (if (and (>= 0 curr-elem
) (not (allout-hidden-p)))
5315 (save-excursion (allout-hide-current-subtree t
)
5318 (if (> allout-recent-end-of-subtree max-pos
)
5320 allout-recent-end-of-subtree
)))))
5321 (if (> (abs curr-elem
) 0)
5322 (progn (allout-show-children (abs curr-elem
))
5323 (if (> allout-recent-end-of-subtree max-pos
)
5324 (setq max-pos allout-recent-end-of-subtree
)))))
5326 (if (allout-descend-to-depth (1+ depth
))
5327 (let ((got (allout-expose-topic curr-elem
)))
5328 (if (and got
(> got max-pos
)) (setq max-pos got
))))))
5329 (cond (stay (setq stay nil
))
5330 ((listp (car spec
)) nil
)
5331 ((> max-pos
(point))
5332 ;; Capitalize on max-pos state to get us nearer next sibling:
5333 (progn (goto-char (min (point-max) max-pos
))
5334 (allout-next-heading)))
5335 ((allout-next-sibling depth
))))
5337 ;;;_ > allout-old-expose-topic (spec &rest followers)
5338 (defun allout-old-expose-topic (spec &rest followers
)
5340 "Deprecated. Use `allout-expose-topic' (with different schema
5343 Dictate wholesale exposure scheme for current topic, according to SPEC.
5345 SPEC is either a number or a list. Optional successive args
5346 dictate exposure for subsequent siblings of current topic.
5348 A simple spec (either a number, a special symbol, or the null list)
5349 dictates the overall exposure for a topic. Non null lists are
5350 composite specs whose first element dictates the overall exposure for
5351 a topic, with the subsequent elements in the list interpreted as specs
5352 that dictate the exposure for the successive offspring of the topic.
5354 Simple (numeric and null-list) specs are interpreted as follows:
5356 - Numbers indicate the relative depth to open the corresponding topic:
5357 - negative numbers force the topic to be close before opening to the
5358 absolute value of the number.
5359 - positive numbers just open to the relative depth indicated by the number.
5361 - `*' completely opens the topic, including bodies.
5362 - `+' shows all the sub headers, but not the bodies
5363 - `-' exposes the body and immediate offspring of the corresponding topic.
5365 If the spec is a list, the first element must be a number, which
5366 dictates the exposure depth of the topic as a whole. Subsequent
5367 elements of the list are nested SPECs, dictating the specific exposure
5368 for the corresponding offspring of the topic.
5370 Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
5372 (interactive "xExposure spec: ")
5373 (let ((inhibit-field-text-motion t
)
5374 (depth (allout-current-depth))
5376 (cond ((null spec
) nil
)
5378 (if (eq spec
'*) (allout-show-current-subtree))
5379 (if (eq spec
'+) (allout-show-current-branches))
5380 (if (eq spec
'-
) (allout-show-current-entry)))
5383 (save-excursion (allout-hide-current-subtree t
)
5385 (if (or (not max-pos
)
5386 (> (point) max-pos
))
5387 (setq max-pos
(point)))
5389 (setq spec
(* -
1 spec
)))))
5391 (allout-show-children spec
)))
5393 ;(let ((got (allout-old-expose-topic (car spec))))
5394 ; (if (and got (or (not max-pos) (> got max-pos)))
5395 ; (setq max-pos got)))
5396 (let ((new-depth (+ (allout-current-depth) 1))
5398 (setq max-pos
(allout-old-expose-topic (car spec
)))
5399 (setq spec
(cdr spec
))
5401 (allout-descend-to-depth new-depth
)
5402 (not (allout-hidden-p)))
5403 (progn (setq got
(apply 'allout-old-expose-topic spec
))
5404 (if (and got
(or (not max-pos
) (> got max-pos
)))
5405 (setq max-pos got
)))))))
5406 (while (and followers
5407 (progn (if (and max-pos
(< (point) max-pos
))
5408 (progn (goto-char max-pos
)
5409 (setq max-pos nil
)))
5411 (allout-next-sibling depth
)))
5412 (allout-old-expose-topic (car followers
))
5413 (setq followers
(cdr followers
)))
5415 ;;;_ > allout-new-exposure '()
5416 (defmacro allout-new-exposure
(&rest spec
)
5417 "Literal frontend for `allout-expose-topic', doesn't evaluate arguments.
5418 Some arguments that would need to be quoted in `allout-expose-topic'
5419 need not be quoted in `allout-new-exposure'.
5421 Cursor is left at start position.
5423 Use this instead of obsolete `allout-exposure'.
5426 \(allout-new-exposure (-1 () () () 1) 0)
5427 Close current topic at current level so only the immediate
5428 subtopics are shown, except also show the children of the
5429 third subtopic; and close the next topic at the current level.
5430 \(allout-new-exposure : -1 0)
5431 Close all topics at current level to expose only their
5432 immediate children, except for the last topic at the current
5433 level, in which even its immediate children are hidden.
5434 \(allout-new-exposure -2 : -1 *)
5435 Expose children and grandchildren of first topic at current
5436 level, and expose children of subsequent topics at current
5437 level *except* for the last, which should be opened completely."
5438 (list 'save-excursion
5439 '(if (not (or (allout-goto-prefix-doublechecked)
5440 (allout-next-heading)))
5441 (error "allout-new-exposure: Can't find any outline topics"))
5442 (list 'allout-expose-topic
(list 'quote spec
))))
5444 ;;;_ #7 Systematic outline presentation -- copying, printing, flattening
5446 ;;;_ - Mapping and processing of topics
5447 ;;;_ ( See also Subtree Charting, in Navigation code.)
5448 ;;;_ > allout-stringify-flat-index (flat-index)
5449 (defun allout-stringify-flat-index (flat-index &optional context
)
5450 "Convert list representing section/subsection/... to document string.
5452 Optional arg CONTEXT indicates interior levels to include."
5456 (context-depth (or (and context
2) 1)))
5457 ;; Take care of the explicit context:
5458 (while (> context-depth
0)
5459 (setq numstr
(int-to-string (car flat-index
))
5460 flat-index
(cdr flat-index
)
5461 result
(if flat-index
5462 (cons delim
(cons numstr result
))
5463 (cons numstr result
))
5464 context-depth
(if flat-index
(1- context-depth
) 0)))
5466 ;; Take care of the indentation:
5473 (1+ (truncate (if (zerop (car flat-index
))
5475 (log10 (car flat-index
)))))
5478 (setq flat-index
(cdr flat-index
)))
5479 ;; Dispose of single extra delim:
5480 (setq result
(cdr result
))))
5481 (apply 'concat result
)))
5482 ;;;_ > allout-stringify-flat-index-plain (flat-index)
5483 (defun allout-stringify-flat-index-plain (flat-index)
5484 "Convert list representing section/subsection/... to document string."
5488 (setq result
(cons (int-to-string (car flat-index
))
5490 (cons delim result
))))
5491 (setq flat-index
(cdr flat-index
)))
5492 (apply 'concat result
)))
5493 ;;;_ > allout-stringify-flat-index-indented (flat-index)
5494 (defun allout-stringify-flat-index-indented (flat-index)
5495 "Convert list representing section/subsection/... to document string."
5499 ;; Take care of the explicit context:
5500 (setq numstr
(int-to-string (car flat-index
))
5501 flat-index
(cdr flat-index
)
5502 result
(if flat-index
5503 (cons delim
(cons numstr result
))
5504 (cons numstr result
)))
5506 ;; Take care of the indentation:
5513 (1+ (truncate (if (zerop (car flat-index
))
5515 (log10 (car flat-index
)))))
5518 (setq flat-index
(cdr flat-index
)))
5519 ;; Dispose of single extra delim:
5520 (setq result
(cdr result
))))
5521 (apply 'concat result
)))
5522 ;;;_ > allout-listify-exposed (&optional start end format)
5523 (defun allout-listify-exposed (&optional start end format
)
5525 "Produce a list representing exposed topics in current region.
5527 This list can then be used by `allout-process-exposed' to manipulate
5530 Optional START and END indicate bounds of region.
5532 Optional arg, FORMAT, designates an alternate presentation form for
5535 list -- Present prefix as numeric section.subsection..., starting with
5536 section indicated by the list, innermost nesting first.
5537 `indent' (symbol) -- Convert header prefixes to all white space,
5538 except for distinctive bullets.
5540 The elements of the list produced are lists that represents a topic
5541 header and body. The elements of that list are:
5543 - a number representing the depth of the topic,
5544 - a string representing the header-prefix, including trailing whitespace and
5546 - a string representing the bullet character,
5547 - and a series of strings, each containing one line of the exposed
5548 portion of the topic entry."
5553 ((inhibit-field-text-motion t
)
5555 strings prefix result depth new-depth out gone-out bullet beg
5560 ;; Goto initial topic, and register preceeding stuff, if any:
5561 (if (> (allout-goto-prefix-doublechecked) start
)
5562 ;; First topic follows beginning point -- register preliminary stuff:
5563 (setq result
(list (list 0 "" nil
5564 (buffer-substring start
(1- (point)))))))
5565 (while (and (not done
)
5566 (not (eobp)) ; Loop until we've covered the region.
5567 (not (> (point) end
)))
5568 (setq depth allout-recent-depth
; Current topics depth,
5569 bullet
(allout-recent-bullet) ; ... bullet,
5570 prefix
(allout-recent-prefix)
5571 beg
(progn (allout-end-of-prefix t
) (point))) ; and beginning.
5572 (setq done
; The boundary for the current topic:
5573 (not (allout-next-visible-heading 1)))
5574 (setq new-depth allout-recent-depth
)
5576 out
(< new-depth depth
))
5581 (while (> next
(point)) ; Get all the exposed text in
5583 (cons (buffer-substring
5585 ;To hidden text or end of line:
5588 (allout-back-to-visible-text)))
5590 (when (< (point) next
) ; Resume from after hid text, if any.
5592 (beginning-of-line))
5594 ;; Accumulate list for this topic:
5595 (setq strings
(nreverse strings
))
5599 (let ((special (if (string-match
5600 (regexp-quote bullet
)
5601 allout-distinctive-bullets-string
)
5603 (cond ((listp format
)
5605 (if allout-abbreviate-flattened-numbering
5606 (allout-stringify-flat-index format
5608 (allout-stringify-flat-index-plain
5612 ((eq format
'indent
)
5615 (concat (make-string (1+ depth
) ?
)
5616 (substring prefix -
1))
5619 (make-string depth ?
)
5621 (t (error "allout-listify-exposed: %s %s"
5622 "invalid format" format
))))
5623 (list depth prefix strings
))
5625 ;; Reasses format, if any:
5626 (if (and format
(listp format
))
5627 (cond ((= new-depth depth
)
5628 (setq format
(cons (1+ (car format
))
5630 ((> new-depth depth
) ; descending -- assume by 1:
5631 (setq format
(cons 1 format
)))
5634 (while (< new-depth depth
)
5635 (setq format
(cdr format
))
5636 (setq depth
(1- depth
)))
5637 ; And increment the current one:
5639 (cons (1+ (or (car format
)
5642 ;; Put the list with first at front, to last at back:
5643 (nreverse result
))))
5644 ;;;_ > allout-region-active-p ()
5645 (defmacro allout-region-active-p
()
5646 (cond ((fboundp 'use-region-p
) '(use-region-p))
5647 ((fboundp 'region-active-p
) '(region-active-p))
5649 ;;_ > allout-process-exposed (&optional func from to frombuf
5651 (defun allout-process-exposed (&optional func from to frombuf tobuf
5653 "Map function on exposed parts of current topic; results to another buffer.
5655 All args are options; default values itemized below.
5657 Apply FUNCTION to exposed portions FROM position TO position in buffer
5658 FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
5659 alternate presentation form:
5661 `flat' -- Present prefix as numeric section.subsection..., starting with
5662 section indicated by the START-NUM, innermost nesting first.
5663 X`flat-indented' -- Prefix is like `flat' for first topic at each
5664 X level, but subsequent topics have only leaf topic
5665 X number, padded with blanks to line up with first.
5666 `indent' (symbol) -- Convert header prefixes to all white space,
5667 except for distinctive bullets.
5670 FUNCTION: `allout-insert-listified'
5671 FROM: region start, if region active, else start of buffer
5672 TO: region end, if region active, else end of buffer
5673 FROMBUF: current buffer
5674 TOBUF: buffer name derived: \"*current-buffer-name exposed*\"
5677 ; Resolve arguments,
5678 ; defaulting if necessary:
5679 (if (not func
) (setq func
'allout-insert-listified
))
5680 (if (not (and from to
))
5681 (if (allout-region-active-p)
5682 (setq from
(region-beginning) to
(region-end))
5683 (setq from
(point-min) to
(point-max))))
5685 (if (not (bufferp frombuf
))
5686 ;; Specified but not a buffer -- get it:
5687 (let ((got (get-buffer frombuf
)))
5689 (error (concat "allout-process-exposed: source buffer "
5692 (setq frombuf got
))))
5693 ;; not specified -- default it:
5694 (setq frombuf
(current-buffer)))
5696 (if (not (bufferp tobuf
))
5697 (setq tobuf
(get-buffer-create tobuf
)))
5698 ;; not specified -- default it:
5699 (setq tobuf
(concat "*" (buffer-name frombuf
) " exposed*")))
5704 (progn (set-buffer frombuf
)
5705 (allout-listify-exposed from to format
))))
5707 (mapc func listified
)
5708 (pop-to-buffer tobuf
)))
5711 ;;;_ > allout-insert-listified (listified)
5712 (defun allout-insert-listified (listified)
5713 "Insert contents of listified outline portion in current buffer.
5715 LISTIFIED is a list representing each topic header and body:
5717 \`(depth prefix text)'
5719 or \`(depth prefix text bullet-plus)'
5721 If `bullet-plus' is specified, it is inserted just after the entire prefix."
5722 (setq listified
(cdr listified
))
5723 (let ((prefix (prog1
5725 (setq listified
(cdr listified
))))
5728 (setq listified
(cdr listified
))))
5729 (bullet-plus (car listified
)))
5731 (if bullet-plus
(insert (concat " " bullet-plus
)))
5734 (if (setq text
(cdr text
))
5737 ;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format)
5738 (defun allout-copy-exposed-to-buffer (&optional arg tobuf format
)
5739 "Duplicate exposed portions of current outline to another buffer.
5741 Other buffer has current buffers name with \" exposed\" appended to it.
5743 With repeat count, copy the exposed parts of only the current topic.
5745 Optional second arg TOBUF is target buffer name.
5747 Optional third arg FORMAT, if non-nil, symbolically designates an
5748 alternate presentation format for the outline:
5750 `flat' - Convert topic header prefixes to numeric
5751 section.subsection... identifiers.
5752 `indent' - Convert header prefixes to all white space, except for
5753 distinctive bullets.
5754 `indent-flat' - The best of both - only the first of each level has
5755 the full path, the rest have only the section number
5756 of the leaf, preceded by the right amount of indentation."
5760 (setq tobuf
(get-buffer-create (concat "*" (buffer-name) " exposed*"))))
5761 (let* ((start-pt (point))
5762 (beg (if arg
(allout-back-to-current-heading) (point-min)))
5763 (end (if arg
(allout-end-of-current-subtree) (point-max)))
5764 (buf (current-buffer))
5766 (if (eq format
'flat
)
5767 (setq format
(if arg
(save-excursion
5769 (allout-topic-flat-index))
5771 (with-current-buffer tobuf
(erase-buffer))
5772 (allout-process-exposed 'allout-insert-listified
5778 (goto-char (point-min))
5780 (goto-char start-pt
)))
5781 ;;;_ > allout-flatten-exposed-to-buffer (&optional arg tobuf)
5782 (defun allout-flatten-exposed-to-buffer (&optional arg tobuf
)
5783 "Present numeric outline of outline's exposed portions in another buffer.
5785 The resulting outline is not compatible with outline mode -- use
5786 `allout-copy-exposed-to-buffer' if you want that.
5788 Use `allout-indented-exposed-to-buffer' for indented presentation.
5790 With repeat count, copy the exposed portions of only current topic.
5792 Other buffer has current buffer's name with \" exposed\" appended to
5793 it, unless optional second arg TOBUF is specified, in which case it is
5796 (allout-copy-exposed-to-buffer arg tobuf
'flat
))
5797 ;;;_ > allout-indented-exposed-to-buffer (&optional arg tobuf)
5798 (defun allout-indented-exposed-to-buffer (&optional arg tobuf
)
5799 "Present indented outline of outline's exposed portions in another buffer.
5801 The resulting outline is not compatible with outline mode -- use
5802 `allout-copy-exposed-to-buffer' if you want that.
5804 Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation.
5806 With repeat count, copy the exposed portions of only current topic.
5808 Other buffer has current buffer's name with \" exposed\" appended to
5809 it, unless optional second arg TOBUF is specified, in which case it is
5812 (allout-copy-exposed-to-buffer arg tobuf
'indent
))
5814 ;;;_ - LaTeX formatting
5815 ;;;_ > allout-latex-verb-quote (string &optional flow)
5816 (defun allout-latex-verb-quote (string &optional flow
)
5817 "Return copy of STRING for literal reproduction across LaTeX processing.
5818 Expresses the original characters (including carriage returns) of the
5819 string across LaTeX processing."
5820 (mapconcat (function
5822 (cond ((memq char
'(?
\\ ?$ ?% ?
# ?
& ?
{ ?
} ?_ ?^ ?- ?
*))
5823 (concat "\\char" (number-to-string char
) "{}"))
5824 ((= char ?
\n) "\\\\")
5825 (t (char-to-string char
)))))
5828 ;;;_ > allout-latex-verbatim-quote-curr-line ()
5829 (defun allout-latex-verbatim-quote-curr-line ()
5830 "Express line for exact (literal) representation across LaTeX processing.
5832 Adjust line contents so it is unaltered (from the original line)
5833 across LaTeX processing, within the context of a `verbatim'
5834 environment. Leaves point at the end of the line."
5835 (let ((inhibit-field-text-motion t
))
5838 (end (point-at-eol)))
5840 (while (re-search-forward "\\\\"
5841 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
5842 end
; bounded by end-of-line
5843 1) ; no matches, move to end & return nil
5844 (goto-char (match-beginning 2))
5847 (goto-char (1+ (match-end 2))))))))
5848 ;;;_ > allout-insert-latex-header (buffer)
5849 (defun allout-insert-latex-header (buffer)
5850 "Insert initial LaTeX commands at point in BUFFER."
5851 ;; Much of this is being derived from the stuff in appendix of E in
5852 ;; the TeXBook, pg 421.
5854 (let ((doc-style (format "\n\\documentstyle{%s}\n"
5856 (page-numbering (if allout-number-pages
5857 "\\pagestyle{empty}\n"
5859 (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n"
5860 allout-title-style
))
5861 (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n"
5862 allout-label-style
))
5863 (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n"
5864 allout-head-line-style
))
5865 (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n"
5866 allout-body-line-style
))
5867 (setlength (format "%s%s%s%s"
5868 "\\newlength{\\stepsize}\n"
5869 "\\setlength{\\stepsize}{"
5872 (oneheadline (format "%s%s%s%s%s%s%s"
5873 "\\newcommand{\\OneHeadLine}[3]{%\n"
5875 "\\hspace*{#2\\stepsize}%\n"
5876 "\\labelcmd{#1}\\hspace*{.2cm}"
5877 "\\headlinecmd{#3}\\\\["
5880 (onebodyline (format "%s%s%s%s%s%s"
5881 "\\newcommand{\\OneBodyLine}[2]{%\n"
5883 "\\hspace*{#1\\stepsize}%\n"
5884 "\\bodylinecmd{#2}\\\\["
5887 (begindoc "\\begin{document}\n\\begin{center}\n")
5888 (title (format "%s%s%s%s"
5890 (allout-latex-verb-quote (if allout-title
5893 (error "<unnamed buffer>"))
5896 "\\end{center}\n\n"))
5897 (hsize "\\hsize = 7.5 true in\n")
5898 (hoffset "\\hoffset = -1.5 true in\n")
5899 (vspace "\\vspace{.1cm}\n\n"))
5900 (insert (concat doc-style
5915 ;;;_ > allout-insert-latex-trailer (buffer)
5916 (defun allout-insert-latex-trailer (buffer)
5917 "Insert concluding LaTeX commands at point in BUFFER."
5919 (insert "\n\\end{document}\n"))
5920 ;;;_ > allout-latexify-one-item (depth prefix bullet text)
5921 (defun allout-latexify-one-item (depth prefix bullet text
)
5922 "Insert LaTeX commands for formatting one outline item.
5924 Args are the topics numeric DEPTH, the header PREFIX lead string, the
5925 BULLET string, and a list of TEXT strings for the body."
5926 (let* ((head-line (if text
(car text
)))
5927 (body-lines (cdr text
))
5931 (insert (concat "\\OneHeadLine{\\verb\1 "
5932 (allout-latex-verb-quote bullet
)
5937 (allout-latex-verb-quote head-line
)
5940 (if (not body-lines
)
5942 ;;(insert "\\beginlines\n")
5943 (insert "\\begin{verbatim}\n")
5945 (setq curr-line
(car body-lines
))
5946 (if (and (not body-content
)
5947 (not (string-match "^\\s-*$" curr-line
)))
5948 (setq body-content t
))
5949 ; Mangle any occurrences of
5950 ; "\end{verbatim}" in text,
5952 (if (and body-content
5953 (setq bop
(string-match "\\end{verbatim}" curr-line
)))
5954 (setq curr-line
(concat (substring curr-line
0 bop
)
5956 (substring curr-line bop
))))
5957 ;;(insert "|" (car body-lines) "|")
5959 (allout-latex-verbatim-quote-curr-line)
5961 (setq body-lines
(cdr body-lines
)))
5963 (setq body-content nil
)
5967 ;;(insert "\\endlines\n")
5968 (insert "\\end{verbatim}\n")
5970 ;;;_ > allout-latexify-exposed (arg &optional tobuf)
5971 (defun allout-latexify-exposed (arg &optional tobuf
)
5972 "Format current topics exposed portions to TOBUF for LaTeX processing.
5973 TOBUF defaults to a buffer named the same as the current buffer, but
5974 with \"*\" prepended and \" latex-formed*\" appended.
5976 With repeat count, copy the exposed portions of entire buffer."
5981 (get-buffer-create (concat "*" (buffer-name) " latexified*"))))
5982 (let* ((start-pt (point))
5983 (beg (if arg
(point-min) (allout-back-to-current-heading)))
5984 (end (if arg
(point-max) (allout-end-of-current-subtree)))
5985 (buf (current-buffer)))
5988 (allout-insert-latex-header tobuf
)
5989 (goto-char (point-max))
5990 (allout-process-exposed 'allout-latexify-one-item
5995 (goto-char (point-max))
5996 (allout-insert-latex-trailer tobuf
)
5997 (goto-char (point-min))
5999 (goto-char start-pt
)))
6002 ;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-pass)
6003 (defun allout-toggle-current-subtree-encryption (&optional fetch-pass
)
6004 "Encrypt clear or decrypt encoded text of visibly-containing topic's contents.
6006 Optional FETCH-PASS universal argument provokes key-pair encryption with
6007 single universal argument. With doubled universal argument (value = 16),
6008 it forces prompting for the passphrase regardless of availability from the
6009 passphrase cache. With no universal argument, the appropriate passphrase
6010 is obtained from the cache, if available, else from the user.
6012 Only GnuPG encryption is supported.
6014 \*NOTE WELL* that the encrypted text must be ascii-armored. For gnupg
6015 encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
6017 Both symmetric-key and key-pair encryption is implemented. Symmetric is
6018 the default, use a single (x4) universal argument for keypair mode.
6020 Encrypted topic's bullet is set to a `~' to signal that the contents of the
6021 topic (body and subtopics, but not heading) is pending encryption or
6022 encrypted. `*' asterisk immediately after the bullet signals that the body
6023 is encrypted, its' absence means the topic is meant to be encrypted but is
6024 not. When a file with topics pending encryption is saved, topics pending
6025 encryption are encrypted. See allout-encrypt-unencrypted-on-saves for
6026 auto-encryption specifics.
6028 \*NOTE WELL* that automatic encryption that happens during saves will
6029 default to symmetric encryption -- you must deliberately (re)encrypt key-pair
6030 encrypted topics if you want them to continue to use the key-pair cipher.
6032 Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
6033 encrypted. If you want to encrypt the contents of a top-level topic, use
6034 \\[allout-shift-in] to increase its depth.
6038 The encryption passphrase is solicited if not currently available in the
6039 passphrase cache from a recent encryption action.
6041 The solicited passphrase is retained for reuse in a cache, if enabled. See
6042 `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' for details.
6044 Symmetric Passphrase Hinting and Verification
6046 If the file previously had no associated passphrase, or had a different
6047 passphrase than specified, the user is prompted to repeat the new one for
6048 corroboration. A random string encrypted by the new passphrase is set on
6049 the buffer-specific variable `allout-passphrase-verifier-string', for
6050 confirmation of the passphrase when next obtained, before encrypting or
6051 decrypting anything with it. This helps avoid mistakenly shifting between
6054 If allout customization var `allout-passphrase-verifier-handling' is
6055 non-nil, an entry for `allout-passphrase-verifier-string' and its value is
6056 added to an Emacs 'local variables' section at the end of the file, which
6057 is created if necessary. That setting is for retention of the passphrase
6058 verifier across Emacs sessions.
6060 Similarly, `allout-passphrase-hint-string' stores a user-provided reminder
6061 about their passphrase, and `allout-passphrase-hint-handling' specifies
6062 when the hint is presented, or if passphrase hints are disabled. If
6063 enabled (see the `allout-passphrase-hint-handling' docstring for details),
6064 the hint string is stored in the local-variables section of the file, and
6065 solicited whenever the passphrase is changed."
6068 (allout-back-to-current-heading)
6069 (allout-toggle-subtree-encryption fetch-pass
)
6072 ;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass)
6073 (defun allout-toggle-subtree-encryption (&optional fetch-pass
)
6074 "Encrypt clear text or decrypt encoded topic contents (body and subtopics.)
6076 Optional FETCH-PASS universal argument provokes key-pair encryption with
6077 single universal argument. With doubled universal argument (value = 16),
6078 it forces prompting for the passphrase regardless of availability from the
6079 passphrase cache. With no universal argument, the appropriate passphrase
6080 is obtained from the cache, if available, else from the user.
6082 Currently only GnuPG encryption is supported, and integration
6083 with gpg-agent is not yet implemented.
6085 \**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg
6086 encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
6088 See `allout-toggle-current-subtree-encryption' for more details."
6092 (allout-end-of-prefix t
)
6094 (if (= allout-recent-depth
1)
6095 (error (concat "Cannot encrypt or decrypt level 1 topics -"
6096 " shift it in to make it encryptable")))
6098 (let* ((allout-buffer (current-buffer))
6100 (bullet-pos allout-recent-prefix-beginning
)
6101 (after-bullet-pos (point))
6103 (progn (if (= (point-max) after-bullet-pos
)
6104 (error "no body to encrypt"))
6105 (allout-encrypted-topic-p)))
6106 (was-collapsed (if (not (search-forward "\n" nil t
))
6110 (subtree-beg (1+ (point)))
6111 (subtree-end (allout-end-of-subtree))
6112 (subject-text (buffer-substring-no-properties subtree-beg
6114 (subtree-end-char (char-after (1- subtree-end
)))
6115 (subtree-trailing-char (char-after subtree-end
))
6116 ;; kluge -- result-text needs to be nil, but we also want to
6117 ;; check for the error condition
6118 (result-text (if (or (string= "" subject-text
)
6119 (string= "\n" subject-text
))
6120 (error "No topic contents to %scrypt"
6121 (if was-encrypted
"de" "en"))
6123 ;; Assess key parameters:
6125 ;; detect the type by which it is already encrypted
6127 (allout-encrypted-key-info subject-text
))
6128 (and (member fetch-pass
'(4 (4)))
6131 (for-key-type (car key-info
))
6132 (for-key-identity (cadr key-info
))
6133 (fetch-pass (and fetch-pass
(member fetch-pass
'(16 (16)))))
6134 (was-coding-system buffer-file-coding-system
))
6136 (when (not was-encrypted
)
6137 ;; ensure that non-ascii chars pending encryption are noticed before
6138 ;; they're encrypted, so the coding system is set to accommodate
6140 (setq buffer-file-coding-system
6141 (allout-select-safe-coding-system subtree-beg subtree-end
))
6142 ;; if the coding system for the text being encrypted is different
6143 ;; than that prevailing, then there a real risk that the coding
6144 ;; system can't be noticed by emacs when the file is visited. to
6145 ;; mitigate that, offer to preserve the coding system using a file
6147 (if (and (not (equal buffer-file-coding-system
6150 (format (concat "Register coding system %s as file local"
6151 " var? Necessary when only encrypted text"
6152 " is in that coding system. ")
6153 buffer-file-coding-system
)))
6154 (allout-adjust-file-variable "buffer-file-coding-system"
6155 buffer-file-coding-system
)))
6158 (allout-encrypt-string subject-text was-encrypted
6160 for-key-type for-key-identity fetch-pass
))
6162 ;; Replace the subtree with the processed product.
6165 (set-buffer allout-buffer
)
6166 (delete-region subtree-beg subtree-end
)
6167 (insert result-text
)
6169 (allout-flag-region (1- subtree-beg
) (point) t
))
6170 ;; adjust trailing-blank-lines to preserve topic spacing:
6171 (if (not was-encrypted
)
6172 (if (and (= subtree-end-char ?
\n)
6173 (= subtree-trailing-char ?
\n))
6174 (insert subtree-trailing-char
)))
6175 ;; Ensure that the item has an encrypted-entry bullet:
6176 (if (not (string= (buffer-substring-no-properties
6177 (1- after-bullet-pos
) after-bullet-pos
)
6178 allout-topic-encryption-bullet
))
6179 (progn (goto-char (1- after-bullet-pos
))
6181 (insert allout-topic-encryption-bullet
)))
6183 ;; Remove the is-encrypted bullet qualifier:
6184 (progn (goto-char after-bullet-pos
)
6186 ;; Add the is-encrypted bullet qualifier:
6187 (goto-char after-bullet-pos
)
6189 (run-hook-with-args 'allout-structure-added-hook
6190 bullet-pos subtree-end
))))
6191 ;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key
6192 ;;; fetch-pass &optional retried verifying
6194 (defun allout-encrypt-string (text decrypt allout-buffer key-type for-key
6195 fetch-pass
&optional retried rejected
6196 verifying passphrase
)
6197 "Encrypt or decrypt message TEXT.
6199 If DECRYPT is true (default false), then decrypt instead of encrypt.
6201 FETCH-PASS (default false) forces fresh prompting for the passphrase.
6203 KEY-TYPE, either `symmetric' or `keypair', specifies which type
6206 FOR-KEY is human readable identification of the first of the user's
6207 eligible secret keys a keypair decryption targets, or else nil.
6209 Optional RETRIED is for internal use -- conveys the number of failed keys
6210 that have been solicited in sequence leading to this current call.
6212 Optional PASSPHRASE enables explicit delivery of the decryption passphrase,
6213 for verification purposes.
6215 Optional REJECTED is for internal use -- conveys the number of
6216 rejections due to matches against
6217 `allout-encryption-ciphertext-rejection-regexps', as limited by
6218 `allout-encryption-ciphertext-rejection-ceiling'.
6220 Returns the resulting string, or nil if the transformation fails."
6224 (if (not (fboundp 'pgg-encrypt-symmetric
))
6225 (error "Allout encryption depends on a newer version of pgg"))
6227 (let* ((scheme (upcase
6228 (format "%s" (or pgg-scheme pgg-default-scheme
"GPG"))))
6229 (for-key (and (equal key-type
'keypair
)
6231 (split-string (read-string
6232 (format "%s message recipients: "
6235 (target-prompt-id (if (equal key-type
'keypair
)
6236 (if (= (length for-key
) 1)
6237 (car for-key
) for-key
)
6238 (buffer-name allout-buffer
)))
6239 (target-cache-id (format "%s-%s"
6241 (if (equal key-type
'keypair
)
6243 (or (buffer-file-name allout-buffer
)
6244 target-prompt-id
))))
6245 (encoding (with-current-buffer allout-buffer
6246 buffer-file-coding-system
))
6247 (multibyte (with-current-buffer allout-buffer
6248 enable-multibyte-characters
))
6249 (strip-plaintext-regexps
6251 (allout-get-configvar-values
6252 'allout-encryption-plaintext-sanitization-regexps
)))
6253 (reject-ciphertext-regexps
6255 (allout-get-configvar-values
6256 'allout-encryption-ciphertext-rejection-regexps
)))
6257 (rejected (or rejected
0))
6258 (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
6263 (if (and fetch-pass
(not passphrase
))
6264 ;; Force later fetch by evicting passphrase from the cache.
6265 (pgg-remove-passphrase-from-cache target-cache-id t
))
6267 (catch 'encryption-failed
6269 ;; We handle only symmetric-key passphrase caching.
6270 (if (and (not passphrase
)
6271 (not (equal key-type
'keypair
)))
6272 (setq passphrase
(allout-obtain-passphrase for-key
6277 retried fetch-pass
)))
6283 ;; convey the text characteristics of the original buffer:
6284 (allout-set-buffer-multibyte multibyte
)
6286 (set-buffer-file-coding-system encoding
)
6288 (encode-coding-region (point-min) (point-max) encoding
)))
6290 (when (and strip-plaintext-regexps
(not decrypt
))
6291 (dolist (re strip-plaintext-regexps
)
6292 (let ((re (if (listp re
) (car re
) re
))
6293 (replacement (if (listp re
) (cadr re
) "")))
6294 (goto-char (point-min))
6296 (while (re-search-forward re nil t
)
6297 (replace-match replacement nil nil
))))))
6302 ((equal key-type
'symmetric
)
6306 (pgg-decrypt (point-min) (point-max) passphrase
)
6308 (pgg-encrypt-symmetric (point-min) (point-max)
6312 (pgg-situate-output (point-min) (point-max))
6313 ;; failed -- handle passphrase caching
6315 (throw 'encryption-failed nil
)
6316 (pgg-remove-passphrase-from-cache target-cache-id t
)
6317 (error "Symmetric-cipher %scryption failed -- %s"
6318 (if decrypt
"de" "en")
6319 "try again with different passphrase"))))
6321 ;; encrypt `keypair':
6326 (pgg-encrypt for-key
6327 nil
(point-min) (point-max) passphrase
))
6330 (pgg-situate-output (point-min) (point-max))
6331 (error (pgg-remove-passphrase-from-cache target-cache-id t
)
6332 (error "encryption failed"))))
6334 ;; decrypt `keypair':
6338 (pgg-decrypt (point-min) (point-max) passphrase
))
6341 (pgg-situate-output (point-min) (point-max))
6342 (error (pgg-remove-passphrase-from-cache target-cache-id t
)
6343 (error "decryption failed")))))
6346 (buffer-substring-no-properties
6347 1 (- (point-max) (if decrypt
0 1))))
6350 ;; validate result -- non-empty
6351 (cond ((not result-text
)
6354 ;; transform was fruitless, retry w/new passphrase.
6355 (pgg-remove-passphrase-from-cache target-cache-id t
)
6356 (allout-encrypt-string text decrypt allout-buffer
6357 key-type for-key nil
6358 (if retried
(1+ retried
) 1)
6359 rejected verifying nil
)))
6361 ;; Retry (within limit) if ciphertext contains rejections:
6363 ;; Check for disqualification of this ciphertext:
6364 (let ((regexps reject-ciphertext-regexps
)
6366 (while (and regexps
(not reject-it
))
6367 (setq reject-it
(string-match (car regexps
)
6371 (setq rejections-left
(1- rejections-left
))
6372 (if (<= rejections-left
0)
6373 (error (concat "Ciphertext rejected too many times"
6375 allout-encryption-ciphertext-rejection-ceiling
6376 'allout-encryption-ciphertext-rejection-regexps
)
6377 (allout-encrypt-string text decrypt allout-buffer
6378 key-type for-key nil
6379 retried
(1+ rejected
)
6380 verifying passphrase
)))
6381 ;; Barf if encryption yields extraordinary control chars:
6383 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
6385 (error (concat "Encryption produced non-armored text, which"
6386 "conflicts with allout mode -- reconfigure!")))
6388 ;; valid result and just verifying or non-symmetric:
6389 ((or verifying
(not (equal key-type
'symmetric
)))
6390 (if (or verifying decrypt
)
6391 (pgg-add-passphrase-to-cache target-cache-id
6395 ;; valid result and regular symmetric -- "register"
6396 ;; passphrase with mnemonic aids/cache.
6398 (set-buffer allout-buffer
)
6400 (pgg-add-passphrase-to-cache target-cache-id
6402 (allout-update-passphrase-mnemonic-aids for-key passphrase
6409 ;;;_ > allout-obtain-passphrase (for-key cache-id prompt-id key-type
6410 ;;; allout-buffer retried fetch-pass)
6411 (defun allout-obtain-passphrase (for-key cache-id prompt-id key-type
6412 allout-buffer retried fetch-pass
)
6413 "Obtain passphrase for a key from the cache or else from the user.
6415 When obtaining from the user, symmetric-cipher passphrases are verified
6416 against either, if available and enabled, a random string that was
6417 encrypted against the passphrase, or else against repeated entry by the
6418 user for corroboration.
6420 FOR-KEY is the key for which the passphrase is being obtained.
6422 CACHE-ID is the cache id of the key for the passphrase.
6424 PROMPT-ID is the id for use when prompting the user.
6426 KEY-TYPE is either `symmetric' or `keypair'.
6428 ALLOUT-BUFFER is the buffer containing the entry being en/decrypted.
6430 RETRIED is the number of this attempt to obtain this passphrase.
6432 FETCH-PASS causes the passphrase to be solicited from the user, regardless
6433 of the availability of a cached copy."
6435 (if (not (equal key-type
'symmetric
))
6436 ;; do regular passphrase read on non-symmetric passphrase:
6437 (pgg-read-passphrase (format "%s passphrase%s: "
6438 (upcase (format "%s" (or pgg-scheme
6442 (format " for %s" prompt-id
)
6446 ;; Symmetric hereon:
6448 (with-current-buffer allout-buffer
6449 (let* ((hint (if (and (not (string= allout-passphrase-hint-string
""))
6450 (or (equal allout-passphrase-hint-handling
'always
)
6451 (and (equal allout-passphrase-hint-handling
6454 (format " [%s]" allout-passphrase-hint-string
)
6456 (retry-message (if retried
(format " (%s retry)" retried
) ""))
6457 (prompt-sans-hint (format "'%s' symmetric passphrase%s: "
6458 prompt-id retry-message
))
6459 (full-prompt (format "'%s' symmetric passphrase%s%s: "
6460 prompt-id hint retry-message
))
6461 (prompt full-prompt
)
6462 (verifier-string (allout-get-encryption-passphrase-verifier))
6464 (cached (and (not fetch-pass
)
6465 (pgg-read-passphrase-from-cache cache-id t
)))
6466 (got-pass (or cached
6467 (pgg-read-passphrase full-prompt cache-id t
)))
6473 ;; Duplicate our handle on the passphrase so it's not clobbered by
6474 ;; deactivate-passwd memory clearing:
6475 (setq got-pass
(copy-sequence got-pass
))
6477 (cond (verifier-string
6478 (save-window-excursion
6479 (if (allout-encrypt-string verifier-string
'decrypt
6480 allout-buffer
'symmetric
6481 for-key nil
0 0 'verifying
6482 (copy-sequence got-pass
))
6483 (setq confirmation
(format "%s" got-pass
))))
6485 (if (and (not confirmation
)
6487 (concat "Passphrase differs from established"
6488 " -- use new one instead? "))
6489 ;; deactivate password for subsequent
6492 (pgg-remove-passphrase-from-cache cache-id t
)
6493 (setq prompt prompt-sans-hint
)
6496 (progn (pgg-remove-passphrase-from-cache cache-id t
)
6497 (error "Wrong passphrase"))))
6498 ;; No verifier string -- force confirmation by repetition of
6499 ;; (new) passphrase:
6500 ((or fetch-pass
(not cached
))
6501 (pgg-remove-passphrase-from-cache cache-id t
))))
6502 ;; confirmation vs new input -- doing pgg-read-passphrase will do the
6503 ;; right thing, in either case:
6504 (if (not confirmation
)
6506 (pgg-read-passphrase (concat prompt
6507 " ... confirm spelling: ")
6510 (if (equal got-pass confirmation
)
6512 (if (yes-or-no-p (concat "spelling of original and"
6513 " confirmation differ -- retry? "))
6514 (progn (setq retried
(if retried
(1+ retried
) 1))
6515 (pgg-remove-passphrase-from-cache cache-id t
)
6516 ;; recurse to this routine:
6517 (pgg-read-passphrase prompt-sans-hint cache-id t
))
6518 (pgg-remove-passphrase-from-cache cache-id t
)
6519 (error "Confirmation failed"))))))))
6520 ;;;_ > allout-encrypted-topic-p ()
6521 (defun allout-encrypted-topic-p ()
6522 "True if the current topic is encryptable and encrypted."
6524 (allout-end-of-prefix t
)
6525 (and (string= (buffer-substring-no-properties (1- (point)) (point))
6526 allout-topic-encryption-bullet
)
6527 (save-match-data (looking-at "\\*")))
6530 ;;;_ > allout-encrypted-key-info (text)
6531 ;; XXX gpg-specific, alas
6532 (defun allout-encrypted-key-info (text)
6533 "Return a pair of the key type and identity of a recipient's secret key.
6535 The key type is one of `symmetric' or `keypair'.
6537 If `keypair', and some of the user's secret keys are among those for which
6538 the message was encoded, return the identity of the first. Otherwise,
6539 return nil for the second item of the pair.
6541 An error is raised if the text is not encrypted."
6542 (require 'pgg-parse
)
6546 (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max)))
6547 (type (if (pgg-gpg-symmetric-key-p parsed-armor
)
6550 secret-keys first-secret-key for-key-owner
)
6551 (if (equal type
'keypair
)
6552 (setq secret-keys
(pgg-gpg-lookup-all-secret-keys)
6553 first-secret-key
(pgg-gpg-select-matching-key parsed-armor
6555 for-key-owner
(and first-secret-key
6556 (pgg-gpg-lookup-key-owner
6557 first-secret-key
))))
6558 (list type
(pgg-gpg-key-id-from-key-owner for-key-owner
))
6563 ;;;_ > allout-create-encryption-passphrase-verifier (passphrase)
6564 (defun allout-create-encryption-passphrase-verifier (passphrase)
6565 "Encrypt random message for later validation of symmetric key's passphrase."
6566 ;; use 20 random ascii characters, across the entire ascii range.
6568 (let ((spew (make-string 20 ?\
0)))
6569 (dotimes (i (length spew
))
6570 (aset spew i
(1+ (random 254))))
6571 (allout-encrypt-string spew nil
(current-buffer) 'symmetric
6572 nil nil
0 0 passphrase
))
6574 ;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase
6576 (defun allout-update-passphrase-mnemonic-aids (for-key passphrase
6578 "Update passphrase verifier and hint strings if necessary.
6580 See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string'
6583 PASSPHRASE is the passphrase being mnemonicized.
6585 OUTLINE-BUFFER is the buffer of the outline being adjusted.
6587 These are used to help the user keep track of the passphrase they use for
6588 symmetric encryption in the file.
6590 Behavior is governed by `allout-passphrase-verifier-handling',
6591 `allout-passphrase-hint-handling', and also, controlling whether the values
6592 are preserved on Emacs local file variables,
6593 `allout-enable-file-variable-adjustment'."
6595 ;; If passphrase doesn't agree with current verifier:
6596 ;; - adjust the verifier
6597 ;; - if passphrase hint handling is enabled, adjust the passphrase hint
6598 ;; - if file var settings are enabled, adjust the file vars
6600 (let* ((new-verifier-needed (not (allout-verify-passphrase
6601 for-key passphrase outline-buffer
)))
6602 (new-verifier-string
6603 (if new-verifier-needed
6604 ;; Collapse to a single line and enclose in string quotes:
6605 (subst-char-in-string
6606 ?
\n ?\C-a
(allout-create-encryption-passphrase-verifier
6609 (when new-verifier-string
6610 ;; do the passphrase hint first, since it's interactive
6611 (when (and allout-passphrase-hint-handling
6612 (not (equal allout-passphrase-hint-handling
'disabled
)))
6614 (read-from-minibuffer "Passphrase hint to jog your memory: "
6615 allout-passphrase-hint-string
))
6616 (when (not (string= new-hint allout-passphrase-hint-string
))
6617 (setq allout-passphrase-hint-string new-hint
)
6618 (allout-adjust-file-variable "allout-passphrase-hint-string"
6619 allout-passphrase-hint-string
)))
6620 (when allout-passphrase-verifier-handling
6621 (setq allout-passphrase-verifier-string new-verifier-string
)
6622 (allout-adjust-file-variable "allout-passphrase-verifier-string"
6623 allout-passphrase-verifier-string
))
6627 ;;;_ > allout-get-encryption-passphrase-verifier ()
6628 (defun allout-get-encryption-passphrase-verifier ()
6629 "Return text of the encrypt passphrase verifier, unmassaged, or nil if none.
6631 Derived from value of `allout-passphrase-verifier-string'."
6633 (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string
)
6634 allout-passphrase-verifier-string
)))
6636 ;; Return it uncollapsed
6637 (subst-char-in-string ?\C-a ?
\n verifier-string
))
6640 ;;;_ > allout-verify-passphrase (key passphrase allout-buffer)
6641 (defun allout-verify-passphrase (key passphrase allout-buffer
)
6642 "True if passphrase successfully decrypts verifier, nil otherwise.
6644 \"Otherwise\" includes absence of passphrase verifier."
6645 (with-current-buffer allout-buffer
6646 (and (boundp 'allout-passphrase-verifier-string
)
6647 allout-passphrase-verifier-string
6648 (allout-encrypt-string (allout-get-encryption-passphrase-verifier)
6649 'decrypt allout-buffer
'symmetric
6650 key nil
0 0 'verifying passphrase
)
6652 ;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
6653 (defun allout-next-topic-pending-encryption (&optional except-mark
)
6654 "Return the point of the next topic pending encryption, or nil if none.
6656 EXCEPT-MARK identifies a point whose containing topics should be excluded
6657 from encryption. This supports 'except-current mode of
6658 `allout-encrypt-unencrypted-on-saves'.
6660 Such a topic has the `allout-topic-encryption-bullet' without an
6661 immediately following '*' that would mark the topic as being encrypted. It
6662 must also have content."
6663 (let (done got content-beg
)
6667 (if (not (re-search-forward
6668 (format "\\(\\`\\|\n\\)%s *%s[^*]"
6669 (regexp-quote allout-header-prefix
)
6670 (regexp-quote allout-topic-encryption-bullet
))
6674 (goto-char (setq got
(match-beginning 0)))
6675 (if (save-match-data (looking-at "\n"))
6682 ((not (search-forward "\n"))
6691 (setq content-beg
(point))
6693 (allout-end-of-subtree)
6694 (if (or (<= (point) content-beg
)
6696 (<= content-beg except-mark
)
6697 (>= (point) except-mark
)))
6709 ;;;_ > allout-encrypt-decrypted (&optional except-mark)
6710 (defun allout-encrypt-decrypted (&optional except-mark
)
6711 "Encrypt topics pending encryption except those containing exemption point.
6713 EXCEPT-MARK identifies a point whose containing topics should be excluded
6714 from encryption. This supports the `except-current' mode of
6715 `allout-encrypt-unencrypted-on-saves'.
6717 If a topic that is currently being edited was encrypted, we return a list
6718 containing the location of the topic and the location of the cursor just
6719 before the topic was encrypted. This can be used, eg, to decrypt the topic
6720 and exactly resituate the cursor if this is being done as part of a file
6721 save. See `allout-encrypt-unencrypted-on-saves' for more info."
6726 (let* ((current-mark (point-marker))
6727 (current-mark-position (marker-position current-mark
))
6730 editing-topic editing-point
)
6731 (goto-char (point-min))
6732 (while (allout-next-topic-pending-encryption except-mark
)
6733 (setq was-modified
(buffer-modified-p))
6734 (when (save-excursion
6735 (and (boundp 'allout-encrypt-unencrypted-on-saves
)
6736 allout-encrypt-unencrypted-on-saves
6737 (setq bo-subtree
(re-search-forward "$"))
6738 (not (allout-hidden-p))
6739 (>= current-mark
(point))
6740 (allout-end-of-current-subtree)
6741 (<= current-mark
(point))))
6742 (setq editing-topic
(point)
6743 ;; we had to wait for this 'til now so prior topics are
6744 ;; encrypted, any relevant text shifts are in place:
6745 editing-point
(- current-mark-position
6746 (count-trailing-whitespace-region
6747 bo-subtree current-mark-position
))))
6748 (allout-toggle-subtree-encryption)
6749 (if (not was-modified
)
6750 (set-buffer-modified-p nil
))
6752 (if (not was-modified
)
6753 (set-buffer-modified-p nil
))
6754 (if editing-topic
(list editing-topic editing-point
))
6760 ;;;_ #9 miscellaneous
6762 ;;;_ > outlineify-sticky ()
6763 ;; outlinify-sticky is correct spelling; provide this alias for sticklers:
6765 (defalias 'outlinify-sticky
'outlineify-sticky
)
6767 (defun outlineify-sticky (&optional arg
)
6768 "Activate outline mode and establish file var so it is started subsequently.
6770 See doc-string for `allout-layout' and `allout-init' for details on
6771 setup for auto-startup."
6778 (goto-char (point-min))
6779 (if (allout-goto-prefix)
6781 (allout-open-topic 2)
6782 (insert (concat "Dummy outline topic header -- see"
6783 "`allout-mode' docstring: `^Hm'."))
6784 (allout-adjust-file-variable
6785 "allout-layout" (or allout-layout
'(-1 : 0))))))
6786 ;;;_ > allout-file-vars-section-data ()
6787 (defun allout-file-vars-section-data ()
6788 "Return data identifying the file-vars section, or nil if none.
6790 Returns a list of the form (BEGINNING-POINT PREFIX-STRING SUFFIX-STRING)."
6791 ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function.
6792 (let (beg prefix suffix
)
6794 (goto-char (point-max))
6795 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move
)
6796 (if (let ((case-fold-search t
))
6797 (not (search-forward "Local Variables:" nil t
)))
6799 (setq beg
(- (point) 16))
6800 (setq suffix
(buffer-substring-no-properties
6802 (progn (if (search-forward "\n" nil t
)
6805 (setq prefix
(buffer-substring-no-properties
6806 (progn (if (search-backward "\n" nil t
)
6810 (list beg prefix suffix
))
6814 ;;;_ > allout-adjust-file-variable (varname value)
6815 (defun allout-adjust-file-variable (varname value
)
6816 "Adjust the setting of an Emacs file variable named VARNAME to VALUE.
6818 This activity is inhibited if either `enable-local-variables'
6819 `allout-enable-file-variable-adjustment' are nil.
6821 When enabled, an entry for the variable is created if not already present,
6822 or changed if established with a different value. The section for the file
6823 variables, itself, is created if not already present. When created, the
6824 section lines (including the section line) exist as second-level topics in
6825 a top-level topic at the end of the file.
6827 `enable-local-variables' must be true for any of this to happen."
6828 (if (not (and enable-local-variables
6829 allout-enable-file-variable-adjustment
))
6832 (let ((inhibit-field-text-motion t
)
6833 (section-data (allout-file-vars-section-data))
6836 (setq beg
(car section-data
)
6837 prefix
(cadr section-data
)
6838 suffix
(car (cddr section-data
)))
6839 ;; create the section
6840 (goto-char (point-max))
6842 (allout-open-topic 0)
6844 (insert "Local emacs vars.\n")
6845 (allout-open-topic 1)
6848 prefix
(buffer-substring-no-properties (progn
6853 (insert "Local variables:\n")
6854 (allout-open-topic 0)
6857 ;; look for existing entry or create one, leaving point for insertion
6860 (allout-show-to-offshoot)
6861 (if (search-forward (concat "\n" prefix varname
":") nil t
)
6862 (let* ((value-beg (point))
6863 (line-end (progn (if (search-forward "\n" nil t
)
6866 (value-end (- line-end
(length suffix
))))
6867 (if (> value-end value-beg
)
6868 (delete-region value-beg value-end
)))
6872 (insert (concat prefix varname
":")))
6873 (insert (format " %S%s" value suffix
))
6878 ;;;_ > allout-get-configvar-values (varname)
6879 (defun allout-get-configvar-values (configvar-name)
6880 "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
6882 The user is prompted for removal of symbols that are unbound, and they
6883 otherwise are ignored.
6885 CONFIGVAR-NAME should be the name of the configuration variable,
6888 (let ((configvar-value (symbol-value configvar-name
))
6890 (dolist (sym configvar-value
)
6891 (if (not (boundp sym
))
6892 (if (yes-or-no-p (format "%s entry `%s' is unbound -- remove it? "
6893 configvar-name sym
))
6894 (delq sym
(symbol-value configvar-name
)))
6895 (push (symbol-value sym
) got
)))
6898 ;;;_ > allout-mark-topic ()
6899 (defun allout-mark-topic ()
6900 "Put the region around topic currently containing point."
6902 (let ((inhibit-field-text-motion t
))
6903 (beginning-of-line))
6904 (allout-goto-prefix-doublechecked)
6906 (allout-end-of-current-subtree)
6907 (exchange-point-and-mark))
6909 ;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
6910 (defun solicit-char-in-string (prompt string
&optional do-defaulting
)
6911 "Solicit (with first arg PROMPT) choice of a character from string STRING.
6913 Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
6915 (let ((new-prompt prompt
)
6919 (message "%s" new-prompt
)
6921 ;; We do our own reading here, so we can circumvent, eg, special
6922 ;; treatment for `?' character. (Oughta use minibuffer keymap instead.)
6924 (char-to-string (let ((cursor-in-echo-area nil
)) (read-char))))
6927 (cond ((string-match (regexp-quote got
) string
) got
)
6928 ((and do-defaulting
(string= got
"\r"))
6929 ;; Return empty string to default:
6931 ((string= got
"\C-g") (signal 'quit nil
))
6933 (setq new-prompt
(concat prompt
6939 ;; got something out of loop -- return it:
6943 ;;;_ > regexp-sans-escapes (string)
6944 (defun regexp-sans-escapes (regexp &optional successive-backslashes
)
6945 "Return a copy of REGEXP with all character escapes stripped out.
6947 Representations of actual backslashes -- '\\\\\\\\' -- are left as a
6950 Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
6952 (if (string= regexp
"")
6954 ;; Set successive-backslashes to number if current char is
6955 ;; backslash, or else to nil:
6956 (setq successive-backslashes
6957 (if (= (aref regexp
0) ?
\\)
6958 (if successive-backslashes
(1+ successive-backslashes
) 1)
6960 (if (or (not successive-backslashes
) (= 2 successive-backslashes
))
6961 ;; Include first char:
6962 (concat (substring regexp
0 1)
6963 (regexp-sans-escapes (substring regexp
1)))
6964 ;; Exclude first char, but maintain count:
6965 (regexp-sans-escapes (substring regexp
1) successive-backslashes
))))
6966 ;;;_ > count-trailing-whitespace-region (beg end)
6967 (defun count-trailing-whitespace-region (beg end
)
6968 "Return number of trailing whitespace chars between BEG and END.
6970 If BEG is bigger than END we return 0."
6977 (while (re-search-forward "[ ][ ]*$" end t
)
6978 (goto-char (1+ (match-beginning 2)))
6979 (setq count
(1+ count
)))
6981 ;;;_ > allout-format-quote (string)
6982 (defun allout-format-quote (string)
6983 "Return a copy of string with all \"%\" characters doubled."
6985 (mapcar (lambda (char) (if (= char ?%
) "%%" (char-to-string char
)))
6988 ;;;_ > allout-flatten (list)
6989 (defun allout-flatten (list)
6990 "Return a list of all atoms in list."
6992 (cond ((null list
) nil
)
6993 ((atom (car list
)) (cons (car list
) (allout-flatten (cdr list
))))
6994 (t (append (allout-flatten (car list
)) (allout-flatten (cdr list
))))))
6995 ;;;_ : Compatibility:
6996 ;;;_ : xemacs undo-in-progress provision:
6997 (unless (boundp 'undo-in-progress
)
6998 (defvar undo-in-progress nil
6999 "Placeholder defvar for XEmacs compatibility from allout.el.")
7000 (defadvice undo-more
(around allout activate
)
7001 ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs.
7002 (let ((undo-in-progress t
)) ad-do-it
)))
7004 ;;;_ > allout-mark-marker to accommodate divergent emacsen:
7005 (defun allout-mark-marker (&optional force buffer
)
7006 "Accommodate the different signature for `mark-marker' across Emacsen.
7008 XEmacs takes two optional args, while mainline GNU Emacs does not,
7009 so pass them along when appropriate."
7010 (if (featurep 'xemacs
)
7011 (apply 'mark-marker force buffer
)
7013 ;;;_ > subst-char-in-string if necessary
7014 (if (not (fboundp 'subst-char-in-string
))
7015 (defun subst-char-in-string (fromchar tochar string
&optional inplace
)
7016 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
7017 Unless optional argument INPLACE is non-nil, return a new string."
7018 (let ((i (length string
))
7019 (newstr (if inplace string
(copy-sequence string
))))
7022 (if (eq (aref newstr i
) fromchar
)
7023 (aset newstr i tochar
)))
7025 ;;;_ > wholenump if necessary
7026 (if (not (fboundp 'wholenump
))
7027 (defalias 'wholenump
'natnump
))
7028 ;;;_ > remove-overlays if necessary
7029 (if (not (fboundp 'remove-overlays
))
7030 (defun remove-overlays (&optional beg end name val
)
7031 "Clear BEG and END of overlays whose property NAME has value VAL.
7032 Overlays might be moved and/or split.
7033 BEG and END default respectively to the beginning and end of buffer."
7034 (unless beg
(setq beg
(point-min)))
7035 (unless end
(setq end
(point-max)))
7037 (setq beg
(prog1 end
(setq end beg
))))
7039 (dolist (o (overlays-in beg end
))
7040 (when (eq (overlay-get o name
) val
)
7041 ;; Either push this overlay outside beg...end
7042 ;; or split it to exclude beg...end
7043 ;; or delete it entirely (if it is contained in beg...end).
7044 (if (< (overlay-start o
) beg
)
7045 (if (> (overlay-end o
) end
)
7047 (move-overlay (copy-overlay o
)
7048 (overlay-start o
) beg
)
7049 (move-overlay o end
(overlay-end o
)))
7050 (move-overlay o
(overlay-start o
) beg
))
7051 (if (> (overlay-end o
) end
)
7052 (move-overlay o end
(overlay-end o
))
7053 (delete-overlay o
)))))))
7055 ;;;_ > copy-overlay if necessary -- xemacs ~ 21.4
7056 (if (not (fboundp 'copy-overlay
))
7057 (defun copy-overlay (o)
7058 "Return a copy of overlay O."
7059 (let ((o1 (make-overlay (overlay-start o
) (overlay-end o
)
7060 ;; FIXME: there's no easy way to find the
7061 ;; insertion-type of the two markers.
7062 (overlay-buffer o
)))
7063 (props (overlay-properties o
)))
7065 (overlay-put o1
(pop props
) (pop props
)))
7067 ;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4
7068 (if (not (fboundp 'add-to-invisibility-spec
))
7069 (defun add-to-invisibility-spec (element)
7070 "Add ELEMENT to `buffer-invisibility-spec'.
7071 See documentation for `buffer-invisibility-spec' for the kind of elements
7073 (if (eq buffer-invisibility-spec t
)
7074 (setq buffer-invisibility-spec
(list t
)))
7075 (setq buffer-invisibility-spec
7076 (cons element buffer-invisibility-spec
))))
7077 ;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4
7078 (if (not (fboundp 'remove-from-invisibility-spec
))
7079 (defun remove-from-invisibility-spec (element)
7080 "Remove ELEMENT from `buffer-invisibility-spec'."
7081 (if (consp buffer-invisibility-spec
)
7082 (setq buffer-invisibility-spec
(delete element
7083 buffer-invisibility-spec
)))))
7084 ;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs
7085 (if (not (fboundp 'move-beginning-of-line
))
7086 (defun move-beginning-of-line (arg)
7087 "Move point to beginning of current line as displayed.
7088 \(This disregards invisible newlines such as those
7089 which are part of the text that an image rests on.)
7091 With argument ARG not nil or 1, move forward ARG - 1 lines first.
7092 If point reaches the beginning or end of buffer, it stops there.
7093 To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
7095 (or arg
(setq arg
1))
7097 (condition-case nil
(line-move (1- arg
)) (error nil
)))
7099 ;; Move to beginning-of-line, ignoring fields and invisibles.
7100 (skip-chars-backward "^\n")
7101 (while (and (not (bobp))
7103 (get-char-property (1- (point)) 'invisible
)))
7104 (if (eq buffer-invisibility-spec t
)
7106 (or (memq prop buffer-invisibility-spec
)
7107 (assq prop buffer-invisibility-spec
)))))
7108 (goto-char (if (featurep 'xemacs
)
7109 (previous-property-change (point))
7110 (previous-char-property-change (point))))
7111 (skip-chars-backward "^\n"))
7112 (vertical-motion 0))
7114 ;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs
7115 (if (not (fboundp 'move-end-of-line
))
7116 (defun move-end-of-line (arg)
7117 "Move point to end of current line as displayed.
7118 \(This disregards invisible newlines such as those
7119 which are part of the text that an image rests on.)
7121 With argument ARG not nil or 1, move forward ARG - 1 lines first.
7122 If point reaches the beginning or end of buffer, it stops there.
7123 To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
7125 (or arg
(setq arg
1))
7130 (let ((goal-column 0))
7131 (and (condition-case nil
7132 (or (line-move arg
) t
)
7140 (get-char-property (1- (point))
7142 (if (eq buffer-invisibility-spec t
)
7145 buffer-invisibility-spec
)
7147 buffer-invisibility-spec
)))))
7149 (previous-char-property-change (point))))
7153 (if (and (> (point) newpos
)
7154 (eq (preceding-char) ?
\n))
7156 (if (and (> (point) newpos
) (not (eobp))
7157 (not (eq (following-char) ?
\n)))
7158 ;; If we skipped something intangible
7159 ;; and now we're not really at eol,
7164 ;;;_ > allout-next-single-char-property-change -- alias unless lacking
7165 (defalias 'allout-next-single-char-property-change
7166 (if (fboundp 'next-single-char-property-change
)
7167 'next-single-char-property-change
7168 'next-single-property-change
)
7169 ;; No docstring because xemacs defalias doesn't support it.
7171 ;;;_ > allout-previous-single-char-property-change -- alias unless lacking
7172 (defalias 'allout-previous-single-char-property-change
7173 (if (fboundp 'previous-single-char-property-change
)
7174 'previous-single-char-property-change
7175 'previous-single-property-change
)
7176 ;; No docstring because xemacs defalias doesn't support it.
7178 ;;;_ > allout-set-buffer-multibyte
7179 ;; define as alias first, so byte compiler is happy.
7180 (defalias 'allout-set-buffer-multibyte
'set-buffer-multibyte
)
7181 ;; then supplant with definition if underlying alias absent.
7182 (if (not (fboundp 'set-buffer-multibyte
))
7183 (defun allout-set-buffer-multibyte (is-multibyte)
7184 (setq enable-multibyte-characters is-multibyte
))
7186 ;;;_ > allout-select-safe-coding-system
7187 (defalias 'allout-select-safe-coding-system
7188 (if (fboundp 'select-safe-coding-system
)
7189 'select-safe-coding-system
7190 'detect-coding-region
)
7192 ;;;_ > allout-substring-no-properties
7193 ;; define as alias first, so byte compiler is happy.
7194 (defalias 'allout-substring-no-properties
'substring-no-properties
)
7195 ;; then supplant with definition if underlying alias absent.
7196 (if (not (fboundp 'substring-no-properties
))
7197 (defun allout-substring-no-properties (string &optional start end
)
7198 (substring string
(or start
0) end
))
7202 ;;;_ > allout-bullet-isearch (&optional bullet)
7203 (defun allout-bullet-isearch (&optional bullet
)
7204 "Isearch (regexp) for topic with bullet BULLET."
7207 (setq bullet
(solicit-char-in-string
7208 "ISearch for topic with bullet: "
7209 (regexp-sans-escapes allout-bullets-string
))))
7211 (let ((isearch-regexp t
)
7212 (isearch-string (concat "^"
7213 allout-header-prefix
7216 (isearch-repeat 'forward
)
7219 ;;;_ #11 Unit tests -- this should be last item before "Provide"
7220 ;;;_ > allout-run-unit-tests ()
7221 (defun allout-run-unit-tests ()
7222 "Run the various allout unit tests."
7223 (message "Running allout tests...")
7224 (allout-test-resumptions)
7225 (message "Running allout tests... Done.")
7227 ;;;_ : test resumptions:
7228 ;;;_ > allout-tests-obliterate-variable (name)
7229 (defun allout-tests-obliterate-variable (name)
7230 "Completely unbind variable with NAME."
7231 (if (local-variable-p name
(current-buffer)) (kill-local-variable name
))
7232 (while (boundp name
) (makunbound name
)))
7233 ;;;_ > allout-test-resumptions ()
7234 (defvar allout-tests-globally-unbound nil
7235 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
7236 (defvar allout-tests-globally-true nil
7237 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
7238 (defvar allout-tests-locally-true nil
7239 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
7240 (defun allout-test-resumptions ()
7241 "Exercise allout resumptions."
7242 ;; for each resumption case, we also test that the right local/global
7243 ;; scopes are affected during resumption effects:
7245 ;; ensure that previously unbound variables return to the unbound state.
7247 (allout-tests-obliterate-variable 'allout-tests-globally-unbound
)
7248 (allout-add-resumptions '(allout-tests-globally-unbound t
))
7249 (assert (not (default-boundp 'allout-tests-globally-unbound
)))
7250 (assert (local-variable-p 'allout-tests-globally-unbound
(current-buffer)))
7251 (assert (boundp 'allout-tests-globally-unbound
))
7252 (assert (equal allout-tests-globally-unbound t
))
7253 (allout-do-resumptions)
7254 (assert (not (local-variable-p 'allout-tests-globally-unbound
7256 (assert (not (boundp 'allout-tests-globally-unbound
))))
7258 ;; ensure that variable with prior global value is resumed
7260 (allout-tests-obliterate-variable 'allout-tests-globally-true
)
7261 (setq allout-tests-globally-true t
)
7262 (allout-add-resumptions '(allout-tests-globally-true nil
))
7263 (assert (equal (default-value 'allout-tests-globally-true
) t
))
7264 (assert (local-variable-p 'allout-tests-globally-true
(current-buffer)))
7265 (assert (equal allout-tests-globally-true nil
))
7266 (allout-do-resumptions)
7267 (assert (not (local-variable-p 'allout-tests-globally-true
7269 (assert (boundp 'allout-tests-globally-true
))
7270 (assert (equal allout-tests-globally-true t
)))
7272 ;; ensure that prior local value is resumed
7274 (allout-tests-obliterate-variable 'allout-tests-locally-true
)
7275 (set (make-local-variable 'allout-tests-locally-true
) t
)
7276 (assert (not (default-boundp 'allout-tests-locally-true
))
7277 nil
(concat "Test setup mistake -- variable supposed to"
7278 " not have global binding, but it does."))
7279 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer))
7280 nil
(concat "Test setup mistake -- variable supposed to have"
7281 " local binding, but it lacks one."))
7282 (allout-add-resumptions '(allout-tests-locally-true nil
))
7283 (assert (not (default-boundp 'allout-tests-locally-true
)))
7284 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer)))
7285 (assert (equal allout-tests-locally-true nil
))
7286 (allout-do-resumptions)
7287 (assert (boundp 'allout-tests-locally-true
))
7288 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer)))
7289 (assert (equal allout-tests-locally-true t
))
7290 (assert (not (default-boundp 'allout-tests-locally-true
))))
7292 ;; ensure that last of multiple resumptions holds, for various scopes.
7294 (allout-tests-obliterate-variable 'allout-tests-globally-unbound
)
7295 (allout-tests-obliterate-variable 'allout-tests-globally-true
)
7296 (setq allout-tests-globally-true t
)
7297 (allout-tests-obliterate-variable 'allout-tests-locally-true
)
7298 (set (make-local-variable 'allout-tests-locally-true
) t
)
7299 (allout-add-resumptions '(allout-tests-globally-unbound t
)
7300 '(allout-tests-globally-true nil
)
7301 '(allout-tests-locally-true nil
))
7302 (allout-add-resumptions '(allout-tests-globally-unbound 2)
7303 '(allout-tests-globally-true 3)
7304 '(allout-tests-locally-true 4))
7305 ;; reestablish many of the basic conditions are maintained after re-add:
7306 (assert (not (default-boundp 'allout-tests-globally-unbound
)))
7307 (assert (local-variable-p 'allout-tests-globally-unbound
(current-buffer)))
7308 (assert (equal allout-tests-globally-unbound
2))
7309 (assert (default-boundp 'allout-tests-globally-true
))
7310 (assert (local-variable-p 'allout-tests-globally-true
(current-buffer)))
7311 (assert (equal allout-tests-globally-true
3))
7312 (assert (not (default-boundp 'allout-tests-locally-true
)))
7313 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer)))
7314 (assert (equal allout-tests-locally-true
4))
7315 (allout-do-resumptions)
7316 (assert (not (local-variable-p 'allout-tests-globally-unbound
7318 (assert (not (boundp 'allout-tests-globally-unbound
)))
7319 (assert (not (local-variable-p 'allout-tests-globally-true
7321 (assert (boundp 'allout-tests-globally-true
))
7322 (assert (equal allout-tests-globally-true t
))
7323 (assert (boundp 'allout-tests-locally-true
))
7324 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer)))
7325 (assert (equal allout-tests-locally-true t
))
7326 (assert (not (default-boundp 'allout-tests-locally-true
))))
7328 ;; ensure that deliberately unbinding registered variables doesn't foul things
7330 (allout-tests-obliterate-variable 'allout-tests-globally-unbound
)
7331 (allout-tests-obliterate-variable 'allout-tests-globally-true
)
7332 (setq allout-tests-globally-true t
)
7333 (allout-tests-obliterate-variable 'allout-tests-locally-true
)
7334 (set (make-local-variable 'allout-tests-locally-true
) t
)
7335 (allout-add-resumptions '(allout-tests-globally-unbound t
)
7336 '(allout-tests-globally-true nil
)
7337 '(allout-tests-locally-true nil
))
7338 (allout-tests-obliterate-variable 'allout-tests-globally-unbound
)
7339 (allout-tests-obliterate-variable 'allout-tests-globally-true
)
7340 (allout-tests-obliterate-variable 'allout-tests-locally-true
)
7341 (allout-do-resumptions))
7343 ;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true:
7344 (when allout-run-unit-tests-on-load
7345 (allout-run-unit-tests))
7350 ;;;_* Local emacs vars.
7351 ;; The following `allout-layout' local variable setting:
7352 ;; - closes all topics from the first topic to just before the third-to-last,
7353 ;; - shows the children of the third to last (config vars)
7354 ;; - and the second to last (code section),
7355 ;; - and closes the last topic (this local-variables section).
7357 ;;allout-layout: (0 : -1 -1 0)
7360 ;;; allout.el ends here