1 ;;; allout.el --- extensive outline mode for use alone and with other modes
3 ;; Copyright (C) 1992-1994, 2001-2018 Free Software Foundation, Inc.
5 ;; Author: Ken Manheimer <ken dot manheimer at gmail...>
6 ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail...>
7 ;; Created: Dec 1991 -- first release to usenet
9 ;; Keywords: outlines, wp, languages, PGP, GnuPG
10 ;; Website: http://myriadicity.net/software-and-systems/craft/emacs-allout
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
29 ;; Allout outline minor mode provides extensive outline formatting and
30 ;; and manipulation beyond standard emacs outline mode. Some features:
32 ;; - Classic outline-mode topic-oriented navigation and exposure adjustment
33 ;; - Topic-oriented editing including coherent topic and subtopic
34 ;; creation, promotion, demotion, cut/paste across depths, etc.
35 ;; - Incremental search with dynamic exposure and reconcealment of text
36 ;; - Customizable bullet format -- enables programming-language specific
37 ;; outlining, for code-folding editing. (Allout code itself is to try it;
38 ;; formatted as an outline -- do ESC-x eval-buffer in allout.el; but
39 ;; emacs local file variables need to be enabled when the
40 ;; file was visited -- see `enable-local-variables'.)
41 ;; - Configurable per-file initial exposure settings
42 ;; - Symmetric-key and key-pair topic encryption. Encryption is via the
43 ;; Emacs 'epg' library. See allout-toggle-current-subtree-encryption
45 ;; - Automatic topic-number maintenance
46 ;; - "Hot-spot" operation, for single-keystroke maneuvering and
47 ;; exposure control (see the allout-mode docstring)
48 ;; - Easy rendering of exposed portions into numbered, latex, indented, etc
50 ;; - Careful attention to whitespace -- enabling blank lines between items
51 ;; and maintenance of hanging indentation (in paragraph auto-fill and
52 ;; across topic promotion and demotion) of topic bodies consistent with
53 ;; indentation of their topic header.
57 ;; See the `allout-mode' function's docstring for an introduction to the
60 ;; Directions to the latest development version and helpful notes are
61 ;; available at http://myriadicity.net/Sundry/EmacsAllout .
63 ;; The outline menubar additions provide quick reference to many of the
64 ;; features. See the docstring of the variables `allout-layout' and
65 ;; `allout-auto-activation' for details on automatic activation of
66 ;; `allout-mode' as a minor mode. (`allout-init' is deprecated in favor of
67 ;; a purely customization-based method.)
69 ;; Note -- the lines beginning with `;;;_' are outline topic headers.
70 ;; Customize `allout-auto-activation' to enable, then revisit this
71 ;; buffer to give it a whirl.
73 ;; ken manheimer (ken dot manheimer at gmail dot com)
77 (declare-function epa-passphrase-callback-function
78 "epa" (context key-id handback
))
80 ;;;_* Dependency loads
83 ;; `cl' is required for `assert'. `assert' is not covered by a standard
84 ;; autoload, but it is a macro, so that eval-when-compile is sufficient
85 ;; to byte-compile it in, or to do the require when the buffer evalled.
89 ;;;_* USER CUSTOMIZATION VARIABLES:
91 ;;;_ > defgroup allout, allout-keybindings
93 "Extensive outline minor-mode, for use stand-alone and with other modes.
95 See Allout Auto Activation for automatic activation."
98 (defgroup allout-keybindings nil
99 "Allout outline mode keyboard bindings configuration."
102 ;;;_ + Layout, Mode, and Topic Header Configuration
104 (defvar allout-command-prefix
) ; defined below
106 ;;;_ > allout-keybindings incidentals:
107 ;;;_ : internal key binding stuff - in this section for load-order.
108 ;;;_ = allout-mode-map
109 (defvar allout-mode-map
'allout-mode-map
110 "Keybindings place-holder for (allout) outline minor mode.
112 Do NOT set the value of this variable. Instead, customize
113 `allout-command-prefix', `allout-prefixed-keybindings', and
114 `allout-unprefixed-keybindings'.")
115 ;;;_ = allout-mode-map-value
116 (defvar allout-mode-map-value nil
117 "Keymap for allout outline minor mode.
119 Do NOT set the value of this variable. Instead, customize
120 `allout-command-prefix', `allout-prefixed-keybindings', and
121 `allout-unprefixed-keybindings'.")
122 ;;;_ = make allout-mode-map-value an alias for allout-mode-map:
123 ;; this needs to be revised when the value is changed, sigh.
124 (defalias 'allout-mode-map allout-mode-map-value
)
125 ;;;_ > allout-compose-and-institute-keymap (&optional varname value)
126 (defun allout-compose-and-institute-keymap (&optional varname value
)
127 "Create the allout keymap according to the keybinding specs, and set it.
129 Useful standalone or to effect customizations of the
130 respective allout-mode keybinding variables, `allout-command-prefix',
131 `allout-prefixed-keybindings', and `allout-unprefixed-keybindings'"
132 ;; Set the customization variable, if any:
134 (set-default varname value
))
135 (let ((map (make-sparse-keymap)))
136 (when (boundp 'allout-prefixed-keybindings
)
137 ;; tolerate first definitions of the variables:
138 (dolist (entry allout-prefixed-keybindings
)
140 ;; XXX vector vs non-vector key descriptions?
141 (vconcat allout-command-prefix
142 (car (read-from-string (car entry
))))
144 (when (boundp 'allout-unprefixed-keybindings
)
145 (dolist (entry allout-unprefixed-keybindings
)
146 (define-key map
(car (read-from-string (car entry
))) (cadr entry
))))
147 (substitute-key-definition 'beginning-of-line
'allout-beginning-of-line
149 (substitute-key-definition 'move-beginning-of-line
'allout-beginning-of-line
151 (substitute-key-definition 'end-of-line
'allout-end-of-line
153 (substitute-key-definition 'move-end-of-line
'allout-end-of-line
155 (allout-institute-keymap map
)))
156 ;;;_ > allout-institute-keymap (map)
157 (defun allout-institute-keymap (map)
158 "Associate allout-mode bindings with allout as a minor mode."
160 ;; allout-mode-map var is a keymap by virtue of being a defalias for
161 ;; allout-mode-map-value, which has the actual keymap value.
162 ;; allout-mode-map's symbol value is just 'allout-mode-map, so it can be
163 ;; used in minor-mode-map-alist to indirect to the actual
164 ;; allout-mode-map-var value, which can be adjusted and reassigned.
166 ;; allout-mode-map-value for keymap reference in various places:
167 (setq allout-mode-map-value map
)
168 ;; the function value keymap of allout-mode-map is used in
169 ;; minor-mode-map-alist - update it:
170 (fset allout-mode-map allout-mode-map-value
))
171 ;;;_ * initialize the mode map:
172 ;; ensure that allout-mode-map has some setting even if allout-mode hasn't
174 (allout-compose-and-institute-keymap)
175 ;;;_ = allout-command-prefix
176 (defcustom allout-command-prefix
"\C-c "
177 "Key sequence to be used as prefix for outline mode command key bindings.
179 Default is `\C-c<space>'; just `\C-c' is more short-and-sweet, if you're
180 willing to let allout use a bunch of \C-c keybindings."
182 :group
'allout-keybindings
183 :set
'allout-compose-and-institute-keymap
)
184 ;;;_ = allout-keybindings-binding
185 (define-widget 'allout-keybindings-binding
'lazy
186 "Structure of allout keybindings customization items."
188 (list (string :tag
"Key" :value
"[(meta control shift ?f)]")
189 (function :tag
"Function name"
190 :value allout-forward-current-level
))))
191 ;;;_ = allout-prefixed-keybindings
192 (defcustom allout-prefixed-keybindings
193 '(("[(control ?n)]" allout-next-visible-heading
)
194 ("[(control ?p)]" allout-previous-visible-heading
)
195 ("[(control ?u)]" allout-up-current-level
)
196 ("[(control ?f)]" allout-forward-current-level
)
197 ("[(control ?b)]" allout-backward-current-level
)
198 ("[(control ?a)]" allout-beginning-of-current-entry
)
199 ("[(control ?e)]" allout-end-of-entry
)
200 ("[(control ?i)]" allout-show-children
)
201 ("[(control ?s)]" allout-show-current-subtree
)
202 ("[(control ?t)]" allout-toggle-current-subtree-exposure
)
203 ;; Let user customize if they want to preempt describe-prefix-bindings ^h use.
204 ;; ("[(control ?h)]" allout-hide-current-subtree)
205 ("[?h]" allout-hide-current-subtree
)
206 ("[(control ?o)]" allout-show-current-entry
)
207 ("[?!]" allout-show-all
)
208 ("[?x]" allout-toggle-current-subtree-encryption
)
209 ("[? ]" allout-open-sibtopic
)
210 ("[?.]" allout-open-subtopic
)
211 ("[?,]" allout-open-supertopic
)
212 ("[?']" allout-shift-in
)
213 ("[?>]" allout-shift-in
)
214 ("[?<]" allout-shift-out
)
215 ("[(control ?m)]" allout-rebullet-topic
)
216 ("[?*]" allout-rebullet-current-heading
)
217 ("[?#]" allout-number-siblings
)
218 ("[(control ?k)]" allout-kill-topic
)
219 ("[(meta ?k)]" allout-copy-topic-as-kill
)
220 ("[?@]" allout-resolve-xref
)
221 ("[?=?c]" allout-copy-exposed-to-buffer
)
222 ("[?=?i]" allout-indented-exposed-to-buffer
)
223 ("[?=?t]" allout-latexify-exposed
)
224 ("[?=?p]" allout-flatten-exposed-to-buffer
)
226 "Allout-mode key bindings that are prefixed with `allout-command-prefix'.
228 See `allout-unprefixed-keybindings' for the list of keybindings
229 that are not prefixed.
231 Use vector format for the keys:
232 - put literal keys after a `?' question mark, eg: `?a', `?.'
233 - enclose control, shift, or meta-modified keys as sequences within
234 parentheses, with the literal key, as above, preceded by the name(s)
235 of the modifiers, eg: [(control ?a)]
236 See the existing keys for examples.
238 Functions can be bound to multiple keys, but binding keys to
239 multiple functions will not work - the last binding for a key
242 :type
'allout-keybindings-binding
243 :group
'allout-keybindings
244 :set
'allout-compose-and-institute-keymap
246 ;;;_ = allout-unprefixed-keybindings
247 (defcustom allout-unprefixed-keybindings
248 '(("[(control ?k)]" allout-kill-line
)
249 ("[(meta ?k)]" allout-copy-line-as-kill
)
250 ("[(control ?y)]" allout-yank
)
251 ("[(meta ?y)]" allout-yank-pop
)
253 "Allout-mode functions bound to keys without any added prefix.
255 This is in contrast to the majority of allout-mode bindings on
256 `allout-prefixed-bindings', whose bindings are created with a
257 preceding command key.
259 Use vector format for the keys:
260 - put literal keys after a `?' question mark, eg: `?a', `?.'
261 - enclose control, shift, or meta-modified keys as sequences within
262 parentheses, with the literal key, as above, preceded by the name(s)
263 of the modifiers, eg: [(control ?a)]
264 See the existing keys for examples."
266 :type
'allout-keybindings-binding
267 :group
'allout-keybindings
268 :set
'allout-compose-and-institute-keymap
271 ;;;_ > allout-auto-activation-helper (var value)
273 (defun allout-auto-activation-helper (var value
)
274 "Institute `allout-auto-activation'.
276 Intended to be used as the `allout-auto-activation' :set function."
277 (set-default var value
)
279 ;;;_ > allout-setup ()
281 (defun allout-setup ()
282 "Do fundamental Emacs session for allout auto-activation.
284 Establishes allout processing as part of visiting a file if
285 `allout-auto-activation' is non-nil, or removes it otherwise.
287 The proper way to use this is through customizing the setting of
288 `allout-auto-activation'."
289 (if (not allout-auto-activation
)
290 (remove-hook 'find-file-hook
'allout-find-file-hook
)
291 (add-hook 'find-file-hook
'allout-find-file-hook
)))
292 ;;;_ = allout-auto-activation
294 (defcustom allout-auto-activation nil
295 "Configure allout outline mode auto-activation.
297 Control whether and how allout outline mode is automatically
298 activated when files are visited with non-nil buffer-specific
299 file variable `allout-layout'.
301 When allout-auto-activation is \"On\" (t), allout mode is
302 activated in buffers with non-nil `allout-layout', and the
303 specified layout is applied.
305 With value \"ask\", auto-mode-activation is enabled, and endorsement for
306 performing auto-layout is asked of the user each time.
308 With value \"activate\", only auto-mode-activation is enabled.
311 With value nil, inhibit any automatic allout-mode activation."
312 :set
'allout-auto-activation-helper
313 ;; FIXME: Using strings here is unusual and less efficient than symbols.
314 :type
'(choice (const :tag
"On" t
)
315 (const :tag
"Ask about layout" "ask")
316 (const :tag
"Mode only" "activate")
317 (const :tag
"Off" nil
))
320 ;;;_ = allout-default-layout
321 (defcustom allout-default-layout
'(-2 : 0)
322 "Default allout outline layout specification.
324 This setting specifies the outline exposure to use when
325 `allout-layout' has the local value t. This docstring describes the
326 layout specifications.
328 A list value specifies a default layout for the current buffer,
329 to be applied upon activation of `allout-mode'. Any non-nil
330 value will automatically trigger `allout-mode', provided
331 `allout-auto-activation' has been customized to enable it.
333 The types of elements in the layout specification are:
335 INTEGER -- dictate the relative depth to open the corresponding topic(s),
337 -- negative numbers force the topic to be closed before opening
338 to the absolute value of the number, so all siblings are open
340 -- positive numbers open to the relative depth indicated by the
341 number, but do not force already opened subtopics to be closed.
342 -- 0 means to close topic -- hide all subitems.
343 : -- repeat spec -- apply the preceding element to all siblings at
344 current level, *up to* those siblings that would be covered by specs
345 following the `:' on the list. Ie, apply to all topics at level but
346 trailing ones accounted for by trailing specs. (Only the first of
347 multiple colons at the same level is honored -- later ones are ignored.)
348 * -- completely exposes the topic, including bodies
349 + -- exposes all subtopics, but not the bodies
350 - -- exposes the body of the corresponding topic, but not subtopics
351 LIST -- a nested layout spec, to be applied intricately to its
352 corresponding item(s)
356 Collapse the top-level topics to show their children and
357 grandchildren, but completely collapse the final top-level topic.
359 Close the first topic so only the immediate subtopics are shown,
360 leave the subsequent topics exposed as they are until the
361 second to last topic, which is exposed at least one level, and
362 completely close the last topic.
364 Expose children and grandchildren of all topics at current
365 level except the last two; expose children of the second to
366 last and completely expose the last one, including its subtopics.
368 See `allout-expose-topic' for more about the exposure process.
370 Also, allout's mode-specific provisions will make topic prefixes default
371 to the comment-start string, if any, of the language of the file. This
372 is modulo the setting of `allout-use-mode-specific-leader', which see."
373 :type
'allout-layout-type
375 ;;;_ : allout-layout-type
376 (define-widget 'allout-layout-type
'lazy
377 "Allout layout format customization basic building blocks."
379 (choice (integer :tag
"integer (<= zero is strict)")
380 (const :tag
": (repeat prior)" :)
381 (const :tag
"* (completely expose)" *)
382 (const :tag
"+ (expose all offspring, headlines only)" +)
383 (const :tag
"- (expose topic body but not offspring)" -
)
384 (allout-layout-type :tag
"<Nested layout>"))))
386 ;;;_ = allout-inhibit-auto-fill
387 (defcustom allout-inhibit-auto-fill nil
388 "If non-nil, auto-fill will be inhibited in the allout buffers.
390 You can customize this setting to set it for all allout buffers, or set it
391 in individual buffers if you want to inhibit auto-fill only in particular
392 buffers. (You could use a function on `allout-mode-hook' to inhibit
393 auto-fill according, eg, to the major mode.)
395 If you don't set this and auto-fill-mode is enabled, allout will use the
396 value that `normal-auto-fill-function', if any, when allout mode starts, or
397 else allout's special hanging-indent maintaining auto-fill function,
401 (make-variable-buffer-local 'allout-inhibit-auto-fill
)
402 ;;;_ = allout-inhibit-auto-fill-on-headline
403 (defcustom allout-inhibit-auto-fill-on-headline nil
404 "If non-nil, auto-fill will be inhibited while on topic's header line."
408 (make-variable-buffer-local 'allout-inhibit-auto-fill-on-headline
)
409 ;;;_ = allout-use-hanging-indents
410 (defcustom allout-use-hanging-indents t
411 "If non-nil, topic body text auto-indent defaults to indent of the header.
412 Ie, it is indented to be just past the header prefix. This is
413 relevant mostly for use with `indented-text-mode', or other situations
414 where auto-fill occurs."
417 (make-variable-buffer-local 'allout-use-hanging-indents
)
419 (put 'allout-use-hanging-indents
'safe-local-variable
420 (if (fboundp 'booleanp
) 'booleanp
(lambda (x) (member x
'(t nil
)))))
421 ;;;_ = allout-reindent-bodies
422 (defcustom allout-reindent-bodies
(if allout-use-hanging-indents
424 "Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
426 When active, topic body lines that are indented even with or beyond
427 their topic header are reindented to correspond with depth shifts of
430 A value of t enables reindent in non-programming-code buffers, ie
431 those that do not have the variable `comment-start' set. A value of
432 `force' enables reindent whether or not `comment-start' is set."
433 :type
'(choice (const nil
) (const t
) (const text
) (const force
))
436 (make-variable-buffer-local 'allout-reindent-bodies
)
438 (put 'allout-reindent-bodies
'safe-local-variable
439 (lambda (x) (memq x
'(nil t text force
))))
441 ;;;_ = allout-show-bodies
442 (defcustom allout-show-bodies nil
443 "If non-nil, show entire body when exposing a topic, rather than
447 (make-variable-buffer-local 'allout-show-bodies
)
449 (put 'allout-show-bodies
'safe-local-variable
450 (if (fboundp 'booleanp
) 'booleanp
(lambda (x) (member x
'(t nil
)))))
452 ;;;_ = allout-beginning-of-line-cycles
453 (defcustom allout-beginning-of-line-cycles t
454 "If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options.
456 Cycling only happens on when the command is repeated, not when it
457 follows a different command.
459 Smart-placement means that repeated calls to this function will
462 - if the cursor is on a non-headline body line and not on the first column:
463 then it goes to the first column
464 - if the cursor is on the first column of a non-headline body line:
465 then it goes to the start of the headline within the item body
466 - if the cursor is on the headline and not the start of the headline:
467 then it goes to the start of the headline
468 - if the cursor is on the start of the headline:
469 then it goes to the bullet character (for hotspot navigation)
470 - if the cursor is on the bullet character:
471 then it goes to the first column of that line (the headline)
472 - if the cursor is on the first column of the headline:
473 then it goes to the start of the headline within the item body.
475 In this fashion, you can use the beginning-of-line command to do
476 its normal job and then, when repeated, advance through the
477 entry, cycling back to start.
479 If this configuration variable is nil, then the cursor is just
480 advanced to the beginning of the line and remains there on
482 :type
'boolean
:group
'allout
)
483 ;;;_ = allout-end-of-line-cycles
484 (defcustom allout-end-of-line-cycles t
485 "If non-nil, \\[allout-end-of-line] will cycle through smart-placement options.
487 Cycling only happens on when the command is repeated, not when it
488 follows a different command.
490 Smart placement means that repeated calls to this function will
493 - if the cursor is not on the end-of-line,
494 then it goes to the end-of-line
495 - if the cursor is on the end-of-line but not the end-of-entry,
496 then it goes to the end-of-entry, exposing it if necessary
497 - if the cursor is on the end-of-entry,
498 then it goes to the end of the head line
500 In this fashion, you can use the end-of-line command to do its
501 normal job and then, when repeated, advance through the entry,
502 cycling back to start.
504 If this configuration variable is nil, then the cursor is just
505 advanced to the end of the line and remains there on repeated
507 :type
'boolean
:group
'allout
)
509 ;;;_ = allout-header-prefix
510 (defcustom allout-header-prefix
"."
511 ;; this string is treated as literal match. it will be `regexp-quote'd, so
512 ;; one cannot use regular expressions to match varying header prefixes.
513 "Leading string which helps distinguish topic headers.
515 Outline topic header lines are identified by a leading topic
516 header prefix, which mostly have the value of this var at their front.
517 Level 1 topics are exceptions. They consist of only a single
518 character, which is typically set to the `allout-primary-bullet'."
521 (make-variable-buffer-local 'allout-header-prefix
)
523 (put 'allout-header-prefix
'safe-local-variable
'stringp
)
524 ;;;_ = allout-primary-bullet
525 (defcustom allout-primary-bullet
"*"
526 "Bullet used for top-level outline topics.
528 Outline topic header lines are identified by a leading topic header
529 prefix, which is concluded by bullets that includes the value of this
530 var and the respective allout-*-bullets-string vars.
532 The value of an asterisk (`*') provides for backwards compatibility
533 with the original Emacs outline mode. See `allout-plain-bullets-string'
534 and `allout-distinctive-bullets-string' for the range of available
538 (make-variable-buffer-local 'allout-primary-bullet
)
540 (put 'allout-primary-bullet
'safe-local-variable
'stringp
)
541 ;;;_ = allout-plain-bullets-string
542 (defcustom allout-plain-bullets-string
".,"
543 "The bullets normally used in outline topic prefixes.
545 See `allout-distinctive-bullets-string' for the other kind of
548 DO NOT include the close-square-bracket, `]', as a bullet.
550 Outline mode has to be reactivated in order for changes to the value
551 of this var to take effect."
554 (make-variable-buffer-local 'allout-plain-bullets-string
)
556 (put 'allout-plain-bullets-string
'safe-local-variable
'stringp
)
557 ;;;_ = allout-distinctive-bullets-string
558 (defcustom allout-distinctive-bullets-string
"*+-=>()[{}&!?#%\"X@$~_\\:;^"
559 "Persistent outline header bullets used to distinguish special topics.
561 These bullets are distinguish topics with particular character.
562 They are not used by default in the topic creation routines, but
563 are offered as options when you modify topic creation with a
564 universal argument (\\[universal-argument]), or during rebulleting (\\[allout-rebullet-current-heading]).
566 Distinctive bullets are not cycled when topics are shifted or
567 otherwise automatically rebulleted, so their marking is
568 persistent until deliberately changed. Their significance is
569 purely by convention, however. Some conventions suggest
572 `(' - open paren -- an aside or incidental point
573 `?' - question mark -- uncertain or outright question
574 `!' - exclamation point/bang -- emphatic
575 `[' - open square bracket -- meta-note, about item instead of item's subject
576 `\"' - double quote -- a quotation or other citation
577 `=' - equal sign -- an assignment, some kind of definition
578 `^' - carat -- relates to something above
580 Some are more elusive, but their rationale may be recognizable:
582 `+' - plus -- pending consideration, completion
583 `_' - underscore -- done, completed
584 `&' - ampersand -- addendum, furthermore
586 \(Some other non-plain bullets have special meaning to the
587 software. By default:
589 `~' marks encryptable topics -- see `allout-topic-encryption-bullet'
590 `#' marks auto-numbered bullets -- see `allout-numbered-bullet'.)
592 See `allout-plain-bullets-string' for the standard, alternating
595 You must run `allout-set-regexp' in order for outline mode to
596 adopt changes of this value.
598 DO NOT include the close-square-bracket, `]', on either of the bullet
602 (make-variable-buffer-local 'allout-distinctive-bullets-string
)
604 (put 'allout-distinctive-bullets-string
'safe-local-variable
'stringp
)
606 ;;;_ = allout-use-mode-specific-leader
607 (defcustom allout-use-mode-specific-leader t
608 "When non-nil, use mode-specific topic-header prefixes.
610 Allout outline mode will use the mode-specific `allout-mode-leaders' or
611 comment-start string, if any, to lead the topic prefix string, so topic
612 headers look like comments in the programming language. It will also use
613 the comment-start string, with an `_' appended, for `allout-primary-bullet'.
615 String values are used as literals, not regular expressions, so
616 do not escape any regular-expression characters.
618 Value t means to first check for assoc value in `allout-mode-leaders'
619 alist, then use comment-start string, if any, then use default (`.').
620 \(See note about use of comment-start strings, below.)
622 Set to the symbol for either of `allout-mode-leaders' or
623 `comment-start' to use only one of them, respectively.
625 Value nil means to always use the default (`.') and leave
626 `allout-primary-bullet' unaltered.
628 comment-start strings that do not end in spaces are tripled in
629 the header-prefix, and an `_' underscore is tacked on the end, to
630 distinguish them from regular comment strings. comment-start
631 strings that do end in spaces are not tripled, but an underscore
632 is substituted for the space. [This presumes that the space is
633 for appearance, not comment syntax. You can use
634 `allout-mode-leaders' to override this behavior, when
636 :type
'(choice (const t
) (const nil
) string
637 (const allout-mode-leaders
)
638 (const comment-start
))
641 (put 'allout-use-mode-specific-leader
'safe-local-variable
642 (lambda (x) (or (memq x
'(t nil allout-mode-leaders comment-start
))
644 ;;;_ = allout-mode-leaders
645 (defvar allout-mode-leaders
'()
646 "Specific allout-prefix leading strings per major modes.
648 Use this if the mode's comment-start string isn't what you
649 prefer, or if the mode lacks a comment-start string. See
650 `allout-use-mode-specific-leader' for more details.
652 If you're constructing a string that will comment-out outline
653 structuring so it can be included in program code, append an extra
654 character, like an \"_\" underscore, to distinguish the lead string
655 from regular comments that start at the beginning-of-line.")
657 ;;;_ = allout-old-style-prefixes
658 (defcustom allout-old-style-prefixes nil
659 "When non-nil, use only old-and-crusty `outline-mode' `*' topic prefixes.
661 Non-nil restricts the topic creation and modification
662 functions to asterix-padded prefixes, so they look exactly
663 like the original Emacs-outline style prefixes.
665 Whatever the setting of this variable, both old and new style prefixes
666 are always respected by the topic maneuvering functions."
669 (make-variable-buffer-local 'allout-old-style-prefixes
)
671 (put 'allout-old-style-prefixes
'safe-local-variable
672 (if (fboundp 'booleanp
) 'booleanp
(lambda (x) (member x
'(t nil
)))))
673 ;;;_ = allout-stylish-prefixes -- alternating bullets
674 (defcustom allout-stylish-prefixes t
675 "Do fancy stuff with topic prefix bullets according to level, etc.
677 Non-nil enables topic creation, modification, and repositioning
678 functions to vary the topic bullet char (the char that marks the topic
679 depth) just preceding the start of the topic text) according to level.
680 Otherwise, only asterisks (`*') and distinctive bullets are used.
682 This is how an outline can look (but sans indentation) with stylish
687 . + One level 3 subtopic
688 . . One level 4 subtopic
689 . . A second 4 subtopic
690 . + Another level 3 subtopic
691 . #1 A numbered level 4 subtopic
693 . ! Another level 4 subtopic with a different distinctive bullet
694 . #4 And another numbered level 4 subtopic
696 This would be an outline with stylish prefixes inhibited (but the
697 numbered and other distinctive bullets retained):
701 . * One level 3 subtopic
702 . * One level 4 subtopic
703 . * A second 4 subtopic
704 . * Another level 3 subtopic
705 . #1 A numbered level 4 subtopic
707 . ! Another level 4 subtopic with a different distinctive bullet
708 . #4 And another numbered level 4 subtopic
710 Stylish and constant prefixes (as well as old-style prefixes) are
711 always respected by the topic maneuvering functions, regardless of
712 this variable setting.
714 The setting of this var is not relevant when `allout-old-style-prefixes'
718 (make-variable-buffer-local 'allout-stylish-prefixes
)
720 (put 'allout-stylish-prefixes
'safe-local-variable
721 (if (fboundp 'booleanp
) 'booleanp
(lambda (x) (member x
'(t nil
)))))
723 ;;;_ = allout-numbered-bullet
724 (defcustom allout-numbered-bullet
"#"
725 "String designating bullet of topics that have auto-numbering; nil for none.
727 Topics having this bullet have automatic maintenance of a sibling
728 sequence-number tacked on, just after the bullet. Conventionally set
729 to \"#\", you can set it to a bullet of your choice. A nil value
730 disables numbering maintenance."
731 :type
'(choice (const nil
) string
)
733 (make-variable-buffer-local 'allout-numbered-bullet
)
735 (put 'allout-numbered-bullet
'safe-local-variable
736 (if (fboundp 'string-or-null-p
)
738 (lambda (x) (or (stringp x
) (null x
)))))
739 ;;;_ = allout-file-xref-bullet
740 (defcustom allout-file-xref-bullet
"@"
741 "Bullet signifying file cross-references, for `allout-resolve-xref'.
743 Set this var to the bullet you want to use for file cross-references."
744 :type
'(choice (const nil
) string
)
747 (put 'allout-file-xref-bullet
'safe-local-variable
748 (if (fboundp 'string-or-null-p
)
750 (lambda (x) (or (stringp x
) (null x
)))))
751 ;;;_ = allout-presentation-padding
752 (defcustom allout-presentation-padding
2
753 "Presentation-format white-space padding factor, for greater indent."
757 (make-variable-buffer-local 'allout-presentation-padding
)
759 (put 'allout-presentation-padding
'safe-local-variable
'integerp
)
761 ;;;_ = allout-flattened-numbering-abbreviation
762 (define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering
763 'allout-flattened-numbering-abbreviation
"24.1")
764 (defcustom allout-flattened-numbering-abbreviation nil
765 "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic
766 numbers to minimal amount with some context. Otherwise, entire
767 numbers are always used."
772 ;;;_ + LaTeX formatting
773 ;;;_ - allout-number-pages
774 (defcustom allout-number-pages nil
775 "Non-nil turns on page numbering for LaTeX formatting of an outline."
778 ;;;_ - allout-label-style
779 (defcustom allout-label-style
"\\large\\bf"
780 "Font and size of labels for LaTeX formatting of an outline."
783 ;;;_ - allout-head-line-style
784 (defcustom allout-head-line-style
"\\large\\sl "
785 "Font and size of entries for LaTeX formatting of an outline."
788 ;;;_ - allout-body-line-style
789 (defcustom allout-body-line-style
" "
790 "Font and size of entries for LaTeX formatting of an outline."
793 ;;;_ - allout-title-style
794 (defcustom allout-title-style
"\\Large\\bf"
795 "Font and size of titles for LaTeX formatting of an outline."
799 (defcustom allout-title
'(or buffer-file-name
(buffer-name))
800 "Expression to evaluate to determine the title for LaTeX formatted copy."
804 ;;;_ - allout-line-skip
805 (defcustom allout-line-skip
".05cm"
806 "Space between lines for LaTeX formatting of an outline."
810 (defcustom allout-indent
".3cm"
811 "LaTeX formatted depth-indent spacing."
815 ;;;_ + Topic encryption
816 ;;;_ = allout-encryption group
817 (defgroup allout-encryption nil
818 "Settings for topic encryption features of allout outliner."
820 ;;;_ = allout-topic-encryption-bullet
821 (defcustom allout-topic-encryption-bullet
"~"
822 "Bullet signifying encryption of the entry's body."
823 :type
'(choice (const nil
) string
)
825 :group
'allout-encryption
)
826 ;;;_ = allout-encrypt-unencrypted-on-saves
827 (defcustom allout-encrypt-unencrypted-on-saves t
828 "If non-nil, topics pending encryption are encrypted during buffer saves.
830 This prevents file-system exposure of un-encrypted contents of
831 items marked for encryption.
833 When non-nil, if the topic currently being edited is decrypted,
834 it will be encrypted for saving but automatically decrypted
835 before any subsequent user interaction, so it is once again clear
836 text for editing though the file system copy is encrypted.
838 \(Auto-saves are handled differently. Buffers with plain-text
839 exposed encrypted topics are exempted from auto saves until all
840 such topics are encrypted.)"
844 :group
'allout-encryption
)
845 (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves
)
846 (defvar allout-auto-save-temporarily-disabled nil
847 "True while topic encryption is pending and auto-saving was active.
849 The value of `buffer-saved-size' at the time of decryption is used,
850 for restoring when all encryptions are established.")
851 (defvar allout-just-did-undo nil
852 "True just after undo commands, until allout-post-command-business.")
853 (make-variable-buffer-local 'allout-just-did-undo
)
856 ;;;_ = allout-developer group
857 (defgroup allout-developer nil
858 "Allout settings developers care about, including topic encryption and more."
860 ;;;_ = allout-run-unit-tests-on-load
861 (defcustom allout-run-unit-tests-on-load nil
862 "When non-nil, unit tests will be run at end of loading the allout module.
864 Generally, allout code developers are the only ones who'll want to set this.
866 \(If set, this makes it an even better practice to exercise changes by
867 doing byte-compilation with a repeat count, so the file is loaded after
870 See `allout-run-unit-tests' to see what's run."
872 :group
'allout-developer
)
874 ;;;_ + Miscellaneous customization
876 ;;;_ = allout-enable-file-variable-adjustment
877 (defcustom allout-enable-file-variable-adjustment t
878 "If non-nil, some allout outline actions edit Emacs local file var text.
880 This can range from changes to existing entries, addition of new ones,
881 and creation of a new local variables section when necessary.
883 Emacs file variables adjustments are also inhibited if `enable-local-variables'
886 Operations potentially causing edits include allout encryption routines.
887 For details, see `allout-toggle-current-subtree-encryption's docstring."
890 (make-variable-buffer-local 'allout-enable-file-variable-adjustment
)
892 ;;;_* CODE -- no user customizations below.
894 ;;;_ #1 Internal Outline Formatting and Configuration
896 ;;;_ = allout-version
897 (defvar allout-version
"2.3"
898 "Version of currently loaded outline package. (allout.el)")
899 ;;;_ > allout-version
900 (defun allout-version (&optional here
)
901 "Return string describing the loaded outline version."
903 (let ((msg (concat "Allout Outline Mode v " allout-version
)))
904 (if here
(insert msg
))
907 ;;;_ : Mode activation (defined here because it's referenced early)
909 (defvar allout-mode nil
"Allout outline mode minor-mode flag.")
910 (make-variable-buffer-local 'allout-mode
)
911 ;;;_ = allout-layout nil
912 (defvar allout-layout nil
; LEAVE GLOBAL VALUE NIL -- see docstring.
913 "Buffer-specific setting for allout layout.
915 In buffers where this is non-nil (and if `allout-auto-activation'
916 has been customized to enable this behavior), `allout-mode' will be
917 automatically activated. The layout dictated by the value will be used to
918 set the initial exposure when `allout-mode' is activated.
920 *You should not setq-default this variable non-nil unless you want every
921 visited file to be treated as an allout file.*
923 The value would typically be set by a file local variable. For
924 example, the following lines at the bottom of an Emacs Lisp file:
927 ;;;allout-layout: (0 : -1 -1 0)
930 dictate activation of `allout-mode' mode when the file is visited
931 \(presuming proper `allout-auto-activation' customization),
932 followed by the equivalent of `(allout-expose-topic 0 : -1 -1 0)'.
933 \(This is the layout used for the allout.el source file.)
935 `allout-default-layout' describes the specification format.
936 `allout-layout' can additionally have the value t, in which
937 case the value of `allout-default-layout' is used.")
938 (make-variable-buffer-local 'allout-layout
)
940 (put 'allout-layout
'safe-local-variable
941 (lambda (x) (or (numberp x
) (listp x
) (memq x
'(: * + -
)))))
943 ;;;_ : Topic header format
945 (defvar allout-regexp
""
946 "Regular expression to match the beginning of a heading line.
948 Any line whose beginning matches this regexp is considered a
949 heading. This var is set according to the user configuration vars
950 by `allout-set-regexp'.")
951 (make-variable-buffer-local 'allout-regexp
)
952 ;;;_ = allout-bullets-string
953 (defvar allout-bullets-string
""
954 "A string dictating the valid set of outline topic bullets.
956 This var should *not* be set by the user -- it is set by `allout-set-regexp',
957 and is produced from the elements of `allout-plain-bullets-string'
958 and `allout-distinctive-bullets-string'.")
959 (make-variable-buffer-local 'allout-bullets-string
)
960 ;;;_ = allout-bullets-string-len
961 (defvar allout-bullets-string-len
0
962 "Length of current buffers' `allout-plain-bullets-string'.")
963 (make-variable-buffer-local 'allout-bullets-string-len
)
964 ;;;_ = allout-depth-specific-regexp
965 (defvar allout-depth-specific-regexp
""
966 "Regular expression to match a heading line prefix for a particular depth.
968 This expression is used to search for depth-specific topic
969 headers at depth 2 and greater. Use `allout-depth-one-regexp'
970 for to seek topics at depth one.
972 This var is set according to the user configuration vars by
973 `allout-set-regexp'. It is prepared with format strings for two
974 decimal numbers, which should each be one less than the depth of the
975 topic prefix to be matched.")
976 (make-variable-buffer-local 'allout-depth-specific-regexp
)
977 ;;;_ = allout-depth-one-regexp
978 (defvar allout-depth-one-regexp
""
979 "Regular expression to match a heading line prefix for depth one.
981 This var is set according to the user configuration vars by
982 `allout-set-regexp'. It is prepared with format strings for two
983 decimal numbers, which should each be one less than the depth of the
984 topic prefix to be matched.")
985 (make-variable-buffer-local 'allout-depth-one-regexp
)
986 ;;;_ = allout-line-boundary-regexp
987 (defvar allout-line-boundary-regexp
()
988 "`allout-regexp' prepended with a newline for the search target.
990 This is properly set by `allout-set-regexp'.")
991 (make-variable-buffer-local 'allout-line-boundary-regexp
)
992 ;;;_ = allout-bob-regexp
993 (defvar allout-bob-regexp
()
994 "Like `allout-line-boundary-regexp', for headers at beginning of buffer.")
995 (make-variable-buffer-local 'allout-bob-regexp
)
996 ;;;_ = allout-header-subtraction
997 (defvar allout-header-subtraction
(1- (length allout-header-prefix
))
998 "Allout-header prefix length to subtract when computing topic depth.")
999 (make-variable-buffer-local 'allout-header-subtraction
)
1000 ;;;_ = allout-plain-bullets-string-len
1001 (defvar allout-plain-bullets-string-len
(length allout-plain-bullets-string
)
1002 "Length of `allout-plain-bullets-string', updated by `allout-set-regexp'.")
1003 (make-variable-buffer-local 'allout-plain-bullets-string-len
)
1005 ;;;_ = allout-doublecheck-at-and-shallower
1006 (defconst allout-doublecheck-at-and-shallower
3
1007 "Validate apparent topics of this depth and shallower as being non-aberrant.
1009 Verified with `allout-aberrant-container-p'. The usefulness of
1010 this check is limited to shallow depths, because the
1011 determination of aberrance is according to the mistaken item
1012 being followed by a legitimate item of excessively greater depth.
1014 The classic example of a mistaken item, for a standard allout
1015 outline configuration, is a body line that begins with an `...'
1016 ellipsis. This happens to contain a legitimate depth-2 header
1017 prefix, constituted by two `..' dots at the beginning of the
1018 line. The only thing that can distinguish it *in principle* from
1019 a legitimate one is if the following real header is at a depth
1020 that is discontinuous from the depth of 2 implied by the
1021 ellipsis, ie depth 4 or more. As the depth being tested gets
1022 greater, the likelihood of this kind of disqualification is
1023 lower, and the usefulness of this test is lower.
1025 Extending the depth of the doublecheck increases the amount it is
1026 applied, increasing the cost of the test - on casual estimation,
1027 for outlines with many deep topics, geometrically (O(n)?).
1028 Taken together with decreasing likelihood that the test will be
1029 useful at greater depths, more modest doublecheck limits are more
1030 suitably economical.")
1031 ;;;_ X allout-reset-header-lead (header-lead)
1032 (defun allout-reset-header-lead (header-lead)
1033 "Reset the leading string used to identify topic headers."
1034 (interactive "sNew lead string: ")
1035 (setq allout-header-prefix header-lead
)
1036 (setq allout-header-subtraction
(1- (length allout-header-prefix
)))
1037 (allout-set-regexp))
1038 ;;;_ X allout-lead-with-comment-string (header-lead)
1039 (defun allout-lead-with-comment-string (&optional header-lead
)
1040 "Set the topic-header leading string to specified string.
1042 Useful for encapsulating outline structure in programming
1043 language comments. Returns the leading string."
1046 (if (not (stringp header-lead
))
1047 (setq header-lead
(read-string
1048 "String prefix for topic headers: ")))
1049 (setq allout-reindent-bodies nil
)
1050 (allout-reset-header-lead header-lead
)
1052 ;;;_ > allout-infer-header-lead-and-primary-bullet ()
1053 (defun allout-infer-header-lead-and-primary-bullet ()
1054 "Determine appropriate `allout-header-prefix' and `allout-primary-bullet'.
1056 Works according to settings of:
1059 `allout-header-prefix' (default)
1060 `allout-use-mode-specific-leader'
1061 and `allout-mode-leaders'.
1063 Apply this via (re)activation of `allout-mode', rather than
1064 invoking it directly."
1065 (let* ((use-leader (and (boundp 'allout-use-mode-specific-leader
)
1066 (if (or (stringp allout-use-mode-specific-leader
)
1067 (memq allout-use-mode-specific-leader
1068 '(allout-mode-leaders
1071 allout-use-mode-specific-leader
1072 ;; Oops -- garbled value, equate with effect of t:
1076 ((not use-leader
) nil
)
1077 ;; Use the explicitly designated leader:
1078 ((stringp use-leader
) use-leader
)
1079 (t (or (and (memq use-leader
'(t allout-mode-leaders
))
1080 ;; Get it from outline mode leaders?
1081 (cdr (assq major-mode allout-mode-leaders
)))
1082 ;; ... didn't get from allout-mode-leaders...
1083 (and (memq use-leader
'(t comment-start
))
1085 ;; Use comment-start, maybe tripled, and with
1089 (substring comment-start
1090 (1- (length comment-start
))))
1091 ;; Use comment-start, sans trailing space:
1092 (substring comment-start
0 -
1)
1093 (concat comment-start comment-start comment-start
))
1094 ;; ... and append underscore, whichever:
1098 (setq allout-header-prefix leader
)
1099 (if (not allout-old-style-prefixes
)
1100 ;; setting allout-primary-bullet makes the top level topics use --
1101 ;; actually, be -- the special prefix:
1102 (setq allout-primary-bullet leader
))
1103 allout-header-prefix
)))
1104 (defalias 'allout-infer-header-lead
1105 'allout-infer-header-lead-and-primary-bullet
)
1106 ;;;_ > allout-infer-body-reindent ()
1107 (defun allout-infer-body-reindent ()
1108 "Determine proper setting for `allout-reindent-bodies'.
1110 Depends on default setting of `allout-reindent-bodies' (which see)
1111 and presence of setting for `comment-start', to tell whether the
1112 file is programming code."
1113 (if (and allout-reindent-bodies
1115 (not (eq 'force allout-reindent-bodies
)))
1116 (setq allout-reindent-bodies nil
)))
1117 ;;;_ > allout-set-regexp ()
1118 (defun allout-set-regexp ()
1119 "Generate proper topic-header regexp form for outline functions.
1121 Works with respect to `allout-plain-bullets-string' and
1122 `allout-distinctive-bullets-string'.
1124 Also refresh various data structures that hinge on the regexp."
1127 ;; Derive allout-bullets-string from user configured components:
1128 (setq allout-bullets-string
"")
1129 (let ((strings (list 'allout-plain-bullets-string
1130 'allout-distinctive-bullets-string
1131 'allout-primary-bullet
))
1138 (setq cur-len
(length (setq cur-string
(symbol-value (car strings
)))))
1139 (while (< index cur-len
)
1140 (setq cur-char
(aref cur-string index
))
1141 (setq allout-bullets-string
1142 (concat allout-bullets-string
1144 ; Single dash would denote a
1145 ; sequence, repeated denotes
1147 ((eq cur-char ?-
) "--")
1148 ; literal close-square-bracket
1149 ; doesn't work right in the
1151 ((eq cur-char ?\
]) "")
1152 (t (regexp-quote (char-to-string cur-char
))))))
1153 (setq index
(1+ index
)))
1154 (setq strings
(cdr strings
)))
1156 ;; Derive next for repeated use in allout-pending-bullet:
1157 (setq allout-plain-bullets-string-len
(length allout-plain-bullets-string
))
1158 (setq allout-header-subtraction
(1- (length allout-header-prefix
)))
1160 (let (new-part old-part formfeed-part
)
1161 (setq new-part
(concat "\\("
1162 (regexp-quote allout-header-prefix
)
1164 ;; already regexp-quoted in a custom way:
1165 "[" allout-bullets-string
"]"
1167 old-part
(concat "\\("
1168 (regexp-quote allout-primary-bullet
)
1170 (regexp-quote allout-header-prefix
)
1173 " ?[^" allout-primary-bullet
"]")
1174 formfeed-part
"\\(\^L\\)"
1176 allout-regexp
(concat new-part
1182 allout-line-boundary-regexp
(concat "\n" new-part
1188 allout-bob-regexp
(concat "\\`" new-part
1195 (setq allout-depth-specific-regexp
1196 (concat "\\(^\\|\\`\\)"
1199 ;; new-style spacers-then-bullet string:
1201 (allout-format-quote (regexp-quote allout-header-prefix
))
1203 "[" (allout-format-quote allout-bullets-string
) "]"
1206 ;; old-style all-bullets string, if primary not multi-char:
1207 (if (< 0 allout-header-subtraction
)
1210 (allout-format-quote
1211 (regexp-quote allout-primary-bullet
))
1212 (allout-format-quote
1213 (regexp-quote allout-primary-bullet
))
1214 (allout-format-quote
1215 (regexp-quote allout-primary-bullet
))
1217 ;; disqualify greater depths:
1219 (allout-format-quote allout-primary-bullet
)
1224 (setq allout-depth-one-regexp
1225 (concat "\\(^\\|\\`\\)"
1229 (regexp-quote allout-header-prefix
)
1230 ;; disqualify any bullet char following any amount of
1231 ;; intervening whitespace:
1233 (concat "[^ " allout-bullets-string
"]")
1235 (if (< 0 allout-header-subtraction
)
1236 ;; Need not support anything like the old
1237 ;; bullet style if the prefix is multi-char.
1240 (regexp-quote allout-primary-bullet
)
1241 ;; disqualify deeper primary-bullet sequences:
1242 "[^" allout-primary-bullet
"]"))
1245 (define-obsolete-function-alias 'set-allout-regexp
'allout-set-regexp
"26.1")
1247 (defvar allout-mode-exposure-menu
)
1248 (defvar allout-mode-editing-menu
)
1249 (defvar allout-mode-navigation-menu
)
1250 (defvar allout-mode-misc-menu
)
1251 (defun allout-produce-mode-menubar-entries ()
1253 (easy-menu-define allout-mode-exposure-menu
1254 allout-mode-map-value
1255 "Allout outline exposure menu."
1257 ["Show Entry" allout-show-current-entry t
]
1258 ["Show Children" allout-show-children t
]
1259 ["Show Subtree" allout-show-current-subtree t
]
1260 ["Hide Subtree" allout-hide-current-subtree t
]
1261 ["Hide Leaves" allout-hide-current-leaves t
]
1263 ["Show All" allout-show-all t
]))
1264 (easy-menu-define allout-mode-editing-menu
1265 allout-mode-map-value
1266 "Allout outline editing menu."
1268 ["Open Sibling" allout-open-sibtopic t
]
1269 ["Open Subtopic" allout-open-subtopic t
]
1270 ["Open Supertopic" allout-open-supertopic t
]
1272 ["Shift Topic In" allout-shift-in t
]
1273 ["Shift Topic Out" allout-shift-out t
]
1274 ["Rebullet Topic" allout-rebullet-topic t
]
1275 ["Rebullet Heading" allout-rebullet-current-heading t
]
1276 ["Number Siblings" allout-number-siblings t
]
1278 ["Toggle Topic Encryption"
1279 allout-toggle-current-subtree-encryption
1280 (> (allout-current-depth) 1)]))
1281 (easy-menu-define allout-mode-navigation-menu
1282 allout-mode-map-value
1283 "Allout outline navigation menu."
1285 ["Next Visible Heading" allout-next-visible-heading t
]
1286 ["Previous Visible Heading"
1287 allout-previous-visible-heading t
]
1289 ["Up Level" allout-up-current-level t
]
1290 ["Forward Current Level" allout-forward-current-level t
]
1291 ["Backward Current Level"
1292 allout-backward-current-level t
]
1294 ["Beginning of Entry"
1295 allout-beginning-of-current-entry t
]
1296 ["End of Entry" allout-end-of-entry t
]
1297 ["End of Subtree" allout-end-of-current-subtree t
]))
1298 (easy-menu-define allout-mode-misc-menu
1299 allout-mode-map-value
1300 "Allout outlines miscellaneous bindings."
1302 ["Version" allout-version t
]
1304 ["Duplicate Exposed" allout-copy-exposed-to-buffer t
]
1305 ["Duplicate Exposed, numbered"
1306 allout-flatten-exposed-to-buffer t
]
1307 ["Duplicate Exposed, indented"
1308 allout-indented-exposed-to-buffer t
]
1310 ["Set Header Lead" allout-reset-header-lead t
]
1311 ["Set New Exposure" allout-expose-topic t
])))
1312 ;;;_ : Allout Modal-Variables Utilities
1313 ;;;_ = allout-mode-prior-settings
1314 (defvar allout-mode-prior-settings nil
1315 "Internal `allout-mode' use; settings to be resumed on mode deactivation.
1317 See `allout-add-resumptions' and `allout-do-resumptions'.")
1318 (make-variable-buffer-local 'allout-mode-prior-settings
)
1319 ;;;_ > allout-add-resumptions (&rest pairs)
1320 (defun allout-add-resumptions (&rest pairs
)
1321 "Set name/value PAIRS.
1323 Old settings are preserved for later resumption using `allout-do-resumptions'.
1325 The new values are set as a buffer local. On resumption, the prior buffer
1326 scope of the variable is restored along with its value. If it was a void
1327 buffer-local value, then it is left as nil on resumption.
1329 The pairs are lists whose car is the name of the variable and car of the
1330 cdr is the new value: `(some-var some-value)'. The pairs can actually be
1331 triples, where the third element qualifies the disposition of the setting,
1332 as described further below.
1334 If the optional third element is the symbol `extend', then the new value
1335 created by `cons'ing the second element of the pair onto the front of the
1338 If the optional third element is the symbol `append', then the new value is
1339 extended from the existing one by `append'ing a list containing the second
1340 element of the pair onto the end of the existing value.
1342 Extension, and resumptions in general, should not be used for hook
1343 functions -- use the `local' mode of `add-hook' for that, instead.
1345 The settings are stored on `allout-mode-prior-settings'."
1347 (let* ((pair (pop pairs
))
1350 (qualifier (if (> (length pair
) 2)
1353 (if (not (symbolp name
))
1354 (error "Pair's name, %S, must be a symbol, not %s"
1355 name
(type-of name
)))
1356 (setq prior-value
(condition-case nil
1358 (void-variable nil
)))
1359 (when (not (assoc name allout-mode-prior-settings
))
1360 ;; Not already added as a resumption, create the prior setting entry.
1361 (if (local-variable-p name
(current-buffer))
1362 ;; is already local variable -- preserve the prior value:
1363 (push (list name prior-value
) allout-mode-prior-settings
)
1364 ;; wasn't local variable, indicate so for resumption by killing
1365 ;; local value, and make it local:
1366 (push (list name
) allout-mode-prior-settings
)
1367 (make-local-variable name
)))
1369 (cond ((eq qualifier
'extend
)
1370 (if (not (listp prior-value
))
1371 (error "extension of non-list prior value attempted")
1372 (set name
(cons value prior-value
))))
1373 ((eq qualifier
'append
)
1374 (if (not (listp prior-value
))
1375 (error "appending of non-list prior value attempted")
1376 (set name
(append prior-value
(list value
)))))
1377 (t (error "unrecognized setting qualifier `%s' encountered"
1379 (set name value
)))))
1380 ;;;_ > allout-do-resumptions ()
1381 (defun allout-do-resumptions ()
1382 "Resume all name/value settings registered by `allout-add-resumptions'.
1384 This is used when concluding allout-mode, to resume selected variables to
1385 their settings before allout-mode was started."
1387 (while allout-mode-prior-settings
1388 (let* ((pair (pop allout-mode-prior-settings
))
1390 (value-cell (cdr pair
)))
1391 (if (not value-cell
)
1392 ;; Prior value was global:
1393 (kill-local-variable name
)
1394 ;; Prior value was explicit:
1395 (set name
(car value-cell
))))))
1396 ;;;_ : Mode-specific incidentals
1397 ;;;_ > allout-unprotected (expr)
1398 (defmacro allout-unprotected
(expr)
1399 "Enable internal outline operations to alter invisible text."
1400 `(let ((inhibit-read-only (if (not buffer-read-only
) t
))
1401 (inhibit-field-text-motion t
))
1403 ;;;_ = allout-mode-hook
1404 (defvar allout-mode-hook nil
1405 "Hook run when allout mode starts.")
1406 ;;;_ = allout-mode-deactivate-hook
1407 (define-obsolete-variable-alias 'allout-mode-deactivate-hook
1408 'allout-mode-off-hook
"24.1")
1409 (defvar allout-mode-deactivate-hook nil
1410 "Hook run when allout mode ends.")
1411 ;;;_ = allout-exposure-category
1412 (defvar allout-exposure-category nil
1413 "Symbol for use as allout invisible-text overlay category.")
1415 ;;;_ = allout-exposure-change-functions
1416 (define-obsolete-variable-alias 'allout-exposure-change-hook
1417 'allout-exposure-change-functions
"24.3")
1418 (defcustom allout-exposure-change-functions nil
1419 "Abnormal hook run after allout outline subtree exposure changes.
1420 It is run at the conclusion of `allout-flag-region'.
1422 Functions on the hook must take three arguments:
1424 - FROM -- integer indicating the point at the start of the change.
1425 - TO -- integer indicating the point of the end of the change.
1426 - FLAG -- change mode: nil for exposure, otherwise concealment.
1428 This hook might be invoked multiple times by a single command."
1433 ;;;_ = allout-structure-added-functions
1434 (define-obsolete-variable-alias 'allout-structure-added-hook
1435 'allout-structure-added-functions
"24.3")
1436 (defcustom allout-structure-added-functions nil
1437 "Abnormal hook run after adding items to an Allout outline.
1438 Functions on the hook should take two arguments:
1440 - NEW-START -- integer indicating position of start of the first new item.
1441 - NEW-END -- integer indicating position of end of the last new item.
1443 This hook might be invoked multiple times by a single command."
1448 ;;;_ = allout-structure-deleted-functions
1449 (define-obsolete-variable-alias 'allout-structure-deleted-hook
1450 'allout-structure-deleted-functions
"24.3")
1451 (defcustom allout-structure-deleted-functions nil
1452 "Abnormal hook run after deleting subtrees from an Allout outline.
1453 Functions on the hook must take two arguments:
1455 - DEPTH -- integer indicating the depth of the subtree that was deleted.
1456 - REMOVED-FROM -- integer indicating the point where the subtree was removed.
1458 Some edits that remove or invalidate items may be missed by this hook:
1459 specifically edits that native allout routines do not control.
1461 This hook might be invoked multiple times by a single command."
1466 ;;;_ = allout-structure-shifted-functions
1467 (define-obsolete-variable-alias 'allout-structure-shifted-hook
1468 'allout-structure-shifted-functions
"24.3")
1469 (defcustom allout-structure-shifted-functions nil
1470 "Abnormal hook run after shifting items in an Allout outline.
1471 Functions on the hook should take two arguments:
1473 - DEPTH-CHANGE -- integer indicating depth increase, negative for decrease
1474 - START -- integer indicating the start point of the shifted parent item.
1476 Some edits that shift items can be missed by this hook: specifically edits
1477 that native allout routines do not control.
1479 This hook might be invoked multiple times by a single command."
1484 ;;;_ = allout-after-copy-or-kill-hook
1485 (defcustom allout-after-copy-or-kill-hook nil
1486 "Normal hook run after copying outline text.."
1491 ;;;_ = allout-post-undo-hook
1492 (defcustom allout-post-undo-hook nil
1493 "Normal hook run after undo activity.
1494 The item that's current when the hook is run *may* be the one
1495 that was affected by the undo.."
1500 ;;;_ = allout-outside-normal-auto-fill-function
1501 (defvar allout-outside-normal-auto-fill-function nil
1502 "Value of `normal-auto-fill-function' outside of allout mode.
1504 Used by `allout-auto-fill' to do the mandated `normal-auto-fill-function'
1505 wrapped within allout's automatic `fill-prefix' setting.")
1506 (make-variable-buffer-local 'allout-outside-normal-auto-fill-function
)
1507 ;;;_ = prevent redundant activation by desktop mode:
1508 (add-to-list 'desktop-minor-mode-handlers
'(allout-mode . nil
))
1509 ;;;_ = allout-after-save-decrypt
1510 (defvar allout-after-save-decrypt nil
1511 "Internal variable, is nil or has the value of two points:
1513 - the location of a topic to be decrypted after saving is done
1514 - where to situate the cursor after the decryption is performed
1516 This is used to decrypt the topic that was currently being edited, if it
1517 was encrypted automatically as part of a file write or autosave.")
1518 (make-variable-buffer-local 'allout-after-save-decrypt
)
1519 ;;;_ = allout-encryption-plaintext-sanitization-regexps
1520 (defvar allout-encryption-plaintext-sanitization-regexps nil
1521 "List of regexps whose matches are removed from plaintext before encryption.
1523 This is for the sake of removing artifacts, like escapes, that are added on
1524 and not actually part of the original plaintext. The removal is done just
1525 prior to encryption.
1527 Entries must be symbols that are bound to the desired values.
1529 Each value can be a regexp or a list with a regexp followed by a
1530 substitution string. If it's just a regexp, all its matches are removed
1531 before the text is encrypted. If it's a regexp and a substitution, the
1532 substitution is used against the regexp matches, a la `replace-match'.")
1533 (make-variable-buffer-local 'allout-encryption-plaintext-sanitization-regexps
)
1534 ;;;_ = allout-encryption-ciphertext-rejection-regexps
1535 (defvar allout-encryption-ciphertext-rejection-regexps nil
1536 "Variable for regexps matching plaintext to remove before encryption.
1538 This is used to detect strings in encryption results that would
1539 register as allout mode structural elements, for example, as a
1542 Entries must be symbols that are bound to the desired regexp values.
1544 Encryptions that result in matches will be retried, up to
1545 `allout-encryption-ciphertext-rejection-limit' times, after which
1546 an error is raised.")
1548 (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps
)
1549 ;;;_ = allout-encryption-ciphertext-rejection-ceiling
1550 (defvar allout-encryption-ciphertext-rejection-ceiling
5
1551 "Limit on number of times encryption ciphertext is rejected.
1553 See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
1554 (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling
)
1555 ;;;_ > allout-mode-p ()
1556 ;; Must define this macro above any uses, or byte compilation will lack
1557 ;; proper def, if file isn't loaded -- eg, during emacs build!
1559 (defmacro allout-mode-p
()
1560 "Return t if `allout-mode' is active in current buffer."
1562 ;;;_ > allout-write-contents-hook-handler ()
1563 (defun allout-write-contents-hook-handler ()
1564 "Implement `allout-encrypt-unencrypted-on-saves' for file writes
1566 Return nil if all goes smoothly, or else return an informative
1567 message if an error is encountered. The message will serve as a
1568 non-nil return on `write-contents-functions' to prevent saving of
1569 the buffer while it has decrypted content.
1571 This behavior depends on Emacs versions that implement the
1572 `write-contents-functions' hook."
1574 (if (or (not (allout-mode-p))
1575 (not (boundp 'allout-encrypt-unencrypted-on-saves
))
1576 (not allout-encrypt-unencrypted-on-saves
))
1578 (if (save-excursion (goto-char (point-min))
1579 (allout-next-topic-pending-encryption))
1581 (message "auto-encrypting pending topics")
1583 (condition-case failure
1585 (setq allout-after-save-decrypt
1586 (allout-encrypt-decrypted))
1587 ;; aok - return nil:
1590 ;; whoops - probably some still-decrypted items, return non-nil:
1591 (let ((text (format (concat "%s contents write inhibited due to"
1592 " encrypted topic encryption error:"
1594 (buffer-name (current-buffer))
1596 (message text
)(sit-for 2)
1599 ;;;_ > allout-after-saves-handler ()
1600 (defun allout-after-saves-handler ()
1601 "Decrypt topic encrypted for save, if it's currently being edited.
1603 Ie, if it was pending encryption and contained the point in its body before
1606 We use values stored in `allout-after-save-decrypt' to locate the topic
1607 and the place for the cursor after the decryption is done."
1608 (if (not (and (allout-mode-p)
1609 (boundp 'allout-after-save-decrypt
)
1610 allout-after-save-decrypt
))
1612 (goto-char (car allout-after-save-decrypt
))
1613 (let ((was-modified (buffer-modified-p)))
1614 (allout-toggle-subtree-encryption)
1615 (if (not was-modified
)
1616 (set-buffer-modified-p nil
)))
1617 (goto-char (cadr allout-after-save-decrypt
))
1618 (setq allout-after-save-decrypt nil
))
1620 ;;;_ > allout-called-interactively-p ()
1621 (defmacro allout-called-interactively-p
()
1622 "A version of `called-interactively-p' independent of Emacs version."
1623 ;; ... to ease maintenance of allout without betraying deprecation.
1624 (if (ignore-errors (called-interactively-p 'interactive
) t
)
1625 '(called-interactively-p 'interactive
)
1626 '(called-interactively-p)))
1627 ;;;_ = allout-inhibit-aberrance-doublecheck nil
1628 ;; In some exceptional moments, disparate topic depths need to be allowed
1629 ;; momentarily, eg when one topic is being yanked into another and they're
1630 ;; about to be reconciled. let-binding allout-inhibit-aberrance-doublecheck
1631 ;; prevents the aberrance doublecheck to allow, eg, the reconciliation
1632 ;; processing to happen in the presence of such discrepancies. It should
1633 ;; almost never be needed, however.
1634 (defvar allout-inhibit-aberrance-doublecheck nil
1635 "Internal state, for momentarily inhibits aberrance doublecheck.
1637 This should only be momentarily let-bound non-nil, not set
1638 non-nil in a lasting way.")
1640 ;;;_ #2 Mode environment and activation
1641 ;;;_ = allout-explicitly-deactivated
1642 (defvar allout-explicitly-deactivated nil
1643 "If t, `allout-mode's last deactivation was deliberate.
1644 So `allout-post-command-business' should not reactivate it...")
1645 (make-variable-buffer-local 'allout-explicitly-deactivated
)
1646 ;;;_ > allout-init (mode)
1647 (defun allout-init (mode)
1648 "DEPRECATED - configure allout activation by customizing
1649 `allout-auto-activation'. This function remains around, limited
1650 from what it did before, for backwards compatibility.
1652 MODE is the activation mode - see `allout-auto-activation' for
1654 (declare (obsolete allout-auto-activation
"23.3"))
1655 (customize-set-variable 'allout-auto-activation
(format "%s" mode
))
1658 ;;;_ > allout-setup-menubar ()
1659 (defun allout-setup-menubar ()
1660 "Populate the current buffer's menubar with `allout-mode' stuff."
1661 (let ((menus (list allout-mode-exposure-menu
1662 allout-mode-editing-menu
1663 allout-mode-navigation-menu
1664 allout-mode-misc-menu
))
1667 (setq cur
(car menus
)
1669 (easy-menu-add cur
))))
1670 ;;;_ > allout-overlay-preparations
1671 (defun allout-overlay-preparations ()
1672 "Set the properties of the allout invisible-text overlay and others."
1673 (setplist 'allout-exposure-category nil
)
1674 (put 'allout-exposure-category
'invisible
'allout
)
1675 (put 'allout-exposure-category
'evaporate t
)
1676 ;; ??? We use isearch-open-invisible *and* isearch-mode-end-hook. The
1677 ;; latter would be sufficient, but it seems that a separate behavior --
1678 ;; the _transient_ opening of invisible text during isearch -- is keyed to
1679 ;; presence of the isearch-open-invisible property -- even though this
1680 ;; property controls the isearch _arrival_ behavior. This is the case at
1681 ;; least in emacs 21, 22.1, and xemacs 21.4.
1682 (put 'allout-exposure-category
'isearch-open-invisible
1683 'allout-isearch-end-handler
)
1684 (if (featurep 'xemacs
)
1685 (put 'allout-exposure-category
'start-open t
)
1686 (put 'allout-exposure-category
'insert-in-front-hooks
1687 '(allout-overlay-insert-in-front-handler)))
1688 (put 'allout-exposure-category
'modification-hooks
1689 '(allout-overlay-interior-modification-handler)))
1690 ;;;_ > define-minor-mode allout-mode
1693 (define-minor-mode allout-mode
1695 "Toggle Allout outline mode.
1696 With a prefix argument ARG, enable Allout outline mode if ARG is
1697 positive, and disable it otherwise. If called from Lisp, enable
1698 the mode if ARG is omitted or nil.
1700 \\<allout-mode-map-value>
1701 Allout outline mode is a minor mode that provides extensive
1702 outline oriented formatting and manipulation. It enables
1703 structural editing of outlines, as well as navigation and
1704 exposure. It also is specifically aimed at accommodating
1705 syntax-sensitive text like programming languages. (For example,
1706 see the allout code itself, which is organized as an allout
1709 In addition to typical outline navigation and exposure, allout includes:
1711 - topic-oriented authoring, including keystroke-based topic creation,
1712 repositioning, promotion/demotion, cut, and paste
1713 - incremental search with dynamic exposure and reconcealment of hidden text
1714 - adjustable format, so programming code can be developed in outline-structure
1715 - easy topic encryption and decryption, symmetric or key-pair
1716 - \"Hot-spot\" operation, for single-keystroke maneuvering and exposure control
1717 - integral outline layout, for automatic initial exposure when visiting a file
1718 - independent extensibility, using comprehensive exposure and authoring hooks
1720 and many other features.
1722 Below is a description of the key bindings, and then description
1723 of special `allout-mode' features and terminology. See also the
1724 outline menubar additions for quick reference to many of the
1725 features. Customize `allout-auto-activation' to prepare your
1726 Emacs session for automatic activation of `allout-mode'.
1728 The bindings are those listed in `allout-prefixed-keybindings'
1729 and `allout-unprefixed-keybindings'. We recommend customizing
1730 `allout-command-prefix' to use just `\\C-c' as the command
1731 prefix, if the allout bindings don't conflict with any personal
1732 bindings you have on \\C-c. In any case, outline structure
1733 navigation and authoring is simplified by positioning the cursor
1734 on an item's bullet character, the \"hot-spot\" -- then you can
1735 invoke allout commands with just the un-prefixed,
1736 un-control-shifted command letters. This is described further in
1737 the HOT-SPOT Operation section.
1741 \\[allout-hide-current-subtree] `allout-hide-current-subtree'
1742 \\[allout-show-children] `allout-show-children'
1743 \\[allout-show-current-subtree] `allout-show-current-subtree'
1744 \\[allout-show-current-entry] `allout-show-current-entry'
1745 \\[allout-show-all] `allout-show-all'
1749 \\[allout-next-visible-heading] `allout-next-visible-heading'
1750 \\[allout-previous-visible-heading] `allout-previous-visible-heading'
1751 \\[allout-up-current-level] `allout-up-current-level'
1752 \\[allout-forward-current-level] `allout-forward-current-level'
1753 \\[allout-backward-current-level] `allout-backward-current-level'
1754 \\[allout-end-of-entry] `allout-end-of-entry'
1755 \\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot)
1756 \\[allout-beginning-of-line] `allout-beginning-of-line' -- like regular beginning-of-line, but
1757 if immediately repeated cycles to the beginning of the current item
1758 and then to the hot-spot (if `allout-beginning-of-line-cycles' is set).
1761 Topic Header Production:
1762 -----------------------
1763 \\[allout-open-sibtopic] `allout-open-sibtopic' Create a new sibling after current topic.
1764 \\[allout-open-subtopic] `allout-open-subtopic' ... an offspring of current topic.
1765 \\[allout-open-supertopic] `allout-open-supertopic' ... a sibling of the current topic's parent.
1767 Topic Level and Prefix Adjustment:
1768 ---------------------------------
1769 \\[allout-shift-in] `allout-shift-in' Shift current topic and all offspring deeper
1770 \\[allout-shift-out] `allout-shift-out' ... less deep
1771 \\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for
1773 \\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and
1774 its offspring -- distinctive bullets are not changed, others
1775 are alternated according to nesting depth.
1776 \\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings --
1777 the offspring are not affected.
1778 With repeat count, revoke numbering.
1780 Topic-oriented Killing and Yanking:
1781 ----------------------------------
1782 \\[allout-kill-topic] `allout-kill-topic' Kill current topic, including offspring.
1783 \\[allout-copy-topic-as-kill] `allout-copy-topic-as-kill' Copy current topic, including offspring.
1784 \\[allout-kill-line] `allout-kill-line' Kill line, attending to outline structure.
1785 \\[allout-copy-line-as-kill] `allout-copy-line-as-kill' Copy line but don't delete it.
1786 \\[allout-yank] `allout-yank' Yank, adjusting depth of yanked topic to
1787 depth of heading if yanking into bare topic
1788 heading (ie, prefix sans text).
1789 \\[allout-yank-pop] `allout-yank-pop' Is to `allout-yank' as `yank-pop' is to `yank'.
1791 Topic-oriented Encryption:
1792 -------------------------
1793 \\[allout-toggle-current-subtree-encryption] `allout-toggle-current-subtree-encryption'
1794 Encrypt/Decrypt topic content
1798 M-x outlineify-sticky Activate outline mode for current buffer,
1799 and establish a default file-var setting
1800 for `allout-layout'.
1801 \\[allout-mark-topic] `allout-mark-topic'
1802 \\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer'
1803 Duplicate outline, sans concealed text, to
1804 buffer with name derived from derived from that
1805 of current buffer -- \"*BUFFERNAME exposed*\".
1806 \\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer'
1807 Like above `copy-exposed', but convert topic
1808 prefixes to section.subsection... numeric
1810 \\[customize-variable] allout-auto-activation
1811 Prepare Emacs session for allout outline mode
1816 Outline mode supports gpg encryption of topics, with support for
1817 symmetric and key-pair modes, and auto-encryption of topics
1818 pending encryption on save.
1820 Topics pending encryption are, by default, automatically
1821 encrypted during file saves, including checkpoint saves, to avoid
1822 exposing the plain text of encrypted topics in the file system.
1823 If the content of the topic containing the cursor was encrypted
1824 for a save, it is automatically decrypted for continued editing.
1826 NOTE: A few GnuPG v2 versions improperly preserve incorrect
1827 symmetric decryption keys, preventing entry of the correct key on
1828 subsequent decryption attempts until the cache times-out. That
1829 can take several minutes. (Decryption of other entries is not
1830 affected.) Upgrade your EasyPG version, if you can, and you can
1831 deliberately clear your gpg-agent's cache by sending it a `-HUP'
1834 See `allout-toggle-current-subtree-encryption' function docstring
1835 and `allout-encrypt-unencrypted-on-saves' customization variable
1840 Hot-spot operation provides a means for easy, single-keystroke outline
1841 navigation and exposure control.
1843 When the text cursor is positioned directly on the bullet character of
1844 a topic, regular characters (a to z) invoke the commands of the
1845 corresponding allout-mode keymap control chars. For example, \"f\"
1846 would invoke the command typically bound to \"C-c<space>C-f\"
1847 \(\\[allout-forward-current-level] `allout-forward-current-level').
1849 Thus, by positioning the cursor on a topic bullet, you can
1850 execute the outline navigation and manipulation commands with a
1851 single keystroke. Regular navigation keys (eg, \\[forward-char], \\[next-line]) don't get
1852 this special translation, so you can use them to get out of the
1853 hot-spot and back to normal editing operation.
1855 In allout-mode, the normal beginning-of-line command (\\[allout-beginning-of-line]) is
1856 replaced with one that makes it easy to get to the hot-spot. If you
1857 repeat it immediately it cycles (if `allout-beginning-of-line-cycles'
1858 is set) to the beginning of the item and then, if you hit it again
1859 immediately, to the hot-spot. Similarly, `allout-beginning-of-current-entry'
1860 \(\\[allout-beginning-of-current-entry]) moves to the hot-spot when the cursor is already located
1861 at the beginning of the current entry.
1865 Allout exposure and authoring activities all have associated
1866 hooks, by which independent code can cooperate with allout
1867 without changes to the allout core. Here are key ones:
1870 `allout-mode-deactivate-hook' (deprecated)
1871 `allout-mode-off-hook'
1872 `allout-exposure-change-functions'
1873 `allout-structure-added-functions'
1874 `allout-structure-deleted-functions'
1875 `allout-structure-shifted-functions'
1876 `allout-after-copy-or-kill-hook'
1877 `allout-post-undo-hook'
1881 Topic hierarchy constituents -- TOPICS and SUBTOPICS:
1883 ITEM: A unitary outline element, including the HEADER and ENTRY text.
1884 TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH
1885 and with no intervening items of lower DEPTH than the container.
1887 The visible ITEM most immediately containing the cursor.
1888 DEPTH: The degree of nesting of an ITEM; it increases with containment.
1889 The DEPTH is determined by the HEADER PREFIX. The DEPTH is also
1891 LEVEL: The same as DEPTH.
1894 Those ITEMs whose TOPICs contain an ITEM.
1895 PARENT: An ITEM's immediate ANCESTOR. It has a DEPTH one less than that
1898 The ITEMs contained within an ITEM's TOPIC.
1900 An OFFSPRING of its ANCESTOR TOPICs.
1902 An immediate SUBTOPIC of its PARENT.
1904 TOPICs having the same PARENT and DEPTH.
1906 Topic text constituents:
1908 HEADER: The first line of an ITEM, include the ITEM PREFIX and HEADER
1910 ENTRY: The text content of an ITEM, before any OFFSPRING, but including
1911 the HEADER text and distinct from the ITEM PREFIX.
1912 BODY: Same as ENTRY.
1913 PREFIX: The leading text of an ITEM which distinguishes it from normal
1914 ENTRY text. Allout recognizes the outline structure according
1915 to the strict PREFIX format. It consists of a PREFIX-LEAD string,
1916 PREFIX-PADDING, and a BULLET. The BULLET might be followed by a
1917 number, indicating the ordinal number of the topic among its
1918 siblings, or an asterisk indicating encryption, plus an optional
1919 space. After that is the ITEM HEADER text, which is not part of
1922 The relative length of the PREFIX determines the nesting DEPTH
1925 The string at the beginning of a HEADER PREFIX, by default a `.'.
1926 It can be customized by changing the setting of
1927 `allout-header-prefix' and then reinitializing `allout-mode'.
1929 When the PREFIX-LEAD is set to the comment-string of a
1930 programming language, outline structuring can be embedded in
1931 program code without interfering with processing of the text
1932 (by Emacs or the language processor) as program code. This
1933 setting happens automatically when allout mode is used in
1934 programming-mode buffers. See `allout-use-mode-specific-leader'
1935 docstring for more detail.
1937 Spaces or asterisks which separate the PREFIX-LEAD and the
1938 bullet, determining the ITEM's DEPTH.
1939 BULLET: A character at the end of the ITEM PREFIX, it must be one of
1940 the characters listed on `allout-plain-bullets-string' or
1941 `allout-distinctive-bullets-string'. When creating a TOPIC,
1942 plain BULLETs are by default used, according to the DEPTH of the
1943 TOPIC. Choice among the distinctive BULLETs is offered when you
1944 provide a universal argument (\\[universal-argument]) to the
1945 TOPIC creation command, or when explicitly rebulleting a TOPIC. The
1946 significance of the various distinctive bullets is purely by
1947 convention. See the documentation for the above bullet strings for
1950 The state of a TOPIC which determines the on-screen visibility
1951 of its OFFSPRING and contained ENTRY text.
1953 TOPICs and ENTRY text whose EXPOSURE is inhibited. Concealed
1954 text is represented by \"...\" ellipses.
1956 CONCEALED TOPICs are effectively collapsed within an ANCESTOR.
1957 CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED.
1958 OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
1961 :keymap
'allout-mode-map
1963 (let ((use-layout (if (listp allout-layout
)
1965 allout-default-layout
)))
1967 (if (not (allout-mode-p))
1971 ; Activation not explicitly
1972 ; requested, and either in
1973 ; active state or *de*activation
1974 ; specifically requested:
1975 (allout-do-resumptions)
1977 (remove-from-invisibility-spec '(allout . t
))
1978 (remove-hook 'pre-command-hook
'allout-pre-command-business t
)
1979 (remove-hook 'post-command-hook
'allout-post-command-business t
)
1980 (remove-hook 'before-change-functions
'allout-before-change-handler t
)
1981 (remove-hook 'isearch-mode-end-hook
'allout-isearch-end-handler t
)
1982 (remove-hook 'write-contents-functions
1983 'allout-write-contents-hook-handler t
)
1985 (remove-overlays (point-min) (point-max)
1986 'category
'allout-exposure-category
))
1989 (if allout-old-style-prefixes
1990 ;; Inhibit all the fancy formatting:
1991 (allout-add-resumptions '(allout-primary-bullet "*")))
1993 (allout-overlay-preparations) ; Doesn't hurt to redo this.
1995 (allout-infer-header-lead-and-primary-bullet)
1996 (allout-infer-body-reindent)
1999 (allout-add-resumptions '(allout-encryption-ciphertext-rejection-regexps
2000 allout-line-boundary-regexp
2002 '(allout-encryption-ciphertext-rejection-regexps
2006 (allout-compose-and-institute-keymap)
2007 (allout-produce-mode-menubar-entries)
2009 (add-to-invisibility-spec '(allout . t
))
2011 (allout-add-resumptions '(line-move-ignore-invisible t
))
2012 (add-hook 'pre-command-hook
'allout-pre-command-business nil t
)
2013 (add-hook 'post-command-hook
'allout-post-command-business nil t
)
2014 (add-hook 'before-change-functions
'allout-before-change-handler nil t
)
2015 (add-hook 'isearch-mode-end-hook
'allout-isearch-end-handler nil t
)
2016 (add-hook 'write-contents-functions
'allout-write-contents-hook-handler
2019 ;; Stash auto-fill settings and adjust so custom allout auto-fill
2020 ;; func will be used if auto-fill is active or activated. (The
2021 ;; custom func respects topic headline, maintains hanging-indents,
2023 (allout-add-resumptions (list 'allout-former-auto-filler
2025 ;; Register allout-auto-fill to be used if
2026 ;; filling is active:
2027 (list 'allout-outside-normal-auto-fill-function
2028 normal-auto-fill-function
)
2029 '(normal-auto-fill-function allout-auto-fill
)
2030 ;; Paragraphs are broken by topic headlines.
2031 (list 'paragraph-start
2032 (concat paragraph-start
"\\|^\\("
2033 allout-regexp
"\\)"))
2034 (list 'paragraph-separate
2035 (concat paragraph-separate
"\\|^\\("
2036 allout-regexp
"\\)")))
2037 (if (and auto-fill-function
(not allout-inhibit-auto-fill
))
2038 ;; allout-auto-fill will use the stashed values and so forth.
2039 (allout-add-resumptions '(auto-fill-function allout-auto-fill
)))
2041 (allout-setup-menubar)
2043 ;; Do auto layout if warranted:
2044 (when (and allout-layout
2045 allout-auto-activation
2047 (and (not (string= allout-auto-activation
"activate"))
2048 (if (string= allout-auto-activation
"ask")
2049 (if (y-or-n-p (format-message
2050 "Expose %s with layout `%s'? "
2051 (buffer-name) use-layout
))
2053 (message "Skipped %s layout." (buffer-name))
2057 (message "Adjusting `%s' exposure..." (buffer-name))
2059 (allout-this-or-next-heading)
2062 (apply 'allout-expose-topic
(list use-layout
))
2063 (message "Adjusting `%s' exposure... done."
2065 ;; Problem applying exposure -- notify user, but don't
2066 ;; interrupt, eg, file visit:
2067 (error (message "%s" (car (cdr err
)))
2069 ) ; when allout-layout
2070 ) ; if (allout-mode-p)
2072 ) ; define-minor-mode
2073 ;;;_ > allout-minor-mode alias
2074 (defalias 'allout-minor-mode
'allout-mode
)
2075 ;;;_ > allout-unload-function
2076 (defun allout-unload-function ()
2077 "Unload the allout outline library."
2078 (save-current-buffer
2079 (dolist (buffer (buffer-list))
2081 (when (allout-mode-p) (allout-mode -
1))))
2082 ;; continue standard unloading
2085 ;;;_ - Position Assessment
2086 ;;;_ > allout-hidden-p (&optional pos)
2087 (defsubst allout-hidden-p
(&optional pos
)
2088 "Non-nil if the character after point was made invisible by allout."
2089 (eq (get-char-property (or pos
(point)) 'invisible
) 'allout
))
2091 ;;;_ > allout-overlay-insert-in-front-handler (ol after beg end
2092 ;;; &optional prelen)
2093 (defun allout-overlay-insert-in-front-handler (ol after beg _end
2095 "Shift the overlay so stuff inserted in front of it is excluded."
2097 ;; ??? Shouldn't moving the overlay should be unnecessary, if overlay
2098 ;; front-advance on the overlay worked as expected?
2099 (move-overlay ol
(1+ beg
) (overlay-end ol
))))
2100 ;;;_ > allout-overlay-interior-modification-handler (ol after beg end
2101 ;;; &optional prelen)
2102 (defun allout-overlay-interior-modification-handler (ol after beg end
2104 "Get confirmation before making arbitrary changes to invisible text.
2106 We expose the invisible text and ask for confirmation. Refusal or
2107 `keyboard-quit' abandons the changes, with keyboard-quit additionally
2108 reclosing the opened text.
2110 No confirmation is necessary when `inhibit-read-only' is set -- eg, allout
2111 internal functions use this feature cohesively bunch changes."
2113 (when (and (not inhibit-read-only
) (not after
))
2114 (let ((start (point))
2115 (ol-start (overlay-start ol
))
2116 (ol-end (overlay-end ol
))
2119 (while (< (point) end
)
2120 (when (allout-hidden-p)
2121 (allout-show-to-offshoot)
2122 (if (allout-hidden-p)
2123 (save-excursion (forward-char 1)
2124 (allout-show-to-offshoot)))
2126 (setq first
(point))))
2127 (goto-char (if (featurep 'xemacs
)
2128 (next-property-change (1+ (point)) nil end
)
2129 (next-char-property-change (1+ (point)) end
))))
2135 (substitute-command-keys
2136 (concat "Modify concealed text? (\"no\" just aborts,"
2137 " \\[keyboard-quit] also reconceals) "))))
2138 (progn (goto-char start
)
2139 (error "Concealed-text change refused")))
2140 (quit (allout-flag-region ol-start ol-end nil
)
2141 (allout-flag-region ol-start ol-end t
)
2142 (error "Concealed-text change abandoned, text reconcealed"))))
2143 (goto-char start
))))
2144 ;;;_ > allout-before-change-handler (beg end)
2145 (defun allout-before-change-handler (beg end
)
2146 "Protect against changes to invisible text.
2148 See `allout-overlay-interior-modification-handler' for details."
2150 (when (and (allout-mode-p) undo-in-progress
)
2151 (setq allout-just-did-undo t
)
2152 (if (allout-hidden-p)
2153 (allout-show-children)))
2155 ;; allout-overlay-interior-modification-handler on an overlay handles
2156 ;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
2157 (when (and (featurep 'xemacs
) (allout-mode-p))
2158 ;; process all of the pending overlays:
2161 (let ((overlay (allout-get-invisibility-overlay)))
2163 (allout-overlay-interior-modification-handler
2164 overlay nil beg end nil
))))))
2165 ;;;_ > allout-isearch-end-handler (&optional overlay)
2166 (defun allout-isearch-end-handler (&optional _overlay
)
2167 "Reconcile allout outline exposure on arriving in hidden text after isearch.
2169 Optional OVERLAY parameter is for when this function is used by
2170 `isearch-open-invisible' overlay property. It is otherwise unused, so this
2171 function can also be used as an `isearch-mode-end-hook'."
2173 (if (and (allout-mode-p) (allout-hidden-p))
2174 (allout-show-to-offshoot)))
2176 ;;;_ #3 Internal Position State-Tracking -- "allout-recent-*" funcs
2177 ;; All the basic outline functions that directly do string matches to
2178 ;; evaluate heading prefix location set the variables
2179 ;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end'
2180 ;; when successful. Functions starting with `allout-recent-' all
2181 ;; use this state, providing the means to avoid redundant searches
2182 ;; for just-established data. This optimization can provide
2183 ;; significant speed improvement, but it must be employed carefully.
2184 ;;;_ = allout-recent-prefix-beginning
2185 (defvar allout-recent-prefix-beginning
0
2186 "Buffer point of the start of the last topic prefix encountered.")
2187 (make-variable-buffer-local 'allout-recent-prefix-beginning
)
2188 ;;;_ = allout-recent-prefix-end
2189 (defvar allout-recent-prefix-end
0
2190 "Buffer point of the end of the last topic prefix encountered.")
2191 (make-variable-buffer-local 'allout-recent-prefix-end
)
2192 ;;;_ = allout-recent-depth
2193 (defvar allout-recent-depth
0
2194 "Depth of the last topic prefix encountered.")
2195 (make-variable-buffer-local 'allout-recent-depth
)
2196 ;;;_ = allout-recent-end-of-subtree
2197 (defvar allout-recent-end-of-subtree
0
2198 "Buffer point last returned by `allout-end-of-current-subtree'.")
2199 (make-variable-buffer-local 'allout-recent-end-of-subtree
)
2200 ;;;_ > allout-prefix-data ()
2201 (defsubst allout-prefix-data
()
2202 "Register allout-prefix state data.
2204 For reference by `allout-recent' funcs. Return
2205 the new value of `allout-recent-prefix-beginning'."
2206 (setq allout-recent-prefix-end
(or (match-end 1) (match-end 2) (match-end 3))
2207 allout-recent-prefix-beginning
(or (match-beginning 1)
2209 (match-beginning 3))
2210 allout-recent-depth
(max 1 (- allout-recent-prefix-end
2211 allout-recent-prefix-beginning
2212 allout-header-subtraction
)))
2213 allout-recent-prefix-beginning
)
2214 ;;;_ > allout-nullify-prefix-data ()
2215 (defsubst allout-nullify-prefix-data
()
2216 "Mark allout prefix data as being uninformative."
2217 (setq allout-recent-prefix-end
(point)
2218 allout-recent-prefix-beginning
(point)
2219 allout-recent-depth
0)
2220 allout-recent-prefix-beginning
)
2221 ;;;_ > allout-recent-depth ()
2222 (defsubst allout-recent-depth
()
2223 "Return depth of last heading encountered by an outline maneuvering function.
2225 All outline functions which directly do string matches to assess
2226 headings set the variables `allout-recent-prefix-beginning' and
2227 `allout-recent-prefix-end' if successful. This function uses those settings
2228 to return the current depth."
2230 allout-recent-depth
)
2231 ;;;_ > allout-recent-prefix ()
2232 (defsubst allout-recent-prefix
()
2233 "Like `allout-recent-depth', but returns text of last encountered prefix.
2235 All outline functions which directly do string matches to assess
2236 headings set the variables `allout-recent-prefix-beginning' and
2237 `allout-recent-prefix-end' if successful. This function uses those settings
2238 to return the current prefix."
2239 (buffer-substring-no-properties allout-recent-prefix-beginning
2240 allout-recent-prefix-end
))
2241 ;;;_ > allout-recent-bullet ()
2242 (defmacro allout-recent-bullet
()
2243 "Like `allout-recent-prefix', but returns bullet of last encountered prefix.
2245 All outline functions which directly do string matches to assess
2246 headings set the variables `allout-recent-prefix-beginning' and
2247 `allout-recent-prefix-end' if successful. This function uses those settings
2248 to return the current depth of the most recently matched topic."
2249 '(buffer-substring-no-properties (1- allout-recent-prefix-end
)
2250 allout-recent-prefix-end
))
2254 ;;;_ - Position Assessment
2255 ;;;_ : Location Predicates
2256 ;;;_ > allout-do-doublecheck ()
2257 (defsubst allout-do-doublecheck
()
2258 "True if current item conditions qualify for checking on topic aberrance."
2260 ;; presume integrity of outline and yanked content during yank -- necessary
2261 ;; to allow for level disparity of yank location and yanked text:
2262 (not allout-inhibit-aberrance-doublecheck
)
2263 ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck:
2264 (<= allout-recent-depth allout-doublecheck-at-and-shallower
)))
2265 ;;;_ > allout-aberrant-container-p ()
2266 (defun allout-aberrant-container-p ()
2267 "True if topic, or next sibling with children, contains them discontinuously.
2269 Discontinuous means an immediate offspring that is nested more
2270 than one level deeper than the topic.
2272 If topic has no offspring, then the next sibling with offspring will
2273 determine whether or not this one is determined to be aberrant.
2275 If true, then the allout-recent-* settings are calibrated on the
2276 offspring that qualifies it as aberrant, ie with depth that
2277 exceeds the topic by more than one."
2279 ;; This is most clearly understood when considering standard-prefix-leader
2280 ;; low-level topics, which can all too easily match text not intended as
2281 ;; headers. For example, any line with a leading '.' or '*' and lacking a
2282 ;; following bullet qualifies without this protection. (A sequence of
2283 ;; them can occur naturally, eg a typical textual bullet list.) We
2284 ;; disqualify such low-level sequences when they are followed by a
2285 ;; discontinuously contained child, inferring that the sequences are not
2286 ;; actually connected with their prospective context.
2288 (let ((depth (allout-depth))
2289 (start-point (point))
2293 (while (and (not done
)
2294 (re-search-forward allout-line-boundary-regexp nil
0))
2295 (allout-prefix-data)
2296 (goto-char allout-recent-prefix-beginning
)
2298 ;; sibling -- continue:
2299 ((eq allout-recent-depth depth
))
2300 ;; first offspring is excessive -- aberrant:
2301 ((> allout-recent-depth
(1+ depth
))
2302 (setq done t aberrant t
))
2303 ;; next non-sibling is lower-depth -- not aberrant:
2304 (t (setq done t
))))))
2307 (goto-char start-point
)
2308 ;; recalibrate allout-recent-*
2311 ;;;_ > allout-on-current-heading-p ()
2312 (defun allout-on-current-heading-p ()
2313 "Return non-nil if point is on current visible topics' header line.
2315 Actually, returns prefix beginning point."
2317 (allout-beginning-of-current-line)
2319 (and (looking-at allout-regexp
)
2320 (allout-prefix-data)
2321 (or (not (allout-do-doublecheck))
2322 (not (allout-aberrant-container-p)))))))
2323 ;;;_ > allout-on-heading-p ()
2324 (defalias 'allout-on-heading-p
'allout-on-current-heading-p
)
2325 ;;;_ > allout-e-o-prefix-p ()
2326 (defun allout-e-o-prefix-p ()
2327 "True if point is located where current topic prefix ends, heading begins."
2328 (and (save-match-data
2329 (save-excursion (let ((inhibit-field-text-motion t
))
2330 (beginning-of-line))
2331 (looking-at allout-regexp
))
2332 (= (point) (save-excursion (allout-end-of-prefix)(point))))))
2333 ;;;_ : Location attributes
2334 ;;;_ > allout-depth ()
2335 (defun allout-depth ()
2336 "Return depth of topic most immediately containing point.
2338 Does not do doublecheck for aberrant topic header.
2340 Return zero if point is not within any topic.
2342 Like `allout-current-depth', but respects hidden as well as visible topics."
2344 (let ((start-point (point)))
2345 (if (and (allout-goto-prefix)
2346 (not (< start-point
(point))))
2349 ;; Oops, no prefix, nullify it:
2350 (allout-nullify-prefix-data)
2351 ;; ... and return 0:
2353 ;;;_ > allout-current-depth ()
2354 (defun allout-current-depth ()
2355 "Return depth of visible topic most immediately containing point.
2357 Return zero if point is not within any topic."
2359 (if (allout-back-to-current-heading)
2361 (- allout-recent-prefix-end
2362 allout-recent-prefix-beginning
2363 allout-header-subtraction
))
2365 ;;;_ > allout-get-current-prefix ()
2366 (defun allout-get-current-prefix ()
2367 "Topic prefix of the current topic."
2369 (if (allout-goto-prefix)
2370 (allout-recent-prefix))))
2371 ;;;_ > allout-get-bullet ()
2372 (defun allout-get-bullet ()
2373 "Return bullet of containing topic (visible or not)."
2375 (and (allout-goto-prefix)
2376 (allout-recent-bullet))))
2377 ;;;_ > allout-current-bullet ()
2378 (defun allout-current-bullet ()
2379 "Return bullet of current (visible) topic heading, or none if none found."
2382 (allout-back-to-current-heading)
2383 (buffer-substring-no-properties (- allout-recent-prefix-end
1)
2384 allout-recent-prefix-end
))
2385 ;; Quick and dirty provision, ostensibly for missing bullet:
2386 (args-out-of-range nil
))
2388 ;;;_ > allout-get-prefix-bullet (prefix)
2389 (defun allout-get-prefix-bullet (prefix)
2390 "Return the bullet of the header prefix string PREFIX."
2391 ;; Doesn't make sense if we're old-style prefixes, but this just
2392 ;; oughtn't be called then, so forget about it...
2393 (if (string-match allout-regexp prefix
)
2394 (substring prefix
(1- (match-end 2)) (match-end 2))))
2395 ;;;_ > allout-sibling-index (&optional depth)
2396 (defun allout-sibling-index (&optional depth
)
2397 "Item number of this prospective topic among its siblings.
2399 If optional arg DEPTH is greater than current depth, then we're
2400 opening a new level, and return 0.
2402 If less than this depth, ascend to that depth and count..."
2405 (cond ((and depth
(<= depth
0) 0))
2406 ((or (null depth
) (= depth
(allout-depth)))
2408 (while (allout-previous-sibling allout-recent-depth nil
)
2409 (setq index
(1+ index
)))
2411 ((< depth allout-recent-depth
)
2412 (allout-ascend-to-depth depth
)
2413 (allout-sibling-index))
2415 ;;;_ > allout-topic-flat-index ()
2416 (defun allout-topic-flat-index ()
2417 "Return a list indicating point's numeric section.subsect.subsubsect...
2418 Outermost is first."
2419 (let* ((depth (allout-depth))
2420 (next-index (allout-sibling-index depth
))
2422 (while (> next-index
0)
2423 (setq rev-sibls
(cons next-index rev-sibls
))
2424 (setq depth
(1- depth
))
2425 (setq next-index
(allout-sibling-index depth
)))
2429 ;;;_ - Navigation routines
2430 ;;;_ > allout-beginning-of-current-line ()
2431 (defun allout-beginning-of-current-line ()
2432 "Like beginning of line, but to visible text."
2434 ;; This combination of move-beginning-of-line and beginning-of-line is
2435 ;; deliberate, but the (beginning-of-line) may now be superfluous.
2436 (let ((inhibit-field-text-motion t
))
2437 (move-beginning-of-line 1)
2439 (while (and (not (bobp)) (or (not (bolp)) (allout-hidden-p)))
2441 (if (or (allout-hidden-p) (not (bolp)))
2442 (forward-char -
1)))))
2443 ;;;_ > allout-end-of-current-line ()
2444 (defun allout-end-of-current-line ()
2445 "Move to the end of line, past concealed text if any."
2446 ;; This is for symmetry with `allout-beginning-of-current-line' --
2447 ;; `move-end-of-line' doesn't suffer the same problem as
2448 ;; `move-beginning-of-line'.
2449 (let ((inhibit-field-text-motion t
))
2451 (while (allout-hidden-p)
2453 (if (allout-hidden-p) (forward-char 1)))))
2454 ;;;_ > allout-beginning-of-line ()
2455 (defun allout-beginning-of-line ()
2456 "Beginning-of-line with `allout-beginning-of-line-cycles' behavior, if set."
2460 (if (or (not allout-beginning-of-line-cycles
)
2461 (not (equal last-command this-command
)))
2463 (if (and (not (bolp))
2464 (allout-hidden-p (1- (point))))
2465 (goto-char (allout-previous-single-char-property-change
2466 (1- (point)) 'invisible
)))
2467 (move-beginning-of-line 1))
2469 (let ((beginning-of-body
2471 (while (and (allout-do-doublecheck)
2472 (allout-aberrant-container-p)
2473 (allout-previous-visible-heading 1)))
2474 (allout-beginning-of-current-entry)
2476 (cond ((= (current-column) 0)
2477 (goto-char beginning-of-body
))
2478 ((< (point) beginning-of-body
)
2479 (allout-beginning-of-current-line))
2480 ((= (point) beginning-of-body
)
2481 (goto-char (allout-current-bullet-pos)))
2482 (t (allout-beginning-of-current-line)
2483 (if (< (point) beginning-of-body
)
2484 ;; we were on the headline after its start:
2485 (goto-char beginning-of-body
)))))))
2486 ;;;_ > allout-end-of-line ()
2487 (defun allout-end-of-line ()
2488 "End-of-line with `allout-end-of-line-cycles' behavior, if set."
2492 (if (or (not allout-end-of-line-cycles
)
2493 (not (equal last-command this-command
)))
2494 (allout-end-of-current-line)
2495 (let ((end-of-entry (save-excursion
2496 (allout-end-of-entry)
2499 (allout-end-of-current-line))
2500 ((or (allout-hidden-p) (save-excursion
2503 (allout-back-to-current-heading)
2504 (allout-show-current-entry)
2505 (allout-show-children)
2506 (allout-end-of-entry))
2507 ((>= (point) end-of-entry
)
2508 (allout-back-to-current-heading)
2509 (allout-end-of-current-line))
2511 (if (not (allout-mark-active-p))
2513 (allout-end-of-entry))))))
2514 ;;;_ > allout-mark-active-p ()
2515 (defun allout-mark-active-p ()
2516 "True if the mark is currently or always active."
2517 ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler
2518 ;; provisions, at least in GNU Emacs to prevent warnings about lack of,
2519 ;; eg, region-active-p.
2520 (cond ((boundp 'mark-active
)
2522 ((fboundp 'region-active-p
)
2525 ;;;_ > allout-next-heading ()
2526 (defsubst allout-next-heading
()
2527 "Move to the heading for the topic (possibly invisible) after this one.
2529 Returns the location of the heading, or nil if none found.
2531 We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
2534 (if (looking-at allout-regexp
)
2537 (when (re-search-forward allout-line-boundary-regexp nil
0)
2538 (allout-prefix-data)
2539 (goto-char allout-recent-prefix-beginning
)
2542 (and (allout-do-doublecheck)
2543 ;; this will set allout-recent-* on the first non-aberrant topic,
2544 ;; whether it's the current one or one that disqualifies it:
2545 (allout-aberrant-container-p))
2546 ;; this may or may not be the same as above depending on doublecheck:
2547 (goto-char allout-recent-prefix-beginning
))))
2548 ;;;_ > allout-this-or-next-heading
2549 (defun allout-this-or-next-heading ()
2550 "Position cursor on current or next heading."
2551 ;; A throwaway non-macro that is defined after allout-next-heading
2552 ;; and usable by allout-mode.
2553 (if (not (allout-goto-prefix-doublechecked)) (allout-next-heading)))
2554 ;;;_ > allout-previous-heading ()
2555 (defun allout-previous-heading ()
2556 "Move to the prior (possibly invisible) heading line.
2558 Return the location of the beginning of the heading, or nil if not found.
2560 We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
2564 (let ((start-point (point)))
2565 ;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
2566 (allout-goto-prefix)
2568 (when (or (re-search-backward allout-line-boundary-regexp nil
0)
2569 (looking-at allout-bob-regexp
))
2570 (goto-char (allout-prefix-data))
2571 (if (and (allout-do-doublecheck)
2572 (allout-aberrant-container-p))
2573 (or (allout-previous-heading)
2574 (and (goto-char start-point
)
2575 ;; recalibrate allout-recent-*:
2579 ;;;_ > allout-get-invisibility-overlay ()
2580 (defun allout-get-invisibility-overlay ()
2581 "Return the overlay at point that dictates allout invisibility."
2582 (let ((overlays (overlays-at (point)))
2584 (while (and overlays
(not got
))
2585 (if (equal (overlay-get (car overlays
) 'invisible
) 'allout
)
2586 (setq got
(car overlays
))
2589 ;;;_ > allout-back-to-visible-text ()
2590 (defun allout-back-to-visible-text ()
2591 "Move to most recent prior character that is visible, and return point."
2592 (if (allout-hidden-p)
2593 (goto-char (overlay-start (allout-get-invisibility-overlay))))
2596 ;;;_ - Subtree Charting
2597 ;;;_ " These routines either produce or assess charts, which are
2598 ;;; nested lists of the locations of topics within a subtree.
2600 ;;; Charts enable efficient subtree navigation by providing a reusable basis
2601 ;;; for elaborate, compound assessment and adjustment of a subtree.
2603 ;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
2604 (defun allout-chart-subtree (&optional levels visible orig-depth prev-depth
)
2605 "Produce a location \"chart\" of subtopics of the containing topic.
2607 Optional argument LEVELS specifies a depth limit (relative to start
2608 depth) for the chart. Null LEVELS means no limit.
2610 When optional argument VISIBLE is non-nil, the chart includes
2611 only the visible subelements of the charted subjects.
2613 The remaining optional args are for internal use by the function.
2615 Point is left at the end of the subtree.
2617 Charts are used to capture outline structure, so that outline-altering
2618 routines need to assess the structure only once, and then use the chart
2619 for their elaborate manipulations.
2621 The chart entries for the topics are in reverse order, so the
2622 last topic is listed first. The entry for each topic consists of
2623 an integer indicating the point at the beginning of the topic
2624 prefix. Charts for offspring consist of a list containing,
2625 recursively, the charts for the respective subtopics. The chart
2626 for a topics' offspring precedes the entry for the topic itself.
2628 The other function parameters are for internal recursion, and should
2629 not be specified by external callers. ORIG-DEPTH is depth of topic at
2630 starting point, and PREV-DEPTH is depth of prior topic."
2632 (let ((original (not orig-depth
)) ; `orig-depth' set only in recursion.
2635 (if original
; Just starting?
2636 ; Register initial settings and
2637 ; position to first offspring:
2638 (progn (setq orig-depth
(allout-depth))
2639 (or prev-depth
(setq prev-depth
(1+ orig-depth
)))
2641 (allout-next-visible-heading 1)
2642 (allout-next-heading))))
2644 ;; Loop over the current levels' siblings. Besides being more
2645 ;; efficient than tail-recursing over a level, it avoids exceeding
2646 ;; the typically quite constrained Emacs max-lisp-eval-depth.
2648 ;; Probably would speed things up to implement loop-based stack
2649 ;; operation rather than recursing for lower levels. Bah.
2651 (while (and (not (eobp))
2652 ; Still within original topic?
2653 (< orig-depth
(setq curr-depth allout-recent-depth
))
2654 (cond ((= prev-depth curr-depth
)
2655 ;; Register this one and move on:
2656 (setq chart
(cons allout-recent-prefix-beginning chart
))
2657 (if (and levels
(<= levels
1))
2658 ;; At depth limit -- skip sublevels:
2659 (or (allout-next-sibling curr-depth
)
2660 ;; or no more siblings -- proceed to
2661 ;; next heading at lesser depth:
2662 (while (and (<= curr-depth
2663 allout-recent-depth
)
2665 (allout-next-visible-heading 1)
2666 (allout-next-heading)))))
2668 (allout-next-visible-heading 1)
2669 (allout-next-heading))))
2671 ((and (< prev-depth curr-depth
)
2674 ;; Recurse on deeper level of curr topic:
2676 (cons (allout-chart-subtree (and levels
2682 ;; ... then continue with this one.
2685 ;; ... else nil if we've ascended back to prev-depth.
2689 (if original
; We're at the last sibling on
2690 ; the original level. Position
2692 (progn (and (not (eobp)) (forward-char -
1))
2693 (and (= (preceding-char) ?
\n)
2694 (= (aref (buffer-substring (max 1 (- (point) 3))
2699 (setq allout-recent-end-of-subtree
(point))))
2701 chart
; (nreverse chart) not necessary,
2702 ; and maybe not preferable.
2704 ;;;_ > allout-chart-siblings (&optional start end)
2705 (defun allout-chart-siblings (&optional _start _end
)
2706 "Produce a list of locations of this and succeeding sibling topics.
2707 Effectively a top-level chart of siblings. See `allout-chart-subtree'
2708 for an explanation of charts."
2710 (when (allout-goto-prefix-doublechecked)
2711 (let ((chart (list (point))))
2712 (while (allout-next-sibling)
2713 (setq chart
(cons (point) chart
)))
2714 (if chart
(setq chart
(nreverse chart
)))))))
2715 ;;;_ > allout-chart-to-reveal (chart depth)
2716 (defun allout-chart-to-reveal (chart depth
)
2718 "Return a flat list of hidden points in subtree CHART, up to DEPTH.
2720 If DEPTH is nil, include hidden points at any depth.
2722 Note that point can be left at any of the points on chart, or at the
2726 (while (and (or (null depth
) (> depth
0))
2728 (setq here
(car chart
))
2730 (let ((further (allout-chart-to-reveal here
(if (null depth
)
2733 ;; We're on the start of a subtree -- recurse with it, if there's
2734 ;; more depth to go:
2735 (if further
(setq result
(append further result
)))
2736 (setq chart
(cdr chart
)))
2738 (if (allout-hidden-p)
2739 (setq result
(cons here result
)))
2740 (setq chart
(cdr chart
))))
2742 ;;;_ X allout-chart-spec (chart spec &optional exposing)
2743 ;; (defun allout-chart-spec (chart spec &optional exposing)
2744 ;; "Not yet (if ever) implemented.
2746 ;; Produce exposure directives given topic/subtree CHART and an exposure SPEC.
2748 ;; Exposure spec indicates the locations to be exposed and the prescribed
2749 ;; exposure status. Optional arg EXPOSING is an integer, with 0
2750 ;; indicating pending concealment, anything higher indicating depth to
2751 ;; which subtopic headers should be exposed, and negative numbers
2752 ;; indicating (negative of) the depth to which subtopic headers and
2753 ;; bodies should be exposed.
2755 ;; The produced list can have two types of entries. Bare numbers
2756 ;; indicate points in the buffer where topic headers that should be
2759 ;; - bare negative numbers indicates that the topic starting at the
2760 ;; point which is the negative of the number should be opened,
2761 ;; including their entries.
2762 ;; - bare positive values indicate that this topic header should be
2764 ;; - Lists signify the beginning and end points of regions that should
2765 ;; be flagged, and the flag to employ. (For concealment: `(\?r)', and
2768 ;; (cond ((listp spec)
2771 ;; (setq spec (cdr spec)))
2775 ;;;_ > allout-goto-prefix ()
2776 (defun allout-goto-prefix ()
2777 "Put point at beginning of immediately containing outline topic.
2779 Goes to most immediate subsequent topic if none immediately containing.
2781 Not sensitive to topic visibility.
2783 Returns the point at the beginning of the prefix, or nil if none."
2787 (while (and (not done
)
2788 (search-backward "\n" nil
1))
2790 (if (looking-at allout-regexp
)
2791 (setq done
(allout-prefix-data))
2794 (cond ((looking-at allout-regexp
)
2795 (allout-prefix-data))
2796 ((allout-next-heading))
2799 ;;;_ > allout-goto-prefix-doublechecked ()
2800 (defun allout-goto-prefix-doublechecked ()
2801 "Put point at beginning of immediately containing outline topic.
2803 Like `allout-goto-prefix', but shallow topics (according to
2804 `allout-doublecheck-at-and-shallower') are checked and
2805 disqualified for child containment discontinuity, according to
2806 `allout-aberrant-container-p'."
2807 (if (allout-goto-prefix)
2808 (if (and (allout-do-doublecheck)
2809 (allout-aberrant-container-p))
2810 (allout-previous-heading)
2813 ;;;_ > allout-end-of-prefix ()
2814 (defun allout-end-of-prefix (&optional ignore-decorations
)
2815 "Position cursor at beginning of header text.
2817 If optional IGNORE-DECORATIONS is non-nil, put just after bullet,
2818 otherwise skip white space between bullet and ensuing text."
2820 (if (not (allout-goto-prefix-doublechecked))
2822 (goto-char allout-recent-prefix-end
)
2824 (if ignore-decorations
2826 (while (looking-at "[0-9]") (forward-char 1))
2827 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))))
2828 ;; Reestablish where we are:
2829 (allout-current-depth)))
2830 ;;;_ > allout-current-bullet-pos ()
2831 (defun allout-current-bullet-pos ()
2832 "Return position of current (visible) topic's bullet."
2834 (if (not (allout-current-depth))
2836 (1- allout-recent-prefix-end
)))
2837 ;;;_ > allout-back-to-current-heading (&optional interactive)
2838 (defun allout-back-to-current-heading (&optional interactive
)
2839 "Move to heading line of current topic, or beginning if not in a topic.
2841 If interactive, we position at the end of the prefix.
2843 Return value of resulting point, unless we started outside
2844 of (before any) topics, in which case we return nil."
2848 (allout-beginning-of-current-line)
2849 (let ((bol-point (point)))
2850 (when (allout-goto-prefix-doublechecked)
2851 (if (<= (point) bol-point
)
2853 (setq bol-point
(point))
2854 (allout-beginning-of-current-line)
2855 (if (not (= bol-point
(point)))
2856 (if (looking-at allout-regexp
)
2857 (allout-prefix-data)))
2859 (allout-end-of-prefix)
2861 (goto-char (point-min))
2863 ;;;_ > allout-back-to-heading ()
2864 (defalias 'allout-back-to-heading
'allout-back-to-current-heading
)
2865 ;;;_ > allout-pre-next-prefix ()
2866 (defun allout-pre-next-prefix ()
2867 "Skip forward to just before the next heading line.
2869 Returns that character position."
2871 (if (allout-next-heading)
2872 (goto-char (1- allout-recent-prefix-beginning
))))
2873 ;;;_ > allout-end-of-subtree (&optional current include-trailing-blank)
2874 (defun allout-end-of-subtree (&optional current include-trailing-blank
)
2875 "Put point at the end of the last leaf in the containing topic.
2877 Optional CURRENT means put point at the end of the containing
2880 Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if
2881 any, as part of the subtree. Otherwise, that trailing blank will be
2882 excluded as delimiting whitespace between topics.
2884 Returns the value of point."
2887 (allout-back-to-current-heading)
2888 (allout-goto-prefix-doublechecked))
2889 (let ((level allout-recent-depth
))
2890 (allout-next-heading)
2891 (while (and (not (eobp))
2892 (> allout-recent-depth level
))
2893 (allout-next-heading))
2895 (allout-end-of-entry)
2897 (if (and (not include-trailing-blank
) (= ?
\n (preceding-char)))
2899 (setq allout-recent-end-of-subtree
(point))))
2900 ;;;_ > allout-end-of-current-subtree (&optional include-trailing-blank)
2901 (defun allout-end-of-current-subtree (&optional include-trailing-blank
)
2903 "Put point at end of last leaf in currently visible containing topic.
2905 Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if
2906 any, as part of the subtree. Otherwise, that trailing blank will be
2907 excluded as delimiting whitespace between topics.
2909 Returns the value of point."
2911 (allout-end-of-subtree t include-trailing-blank
))
2912 ;;;_ > allout-beginning-of-current-entry (&optional interactive)
2913 (defun allout-beginning-of-current-entry (&optional interactive
)
2914 "When not already there, position point at beginning of current topic header.
2916 If already there, move cursor to bullet for hot-spot operation.
2917 \(See `allout-mode' doc string for details of hot-spot operation.)"
2919 (let ((start-point (point)))
2920 (move-beginning-of-line 1)
2921 (if (< 0 (allout-current-depth))
2922 (goto-char allout-recent-prefix-end
)
2923 (goto-char (point-min)))
2924 (allout-end-of-prefix)
2925 (if (and interactive
2926 (= (point) start-point
))
2927 (goto-char (allout-current-bullet-pos)))))
2928 ;;;_ > allout-end-of-entry (&optional inclusive)
2929 (defun allout-end-of-entry (&optional inclusive
)
2930 "Position the point at the end of the current topics' entry.
2932 Optional INCLUSIVE means also include trailing empty line, if any. When
2933 unset, whitespace between items separates them even when the items are
2936 (allout-pre-next-prefix)
2937 (if (and (not inclusive
) (not (bobp)) (= ?
\n (preceding-char)))
2940 ;;;_ > allout-end-of-current-heading ()
2941 (defun allout-end-of-current-heading ()
2943 (allout-beginning-of-current-entry)
2944 (search-forward "\n" nil t
)
2946 (defalias 'allout-end-of-heading
'allout-end-of-current-heading
)
2947 ;;;_ > allout-get-body-text ()
2948 (defun allout-get-body-text ()
2949 "Return the unmangled body text of the topic immediately containing point."
2951 (allout-end-of-prefix)
2952 (if (not (search-forward "\n" nil t
))
2955 (let ((pre-body (point)))
2958 (allout-end-of-entry t
)
2959 (if (not (= pre-body
(point)))
2960 (buffer-substring-no-properties (1+ pre-body
) (point))))
2967 ;;;_ > allout-ascend-to-depth (depth)
2968 (defun allout-ascend-to-depth (depth)
2969 "Ascend to depth DEPTH, returning depth if successful, nil if not."
2970 (if (and (> depth
0)(<= depth
(allout-depth)))
2971 (let (last-ascended)
2972 (while (and (< depth allout-recent-depth
)
2973 (setq last-ascended
(allout-ascend))))
2974 (goto-char allout-recent-prefix-beginning
)
2975 (if (allout-called-interactively-p) (allout-end-of-prefix))
2976 (and last-ascended allout-recent-depth
))))
2977 ;;;_ > allout-ascend (&optional dont-move-if-unsuccessful)
2978 (defun allout-ascend (&optional dont-move-if-unsuccessful
)
2979 "Ascend one level, returning resulting depth if successful, nil if not.
2981 Point is left at the beginning of the level whether or not
2982 successful, unless optional DONT-MOVE-IF-UNSUCCESSFUL is set, in
2983 which case point is returned to its original starting location."
2984 (if dont-move-if-unsuccessful
2985 (setq dont-move-if-unsuccessful
(point)))
2987 (if (allout-beginning-of-level)
2988 (let ((bolevel (point))
2989 (bolevel-depth allout-recent-depth
))
2990 (allout-previous-heading)
2991 (cond ((< allout-recent-depth bolevel-depth
)
2992 allout-recent-depth
)
2993 ((= allout-recent-depth bolevel-depth
)
2994 (if dont-move-if-unsuccessful
2995 (goto-char dont-move-if-unsuccessful
))
2999 ;; some topic after very first is lower depth than first:
3003 (if (allout-called-interactively-p) (allout-end-of-prefix))))
3004 ;;;_ > allout-descend-to-depth (depth)
3005 (defun allout-descend-to-depth (depth)
3006 "Descend to depth DEPTH within current topic.
3008 Returning depth if successful, nil if not."
3009 (let ((start-point (point))
3010 (start-depth (allout-depth)))
3012 (and (> (allout-depth) 0)
3013 (not (= depth allout-recent-depth
)) ; ... not there yet
3014 (allout-next-heading) ; ... go further
3015 (< start-depth allout-recent-depth
))) ; ... still in topic
3016 (if (and (> (allout-depth) 0)
3017 (= allout-recent-depth depth
))
3019 (goto-char start-point
)
3022 ;;;_ > allout-up-current-level (arg)
3023 (defun allout-up-current-level (_arg)
3024 "Move out ARG levels from current visible topic."
3026 (let ((start-point (point)))
3027 (allout-back-to-current-heading)
3028 (if (not (allout-ascend))
3029 (progn (goto-char start-point
)
3030 (error "Can't ascend past outermost level"))
3031 (if (allout-called-interactively-p) (allout-end-of-prefix))
3032 allout-recent-prefix-beginning
)))
3035 ;;;_ > allout-next-sibling (&optional depth backward)
3036 (defun allout-next-sibling (&optional depth backward
)
3037 "Like `allout-forward-current-level', but respects invisible topics.
3039 Traverse at optional DEPTH, or current depth if none specified.
3041 Go backward if optional arg BACKWARD is non-nil.
3043 Return the start point of the new topic if successful, nil otherwise."
3045 (if (if backward
(bobp) (eobp))
3047 (let ((target-depth (or depth
(allout-depth)))
3048 (start-point (point))
3049 (start-prefix-beginning allout-recent-prefix-beginning
)
3054 ;; done too few single steps to resort to the leap routine:
3057 (not (if backward
(bobp) (eobp)))
3058 ;; still traversable:
3059 (if backward
(allout-previous-heading) (allout-next-heading))
3060 ;; we're below the target depth
3061 (> (setq last-depth allout-recent-depth
) target-depth
))
3062 (setq count
(1+ count
))
3063 (if (> count
7) ; lists are commonly 7 +- 2, right?-)
3066 (or (allout-next-sibling-leap target-depth backward
)
3068 (goto-char start-point
)
3069 (if depth
(allout-depth) target-depth
)
3072 (and (> (or last-depth
(allout-depth)) 0)
3073 (= allout-recent-depth target-depth
))
3074 (not (= start-prefix-beginning
3075 allout-recent-prefix-beginning
)))
3076 allout-recent-prefix-beginning
)
3078 (goto-char start-point
)
3079 (if depth
(allout-depth) target-depth
)
3081 ;;;_ > allout-next-sibling-leap (&optional depth backward)
3082 (defun allout-next-sibling-leap (&optional depth backward
)
3083 "Like `allout-next-sibling', but by direct search for topic at depth.
3085 Traverse at optional DEPTH, or current depth if none specified.
3087 Go backward if optional arg BACKWARD is non-nil.
3089 Return the start point of the new topic if successful, nil otherwise.
3091 Costs more than regular `allout-next-sibling' for short traversals:
3093 - we have to check the prior (next, if traveling backwards)
3094 item to confirm connectivity with the prior topic, and
3095 - if confirmed, we have to reestablish the allout-recent-* settings with
3096 some extra navigation
3097 - if confirmation fails, we have to do more work to recover
3099 It is an increasingly big win when there are many intervening
3100 offspring before the next sibling, however, so
3101 `allout-next-sibling' resorts to this if it finds itself in that
3104 (if (if backward
(bobp) (eobp))
3106 (let* ((start-point (point))
3107 (target-depth (or depth
(allout-depth)))
3108 (search-whitespace-regexp nil
)
3109 (depth-biased (- target-depth
2))
3110 (expression (if (<= target-depth
1)
3111 allout-depth-one-regexp
3112 (format allout-depth-specific-regexp
3113 depth-biased depth-biased
)))
3117 (setq found
(save-match-data
3119 (re-search-backward expression nil
'to-limit
)
3121 (re-search-forward expression nil
'to-limit
))))
3122 (if (and found
(allout-aberrant-container-p))
3124 (setq done
(or found
(if backward
(bobp) (eobp)))))
3126 (progn (goto-char start-point
)
3128 ;; rationale: if any intervening items were at a lower depth, we
3129 ;; would now be on the first offspring at the target depth -- ie,
3130 ;; the preceding item (per the search direction) must be at a
3131 ;; lesser depth. that's all we need to check.
3132 (if backward
(allout-next-heading) (allout-previous-heading))
3133 (if (< allout-recent-depth target-depth
)
3134 ;; return to start and reestablish allout-recent-*:
3136 (goto-char start-point
)
3140 ;; locate cursor and set allout-recent-*:
3141 (allout-goto-prefix))))))
3142 ;;;_ > allout-previous-sibling (&optional depth backward)
3143 (defun allout-previous-sibling (&optional depth backward
)
3144 "Like `allout-forward-current-level' backwards, respecting invisible topics.
3146 Optional DEPTH specifies depth to traverse, default current depth.
3148 Optional BACKWARD reverses direction.
3150 Return depth if successful, nil otherwise."
3151 (allout-next-sibling depth
(not backward
))
3153 ;;;_ > allout-snug-back ()
3154 (defun allout-snug-back ()
3155 "Position cursor at end of previous topic.
3157 Presumes point is at the start of a topic prefix."
3158 (if (or (bobp) (eobp))
3161 (if (or (bobp) (not (= ?
\n (preceding-char))))
3165 ;;;_ > allout-beginning-of-level ()
3166 (defun allout-beginning-of-level ()
3167 "Go back to the first sibling at this level, visible or not."
3168 (allout-end-of-level 'backward
))
3169 ;;;_ > allout-end-of-level (&optional backward)
3170 (defun allout-end-of-level (&optional _backward
)
3171 "Go to the last sibling at this level, visible or not."
3173 (let ((depth (allout-depth)))
3174 (while (allout-previous-sibling depth nil
))
3175 (prog1 allout-recent-depth
3176 (if (allout-called-interactively-p) (allout-end-of-prefix)))))
3177 ;;;_ > allout-next-visible-heading (arg)
3178 (defun allout-next-visible-heading (arg)
3179 "Move to the next ARGth visible heading line, backward if ARG is negative.
3181 Move to buffer limit in indicated direction if headings are exhausted."
3184 (let* ((inhibit-field-text-motion t
)
3185 (backward (if (< arg
0) (setq arg
(* -
1 arg
))))
3186 (step (if backward -
1 1))
3187 (progress (allout-current-bullet-pos))
3192 ;; Boundary condition:
3193 (not (if backward
(bobp)(eobp)))
3194 ;; Move, skipping over all concealed lines in one fell swoop:
3195 (prog1 (condition-case nil
(or (line-move step
) t
)
3197 (allout-beginning-of-current-line)
3198 ;; line-move can wind up on the same line if long.
3199 ;; when moving forward, that would yield no-progress
3200 (when (and (not backward
)
3201 (<= (point) progress
))
3202 ;; ensure progress by doing line-move from end-of-line:
3204 (condition-case nil
(or (line-move step
) t
)
3206 (allout-beginning-of-current-line)
3207 (setq progress
(point))))
3208 ;; Deal with apparent header line:
3210 (if (not (looking-at allout-regexp
))
3211 ;; not a header line, keep looking:
3213 (allout-prefix-data)
3214 (if (and (allout-do-doublecheck)
3215 (allout-aberrant-container-p))
3216 ;; skip this aberrant prospective header line:
3218 ;; this prospective headerline qualifies -- register:
3219 (setq got allout-recent-prefix-beginning
)
3220 ;; and break the loop:
3222 ;; Register this got, it may be the last:
3223 (if got
(setq prev got
))
3224 (setq arg
(1- arg
)))
3225 (cond (got ; Last move was to a prefix:
3226 (allout-end-of-prefix))
3227 (prev ; Last move wasn't, but prev was:
3229 (allout-end-of-prefix))
3230 ((not backward
) (end-of-line) nil
))))
3231 ;;;_ > allout-previous-visible-heading (arg)
3232 (defun allout-previous-visible-heading (arg)
3233 "Move to the previous heading line.
3235 With argument, repeats or can move forward if negative.
3236 A heading line is one that starts with a `*' (or that `allout-regexp'
3239 (prog1 (allout-next-visible-heading (- arg
))
3240 (if (allout-called-interactively-p) (allout-end-of-prefix))))
3241 ;;;_ > allout-forward-current-level (arg)
3242 (defun allout-forward-current-level (arg)
3243 "Position point at the next heading of the same level.
3245 Takes optional repeat-count, goes backward if count is negative.
3247 Returns resulting position, else nil if none found."
3249 (let ((start-depth (allout-current-depth))
3251 (backward (> 0 arg
)))
3252 (if (= 0 start-depth
)
3253 (error "No siblings, not in a topic..."))
3254 (if backward
(setq arg
(* -
1 arg
)))
3255 (allout-back-to-current-heading)
3256 (while (and (not (zerop arg
))
3258 (allout-previous-sibling)
3259 (allout-next-sibling)))
3260 (setq arg
(1- arg
)))
3261 (if (not (allout-called-interactively-p))
3263 (allout-end-of-prefix)
3264 (if (not (zerop arg
))
3265 (error "Hit %s level %d topic, traversed %d of %d requested"
3266 (if backward
"first" "last")
3268 (- (abs start-arg
) arg
)
3269 (abs start-arg
))))))
3270 ;;;_ > allout-backward-current-level (arg)
3271 (defun allout-backward-current-level (arg)
3272 "Inverse of `allout-forward-current-level'."
3274 (if (allout-called-interactively-p)
3275 (let ((current-prefix-arg (* -
1 arg
)))
3276 (call-interactively 'allout-forward-current-level
))
3277 (allout-forward-current-level (* -
1 arg
))))
3282 ;;;_ = allout-post-goto-bullet
3283 (defvar allout-post-goto-bullet nil
3284 "Outline internal var, for `allout-pre-command-business' hot-spot operation.
3286 When set, tells post-processing to reposition on topic bullet, and
3287 then unset it. Set by `allout-pre-command-business' when implementing
3288 hot-spot operation, where literal characters typed over a topic bullet
3289 are mapped to the command of the corresponding control-key on the
3290 `allout-mode-map-value'.")
3291 (make-variable-buffer-local 'allout-post-goto-bullet
)
3292 ;;;_ = allout-command-counter
3293 (defvar allout-command-counter
0
3294 "Counter that monotonically increases in allout-mode buffers.
3296 Set by `allout-pre-command-business', to support allout addons in
3297 coordinating with allout activity.")
3298 (make-variable-buffer-local 'allout-command-counter
)
3299 ;;;_ = allout-this-command-hid-text
3300 (defvar allout-this-command-hid-text nil
3301 "True if the most recent allout-mode command hid any text.")
3302 (make-variable-buffer-local 'allout-this-command-hid-text
)
3303 ;;;_ > allout-post-command-business ()
3304 (defun allout-post-command-business ()
3305 "Outline `post-command-hook' function.
3307 - Implement (and clear) `allout-post-goto-bullet', for hot-spot
3310 - Move the cursor to the beginning of the entry if it is hidden
3311 and collapsing activity just happened.
3313 - If the command we're following was an undo, check for change in
3314 the status of encrypted items and adjust auto-save inhibitions
3317 - Decrypt topic currently being edited if it was encrypted for a save."
3319 (if (not (allout-mode-p)) ; In allout-mode.
3322 (when allout-just-did-undo
3323 (setq allout-just-did-undo nil
)
3324 (run-hooks 'allout-post-undo-hook
)
3325 (cond ((and (= buffer-saved-size -
1)
3326 allout-auto-save-temporarily-disabled
)
3327 ;; user possibly undid a decryption, disinhibit auto-save:
3328 (allout-maybe-resume-auto-save-info-after-encryption))
3332 (goto-char (point-min))
3333 (not (allout-next-topic-pending-encryption))))
3334 ;; plain-text encrypted items are present, inhibit auto-save:
3335 (allout-inhibit-auto-save-info-for-decryption (buffer-size)))))
3337 (if (and (boundp 'allout-after-save-decrypt
)
3338 allout-after-save-decrypt
)
3339 (allout-after-saves-handler))
3341 ;; Implement allout-post-goto-bullet, if set:
3342 (if (and allout-post-goto-bullet
3343 (allout-current-bullet-pos))
3344 (progn (goto-char (allout-current-bullet-pos))
3345 (setq allout-post-goto-bullet nil
))
3346 (when (and (allout-hidden-p) allout-this-command-hid-text
)
3347 (allout-beginning-of-current-entry)))))
3348 ;;;_ > allout-pre-command-business ()
3349 (defun allout-pre-command-business ()
3350 "Outline `pre-command-hook' function for outline buffers.
3352 Among other things, implements special behavior when the cursor is on the
3353 topic bullet character.
3355 When the cursor is on the bullet character, self-insert
3356 characters are reinterpreted as the corresponding
3357 control-character in the `allout-mode-map-value'. The
3358 `allout-mode' `post-command-hook' insures that the cursor which
3359 has moved as a result of such reinterpretation is positioned on
3360 the bullet character of the destination topic.
3362 The upshot is that you can get easy, single (ie, unmodified) key
3363 outline maneuvering operations by positioning the cursor on the bullet
3364 char. When in this mode you can use regular cursor-positioning
3365 command/keystrokes to relocate the cursor off of a bullet character to
3366 return to regular interpretation of self-insert characters."
3368 (if (not (allout-mode-p))
3370 (setq allout-command-counter
(1+ allout-command-counter
))
3371 (setq allout-this-command-hid-text nil
)
3372 ;; Do hot-spot navigation.
3373 (if (and (eq this-command
'self-insert-command
)
3374 (eq (point)(allout-current-bullet-pos)))
3375 (allout-hotspot-key-handler))))
3376 ;;;_ > allout-hotspot-key-handler ()
3377 (defun allout-hotspot-key-handler ()
3378 "Catchall handling of key bindings in hot-spots.
3380 Translates unmodified keystrokes to corresponding allout commands, when
3381 they would qualify if prefixed with the `allout-command-prefix', and sets
3382 `this-command' accordingly.
3384 Returns the qualifying command, if any, else nil."
3386 (let* ((modified (event-modifiers last-command-event
))
3387 (key-num (cond ((numberp last-command-event
) last-command-event
)
3388 ;; for XEmacs character type:
3389 ((and (fboundp 'characterp
)
3390 (apply 'characterp
(list last-command-event
)))
3391 (apply 'char-to-int
(list last-command-event
)))
3399 ;; exclude control chars and escape:
3402 (setq mapped-binding
3404 ;; try control-modified versions of keys:
3405 (key-binding (vconcat allout-command-prefix
3407 (if (and (<= 97 key-num
) ; "a"
3408 (>= 122 key-num
)) ; "z"
3409 (- key-num
96) key-num
)))
3411 ;; try non-modified versions of keys:
3412 (key-binding (vconcat allout-command-prefix
3415 ;; Qualified as an allout command -- do hot-spot operation.
3416 (setq allout-post-goto-bullet t
)
3417 ;; accept-defaults nil, or else we get allout-item-icon-key-handler.
3418 (setq mapped-binding
(key-binding (vector key-num
))))
3420 (while (keymapp mapped-binding
)
3421 (setq mapped-binding
3422 (lookup-key mapped-binding
(vector (read-char)))))
3424 (when mapped-binding
3425 (setq this-command mapped-binding
)))))
3427 ;;;_ > allout-find-file-hook ()
3428 (defun allout-find-file-hook ()
3429 "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'.
3431 See `allout-auto-activation' for setup instructions."
3432 (if (and allout-auto-activation
3433 (not (allout-mode-p))
3437 ;;;_ - Topic Format Assessment
3438 ;;;_ > allout-solicit-alternate-bullet (depth &optional current-bullet)
3439 (defun allout-solicit-alternate-bullet (depth &optional current-bullet
)
3441 "Prompt for and return a bullet char as an alternative to the current one.
3443 Offer one suitable for current depth DEPTH as default."
3445 (let* ((default-bullet (or (and (stringp current-bullet
) current-bullet
)
3446 (allout-bullet-for-depth depth
)))
3447 (sans-escapes (allout-regexp-sans-escapes allout-bullets-string
))
3450 (goto-char (allout-current-bullet-pos))
3451 (setq choice
(allout-solicit-char-in-string
3453 "Select bullet: %s (`%s' default): "
3455 (allout-substring-no-properties default-bullet
))
3459 (if (string= choice
"") default-bullet choice
))
3461 ;;;_ > allout-distinctive-bullet (bullet)
3462 (defun allout-distinctive-bullet (bullet)
3463 "True if BULLET is one of those on `allout-distinctive-bullets-string'."
3464 (string-match (regexp-quote bullet
) allout-distinctive-bullets-string
))
3465 ;;;_ > allout-numbered-type-prefix (&optional prefix)
3466 (defun allout-numbered-type-prefix (&optional prefix
)
3467 "True if current header prefix bullet is numbered bullet."
3468 (and allout-numbered-bullet
3469 (string= allout-numbered-bullet
3471 (allout-get-prefix-bullet prefix
)
3472 (allout-get-bullet)))))
3473 ;;;_ > allout-encrypted-type-prefix (&optional prefix)
3474 (defun allout-encrypted-type-prefix (&optional prefix
)
3475 "True if current header prefix bullet is for an encrypted entry (body)."
3476 (and allout-topic-encryption-bullet
3477 (string= allout-topic-encryption-bullet
3479 (allout-get-prefix-bullet prefix
)
3480 (allout-get-bullet)))))
3481 ;;;_ > allout-bullet-for-depth (&optional depth)
3482 (defun allout-bullet-for-depth (&optional depth
)
3483 "Return outline topic bullet suited to optional DEPTH, or current depth."
3484 ;; Find bullet in plain-bullets-string modulo DEPTH.
3485 (if allout-stylish-prefixes
3486 (char-to-string (aref allout-plain-bullets-string
3487 (%
(max 0 (- depth
2))
3488 allout-plain-bullets-string-len
)))
3489 allout-primary-bullet
)
3492 ;;;_ - Topic Production
3493 ;;;_ > allout-make-topic-prefix (&optional prior-bullet
3494 (defun allout-make-topic-prefix (&optional prior-bullet
3500 ;; Depth null means use current depth, non-null means we're either
3501 ;; opening a new topic after current topic, lower or higher, or we're
3502 ;; changing level of current topic.
3503 ;; Instead dominates specified bullet-char.
3505 "Generate a topic prefix suitable for optional arg DEPTH, or current depth.
3507 All the arguments are optional.
3509 PRIOR-BULLET indicates the bullet of the prefix being changed, or
3510 nil if none. This bullet may be preserved (other options
3511 notwithstanding) if it is on the `allout-distinctive-bullets-string',
3514 Second arg NEW indicates that a new topic is being opened after the
3515 topic at point, if non-nil. Default bullet for new topics, eg, may
3516 be set (contingent to other args) to numbered bullets if previous
3517 sibling is one. The implication otherwise is that the current topic
3518 is being adjusted -- shifted or rebulleted -- and we don't consider
3519 bullet or previous sibling.
3521 Third arg DEPTH forces the topic prefix to that depth, regardless of
3522 the current topics' depth.
3526 - nil, then the bullet char for the context is used, per distinction or depth
3527 - a (numeric) character, then character's string representation is used
3528 - a string, then the user is asked for bullet with the first char as default
3529 - anything else, the user is solicited with bullet char per context as default
3531 \(INSTEAD overrides other options, including, eg, a distinctive
3534 Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet'
3535 is non-nil *and* no specific INSTEAD was specified. Then
3536 NUMBER-CONTROL non-nil forces prefix to either numbered or
3537 unnumbered format, depending on the value of the sixth arg, INDEX.
3539 \(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...)
3541 If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then
3542 the prefix of the topic is forced to be numbered. Non-nil
3543 NUMBER-CONTROL and nil INDEX forces non-numbered format on the
3544 bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means
3545 that the index for the numbered prefix will be derived, by counting
3546 siblings back to start of level. If INDEX is a number, then that
3547 number is used as the index for the numbered prefix (allowing, eg,
3548 sequential renumbering to not require this function counting back the
3549 index for each successive sibling)."
3551 ;; The options are ordered in likely frequency of use, most common
3552 ;; highest, least lowest. Ie, more likely to be doing prefix
3553 ;; adjustments than soliciting, and yet more than numbering.
3554 ;; Current prefix is least dominant, but most likely to be commonly
3560 (depth (or depth
(allout-depth)))
3561 (header-lead allout-header-prefix
)
3564 ;; Getting value for bullet char is practically the whole job:
3567 ; Simplest situation -- level 1:
3568 ((<= depth
1) (setq header-lead
"") allout-primary-bullet
)
3569 ; Simple, too: all asterisks:
3570 (allout-old-style-prefixes
3571 ;; Cheat -- make body the whole thing, null out header-lead and
3573 (setq body
(make-string depth
3574 (string-to-char allout-primary-bullet
)))
3575 (setq header-lead
"")
3578 ;; (Neither level 1 nor old-style, so we're space padding.
3579 ;; Sneak it in the condition of the next case, whatever it is.)
3581 ;; Solicitation overrides numbering and other cases:
3582 ((progn (setq body
(make-string (- depth
2) ?\
))
3583 ;; The actual condition:
3585 (let ((got (cond ((stringp instead
)
3586 (if (> (length instead
) 0)
3587 (allout-solicit-alternate-bullet
3588 depth
(substring instead
0 1))))
3589 ((characterp instead
) (char-to-string instead
))
3590 (t (allout-solicit-alternate-bullet depth
)))))
3591 ;; Gotta check whether we're numbering and got a numbered bullet:
3592 (setq numbering
(and allout-numbered-bullet
3593 (not (and number-control
(not index
)))
3594 (string= got allout-numbered-bullet
)))
3595 ;; Now return what we got, regardless:
3598 ;; Numbering invoked through args:
3599 ((and allout-numbered-bullet number-control
)
3600 (if (setq numbering
(not (setq denumbering
(not index
))))
3601 allout-numbered-bullet
3602 (if (and prior-bullet
3603 (not (string= allout-numbered-bullet
3606 (allout-bullet-for-depth depth
))))
3608 ;;; Neither soliciting nor controlled numbering ;;;
3609 ;;; (may be controlled denumbering, tho) ;;;
3611 ;; Check wrt previous sibling:
3612 ((and new
; only check for new prefixes
3613 (<= depth
(allout-depth))
3614 allout-numbered-bullet
; ... & numbering enabled
3616 (let ((sibling-bullet
3618 ;; Locate correct sibling:
3619 (or (>= depth
(allout-depth))
3620 (allout-ascend-to-depth depth
))
3621 (allout-get-bullet))))
3622 (if (and sibling-bullet
3623 (string= allout-numbered-bullet sibling-bullet
))
3624 (setq numbering sibling-bullet
)))))
3626 ;; Distinctive prior bullet?
3628 (allout-distinctive-bullet prior-bullet
)
3629 ;; Either non-numbered:
3630 (or (not (and allout-numbered-bullet
3631 (string= prior-bullet allout-numbered-bullet
)))
3632 ;; or numbered, and not denumbering:
3633 (setq numbering
(not denumbering
)))
3637 ;; Else, standard bullet per depth:
3638 ((allout-bullet-for-depth depth
)))))
3644 (format "%d" (cond ((and index
(numberp index
)) index
)
3645 (new (1+ (allout-sibling-index depth
)))
3646 ((allout-sibling-index))))))
3649 ;;;_ > allout-open-topic (relative-depth &optional before offer-recent-bullet)
3650 (defun allout-open-topic (relative-depth &optional before offer-recent-bullet
)
3651 "Open a new topic at depth DEPTH.
3653 New topic is situated after current one, unless optional flag BEFORE
3654 is non-nil, or unless current line is completely empty -- lacking even
3655 whitespace -- in which case open is done on the current line.
3657 When adding an offspring, it will be added immediately after the parent if
3658 the other offspring are exposed, or after the last child if the offspring
3659 are hidden. (The intervening offspring will be exposed in the latter
3662 If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
3666 - Creation of new topics is with respect to the visible topic
3667 containing the cursor, regardless of intervening concealed ones.
3669 - New headers are generally created after/before the body of a
3670 topic. However, they are created right at cursor location if the
3671 cursor is on a blank line, even if that breaks the current topic
3672 body. This is intentional, to provide a simple means for
3673 deliberately dividing topic bodies.
3675 - Double spacing of topic lists is preserved. Also, the first
3676 level two topic is created double-spaced (and so would be
3677 subsequent siblings, if that's left intact). Otherwise,
3678 single-spacing is used.
3680 - Creation of sibling or nested topics is with respect to the topic
3681 you're starting from, even when creating backwards. This way you
3682 can easily create a sibling in front of the current topic without
3683 having to go to its preceding sibling, and then open forward
3686 (allout-beginning-of-current-line)
3688 (let* ((inhibit-field-text-motion t
)
3689 (depth (+ (allout-current-depth) relative-depth
))
3690 (opening-on-blank (if (looking-at "^$")
3691 (not (setq before nil
))))
3692 ;; bunch o vars set while computing ref-topic
3696 (ref-topic (save-excursion
3697 (cond ((< relative-depth
0)
3698 (allout-ascend-to-depth depth
))
3699 ((>= relative-depth
1) nil
)
3700 (t (allout-back-to-current-heading)))
3701 (setq ref-depth allout-recent-depth
)
3703 (if (> allout-recent-prefix-end
1)
3704 (allout-recent-bullet)
3706 (setq opening-numbered
3708 (and allout-numbered-bullet
3709 (or (<= relative-depth
0)
3710 (allout-descend-to-depth depth
))
3711 (if (allout-numbered-type-prefix)
3712 allout-numbered-bullet
))))
3718 (if (not opening-on-blank
)
3719 ; Positioning and vertical
3720 ; padding -- only if not
3723 (goto-char ref-topic
)
3724 (setq dbl-space
; Determine double space action:
3725 (or (and (<= relative-depth
0) ; not descending;
3727 ;; at b-o-b or preceded by a blank line?
3728 (or (> 0 (forward-line -
1))
3729 (looking-at "^\\s-*$")
3732 ;; succeeded by a blank line?
3733 (allout-end-of-current-subtree)
3734 (looking-at "\n\n")))
3735 (and (= ref-depth
1)
3739 ;; Don't already have following
3740 ;; vertical padding:
3741 (not (allout-pre-next-prefix)))))))
3743 ;; Position to prior heading, if inserting backwards, and not
3745 (if (and before
(>= relative-depth
0))
3746 (progn (allout-back-to-current-heading)
3747 (setq doing-beginning
(bobp))
3749 (allout-previous-heading)))
3750 (if (and before
(bobp))
3753 (if (<= relative-depth
0)
3754 ;; Not going inwards, don't snug up:
3760 (progn (end-of-line)
3761 (allout-pre-next-prefix)
3762 (while (and (= ?
\n (following-char))
3767 (if (not (looking-at "^$"))
3769 (allout-end-of-current-subtree)
3770 (if (looking-at "\n\n") (forward-char 1))))
3771 ;; Going inwards -- double-space if first offspring is
3772 ;; double-spaced, otherwise snug up.
3773 (allout-end-of-entry)
3777 (allout-beginning-of-current-line)
3780 ;; Blank lines between current header body and next
3781 ;; header -- get to last substantive (non-white-space)
3783 (progn (setq dbl-space t
)
3784 (re-search-backward "[^ \t\n]" nil t
)))
3785 (if (looking-at "\n\n")
3788 (allout-next-heading)
3789 (when (> allout-recent-depth ref-depth
)
3790 ;; This is an offspring.
3792 (looking-at "^\\s-*$")))
3793 (progn (forward-line 1)
3796 (allout-end-of-current-line))
3798 ;;(if doing-beginning (goto-char doing-beginning))
3800 ;; We insert a newline char rather than using open-line to
3801 ;; avoid rear-stickiness inheritance of read-only property.
3802 (progn (if (and (not (> depth ref-depth
))
3805 (if (and (not dbl-space
) (> depth ref-depth
))
3811 (if (and dbl-space
(not (> relative-depth
0)))
3813 (if (and (not (eobp))
3816 ;; bolp doesn't detect concealed
3817 ;; trailing newlines, compensate:
3820 (allout-hidden-p)))))
3823 (setq start
(point))
3824 (insert (concat (allout-make-topic-prefix opening-numbered t depth
)
3826 (setq end
(1+ (point)))
3828 (allout-rebullet-heading (and offer-recent-bullet ref-bullet
)
3830 (if (> relative-depth
0)
3831 (save-excursion (goto-char ref-topic
)
3832 (allout-show-children)))
3835 (run-hook-with-args 'allout-structure-added-functions start end
)
3839 ;;;_ > allout-open-subtopic (arg)
3840 (defun allout-open-subtopic (arg)
3841 "Open new topic header at deeper level than the current one.
3843 Negative universal ARG means to open deeper, but place the new topic
3844 prior to the current one."
3846 (allout-open-topic 1 (> 0 arg
) (< 1 arg
)))
3847 ;;;_ > allout-open-sibtopic (arg)
3848 (defun allout-open-sibtopic (arg)
3849 "Open new topic header at same level as the current one.
3851 Positive universal ARG means to use the bullet of the prior sibling.
3853 Negative universal ARG means to place the new topic prior to the current
3856 (allout-open-topic 0 (> 0 arg
) (not (= 1 arg
))))
3857 ;;;_ > allout-open-supertopic (arg)
3858 (defun allout-open-supertopic (arg)
3859 "Open new topic header at shallower level than the current one.
3861 Negative universal ARG means to open shallower, but place the new
3862 topic prior to the current one."
3865 (allout-open-topic -
1 (> 0 arg
) (< 1 arg
)))
3867 ;;;_ - Outline Alteration
3868 ;;;_ : Topic Modification
3869 ;;;_ = allout-former-auto-filler
3870 (defvar allout-former-auto-filler nil
3871 "Name of modal fill function being wrapped by `allout-auto-fill'.")
3872 ;;;_ > allout-auto-fill ()
3873 (defun allout-auto-fill ()
3874 "`allout-mode' autofill function.
3876 Maintains outline hanging topic indentation if
3877 `allout-use-hanging-indents' is set."
3879 (when (and (not allout-inhibit-auto-fill
)
3880 (or (not allout-inhibit-auto-fill-on-headline
)
3881 (not (allout-on-current-heading-p))))
3882 (let ((fill-prefix (if allout-use-hanging-indents
3883 ;; Check for topic header indentation:
3887 (if (looking-at allout-regexp
)
3888 ;; ... construct indentation to account for
3889 ;; length of topic prefix:
3890 (make-string (progn (allout-end-of-prefix)
3893 (use-auto-fill-function
3894 (if (and (eq allout-outside-normal-auto-fill-function
3896 (eq auto-fill-function
'allout-auto-fill
))
3898 (or allout-outside-normal-auto-fill-function
3899 auto-fill-function
))))
3900 (if (or allout-former-auto-filler allout-use-hanging-indents
)
3901 (funcall use-auto-fill-function
)))))
3902 ;;;_ > allout-reindent-body (old-depth new-depth &optional number)
3903 (defun allout-reindent-body (old-depth new-depth
&optional _number
)
3904 "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH.
3906 Optional arg NUMBER indicates numbering is being added, and it must
3909 Note that refill of indented paragraphs is not done."
3912 (allout-end-of-prefix)
3913 (let* ((new-margin (current-column))
3914 excess old-indent-begin old-indent-end
3915 ;; We want the column where the header-prefix text started
3916 ;; *before* the prefix was changed, so we infer it relative
3917 ;; to the new margin and the shift in depth:
3918 (old-margin (+ old-depth
(- new-margin new-depth
))))
3920 ;; Process lines up to (but excluding) next topic header:
3924 (and (re-search-forward "\n\\(\\s-*\\)"
3927 ;; Register the indent data, before we reset the
3928 ;; match data with a subsequent `looking-at':
3929 (setq old-indent-begin
(match-beginning 1)
3930 old-indent-end
(match-end 1))
3931 (not (looking-at allout-regexp
)))
3932 (if (> 0 (setq excess
(- (- old-indent-end old-indent-begin
)
3934 ;; Text starts left of old margin -- don't adjust:
3936 ;; Text was hanging at or right of old left margin --
3937 ;; reindent it, preserving its existing indentation
3938 ;; beyond the old margin:
3939 (delete-region old-indent-begin old-indent-end
)
3940 (indent-to (+ new-margin excess
(current-column))))))))))
3941 ;;;_ > allout-rebullet-current-heading (arg)
3942 (defun allout-rebullet-current-heading (arg)
3943 "Solicit new bullet for current visible heading."
3945 (let ((initial-col (current-column))
3946 (on-bullet (eq (point)(allout-current-bullet-pos)))
3948 (backwards (if (< arg
0)
3949 (setq arg
(* arg -
1)))))
3951 (save-excursion (allout-back-to-current-heading)
3952 (allout-end-of-prefix)
3953 (setq from allout-recent-prefix-beginning
3954 to allout-recent-prefix-end
)
3955 (allout-rebullet-heading t
;;; instead
3957 nil
;;; number-control
3959 t
) ;;; do-successors
3960 (run-hook-with-args 'allout-exposure-change-functions
3965 (setq initial-col nil
) ; Override positioning back to init col
3967 (allout-next-visible-heading 1)
3968 (allout-goto-prefix-doublechecked)
3969 (allout-next-visible-heading -
1))))
3971 (cond (on-bullet (goto-char (allout-current-bullet-pos)))
3972 (initial-col (move-to-column initial-col
)))))
3973 ;;;_ > allout-rebullet-heading (&optional instead ...)
3974 (defun allout-rebullet-heading (&optional instead
3980 "Adjust bullet of current topic prefix.
3982 All args are optional.
3985 - nil, then the bullet char for the context is used, per distinction or depth
3986 - a (numeric) character, then character's string representation is used
3987 - a string, then the user is asked for bullet with the first char as default
3988 - anything else, the user is solicited with bullet char per context as default
3990 Second arg DEPTH forces the topic prefix to that depth, regardless
3991 of the topic's current depth.
3993 Third arg NUMBER-CONTROL can force the prefix to or away from
3994 numbered form. It has effect only if `allout-numbered-bullet' is
3995 non-nil and soliciting was not explicitly invoked (via first arg).
3996 Its effect, numbering or denumbering, then depends on the setting
3997 of the fourth arg, INDEX.
3999 If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the
4000 prefix of the topic is forced to be non-numbered. Null index and
4001 non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
4002 non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
4003 INDEX is a number, then that number is used for the numbered
4004 prefix. Non-nil and non-number means that the index for the
4005 numbered prefix will be derived by allout-make-topic-prefix.
4007 Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
4010 Cf vars `allout-stylish-prefixes', `allout-old-style-prefixes',
4011 and `allout-numbered-bullet', which all affect the behavior of
4014 (let* ((current-depth (allout-depth))
4015 (new-depth (or new-depth current-depth
))
4016 (mb allout-recent-prefix-beginning
)
4017 (me allout-recent-prefix-end
)
4018 (current-bullet (buffer-substring-no-properties (- me
1) me
))
4019 (has-annotation (get-text-property mb
'allout-was-hidden
))
4020 (new-prefix (allout-make-topic-prefix current-bullet
4027 ;; Is new one identical to old?
4028 (if (and (= current-depth new-depth
)
4029 (string= current-bullet
4030 (substring new-prefix
(1- (length new-prefix
)))))
4034 ;; New prefix probably different from old:
4035 ; get rid of old one:
4036 (allout-unprotected (delete-region mb me
))
4038 ; Dispense with number if
4039 ; numbered-bullet prefix:
4041 (if (and allout-numbered-bullet
4042 (string= allout-numbered-bullet current-bullet
)
4043 (looking-at "[0-9]+"))
4045 (delete-region (match-beginning 0)(match-end 0)))))
4047 ;; convey 'allout-was-hidden annotation, if original had it:
4049 (put-text-property 0 (length new-prefix
) 'allout-was-hidden t
4052 ; Put in new prefix:
4053 (allout-unprotected (insert new-prefix
))
4055 ;; Reindent the body if elected, margin changed, and not encrypted body:
4056 (if (and allout-reindent-bodies
4057 (not (= new-depth current-depth
))
4058 (not (allout-encrypted-topic-p)))
4059 (allout-reindent-body current-depth new-depth
))
4061 (run-hook-with-args 'allout-exposure-change-functions mb me nil
)
4063 ;; Recursively rectify successive siblings of orig topic if
4064 ;; caller elected for it:
4067 (while (allout-next-sibling new-depth nil
)
4069 (cond ((numberp index
) (1+ index
))
4070 ((not number-control
) (allout-sibling-index))))
4071 (if (allout-numbered-type-prefix)
4072 (allout-rebullet-heading nil
;;; instead
4073 new-depth
;;; new-depth
4074 number-control
;;; number-control
4076 nil
))))) ;;;(dont!)do-successors
4077 ) ; (if (and (= current-depth new-depth)...))
4078 ) ; let* ((current-depth (allout-depth))...)
4080 ;;;_ > allout-rebullet-topic (arg)
4081 (defun allout-rebullet-topic (arg &optional sans-offspring
)
4082 "Rebullet the visible topic containing point and all contained subtopics.
4084 Descends into invisible as well as visible topics, however.
4086 When optional SANS-OFFSPRING is non-nil, subtopics are not
4087 shifted. (Shifting a topic outwards without shifting its
4088 offspring is disallowed, since this would create a \"containment
4089 discontinuity\", where the depth difference between a topic and
4090 its immediate offspring is greater than one.)
4092 With repeat count, shift topic depth by that amount."
4094 (let ((start-col (current-column)))
4097 (cond ((null arg
) (setq arg
0))
4098 ((listp arg
) (setq arg
(car arg
))))
4099 ;; Fill the user in, in case we're shifting a big topic:
4100 (if (not (zerop arg
)) (message "Shifting..."))
4101 (allout-back-to-current-heading)
4102 (if (<= (+ allout-recent-depth arg
) 0)
4103 (error "Attempt to shift topic below level 1"))
4104 (allout-rebullet-topic-grunt arg nil nil nil nil sans-offspring
)
4105 (if (not (zerop arg
)) (message "Shifting... done.")))
4106 (move-to-column (max 0 (+ start-col arg
)))))
4107 ;;;_ > allout-rebullet-topic-grunt (&optional relative-depth ...)
4108 (defun allout-rebullet-topic-grunt (&optional relative-depth
4114 "Like `allout-rebullet-topic', but on nearest containing topic
4117 See `allout-rebullet-heading' for rebulleting behavior.
4119 All arguments are optional.
4121 First arg RELATIVE-DEPTH means to shift the depth of the entire
4124 Several subsequent args are for internal recursive use by the function
4125 itself: STARTING-DEPTH, STARTING-POINT, and INDEX.
4127 Finally, if optional SANS-OFFSPRING is non-nil then the offspring
4128 are not shifted. (Shifting a topic outwards without shifting
4129 its offspring is disallowed, since this would create a
4130 \"containment discontinuity\", where the depth difference between
4131 a topic and its immediate offspring is greater than one.)"
4133 ;; XXX the recursion here is peculiar, and in general the routine may
4134 ;; need simplification with refactoring.
4136 (if (and sans-offspring
4138 (< relative-depth
0))
4139 (error (concat "Attempt to shift topic outwards without offspring,"
4140 " would cause containment discontinuity.")))
4142 (let* ((relative-depth (or relative-depth
0))
4143 (new-depth (allout-depth))
4144 (starting-depth (or starting-depth new-depth
))
4145 (on-starting-call (null starting-point
))
4147 ;; Leave index null on starting call, so rebullet-heading
4148 ;; calculates it at what might be new depth:
4149 (and (or (zerop relative-depth
)
4150 (not on-starting-call
))
4151 (allout-sibling-index))))
4152 (starting-index index
)
4153 (moving-outwards (< 0 relative-depth
))
4154 (starting-point (or starting-point
(point)))
4155 (local-point (point)))
4157 ;; Sanity check for excessive promotion done only on starting call:
4158 (and on-starting-call
4160 (> 0 (+ starting-depth relative-depth
))
4161 (error "Attempt to shift topic out beyond level 1"))
4163 (cond ((= starting-depth new-depth
)
4164 ;; We're at depth to work on this one.
4166 ;; When shifting out we work on the children before working on
4167 ;; the parent to avoid interim `allout-aberrant-container-p'
4168 ;; aberrancy, and vice-versa when shifting in:
4169 (if (>= relative-depth
0)
4170 (allout-rebullet-heading nil
4171 (+ starting-depth relative-depth
)
4174 nil
)) ;;; do-successors
4175 (when (not sans-offspring
)
4176 ;; ... and work on subsequent ones which are at greater depth:
4178 (allout-next-heading)
4179 (while (and (not (eobp))
4180 (< starting-depth
(allout-depth)))
4181 (setq index
(1+ index
))
4182 (allout-rebullet-topic-grunt relative-depth
4186 (when (< relative-depth
0)
4188 (goto-char local-point
)
4189 (allout-rebullet-heading nil
;;; instead
4190 (+ starting-depth relative-depth
)
4193 nil
)))) ;;; do-successors
4195 ((< starting-depth new-depth
)
4196 ;; Rare case -- subtopic more than one level deeper than parent.
4197 ;; Treat this one at an even deeper level:
4198 (allout-rebullet-topic-grunt relative-depth
4204 (if on-starting-call
4206 ;; Rectify numbering of former siblings of the adjusted topic,
4207 ;; if topic has changed depth
4208 (if (or do-successors
4209 (and (not (zerop relative-depth
))
4210 (or (= allout-recent-depth starting-depth
)
4211 (= allout-recent-depth
(+ starting-depth
4213 (allout-rebullet-heading nil nil nil nil t
))
4214 ;; Now rectify numbering of new siblings of the adjusted topic,
4215 ;; if depth has been changed:
4216 (progn (goto-char starting-point
)
4217 (if (not (zerop relative-depth
))
4218 (allout-rebullet-heading nil nil nil nil t
)))))
4221 ;;;_ > allout-renumber-to-depth (&optional depth)
4222 (defun allout-renumber-to-depth (&optional depth
)
4223 "Renumber siblings at current depth.
4225 Affects superior topics if optional arg DEPTH is less than current depth.
4227 Returns final depth."
4229 ;; Proceed by level, processing subsequent siblings on each,
4230 ;; ascending until we get shallower than the start depth:
4232 (let ((ascender (allout-depth))
4234 (while (and (not (eobp))
4236 (>= allout-recent-depth depth
)
4237 (>= ascender depth
))
4238 ; Skip over all topics at
4239 ; lesser depths, which can not
4240 ; have been disturbed:
4241 (while (and (not (setq was-eobp
(eobp)))
4242 (> allout-recent-depth ascender
))
4243 (allout-next-heading))
4244 ; Prime ascender for ascension:
4245 (setq ascender
(1- allout-recent-depth
))
4246 (if (>= allout-recent-depth depth
)
4247 (allout-rebullet-heading nil
;;; instead
4249 nil
;;; number-control
4251 t
)) ;;; do-successors
4252 (if was-eobp
(goto-char (point-max)))))
4253 allout-recent-depth
)
4254 ;;;_ > allout-number-siblings (&optional denumber)
4255 (defun allout-number-siblings (&optional denumber
)
4256 "Assign numbered topic prefix to this topic and its siblings.
4258 With universal argument, denumber -- assign default bullet to this
4259 topic and its siblings.
4261 With repeated universal argument (`^U^U'), solicit bullet for each
4262 rebulleting each topic at this level."
4267 (allout-back-to-current-heading)
4268 (allout-beginning-of-level)
4269 (let ((depth allout-recent-depth
)
4270 (index (if (not denumber
) 1))
4271 (use-bullet (equal '(16) denumber
))
4274 (allout-rebullet-heading use-bullet
;;; instead
4276 t
;;; number-control
4278 nil
) ;;; do-successors
4279 (if index
(setq index
(1+ index
)))
4280 (setq more
(allout-next-sibling depth nil
))))))
4281 ;;;_ > allout-shift-in (arg)
4282 (defun allout-shift-in (arg)
4283 "Increase depth of current heading and any items collapsed within it.
4285 With a negative argument, the item is shifted out using
4286 `allout-shift-out', instead.
4288 With an argument greater than one, shift-in the item but not its
4289 offspring, making the item into a sibling of its former children,
4290 and a child of sibling that formerly preceded it.
4292 You are not allowed to shift the first offspring of a topic
4293 inwards, because that would yield a \"containment
4294 discontinuity\", where the depth difference between a topic and
4295 its immediate offspring is greater than one. The first topic in
4296 the file can be adjusted to any positive depth, however."
4300 (allout-shift-out (* arg -
1))
4301 ;; refuse to create a containment discontinuity:
4303 (allout-back-to-current-heading)
4305 (let* ((current-depth allout-recent-depth
)
4306 (start-point (point))
4307 (predecessor-depth (progn
4309 (allout-goto-prefix-doublechecked)
4310 (if (< (point) start-point
)
4313 (if (and (> predecessor-depth
0)
4314 (> (1+ current-depth
)
4315 (1+ predecessor-depth
)))
4316 (error (concat "Disallowed shift deeper than"
4317 " containing topic's children."))
4318 (allout-back-to-current-heading)
4319 (if (< allout-recent-depth
(1+ current-depth
))
4320 (allout-show-children))))))
4321 (let ((where (point)))
4322 (allout-rebullet-topic 1 (and (> arg
1) 'sans-offspring
))
4323 (run-hook-with-args 'allout-structure-shifted-functions arg where
))))
4324 ;;;_ > allout-shift-out (arg)
4325 (defun allout-shift-out (arg)
4326 "Decrease depth of current heading and any topics collapsed within it.
4327 This will make the item a sibling of its former container.
4329 With a negative argument, the item is shifted in using
4330 `allout-shift-in', instead.
4332 With an argument greater than one, shift-out the item's offspring
4333 but not the item itself, making the former children siblings of
4336 With an argument greater than 1, the item's offspring are shifted
4337 out without shifting the item. This will make the immediate
4338 subtopics into siblings of the item."
4341 (allout-shift-in (* arg -
1))
4342 ;; Get proper exposure in this area:
4343 (save-excursion (if (allout-ascend)
4344 (allout-show-children)))
4345 ;; Show collapsed children if there's a successor which will become
4347 (if (and (allout-current-topic-collapsed-p)
4348 (save-excursion (allout-next-sibling)))
4349 (allout-show-children))
4350 (let ((where (and (allout-depth) allout-recent-prefix-beginning
)))
4353 ;; Shift the offspring but not the topic:
4354 (let ((children-chart (allout-chart-subtree 1)))
4355 (if (listp (car children-chart
))
4357 (setq children-chart
(allout-flatten children-chart
)))
4359 (dolist (child-point children-chart
)
4360 (goto-char child-point
)
4361 (allout-shift-out 1))))
4362 (allout-rebullet-topic (* arg -
1))))
4363 (run-hook-with-args 'allout-structure-shifted-functions
(* arg -
1) where
))))
4364 ;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
4365 ;;;_ > allout-kill-line (&optional arg)
4366 (defun allout-kill-line (&optional arg
)
4367 "Kill line, adjusting subsequent lines suitably for outline mode."
4371 (if (or (not (allout-mode-p))
4373 (not (save-match-data (looking-at allout-regexp
))))
4374 ;; Just do a regular kill:
4376 ;; Ah, have to watch out for adjustments:
4377 (let* ((beg (point))
4379 (beg-hidden (allout-hidden-p))
4380 (end-hidden (save-excursion (allout-end-of-current-line)
4383 (depth (allout-depth)))
4385 (allout-annotate-hidden beg end
)
4387 (if (and (not beg-hidden
) (not end-hidden
))
4388 (allout-unprotected (kill-line arg
))
4390 (run-hooks 'allout-after-copy-or-kill-hook
)
4391 (allout-deannotate-hidden beg end
)
4393 (if allout-numbered-bullet
4394 (save-excursion ; Renumber subsequent topics if needed:
4395 (if (not (save-match-data (looking-at allout-regexp
)))
4396 (allout-next-heading))
4397 (allout-renumber-to-depth depth
)))
4398 (run-hook-with-args 'allout-structure-deleted-functions depth
(point))))))
4399 ;;;_ > allout-copy-line-as-kill ()
4400 (defun allout-copy-line-as-kill ()
4401 "Like `allout-kill-topic', but save to kill ring instead of deleting."
4403 (let ((buffer-read-only t
))
4406 (buffer-read-only nil
))))
4407 ;;;_ > allout-kill-topic ()
4408 (defun allout-kill-topic ()
4409 "Kill topic together with subtopics.
4411 Trailing whitespace is killed with a topic if that whitespace:
4413 - would separate the topic from a subsequent sibling
4414 - would separate the topic from the end of buffer
4415 - would not be added to whitespace already separating the topic from the
4418 Topic exposure is marked with text-properties, to be used by
4419 `allout-yank-processing' for exposure recovery."
4422 (let* ((inhibit-field-text-motion t
)
4423 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
4425 (depth allout-recent-depth
))
4426 (allout-end-of-current-subtree)
4427 (if (and (/= (current-column) 0) (not (eobp)))
4430 (if (and (= (following-char) ?
\n)
4432 (or (not (allout-next-heading))
4433 (= depth allout-recent-depth
)))
4434 (and (> (- beg
(point-min)) 3)
4435 (string= (buffer-substring (- beg
2) beg
) "\n\n"))))
4438 (allout-annotate-hidden beg
(setq end
(point)))
4439 (unwind-protect ; for possible barf-if-buffer-read-only.
4440 (allout-unprotected (kill-region beg end
))
4441 (allout-deannotate-hidden beg end
)
4442 (run-hooks 'allout-after-copy-or-kill-hook
)
4445 (allout-renumber-to-depth depth
))
4446 (run-hook-with-args 'allout-structure-deleted-functions depth
(point)))))
4447 ;;;_ > allout-copy-topic-as-kill ()
4448 (defun allout-copy-topic-as-kill ()
4449 "Like `allout-kill-topic', but save to kill ring instead of deleting."
4451 (let ((buffer-read-only t
))
4454 (buffer-read-only (message "Topic copied...")))))
4455 ;;;_ > allout-annotate-hidden (begin end)
4456 (defun allout-annotate-hidden (begin end
)
4457 "Qualify text with properties to indicate exposure status."
4459 (let ((was-modified (buffer-modified-p))
4460 (buffer-read-only nil
))
4461 (allout-deannotate-hidden begin end
)
4464 (let (done next prev overlay
)
4466 ;; at or advance to start of next hidden region:
4467 (if (not (allout-hidden-p))
4470 (allout-next-single-char-property-change (point)
4473 (if (or (not next
) (eq prev next
))
4474 ;; still not at start of hidden area -- must not be any left.
4478 (if (not (allout-hidden-p))
4479 ;; still not at start of hidden area.
4481 (setq overlay
(allout-get-invisibility-overlay))
4482 (setq next
(overlay-end overlay
)
4484 ;; advance to end of this hidden area:
4488 (let ((buffer-undo-list t
))
4489 (put-text-property (overlay-start overlay
) next
4490 'allout-was-hidden t
)))))))))
4491 (set-buffer-modified-p was-modified
)))
4492 ;;;_ > allout-deannotate-hidden (begin end)
4493 (defun allout-deannotate-hidden (begin end
)
4494 "Remove allout hidden-text annotation between BEGIN and END."
4497 (let ((inhibit-read-only t
)
4498 (buffer-undo-list t
))
4499 (remove-text-properties begin
(min end
(point-max))
4500 '(allout-was-hidden t
)))))
4501 ;;;_ > allout-hide-by-annotation (begin end)
4502 (defun allout-hide-by-annotation (begin end
)
4503 "Translate text properties indicating exposure status into actual exposure."
4506 (let ((was-modified (buffer-modified-p))
4509 ;; at or advance to start of next annotation:
4510 (if (not (get-text-property (point) 'allout-was-hidden
))
4511 (setq next
(allout-next-single-char-property-change
4512 (point) 'allout-was-hidden nil end
)))
4513 (if (or (not next
) (eq prev next
))
4514 ;; no more or not advancing -- must not be any left.
4518 (if (not (get-text-property (point) 'allout-was-hidden
))
4519 ;; still not at start of annotation.
4521 ;; advance to just after end of this annotation:
4522 (setq next
(allout-next-single-char-property-change
4523 (point) 'allout-was-hidden nil end
))
4524 (let ((o (make-overlay prev next nil
'front-advance
)))
4525 (overlay-put o
'category
'allout-exposure-category
)
4526 (overlay-put o
'evaporate t
))
4527 (allout-deannotate-hidden prev next
)
4529 (if next
(goto-char next
)))))
4530 (set-buffer-modified-p was-modified
))))
4531 ;;;_ > allout-yank-processing ()
4532 (defun allout-yank-processing (&optional _arg
)
4534 "Incidental allout-specific business to be done just after text yanks.
4536 Does depth adjustment of yanked topics, when:
4538 1 the stuff being yanked starts with a valid outline header prefix, and
4539 2 it is being yanked at the end of a line which consists of only a valid
4542 Also, adjusts numbering of subsequent siblings when appropriate.
4544 Depth adjustment alters the depth of all the topics being yanked
4545 the amount it takes to make the first topic have the depth of the
4546 header into which it's being yanked.
4548 The point is left in front of yanked, adjusted topics, rather than
4549 at the end (and vice-versa with the mark). Non-adjusted yanks,
4550 however, are left exactly like normal, non-allout-specific yanks."
4553 ; Get to beginning, leaving
4554 ; region around subject:
4555 (if (< (allout-mark-marker t
) (point))
4556 (exchange-point-and-mark))
4558 (let* ((subj-beg (point))
4560 (subj-end (allout-mark-marker t
))
4561 ;; 'resituate' if yanking an entire topic into topic header:
4562 (resituate (and (let ((allout-inhibit-aberrance-doublecheck t
))
4563 (allout-e-o-prefix-p))
4564 (looking-at allout-regexp
)
4565 (allout-prefix-data)))
4566 ;; `rectify-numbering' if resituating (where several topics may
4567 ;; be resituating) or yanking a topic into a topic slot (bol):
4568 (rectify-numbering (or resituate
4569 (and into-bol
(looking-at allout-regexp
)))))
4571 ;; Yanking a topic into the start of a topic -- reconcile to fit:
4572 (let* ((inhibit-field-text-motion t
)
4573 (prefix-len (if (not (match-end 1))
4575 (- (match-end 1) subj-beg
)))
4576 (subj-depth allout-recent-depth
)
4577 (prefix-bullet (allout-recent-bullet))
4579 ;; Nil if adjustment unnecessary, otherwise depth to which
4580 ;; adjustment should be made:
4582 (and (goto-char subj-end
)
4584 (goto-char subj-beg
)
4585 (and (looking-at allout-regexp
)
4588 (not (= (point) subj-beg
)))
4589 (looking-at allout-regexp
)
4590 (allout-prefix-data))
4591 allout-recent-depth
)))
4593 (setq rectify-numbering allout-numbered-bullet
)
4595 ; Do the adjustment:
4598 (narrow-to-region subj-beg subj-end
)
4599 ; Trim off excessive blank
4600 ; line at end, if any:
4601 (goto-char (point-max))
4602 (if (looking-at "^$")
4603 (allout-unprotected (delete-char -
1)))
4604 ; Work backwards, with each
4606 ; successively excluding the
4607 ; last processed topic from
4608 ; the narrow region:
4610 (allout-back-to-current-heading)
4611 ; go as high as we can in each bunch:
4612 (while (allout-ascend t
))
4615 (allout-rebullet-topic-grunt (- adjust-to-depth
4618 (if (setq more
(not (bobp)))
4621 (narrow-to-region subj-beg
(point))))))
4622 ;; Remove new heading prefix:
4625 (delete-region (point) (+ (point)
4629 ; and delete residual subj
4630 ; prefix digits and space:
4631 (while (looking-at "[0-9]") (delete-char 1))
4635 ;; Assert new topic's bullet - minimal effort if unchanged:
4636 (allout-rebullet-heading (string-to-char prefix-bullet
)))
4637 (exchange-point-and-mark))))
4638 (if rectify-numbering
4641 ; Give some preliminary feedback:
4642 (message "... reconciling numbers")
4643 ; ... and renumber, in case necessary:
4644 (goto-char subj-beg
)
4645 (if (allout-goto-prefix-doublechecked)
4647 (allout-rebullet-heading nil
;;; instead
4648 (allout-depth) ;;; depth
4649 nil
;;; number-control
4653 (if (or into-bol resituate
)
4654 (allout-hide-by-annotation (point) (allout-mark-marker t
))
4655 (allout-deannotate-hidden (allout-mark-marker t
) (point)))
4657 (exchange-point-and-mark))
4658 (run-hook-with-args 'allout-structure-added-functions subj-beg subj-end
))))
4659 ;;;_ > allout-yank (&optional arg)
4660 (defun allout-yank (&optional arg
)
4661 "`allout-mode' yank, with depth and numbering adjustment of yanked topics.
4663 Non-topic yanks work no differently than normal yanks.
4665 If a topic is being yanked into a bare topic prefix, the depth of the
4666 yanked topic is adjusted to the depth of the topic prefix.
4668 1 we're yanking in an `allout-mode' buffer
4669 2 the stuff being yanked starts with a valid outline header prefix, and
4670 3 it is being yanked at the end of a line which consists of only a valid
4673 If these conditions hold then the depth of the yanked topics are all
4674 adjusted the amount it takes to make the first one at the depth of the
4675 header into which it's being yanked.
4677 The point is left in front of yanked, adjusted topics, rather than
4678 at the end (and vice-versa with the mark). Non-adjusted yanks,
4679 however, (ones that don't qualify for adjustment) are handled
4680 exactly like normal yanks.
4682 Numbering of yanked topics, and the successive siblings at the depth
4683 into which they're being yanked, is adjusted.
4685 `allout-yank-pop' works with `allout-yank' just like normal `yank-pop'
4686 works with normal `yank' in non-outline buffers."
4689 (setq this-command
'yank
)
4693 (allout-yank-processing)))
4694 ;;;_ > allout-yank-pop (&optional arg)
4695 (defun allout-yank-pop (&optional arg
)
4696 "Yank-pop like `allout-yank' when popping to bare outline prefixes.
4698 Adapts level of popped topics to level of fresh prefix.
4700 Note -- prefix changes to distinctive bullets will stick, if followed
4701 by pops to non-distinctive yanks. Bug..."
4704 (setq this-command
'yank
)
4707 (allout-yank-processing)))
4709 ;;;_ - Specialty bullet functions
4710 ;;;_ : File Cross references
4711 ;;;_ > allout-resolve-xref ()
4712 (defun allout-resolve-xref ()
4713 "Pop to file associated with current heading, if it has an xref bullet.
4715 \(Works according to setting of `allout-file-xref-bullet')."
4717 (if (not allout-file-xref-bullet
)
4719 "Outline cross references disabled -- no `allout-file-xref-bullet'")
4720 (if (not (string= (allout-current-bullet) allout-file-xref-bullet
))
4721 (error "Current heading lacks cross-reference bullet `%s'"
4722 allout-file-xref-bullet
)
4723 (let ((inhibit-field-text-motion t
)
4727 (let* ((text-start allout-recent-prefix-end
)
4728 (heading-end (point-at-eol)))
4729 (goto-char text-start
)
4731 (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t
)
4732 (buffer-substring (match-beginning 1)
4734 (setq file-name
(expand-file-name file-name
))
4735 (if (or (file-exists-p file-name
)
4736 (if (file-writable-p file-name
)
4737 (y-or-n-p (format "%s not there, create one? "
4739 (error "%s not found and can't be created" file-name
)))
4740 (condition-case failure
4741 (find-file-other-window file-name
)
4743 (error "%s not found" file-name
))
4749 ;;;_ #6 Exposure Control
4752 ;;;_ > allout-flag-region (from to flag)
4753 (defun allout-flag-region (from to flag
)
4754 "Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
4755 After the exposure changes are made, run the abnormal hook
4756 `allout-exposure-change-functions' with the same arguments as
4759 ;; We use outline invisibility spec.
4760 (remove-overlays from to
'category
'allout-exposure-category
)
4762 (let ((o (make-overlay from to nil
'front-advance
)))
4763 (overlay-put o
'category
'allout-exposure-category
)
4764 (overlay-put o
'evaporate t
)
4765 (when (featurep 'xemacs
)
4766 (let ((props (symbol-plist 'allout-exposure-category
)))
4769 ;; as of 2008-02-27, xemacs lacks modification-hooks
4770 (overlay-put o
(pop props
) (pop props
))
4772 (setq allout-this-command-hid-text t
))
4773 (run-hook-with-args 'allout-exposure-change-functions from to flag
))
4774 ;;;_ > allout-flag-current-subtree (flag)
4775 (defun allout-flag-current-subtree (flag)
4776 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
4779 (allout-back-to-current-heading)
4780 (let ((inhibit-field-text-motion t
))
4782 (allout-flag-region (point)
4783 ;; Exposing must not leave trailing blanks hidden,
4784 ;; but can leave them exposed when hiding, so we
4785 ;; can use flag's inverse as the
4786 ;; include-trailing-blank cue:
4787 (allout-end-of-current-subtree (not flag
))
4790 ;;;_ - Topic-specific
4791 ;;;_ > allout-show-entry ()
4792 (defun allout-show-entry ()
4793 "Like `allout-show-current-entry', but reveals entries in hidden topics.
4795 This is a way to give restricted peek at a concealed locality without the
4796 expense of exposing its context, but can leave the outline with aberrant
4797 exposure. `allout-show-offshoot' should be used after the peek to rectify
4803 (allout-goto-prefix-doublechecked)
4804 (setq beg
(if (allout-hidden-p) (1- (point)) (point)))
4805 (setq end
(allout-pre-next-prefix))
4806 (allout-flag-region beg end nil
)
4808 ;;;_ > allout-show-children (&optional level strict)
4809 (defun allout-show-children (&optional level strict
)
4811 "If point is visible, show all direct subheadings of this heading.
4813 Otherwise, do `allout-show-to-offshoot', and then show subheadings.
4815 Optional LEVEL specifies how many levels below the current level
4816 should be shown, or all levels if t. Default is 1.
4818 Optional STRICT means don't resort to -show-to-offshoot, no matter
4819 what. This is basically so -show-to-offshoot, which is called by
4820 this function, can employ the pure offspring-revealing capabilities of
4823 Returns point at end of subtree that was opened, if any. (May get a
4824 point of non-opened subtree?)"
4827 (let ((start-point (point)))
4828 (if (and (not strict
)
4831 (progn (allout-show-to-offshoot) ; Point's concealed, open to
4833 ;; Then recurse, but with "strict" set so we don't
4834 ;; infinite regress:
4835 (allout-show-children level t
))
4838 (allout-beginning-of-current-line)
4841 ;; translate the level spec for this routine to the ones
4842 ;; used by -chart-subtree and -chart-to-reveal:
4843 (chart-level (cond ((not level
) 1)
4846 (chart (allout-chart-subtree chart-level
))
4847 (to-reveal (or (allout-chart-to-reveal chart chart-level
)
4848 ;; interactive, show discontinuous children:
4850 (allout-called-interactively-p)
4852 (allout-back-to-current-heading)
4853 (setq depth
(allout-current-depth))
4854 (and (allout-next-heading)
4855 (> allout-recent-depth
4858 "Discontinuous offspring; use `%s %s'%s."
4859 (substitute-command-keys
4860 "\\[universal-argument]")
4861 (substitute-command-keys
4862 "\\[allout-shift-out]")
4863 " to elevate them.")
4864 (allout-chart-to-reveal
4865 chart
(- allout-recent-depth depth
))))))
4866 (goto-char start-point
)
4867 (when (and strict
(allout-hidden-p))
4868 ;; Concealed root would already have been taken care of,
4869 ;; unless strict was set.
4870 (allout-flag-region (point) (allout-snug-back) nil
)
4871 (when allout-show-bodies
4872 (goto-char (car to-reveal
))
4873 (allout-show-current-entry)))
4875 (goto-char (car to-reveal
))
4876 (allout-flag-region (save-excursion (allout-snug-back) (point))
4877 (progn (search-forward "\n" nil t
)
4880 (when allout-show-bodies
4881 (goto-char (car to-reveal
))
4882 (allout-show-current-entry))
4883 (setq to-reveal
(cdr to-reveal
)))))))
4884 ;; Compensate for `save-excursion's maintenance of point
4885 ;; within invisible text:
4886 (goto-char start-point
)))
4887 ;;;_ > allout-show-to-offshoot ()
4888 (defun allout-show-to-offshoot ()
4889 "Like `allout-show-entry', but reveals all concealed ancestors, as well.
4891 Useful for coherently exposing to a random point in a hidden region."
4894 (let ((inhibit-field-text-motion t
)
4896 (orig-pref (allout-goto-prefix-doublechecked))
4899 (while (or (> bag-it
1) (allout-hidden-p))
4900 (while (allout-hidden-p)
4901 (move-beginning-of-line 1)
4902 (if (allout-hidden-p) (forward-char -
1)))
4903 (if (= last-at
(setq last-at
(point)))
4904 ;; Oops, we're not making any progress! Show the current topic
4905 ;; completely, and try one more time here, if we haven't already.
4906 (progn (beginning-of-line)
4907 (allout-show-current-subtree)
4909 (setq bag-it
(1+ bag-it
))
4911 (error "allout-show-to-offshoot: %s"
4912 "Stumped by aberrant nesting.")))
4913 (if (> bag-it
0) (setq bag-it
0))
4914 (allout-show-children)
4915 (goto-char orig-pref
)))
4916 (goto-char orig-pt
)))
4917 (if (allout-hidden-p)
4918 (allout-show-entry)))
4919 ;;;_ > allout-hide-current-entry ()
4920 (defun allout-hide-current-entry ()
4921 "Hide the body directly following this heading."
4923 (allout-back-to-current-heading)
4925 (let ((inhibit-field-text-motion t
))
4927 (allout-flag-region (point)
4928 (progn (allout-end-of-entry) (point))
4930 ;;;_ > allout-show-current-entry (&optional arg)
4931 (defun allout-show-current-entry (&optional arg
)
4932 "Show body following current heading, or hide entry with universal argument."
4936 (allout-hide-current-entry)
4937 (save-excursion (allout-show-to-offshoot))
4939 (allout-flag-region (point)
4940 (progn (allout-end-of-entry t
) (point))
4943 ;;;_ > allout-show-current-subtree (&optional arg)
4944 (defun allout-show-current-subtree (&optional arg
)
4945 "Show everything within the current topic.
4946 With a repeat-count, expose this topic and its siblings."
4949 (if (<= (allout-current-depth) 0)
4950 ;; Outside any topics -- try to get to the first:
4951 (if (not (allout-next-heading))
4953 ;; got to first, outermost topic -- set to expose it and siblings:
4954 (message "Above outermost topic -- exposing all.")
4955 (allout-flag-region (point-min)(point-max) nil
))
4956 (allout-beginning-of-current-line)
4958 (allout-flag-current-subtree nil
)
4959 (allout-beginning-of-level)
4960 (allout-expose-topic '(* :))))))
4961 ;;;_ > allout-current-topic-collapsed-p (&optional include-single-liners)
4962 (defun allout-current-topic-collapsed-p (&optional include-single-liners
)
4963 "True if the currently visible containing topic is already collapsed.
4965 Single line topics intrinsically can be considered as being both
4966 collapsed and uncollapsed. If optional INCLUDE-SINGLE-LINERS is
4967 true, then single-line topics are considered to be collapsed. By
4968 default, they are treated as being uncollapsed."
4972 ;; Is the topic all on one line (allowing for trailing blank line)?
4973 (>= (progn (allout-back-to-current-heading)
4974 (let ((inhibit-field-text-motion t
))
4975 (move-end-of-line 1))
4977 (allout-end-of-current-subtree (not (looking-at "\n\n"))))
4979 (or include-single-liners
4980 (progn (backward-char 1) (allout-hidden-p)))))))
4981 ;;;_ > allout-hide-current-subtree (&optional just-close)
4982 (defun allout-hide-current-subtree (&optional just-close
)
4983 "Close the current topic, or containing topic if this one is already closed.
4985 If this topic is closed and it's a top level topic, close this topic
4988 If optional arg JUST-CLOSE is non-nil, do not close the parent or
4989 siblings, even if the target topic is already closed."
4992 (let* ((from (point))
4993 (sibs-msg "Top-level topic already closed -- closing siblings...")
4994 (current-exposed (not (allout-current-topic-collapsed-p t
))))
4995 (cond (current-exposed (allout-flag-current-subtree t
))
4997 ((allout-ascend) (allout-hide-current-subtree))
5000 (allout-goto-prefix-doublechecked)
5001 (allout-expose-topic '(0 :))
5002 (message (concat sibs-msg
" Done."))))
5004 ;;;_ > allout-toggle-current-subtree-exposure
5005 (defun allout-toggle-current-subtree-exposure ()
5006 "Show or hide the current subtree depending on its current state."
5007 ;; thanks to tassilo for suggesting this.
5010 (allout-back-to-heading)
5011 (if (allout-hidden-p (point-at-eol))
5012 (allout-show-current-subtree)
5013 (allout-hide-current-subtree))))
5014 ;;;_ > allout-show-current-branches ()
5015 (defun allout-show-current-branches ()
5016 "Show all subheadings of this heading, but not their bodies."
5018 (let ((inhibit-field-text-motion t
))
5019 (beginning-of-line))
5020 (allout-show-children t
))
5021 ;;;_ > allout-hide-current-leaves ()
5022 (defun allout-hide-current-leaves ()
5023 "Hide the bodies of the current topic and all its offspring."
5025 (allout-back-to-current-heading)
5026 (allout-hide-region-body (point) (progn (allout-end-of-current-subtree)
5029 ;;;_ - Region and beyond
5030 ;;;_ > allout-show-all ()
5031 (defun allout-show-all ()
5032 "Show all of the text in the buffer."
5034 (message "Exposing entire buffer...")
5035 (allout-flag-region (point-min) (point-max) nil
)
5036 (message "Exposing entire buffer... Done."))
5037 ;;;_ > allout-hide-bodies ()
5038 (defun allout-hide-bodies ()
5039 "Hide all of buffer except headings."
5041 (allout-hide-region-body (point-min) (point-max)))
5042 ;;;_ > allout-hide-region-body (start end)
5043 (defun allout-hide-region-body (start end
)
5044 "Hide all body lines in the region, but not headings."
5048 (narrow-to-region start end
)
5049 (goto-char (point-min))
5050 (let ((inhibit-field-text-motion t
))
5053 (allout-flag-region (point) (allout-end-of-entry) t
)
5056 (if (looking-at "\n\n")
5059 ;;;_ > allout-expose-topic (spec)
5060 (defun allout-expose-topic (spec)
5061 "Apply exposure specs to successive outline topic items.
5063 Use the more convenient frontend, `allout-new-exposure', if you don't
5064 need evaluation of the arguments, or even better, the `allout-layout'
5065 variable-keyed mode-activation/auto-exposure feature of allout outline
5066 mode. See the respective documentation strings for more details.
5068 Cursor is left at start position.
5070 SPEC is either a number or a list.
5072 Successive specs on a list are applied to successive sibling topics.
5074 A simple spec (either a number, one of a few symbols, or the null
5075 list) dictates the exposure for the corresponding topic.
5077 Non-null lists recursively designate exposure specs for respective
5078 subtopics of the current topic.
5080 The `:' repeat spec is used to specify exposure for any number of
5081 successive siblings, up to the trailing ones for which there are
5082 explicit specs following the `:'.
5084 Simple (numeric and null-list) specs are interpreted as follows:
5086 Numbers indicate the relative depth to open the corresponding topic.
5087 - negative numbers force the topic to be closed before opening to the
5088 absolute value of the number, so all siblings are open only to
5090 - positive numbers open to the relative depth indicated by the
5091 number, but do not force already opened subtopics to be closed.
5092 - 0 means to close topic -- hide all offspring.
5094 apply prior element to all siblings at current level, *up to*
5095 those siblings that would be covered by specs following the `:'
5096 on the list. Ie, apply to all topics at level but the last
5097 ones. (Only first of multiple colons at same level is
5098 respected -- subsequent ones are discarded.)
5099 * - completely opens the topic, including bodies.
5100 + - shows all the sub headers, but not the bodies
5101 - - exposes the body of the corresponding topic.
5104 \(allout-expose-topic \\='(-1 : 0))
5105 Close this and all following topics at current level, exposing
5106 only their immediate children, but close down the last topic
5107 at this current level completely.
5108 \(allout-expose-topic \\='(-1 () : 1 0))
5109 Close current topic so only the immediate subtopics are shown;
5110 show the children in the second to last topic, and completely
5112 \(allout-expose-topic \\='(-2 : -1 *))
5113 Expose children and grandchildren of all topics at current
5114 level except the last two; expose children of the second to
5115 last and completely open the last one."
5117 (interactive "xExposure spec: ")
5118 (if (not (listp spec
))
5120 (let ((depth (allout-depth))
5125 (setq prev-elem curr-elem
5126 curr-elem
(car spec
)
5128 (cond ; Do current element:
5129 ((null curr-elem
) nil
)
5130 ((symbolp curr-elem
)
5131 (cond ((eq curr-elem
'*) (allout-show-current-subtree)
5132 (if (> allout-recent-end-of-subtree max-pos
)
5133 (setq max-pos allout-recent-end-of-subtree
)))
5135 (if (not (allout-hidden-p))
5136 (save-excursion (allout-hide-current-subtree t
)))
5137 (allout-show-current-branches)
5138 (if (> allout-recent-end-of-subtree max-pos
)
5139 (setq max-pos allout-recent-end-of-subtree
)))
5140 ((eq curr-elem
'-
) (allout-show-current-entry))
5143 ;; Expand the `repeat' spec to an explicit version,
5144 ;; w.r.t. remaining siblings:
5145 (let ((residue ; = # of sibs not covered by remaining spec
5146 ;; Dang, could be nice to make use of the chart, sigh:
5147 (- (length (allout-chart-siblings))
5150 ;; Some residue -- cover it with prev-elem:
5151 (setq spec
(append (make-list residue prev-elem
)
5153 ((numberp curr-elem
)
5154 (if (and (>= 0 curr-elem
) (not (allout-hidden-p)))
5155 (save-excursion (allout-hide-current-subtree t
)
5158 (if (> allout-recent-end-of-subtree max-pos
)
5160 allout-recent-end-of-subtree
)))))
5161 (if (> (abs curr-elem
) 0)
5162 (progn (allout-show-children (abs curr-elem
))
5163 (if (> allout-recent-end-of-subtree max-pos
)
5164 (setq max-pos allout-recent-end-of-subtree
)))))
5166 (if (allout-descend-to-depth (1+ depth
))
5167 (let ((got (allout-expose-topic curr-elem
)))
5168 (if (and got
(> got max-pos
)) (setq max-pos got
))))))
5169 (cond (stay (setq stay nil
))
5170 ((listp (car spec
)) nil
)
5171 ((> max-pos
(point))
5172 ;; Capitalize on max-pos state to get us nearer next sibling:
5173 (progn (goto-char (min (point-max) max-pos
))
5174 (allout-next-heading)))
5175 ((allout-next-sibling depth
))))
5177 ;;;_ > allout-old-expose-topic (spec &rest followers)
5178 (defun allout-old-expose-topic (spec &rest followers
)
5180 "Deprecated. Use `allout-expose-topic' (with different schema
5183 Dictate wholesale exposure scheme for current topic, according to SPEC.
5185 SPEC is either a number or a list. Optional successive args
5186 dictate exposure for subsequent siblings of current topic.
5188 A simple spec (either a number, a special symbol, or the null list)
5189 dictates the overall exposure for a topic. Non null lists are
5190 composite specs whose first element dictates the overall exposure for
5191 a topic, with the subsequent elements in the list interpreted as specs
5192 that dictate the exposure for the successive offspring of the topic.
5194 Simple (numeric and null-list) specs are interpreted as follows:
5196 - Numbers indicate the relative depth to open the corresponding topic:
5197 - negative numbers force the topic to be close before opening to the
5198 absolute value of the number.
5199 - positive numbers just open to the relative depth indicated by the number.
5201 - `*' completely opens the topic, including bodies.
5202 - `+' shows all the sub headers, but not the bodies
5203 - `-' exposes the body and immediate offspring of the corresponding topic.
5205 If the spec is a list, the first element must be a number, which
5206 dictates the exposure depth of the topic as a whole. Subsequent
5207 elements of the list are nested SPECs, dictating the specific exposure
5208 for the corresponding offspring of the topic.
5210 Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
5212 (interactive "xExposure spec: ")
5213 (let ((inhibit-field-text-motion t
)
5214 (depth (allout-current-depth))
5216 (cond ((null spec
) nil
)
5218 (if (eq spec
'*) (allout-show-current-subtree))
5219 (if (eq spec
'+) (allout-show-current-branches))
5220 (if (eq spec
'-
) (allout-show-current-entry)))
5223 (save-excursion (allout-hide-current-subtree t
)
5225 (if (or (not max-pos
)
5226 (> (point) max-pos
))
5227 (setq max-pos
(point)))
5229 (setq spec
(* -
1 spec
)))))
5231 (allout-show-children spec
)))
5233 ;(let ((got (allout-old-expose-topic (car spec))))
5234 ; (if (and got (or (not max-pos) (> got max-pos)))
5235 ; (setq max-pos got)))
5236 (let ((new-depth (+ (allout-current-depth) 1))
5238 (setq max-pos
(allout-old-expose-topic (car spec
)))
5239 (setq spec
(cdr spec
))
5241 (allout-descend-to-depth new-depth
)
5242 (not (allout-hidden-p)))
5243 (progn (setq got
(apply 'allout-old-expose-topic spec
))
5244 (if (and got
(or (not max-pos
) (> got max-pos
)))
5245 (setq max-pos got
)))))))
5246 (while (and followers
5247 (progn (if (and max-pos
(< (point) max-pos
))
5248 (progn (goto-char max-pos
)
5249 (setq max-pos nil
)))
5251 (allout-next-sibling depth
)))
5252 (allout-old-expose-topic (car followers
))
5253 (setq followers
(cdr followers
)))
5255 ;;;_ > allout-new-exposure '()
5256 (defmacro allout-new-exposure
(&rest spec
)
5257 "Literal frontend for `allout-expose-topic', doesn't evaluate arguments.
5258 Some arguments that would need to be quoted in `allout-expose-topic'
5259 need not be quoted in `allout-new-exposure'.
5261 Cursor is left at start position.
5263 Use this instead of obsolete `allout-exposure'.
5266 \(allout-new-exposure (-1 () () () 1) 0)
5267 Close current topic at current level so only the immediate
5268 subtopics are shown, except also show the children of the
5269 third subtopic; and close the next topic at the current level.
5270 \(allout-new-exposure : -1 0)
5271 Close all topics at current level to expose only their
5272 immediate children, except for the last topic at the current
5273 level, in which even its immediate children are hidden.
5274 \(allout-new-exposure -2 : -1 *)
5275 Expose children and grandchildren of first topic at current
5276 level, and expose children of subsequent topics at current
5277 level *except* for the last, which should be opened completely."
5279 (if (not (or (allout-goto-prefix-doublechecked)
5280 (allout-next-heading)))
5281 (error "allout-new-exposure: Can't find any outline topics"))
5282 (allout-expose-topic ',spec
)))
5284 ;;;_ #7 Systematic outline presentation -- copying, printing, flattening
5286 ;;;_ - Mapping and processing of topics
5287 ;;;_ ( See also Subtree Charting, in Navigation code.)
5288 ;;;_ > allout-stringify-flat-index (flat-index)
5289 (defun allout-stringify-flat-index (flat-index &optional context
)
5290 "Convert list representing section/subsection/... to document string.
5292 Optional arg CONTEXT indicates interior levels to include."
5296 (context-depth (or (and context
2) 1)))
5297 ;; Take care of the explicit context:
5298 (while (> context-depth
0)
5299 (setq numstr
(int-to-string (car flat-index
))
5300 flat-index
(cdr flat-index
)
5301 result
(if flat-index
5302 (cons delim
(cons numstr result
))
5303 (cons numstr result
))
5304 context-depth
(if flat-index
(1- context-depth
) 0)))
5306 ;; Take care of the indentation:
5313 (1+ (truncate (if (zerop (car flat-index
))
5315 (log (car flat-index
) 10))))
5318 (setq flat-index
(cdr flat-index
)))
5319 ;; Dispose of single extra delim:
5320 (setq result
(cdr result
))))
5321 (apply 'concat result
)))
5322 ;;;_ > allout-stringify-flat-index-plain (flat-index)
5323 (defun allout-stringify-flat-index-plain (flat-index)
5324 "Convert list representing section/subsection/... to document string."
5328 (setq result
(cons (int-to-string (car flat-index
))
5330 (cons delim result
))))
5331 (setq flat-index
(cdr flat-index
)))
5332 (apply 'concat result
)))
5333 ;;;_ > allout-stringify-flat-index-indented (flat-index)
5334 (defun allout-stringify-flat-index-indented (flat-index)
5335 "Convert list representing section/subsection/... to document string."
5339 ;; Take care of the explicit context:
5340 (setq numstr
(int-to-string (car flat-index
))
5341 flat-index
(cdr flat-index
)
5342 result
(if flat-index
5343 (cons delim
(cons numstr result
))
5344 (cons numstr result
)))
5346 ;; Take care of the indentation:
5353 (1+ (truncate (if (zerop (car flat-index
))
5355 (log (car flat-index
) 10))))
5358 (setq flat-index
(cdr flat-index
)))
5359 ;; Dispose of single extra delim:
5360 (setq result
(cdr result
))))
5361 (apply 'concat result
)))
5362 ;;;_ > allout-listify-exposed (&optional start end format)
5363 (defun allout-listify-exposed (&optional start end format
)
5365 "Produce a list representing exposed topics in current region.
5367 This list can then be used by `allout-process-exposed' to manipulate
5370 Optional START and END indicate bounds of region.
5372 Optional arg, FORMAT, designates an alternate presentation form for
5375 list -- Present prefix as numeric section.subsection..., starting with
5376 section indicated by the list, innermost nesting first.
5377 `indent' (symbol) -- Convert header prefixes to all white space,
5378 except for distinctive bullets.
5380 The elements of the list produced are lists that represents a topic
5381 header and body. The elements of that list are:
5383 - a number representing the depth of the topic,
5384 - a string representing the header-prefix, including trailing whitespace and
5386 - a string representing the bullet character,
5387 - and a series of strings, each containing one line of the exposed
5388 portion of the topic entry."
5393 ((inhibit-field-text-motion t
)
5395 strings prefix result depth new-depth out gone-out bullet beg
5400 ;; Goto initial topic, and register preceding stuff, if any:
5401 (if (> (allout-goto-prefix-doublechecked) start
)
5402 ;; First topic follows beginning point -- register preliminary stuff:
5404 (list (list 0 "" nil
5405 (buffer-substring-no-properties start
5407 (while (and (not done
)
5408 (not (eobp)) ; Loop until we've covered the region.
5409 (not (> (point) end
)))
5410 (setq depth allout-recent-depth
; Current topics depth,
5411 bullet
(allout-recent-bullet) ; ... bullet,
5412 prefix
(allout-recent-prefix)
5413 beg
(progn (allout-end-of-prefix t
) (point))) ; and beginning.
5414 (setq done
; The boundary for the current topic:
5415 (not (allout-next-visible-heading 1)))
5416 (setq new-depth allout-recent-depth
)
5418 out
(< new-depth depth
))
5423 (while (> next
(point)) ; Get all the exposed text in
5425 (cons (buffer-substring-no-properties
5427 ;To hidden text or end of line:
5430 (allout-back-to-visible-text)))
5432 (when (< (point) next
) ; Resume from after hid text, if any.
5434 (beginning-of-line))
5436 ;; Accumulate list for this topic:
5437 (setq strings
(nreverse strings
))
5441 (let ((special (if (string-match
5442 (regexp-quote bullet
)
5443 allout-distinctive-bullets-string
)
5445 (cond ((listp format
)
5447 (if allout-flattened-numbering-abbreviation
5448 (allout-stringify-flat-index format
5450 (allout-stringify-flat-index-plain
5454 ((eq format
'indent
)
5457 (concat (make-string (1+ depth
) ?
)
5458 (substring prefix -
1))
5461 (make-string depth ?
)
5463 (t (error "allout-listify-exposed: %s %s"
5464 "invalid format" format
))))
5465 (list depth prefix strings
))
5467 ;; Reassess format, if any:
5468 (if (and format
(listp format
))
5469 (cond ((= new-depth depth
)
5470 (setq format
(cons (1+ (car format
))
5472 ((> new-depth depth
) ; descending -- assume by 1:
5473 (setq format
(cons 1 format
)))
5476 (while (< new-depth depth
)
5477 (setq format
(cdr format
))
5478 (setq depth
(1- depth
)))
5479 ; And increment the current one:
5481 (cons (1+ (or (car format
)
5484 ;; Put the list with first at front, to last at back:
5485 (nreverse result
))))
5486 ;;;_ > allout-region-active-p ()
5487 (defmacro allout-region-active-p
()
5488 (cond ((fboundp 'use-region-p
) '(use-region-p))
5489 ((fboundp 'region-active-p
) '(region-active-p))
5491 ;;_ > allout-process-exposed (&optional func from to frombuf
5493 (defun allout-process-exposed (&optional func from to frombuf tobuf
5495 "Map function on exposed parts of current topic; results to another buffer.
5497 All args are options; default values itemized below.
5499 Apply FUNCTION to exposed portions FROM position TO position in buffer
5500 FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
5501 alternate presentation form:
5503 `flat' -- Present prefix as numeric section.subsection..., starting with
5504 section indicated by the START-NUM, innermost nesting first.
5505 X`flat-indented' -- Prefix is like `flat' for first topic at each
5506 X level, but subsequent topics have only leaf topic
5507 X number, padded with blanks to line up with first.
5508 `indent' (symbol) -- Convert header prefixes to all white space,
5509 except for distinctive bullets.
5512 FUNCTION: `allout-insert-listified'
5513 FROM: region start, if region active, else start of buffer
5514 TO: region end, if region active, else end of buffer
5515 FROMBUF: current buffer
5516 TOBUF: buffer name derived: \"*current-buffer-name exposed*\"
5519 ; Resolve arguments,
5520 ; defaulting if necessary:
5521 (if (not func
) (setq func
'allout-insert-listified
))
5522 (if (not (and from to
))
5523 (if (allout-region-active-p)
5524 (setq from
(region-beginning) to
(region-end))
5525 (setq from
(point-min) to
(point-max))))
5527 (if (not (bufferp frombuf
))
5528 ;; Specified but not a buffer -- get it:
5529 (let ((got (get-buffer frombuf
)))
5531 (error "allout-process-exposed: source buffer %s not found."
5533 (setq frombuf got
))))
5534 ;; not specified -- default it:
5535 (setq frombuf
(current-buffer)))
5537 (if (not (bufferp tobuf
))
5538 (setq tobuf
(get-buffer-create tobuf
)))
5539 ;; not specified -- default it:
5540 (setq tobuf
(concat "*" (buffer-name frombuf
) " exposed*")))
5545 (progn (set-buffer frombuf
)
5546 (allout-listify-exposed from to format
))))
5548 (mapc func listified
)
5549 (pop-to-buffer tobuf
)))
5552 ;;;_ > allout-insert-listified (listified)
5553 (defun allout-insert-listified (listified)
5554 "Insert contents of listified outline portion in current buffer.
5556 LISTIFIED is a list representing each topic header and body:
5558 `(depth prefix text)'
5560 or `(depth prefix text bullet-plus)'
5562 If `bullet-plus' is specified, it is inserted just after the entire prefix."
5563 (setq listified
(cdr listified
))
5564 (let ((prefix (prog1
5566 (setq listified
(cdr listified
))))
5569 (setq listified
(cdr listified
))))
5570 (bullet-plus (car listified
)))
5572 (if bullet-plus
(insert (concat " " bullet-plus
)))
5575 (if (setq text
(cdr text
))
5578 ;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format)
5579 (defun allout-copy-exposed-to-buffer (&optional arg tobuf format
)
5580 "Duplicate exposed portions of current outline to another buffer.
5582 Other buffer has current buffers name with \" exposed\" appended to it.
5584 With repeat count, copy the exposed parts of only the current topic.
5586 Optional second arg TOBUF is target buffer name.
5588 Optional third arg FORMAT, if non-nil, symbolically designates an
5589 alternate presentation format for the outline:
5591 `flat' - Convert topic header prefixes to numeric
5592 section.subsection... identifiers.
5593 `indent' - Convert header prefixes to all white space, except for
5594 distinctive bullets.
5595 `indent-flat' - The best of both - only the first of each level has
5596 the full path, the rest have only the section number
5597 of the leaf, preceded by the right amount of indentation."
5601 (setq tobuf
(get-buffer-create (concat "*" (buffer-name) " exposed*"))))
5602 (let* ((start-pt (point))
5603 (beg (if arg
(allout-back-to-current-heading) (point-min)))
5604 (end (if arg
(allout-end-of-current-subtree) (point-max)))
5605 (buf (current-buffer))
5607 (if (eq format
'flat
)
5608 (setq format
(if arg
(save-excursion
5610 (allout-topic-flat-index))
5612 (with-current-buffer tobuf
(erase-buffer))
5613 (allout-process-exposed 'allout-insert-listified
5619 (goto-char (point-min))
5621 (goto-char start-pt
)))
5622 ;;;_ > allout-flatten-exposed-to-buffer (&optional arg tobuf)
5623 (defun allout-flatten-exposed-to-buffer (&optional arg tobuf
)
5624 "Present numeric outline of outline's exposed portions in another buffer.
5626 The resulting outline is not compatible with outline mode -- use
5627 `allout-copy-exposed-to-buffer' if you want that.
5629 Use `allout-indented-exposed-to-buffer' for indented presentation.
5631 With repeat count, copy the exposed portions of only current topic.
5633 Other buffer has current buffer's name with \" exposed\" appended to
5634 it, unless optional second arg TOBUF is specified, in which case it is
5637 (allout-copy-exposed-to-buffer arg tobuf
'flat
))
5638 ;;;_ > allout-indented-exposed-to-buffer (&optional arg tobuf)
5639 (defun allout-indented-exposed-to-buffer (&optional arg tobuf
)
5640 "Present indented outline of outline's exposed portions in another buffer.
5642 The resulting outline is not compatible with outline mode -- use
5643 `allout-copy-exposed-to-buffer' if you want that.
5645 Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation.
5647 With repeat count, copy the exposed portions of only current topic.
5649 Other buffer has current buffer's name with \" exposed\" appended to
5650 it, unless optional second arg TOBUF is specified, in which case it is
5653 (allout-copy-exposed-to-buffer arg tobuf
'indent
))
5655 ;;;_ - LaTeX formatting
5656 ;;;_ > allout-latex-verb-quote (string &optional flow)
5657 (defun allout-latex-verb-quote (string &optional _flow
)
5658 "Return copy of STRING for literal reproduction across LaTeX processing.
5659 Expresses the original characters (including carriage returns) of the
5660 string across LaTeX processing."
5661 (mapconcat (function
5663 (cond ((memq char
'(?
\\ ?$ ?% ?
# ?
& ?
{ ?
} ?_ ?^ ?- ?
*))
5664 (concat "\\char" (number-to-string char
) "{}"))
5665 ((= char ?
\n) "\\\\")
5666 (t (char-to-string char
)))))
5669 ;;;_ > allout-latex-verbatim-quote-curr-line ()
5670 (defun allout-latex-verbatim-quote-curr-line ()
5671 "Express line for exact (literal) representation across LaTeX processing.
5673 Adjust line contents so it is unaltered (from the original line)
5674 across LaTeX processing, within the context of a `verbatim'
5675 environment. Leaves point at the end of the line."
5676 (let ((inhibit-field-text-motion t
))
5678 (let (;(beg (point))
5679 (end (point-at-eol)))
5681 (while (re-search-forward "\\\\"
5682 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
5683 end
; bounded by end-of-line
5684 1) ; no matches, move to end & return nil
5685 (goto-char (match-beginning 2))
5688 (goto-char (1+ (match-end 2))))))))
5689 ;;;_ > allout-insert-latex-header (buffer)
5690 (defun allout-insert-latex-header (buffer)
5691 "Insert initial LaTeX commands at point in BUFFER."
5692 ;; Much of this is being derived from the stuff in appendix of E in
5693 ;; the TeXBook, pg 421.
5695 (let ((doc-style (format "\n\\documentstyle{%s}\n"
5697 (page-numbering (if allout-number-pages
5698 "\\pagestyle{empty}\n"
5700 (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n"
5701 allout-title-style
))
5702 (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n"
5703 allout-label-style
))
5704 (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n"
5705 allout-head-line-style
))
5706 (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n"
5707 allout-body-line-style
))
5708 (setlength (format "%s%s%s%s"
5709 "\\newlength{\\stepsize}\n"
5710 "\\setlength{\\stepsize}{"
5713 (oneheadline (format "%s%s%s%s%s%s%s"
5714 "\\newcommand{\\OneHeadLine}[3]{%\n"
5716 "\\hspace*{#2\\stepsize}%\n"
5717 "\\labelcmd{#1}\\hspace*{.2cm}"
5718 "\\headlinecmd{#3}\\\\["
5721 (onebodyline (format "%s%s%s%s%s%s"
5722 "\\newcommand{\\OneBodyLine}[2]{%\n"
5724 "\\hspace*{#1\\stepsize}%\n"
5725 "\\bodylinecmd{#2}\\\\["
5728 (begindoc "\\begin{document}\n\\begin{center}\n")
5729 (title (format "%s%s%s%s"
5731 (allout-latex-verb-quote (if allout-title
5734 (error "<unnamed buffer>"))
5737 "\\end{center}\n\n"))
5738 (hsize "\\hsize = 7.5 true in\n")
5739 (hoffset "\\hoffset = -1.5 true in\n")
5740 (vspace "\\vspace{.1cm}\n\n"))
5741 (insert (concat doc-style
5756 ;;;_ > allout-insert-latex-trailer (buffer)
5757 (defun allout-insert-latex-trailer (buffer)
5758 "Insert concluding LaTeX commands at point in BUFFER."
5760 (insert "\n\\end{document}\n"))
5761 ;;;_ > allout-latexify-one-item (depth prefix bullet text)
5762 (defun allout-latexify-one-item (depth _prefix bullet text
)
5763 "Insert LaTeX commands for formatting one outline item.
5765 Args are the topics numeric DEPTH, the header PREFIX lead string, the
5766 BULLET string, and a list of TEXT strings for the body."
5767 (let* ((head-line (if text
(car text
)))
5768 (body-lines (cdr text
))
5772 (insert (concat "\\OneHeadLine{\\verb\1 "
5773 (allout-latex-verb-quote bullet
)
5778 (allout-latex-verb-quote head-line
)
5781 (if (not body-lines
)
5783 ;;(insert "\\beginlines\n")
5784 (insert "\\begin{verbatim}\n")
5786 (setq curr-line
(car body-lines
))
5787 (if (and (not body-content
)
5788 (not (string-match "^\\s-*$" curr-line
)))
5789 (setq body-content t
))
5790 ; Mangle any occurrences of
5791 ; "\end{verbatim}" in text,
5793 (if (and body-content
5794 (setq bop
(string-match "\\end{verbatim}" curr-line
)))
5795 (setq curr-line
(concat (substring curr-line
0 bop
)
5797 (substring curr-line bop
))))
5798 ;;(insert "|" (car body-lines) "|")
5800 (allout-latex-verbatim-quote-curr-line)
5802 (setq body-lines
(cdr body-lines
)))
5804 (setq body-content nil
)
5808 ;;(insert "\\endlines\n")
5809 (insert "\\end{verbatim}\n")
5811 ;;;_ > allout-latexify-exposed (arg &optional tobuf)
5812 (defun allout-latexify-exposed (arg &optional tobuf
)
5813 "Format current topics exposed portions to TOBUF for LaTeX processing.
5814 TOBUF defaults to a buffer named the same as the current buffer, but
5815 with \"*\" prepended and \" latex-formed*\" appended.
5817 With repeat count, copy the exposed portions of entire buffer."
5822 (get-buffer-create (concat "*" (buffer-name) " latexified*"))))
5823 (let* ((start-pt (point))
5824 (beg (if arg
(point-min) (allout-back-to-current-heading)))
5825 (end (if arg
(point-max) (allout-end-of-current-subtree)))
5826 (buf (current-buffer)))
5829 (allout-insert-latex-header tobuf
)
5830 (goto-char (point-max))
5831 (allout-process-exposed 'allout-latexify-one-item
5836 (goto-char (point-max))
5837 (allout-insert-latex-trailer tobuf
)
5838 (goto-char (point-min))
5840 (goto-char start-pt
)))
5843 ;;;_ > allout-toggle-current-subtree-encryption (&optional keymode-cue)
5844 (defun allout-toggle-current-subtree-encryption (&optional keymode-cue
)
5845 "Encrypt clear or decrypt encoded topic text.
5847 Allout uses Emacs `epg' library to perform encryption. Symmetric
5848 and keypair encryption are supported. All encryption is ascii
5851 Entry encryption defaults to symmetric key mode unless keypair
5852 recipients are associated with the file (see
5853 `epa-file-encrypt-to') or the function is invoked with a
5854 \(KEYMODE-CUE) universal argument greater than 1.
5856 When encrypting, KEYMODE-CUE universal argument greater than 1
5857 causes prompting for recipients for public-key keypair
5858 encryption. Selecting no recipients results in symmetric key
5861 Further, encrypting with a KEYMODE-CUE universal argument greater
5862 than 4 - eg, preceded by a doubled Ctrl-U - causes association of
5863 the specified recipients with the file, replacing those currently
5864 associated with it. This can be used to dissociate any
5865 recipients with the file, by selecting no recipients in the
5868 Encrypted topic's bullets are set to a `~' to signal that the
5869 contents of the topic (body and subtopics, but not heading) is
5870 pending encryption or encrypted. `*' asterisk immediately after
5871 the bullet signals that the body is encrypted, its absence means
5872 the topic is meant to be encrypted but is not currently. When a
5873 file with topics pending encryption is saved, topics pending
5874 encryption are encrypted. See `allout-encrypt-unencrypted-on-saves'
5875 for auto-encryption specifics.
5877 *NOTE WELL* that automatic encryption that happens during saves will
5878 default to symmetric encryption -- you must deliberately (re)encrypt key-pair
5879 encrypted topics if you want them to continue to use the key-pair cipher.
5881 Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
5882 encrypted. If you want to encrypt the contents of a top-level topic, use
5883 \\[allout-shift-in] to increase its depth."
5886 (allout-back-to-current-heading)
5887 (allout-toggle-subtree-encryption keymode-cue
)))
5888 ;;;_ > allout-toggle-subtree-encryption (&optional keymode-cue)
5889 (defun allout-toggle-subtree-encryption (&optional keymode-cue
)
5890 "Encrypt clear text or decrypt encoded topic contents (body and subtopics.)
5892 Entry encryption defaults to symmetric key mode unless keypair
5893 recipients are associated with the file (see
5894 `epa-file-encrypt-to') or the function is invoked with a
5895 \(KEYMODE-CUE) universal argument greater than 1.
5897 When encrypting, KEYMODE-CUE universal argument greater than 1
5898 causes prompting for recipients for public-key keypair
5899 encryption. Selecting no recipients results in symmetric key
5902 Further, encrypting with a KEYMODE-CUE universal argument greater
5903 than 4 - eg, preceded by a doubled Ctrl-U - causes association of
5904 the specified recipients with the file, replacing those currently
5905 associated with it. This can be used to dissociate any
5906 recipients with the file, by selecting no recipients in the
5909 Encryption and decryption uses the Emacs `epg' library.
5911 Encrypted text will be ascii-armored.
5913 See `allout-toggle-current-subtree-encryption' for more details."
5917 (allout-end-of-prefix t
)
5919 (if (= allout-recent-depth
1)
5920 (error (concat "Cannot encrypt or decrypt level 1 topics -"
5921 " shift it in to make it encryptable")))
5923 (let* ((allout-buffer (current-buffer))
5924 ;; for use with allout-auto-save-temporarily-disabled, if necessary:
5925 (was-buffer-saved-size buffer-saved-size
)
5927 (bullet-pos allout-recent-prefix-beginning
)
5928 (after-bullet-pos (point))
5930 (progn (if (= (point-max) after-bullet-pos
)
5931 (error "no body to encrypt"))
5932 (allout-encrypted-topic-p)))
5933 (was-collapsed (if (not (search-forward "\n" nil t
))
5937 (subtree-beg (1+ (point)))
5938 (subtree-end (allout-end-of-subtree))
5939 (subject-text (buffer-substring-no-properties subtree-beg
5941 (subtree-end-char (char-after (1- subtree-end
)))
5942 (subtree-trailing-char (char-after subtree-end
))
5943 ;; kluge -- result-text needs to be nil, but we also want to
5944 ;; check for the error condition
5945 (result-text (if (or (string= "" subject-text
)
5946 (string= "\n" subject-text
))
5947 (error "No topic contents to %scrypt"
5948 (if was-encrypted
"de" "en"))
5950 ;; Assess key parameters:
5951 (was-coding-system buffer-file-coding-system
))
5953 (when (not was-encrypted
)
5954 ;; ensure that non-ascii chars pending encryption are noticed before
5955 ;; they're encrypted, so the coding system is set to accommodate
5957 (setq buffer-file-coding-system
5958 (allout-select-safe-coding-system subtree-beg subtree-end
))
5959 ;; if the coding system for the text being encrypted is different
5960 ;; than that prevailing, then there a real risk that the coding
5961 ;; system can't be noticed by emacs when the file is visited. to
5962 ;; mitigate that, offer to preserve the coding system using a file
5964 (if (and (not (equal buffer-file-coding-system
5967 (format (concat "Register coding system %s as file local"
5968 " var? Necessary when only encrypted text"
5969 " is in that coding system. ")
5970 buffer-file-coding-system
)))
5971 (allout-adjust-file-variable "buffer-file-coding-system"
5972 buffer-file-coding-system
)))
5975 (allout-encrypt-string subject-text was-encrypted
5976 (current-buffer) keymode-cue
))
5978 ;; Replace the subtree with the processed product.
5981 (set-buffer allout-buffer
)
5982 (delete-region subtree-beg subtree-end
)
5983 (insert result-text
)
5985 (allout-flag-region (1- subtree-beg
) (point) t
))
5986 ;; adjust trailing-blank-lines to preserve topic spacing:
5987 (if (not was-encrypted
)
5988 (if (and (= subtree-end-char ?
\n)
5989 (= subtree-trailing-char ?
\n))
5990 (insert subtree-trailing-char
)))
5991 ;; Ensure that the item has an encrypted-entry bullet:
5992 (if (not (string= (buffer-substring-no-properties
5993 (1- after-bullet-pos
) after-bullet-pos
)
5994 allout-topic-encryption-bullet
))
5995 (progn (goto-char (1- after-bullet-pos
))
5997 (insert allout-topic-encryption-bullet
)))
5999 ;; Remove the is-encrypted bullet qualifier:
6000 (progn (goto-char after-bullet-pos
)
6002 ;; Add the is-encrypted bullet qualifier:
6003 (goto-char after-bullet-pos
)
6006 ;; adjust buffer's auto-save eligibility:
6008 (allout-inhibit-auto-save-info-for-decryption was-buffer-saved-size
)
6009 (allout-maybe-resume-auto-save-info-after-encryption))
6011 (run-hook-with-args 'allout-structure-added-functions
6012 bullet-pos subtree-end
))))
6014 (declare-function epg-context-set-passphrase-callback
"epg"
6015 (context passphrase-callback
))
6016 (declare-function epg-list-keys
"epg" (context &optional name mode
))
6017 (declare-function epg-decrypt-string
"epg" (context cipher
))
6018 (declare-function epg-encrypt-string
"epg"
6019 (context plain recipients
&optional sign always-trust
))
6020 (declare-function epg-user-id-string
"epg" (user-id) t
)
6021 (declare-function epg-key-user-id-list
"epg" (key) t
)
6023 ;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue
6024 ;;; &optional rejected)
6025 (defun allout-encrypt-string (text decrypt allout-buffer keymode-cue
6027 "Encrypt or decrypt message TEXT.
6029 Returns the resulting string, or nil if the transformation fails.
6031 If DECRYPT is true (default false), then decrypt instead of encrypt.
6033 ALLOUT-BUFFER identifies the buffer containing the text.
6035 Entry encryption defaults to symmetric key mode unless keypair
6036 recipients are associated with the file (see
6037 `epa-file-encrypt-to') or the function is invoked with a
6038 \(KEYMODE-CUE) universal argument greater than 1.
6040 When encrypting, KEYMODE-CUE universal argument greater than 1
6041 causes prompting for recipients for public-key keypair
6042 encryption. Selecting no recipients results in symmetric key
6045 Further, encrypting with a KEYMODE-CUE universal argument greater
6046 than 4 - eg, preceded by a doubled Ctrl-U - causes association of
6047 the specified recipients with the file, replacing those currently
6048 associated with it. This can be used to dissociate any
6049 recipients with the file, by selecting no recipients in the
6052 Optional REJECTED is for internal use, to convey the number of
6053 rejections due to matches against
6054 `allout-encryption-ciphertext-rejection-regexps', as limited by
6055 `allout-encryption-ciphertext-rejection-ceiling'.
6057 NOTE: A few GnuPG v2 versions improperly preserve incorrect
6058 symmetric decryption keys, preventing entry of the correct key on
6059 subsequent decryption attempts until the cache times-out. That
6060 can take several minutes. (Decryption of other entries is not
6061 affected.) Upgrade your EasyPG version, if you can, and you can
6062 deliberately clear your gpg-agent's cache by sending it a `-HUP'
6068 (let* ((epg-context (let* ((context (epg-make-context nil t
)))
6069 (epg-context-set-passphrase-callback
6070 context
#'epa-passphrase-callback-function
)
6073 (encoding (with-current-buffer allout-buffer
6074 buffer-file-coding-system
))
6075 (multibyte (with-current-buffer allout-buffer
6076 enable-multibyte-characters
))
6077 ;; "sanitization" avoids encryption results that are outline structure.
6078 (sani-regexps 'allout-encryption-plaintext-sanitization-regexps
)
6079 (strip-plaintext-regexps (if (not decrypt
)
6080 (allout-get-configvar-values
6082 (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps
)
6083 (reject-ciphertext-regexps (if (not decrypt
)
6084 (allout-get-configvar-values
6085 rejection-regexps
)))
6086 (rejected (or rejected
0))
6087 (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
6089 (keypair-mode (cond (decrypt 'decrypting
)
6090 ((<= (prefix-numeric-value keymode-cue
) 1)
6092 ((<= (prefix-numeric-value keymode-cue
) 4)
6094 ((> (prefix-numeric-value keymode-cue
) 4)
6096 (keypair-message (concat "Select encryption recipients.\n"
6097 "Symmetric encryption is done if no"
6098 " recipients are selected. "))
6099 (encrypt-to (and (boundp 'epa-file-encrypt-to
) epa-file-encrypt-to
))
6105 ;; Massage the subject text for encoding and filtering.
6108 ;; convey the text characteristics of the original buffer:
6109 (set-buffer-multibyte multibyte
)
6111 (set-buffer-file-coding-system encoding
)
6113 (encode-coding-region (point-min) (point-max) encoding
)))
6115 ;; remove sanitization regexps matches before encrypting:
6116 (when (and strip-plaintext-regexps
(not decrypt
))
6117 (dolist (re strip-plaintext-regexps
)
6118 (let ((re (if (listp re
) (car re
) re
))
6119 (replacement (if (listp re
) (cadr re
) "")))
6120 (goto-char (point-min))
6122 (while (re-search-forward re nil t
)
6123 (replace-match replacement nil nil
))))))
6124 (setq massaged-text
(buffer-substring-no-properties (point-min)
6126 ;; determine key mode and, if keypair, recipients:
6132 (default (if encrypt-to
(epg-list-keys epg-context encrypt-to
)))
6134 ((prompt prompt-save
)
6135 (save-window-excursion
6136 (epa-select-keys epg-context keypair-message
)))))
6141 (epg-decrypt-string epg-context
6142 (encode-coding-string massaged-text
6143 (or encoding
'utf-8
)))
6146 (cons (concat (cadr err
) " - gpg version problem?")
6148 (replace-regexp-in-string "\n$" ""
6149 (epg-encrypt-string epg-context
6150 (encode-coding-string massaged-text
6151 (or encoding
'utf-8
))
6154 ;; validate result -- non-empty
6155 (if (not result-text
)
6156 (error "%scryption failed." (if decrypt
"De" "En")))
6159 (when (eq keypair-mode
'prompt-save
)
6160 ;; set epa-file-encrypt-to in the buffer:
6161 (setq epa-file-encrypt-to
(mapcar (lambda (key)
6163 (car (epg-key-user-id-list key
))))
6165 ;; change the file variable:
6166 (allout-adjust-file-variable "epa-file-encrypt-to" epa-file-encrypt-to
))
6169 ;; Retry (within limit) if ciphertext contains rejections:
6171 ;; Check for disqualification of this ciphertext:
6172 (let ((regexps reject-ciphertext-regexps
)
6174 (while (and regexps
(not reject-it
))
6175 (setq reject-it
(string-match (car regexps
) result-text
))
6178 (setq rejections-left
(1- rejections-left
))
6179 (if (<= rejections-left
0)
6180 (error (concat "Ciphertext rejected too many times"
6182 allout-encryption-ciphertext-rejection-ceiling
6183 'allout-encryption-ciphertext-rejection-regexps
)
6184 ;; try again (gpg-agent may have the key cached):
6185 (allout-encrypt-string text decrypt allout-buffer keypair-mode
6188 ;; Barf if encryption yields extraordinary control chars:
6190 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
6192 (error (concat "Encryption produced non-armored text, which"
6193 "conflicts with allout mode -- reconfigure!")))
6195 ;;;_ > allout-inhibit-auto-save-info-for-decryption
6196 (defun allout-inhibit-auto-save-info-for-decryption (was-buffer-saved-size)
6197 "Temporarily prevent auto-saves in this buffer when an item is decrypted.
6199 WAS-BUFFER-SAVED-SIZE is the value of `buffer-saved-size' *before*
6201 (when (not (or (= buffer-saved-size -
1) (= was-buffer-saved-size -
1)))
6202 (setq allout-auto-save-temporarily-disabled was-buffer-saved-size
6203 buffer-saved-size -
1)))
6204 ;;;_ > allout-maybe-resume-auto-save-info-after-encryption ()
6205 (defun allout-maybe-resume-auto-save-info-after-encryption ()
6206 "Restore auto-save info, *if* there are no topics pending encryption."
6207 (when (and allout-auto-save-temporarily-disabled
6208 (= buffer-saved-size -
1)
6212 (goto-char (point-min))
6213 (not (allout-next-topic-pending-encryption)))))
6214 (setq buffer-saved-size allout-auto-save-temporarily-disabled
6215 allout-auto-save-temporarily-disabled nil
)))
6217 ;;;_ > allout-encrypted-topic-p ()
6218 (defun allout-encrypted-topic-p ()
6219 "True if the current topic is encryptable and encrypted."
6221 (allout-end-of-prefix t
)
6222 (and (string= (buffer-substring-no-properties (1- (point)) (point))
6223 allout-topic-encryption-bullet
)
6224 (save-match-data (looking-at "\\*")))
6227 ;;;_ > allout-next-topic-pending-encryption ()
6228 (defun allout-next-topic-pending-encryption ()
6229 "Return the point of the next topic pending encryption, or nil if none.
6231 Such a topic has the `allout-topic-encryption-bullet' without an
6232 immediately following `*' that would mark the topic as being encrypted.
6233 It must also have content."
6234 (let (done got content-beg
)
6238 (if (not (re-search-forward
6239 (format "\\(\\`\\|\n\\)%s *%s[^*]"
6240 (regexp-quote allout-header-prefix
)
6241 (regexp-quote allout-topic-encryption-bullet
))
6245 (goto-char (setq got
(match-beginning 0)))
6246 (when (= (following-char) ?
\n) (forward-char 1))
6252 ((not (search-forward "\n"))
6261 (setq content-beg
(point))
6263 (allout-end-of-subtree)
6264 (if (<= (point) content-beg
)
6276 ;;;_ > allout-encrypt-decrypted ()
6277 (defun allout-encrypt-decrypted ()
6278 "Encrypt topics pending encryption except those containing exemption point.
6280 If a topic that is currently being edited was encrypted, we return a list
6281 containing the location of the topic and the location of the cursor just
6282 before the topic was encrypted. This can be used, eg, to decrypt the topic
6283 and exactly resituate the cursor if this is being done as part of a file
6284 save. See `allout-encrypt-unencrypted-on-saves' for more info."
6289 (let* ((current-mark (point-marker))
6290 (current-mark-position (marker-position current-mark
))
6293 editing-topic editing-point
)
6294 (goto-char (point-min))
6295 (while (allout-next-topic-pending-encryption)
6296 (setq was-modified
(buffer-modified-p))
6297 (when (save-excursion
6298 (and (boundp 'allout-encrypt-unencrypted-on-saves
)
6299 allout-encrypt-unencrypted-on-saves
6300 (setq bo-subtree
(re-search-forward "$"))
6301 (not (allout-hidden-p))
6302 (>= current-mark
(point))
6303 (allout-end-of-current-subtree)
6304 (<= current-mark
(point))))
6305 (setq editing-topic
(point)
6306 ;; we had to wait for this 'til now so prior topics are
6307 ;; encrypted, any relevant text shifts are in place:
6308 editing-point
(- current-mark-position
6309 (allout-count-trailing-whitespace-region
6310 bo-subtree current-mark-position
))))
6311 (allout-toggle-subtree-encryption)
6312 (if (not was-modified
)
6313 (set-buffer-modified-p nil
))
6315 (if (not was-modified
)
6316 (set-buffer-modified-p nil
))
6317 (if editing-topic
(list editing-topic editing-point
))
6323 ;;;_ #9 miscellaneous
6325 ;;;_ > outlineify-sticky ()
6326 ;; outlinify-sticky is correct spelling; provide this alias for sticklers:
6328 (defalias 'outlinify-sticky
'outlineify-sticky
)
6330 (defun outlineify-sticky (&optional _arg
)
6331 "Activate outline mode and establish file var so it is started subsequently.
6333 See `allout-layout' and customization of `allout-auto-activation'
6334 for details on preparing Emacs for automatic allout activation."
6338 (if (allout-mode-p) (allout-mode)) ; deactivate so we can re-activate...
6342 (goto-char (point-min))
6343 (if (allout-goto-prefix)
6345 (allout-open-topic 2)
6346 (insert (substitute-command-keys
6347 (concat "Dummy outline topic header -- see"
6348 " `allout-mode' docstring: `\\[describe-mode]'.")))
6349 (allout-adjust-file-variable
6350 "allout-layout" (or allout-layout
'(-1 : 0))))))
6351 ;;;_ > allout-file-vars-section-data ()
6352 (defun allout-file-vars-section-data ()
6353 "Return data identifying the file-vars section, or nil if none.
6355 Returns a list of the form (BEGINNING-POINT PREFIX-STRING SUFFIX-STRING)."
6356 ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function.
6357 (let (beg prefix suffix
)
6359 (goto-char (point-max))
6360 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move
)
6361 (if (let ((case-fold-search t
))
6362 (not (search-forward "Local Variables:" nil t
)))
6364 (setq beg
(- (point) 16))
6365 (setq suffix
(buffer-substring-no-properties
6367 (progn (if (search-forward "\n" nil t
)
6370 (setq prefix
(buffer-substring-no-properties
6371 (progn (if (search-backward "\n" nil t
)
6375 (list beg prefix suffix
))
6379 ;;;_ > allout-adjust-file-variable (varname value)
6380 (defun allout-adjust-file-variable (varname value
)
6381 "Adjust the setting of an Emacs file variable named VARNAME to VALUE.
6383 This activity is inhibited if either `enable-local-variables' or
6384 `allout-enable-file-variable-adjustment' are nil.
6386 When enabled, an entry for the variable is created if not already present,
6387 or changed if established with a different value. The section for the file
6388 variables, itself, is created if not already present. When created, the
6389 section lines (including the section line) exist as second-level topics in
6390 a top-level topic at the end of the file.
6392 `enable-local-variables' must be true for any of this to happen."
6393 (if (not (and enable-local-variables
6394 allout-enable-file-variable-adjustment
))
6397 (let ((inhibit-field-text-motion t
)
6398 (section-data (allout-file-vars-section-data))
6401 (setq beg
(car section-data
)
6402 prefix
(cadr section-data
)
6403 suffix
(car (cddr section-data
)))
6404 ;; create the section
6405 (goto-char (point-max))
6407 (allout-open-topic 0)
6409 (insert "Local emacs vars.\n")
6410 (allout-open-topic 1)
6413 prefix
(buffer-substring-no-properties (progn
6418 (insert "Local variables:\n")
6419 (allout-open-topic 0)
6422 ;; look for existing entry or create one, leaving point for insertion
6425 (allout-show-to-offshoot)
6426 (if (search-forward (concat "\n" prefix varname
":") nil t
)
6427 (let* ((value-beg (point))
6428 (line-end (progn (if (search-forward "\n" nil t
)
6431 (value-end (- line-end
(length suffix
))))
6432 (if (> value-end value-beg
)
6433 (delete-region value-beg value-end
)))
6437 (insert (concat prefix varname
":")))
6438 (insert (format " %S%s" value suffix
))
6443 ;;;_ > allout-get-configvar-values (varname)
6444 (defun allout-get-configvar-values (configvar-name)
6445 "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
6447 The user is prompted for removal of symbols that are unbound, and they
6448 otherwise are ignored.
6450 CONFIGVAR-NAME should be the name of the configuration variable,
6453 (let ((configvar-value (symbol-value configvar-name
))
6455 (dolist (sym configvar-value
)
6456 (if (not (boundp sym
))
6457 (if (yes-or-no-p (format-message
6458 "%s entry `%s' is unbound -- remove it? "
6459 configvar-name sym
))
6460 (delq sym
(symbol-value configvar-name
)))
6461 (push (symbol-value sym
) got
)))
6464 ;;;_ > allout-mark-topic ()
6465 (defun allout-mark-topic ()
6466 "Put the region around topic currently containing point."
6468 (let ((inhibit-field-text-motion t
))
6469 (beginning-of-line))
6470 (allout-goto-prefix-doublechecked)
6472 (allout-end-of-current-subtree)
6473 (exchange-point-and-mark))
6475 ;;;_ > allout-solicit-char-in-string (prompt string &optional do-defaulting)
6476 (defun allout-solicit-char-in-string (prompt string
&optional do-defaulting
)
6477 "Solicit (with first arg PROMPT) choice of a character from string STRING.
6479 Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
6481 (let ((new-prompt prompt
)
6485 (message "%s" new-prompt
)
6487 ;; We do our own reading here, so we can circumvent, eg, special
6488 ;; treatment for `?' character. (Oughta use minibuffer keymap instead.)
6490 (char-to-string (let ((cursor-in-echo-area nil
)) (read-char))))
6493 (cond ((string-match (regexp-quote got
) string
) got
)
6494 ((and do-defaulting
(string= got
"\r"))
6495 ;; Return empty string to default:
6497 ((string= got
"\C-g") (signal 'quit nil
))
6499 (setq new-prompt
(concat prompt
6505 ;; got something out of loop -- return it:
6509 ;;;_ > allout-regexp-sans-escapes (string)
6510 (defun allout-regexp-sans-escapes (regexp &optional successive-backslashes
)
6511 "Return a copy of REGEXP with all character escapes stripped out.
6513 Representations of actual backslashes -- `\\\\\\\\' -- are left as a
6516 Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
6518 (if (string= regexp
"")
6520 ;; Set successive-backslashes to number if current char is
6521 ;; backslash, or else to nil:
6522 (setq successive-backslashes
6523 (if (= (aref regexp
0) ?
\\)
6524 (if successive-backslashes
(1+ successive-backslashes
) 1)
6526 (if (or (not successive-backslashes
) (= 2 successive-backslashes
))
6527 ;; Include first char:
6528 (concat (substring regexp
0 1)
6529 (allout-regexp-sans-escapes (substring regexp
1)))
6530 ;; Exclude first char, but maintain count:
6531 (allout-regexp-sans-escapes (substring regexp
1) successive-backslashes
))))
6532 ;;;_ > allout-count-trailing-whitespace-region (beg end)
6533 (defun allout-count-trailing-whitespace-region (beg end
)
6534 "Return number of trailing whitespace chars between BEG and END.
6536 If BEG is bigger than END we return 0."
6543 (while (re-search-forward "[ ][ ]*$" end t
)
6544 (goto-char (1+ (match-beginning 2)))
6545 (setq count
(1+ count
)))
6547 ;;;_ > allout-format-quote (string)
6548 (defun allout-format-quote (string)
6549 "Return a copy of string with all \"%\" characters doubled."
6551 (mapcar (lambda (char) (if (= char ?%
) "%%" (char-to-string char
)))
6554 ;;;_ > allout-flatten (list)
6555 (defun allout-flatten (list)
6556 "Return a list of all atoms in list."
6558 (cond ((null list
) nil
)
6559 ((atom (car list
)) (cons (car list
) (allout-flatten (cdr list
))))
6560 (t (append (allout-flatten (car list
)) (allout-flatten (cdr list
))))))
6561 ;;;_ : Compatibility:
6562 ;;;_ : xemacs undo-in-progress provision:
6563 (unless (boundp 'undo-in-progress
)
6564 (defvar undo-in-progress nil
6565 "Placeholder defvar for XEmacs compatibility from allout.el.")
6566 (defadvice undo-more
(around allout activate
)
6567 ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs.
6568 (let ((undo-in-progress t
)) ad-do-it
)))
6570 ;;;_ > allout-mark-marker to accommodate divergent emacsen:
6571 (defun allout-mark-marker (&optional force buffer
)
6572 "Accommodate the different signature for `mark-marker' across Emacsen.
6574 XEmacs takes two optional args, while Emacs does not,
6575 so pass them along when appropriate."
6576 (if (featurep 'xemacs
)
6577 (apply 'mark-marker force buffer
)
6579 ;;;_ > subst-char-in-string if necessary
6580 (if (not (fboundp 'subst-char-in-string
))
6581 (defun subst-char-in-string (fromchar tochar string
&optional inplace
)
6582 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
6583 Unless optional argument INPLACE is non-nil, return a new string."
6584 (let ((i (length string
))
6585 (newstr (if inplace string
(copy-sequence string
))))
6588 (if (eq (aref newstr i
) fromchar
)
6589 (aset newstr i tochar
)))
6591 ;;;_ > wholenump if necessary
6592 (if (not (fboundp 'wholenump
))
6593 (defalias 'wholenump
'natnump
))
6594 ;;;_ > remove-overlays if necessary
6595 (if (not (fboundp 'remove-overlays
))
6596 (defun remove-overlays (&optional beg end name val
)
6597 "Clear BEG and END of overlays whose property NAME has value VAL.
6598 Overlays might be moved and/or split.
6599 BEG and END default respectively to the beginning and end of buffer."
6600 (unless beg
(setq beg
(point-min)))
6601 (unless end
(setq end
(point-max)))
6603 (setq beg
(prog1 end
(setq end beg
))))
6605 (dolist (o (overlays-in beg end
))
6606 (when (eq (overlay-get o name
) val
)
6607 ;; Either push this overlay outside beg...end
6608 ;; or split it to exclude beg...end
6609 ;; or delete it entirely (if it is contained in beg...end).
6610 (if (< (overlay-start o
) beg
)
6611 (if (> (overlay-end o
) end
)
6613 (move-overlay (copy-overlay o
)
6614 (overlay-start o
) beg
)
6615 (move-overlay o end
(overlay-end o
)))
6616 (move-overlay o
(overlay-start o
) beg
))
6617 (if (> (overlay-end o
) end
)
6618 (move-overlay o end
(overlay-end o
))
6619 (delete-overlay o
)))))))
6621 ;;;_ > copy-overlay if necessary -- xemacs ~ 21.4
6622 (if (not (fboundp 'copy-overlay
))
6623 (defun copy-overlay (o)
6624 "Return a copy of overlay O."
6625 (let ((o1 (make-overlay (overlay-start o
) (overlay-end o
)
6626 ;; FIXME: there's no easy way to find the
6627 ;; insertion-type of the two markers.
6628 (overlay-buffer o
)))
6629 (props (overlay-properties o
)))
6631 (overlay-put o1
(pop props
) (pop props
)))
6633 ;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4
6634 (if (not (fboundp 'add-to-invisibility-spec
))
6635 (defun add-to-invisibility-spec (element)
6636 "Add ELEMENT to `buffer-invisibility-spec'.
6637 See documentation for `buffer-invisibility-spec' for the kind of elements
6639 (if (eq buffer-invisibility-spec t
)
6640 (setq buffer-invisibility-spec
(list t
)))
6641 (setq buffer-invisibility-spec
6642 (cons element buffer-invisibility-spec
))))
6643 ;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4
6644 (if (not (fboundp 'remove-from-invisibility-spec
))
6645 (defun remove-from-invisibility-spec (element)
6646 "Remove ELEMENT from `buffer-invisibility-spec'."
6647 (if (consp buffer-invisibility-spec
)
6648 (setq buffer-invisibility-spec
(delete element
6649 buffer-invisibility-spec
)))))
6650 ;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs
6651 (if (not (fboundp 'move-beginning-of-line
))
6652 (defun move-beginning-of-line (arg)
6653 "Move point to beginning of current line as displayed.
6654 \(This disregards invisible newlines such as those
6655 which are part of the text that an image rests on.)
6657 With argument ARG not nil or 1, move forward ARG - 1 lines first.
6658 If point reaches the beginning or end of buffer, it stops there.
6659 To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
6661 (or arg
(setq arg
1))
6663 (condition-case nil
(line-move (1- arg
)) (error nil
)))
6665 ;; Move to beginning-of-line, ignoring fields and invisible text.
6666 (skip-chars-backward "^\n")
6667 (while (and (not (bobp))
6669 (get-char-property (1- (point)) 'invisible
)))
6670 (if (eq buffer-invisibility-spec t
)
6672 (or (memq prop buffer-invisibility-spec
)
6673 (assq prop buffer-invisibility-spec
)))))
6674 (goto-char (if (featurep 'xemacs
)
6675 (previous-property-change (point))
6676 (previous-char-property-change (point))))
6677 (skip-chars-backward "^\n"))
6678 (vertical-motion 0))
6680 ;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs
6681 (if (not (fboundp 'move-end-of-line
))
6682 (defun move-end-of-line (arg)
6683 "Move point to end of current line as displayed.
6684 \(This disregards invisible newlines such as those
6685 which are part of the text that an image rests on.)
6687 With argument ARG not nil or 1, move forward ARG - 1 lines first.
6688 If point reaches the beginning or end of buffer, it stops there.
6689 To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
6691 (or arg
(setq arg
1))
6696 (let ((goal-column 0))
6697 (and (condition-case nil
6698 (or (line-move arg
) t
)
6706 (get-char-property (1- (point))
6708 (if (eq buffer-invisibility-spec t
)
6711 buffer-invisibility-spec
)
6713 buffer-invisibility-spec
)))))
6715 (previous-char-property-change (point))))
6719 (if (and (> (point) newpos
)
6720 (eq (preceding-char) ?
\n))
6722 (if (and (> (point) newpos
) (not (eobp))
6723 (not (eq (following-char) ?
\n)))
6724 ;; If we skipped something intangible
6725 ;; and now we're not really at eol,
6730 ;;;_ > allout-next-single-char-property-change -- alias unless lacking
6731 (defalias 'allout-next-single-char-property-change
6732 (if (fboundp 'next-single-char-property-change
)
6733 'next-single-char-property-change
6734 'next-single-property-change
)
6735 ;; No docstring because xemacs defalias doesn't support it.
6737 ;;;_ > allout-previous-single-char-property-change -- alias unless lacking
6738 (defalias 'allout-previous-single-char-property-change
6739 (if (fboundp 'previous-single-char-property-change
)
6740 'previous-single-char-property-change
6741 'previous-single-property-change
)
6742 ;; No docstring because xemacs defalias doesn't support it.
6744 ;;;_ > allout-select-safe-coding-system
6745 (defalias 'allout-select-safe-coding-system
6746 (if (fboundp 'select-safe-coding-system
)
6747 'select-safe-coding-system
6748 'detect-coding-region
)
6750 ;;;_ > allout-substring-no-properties
6751 ;; define as alias first, so byte compiler is happy.
6752 (defalias 'allout-substring-no-properties
'substring-no-properties
)
6753 ;; then supplant with definition if underlying alias absent.
6754 (if (not (fboundp 'substring-no-properties
))
6755 (defun allout-substring-no-properties (string &optional start end
)
6756 (substring string
(or start
0) end
))
6760 ;;;_ > allout-bullet-isearch (&optional bullet)
6761 (defun allout-bullet-isearch (&optional bullet
)
6762 "Isearch (regexp) for topic with bullet BULLET."
6765 (setq bullet
(allout-solicit-char-in-string
6766 "ISearch for topic with bullet: "
6767 (allout-regexp-sans-escapes allout-bullets-string
))))
6769 (let ((isearch-regexp t
)
6770 (isearch-string (concat "^"
6771 allout-header-prefix
6774 (isearch-repeat 'forward
)
6777 ;;;_ #11 Unit tests -- this should be last item before "Provide"
6778 ;;;_ > allout-run-unit-tests ()
6779 (defun allout-run-unit-tests ()
6780 "Run the various allout unit tests."
6781 (message "Running allout tests...")
6782 (allout-test-resumptions)
6783 (message "Running allout tests... Done.")
6785 ;;;_ : test resumptions:
6786 ;;;_ > allout-tests-obliterate-variable (name)
6787 (defun allout-tests-obliterate-variable (name)
6788 "Completely unbind variable with NAME."
6789 (if (local-variable-p name
(current-buffer)) (kill-local-variable name
))
6790 (while (boundp name
) (makunbound name
)))
6791 ;;;_ > allout-test-resumptions ()
6792 (defvar allout-tests-globally-unbound nil
6793 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
6794 (defvar allout-tests-globally-true nil
6795 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
6796 (defvar allout-tests-locally-true nil
6797 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
6798 (defun allout-test-resumptions ()
6799 "Exercise allout resumptions."
6800 ;; for each resumption case, we also test that the right local/global
6801 ;; scopes are affected during resumption effects:
6803 ;; ensure that previously unbound variables return to the unbound state.
6805 (allout-tests-obliterate-variable 'allout-tests-globally-unbound
)
6806 (allout-add-resumptions '(allout-tests-globally-unbound t
))
6807 (assert (not (default-boundp 'allout-tests-globally-unbound
)))
6808 (assert (local-variable-p 'allout-tests-globally-unbound
(current-buffer)))
6809 (assert (boundp 'allout-tests-globally-unbound
))
6810 (assert (equal allout-tests-globally-unbound t
))
6811 (allout-do-resumptions)
6812 (assert (not (local-variable-p 'allout-tests-globally-unbound
6814 (assert (not (boundp 'allout-tests-globally-unbound
))))
6816 ;; ensure that variable with prior global value is resumed
6818 (allout-tests-obliterate-variable 'allout-tests-globally-true
)
6819 (setq allout-tests-globally-true t
)
6820 (allout-add-resumptions '(allout-tests-globally-true nil
))
6821 (assert (equal (default-value 'allout-tests-globally-true
) t
))
6822 (assert (local-variable-p 'allout-tests-globally-true
(current-buffer)))
6823 (assert (equal allout-tests-globally-true nil
))
6824 (allout-do-resumptions)
6825 (assert (not (local-variable-p 'allout-tests-globally-true
6827 (assert (boundp 'allout-tests-globally-true
))
6828 (assert (equal allout-tests-globally-true t
)))
6830 ;; ensure that prior local value is resumed
6832 (allout-tests-obliterate-variable 'allout-tests-locally-true
)
6833 (set (make-local-variable 'allout-tests-locally-true
) t
)
6834 (assert (not (default-boundp 'allout-tests-locally-true
))
6835 nil
(concat "Test setup mistake -- variable supposed to"
6836 " not have global binding, but it does."))
6837 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer))
6838 nil
(concat "Test setup mistake -- variable supposed to have"
6839 " local binding, but it lacks one."))
6840 (allout-add-resumptions '(allout-tests-locally-true nil
))
6841 (assert (not (default-boundp 'allout-tests-locally-true
)))
6842 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer)))
6843 (assert (equal allout-tests-locally-true nil
))
6844 (allout-do-resumptions)
6845 (assert (boundp 'allout-tests-locally-true
))
6846 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer)))
6847 (assert (equal allout-tests-locally-true t
))
6848 (assert (not (default-boundp 'allout-tests-locally-true
))))
6850 ;; ensure that last of multiple resumptions holds, for various scopes.
6852 (allout-tests-obliterate-variable 'allout-tests-globally-unbound
)
6853 (allout-tests-obliterate-variable 'allout-tests-globally-true
)
6854 (setq allout-tests-globally-true t
)
6855 (allout-tests-obliterate-variable 'allout-tests-locally-true
)
6856 (set (make-local-variable 'allout-tests-locally-true
) t
)
6857 (allout-add-resumptions '(allout-tests-globally-unbound t
)
6858 '(allout-tests-globally-true nil
)
6859 '(allout-tests-locally-true nil
))
6860 (allout-add-resumptions '(allout-tests-globally-unbound 2)
6861 '(allout-tests-globally-true 3)
6862 '(allout-tests-locally-true 4))
6863 ;; reestablish many of the basic conditions are maintained after re-add:
6864 (assert (not (default-boundp 'allout-tests-globally-unbound
)))
6865 (assert (local-variable-p 'allout-tests-globally-unbound
(current-buffer)))
6866 (assert (equal allout-tests-globally-unbound
2))
6867 (assert (default-boundp 'allout-tests-globally-true
))
6868 (assert (local-variable-p 'allout-tests-globally-true
(current-buffer)))
6869 (assert (equal allout-tests-globally-true
3))
6870 (assert (not (default-boundp 'allout-tests-locally-true
)))
6871 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer)))
6872 (assert (equal allout-tests-locally-true
4))
6873 (allout-do-resumptions)
6874 (assert (not (local-variable-p 'allout-tests-globally-unbound
6876 (assert (not (boundp 'allout-tests-globally-unbound
)))
6877 (assert (not (local-variable-p 'allout-tests-globally-true
6879 (assert (boundp 'allout-tests-globally-true
))
6880 (assert (equal allout-tests-globally-true t
))
6881 (assert (boundp 'allout-tests-locally-true
))
6882 (assert (local-variable-p 'allout-tests-locally-true
(current-buffer)))
6883 (assert (equal allout-tests-locally-true t
))
6884 (assert (not (default-boundp 'allout-tests-locally-true
))))
6886 ;; ensure that deliberately unbinding registered variables doesn't foul things
6888 (allout-tests-obliterate-variable 'allout-tests-globally-unbound
)
6889 (allout-tests-obliterate-variable 'allout-tests-globally-true
)
6890 (setq allout-tests-globally-true t
)
6891 (allout-tests-obliterate-variable 'allout-tests-locally-true
)
6892 (set (make-local-variable 'allout-tests-locally-true
) t
)
6893 (allout-add-resumptions '(allout-tests-globally-unbound t
)
6894 '(allout-tests-globally-true nil
)
6895 '(allout-tests-locally-true nil
))
6896 (allout-tests-obliterate-variable 'allout-tests-globally-unbound
)
6897 (allout-tests-obliterate-variable 'allout-tests-globally-true
)
6898 (allout-tests-obliterate-variable 'allout-tests-locally-true
)
6899 (allout-do-resumptions))
6901 ;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true:
6902 (when allout-run-unit-tests-on-load
6903 (allout-run-unit-tests))
6908 ;;;_* Local emacs vars.
6909 ;; The following `allout-layout' local variable setting:
6910 ;; - closes all topics from the first topic to just before the third-to-last,
6911 ;; - shows the children of the third to last (config vars)
6912 ;; - and the second to last (code section),
6913 ;; - and closes the last topic (this local-variables section).
6915 ;;allout-layout: (0 : -1 -1 0)
6918 ;;; allout.el ends here