* lisp/textmodes/rst.el (rst-compile-toolsets): Add pdf and s5 to option alist.
[bpt/emacs.git] / lisp / allout.el
CommitLineData
6a05d05f 1;;; allout.el --- extensive outline mode for use alone and with other modes
19b84ba3 2
08b5f072
GM
3;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
4;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
1977b8f6 5
d82979ea
EZ
6;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
7;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
60c7bbd2 8;; Created: Dec 1991 -- first release to usenet
8d8f5831 9;; Version: 2.2.2
d82979ea 10;; Keywords: outlines wp languages
01fc9422 11;; Website: http://myriadicity.net/Sundry/EmacsAllout
1977b8f6
RS
12
13;; This file is part of GNU Emacs.
14
eb3fa2cf 15;; GNU Emacs is free software: you can redistribute it and/or modify
59243403 16;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
17;; the Free Software Foundation, either version 3 of the License, or
18;; (at your option) any later version.
59243403 19
1977b8f6 20;; GNU Emacs is distributed in the hope that it will be useful,
59243403
RS
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
eb3fa2cf 26;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
1977b8f6 27
6a05d05f 28;;; Commentary:
19b84ba3 29
96b83743
EZ
30;; Allout outline minor mode provides extensive outline formatting and
31;; and manipulation beyond standard emacs outline mode. Some features:
71296446 32;;
96b83743
EZ
33;; - Classic outline-mode topic-oriented navigation and exposure adjustment
34;; - Topic-oriented editing including coherent topic and subtopic
35;; creation, promotion, demotion, cut/paste across depths, etc.
36;; - Incremental search with dynamic exposure and reconcealment of text
60c7bbd2 37;; - Customizable bullet format -- enables programming-language specific
96b83743 38;; outlining, for code-folding editing. (Allout code itself is to try it;
60c7bbd2 39;; formatted as an outline -- do ESC-x eval-buffer in allout.el; but
96b83743 40;; emacs local file variables need to be enabled when the
60c7bbd2 41;; file was visited -- see `enable-local-variables'.)
96b83743
EZ
42;; - Configurable per-file initial exposure settings
43;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase
0949617b
EZ
44;; mnemonic support, with verification against an established passphrase
45;; (using a stashed encrypted dummy string) and user-supplied hint
ff3e8c8e
KM
46;; maintenance. Encryption is via the Emacs 'epg' library. See
47;; allout-toggle-current-subtree-encryption docstring.
96b83743
EZ
48;; - Automatic topic-number maintenance
49;; - "Hot-spot" operation, for single-keystroke maneuvering and
d82979ea 50;; exposure control (see the allout-mode docstring)
96b83743 51;; - Easy rendering of exposed portions into numbered, latex, indented, etc
d82979ea 52;; outline styles
60c7bbd2 53;; - Careful attention to whitespace -- enabling blank lines between items
96b83743
EZ
54;; and maintenance of hanging indentation (in paragraph auto-fill and
55;; across topic promotion and demotion) of topic bodies consistent with
56;; indentation of their topic header.
71296446 57;;
d82979ea 58;; and more.
71296446 59;;
96b83743 60;; See the `allout-mode' function's docstring for an introduction to the
01fc9422
EZ
61;; mode.
62;;
63;; The latest development version and helpful notes are available at
96b83743
EZ
64;; http://myriadicity.net/Sundry/EmacsAllout .
65;;
9179616f 66;; The outline menubar additions provide quick reference to many of
d82979ea 67;; the features, and see the docstring of the variable `allout-init'
a0a022d5 68;; for instructions on priming your Emacs session for automatic
d82979ea 69;; activation of allout-mode.
71296446 70;;
fd5359c6
MR
71;; See the docstring of the variables `allout-layout' and
72;; `allout-auto-activation' for details on automatic activation of
d82979ea 73;; `allout-mode' as a minor mode. (It has changed since allout
19b84ba3 74;; 3.x, for those of you that depend on the old method.)
c567ac01 75;;
60c7bbd2 76;; Note -- the lines beginning with `;;;_' are outline topic headers.
ac052b48 77;; Just `ESC-x eval-buffer' to give it a whirl.
19b84ba3 78
d82979ea 79;; ken manheimer (ken dot manheimer at gmail dot com)
c567ac01 80
6a05d05f
PJ
81;;; Code:
82
d82979ea 83;;;_* Dependency autoloads
96b83743 84(require 'overlay)
01fc9422 85(eval-when-compile
ff3e8c8e
KM
86 ;; Most of the requires here are for stuff covered by autoloads, which
87 ;; byte-compiling doesn't trigger.
29fac3fe 88 (require 'epg)
ff3e8c8e 89 (require 'epa)
08cf18e4
GM
90 (require 'overlay)
91 ;; `cl' is required for `assert'. `assert' is not covered by a standard
92 ;; autoload, but it is a macro, so that eval-when-compile is sufficient
93 ;; to byte-compile it in, or to do the require when the buffer evalled.
94 (require 'cl)
95 )
d82979ea 96
19b84ba3 97;;;_* USER CUSTOMIZATION VARIABLES:
96b83743 98
1c9b9df0 99;;;_ > defgroup allout, allout-keybindings
4bef9110
SE
100(defgroup allout nil
101 "Extensive outline mode for use alone and with other modes."
fd5359c6 102 :prefix "allout-"
d82979ea 103 :group 'outlines)
1c9b9df0
KM
104(defgroup allout-keybindings nil
105 "Allout outline mode keyboard bindings configuration."
106 :group 'allout)
19b84ba3
RS
107
108;;;_ + Layout, Mode, and Topic Header Configuration
109
08b5f072
GM
110(defvar allout-command-prefix) ; defined below
111(defvar allout-mode-map)
112
1c9b9df0
KM
113;;;_ > allout-keybindings incidentals:
114;;;_ > allout-bind-keys &optional varname value
115(defun allout-bind-keys (&optional varname value)
116 "Rebuild the `allout-mode-map' according to the keybinding specs.
117
118Useful standalone, to init the map, or in customizing the
119respective allout-mode keybinding variables, `allout-command-prefix',
120`allout-prefixed-keybindings', and `allout-unprefixed-keybindings'"
121 ;; Set the customization variable, if any:
122 (when varname
123 (set-default varname value))
124 (let ((map (make-sparse-keymap))
125 key)
126 (when (boundp 'allout-prefixed-keybindings)
127 ;; Be tolerant of the moments when the variables are first being defined.
128 (dolist (entry allout-prefixed-keybindings)
129 (define-key map
130 ;; XXX vector vs non-vector key descriptions?
131 (vconcat allout-command-prefix
132 (car (read-from-string (car entry))))
133 (cadr entry))))
134 (when (boundp 'allout-unprefixed-keybindings)
135 (dolist (entry allout-unprefixed-keybindings)
136 (define-key map (car (read-from-string (car entry))) (cadr entry))))
137 (setq allout-mode-map map)
138 map
139 ))
140;;;_ = allout-command-prefix
2a1408fd 141(defcustom allout-command-prefix "\C-c "
9201cc28 142 "Key sequence to be used as prefix for outline mode command key bindings.
2a1408fd
DN
143
144Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
145willing to let allout use a bunch of \C-c keybindings."
146 :type 'string
1c9b9df0
KM
147 :group 'allout-keybindings
148 :set 'allout-bind-keys)
149;;;_ = allout-keybindings-binding
150(define-widget 'allout-keybindings-binding 'lazy
151 "Structure of allout keybindings customization items."
152 :type '(repeat
153 (list (string :tag "Key" :value "[(meta control shift ?f)]")
154 (function :tag "Function name"
155 :value allout-forward-current-level))))
156;;;_ = allout-prefixed-keybindings
157(defcustom allout-prefixed-keybindings
158 '(("[(control ?n)]" allout-next-visible-heading)
159 ("[(control ?p)]" allout-previous-visible-heading)
160;; ("[(control ?u)]" allout-up-current-level)
161 ("[(control ?f)]" allout-forward-current-level)
162 ("[(control ?b)]" allout-backward-current-level)
163 ("[(control ?a)]" allout-beginning-of-current-entry)
164 ("[(control ?e)]" allout-end-of-entry)
165 ("[(control ?i)]" allout-show-children)
166 ("[(control ?i)]" allout-show-children)
167 ("[(control ?s)]" allout-show-current-subtree)
168 ("[(control ?t)]" allout-toggle-current-subtree-exposure)
169 ("[(control ?h)]" allout-hide-current-subtree)
170 ("[?h]" allout-hide-current-subtree)
171 ("[(control ?o)]" allout-show-current-entry)
172 ("[?!]" allout-show-all)
173 ("[?x]" allout-toggle-current-subtree-encryption)
174 ("[? ]" allout-open-sibtopic)
175 ("[?.]" allout-open-subtopic)
176 ("[?,]" allout-open-supertopic)
177 ("[?']" allout-shift-in)
178 ("[?>]" allout-shift-in)
179 ("[?<]" allout-shift-out)
180 ("[(control ?m)]" allout-rebullet-topic)
181 ("[?*]" allout-rebullet-current-heading)
182 ("[?']" allout-number-siblings)
183 ("[(control ?k)]" allout-kill-topic)
184 ("[??]" allout-copy-topic-as-kill)
185 ("[?@]" allout-resolve-xref)
186 ("[?=?c]" allout-copy-exposed-to-buffer)
187 ("[?=?i]" allout-indented-exposed-to-buffer)
188 ("[?=?t]" allout-latexify-exposed)
189 ("[?=?p]" allout-flatten-exposed-to-buffer)
190 )
191 "Allout-mode key bindings that are prefixed with `allout-command-prefix'.
192
193See `allout-unprefixed-keybindings' for the list of keybindings
194that are not prefixed.
195
196Use vector format for the keys:
197 - put literal keys after a '?' question mark, eg: '?a', '?.'
198 - enclose control, shift, or meta-modified keys as sequences within
199 parentheses, with the literal key, as above, preceded by the name(s)
200 of the modifers, eg: [(control ?a)]
201See the existing keys for examples.
202
203Functions can be bound to multiple keys, but binding keys to
204multiple functions will not work - the last binding for a key
205prevails."
206 :type 'allout-keybindings-binding
207 :group 'allout-keybindings
208 :set 'allout-bind-keys
209 )
210;;;_ = allout-unprefixed-keybindings
211(defcustom allout-unprefixed-keybindings
212 '(("[(control ?k)]" allout-kill-line)
213 ("[??(meta ?k)]" allout-copy-line-as-kill)
214 ("[(control ?y)]" allout-yank)
215 ("[??(meta ?y)]" allout-yank-pop)
216 )
217 "Allout-mode functions bound to keys without any added prefix.
218
219This is in contrast to the majority of allout-mode bindings on
220`allout-prefixed-bindings', whose bindings are created with a
221preceeding command key.
222
223Use vector format for the keys:
224 - put literal keys after a '?' question mark, eg: '?a', '?.'
225 - enclose control, shift, or meta-modified keys as sequences within
226 parentheses, with the literal key, as above, preceded by the name(s)
227 of the modifers, eg: [(control ?a)]
228See the existing keys for examples."
229 :type 'allout-keybindings-binding
230 :group 'allout-keybindings
231 :set 'allout-bind-keys
232 )
233
234;;;_ = allout-preempt-trailing-ctrl-h
235(defcustom allout-preempt-trailing-ctrl-h nil
236 "Use <prefix>-\C-h, instead of leaving it for describe-prefix-bindings?"
237 :type 'boolean
2a1408fd 238 :group 'allout)
8dd59f01 239
2a1408fd 240;;;_ = allout-keybindings-list
2576c28f 241;;; You have to reactivate allout-mode to change this var's current setting.
2a1408fd
DN
242(defvar allout-keybindings-list ()
243 "*List of `allout-mode' key / function bindings, for `allout-mode-map'.
2a1408fd
DN
244String or vector key will be prefaced with `allout-command-prefix',
245unless optional third, non-nil element is present.")
246(setq allout-keybindings-list
247 '(
248 ; Motion commands:
249 ("\C-n" allout-next-visible-heading)
250 ("\C-p" allout-previous-visible-heading)
251 ("\C-u" allout-up-current-level)
252 ("\C-f" allout-forward-current-level)
253 ("\C-b" allout-backward-current-level)
254 ("\C-a" allout-beginning-of-current-entry)
255 ("\C-e" allout-end-of-entry)
256 ; Exposure commands:
1c9b9df0
KM
257 ([(control i)] allout-show-children) ; xemacs translates "\C-i" to tab
258 ("\C-i" allout-show-children) ; but we still need this for hotspot
2a1408fd 259 ("\C-s" allout-show-current-subtree)
1c9b9df0
KM
260 ;; binding to \C-h is included if allout-preempt-trailing-ctrl-h,
261 ;; so user controls whether or not to preempt the conventional ^H
262 ;; binding to help-command.
263 ("\C-h" allout-hide-current-subtree)
2a1408fd
DN
264 ("\C-t" allout-toggle-current-subtree-exposure)
265 ("h" allout-hide-current-subtree)
266 ("\C-o" allout-show-current-entry)
267 ("!" allout-show-all)
268 ("x" allout-toggle-current-subtree-encryption)
269 ; Alteration commands:
270 (" " allout-open-sibtopic)
271 ("." allout-open-subtopic)
272 ("," allout-open-supertopic)
273 ("'" allout-shift-in)
274 (">" allout-shift-in)
275 ("<" allout-shift-out)
276 ("\C-m" allout-rebullet-topic)
277 ("*" allout-rebullet-current-heading)
278 ("#" allout-number-siblings)
279 ("\C-k" allout-kill-line t)
42c3e51c 280 ([?\M-k] allout-copy-line-as-kill t)
2a1408fd 281 ("\C-y" allout-yank t)
42c3e51c 282 ([?\M-y] allout-yank-pop t)
2a1408fd 283 ("\C-k" allout-kill-topic)
42c3e51c 284 ([?\M-k] allout-copy-topic-as-kill)
2a1408fd
DN
285 ; Miscellaneous commands:
286 ;([?\C-\ ] allout-mark-topic)
287 ("@" allout-resolve-xref)
288 ("=c" allout-copy-exposed-to-buffer)
289 ("=i" allout-indented-exposed-to-buffer)
290 ("=t" allout-latexify-exposed)
291 ("=p" allout-flatten-exposed-to-buffer)))
292
fd5359c6
MR
293;;;_ = allout-auto-activation
294(defcustom allout-auto-activation nil
9201cc28 295 "Regulates auto-activation modality of allout outlines -- see `allout-init'.
19b84ba3 296
fd5359c6 297Setq-default by `allout-init' to regulate whether or not allout
19b84ba3 298outline mode is automatically activated when the buffer-specific
fd5359c6
MR
299variable `allout-layout' is non-nil, and whether or not the layout
300dictated by `allout-layout' should be imposed on mode activation.
19b84ba3 301
24190da5 302With value t, auto-mode-activation and auto-layout are enabled.
aad94676 303\(This also depends on `allout-find-file-hook' being installed in
95c12694 304`find-file-hook', which is also done by `allout-init'.)
19b84ba3
RS
305
306With value `ask', auto-mode-activation is enabled, and endorsement for
307performing auto-layout is asked of the user each time.
308
71296446 309With value `activate', only auto-mode-activation is enabled,
353e2ef2 310auto-layout is not.
19b84ba3 311
24190da5 312With value nil, neither auto-mode-activation nor auto-layout are
19b84ba3
RS
313enabled.
314
fd5359c6 315See the docstring for `allout-init' for the proper interface to
9179616f
DL
316this variable."
317 :type '(choice (const :tag "On" t)
318 (const :tag "Ask about layout" "ask")
319 (const :tag "Mode only" "activate")
320 (const :tag "Off" nil))
321 :group 'allout)
4034b0e2
LT
322;;;_ = allout-default-layout
323(defcustom allout-default-layout '(-2 : 0)
9201cc28 324 "Default allout outline layout specification.
4034b0e2
LT
325
326This setting specifies the outline exposure to use when
327`allout-layout' has the local value `t'. This docstring describes the
328layout specifications.
329
330A list value specifies a default layout for the current buffer,
331to be applied upon activation of `allout-mode'. Any non-nil
332value will automatically trigger `allout-mode', provided
333`allout-init' has been called to enable this behavior.
334
335The types of elements in the layout specification are:
336
60c7bbd2
RS
337 INTEGER -- dictate the relative depth to open the corresponding topic(s),
338 where:
339 -- negative numbers force the topic to be closed before opening
340 to the absolute value of the number, so all siblings are open
341 only to that level.
342 -- positive numbers open to the relative depth indicated by the
343 number, but do not force already opened subtopics to be closed.
344 -- 0 means to close topic -- hide all subitems.
345 : -- repeat spec -- apply the preceeding element to all siblings at
346 current level, *up to* those siblings that would be covered by specs
347 following the `:' on the list. Ie, apply to all topics at level but
348 trailing ones accounted for by trailing specs. (Only the first of
349 multiple colons at the same level is honored -- later ones are ignored.)
350 * -- completely exposes the topic, including bodies
351 + -- exposes all subtopics, but not the bodies
352 - -- exposes the body of the corresponding topic, but not subtopics
353 LIST -- a nested layout spec, to be applied intricately to its
4034b0e2 354 corresponding item(s)
1977b8f6 355
4034b0e2 356Examples:
60c7bbd2 357 (-2 : 0)
4034b0e2
LT
358 Collapse the top-level topics to show their children and
359 grandchildren, but completely collapse the final top-level topic.
60c7bbd2 360 (-1 () : 1 0)
4034b0e2
LT
361 Close the first topic so only the immediate subtopics are shown,
362 leave the subsequent topics exposed as they are until the second
363 second to last topic, which is exposed at least one level, and
364 completely close the last topic.
60c7bbd2 365 (-2 : -1 *)
4034b0e2
LT
366 Expose children and grandchildren of all topics at current
367 level except the last two; expose children of the second to
368 last and completely expose the last one, including its subtopics.
19b84ba3 369
4034b0e2 370See `allout-expose-topic' for more about the exposure process.
19b84ba3 371
353e2ef2
KH
372Also, allout's mode-specific provisions will make topic prefixes default
373to the comment-start string, if any, of the language of the file. This
4034b0e2
LT
374is modulo the setting of `allout-use-mode-specific-leader', which see."
375 :type 'allout-layout-type
376 :group 'allout)
377;;;_ : allout-layout-type
378(define-widget 'allout-layout-type 'lazy
379 "Allout layout format customization basic building blocks."
380 :type '(repeat
381 (choice (integer :tag "integer (<= zero is strict)")
382 (const :tag ": (repeat prior)" :)
383 (const :tag "* (completely expose)" *)
384 (const :tag "+ (expose all offspring, headlines only)" +)
385 (const :tag "- (expose topic body but not offspring)" -)
386 (allout-layout-type :tag "<Nested layout>"))))
387
2a1408fd
DN
388;;;_ = allout-inhibit-auto-fill
389(defcustom allout-inhibit-auto-fill nil
9201cc28 390 "If non-nil, auto-fill will be inhibited in the allout buffers.
2a1408fd
DN
391
392You can customize this setting to set it for all allout buffers, or set it
393in individual buffers if you want to inhibit auto-fill only in particular
394buffers. (You could use a function on `allout-mode-hook' to inhibit
395auto-fill according, eg, to the major mode.)
396
397If you don't set this and auto-fill-mode is enabled, allout will use the
398value that `normal-auto-fill-function', if any, when allout mode starts, or
399else allout's special hanging-indent maintaining auto-fill function,
400`allout-auto-fill'."
401 :type 'boolean
402 :group 'allout)
403(make-variable-buffer-local 'allout-inhibit-auto-fill)
404;;;_ = allout-use-hanging-indents
405(defcustom allout-use-hanging-indents t
9201cc28 406 "If non-nil, topic body text auto-indent defaults to indent of the header.
2a1408fd 407Ie, it is indented to be just past the header prefix. This is
8dd59f01 408relevant mostly for use with `indented-text-mode', or other situations
2a1408fd
DN
409where auto-fill occurs."
410 :type 'boolean
411 :group 'allout)
412(make-variable-buffer-local 'allout-use-hanging-indents)
413;;;###autoload
414(put 'allout-use-hanging-indents 'safe-local-variable
415 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
416;;;_ = allout-reindent-bodies
417(defcustom allout-reindent-bodies (if allout-use-hanging-indents
418 'text)
9201cc28 419 "Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
2a1408fd
DN
420
421When active, topic body lines that are indented even with or beyond
422their topic header are reindented to correspond with depth shifts of
423the header.
424
425A value of t enables reindent in non-programming-code buffers, ie
426those that do not have the variable `comment-start' set. A value of
427`force' enables reindent whether or not `comment-start' is set."
428 :type '(choice (const nil) (const t) (const text) (const force))
429 :group 'allout)
430
431(make-variable-buffer-local 'allout-reindent-bodies)
432;;;###autoload
433(put 'allout-reindent-bodies 'safe-local-variable
434 '(lambda (x) (memq x '(nil t text force))))
435
fd5359c6
MR
436;;;_ = allout-show-bodies
437(defcustom allout-show-bodies nil
9201cc28 438 "If non-nil, show entire body when exposing a topic, rather than
9179616f
DL
439just the header."
440 :type 'boolean
441 :group 'allout)
fd5359c6 442(make-variable-buffer-local 'allout-show-bodies)
8570ce80
SM
443;;;###autoload
444(put 'allout-show-bodies 'safe-local-variable
64686e6d 445 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
1977b8f6 446
48bd8440
EZ
447;;;_ = allout-beginning-of-line-cycles
448(defcustom allout-beginning-of-line-cycles t
9201cc28 449 "If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options.
48bd8440
EZ
450
451Cycling only happens on when the command is repeated, not when it
452follows a different command.
453
454Smart-placement means that repeated calls to this function will
455advance as follows:
456
457 - if the cursor is on a non-headline body line and not on the first column:
458 then it goes to the first column
459 - if the cursor is on the first column of a non-headline body line:
460 then it goes to the start of the headline within the item body
461 - if the cursor is on the headline and not the start of the headline:
462 then it goes to the start of the headline
463 - if the cursor is on the start of the headline:
c07583cd 464 then it goes to the bullet character (for hotspot navigation)
48bd8440 465 - if the cursor is on the bullet character:
c07583cd 466 then it goes to the first column of that line (the headline)
48bd8440
EZ
467 - if the cursor is on the first column of the headline:
468 then it goes to the start of the headline within the item body.
469
470In this fashion, you can use the beginning-of-line command to do
471its normal job and then, when repeated, advance through the
472entry, cycling back to start.
473
474If this configuration variable is nil, then the cursor is just
475advanced to the beginning of the line and remains there on
476repeated calls."
477 :type 'boolean :group 'allout)
478;;;_ = allout-end-of-line-cycles
479(defcustom allout-end-of-line-cycles t
9201cc28 480 "If non-nil, \\[allout-end-of-line] will cycle through smart-placement options.
48bd8440
EZ
481
482Cycling only happens on when the command is repeated, not when it
483follows a different command.
484
60c7bbd2 485Smart placement means that repeated calls to this function will
48bd8440
EZ
486advance as follows:
487
488 - if the cursor is not on the end-of-line,
489 then it goes to the end-of-line
490 - if the cursor is on the end-of-line but not the end-of-entry,
491 then it goes to the end-of-entry, exposing it if necessary
492 - if the cursor is on the end-of-entry,
493 then it goes to the end of the head line
494
495In this fashion, you can use the end-of-line command to do its
496normal job and then, when repeated, advance through the entry,
497cycling back to start.
498
499If this configuration variable is nil, then the cursor is just
500advanced to the end of the line and remains there on repeated
501calls."
502 :type 'boolean :group 'allout)
503
fd5359c6
MR
504;;;_ = allout-header-prefix
505(defcustom allout-header-prefix "."
48bd8440
EZ
506;; this string is treated as literal match. it will be `regexp-quote'd, so
507;; one cannot use regular expressions to match varying header prefixes.
9201cc28 508 "Leading string which helps distinguish topic headers.
19b84ba3
RS
509
510Outline topic header lines are identified by a leading topic
c567ac01 511header prefix, which mostly have the value of this var at their front.
48bd8440
EZ
512Level 1 topics are exceptions. They consist of only a single
513character, which is typically set to the `allout-primary-bullet'."
4bef9110
SE
514 :type 'string
515 :group 'allout)
fd5359c6 516(make-variable-buffer-local 'allout-header-prefix)
8570ce80
SM
517;;;###autoload
518(put 'allout-header-prefix 'safe-local-variable 'stringp)
fd5359c6
MR
519;;;_ = allout-primary-bullet
520(defcustom allout-primary-bullet "*"
19b84ba3
RS
521 "Bullet used for top-level outline topics.
522
523Outline topic header lines are identified by a leading topic header
c567ac01 524prefix, which is concluded by bullets that includes the value of this
fd5359c6 525var and the respective allout-*-bullets-string vars.
c567ac01 526
353e2ef2 527The value of an asterisk (`*') provides for backwards compatibility
e126900f 528with the original Emacs outline mode. See `allout-plain-bullets-string'
2265e017 529and `allout-distinctive-bullets-string' for the range of available
4bef9110
SE
530bullets."
531 :type 'string
532 :group 'allout)
fd5359c6 533(make-variable-buffer-local 'allout-primary-bullet)
8570ce80
SM
534;;;###autoload
535(put 'allout-primary-bullet 'safe-local-variable 'stringp)
fd5359c6 536;;;_ = allout-plain-bullets-string
d82979ea 537(defcustom allout-plain-bullets-string ".,"
9201cc28 538 "The bullets normally used in outline topic prefixes.
19b84ba3 539
fd5359c6 540See `allout-distinctive-bullets-string' for the other kind of
c567ac01 541bullets.
1977b8f6 542
353e2ef2 543DO NOT include the close-square-bracket, `]', as a bullet.
1977b8f6 544
c567ac01 545Outline mode has to be reactivated in order for changes to the value
4bef9110
SE
546of this var to take effect."
547 :type 'string
548 :group 'allout)
fd5359c6 549(make-variable-buffer-local 'allout-plain-bullets-string)
8570ce80
SM
550;;;###autoload
551(put 'allout-plain-bullets-string 'safe-local-variable 'stringp)
fd5359c6 552;;;_ = allout-distinctive-bullets-string
d82979ea 553(defcustom allout-distinctive-bullets-string "*+-=>()[{}&!?#%\"X@$~_\\:;^"
9201cc28 554 "Persistent outline header bullets used to distinguish special topics.
1977b8f6 555
38b2ca53
NR
556These bullets are distinguish topics with particular character.
557They are not used by default in the topic creation routines, but
558are offered as options when you modify topic creation with a
559universal argument \(\\[universal-argument]), or during rebulleting \(\\[allout-rebullet-current-heading]).
560
561Distinctive bullets are not cycled when topics are shifted or
562otherwise automatically rebulleted, so their marking is
563persistent until deliberately changed. Their significance is
564purely by convention, however. Some conventions suggest
565themselves:
566
60c7bbd2
RS
567 `(' - open paren -- an aside or incidental point
568 `?' - question mark -- uncertain or outright question
569 `!' - exclamation point/bang -- emphatic
570 `[' - open square bracket -- meta-note, about item instead of item's subject
571 `\"' - double quote -- a quotation or other citation
572 `=' - equal sign -- an assignement, equating a name with some connotation
573 `^' - carat -- relates to something above
38b2ca53
NR
574
575Some are more elusive, but their rationale may be recognizable:
576
60c7bbd2
RS
577 `+' - plus -- pending consideration, completion
578 `_' - underscore -- done, completed
579 `&' - ampersand -- addendum, furthermore
38b2ca53
NR
580
581\(Some other non-plain bullets have special meaning to the
582software. By default:
583
60c7bbd2
RS
584 `~' marks encryptable topics -- see `allout-topic-encryption-bullet'
585 `#' marks auto-numbered bullets -- see `allout-numbered-bullet'.)
38b2ca53
NR
586
587See `allout-plain-bullets-string' for the standard, alternating
588bullets.
1977b8f6 589
fd5359c6 590You must run `set-allout-regexp' in order for outline mode to
38b2ca53 591adopt changes of this value.
19b84ba3 592
353e2ef2 593DO NOT include the close-square-bracket, `]', on either of the bullet
4bef9110
SE
594strings."
595 :type 'string
596 :group 'allout)
fd5359c6 597(make-variable-buffer-local 'allout-distinctive-bullets-string)
8570ce80
SM
598;;;###autoload
599(put 'allout-distinctive-bullets-string 'safe-local-variable 'stringp)
1977b8f6 600
fd5359c6
MR
601;;;_ = allout-use-mode-specific-leader
602(defcustom allout-use-mode-specific-leader t
9201cc28 603 "When non-nil, use mode-specific topic-header prefixes.
19b84ba3 604
48bd8440
EZ
605Allout outline mode will use the mode-specific `allout-mode-leaders' or
606comment-start string, if any, to lead the topic prefix string, so topic
607headers look like comments in the programming language. It will also use
608the comment-start string, with an '_' appended, for `allout-primary-bullet'.
19b84ba3 609
48bd8440
EZ
610String values are used as literals, not regular expressions, so
611do not escape any regulare-expression characters.
19b84ba3 612
24190da5 613Value t means to first check for assoc value in `allout-mode-leaders'
c07583cd 614alist, then use comment-start string, if any, then use default (`.').
9179616f 615\(See note about use of comment-start strings, below.)
19b84ba3 616
fd5359c6 617Set to the symbol for either of `allout-mode-leaders' or
19b84ba3
RS
618`comment-start' to use only one of them, respectively.
619
c07583cd 620Value nil means to always use the default (`.') and leave
48bd8440
EZ
621`allout-primary-bullet' unaltered.
622
623comment-start strings that do not end in spaces are tripled in
624the header-prefix, and an `_' underscore is tacked on the end, to
625distinguish them from regular comment strings. comment-start
626strings that do end in spaces are not tripled, but an underscore
75bcb912 627is substituted for the space. [This presumes that the space is
48bd8440
EZ
628for appearance, not comment syntax. You can use
629`allout-mode-leaders' to override this behavior, when
630undesired.]"
71296446 631 :type '(choice (const t) (const nil) string
fd5359c6 632 (const allout-mode-leaders)
4bef9110
SE
633 (const comment-start))
634 :group 'allout)
8570ce80
SM
635;;;###autoload
636(put 'allout-use-mode-specific-leader 'safe-local-variable
da506f05
RS
637 '(lambda (x) (or (memq x '(t nil allout-mode-leaders comment-start))
638 (stringp x))))
fd5359c6
MR
639;;;_ = allout-mode-leaders
640(defvar allout-mode-leaders '()
641 "Specific allout-prefix leading strings per major modes.
19b84ba3 642
48bd8440
EZ
643Use this if the mode's comment-start string isn't what you
644prefer, or if the mode lacks a comment-start string. See
645`allout-use-mode-specific-leader' for more details.
19b84ba3
RS
646
647If you're constructing a string that will comment-out outline
648structuring so it can be included in program code, append an extra
649character, like an \"_\" underscore, to distinguish the lead string
48bd8440 650from regular comments that start at the beginning-of-line.")
19b84ba3 651
fd5359c6
MR
652;;;_ = allout-old-style-prefixes
653(defcustom allout-old-style-prefixes nil
9201cc28 654 "When non-nil, use only old-and-crusty `outline-mode' `*' topic prefixes.
19b84ba3
RS
655
656Non-nil restricts the topic creation and modification
c567ac01 657functions to asterix-padded prefixes, so they look exactly
e126900f 658like the original Emacs-outline style prefixes.
1977b8f6 659
c567ac01 660Whatever the setting of this variable, both old and new style prefixes
4bef9110
SE
661are always respected by the topic maneuvering functions."
662 :type 'boolean
663 :group 'allout)
fd5359c6 664(make-variable-buffer-local 'allout-old-style-prefixes)
8570ce80
SM
665;;;###autoload
666(put 'allout-old-style-prefixes 'safe-local-variable
64686e6d 667 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
60c7bbd2 668;;;_ = allout-stylish-prefixes -- alternating bullets
fd5359c6 669(defcustom allout-stylish-prefixes t
9201cc28 670 "Do fancy stuff with topic prefix bullets according to level, etc.
c567ac01 671
19b84ba3
RS
672Non-nil enables topic creation, modification, and repositioning
673functions to vary the topic bullet char (the char that marks the topic
674depth) just preceding the start of the topic text) according to level.
353e2ef2 675Otherwise, only asterisks (`*') and distinctive bullets are used.
19b84ba3
RS
676
677This is how an outline can look (but sans indentation) with stylish
678prefixes:
c567ac01
RS
679
680 * Top level
681 .* A topic
682 . + One level 3 subtopic
683 . . One level 4 subtopic
19b84ba3 684 . . A second 4 subtopic
c567ac01 685 . + Another level 3 subtopic
19b84ba3
RS
686 . #1 A numbered level 4 subtopic
687 . #2 Another
688 . ! Another level 4 subtopic with a different distinctive bullet
689 . #4 And another numbered level 4 subtopic
c567ac01 690
19b84ba3
RS
691This would be an outline with stylish prefixes inhibited (but the
692numbered and other distinctive bullets retained):
c567ac01
RS
693
694 * Top level
695 .* A topic
19b84ba3
RS
696 . * One level 3 subtopic
697 . * One level 4 subtopic
698 . * A second 4 subtopic
699 . * Another level 3 subtopic
700 . #1 A numbered level 4 subtopic
701 . #2 Another
702 . ! Another level 4 subtopic with a different distinctive bullet
703 . #4 And another numbered level 4 subtopic
c567ac01
RS
704
705Stylish and constant prefixes (as well as old-style prefixes) are
706always respected by the topic maneuvering functions, regardless of
707this variable setting.
708
2265e017 709The setting of this var is not relevant when `allout-old-style-prefixes'
4bef9110
SE
710is non-nil."
711 :type 'boolean
712 :group 'allout)
fd5359c6 713(make-variable-buffer-local 'allout-stylish-prefixes)
8570ce80
SM
714;;;###autoload
715(put 'allout-stylish-prefixes 'safe-local-variable
64686e6d 716 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
1977b8f6 717
fd5359c6
MR
718;;;_ = allout-numbered-bullet
719(defcustom allout-numbered-bullet "#"
9201cc28 720 "String designating bullet of topics that have auto-numbering; nil for none.
19b84ba3 721
a0776d6b 722Topics having this bullet have automatic maintenance of a sibling
19b84ba3 723sequence-number tacked on, just after the bullet. Conventionally set
c567ac01 724to \"#\", you can set it to a bullet of your choice. A nil value
4bef9110
SE
725disables numbering maintenance."
726 :type '(choice (const nil) string)
727 :group 'allout)
fd5359c6 728(make-variable-buffer-local 'allout-numbered-bullet)
8570ce80 729;;;###autoload
64686e6d
RS
730(put 'allout-numbered-bullet 'safe-local-variable
731 (if (fboundp 'string-or-null-p)
732 'string-or-null-p
733 '(lambda (x) (or (stringp x) (null x)))))
fd5359c6
MR
734;;;_ = allout-file-xref-bullet
735(defcustom allout-file-xref-bullet "@"
9201cc28 736 "Bullet signifying file cross-references, for `allout-resolve-xref'.
19b84ba3 737
9179616f 738Set this var to the bullet you want to use for file cross-references."
4bef9110
SE
739 :type '(choice (const nil) string)
740 :group 'allout)
8570ce80 741;;;###autoload
64686e6d
RS
742(put 'allout-file-xref-bullet 'safe-local-variable
743 (if (fboundp 'string-or-null-p)
744 'string-or-null-p
745 '(lambda (x) (or (stringp x) (null x)))))
fd5359c6
MR
746;;;_ = allout-presentation-padding
747(defcustom allout-presentation-padding 2
9201cc28 748 "Presentation-format white-space padding factor, for greater indent."
9179616f
DL
749 :type 'integer
750 :group 'allout)
751
fd5359c6 752(make-variable-buffer-local 'allout-presentation-padding)
8570ce80
SM
753;;;###autoload
754(put 'allout-presentation-padding 'safe-local-variable 'integerp)
9179616f 755
fd5359c6
MR
756;;;_ = allout-abbreviate-flattened-numbering
757(defcustom allout-abbreviate-flattened-numbering nil
9201cc28 758 "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic
9179616f
DL
759numbers to minimal amount with some context. Otherwise, entire
760numbers are always used."
761 :type 'boolean
762 :group 'allout)
763
c567ac01 764;;;_ + LaTeX formatting
fd5359c6
MR
765;;;_ - allout-number-pages
766(defcustom allout-number-pages nil
9201cc28 767 "Non-nil turns on page numbering for LaTeX formatting of an outline."
4bef9110
SE
768 :type 'boolean
769 :group 'allout)
fd5359c6
MR
770;;;_ - allout-label-style
771(defcustom allout-label-style "\\large\\bf"
9201cc28 772 "Font and size of labels for LaTeX formatting of an outline."
4bef9110
SE
773 :type 'string
774 :group 'allout)
fd5359c6
MR
775;;;_ - allout-head-line-style
776(defcustom allout-head-line-style "\\large\\sl "
9201cc28 777 "Font and size of entries for LaTeX formatting of an outline."
4bef9110
SE
778 :type 'string
779 :group 'allout)
fd5359c6
MR
780;;;_ - allout-body-line-style
781(defcustom allout-body-line-style " "
9201cc28 782 "Font and size of entries for LaTeX formatting of an outline."
4bef9110
SE
783 :type 'string
784 :group 'allout)
fd5359c6
MR
785;;;_ - allout-title-style
786(defcustom allout-title-style "\\Large\\bf"
9201cc28 787 "Font and size of titles for LaTeX formatting of an outline."
4bef9110
SE
788 :type 'string
789 :group 'allout)
fd5359c6 790;;;_ - allout-title
d82979ea 791(defcustom allout-title '(or buffer-file-name (buffer-name))
9201cc28 792 "Expression to be evaluated to determine the title for LaTeX
4bef9110
SE
793formatted copy."
794 :type 'sexp
795 :group 'allout)
fd5359c6
MR
796;;;_ - allout-line-skip
797(defcustom allout-line-skip ".05cm"
9201cc28 798 "Space between lines for LaTeX formatting of an outline."
4bef9110
SE
799 :type 'string
800 :group 'allout)
fd5359c6
MR
801;;;_ - allout-indent
802(defcustom allout-indent ".3cm"
9201cc28 803 "LaTeX formatted depth-indent spacing."
4bef9110
SE
804 :type 'string
805 :group 'allout)
c567ac01 806
d82979ea 807;;;_ + Topic encryption
8570ce80
SM
808;;;_ = allout-encryption group
809(defgroup allout-encryption nil
810 "Settings for topic encryption features of allout outliner."
811 :group 'allout)
d82979ea
EZ
812;;;_ = allout-topic-encryption-bullet
813(defcustom allout-topic-encryption-bullet "~"
9201cc28 814 "Bullet signifying encryption of the entry's body."
d82979ea 815 :type '(choice (const nil) string)
21e8bc99 816 :version "22.1"
8570ce80 817 :group 'allout-encryption)
d82979ea 818;;;_ = allout-encrypt-unencrypted-on-saves
96b83743 819(defcustom allout-encrypt-unencrypted-on-saves t
9201cc28 820 "When saving, should topics pending encryption be encrypted?
d82979ea
EZ
821
822The idea is to prevent file-system exposure of any un-encrypted stuff, and
823mostly covers both deliberate file writes and auto-saves.
824
825 - Yes: encrypt all topics pending encryption, even if it's the one
c07583cd 826 currently being edited. (In that case, the currently edited topic
d82979ea
EZ
827 will be automatically decrypted before any user interaction, so they
828 can continue editing but the copy on the file system will be
829 encrypted.)
830 Auto-saves will use the \"All except current topic\" mode if this
60c7bbd2 831 one is selected, to avoid practical difficulties -- see below.
d82979ea
EZ
832 - All except current topic: skip the topic currently being edited, even if
833 it's pending encryption. This may expose the current topic on the
834 file sytem, but avoids the nuisance of prompts for the encryption
0949617b 835 passphrase in the middle of editing for, eg, autosaves.
d82979ea
EZ
836 This mode is used for auto-saves for both this option and \"Yes\".
837 - No: leave it to the user to encrypt any unencrypted topics.
838
839For practical reasons, auto-saves always use the 'except-current policy
c07583cd 840when auto-encryption is enabled. (Otherwise, spurious passphrase prompts
0949617b
EZ
841and unavoidable timing collisions are too disruptive.) If security for a
842file requires that even the current topic is never auto-saved in the clear,
d82979ea
EZ
843disable auto-saves for that file."
844
845 :type '(choice (const :tag "Yes" t)
846 (const :tag "All except current topic" except-current)
847 (const :tag "No" nil))
21e8bc99 848 :version "22.1"
8570ce80 849 :group 'allout-encryption)
d82979ea
EZ
850(make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves)
851
01fc9422
EZ
852;;;_ + Developer
853;;;_ = allout-developer group
854(defgroup allout-developer nil
1c9b9df0 855 "Allout settings developers care about, including topic encryption and more."
01fc9422
EZ
856 :group 'allout)
857;;;_ = allout-run-unit-tests-on-load
858(defcustom allout-run-unit-tests-on-load nil
9201cc28 859 "When non-nil, unit tests will be run at end of loading the allout module.
01fc9422
EZ
860
861Generally, allout code developers are the only ones who'll want to set this.
862
863\(If set, this makes it an even better practice to exercise changes by
5204800f
NR
864doing byte-compilation with a repeat count, so the file is loaded after
865compilation.)
01fc9422
EZ
866
867See `allout-run-unit-tests' to see what's run."
868 :type 'boolean
869 :group 'allout-developer)
870
c567ac01
RS
871;;;_ + Miscellaneous customization
872
d82979ea
EZ
873;;;_ = allout-enable-file-variable-adjustment
874(defcustom allout-enable-file-variable-adjustment t
9201cc28 875 "If non-nil, some allout outline actions edit Emacs local file var text.
d82979ea
EZ
876
877This can range from changes to existing entries, addition of new ones,
878and creation of a new local variables section when necessary.
19b84ba3 879
d82979ea
EZ
880Emacs file variables adjustments are also inhibited if `enable-local-variables'
881is nil.
c567ac01 882
d82979ea 883Operations potentially causing edits include allout encryption routines.
69027dea 884For details, see `allout-toggle-current-subtree-encryption's docstring."
4bef9110
SE
885 :type 'boolean
886 :group 'allout)
d82979ea 887(make-variable-buffer-local 'allout-enable-file-variable-adjustment)
c567ac01 888
60c7bbd2 889;;;_* CODE -- no user customizations below.
c567ac01 890
9179616f
DL
891;;;_ #1 Internal Outline Formatting and Configuration
892;;;_ : Version
fd5359c6 893;;;_ = allout-version
8d8f5831 894(defvar allout-version "2.2.2"
c07583cd 895 "Version of currently loaded outline package. (allout.el)")
fd5359c6
MR
896;;;_ > allout-version
897(defun allout-version (&optional here)
19b84ba3
RS
898 "Return string describing the loaded outline version."
899 (interactive "P")
fd5359c6 900 (let ((msg (concat "Allout Outline Mode v " allout-version)))
eac9cf5f 901 (if here (insert msg))
19b84ba3
RS
902 (message "%s" msg)
903 msg))
69027dea
EZ
904;;;_ : Mode activation (defined here because it's referenced early)
905;;;_ = allout-mode
906(defvar allout-mode nil "Allout outline mode minor-mode flag.")
907(make-variable-buffer-local 'allout-mode)
4034b0e2 908;;;_ = allout-layout nil
60c7bbd2 909(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see docstring.
4034b0e2
LT
910 "Buffer-specific setting for allout layout.
911
c07583cd 912In buffers where this is non-nil (and if `allout-init' has been run, to
4034b0e2
LT
913enable this behavior), `allout-mode' will be automatically activated. The
914layout dictated by the value will be used to set the initial exposure when
915`allout-mode' is activated.
916
917\*You should not setq-default this variable non-nil unless you want every
918visited file to be treated as an allout file.*
919
920The value would typically be set by a file local variable. For
921example, the following lines at the bottom of an Emacs Lisp file:
922
923;;;Local variables:
c07583cd 924;;;allout-layout: (0 : -1 -1 0)
4034b0e2
LT
925;;;End:
926
927dictate activation of `allout-mode' mode when the file is visited
928\(presuming allout-init was already run), followed by the
c07583cd 929equivalent of `(allout-expose-topic 0 : -1 -1 0)'. (This is
4034b0e2
LT
930the layout used for the allout.el source file.)
931
932`allout-default-layout' describes the specification format.
933`allout-layout' can additionally have the value `t', in which
934case the value of `allout-default-layout' is used.")
935(make-variable-buffer-local 'allout-layout)
b1a569b5 936;;;###autoload
8570ce80 937(put 'allout-layout 'safe-local-variable
da506f05 938 '(lambda (x) (or (numberp x) (listp x) (memq x '(: * + -)))))
4034b0e2 939
9179616f 940;;;_ : Topic header format
fd5359c6
MR
941;;;_ = allout-regexp
942(defvar allout-regexp ""
c567ac01 943 "*Regular expression to match the beginning of a heading line.
19b84ba3 944
c567ac01
RS
945Any line whose beginning matches this regexp is considered a
946heading. This var is set according to the user configuration vars
2265e017 947by `set-allout-regexp'.")
fd5359c6
MR
948(make-variable-buffer-local 'allout-regexp)
949;;;_ = allout-bullets-string
950(defvar allout-bullets-string ""
19b84ba3
RS
951 "A string dictating the valid set of outline topic bullets.
952
60c7bbd2 953This var should *not* be set by the user -- it is set by `set-allout-regexp',
fd5359c6
MR
954and is produced from the elements of `allout-plain-bullets-string'
955and `allout-distinctive-bullets-string'.")
956(make-variable-buffer-local 'allout-bullets-string)
957;;;_ = allout-bullets-string-len
958(defvar allout-bullets-string-len 0
2265e017 959 "Length of current buffers' `allout-plain-bullets-string'.")
fd5359c6 960(make-variable-buffer-local 'allout-bullets-string-len)
d8350998
CY
961;;;_ = allout-depth-specific-regexp
962(defvar allout-depth-specific-regexp ""
963 "*Regular expression to match a heading line prefix for a particular depth.
964
965This expression is used to search for depth-specific topic
966headers at depth 2 and greater. Use `allout-depth-one-regexp'
967for to seek topics at depth one.
968
969This var is set according to the user configuration vars by
970`set-allout-regexp'. It is prepared with format strings for two
971decimal numbers, which should each be one less than the depth of the
972topic prefix to be matched.")
973(make-variable-buffer-local 'allout-depth-specific-regexp)
974;;;_ = allout-depth-one-regexp
975(defvar allout-depth-one-regexp ""
976 "*Regular expression to match a heading line prefix for depth one.
977
978This var is set according to the user configuration vars by
979`set-allout-regexp'. It is prepared with format strings for two
980decimal numbers, which should each be one less than the depth of the
981topic prefix to be matched.")
982(make-variable-buffer-local 'allout-depth-one-regexp)
fd5359c6
MR
983;;;_ = allout-line-boundary-regexp
984(defvar allout-line-boundary-regexp ()
42c3e51c 985 "`allout-regexp' prepended with a newline for the search target.
19b84ba3 986
d8350998 987This is properly set by `set-allout-regexp'.")
fd5359c6
MR
988(make-variable-buffer-local 'allout-line-boundary-regexp)
989;;;_ = allout-bob-regexp
990(defvar allout-bob-regexp ()
d8350998 991 "Like `allout-line-boundary-regexp', for headers at beginning of buffer.")
fd5359c6
MR
992(make-variable-buffer-local 'allout-bob-regexp)
993;;;_ = allout-header-subtraction
994(defvar allout-header-subtraction (1- (length allout-header-prefix))
995 "Allout-header prefix length to subtract when computing topic depth.")
996(make-variable-buffer-local 'allout-header-subtraction)
997;;;_ = allout-plain-bullets-string-len
998(defvar allout-plain-bullets-string-len (length allout-plain-bullets-string)
2265e017 999 "Length of `allout-plain-bullets-string', updated by `set-allout-regexp'.")
fd5359c6
MR
1000(make-variable-buffer-local 'allout-plain-bullets-string-len)
1001
d8350998 1002;;;_ = allout-doublecheck-at-and-shallower
2a1408fd 1003(defconst allout-doublecheck-at-and-shallower 3
ede4ac6a 1004 "Validate apparent topics of this depth and shallower as being non-aberrant.
fd5359c6 1005
2a1408fd
DN
1006Verified with `allout-aberrant-container-p'. The usefulness of
1007this check is limited to shallow depths, because the
1008determination of aberrance is according to the mistaken item
1009being followed by a legitimate item of excessively greater depth.
1010
1011The classic example of a mistaken item, for a standard allout
1012outline configuration, is a body line that begins with an '...'
1013ellipsis. This happens to contain a legitimate depth-2 header
1014prefix, constituted by two '..' dots at the beginning of the
1015line. The only thing that can distinguish it *in principle* from
1016a legitimate one is if the following real header is at a depth
1017that is discontinuous from the depth of 2 implied by the
1018ellipsis, ie depth 4 or more. As the depth being tested gets
1019greater, the likelihood of this kind of disqualification is
1020lower, and the usefulness of this test is lower.
1021
1022Extending the depth of the doublecheck increases the amount it is
1023applied, increasing the cost of the test - on casual estimation,
1024for outlines with many deep topics, geometrically (O(n)?).
1025Taken together with decreasing likelihood that the test will be
1026useful at greater depths, more modest doublecheck limits are more
1027suitably economical.")
fd5359c6
MR
1028;;;_ X allout-reset-header-lead (header-lead)
1029(defun allout-reset-header-lead (header-lead)
9201cc28 1030 "Reset the leading string used to identify topic headers."
1977b8f6 1031 (interactive "sNew lead string: ")
fd5359c6
MR
1032 (setq allout-header-prefix header-lead)
1033 (setq allout-header-subtraction (1- (length allout-header-prefix)))
1034 (set-allout-regexp))
1035;;;_ X allout-lead-with-comment-string (header-lead)
1036(defun allout-lead-with-comment-string (&optional header-lead)
9201cc28 1037 "Set the topic-header leading string to specified string.
19b84ba3
RS
1038
1039Useful when for encapsulating outline structure in programming
1040language comments. Returns the leading string."
1977b8f6
RS
1041
1042 (interactive "P")
1043 (if (not (stringp header-lead))
1044 (setq header-lead (read-string
1045 "String prefix for topic headers: ")))
fd5359c6
MR
1046 (setq allout-reindent-bodies nil)
1047 (allout-reset-header-lead header-lead)
1977b8f6 1048 header-lead)
48bd8440
EZ
1049;;;_ > allout-infer-header-lead-and-primary-bullet ()
1050(defun allout-infer-header-lead-and-primary-bullet ()
1051 "Determine appropriate `allout-header-prefix' and `allout-primary-bullet'.
19b84ba3
RS
1052
1053Works according to settings of:
1054
8d118843 1055 `comment-start'
fd5359c6
MR
1056 `allout-header-prefix' (default)
1057 `allout-use-mode-specific-leader'
1058and `allout-mode-leaders'.
19b84ba3 1059
c07583cd 1060Apply this via (re)activation of `allout-mode', rather than
8d118843 1061invoking it directly."
fd5359c6
MR
1062 (let* ((use-leader (and (boundp 'allout-use-mode-specific-leader)
1063 (if (or (stringp allout-use-mode-specific-leader)
1064 (memq allout-use-mode-specific-leader
1065 '(allout-mode-leaders
19b84ba3
RS
1066 comment-start
1067 t)))
fd5359c6 1068 allout-use-mode-specific-leader
60c7bbd2 1069 ;; Oops -- garbled value, equate with effect of t:
19b84ba3
RS
1070 t)))
1071 (leader
1072 (cond
1073 ((not use-leader) nil)
1074 ;; Use the explicitly designated leader:
1075 ((stringp use-leader) use-leader)
fd5359c6 1076 (t (or (and (memq use-leader '(t allout-mode-leaders))
19b84ba3 1077 ;; Get it from outline mode leaders?
fd5359c6
MR
1078 (cdr (assq major-mode allout-mode-leaders)))
1079 ;; ... didn't get from allout-mode-leaders...
19b84ba3
RS
1080 (and (memq use-leader '(t comment-start))
1081 comment-start
1082 ;; Use comment-start, maybe tripled, and with
353e2ef2 1083 ;; underscore:
19b84ba3
RS
1084 (concat
1085 (if (string= " "
1086 (substring comment-start
1087 (1- (length comment-start))))
1088 ;; Use comment-start, sans trailing space:
1089 (substring comment-start 0 -1)
1090 (concat comment-start comment-start comment-start))
1091 ;; ... and append underscore, whichever:
1092 "_")))))))
1093 (if (not leader)
1094 nil
48bd8440
EZ
1095 (setq allout-header-prefix leader)
1096 (if (not allout-old-style-prefixes)
ea18b2b1 1097 ;; setting allout-primary-bullet makes the top level topics use --
60c7bbd2 1098 ;; actually, be -- the special prefix:
48bd8440
EZ
1099 (setq allout-primary-bullet leader))
1100 allout-header-prefix)))
1101(defalias 'allout-infer-header-lead
1102 'allout-infer-header-lead-and-primary-bullet)
fd5359c6
MR
1103;;;_ > allout-infer-body-reindent ()
1104(defun allout-infer-body-reindent ()
1105 "Determine proper setting for `allout-reindent-bodies'.
8d118843 1106
c07583cd 1107Depends on default setting of `allout-reindent-bodies' (which see)
8d118843
RS
1108and presence of setting for `comment-start', to tell whether the
1109file is programming code."
fd5359c6 1110 (if (and allout-reindent-bodies
8d118843 1111 comment-start
fd5359c6
MR
1112 (not (eq 'force allout-reindent-bodies)))
1113 (setq allout-reindent-bodies nil)))
1114;;;_ > set-allout-regexp ()
1115(defun set-allout-regexp ()
19b84ba3
RS
1116 "Generate proper topic-header regexp form for outline functions.
1117
fd5359c6 1118Works with respect to `allout-plain-bullets-string' and
d8350998
CY
1119`allout-distinctive-bullets-string'.
1120
1121Also refresh various data structures that hinge on the regexp."
1977b8f6
RS
1122
1123 (interactive)
fd5359c6
MR
1124 ;; Derive allout-bullets-string from user configured components:
1125 (setq allout-bullets-string "")
1126 (let ((strings (list 'allout-plain-bullets-string
1127 'allout-distinctive-bullets-string
1128 'allout-primary-bullet))
1977b8f6
RS
1129 cur-string
1130 cur-len
c567ac01 1131 cur-char
96b83743 1132 index)
1977b8f6 1133 (while strings
96b83743 1134 (setq index 0)
1977b8f6
RS
1135 (setq cur-len (length (setq cur-string (symbol-value (car strings)))))
1136 (while (< index cur-len)
1137 (setq cur-char (aref cur-string index))
fd5359c6
MR
1138 (setq allout-bullets-string
1139 (concat allout-bullets-string
1977b8f6
RS
1140 (cond
1141 ; Single dash would denote a
1142 ; sequence, repeated denotes
1143 ; a dash:
1144 ((eq cur-char ?-) "--")
1145 ; literal close-square-bracket
1146 ; doesn't work right in the
1147 ; expr, exclude it:
1148 ((eq cur-char ?\]) "")
1149 (t (regexp-quote (char-to-string cur-char))))))
1150 (setq index (1+ index)))
1151 (setq strings (cdr strings)))
1152 )
fd5359c6
MR
1153 ;; Derive next for repeated use in allout-pending-bullet:
1154 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string))
1155 (setq allout-header-subtraction (1- (length allout-header-prefix)))
d8350998 1156
42c3e51c 1157 (let (new-part old-part formfeed-part)
d8350998
CY
1158 (setq new-part (concat "\\("
1159 (regexp-quote allout-header-prefix)
1160 "[ \t]*"
1161 ;; already regexp-quoted in a custom way:
1162 "[" allout-bullets-string "]"
1163 "\\)")
1164 old-part (concat "\\("
1165 (regexp-quote allout-primary-bullet)
1166 "\\|"
1167 (regexp-quote allout-header-prefix)
1168 "\\)"
1169 "+"
1170 " ?[^" allout-primary-bullet "]")
42c3e51c
KM
1171 formfeed-part "\\(\^L\\)"
1172
d8350998
CY
1173 allout-regexp (concat new-part
1174 "\\|"
1175 old-part
42c3e51c
KM
1176 "\\|"
1177 formfeed-part)
d8350998
CY
1178
1179 allout-line-boundary-regexp (concat "\n" new-part
1180 "\\|"
42c3e51c
KM
1181 "\n" old-part
1182 "\\|"
1183 "\n" formfeed-part)
d8350998
CY
1184
1185 allout-bob-regexp (concat "\\`" new-part
1186 "\\|"
42c3e51c
KM
1187 "\\`" old-part
1188 "\\|"
1189 "\\`" formfeed-part
1190 ))
d8350998
CY
1191
1192 (setq allout-depth-specific-regexp
1193 (concat "\\(^\\|\\`\\)"
1194 "\\("
1195
1196 ;; new-style spacers-then-bullet string:
1197 "\\("
1198 (allout-format-quote (regexp-quote allout-header-prefix))
1199 " \\{%s\\}"
1200 "[" (allout-format-quote allout-bullets-string) "]"
1201 "\\)"
1202
1203 ;; old-style all-bullets string, if primary not multi-char:
1204 (if (< 0 allout-header-subtraction)
1205 ""
1206 (concat "\\|\\("
1207 (allout-format-quote
1208 (regexp-quote allout-primary-bullet))
1209 (allout-format-quote
1210 (regexp-quote allout-primary-bullet))
1211 (allout-format-quote
1212 (regexp-quote allout-primary-bullet))
1213 "\\{%s\\}"
1214 ;; disqualify greater depths:
1215 "[^"
1216 (allout-format-quote allout-primary-bullet)
1217 "]\\)"
1218 ))
1219 "\\)"
1220 ))
1221 (setq allout-depth-one-regexp
1222 (concat "\\(^\\|\\`\\)"
1223 "\\("
1224
1225 "\\("
1226 (regexp-quote allout-header-prefix)
1227 ;; disqualify any bullet char following any amount of
1228 ;; intervening whitespace:
1229 " *"
1230 (concat "[^ " allout-bullets-string "]")
1231 "\\)"
1232 (if (< 0 allout-header-subtraction)
1233 ;; Need not support anything like the old
1234 ;; bullet style if the prefix is multi-char.
1235 ""
1236 (concat "\\|"
1237 (regexp-quote allout-primary-bullet)
1238 ;; disqualify deeper primary-bullet sequences:
1239 "[^" allout-primary-bullet "]"))
1240 "\\)"
1241 ))))
9179616f 1242;;;_ : Key bindings
fd5359c6
MR
1243;;;_ = allout-mode-map
1244(defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.")
1245;;;_ > produce-allout-mode-map (keymap-alist &optional base-map)
1246(defun produce-allout-mode-map (keymap-list &optional base-map)
75bcb912 1247 "Produce keymap for use as `allout-mode-map', from KEYMAP-LIST.
19b84ba3
RS
1248
1249Built on top of optional BASE-MAP, or empty sparse map if none specified.
75bcb912 1250See doc string for `allout-keybindings-list' for format of binding list."
9179616f 1251 (let ((map (or base-map (make-sparse-keymap)))
fd5359c6 1252 (pref (list allout-command-prefix)))
5110e166 1253 (mapc (function
2a1408fd
DN
1254 (lambda (cell)
1255 (let ((add-pref (null (cdr (cdr cell))))
1256 (key-suff (list (car cell))))
1257 (apply 'define-key
1258 (list map
1259 (apply 'vconcat (if add-pref
1260 (append pref key-suff)
1261 key-suff))
1262 (car (cdr cell)))))))
1263 keymap-list)
19b84ba3 1264 map))
1c9b9df0
KM
1265;;;_ > allout-mode-map-adjustments (base-map)
1266(defun allout-mode-map-adjustments (base-map)
1267 "Do conditional additions to specified base-map, like inclusion of \\C-h."
1268 (if allout-preempt-trailing-ctrl-h
1269 (cons '("\C-h" allout-hide-current-subtree) base-map)
1270 base-map)
1271 )
9179616f 1272;;;_ : Menu bar
95c12694
RS
1273(defvar allout-mode-exposure-menu)
1274(defvar allout-mode-editing-menu)
1275(defvar allout-mode-navigation-menu)
1276(defvar allout-mode-misc-menu)
fd5359c6 1277(defun produce-allout-mode-menubar-entries ()
9179616f 1278 (require 'easymenu)
fd5359c6
MR
1279 (easy-menu-define allout-mode-exposure-menu
1280 allout-mode-map
9179616f
DL
1281 "Allout outline exposure menu."
1282 '("Exposure"
fd5359c6
MR
1283 ["Show Entry" allout-show-current-entry t]
1284 ["Show Children" allout-show-children t]
1285 ["Show Subtree" allout-show-current-subtree t]
1286 ["Hide Subtree" allout-hide-current-subtree t]
1287 ["Hide Leaves" allout-hide-current-leaves t]
9179616f 1288 "----"
fd5359c6
MR
1289 ["Show All" allout-show-all t]))
1290 (easy-menu-define allout-mode-editing-menu
1291 allout-mode-map
9179616f
DL
1292 "Allout outline editing menu."
1293 '("Headings"
fd5359c6
MR
1294 ["Open Sibling" allout-open-sibtopic t]
1295 ["Open Subtopic" allout-open-subtopic t]
1296 ["Open Supertopic" allout-open-supertopic t]
9179616f 1297 "----"
fd5359c6
MR
1298 ["Shift Topic In" allout-shift-in t]
1299 ["Shift Topic Out" allout-shift-out t]
1300 ["Rebullet Topic" allout-rebullet-topic t]
1301 ["Rebullet Heading" allout-rebullet-current-heading t]
d82979ea
EZ
1302 ["Number Siblings" allout-number-siblings t]
1303 "----"
1304 ["Toggle Topic Encryption"
1305 allout-toggle-current-subtree-encryption
1306 (> (allout-current-depth) 1)]))
fd5359c6
MR
1307 (easy-menu-define allout-mode-navigation-menu
1308 allout-mode-map
9179616f
DL
1309 "Allout outline navigation menu."
1310 '("Navigation"
fd5359c6 1311 ["Next Visible Heading" allout-next-visible-heading t]
9179616f 1312 ["Previous Visible Heading"
fd5359c6 1313 allout-previous-visible-heading t]
9179616f 1314 "----"
fd5359c6
MR
1315 ["Up Level" allout-up-current-level t]
1316 ["Forward Current Level" allout-forward-current-level t]
9179616f 1317 ["Backward Current Level"
fd5359c6 1318 allout-backward-current-level t]
9179616f
DL
1319 "----"
1320 ["Beginning of Entry"
fd5359c6 1321 allout-beginning-of-current-entry t]
d82979ea 1322 ["End of Entry" allout-end-of-entry t]
fd5359c6
MR
1323 ["End of Subtree" allout-end-of-current-subtree t]))
1324 (easy-menu-define allout-mode-misc-menu
1325 allout-mode-map
9179616f
DL
1326 "Allout outlines miscellaneous bindings."
1327 '("Misc"
fd5359c6 1328 ["Version" allout-version t]
9179616f 1329 "----"
fd5359c6 1330 ["Duplicate Exposed" allout-copy-exposed-to-buffer t]
9179616f 1331 ["Duplicate Exposed, numbered"
71296446 1332 allout-flatten-exposed-to-buffer t]
9179616f 1333 ["Duplicate Exposed, indented"
71296446 1334 allout-indented-exposed-to-buffer t]
9179616f 1335 "----"
fd5359c6
MR
1336 ["Set Header Lead" allout-reset-header-lead t]
1337 ["Set New Exposure" allout-expose-topic t])))
01fc9422 1338;;;_ : Allout Modal-Variables Utilities
fd5359c6
MR
1339;;;_ = allout-mode-prior-settings
1340(defvar allout-mode-prior-settings nil
01fc9422 1341 "Internal `allout-mode' use; settings to be resumed on mode deactivation.
1977b8f6 1342
01fc9422
EZ
1343See `allout-add-resumptions' and `allout-do-resumptions'.")
1344(make-variable-buffer-local 'allout-mode-prior-settings)
1345;;;_ > allout-add-resumptions (&rest pairs)
1346(defun allout-add-resumptions (&rest pairs)
48bd8440 1347 "Set name/value PAIRS.
01fc9422
EZ
1348
1349Old settings are preserved for later resumption using `allout-do-resumptions'.
1350
48bd8440
EZ
1351The new values are set as a buffer local. On resumption, the prior buffer
1352scope of the variable is restored along with its value. If it was a void
1353buffer-local value, then it is left as nil on resumption.
1354
01fc9422 1355The pairs are lists whose car is the name of the variable and car of the
48bd8440
EZ
1356cdr is the new value: '(some-var some-value)'. The pairs can actually be
1357triples, where the third element qualifies the disposition of the setting,
1358as described further below.
01fc9422 1359
48bd8440
EZ
1360If the optional third element is the symbol 'extend, then the new value
1361created by `cons'ing the second element of the pair onto the front of the
1362existing value.
01fc9422 1363
48bd8440
EZ
1364If the optional third element is the symbol 'append, then the new value is
1365extended from the existing one by `append'ing a list containing the second
1366element of the pair onto the end of the existing value.
01fc9422 1367
48bd8440 1368Extension, and resumptions in general, should not be used for hook
60c7bbd2 1369functions -- use the 'local mode of `add-hook' for that, instead.
01fc9422
EZ
1370
1371The settings are stored on `allout-mode-prior-settings'."
1372 (while pairs
1373 (let* ((pair (pop pairs))
1374 (name (car pair))
48bd8440
EZ
1375 (value (cadr pair))
1376 (qualifier (if (> (length pair) 2)
1377 (caddr pair)))
1378 prior-value)
01fc9422
EZ
1379 (if (not (symbolp name))
1380 (error "Pair's name, %S, must be a symbol, not %s"
1381 name (type-of name)))
d8350998 1382 (setq prior-value (condition-case nil
48bd8440
EZ
1383 (symbol-value name)
1384 (void-variable nil)))
01fc9422
EZ
1385 (when (not (assoc name allout-mode-prior-settings))
1386 ;; Not already added as a resumption, create the prior setting entry.
1c9b9df0 1387 (if (local-variable-p name (current-buffer))
60c7bbd2 1388 ;; is already local variable -- preserve the prior value:
48bd8440 1389 (push (list name prior-value) allout-mode-prior-settings)
01fc9422
EZ
1390 ;; wasn't local variable, indicate so for resumption by killing
1391 ;; local value, and make it local:
1392 (push (list name) allout-mode-prior-settings)
1393 (make-local-variable name)))
48bd8440
EZ
1394 (if qualifier
1395 (cond ((eq qualifier 'extend)
1396 (if (not (listp prior-value))
1397 (error "extension of non-list prior value attempted")
1398 (set name (cons value prior-value))))
1399 ((eq qualifier 'append)
1400 (if (not (listp prior-value))
1401 (error "appending of non-list prior value attempted")
1402 (set name (append prior-value (list value)))))
1403 (t (error "unrecognized setting qualifier `%s' encountered"
1404 qualifier)))
1405 (set name value)))))
01fc9422
EZ
1406;;;_ > allout-do-resumptions ()
1407(defun allout-do-resumptions ()
1408 "Resume all name/value settings registered by `allout-add-resumptions'.
1409
1410This is used when concluding allout-mode, to resume selected variables to
1411their settings before allout-mode was started."
1412
1413 (while allout-mode-prior-settings
1414 (let* ((pair (pop allout-mode-prior-settings))
1415 (name (car pair))
1416 (value-cell (cdr pair)))
1417 (if (not value-cell)
1418 ;; Prior value was global:
1419 (kill-local-variable name)
1420 ;; Prior value was explicit:
1421 (set name (car value-cell))))))
9179616f 1422;;;_ : Mode-specific incidentals
fd5359c6 1423;;;_ > allout-unprotected (expr)
d82979ea 1424(defmacro allout-unprotected (expr)
96b83743 1425 "Enable internal outline operations to alter invisible text."
1b4d97b2 1426 `(let ((inhibit-read-only (if (not buffer-read-only) t))
0458fa80 1427 (inhibit-field-text-motion t))
96b83743
EZ
1428 ,expr))
1429;;;_ = allout-mode-hook
1430(defvar allout-mode-hook nil
1431 "*Hook that's run when allout mode starts.")
01fc9422
EZ
1432;;;_ = allout-mode-deactivate-hook
1433(defvar allout-mode-deactivate-hook nil
1434 "*Hook that's run when allout mode ends.")
7927f48d
KM
1435(define-obsolete-variable-alias 'allout-mode-deactivate-hook
1436 'allout-mode-off-hook "future")
01fc9422
EZ
1437;;;_ = allout-exposure-category
1438(defvar allout-exposure-category nil
1439 "Symbol for use as allout invisible-text overlay category.")
da506f05 1440;;;_ x allout-view-change-hook
96b83743 1441(defvar allout-view-change-hook nil
c07583cd 1442 "*(Deprecated) A hook run after allout outline exposure changes.
da506f05 1443
48bd8440
EZ
1444Switch to using `allout-exposure-change-hook' instead. Both hooks are
1445currently respected, but the other conveys the details of the exposure
1446change via explicit parameters, and this one will eventually be disabled in
1447a subsequent allout version.")
da506f05
RS
1448;;;_ = allout-exposure-change-hook
1449(defvar allout-exposure-change-hook nil
48bd8440
EZ
1450 "*Hook that's run after allout outline subtree exposure changes.
1451
1452It is run at the conclusion of `allout-flag-region'.
1453
1454Functions on the hook must take three arguments:
1455
60c7bbd2
RS
1456 - FROM -- integer indicating the point at the start of the change.
1457 - TO -- integer indicating the point of the end of the change.
1458 - FLAG -- change mode: nil for exposure, otherwise concealment.
48bd8440
EZ
1459
1460This hook might be invoked multiple times by a single command.
1461
1462This hook is replacing `allout-view-change-hook', which is being deprecated
1463and eventually will not be invoked.")
1464;;;_ = allout-structure-added-hook
1465(defvar allout-structure-added-hook nil
1466 "*Hook that's run after addition of items to the outline.
1467
1468Functions on the hook should take two arguments:
1469
60c7bbd2
RS
1470 - NEW-START -- integer indicating position of start of the first new item.
1471 - NEW-END -- integer indicating position of end of the last new item.
48bd8440 1472
60c7bbd2 1473Some edits that introduce new items may missed by this hook:
48bd8440
EZ
1474specifically edits that native allout routines do not control.
1475
1476This hook might be invoked multiple times by a single command.")
1477;;;_ = allout-structure-deleted-hook
1478(defvar allout-structure-deleted-hook nil
1479 "*Hook that's run after disciplined deletion of subtrees from the outline.
1480
1481Functions on the hook must take two arguments:
1482
60c7bbd2
RS
1483 - DEPTH -- integer indicating the depth of the subtree that was deleted.
1484 - REMOVED-FROM -- integer indicating the point where the subtree was removed.
da506f05 1485
60c7bbd2 1486Some edits that remove or invalidate items may missed by this hook:
48bd8440 1487specifically edits that native allout routines do not control.
96b83743 1488
48bd8440
EZ
1489This hook might be invoked multiple times by a single command.")
1490;;;_ = allout-structure-shifted-hook
1491(defvar allout-structure-shifted-hook nil
1492 "*Hook that's run after shifting of items in the outline.
1493
1494Functions on the hook should take two arguments:
1495
60c7bbd2
RS
1496 - DEPTH-CHANGE -- integer indicating depth increase, negative for decrease
1497 - START -- integer indicating the start point of the shifted parent item.
48bd8440 1498
60c7bbd2 1499Some edits that shift items can be missed by this hook: specifically edits
48bd8440
EZ
1500that native allout routines do not control.
1501
1502This hook might be invoked multiple times by a single command.")
96b83743
EZ
1503;;;_ = allout-outside-normal-auto-fill-function
1504(defvar allout-outside-normal-auto-fill-function nil
1505 "Value of normal-auto-fill-function outside of allout mode.
1506
1507Used by allout-auto-fill to do the mandated normal-auto-fill-function
1508wrapped within allout's automatic fill-prefix setting.")
1509(make-variable-buffer-local 'allout-outside-normal-auto-fill-function)
2576c28f
KM
1510;;;_ = prevent redundant activation by desktop mode:
1511(add-to-list 'desktop-minor-mode-handlers '(allout-mode . nil))
0949617b
EZ
1512;;;_ = allout-passphrase-verifier-string
1513(defvar allout-passphrase-verifier-string nil
1514 "Setting used to test solicited encryption passphrases against the one
1515already associated with a file.
1516
1517It consists of an encrypted random string useful only to verify that a
1518passphrase entered by the user is effective for decryption. The passphrase
1519itself is \*not* recorded in the file anywhere, and the encrypted contents
1520are random binary characters to avoid exposing greater susceptibility to
1521search attacks.
d82979ea
EZ
1522
1523The verifier string is retained as an Emacs file variable, as well as in
a0a022d5 1524the Emacs buffer state, if file variable adjustments are enabled. See
d82979ea 1525`allout-enable-file-variable-adjustment' for details about that.")
0949617b 1526(make-variable-buffer-local 'allout-passphrase-verifier-string)
29fac3fe
KM
1527(make-obsolete 'allout-passphrase-verifier-string
1528 'allout-passphrase-verifier-string "23.3")
8570ce80 1529;;;###autoload
7e5d77dc 1530(put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp)
0949617b
EZ
1531;;;_ = allout-passphrase-hint-string
1532(defvar allout-passphrase-hint-string ""
1533 "Variable used to retain reminder string for file's encryption passphrase.
d82979ea 1534
0949617b 1535See the description of `allout-passphrase-hint-handling' for details about how
d82979ea
EZ
1536the reminder is deployed.
1537
a0a022d5 1538The hint is retained as an Emacs file variable, as well as in the Emacs buffer
d82979ea
EZ
1539state, if file variable adjustments are enabled. See
1540`allout-enable-file-variable-adjustment' for details about that.")
0949617b
EZ
1541(make-variable-buffer-local 'allout-passphrase-hint-string)
1542(setq-default allout-passphrase-hint-string "")
29fac3fe
KM
1543(make-obsolete 'allout-passphrase-hint-string
1544 'allout-passphrase-hint-string "23.3")
8570ce80
SM
1545;;;###autoload
1546(put 'allout-passphrase-hint-string 'safe-local-variable 'stringp)
d82979ea
EZ
1547;;;_ = allout-after-save-decrypt
1548(defvar allout-after-save-decrypt nil
1549 "Internal variable, is nil or has the value of two points:
1550
1551 - the location of a topic to be decrypted after saving is done
1552 - where to situate the cursor after the decryption is performed
1553
1554This is used to decrypt the topic that was currently being edited, if it
1555was encrypted automatically as part of a file write or autosave.")
1556(make-variable-buffer-local 'allout-after-save-decrypt)
48bd8440
EZ
1557;;;_ = allout-encryption-plaintext-sanitization-regexps
1558(defvar allout-encryption-plaintext-sanitization-regexps nil
1559 "List of regexps whose matches are removed from plaintext before encryption.
1560
1561This is for the sake of removing artifacts, like escapes, that are added on
1562and not actually part of the original plaintext. The removal is done just
1563prior to encryption.
1564
1565Entries must be symbols that are bound to the desired values.
1566
1567Each value can be a regexp or a list with a regexp followed by a
1568substitution string. If it's just a regexp, all its matches are removed
1569before the text is encrypted. If it's a regexp and a substitution, the
1570substition is used against the regexp matches, a la `replace-match'.")
1571(make-variable-buffer-local 'allout-encryption-text-removal-regexps)
1572;;;_ = allout-encryption-ciphertext-rejection-regexps
1573(defvar allout-encryption-ciphertext-rejection-regexps nil
1574 "Variable for regexps matching plaintext to remove before encryption.
1575
ff3e8c8e
KM
1576This is used to detect strings in encryption results that would
1577register as allout mode structural elements, for exmple, as a
1578topic prefix.
48bd8440
EZ
1579
1580Entries must be symbols that are bound to the desired regexp values.
1581
ff3e8c8e
KM
1582Encryptions that result in matches will be retried, up to
1583`allout-encryption-ciphertext-rejection-limit' times, after which
1584an error is raised.")
48bd8440
EZ
1585
1586(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps)
1587;;;_ = allout-encryption-ciphertext-rejection-ceiling
1588(defvar allout-encryption-ciphertext-rejection-ceiling 5
1589 "Limit on number of times encryption ciphertext is rejected.
1590
1591See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
1592(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling)
69027dea
EZ
1593;;;_ > allout-mode-p ()
1594;; Must define this macro above any uses, or byte compilation will lack
60c7bbd2 1595;; proper def, if file isn't loaded -- eg, during emacs build!
69027dea
EZ
1596(defmacro allout-mode-p ()
1597 "Return t if `allout-mode' is active in current buffer."
1598 'allout-mode)
d82979ea
EZ
1599;;;_ > allout-write-file-hook-handler ()
1600(defun allout-write-file-hook-handler ()
1601 "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes."
1602
0949617b
EZ
1603 (if (or (not (allout-mode-p))
1604 (not (boundp 'allout-encrypt-unencrypted-on-saves))
d82979ea
EZ
1605 (not allout-encrypt-unencrypted-on-saves))
1606 nil
1607 (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves
1608 'except-current)
1609 (point-marker))))
1610 (if (save-excursion (goto-char (point-min))
1611 (allout-next-topic-pending-encryption except-mark))
1612 (progn
1613 (message "auto-encrypting pending topics")
96b83743 1614 (sit-for 0)
d82979ea
EZ
1615 (condition-case failure
1616 (setq allout-after-save-decrypt
1617 (allout-encrypt-decrypted except-mark))
42c3e51c
KM
1618 (error (message
1619 "allout-write-file-hook-handler suppressing error %s"
1620 failure)
1621 (sit-for 2)))))
d82979ea 1622 ))
42c3e51c 1623 nil)
d82979ea
EZ
1624;;;_ > allout-auto-save-hook-handler ()
1625(defun allout-auto-save-hook-handler ()
69027dea 1626 "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save."
d82979ea 1627
0949617b 1628 (if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves)
d82979ea
EZ
1629 ;; Always implement 'except-current policy when enabled.
1630 (let ((allout-encrypt-unencrypted-on-saves 'except-current))
1631 (allout-write-file-hook-handler))))
1632;;;_ > allout-after-saves-handler ()
1633(defun allout-after-saves-handler ()
1634 "Decrypt topic encrypted for save, if it's currently being edited.
1635
1636Ie, if it was pending encryption and contained the point in its body before
1637the save.
1638
1639We use values stored in `allout-after-save-decrypt' to locate the topic
1640and the place for the cursor after the decryption is done."
1641 (if (not (and (allout-mode-p)
1642 (boundp 'allout-after-save-decrypt)
1643 allout-after-save-decrypt))
1644 t
1645 (goto-char (car allout-after-save-decrypt))
1646 (let ((was-modified (buffer-modified-p)))
69027dea 1647 (allout-toggle-subtree-encryption)
d82979ea
EZ
1648 (if (not was-modified)
1649 (set-buffer-modified-p nil)))
1650 (goto-char (cadr allout-after-save-decrypt))
1651 (setq allout-after-save-decrypt nil))
1652 )
1c9b9df0
KM
1653;;;_ > allout-called-interactively-p ()
1654(defmacro allout-called-interactively-p ()
1655 "A version of called-interactively-p independent of emacs version."
1656 ;; ... to ease maintenance of allout without betraying deprecation.
1657 (if (equal (subr-arity (symbol-function 'called-interactively-p))
1658 '(0 . 0))
1659 '(called-interactively-p)
1660 '(called-interactively-p 'interactive)))
498a6493
CY
1661;;;_ = allout-inhibit-aberrance-doublecheck nil
1662;; In some exceptional moments, disparate topic depths need to be allowed
1663;; momentarily, eg when one topic is being yanked into another and they're
1664;; about to be reconciled. let-binding allout-inhibit-aberrance-doublecheck
1665;; prevents the aberrance doublecheck to allow, eg, the reconciliation
1666;; processing to happen in the presence of such discrepancies. It should
1667;; almost never be needed, however.
1668(defvar allout-inhibit-aberrance-doublecheck nil
1669 "Internal state, for momentarily inhibits aberrance doublecheck.
1670
1671This should only be momentarily let-bound non-nil, not set
1672non-nil in a lasting way.")
19b84ba3 1673
1c9b9df0 1674;;;_ #2 Mode environment and activation
fd5359c6
MR
1675;;;_ = allout-explicitly-deactivated
1676(defvar allout-explicitly-deactivated nil
d82979ea 1677 "If t, `allout-mode's last deactivation was deliberate.
2265e017 1678So `allout-post-command-business' should not reactivate it...")
fd5359c6
MR
1679(make-variable-buffer-local 'allout-explicitly-deactivated)
1680;;;_ > allout-init (&optional mode)
1681(defun allout-init (&optional mode)
2265e017 1682 "Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'.
19b84ba3 1683
8d118843 1684MODE is one of the following symbols:
19b84ba3 1685
c07583cd 1686 - nil (or no argument) deactivate auto-activation/layout;
353e2ef2
KH
1687 - `activate', enable auto-activation only;
1688 - `ask', enable auto-activation, and enable auto-layout but with
a0776d6b 1689 confirmation for layout operation solicited from user each time;
353e2ef2 1690 - `report', just report and return the current auto-activation state;
c07583cd 1691 - anything else (eg, t) for auto-activation and auto-layout, without
8d118843 1692 any confirmation check.
19b84ba3 1693
e126900f 1694Use this function to setup your Emacs session for automatic activation
19b84ba3 1695of allout outline mode, contingent to the buffer-specific setting of
fd5359c6
MR
1696the `allout-layout' variable. (See `allout-layout' and
1697`allout-expose-topic' docstrings for more details on auto layout).
19b84ba3 1698
d82979ea
EZ
1699`allout-init' works by setting up (or removing) the `allout-mode'
1700find-file-hook, and giving `allout-auto-activation' a suitable
1701setting.
19b84ba3 1702
e126900f
JB
1703To prime your Emacs session for full auto-outline operation, include
1704the following two lines in your Emacs init file:
19b84ba3
RS
1705
1706\(require 'allout)
fd5359c6 1707\(allout-init t)"
19b84ba3 1708
d82979ea 1709 (interactive)
1c9b9df0 1710 (if (allout-called-interactively-p)
d82979ea
EZ
1711 (progn
1712 (setq mode
1713 (completing-read
1714 (concat "Select outline auto setup mode "
1715 "(empty for report, ? for options) ")
1716 '(("nil")("full")("activate")("deactivate")
1717 ("ask") ("report") (""))
1718 nil
1719 t))
1720 (if (string= mode "")
1721 (setq mode 'report)
1722 (setq mode (intern-soft mode)))))
8d118843
RS
1723 (let
1724 ;; convenience aliases, for consistent ref to respective vars:
fd5359c6 1725 ((hook 'allout-find-file-hook)
0949617b
EZ
1726 (find-file-hook-var-name (if (boundp 'find-file-hook)
1727 'find-file-hook
1728 'find-file-hooks))
fd5359c6 1729 (curr-mode 'allout-auto-activation))
353e2ef2 1730
8d118843 1731 (cond ((not mode)
0949617b
EZ
1732 (set find-file-hook-var-name
1733 (delq hook (symbol-value find-file-hook-var-name)))
1c9b9df0 1734 (if (allout-called-interactively-p)
8d118843
RS
1735 (message "Allout outline mode auto-activation inhibited.")))
1736 ((eq mode 'report)
0949617b 1737 (if (not (memq hook (symbol-value find-file-hook-var-name)))
d82979ea
EZ
1738 (allout-init nil)
1739 ;; Just punt and use the reports from each of the modes:
1740 (allout-init (symbol-value curr-mode))))
0949617b 1741 (t (add-hook find-file-hook-var-name hook)
353e2ef2 1742 (set curr-mode ; `set', not `setq'!
8d118843
RS
1743 (cond ((eq mode 'activate)
1744 (message
1745 "Outline mode auto-activation enabled.")
1746 'activate)
1747 ((eq mode 'report)
1748 ;; Return the current mode setting:
fd5359c6 1749 (allout-init mode))
8d118843
RS
1750 ((eq mode 'ask)
1751 (message
1752 (concat "Outline mode auto-activation and "
c07583cd 1753 "-layout (upon confirmation) enabled."))
8d118843
RS
1754 'ask)
1755 ((message
1756 "Outline mode auto-activation and -layout enabled.")
1757 'full)))))))
fd5359c6
MR
1758;;;_ > allout-setup-menubar ()
1759(defun allout-setup-menubar ()
aad94676 1760 "Populate the current buffer's menubar with `allout-mode' stuff."
fd5359c6
MR
1761 (let ((menus (list allout-mode-exposure-menu
1762 allout-mode-editing-menu
1763 allout-mode-navigation-menu
1764 allout-mode-misc-menu))
9179616f
DL
1765 cur)
1766 (while menus
1767 (setq cur (car menus)
1768 menus (cdr menus))
1769 (easy-menu-add cur))))
01fc9422
EZ
1770;;;_ > allout-overlay-preparations
1771(defun allout-overlay-preparations ()
1772 "Set the properties of the allout invisible-text overlay and others."
1773 (setplist 'allout-exposure-category nil)
1774 (put 'allout-exposure-category 'invisible 'allout)
1775 (put 'allout-exposure-category 'evaporate t)
1c9b9df0 1776 ;; ??? We use isearch-open-invisible *and* isearch-mode-end-hook. The
ea18b2b1 1777 ;; latter would be sufficient, but it seems that a separate behavior --
60c7bbd2
RS
1778 ;; the _transient_ opening of invisible text during isearch -- is keyed to
1779 ;; presence of the isearch-open-invisible property -- even though this
96b83743 1780 ;; property controls the isearch _arrival_ behavior. This is the case at
21e8bc99 1781 ;; least in emacs 21, 22.1, and xemacs 21.4.
01fc9422 1782 (put 'allout-exposure-category 'isearch-open-invisible
96b83743
EZ
1783 'allout-isearch-end-handler)
1784 (if (featurep 'xemacs)
01fc9422
EZ
1785 (put 'allout-exposure-category 'start-open t)
1786 (put 'allout-exposure-category 'insert-in-front-hooks
96b83743 1787 '(allout-overlay-insert-in-front-handler)))
01fc9422
EZ
1788 (put 'allout-exposure-category 'modification-hooks
1789 '(allout-overlay-interior-modification-handler)))
2576c28f 1790;;;_ > allout-mode (&optional force)
19b84ba3 1791;;;_ : Defun:
0949617b 1792;;;###autoload
2576c28f 1793(defun allout-mode (&optional force)
c567ac01 1794;;;_ . Doc string:
19b84ba3 1795 "Toggle minor mode for controlling exposure and editing of text outlines.
96b83743 1796\\<allout-mode-map>
19b84ba3 1797
2576c28f 1798Allout outline mode always runs as a minor mode.
19b84ba3 1799
2576c28f
KM
1800Optional FORCE non-nil, or command with no universal argument,
1801means force activation.
1802
1803Allout outline mode provides extensive outline oriented
1804formatting and manipulation. It enables structural editing of
1805outlines, as well as navigation and exposure. It also is
1806specifically aimed at accommodating syntax-sensitive text like
1807programming languages. \(For example, see the allout code itself,
1808which is organized as an allout outline.)
19b84ba3 1809
c07583cd 1810In addition to typical outline navigation and exposure, allout includes:
19b84ba3 1811
c07583cd
KS
1812 - topic-oriented authoring, including keystroke-based topic creation,
1813 repositioning, promotion/demotion, cut, and paste
9179616f 1814 - incremental search with dynamic exposure and reconcealment of hidden text
c07583cd 1815 - adjustable format, so programming code can be developed in outline-structure
2576c28f 1816 - easy topic encryption and decryption, symmetric or key-pair
c07583cd
KS
1817 - \"Hot-spot\" operation, for single-keystroke maneuvering and exposure control
1818 - integral outline layout, for automatic initial exposure when visiting a file
1819 - independent extensibility, using comprehensive exposure and authoring hooks
9179616f
DL
1820
1821and many other features.
19b84ba3 1822
2576c28f
KM
1823Below is a description of the key bindings, and then description
1824of special `allout-mode' features and terminology. See also the
1825outline menubar additions for quick reference to many of the
1826features, and see the docstring of the function `allout-init' for
1827instructions on priming your emacs session for automatic
1828activation of `allout-mode'.
9179616f 1829
c07583cd
KS
1830The bindings are dictated by the customizable `allout-keybindings-list'
1831variable. We recommend customizing `allout-command-prefix' to use just
1832`\\C-c' as the command prefix, if the allout bindings don't conflict with
1833any personal bindings you have on \\C-c. In any case, outline structure
1834navigation and authoring is simplified by positioning the cursor on an
60c7bbd2 1835item's bullet character, the \"hot-spot\" -- then you can invoke allout
c07583cd
KS
1836commands with just the un-prefixed, un-control-shifted command letters.
1837This is described further in the HOT-SPOT Operation section.
1838
1839 Exposure Control:
1840 ----------------
1841\\[allout-hide-current-subtree] `allout-hide-current-subtree'
1842\\[allout-show-children] `allout-show-children'
1843\\[allout-show-current-subtree] `allout-show-current-subtree'
1844\\[allout-show-current-entry] `allout-show-current-entry'
1845\\[allout-show-all] `allout-show-all'
1846
1847 Navigation:
1848 ----------
1849\\[allout-next-visible-heading] `allout-next-visible-heading'
1850\\[allout-previous-visible-heading] `allout-previous-visible-heading'
1851\\[allout-up-current-level] `allout-up-current-level'
1852\\[allout-forward-current-level] `allout-forward-current-level'
1853\\[allout-backward-current-level] `allout-backward-current-level'
1854\\[allout-end-of-entry] `allout-end-of-entry'
1855\\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot)
60c7bbd2 1856\\[allout-beginning-of-line] `allout-beginning-of-line' -- like regular beginning-of-line, but
c07583cd
KS
1857 if immediately repeated cycles to the beginning of the current item
1858 and then to the hot-spot (if `allout-beginning-of-line-cycles' is set).
1859
1860
1861 Topic Header Production:
1862 -----------------------
1863\\[allout-open-sibtopic] `allout-open-sibtopic' Create a new sibling after current topic.
1864\\[allout-open-subtopic] `allout-open-subtopic' ... an offspring of current topic.
1865\\[allout-open-supertopic] `allout-open-supertopic' ... a sibling of the current topic's parent.
1866
1867 Topic Level and Prefix Adjustment:
1868 ---------------------------------
1869\\[allout-shift-in] `allout-shift-in' Shift current topic and all offspring deeper
1870\\[allout-shift-out] `allout-shift-out' ... less deep
1871\\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for
1872 current topic
1873\\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and
60c7bbd2 1874 its' offspring -- distinctive bullets are not changed, others
c07583cd 1875 are alternated according to nesting depth.
ea18b2b1 1876\\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings --
c07583cd
KS
1877 the offspring are not affected.
1878 With repeat count, revoke numbering.
1879
1880 Topic-oriented Killing and Yanking:
1881 ----------------------------------
1882\\[allout-kill-topic] `allout-kill-topic' Kill current topic, including offspring.
1883\\[allout-copy-topic-as-kill] `allout-copy-topic-as-kill' Copy current topic, including offspring.
1884\\[allout-kill-line] `allout-kill-line' kill-line, attending to outline structure.
1885\\[allout-copy-line-as-kill] `allout-copy-line-as-kill' Copy line but don't delete it.
1886\\[allout-yank] `allout-yank' Yank, adjusting depth of yanked topic to
1887 depth of heading if yanking into bare topic
1888 heading (ie, prefix sans text).
1889\\[allout-yank-pop] `allout-yank-pop' Is to allout-yank as yank-pop is to yank
1890
1891 Topic-oriented Encryption:
1892 -------------------------
1893\\[allout-toggle-current-subtree-encryption] `allout-toggle-current-subtree-encryption'
1894 Encrypt/Decrypt topic content
1895
1896 Misc commands:
1897 -------------
1898M-x outlineify-sticky Activate outline mode for current buffer,
1899 and establish a default file-var setting
1900 for `allout-layout'.
1901\\[allout-mark-topic] `allout-mark-topic'
1902\\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer'
1903 Duplicate outline, sans concealed text, to
1904 buffer with name derived from derived from that
60c7bbd2 1905 of current buffer -- \"*BUFFERNAME exposed*\".
c07583cd
KS
1906\\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer'
1907 Like above 'copy-exposed', but convert topic
1908 prefixes to section.subsection... numeric
1909 format.
1910\\[eval-expression] (allout-init t) Setup Emacs session for outline mode
1911 auto-activation.
1977b8f6 1912
96b83743 1913 Topic Encryption
d82979ea 1914
96b83743 1915Outline mode supports gpg encryption of topics, with support for
29fac3fe
KM
1916symmetric and key-pair modes, and auto-encryption of topics
1917pending encryption on save.
d82979ea 1918
c07583cd 1919Topics pending encryption are, by default, automatically
29fac3fe
KM
1920encrypted during file saves, including checkpoint saves, to avoid
1921exposing the plain text of encrypted topics in the file system.
1922If the content of the topic containing the cursor was encrypted
1923for a save, it is automatically decrypted for continued editing.
c07583cd 1924
2576c28f
KM
1925NOTE: A few GnuPG v2 versions improperly preserve incorrect
1926symmetric decryption keys, preventing entry of the correct key on
1927subsequent decryption attempts until the cache times-out. That
1928can take several minutes. \(Decryption of other entries is not
1929affected.) Upgrade your EasyPG version, if you can, and you can
1930deliberately clear your gpg-agent's cache by sending it a '-HUP'
1931signal.
c07583cd
KS
1932
1933See `allout-toggle-current-subtree-encryption' function docstring
1934and `allout-encrypt-unencrypted-on-saves' customization variable
1935for details.
d82979ea 1936
c07583cd 1937 HOT-SPOT Operation
c567ac01 1938
19b84ba3
RS
1939Hot-spot operation provides a means for easy, single-keystroke outline
1940navigation and exposure control.
c567ac01 1941
19b84ba3
RS
1942When the text cursor is positioned directly on the bullet character of
1943a topic, regular characters (a to z) invoke the commands of the
fd5359c6 1944corresponding allout-mode keymap control chars. For example, \"f\"
96b83743 1945would invoke the command typically bound to \"C-c<space>C-f\"
fd5359c6 1946\(\\[allout-forward-current-level] `allout-forward-current-level').
19b84ba3 1947
96b83743
EZ
1948Thus, by positioning the cursor on a topic bullet, you can
1949execute the outline navigation and manipulation commands with a
c07583cd 1950single keystroke. Regular navigation keys (eg, \\[forward-char], \\[next-line]) don't get
96b83743 1951this special translation, so you can use them to get out of the
c07583cd
KS
1952hot-spot and back to normal editing operation.
1953
d41b91e6 1954In allout-mode, the normal beginning-of-line command (\\[allout-beginning-of-line]) is
c07583cd
KS
1955replaced with one that makes it easy to get to the hot-spot. If you
1956repeat it immediately it cycles (if `allout-beginning-of-line-cycles'
1957is set) to the beginning of the item and then, if you hit it again
1958immediately, to the hot-spot. Similarly, `allout-beginning-of-current-entry'
1959\(\\[allout-beginning-of-current-entry]) moves to the hot-spot when the cursor is already located
1960at the beginning of the current entry.
1961
1962 Extending Allout
c567ac01 1963
c07583cd
KS
1964Allout exposure and authoring activites all have associated
1965hooks, by which independent code can cooperate with allout
1966without changes to the allout core. Here are key ones:
1977b8f6 1967
c07583cd 1968`allout-mode-hook'
2576c28f
KM
1969`allout-mode-deactivate-hook' \(deprecated)
1970`allout-mode-off-hook'
c07583cd
KS
1971`allout-exposure-change-hook'
1972`allout-structure-added-hook'
1973`allout-structure-deleted-hook'
1974`allout-structure-shifted-hook'
1975
1976 Terminology
1977b8f6 1977
60c7bbd2 1978Topic hierarchy constituents -- TOPICS and SUBTOPICS:
c567ac01 1979
c07583cd
KS
1980ITEM: A unitary outline element, including the HEADER and ENTRY text.
1981TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH
1982 and with no intervening items of lower DEPTH than the container.
1983CURRENT ITEM:
1984 The visible ITEM most immediately containing the cursor.
1985DEPTH: The degree of nesting of an ITEM; it increases with containment.
1986 The DEPTH is determined by the HEADER PREFIX. The DEPTH is also
1987 called the:
1988LEVEL: The same as DEPTH.
c567ac01
RS
1989
1990ANCESTORS:
c07583cd
KS
1991 Those ITEMs whose TOPICs contain an ITEM.
1992PARENT: An ITEM's immediate ANCESTOR. It has a DEPTH one less than that
1993 of the ITEM.
c567ac01 1994OFFSPRING:
c07583cd 1995 The ITEMs contained within an ITEM's TOPIC.
19b84ba3 1996SUBTOPIC:
c07583cd
KS
1997 An OFFSPRING of its ANCESTOR TOPICs.
1998CHILD:
1999 An immediate SUBTOPIC of its PARENT.
c567ac01 2000SIBLINGS:
c07583cd 2001 TOPICs having the same PARENT and DEPTH.
353e2ef2 2002
c567ac01
RS
2003Topic text constituents:
2004
c07583cd
KS
2005HEADER: The first line of an ITEM, include the ITEM PREFIX and HEADER
2006 text.
2007ENTRY: The text content of an ITEM, before any OFFSPRING, but including
2008 the HEADER text and distinct from the ITEM PREFIX.
2009BODY: Same as ENTRY.
2010PREFIX: The leading text of an ITEM which distinguishes it from normal
2011 ENTRY text. Allout recognizes the outline structure according
2012 to the strict PREFIX format. It consists of a PREFIX-LEAD string,
2013 PREFIX-PADDING, and a BULLET. The BULLET might be followed by a
d82979ea 2014 number, indicating the ordinal number of the topic among its
c07583cd
KS
2015 siblings, or an asterisk indicating encryption, plus an optional
2016 space. After that is the ITEM HEADER text, which is not part of
2017 the PREFIX.
c567ac01 2018
c07583cd
KS
2019 The relative length of the PREFIX determines the nesting DEPTH
2020 of the ITEM.
c567ac01 2021PREFIX-LEAD:
c07583cd
KS
2022 The string at the beginning of a HEADER PREFIX, by default a `.'.
2023 It can be customized by changing the setting of
2024 `allout-header-prefix' and then reinitializing `allout-mode'.
2025
2026 When the PREFIX-LEAD is set to the comment-string of a
2027 programming language, outline structuring can be embedded in
2028 program code without interfering with processing of the text
2029 (by emacs or the language processor) as program code. This
2030 setting happens automatically when allout mode is used in
2031 programming-mode buffers. See `allout-use-mode-specific-leader'
2032 docstring for more detail.
c567ac01 2033PREFIX-PADDING:
c07583cd
KS
2034 Spaces or asterisks which separate the PREFIX-LEAD and the
2035 bullet, determining the ITEM's DEPTH.
2036BULLET: A character at the end of the ITEM PREFIX, it must be one of
2037 the characters listed on `allout-plain-bullets-string' or
38b2ca53
NR
2038 `allout-distinctive-bullets-string'. When creating a TOPIC,
2039 plain BULLETs are by default used, according to the DEPTH of the
2040 TOPIC. Choice among the distinctive BULLETs is offered when you
2041 provide a universal argugment \(\\[universal-argument]) to the
2042 TOPIC creation command, or when explictly rebulleting a TOPIC. The
2043 significance of the various distinctive bullets is purely by
2044 convention. See the documentation for the above bullet strings for
2045 more details.
c567ac01 2046EXPOSURE:
c07583cd
KS
2047 The state of a TOPIC which determines the on-screen visibility
2048 of its OFFSPRING and contained ENTRY text.
c567ac01 2049CONCEALED:
c07583cd
KS
2050 TOPICs and ENTRY text whose EXPOSURE is inhibited. Concealed
2051 text is represented by \"...\" ellipses.
c567ac01 2052
c07583cd
KS
2053 CONCEALED TOPICs are effectively collapsed within an ANCESTOR.
2054CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED.
2055OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
c567ac01 2056;;;_ . Code
1977b8f6
RS
2057 (interactive "P")
2058
2576c28f
KM
2059 (let ((write-file-hook-var-name (cond ((boundp 'write-file-functions)
2060 'write-file-functions)
2061 ((boundp 'write-file-hooks)
2062 'write-file-hooks)
2063 (t 'local-write-file-hooks)))
2064 (use-layout (if (listp allout-layout)
2065 allout-layout
2066 allout-default-layout)))
1977b8f6 2067
2576c28f
KM
2068 (if (and (allout-mode-p) (not force))
2069 (progn
2070 ;; Deactivation:
2071
2072 ; Activation not explicitly
2073 ; requested, and either in
2074 ; active state or *de*activation
2075 ; specifically requested:
2076 (allout-do-resumptions)
2077
2078 (remove-from-invisibility-spec '(allout . t))
2079 (remove-hook 'pre-command-hook 'allout-pre-command-business t)
2080 (remove-hook 'post-command-hook 'allout-post-command-business t)
2081 (remove-hook 'before-change-functions 'allout-before-change-handler t)
2082 (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
2083 (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler
2084 t)
2085 (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t)
2086
2087 (remove-overlays (point-min) (point-max)
2088 'category 'allout-exposure-category)
2089
2090 (setq allout-mode nil)
2091 (run-hooks 'allout-mode-deactivate-hook)
2092 (run-hooks 'allout-mode-off-hook))
2093
2094 ;; Activation:
fd5359c6 2095 (if allout-old-style-prefixes
01fc9422 2096 ;; Inhibit all the fancy formatting:
48bd8440 2097 (allout-add-resumptions '(allout-primary-bullet "*")))
19b84ba3 2098
01fc9422 2099 (allout-overlay-preparations) ; Doesn't hurt to redo this.
96b83743 2100
d8350998 2101 (allout-infer-header-lead-and-primary-bullet)
fd5359c6 2102 (allout-infer-body-reindent)
19b84ba3 2103
fd5359c6 2104 (set-allout-regexp)
2576c28f
KM
2105 (allout-add-resumptions '(allout-encryption-ciphertext-rejection-regexps
2106 allout-line-boundary-regexp
2107 extend)
2108 '(allout-encryption-ciphertext-rejection-regexps
2109 allout-bob-regexp
2110 extend))
19b84ba3 2111
01fc9422 2112 ;; Produce map from current version of allout-keybindings-list:
c07583cd 2113 (allout-setup-mode-map)
01fc9422 2114 (produce-allout-mode-menubar-entries)
01fc9422
EZ
2115
2116 ;; Include on minor-mode-map-alist, if not already there:
2117 (if (not (member '(allout-mode . allout-mode-map)
2118 minor-mode-map-alist))
2119 (setq minor-mode-map-alist
2120 (cons '(allout-mode . allout-mode-map)
2121 minor-mode-map-alist)))
353e2ef2 2122
96b83743 2123 (add-to-invisibility-spec '(allout . t))
38b2ca53 2124
01fc9422
EZ
2125 (allout-add-resumptions '(line-move-ignore-invisible t))
2126 (add-hook 'pre-command-hook 'allout-pre-command-business nil t)
2127 (add-hook 'post-command-hook 'allout-post-command-business nil t)
2576c28f 2128 (add-hook 'before-change-functions 'allout-before-change-handler nil t)
01fc9422
EZ
2129 (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
2130 (add-hook write-file-hook-var-name 'allout-write-file-hook-handler
2131 nil t)
2576c28f 2132 (add-hook 'auto-save-hook 'allout-auto-save-hook-handler nil t)
01fc9422
EZ
2133
2134 ;; Stash auto-fill settings and adjust so custom allout auto-fill
2135 ;; func will be used if auto-fill is active or activated. (The
2136 ;; custom func respects topic headline, maintains hanging-indents,
2137 ;; etc.)
01fc9422
EZ
2138 (allout-add-resumptions (list 'allout-former-auto-filler
2139 auto-fill-function)
2140 ;; Register allout-auto-fill to be used if
2141 ;; filling is active:
2142 (list 'allout-outside-normal-auto-fill-function
2143 normal-auto-fill-function)
2144 '(normal-auto-fill-function allout-auto-fill)
2145 ;; Paragraphs are broken by topic headlines.
2146 (list 'paragraph-start
2147 (concat paragraph-start "\\|^\\("
2148 allout-regexp "\\)"))
2149 (list 'paragraph-separate
2150 (concat paragraph-separate "\\|^\\("
2151 allout-regexp "\\)")))
2576c28f
KM
2152 (if (and auto-fill-function (not allout-inhibit-auto-fill))
2153 ;; allout-auto-fill will use the stashed values and so forth.
2154 (allout-add-resumptions '(auto-fill-function allout-auto-fill)))
2155
fd5359c6 2156 (or (assq 'allout-mode minor-mode-alist)
c567ac01 2157 (setq minor-mode-alist
aad94676 2158 (cons '(allout-mode " Allout") minor-mode-alist)))
19b84ba3 2159
fd5359c6 2160 (allout-setup-menubar)
48bd8440 2161 (setq allout-mode t)
2576c28f
KM
2162 (run-hooks 'allout-mode-hook)
2163
2164 ;; Do auto layout if warranted:
2165 (when (and allout-layout
2166 allout-auto-activation
2167 use-layout
2168 (and (not (eq allout-auto-activation 'activate))
2169 (if (eq allout-auto-activation 'ask)
2170 (if (y-or-n-p (format "Expose %s with layout '%s'? "
2171 (buffer-name)
2172 use-layout))
2173 t
2174 (message "Skipped %s layout." (buffer-name))
2175 nil)
2176 t)))
2177 (save-excursion
2178 (message "Adjusting '%s' exposure..." (buffer-name))
2179 (goto-char 0)
2180 (allout-this-or-next-heading)
2181 (condition-case err
2182 (progn
2183 (apply 'allout-expose-topic (list use-layout))
2184 (message "Adjusting '%s' exposure... done."
2185 (buffer-name)))
2186 ;; Problem applying exposure -- notify user, but don't
2187 ;; interrupt, eg, file visit:
2188 (error (message "%s" (car (cdr err)))
2189 (sit-for 1))))
2190 ) ; when allout-layout
2191 ) ; if (allout-mode-p)
2192 ) ; let (())
2193 ) ; define-minor-mode
2194;;;_ > allout-minor-mode alias
2195(defalias 'allout-minor-mode 'allout-mode)
2196;;;_ > allout-setup-mode-map ())
c07583cd
KS
2197(defun allout-setup-mode-map ()
2198 "Establish allout-mode bindings."
2199 (setq-default allout-mode-map
1c9b9df0
KM
2200 (produce-allout-mode-map
2201 (allout-mode-map-adjustments allout-keybindings-list)))
c07583cd 2202 (setq allout-mode-map
1c9b9df0
KM
2203 (produce-allout-mode-map
2204 (allout-mode-map-adjustments allout-keybindings-list)))
c07583cd
KS
2205 (substitute-key-definition 'beginning-of-line
2206 'allout-beginning-of-line
2207 allout-mode-map global-map)
2208 (substitute-key-definition 'move-beginning-of-line
2209 'allout-beginning-of-line
2210 allout-mode-map global-map)
2211 (substitute-key-definition 'end-of-line
2212 'allout-end-of-line
2213 allout-mode-map global-map)
2214 (substitute-key-definition 'move-end-of-line
2215 'allout-end-of-line
2216 allout-mode-map global-map)
2217 (fset 'allout-mode-map allout-mode-map))
2218
2219;; ensure that allout-mode-map has some setting even if allout-mode hasn't
2220;; been invoked:
2221(allout-setup-mode-map)
2222
46771bb3
EZ
2223;;;_ > allout-minor-mode
2224(defalias 'allout-minor-mode 'allout-mode)
773e7e48 2225
41ff6d0a
JB
2226;;;_ > allout-unload-function
2227(defun allout-unload-function ()
2228 "Unload the allout outline library."
2229 (save-current-buffer
2230 (dolist (buffer (buffer-list))
2231 (set-buffer buffer)
2576c28f 2232 (when (allout-mode-p) (allout-mode))))
41ff6d0a
JB
2233 ;; continue standard unloading
2234 nil)
2235
773e7e48
EZ
2236;;;_ - Position Assessment
2237;;;_ > allout-hidden-p (&optional pos)
2238(defsubst allout-hidden-p (&optional pos)
1c9b9df0 2239 "Non-nil if the character after point was made invisible by allout."
da506f05 2240 (eq (get-char-property (or pos (point)) 'invisible) 'allout))
773e7e48 2241
96b83743
EZ
2242;;;_ > allout-overlay-insert-in-front-handler (ol after beg end
2243;;; &optional prelen)
2244(defun allout-overlay-insert-in-front-handler (ol after beg end
2245 &optional prelen)
2a1408fd 2246 "Shift the overlay so stuff inserted in front of it is excluded."
96b83743 2247 (if after
1c9b9df0
KM
2248 ;; ??? Shouldn't moving the overlay should be unnecessary, if overlay
2249 ;; front-advance on the overlay worked as expected?
96b83743
EZ
2250 (move-overlay ol (1+ beg) (overlay-end ol))))
2251;;;_ > allout-overlay-interior-modification-handler (ol after beg end
2252;;; &optional prelen)
2253(defun allout-overlay-interior-modification-handler (ol after beg end
2254 &optional prelen)
2255 "Get confirmation before making arbitrary changes to invisible text.
2256
2257We expose the invisible text and ask for confirmation. Refusal or
75bcb912 2258`keyboard-quit' abandons the changes, with keyboard-quit additionally
96b83743
EZ
2259reclosing the opened text.
2260
60c7bbd2 2261No confirmation is necessary when `inhibit-read-only' is set -- eg, allout
96b83743
EZ
2262internal functions use this feature cohesively bunch changes."
2263
2264 (when (and (not inhibit-read-only) (not after))
2265 (let ((start (point))
2266 (ol-start (overlay-start ol))
2267 (ol-end (overlay-end ol))
96b83743
EZ
2268 first)
2269 (goto-char beg)
2270 (while (< (point) end)
2271 (when (allout-hidden-p)
2272 (allout-show-to-offshoot)
2273 (if (allout-hidden-p)
2274 (save-excursion (forward-char 1)
2275 (allout-show-to-offshoot)))
2276 (when (not first)
96b83743
EZ
2277 (setq first (point))))
2278 (goto-char (if (featurep 'xemacs)
2279 (next-property-change (1+ (point)) nil end)
2280 (next-char-property-change (1+ (point)) end))))
2281 (when first
2282 (goto-char first)
2283 (condition-case nil
2284 (if (not
2285 (yes-or-no-p
2286 (substitute-command-keys
4034b0e2 2287 (concat "Modify concealed text? (\"no\" just aborts,"
96b83743
EZ
2288 " \\[keyboard-quit] also reconceals) "))))
2289 (progn (goto-char start)
5a0c3f56 2290 (error "Concealed-text change refused")))
96b83743
EZ
2291 (quit (allout-flag-region ol-start ol-end nil)
2292 (allout-flag-region ol-start ol-end t)
5a0c3f56 2293 (error "Concealed-text change abandoned, text reconcealed"))))
96b83743
EZ
2294 (goto-char start))))
2295;;;_ > allout-before-change-handler (beg end)
2296(defun allout-before-change-handler (beg end)
2297 "Protect against changes to invisible text.
2298
60c7bbd2 2299See `allout-overlay-interior-modification-handler' for details."
d8350998
CY
2300
2301 (if (and (allout-mode-p) undo-in-progress (allout-hidden-p))
2302 (allout-show-to-offshoot))
2303
01fc9422
EZ
2304 ;; allout-overlay-interior-modification-handler on an overlay handles
2305 ;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
2306 (when (and (featurep 'xemacs) (allout-mode-p))
2307 ;; process all of the pending overlays:
d8350998 2308 (save-excursion
f520c6f2 2309 (goto-char beg)
d8350998 2310 (let ((overlay (allout-get-invisibility-overlay)))
1c9b9df0
KM
2311 (if overlay
2312 (allout-overlay-interior-modification-handler
2313 overlay nil beg end nil))))))
96b83743
EZ
2314;;;_ > allout-isearch-end-handler (&optional overlay)
2315(defun allout-isearch-end-handler (&optional overlay)
2316 "Reconcile allout outline exposure on arriving in hidden text after isearch.
2317
2318Optional OVERLAY parameter is for when this function is used by
2319`isearch-open-invisible' overlay property. It is otherwise unused, so this
2320function can also be used as an `isearch-mode-end-hook'."
2321
2322 (if (and (allout-mode-p) (allout-hidden-p))
2323 (allout-show-to-offshoot)))
2324
60c7bbd2 2325;;;_ #3 Internal Position State-Tracking -- "allout-recent-*" funcs
a5a1e2ef
SM
2326;; All the basic outline functions that directly do string matches to
2327;; evaluate heading prefix location set the variables
2328;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end'
2329;; when successful. Functions starting with `allout-recent-' all
2330;; use this state, providing the means to avoid redundant searches
2331;; for just-established data. This optimization can provide
2332;; significant speed improvement, but it must be employed carefully.
fd5359c6
MR
2333;;;_ = allout-recent-prefix-beginning
2334(defvar allout-recent-prefix-beginning 0
c567ac01 2335 "Buffer point of the start of the last topic prefix encountered.")
fd5359c6
MR
2336(make-variable-buffer-local 'allout-recent-prefix-beginning)
2337;;;_ = allout-recent-prefix-end
2338(defvar allout-recent-prefix-end 0
c567ac01 2339 "Buffer point of the end of the last topic prefix encountered.")
fd5359c6 2340(make-variable-buffer-local 'allout-recent-prefix-end)
d8350998
CY
2341;;;_ = allout-recent-depth
2342(defvar allout-recent-depth 0
2343 "Depth of the last topic prefix encountered.")
2344(make-variable-buffer-local 'allout-recent-depth)
fd5359c6
MR
2345;;;_ = allout-recent-end-of-subtree
2346(defvar allout-recent-end-of-subtree 0
2265e017 2347 "Buffer point last returned by `allout-end-of-current-subtree'.")
fd5359c6 2348(make-variable-buffer-local 'allout-recent-end-of-subtree)
d8350998
CY
2349;;;_ > allout-prefix-data ()
2350(defsubst allout-prefix-data ()
2351 "Register allout-prefix state data.
fd5359c6 2352
75bcb912
JB
2353For reference by `allout-recent' funcs. Return
2354the new value of `allout-recent-prefix-beginning'."
42c3e51c 2355 (setq allout-recent-prefix-end (or (match-end 1) (match-end 2) (match-end 3))
d8350998 2356 allout-recent-prefix-beginning (or (match-beginning 1)
42c3e51c
KM
2357 (match-beginning 2)
2358 (match-beginning 3))
d8350998
CY
2359 allout-recent-depth (max 1 (- allout-recent-prefix-end
2360 allout-recent-prefix-beginning
2361 allout-header-subtraction)))
2362 allout-recent-prefix-beginning)
2363;;;_ > nullify-allout-prefix-data ()
2364(defsubst nullify-allout-prefix-data ()
2365 "Mark allout prefix data as being uninformative."
2366 (setq allout-recent-prefix-end (point)
2367 allout-recent-prefix-beginning (point)
2368 allout-recent-depth 0)
2369 allout-recent-prefix-beginning)
fd5359c6 2370;;;_ > allout-recent-depth ()
d8350998 2371(defsubst allout-recent-depth ()
19b84ba3 2372 "Return depth of last heading encountered by an outline maneuvering function.
c567ac01
RS
2373
2374All outline functions which directly do string matches to assess
2265e017
MR
2375headings set the variables `allout-recent-prefix-beginning' and
2376`allout-recent-prefix-end' if successful. This function uses those settings
c567ac01
RS
2377to return the current depth."
2378
d8350998 2379 allout-recent-depth)
fd5359c6 2380;;;_ > allout-recent-prefix ()
d8350998 2381(defsubst allout-recent-prefix ()
2265e017 2382 "Like `allout-recent-depth', but returns text of last encountered prefix.
c567ac01
RS
2383
2384All outline functions which directly do string matches to assess
2265e017
MR
2385headings set the variables `allout-recent-prefix-beginning' and
2386`allout-recent-prefix-end' if successful. This function uses those settings
d8350998
CY
2387to return the current prefix."
2388 (buffer-substring-no-properties allout-recent-prefix-beginning
2389 allout-recent-prefix-end))
fd5359c6
MR
2390;;;_ > allout-recent-bullet ()
2391(defmacro allout-recent-bullet ()
2392 "Like allout-recent-prefix, but returns bullet of last encountered prefix.
c567ac01
RS
2393
2394All outline functions which directly do string matches to assess
2265e017
MR
2395headings set the variables `allout-recent-prefix-beginning' and
2396`allout-recent-prefix-end' if successful. This function uses those settings
c567ac01 2397to return the current depth of the most recently matched topic."
d8350998
CY
2398 '(buffer-substring-no-properties (1- allout-recent-prefix-end)
2399 allout-recent-prefix-end))
c567ac01 2400
19b84ba3 2401;;;_ #4 Navigation
c567ac01 2402
46771bb3 2403;;;_ - Position Assessment
c567ac01 2404;;;_ : Location Predicates
ede4ac6a
KS
2405;;;_ > allout-do-doublecheck ()
2406(defsubst allout-do-doublecheck ()
2407 "True if current item conditions qualify for checking on topic aberrance."
2408 (and
60c7bbd2 2409 ;; presume integrity of outline and yanked content during yank -- necessary
ede4ac6a 2410 ;; to allow for level disparity of yank location and yanked text:
498a6493 2411 (not allout-inhibit-aberrance-doublecheck)
ede4ac6a
KS
2412 ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck:
2413 (<= allout-recent-depth allout-doublecheck-at-and-shallower)))
2414;;;_ > allout-aberrant-container-p ()
d8350998
CY
2415(defun allout-aberrant-container-p ()
2416 "True if topic, or next sibling with children, contains them discontinuously.
2417
2418Discontinuous means an immediate offspring that is nested more
2419than one level deeper than the topic.
2420
2421If topic has no offspring, then the next sibling with offspring will
2422determine whether or not this one is determined to be aberrant.
2423
2424If true, then the allout-recent-* settings are calibrated on the
2425offspring that qaulifies it as aberrant, ie with depth that
2426exceeds the topic by more than one."
2427
2428 ;; This is most clearly understood when considering standard-prefix-leader
2429 ;; low-level topics, which can all too easily match text not intended as
2430 ;; headers. For example, any line with a leading '.' or '*' and lacking a
2431 ;; following bullet qualifies without this protection. (A sequence of
2432 ;; them can occur naturally, eg a typical textual bullet list.) We
2433 ;; disqualify such low-level sequences when they are followed by a
2434 ;; discontinuously contained child, inferring that the sequences are not
2435 ;; actually connected with their prospective context.
2436
2437 (let ((depth (allout-depth))
2438 (start-point (point))
2439 done aberrant)
2a1408fd
DN
2440 (save-match-data
2441 (save-excursion
2442 (while (and (not done)
2443 (re-search-forward allout-line-boundary-regexp nil 0))
2444 (allout-prefix-data)
2445 (goto-char allout-recent-prefix-beginning)
2446 (cond
8dd59f01 2447 ;; sibling -- continue:
2a1408fd 2448 ((eq allout-recent-depth depth))
8dd59f01 2449 ;; first offspring is excessive -- aberrant:
2a1408fd
DN
2450 ((> allout-recent-depth (1+ depth))
2451 (setq done t aberrant t))
8dd59f01 2452 ;; next non-sibling is lower-depth -- not aberrant:
2a1408fd 2453 (t (setq done t))))))
d8350998
CY
2454 (if aberrant
2455 aberrant
2456 (goto-char start-point)
2457 ;; recalibrate allout-recent-*
2458 (allout-depth)
2459 nil)))
ede4ac6a
KS
2460;;;_ > allout-on-current-heading-p ()
2461(defun allout-on-current-heading-p ()
2462 "Return non-nil if point is on current visible topics' header line.
2463
2464Actually, returns prefix beginning point."
2465 (save-excursion
2466 (allout-beginning-of-current-line)
2a1408fd
DN
2467 (save-match-data
2468 (and (looking-at allout-regexp)
2469 (allout-prefix-data)
2470 (or (not (allout-do-doublecheck))
2471 (not (allout-aberrant-container-p)))))))
ede4ac6a
KS
2472;;;_ > allout-on-heading-p ()
2473(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
2474;;;_ > allout-e-o-prefix-p ()
2475(defun allout-e-o-prefix-p ()
2476 "True if point is located where current topic prefix ends, heading begins."
2a1408fd
DN
2477 (and (save-match-data
2478 (save-excursion (let ((inhibit-field-text-motion t))
2479 (beginning-of-line))
2480 (looking-at allout-regexp))
2481 (= (point) (save-excursion (allout-end-of-prefix)(point))))))
c567ac01 2482;;;_ : Location attributes
fd5359c6 2483;;;_ > allout-depth ()
96b83743
EZ
2484(defun allout-depth ()
2485 "Return depth of topic most immediately containing point.
2486
42c3e51c
KM
2487Does not do doublecheck for aberrant topic header.
2488
96b83743
EZ
2489Return zero if point is not within any topic.
2490
2491Like `allout-current-depth', but respects hidden as well as visible topics."
9179616f 2492 (save-excursion
96b83743
EZ
2493 (let ((start-point (point)))
2494 (if (and (allout-goto-prefix)
2495 (not (< start-point (point))))
d8350998 2496 allout-recent-depth
96b83743 2497 (progn
d8350998
CY
2498 ;; Oops, no prefix, nullify it:
2499 (nullify-allout-prefix-data)
96b83743
EZ
2500 ;; ... and return 0:
2501 0)))))
fd5359c6 2502;;;_ > allout-current-depth ()
96b83743
EZ
2503(defun allout-current-depth ()
2504 "Return depth of visible topic most immediately containing point.
2505
2506Return zero if point is not within any topic."
2507 (save-excursion
2508 (if (allout-back-to-current-heading)
2509 (max 1
2510 (- allout-recent-prefix-end
2511 allout-recent-prefix-beginning
2512 allout-header-subtraction))
2513 0)))
fd5359c6
MR
2514;;;_ > allout-get-current-prefix ()
2515(defun allout-get-current-prefix ()
c567ac01 2516 "Topic prefix of the current topic."
1977b8f6 2517 (save-excursion
fd5359c6
MR
2518 (if (allout-goto-prefix)
2519 (allout-recent-prefix))))
2520;;;_ > allout-get-bullet ()
2521(defun allout-get-bullet ()
c567ac01 2522 "Return bullet of containing topic (visible or not)."
1977b8f6 2523 (save-excursion
fd5359c6
MR
2524 (and (allout-goto-prefix)
2525 (allout-recent-bullet))))
2526;;;_ > allout-current-bullet ()
2527(defun allout-current-bullet ()
c567ac01 2528 "Return bullet of current (visible) topic heading, or none if none found."
96b83743 2529 (condition-case nil
1977b8f6 2530 (save-excursion
fd5359c6 2531 (allout-back-to-current-heading)
d8350998
CY
2532 (buffer-substring-no-properties (- allout-recent-prefix-end 1)
2533 allout-recent-prefix-end))
1977b8f6 2534 ;; Quick and dirty provision, ostensibly for missing bullet:
d8350998 2535 (args-out-of-range nil))
1977b8f6 2536 )
fd5359c6
MR
2537;;;_ > allout-get-prefix-bullet (prefix)
2538(defun allout-get-prefix-bullet (prefix)
c567ac01 2539 "Return the bullet of the header prefix string PREFIX."
1977b8f6
RS
2540 ;; Doesn't make sense if we're old-style prefixes, but this just
2541 ;; oughtn't be called then, so forget about it...
fd5359c6 2542 (if (string-match allout-regexp prefix)
d8350998 2543 (substring prefix (1- (match-end 2)) (match-end 2))))
fd5359c6
MR
2544;;;_ > allout-sibling-index (&optional depth)
2545(defun allout-sibling-index (&optional depth)
9179616f
DL
2546 "Item number of this prospective topic among its siblings.
2547
e126900f 2548If optional arg DEPTH is greater than current depth, then we're
9179616f
DL
2549opening a new level, and return 0.
2550
2551If less than this depth, ascend to that depth and count..."
2552
2553 (save-excursion
2554 (cond ((and depth (<= depth 0) 0))
65e7eb3d 2555 ((or (null depth) (= depth (allout-depth)))
9179616f 2556 (let ((index 1))
d8350998 2557 (while (allout-previous-sibling allout-recent-depth nil)
9179616f
DL
2558 (setq index (1+ index)))
2559 index))
d8350998 2560 ((< depth allout-recent-depth)
fd5359c6
MR
2561 (allout-ascend-to-depth depth)
2562 (allout-sibling-index))
9179616f 2563 (0))))
fd5359c6
MR
2564;;;_ > allout-topic-flat-index ()
2565(defun allout-topic-flat-index ()
9179616f
DL
2566 "Return a list indicating point's numeric section.subsect.subsubsect...
2567Outermost is first."
fd5359c6
MR
2568 (let* ((depth (allout-depth))
2569 (next-index (allout-sibling-index depth))
9179616f
DL
2570 (rev-sibls nil))
2571 (while (> next-index 0)
2572 (setq rev-sibls (cons next-index rev-sibls))
2573 (setq depth (1- depth))
fd5359c6 2574 (setq next-index (allout-sibling-index depth)))
9179616f
DL
2575 rev-sibls)
2576 )
1977b8f6 2577
96b83743
EZ
2578;;;_ - Navigation routines
2579;;;_ > allout-beginning-of-current-line ()
2580(defun allout-beginning-of-current-line ()
2581 "Like beginning of line, but to visible text."
2582
5204800f
NR
2583 ;; This combination of move-beginning-of-line and beginning-of-line is
2584 ;; deliberate, but the (beginning-of-line) may now be superfluous.
0458fa80
EZ
2585 (let ((inhibit-field-text-motion t))
2586 (move-beginning-of-line 1)
96b83743 2587 (beginning-of-line)
0458fa80
EZ
2588 (while (and (not (bobp)) (or (not (bolp)) (allout-hidden-p)))
2589 (beginning-of-line)
2590 (if (or (allout-hidden-p) (not (bolp)))
2591 (forward-char -1)))))
96b83743
EZ
2592;;;_ > allout-end-of-current-line ()
2593(defun allout-end-of-current-line ()
2594 "Move to the end of line, past concealed text if any."
1c9b9df0 2595 ;; This is for symmetry with `allout-beginning-of-current-line' --
96b83743
EZ
2596 ;; `move-end-of-line' doesn't suffer the same problem as
2597 ;; `move-beginning-of-line'.
0458fa80 2598 (let ((inhibit-field-text-motion t))
96b83743 2599 (end-of-line)
0458fa80
EZ
2600 (while (allout-hidden-p)
2601 (end-of-line)
2602 (if (allout-hidden-p) (forward-char 1)))))
48bd8440
EZ
2603;;;_ > allout-beginning-of-line ()
2604(defun allout-beginning-of-line ()
2605 "Beginning-of-line with `allout-beginning-of-line-cycles' behavior, if set."
2606
2607 (interactive)
2608
2609 (if (or (not allout-beginning-of-line-cycles)
2610 (not (equal last-command this-command)))
2a1408fd
DN
2611 (progn
2612 (if (and (not (bolp))
2613 (allout-hidden-p (1- (point))))
1c9b9df0 2614 (goto-char (allout-previous-single-char-property-change
2a1408fd
DN
2615 (1- (point)) 'invisible)))
2616 (move-beginning-of-line 1))
d8350998
CY
2617 (allout-depth)
2618 (let ((beginning-of-body
2619 (save-excursion
ede4ac6a 2620 (while (and (allout-do-doublecheck)
d8350998
CY
2621 (allout-aberrant-container-p)
2622 (allout-previous-visible-heading 1)))
2623 (allout-beginning-of-current-entry)
2624 (point))))
48bd8440 2625 (cond ((= (current-column) 0)
d8350998 2626 (goto-char beginning-of-body))
48bd8440
EZ
2627 ((< (point) beginning-of-body)
2628 (allout-beginning-of-current-line))
2629 ((= (point) beginning-of-body)
2630 (goto-char (allout-current-bullet-pos)))
2631 (t (allout-beginning-of-current-line)
2632 (if (< (point) beginning-of-body)
2633 ;; we were on the headline after its start:
d8350998 2634 (goto-char beginning-of-body)))))))
48bd8440
EZ
2635;;;_ > allout-end-of-line ()
2636(defun allout-end-of-line ()
2637 "End-of-line with `allout-end-of-line-cycles' behavior, if set."
2638
2639 (interactive)
2640
2641 (if (or (not allout-end-of-line-cycles)
2642 (not (equal last-command this-command)))
2643 (allout-end-of-current-line)
2644 (let ((end-of-entry (save-excursion
2645 (allout-end-of-entry)
2646 (point))))
2647 (cond ((not (eolp))
2648 (allout-end-of-current-line))
2649 ((or (allout-hidden-p) (save-excursion
2650 (forward-char -1)
2651 (allout-hidden-p)))
2652 (allout-back-to-current-heading)
2653 (allout-show-current-entry)
d8350998 2654 (allout-show-children)
48bd8440
EZ
2655 (allout-end-of-entry))
2656 ((>= (point) end-of-entry)
2657 (allout-back-to-current-heading)
2658 (allout-end-of-current-line))
2a1408fd 2659 (t
1c9b9df0 2660 (if (not (allout-mark-active-p))
2a1408fd
DN
2661 (push-mark))
2662 (allout-end-of-entry))))))
1c9b9df0
KM
2663;;;_ > allout-mark-active-p ()
2664(defun allout-mark-active-p ()
2665 "True if the mark is currently or always active."
2666 ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler
2667 ;; provisions, at least in fsf emacs to prevent warnings about lack of,
2668 ;; eg, region-active-p.
2669 (cond ((boundp 'mark-active)
2670 mark-active)
2671 ((fboundp 'region-active-p)
2672 (region-active-p))
2673 (t)))
fd5359c6
MR
2674;;;_ > allout-next-heading ()
2675(defsubst allout-next-heading ()
c07583cd 2676 "Move to the heading for the topic (possibly invisible) after this one.
c567ac01 2677
d8350998 2678Returns the location of the heading, or nil if none found.
c567ac01 2679
75bcb912 2680We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
2a1408fd
DN
2681 (save-match-data
2682
2683 (if (looking-at allout-regexp)
2684 (forward-char 1))
2685
2686 (when (re-search-forward allout-line-boundary-regexp nil 0)
2687 (allout-prefix-data)
42c3e51c
KM
2688 (goto-char allout-recent-prefix-beginning)
2689 (while (not (bolp))
2690 (forward-char -1))
2a1408fd
DN
2691 (and (allout-do-doublecheck)
2692 ;; this will set allout-recent-* on the first non-aberrant topic,
2693 ;; whether it's the current one or one that disqualifies it:
2694 (allout-aberrant-container-p))
42c3e51c 2695 ;; this may or may not be the same as above depending on doublecheck:
2a1408fd 2696 (goto-char allout-recent-prefix-beginning))))
96b83743 2697;;;_ > allout-this-or-next-heading
fd5359c6 2698(defun allout-this-or-next-heading ()
8d118843 2699 "Position cursor on current or next heading."
fd5359c6
MR
2700 ;; A throwaway non-macro that is defined after allout-next-heading
2701 ;; and usable by allout-mode.
d8350998 2702 (if (not (allout-goto-prefix-doublechecked)) (allout-next-heading)))
fd5359c6 2703;;;_ > allout-previous-heading ()
8a559d4e 2704(defun allout-previous-heading ()
c07583cd 2705 "Move to the prior (possibly invisible) heading line.
c567ac01 2706
d8350998
CY
2707Return the location of the beginning of the heading, or nil if not found.
2708
75bcb912 2709We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
d8350998
CY
2710
2711 (if (bobp)
2712 nil
d8350998 2713 (let ((start-point (point)))
ede4ac6a 2714 ;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
d8350998 2715 (allout-goto-prefix)
2a1408fd
DN
2716 (save-match-data
2717 (when (or (re-search-backward allout-line-boundary-regexp nil 0)
2718 (looking-at allout-bob-regexp))
2719 (goto-char (allout-prefix-data))
2720 (if (and (allout-do-doublecheck)
2721 (allout-aberrant-container-p))
2722 (or (allout-previous-heading)
2723 (and (goto-char start-point)
2724 ;; recalibrate allout-recent-*:
2725 (allout-depth)
2726 nil))
2727 (point)))))))
96b83743
EZ
2728;;;_ > allout-get-invisibility-overlay ()
2729(defun allout-get-invisibility-overlay ()
2730 "Return the overlay at point that dictates allout invisibility."
2731 (let ((overlays (overlays-at (point)))
2732 got)
2733 (while (and overlays (not got))
2734 (if (equal (overlay-get (car overlays) 'invisible) 'allout)
d8350998
CY
2735 (setq got (car overlays))
2736 (pop overlays)))
96b83743
EZ
2737 got))
2738;;;_ > allout-back-to-visible-text ()
2739(defun allout-back-to-visible-text ()
2740 "Move to most recent prior character that is visible, and return point."
2741 (if (allout-hidden-p)
2742 (goto-char (overlay-start (allout-get-invisibility-overlay))))
2743 (point))
c567ac01
RS
2744
2745;;;_ - Subtree Charting
2746;;;_ " These routines either produce or assess charts, which are
2747;;; nested lists of the locations of topics within a subtree.
2748;;;
d8350998
CY
2749;;; Charts enable efficient subtree navigation by providing a reusable basis
2750;;; for elaborate, compound assessment and adjustment of a subtree.
c567ac01 2751
48bd8440
EZ
2752;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
2753(defun allout-chart-subtree (&optional levels visible orig-depth prev-depth)
19b84ba3
RS
2754 "Produce a location \"chart\" of subtopics of the containing topic.
2755
c07583cd 2756Optional argument LEVELS specifies a depth limit (relative to start
65e7eb3d 2757depth) for the chart. Null LEVELS means no limit.
48bd8440
EZ
2758
2759When optional argument VISIBLE is non-nil, the chart includes
2760only the visible subelements of the charted subjects.
2761
65e7eb3d 2762The remaining optional args are for internal use by the function.
d82979ea
EZ
2763
2764Point is left at the end of the subtree.
19b84ba3 2765
d82979ea 2766Charts are used to capture outline structure, so that outline-altering
19b84ba3
RS
2767routines need assess the structure only once, and then use the chart
2768for their elaborate manipulations.
2769
d8350998
CY
2770The chart entries for the topics are in reverse order, so the
2771last topic is listed first. The entry for each topic consists of
2772an integer indicating the point at the beginning of the topic
2773prefix. Charts for offspring consists of a list containing,
2774recursively, the charts for the respective subtopics. The chart
2775for a topics' offspring precedes the entry for the topic itself.
19b84ba3 2776
d82979ea
EZ
2777The other function parameters are for internal recursion, and should
2778not be specified by external callers. ORIG-DEPTH is depth of topic at
2779starting point, and PREV-DEPTH is depth of prior topic."
19b84ba3 2780
353e2ef2 2781 (let ((original (not orig-depth)) ; `orig-depth' set only in recursion.
19b84ba3
RS
2782 chart curr-depth)
2783
2784 (if original ; Just starting?
2785 ; Register initial settings and
2786 ; position to first offspring:
fd5359c6 2787 (progn (setq orig-depth (allout-depth))
19b84ba3 2788 (or prev-depth (setq prev-depth (1+ orig-depth)))
48bd8440
EZ
2789 (if visible
2790 (allout-next-visible-heading 1)
2791 (allout-next-heading))))
c567ac01 2792
19b84ba3
RS
2793 ;; Loop over the current levels' siblings. Besides being more
2794 ;; efficient than tail-recursing over a level, it avoids exceeding
e126900f 2795 ;; the typically quite constrained Emacs max-lisp-eval-depth.
9179616f 2796 ;;
19b84ba3
RS
2797 ;; Probably would speed things up to implement loop-based stack
2798 ;; operation rather than recursing for lower levels. Bah.
9179616f 2799
c567ac01 2800 (while (and (not (eobp))
19b84ba3 2801 ; Still within original topic?
d8350998 2802 (< orig-depth (setq curr-depth allout-recent-depth))
19b84ba3
RS
2803 (cond ((= prev-depth curr-depth)
2804 ;; Register this one and move on:
d8350998 2805 (setq chart (cons allout-recent-prefix-beginning chart))
19b84ba3 2806 (if (and levels (<= levels 1))
60c7bbd2 2807 ;; At depth limit -- skip sublevels:
fd5359c6 2808 (or (allout-next-sibling curr-depth)
60c7bbd2 2809 ;; or no more siblings -- proceed to
19b84ba3 2810 ;; next heading at lesser depth:
e6a9aec7 2811 (while (and (<= curr-depth
d8350998 2812 allout-recent-depth)
48bd8440
EZ
2813 (if visible
2814 (allout-next-visible-heading 1)
2815 (allout-next-heading)))))
2816 (if visible
2817 (allout-next-visible-heading 1)
2818 (allout-next-heading))))
19b84ba3
RS
2819
2820 ((and (< prev-depth curr-depth)
2821 (or (not levels)
2822 (> levels 0)))
2823 ;; Recurse on deeper level of curr topic:
2824 (setq chart
fd5359c6 2825 (cons (allout-chart-subtree (and levels
19b84ba3 2826 (1- levels))
48bd8440
EZ
2827 visible
2828 orig-depth
2829 curr-depth)
19b84ba3
RS
2830 chart))
2831 ;; ... then continue with this one.
2832 )
2833
2834 ;; ... else nil if we've ascended back to prev-depth.
2835
2836 )))
2837
2838 (if original ; We're at the last sibling on
2839 ; the original level. Position
2840 ; to the end of it:
c567ac01 2841 (progn (and (not (eobp)) (forward-char -1))
96b83743
EZ
2842 (and (= (preceding-char) ?\n)
2843 (= (aref (buffer-substring (max 1 (- (point) 3))
2844 (point))
2845 1)
2846 ?\n)
19b84ba3 2847 (forward-char -1))
fd5359c6 2848 (setq allout-recent-end-of-subtree (point))))
353e2ef2 2849
c567ac01
RS
2850 chart ; (nreverse chart) not necessary,
2851 ; and maybe not preferable.
2852 ))
fd5359c6
MR
2853;;;_ > allout-chart-siblings (&optional start end)
2854(defun allout-chart-siblings (&optional start end)
c567ac01 2855 "Produce a list of locations of this and succeeding sibling topics.
fd5359c6 2856Effectively a top-level chart of siblings. See `allout-chart-subtree'
c567ac01
RS
2857for an explanation of charts."
2858 (save-excursion
d8350998
CY
2859 (when (allout-goto-prefix-doublechecked)
2860 (let ((chart (list (point))))
2861 (while (allout-next-sibling)
2862 (setq chart (cons (point) chart)))
2863 (if chart (setq chart (nreverse chart)))))))
fd5359c6
MR
2864;;;_ > allout-chart-to-reveal (chart depth)
2865(defun allout-chart-to-reveal (chart depth)
c567ac01 2866
19b84ba3 2867 "Return a flat list of hidden points in subtree CHART, up to DEPTH.
c567ac01 2868
65e7eb3d
EZ
2869If DEPTH is nil, include hidden points at any depth.
2870
19b84ba3 2871Note that point can be left at any of the points on chart, or at the
c567ac01
RS
2872start point."
2873
2874 (let (result here)
65e7eb3d 2875 (while (and (or (null depth) (> depth 0))
c567ac01
RS
2876 chart)
2877 (setq here (car chart))
2878 (if (listp here)
65e7eb3d
EZ
2879 (let ((further (allout-chart-to-reveal here (if (null depth)
2880 depth
2881 (1- depth)))))
60c7bbd2 2882 ;; We're on the start of a subtree -- recurse with it, if there's
c567ac01
RS
2883 ;; more depth to go:
2884 (if further (setq result (append further result)))
2885 (setq chart (cdr chart)))
2886 (goto-char here)
96b83743 2887 (if (allout-hidden-p)
c567ac01
RS
2888 (setq result (cons here result)))
2889 (setq chart (cdr chart))))
2890 result))
fd5359c6 2891;;;_ X allout-chart-spec (chart spec &optional exposing)
e126900f 2892;; (defun allout-chart-spec (chart spec &optional exposing)
c07583cd 2893;; "Not yet (if ever) implemented.
e126900f
JB
2894
2895;; Produce exposure directives given topic/subtree CHART and an exposure SPEC.
2896
2897;; Exposure spec indicates the locations to be exposed and the prescribed
2898;; exposure status. Optional arg EXPOSING is an integer, with 0
2899;; indicating pending concealment, anything higher indicating depth to
2900;; which subtopic headers should be exposed, and negative numbers
2901;; indicating (negative of) the depth to which subtopic headers and
2902;; bodies should be exposed.
2903
2904;; The produced list can have two types of entries. Bare numbers
2905;; indicate points in the buffer where topic headers that should be
2906;; exposed reside.
2907
2908;; - bare negative numbers indicates that the topic starting at the
2909;; point which is the negative of the number should be opened,
2910;; including their entries.
2911;; - bare positive values indicate that this topic header should be
2912;; opened.
2913;; - Lists signify the beginning and end points of regions that should
c07583cd 2914;; be flagged, and the flag to employ. (For concealment: `(\?r)', and
e126900f
JB
2915;; exposure:"
2916;; (while spec
2917;; (cond ((listp spec)
2918;; )
2919;; )
2920;; (setq spec (cdr spec)))
2921;; )
c567ac01
RS
2922
2923;;;_ - Within Topic
fd5359c6
MR
2924;;;_ > allout-goto-prefix ()
2925(defun allout-goto-prefix ()
9179616f 2926 "Put point at beginning of immediately containing outline topic.
19b84ba3 2927
9179616f 2928Goes to most immediate subsequent topic if none immediately containing.
19b84ba3
RS
2929
2930Not sensitive to topic visibility.
c567ac01 2931
d27081f5 2932Returns the point at the beginning of the prefix, or nil if none."
c567ac01 2933
2a1408fd
DN
2934 (save-match-data
2935 (let (done)
2936 (while (and (not done)
2937 (search-backward "\n" nil 1))
2938 (forward-char 1)
2939 (if (looking-at allout-regexp)
2940 (setq done (allout-prefix-data))
2941 (forward-char -1)))
2942 (if (bobp)
2943 (cond ((looking-at allout-regexp)
2944 (allout-prefix-data))
2945 ((allout-next-heading))
2946 (done))
2947 done))))
d8350998
CY
2948;;;_ > allout-goto-prefix-doublechecked ()
2949(defun allout-goto-prefix-doublechecked ()
2950 "Put point at beginning of immediately containing outline topic.
2951
c07583cd 2952Like `allout-goto-prefix', but shallow topics (according to
65e7eb3d
EZ
2953`allout-doublecheck-at-and-shallower') are checked and
2954disqualified for child containment discontinuity, according to
2955`allout-aberrant-container-p'."
ede4ac6a
KS
2956 (if (allout-goto-prefix)
2957 (if (and (allout-do-doublecheck)
2958 (allout-aberrant-container-p))
2959 (allout-previous-heading)
2960 (point))))
d8350998 2961
fd5359c6
MR
2962;;;_ > allout-end-of-prefix ()
2963(defun allout-end-of-prefix (&optional ignore-decorations)
19b84ba3
RS
2964 "Position cursor at beginning of header text.
2965
2966If optional IGNORE-DECORATIONS is non-nil, put just after bullet,
2967otherwise skip white space between bullet and ensuing text."
c567ac01 2968
d8350998 2969 (if (not (allout-goto-prefix-doublechecked))
1977b8f6 2970 nil
d8350998 2971 (goto-char allout-recent-prefix-end)
2a1408fd
DN
2972 (save-match-data
2973 (if ignore-decorations
2974 t
2975 (while (looking-at "[0-9]") (forward-char 1))
2976 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))))
1977b8f6 2977 ;; Reestablish where we are:
fd5359c6
MR
2978 (allout-current-depth)))
2979;;;_ > allout-current-bullet-pos ()
2980(defun allout-current-bullet-pos ()
c07583cd 2981 "Return position of current (visible) topic's bullet."
c567ac01 2982
8a559d4e 2983 (if (not (allout-current-depth))
c567ac01 2984 nil
8a559d4e 2985 (1- allout-recent-prefix-end)))
1c9b9df0
KM
2986;;;_ > allout-back-to-current-heading (&optional interactive)
2987(defun allout-back-to-current-heading (&optional interactive)
80f66ef4 2988 "Move to heading line of current topic, or beginning if not in a topic.
96b83743 2989
80f66ef4
CY
2990If interactive, we position at the end of the prefix.
2991
2992Return value of resulting point, unless we started outside
2993of (before any) topics, in which case we return nil."
96b83743 2994
1c9b9df0
KM
2995 (interactive "p")
2996
96b83743 2997 (allout-beginning-of-current-line)
80f66ef4 2998 (let ((bol-point (point)))
ede4ac6a
KS
2999 (if (allout-goto-prefix-doublechecked)
3000 (if (<= (point) bol-point)
1c9b9df0 3001 (if interactive
ede4ac6a
KS
3002 (allout-end-of-prefix)
3003 (point))
3004 (goto-char (point-min))
3005 nil))))
fd5359c6
MR
3006;;;_ > allout-back-to-heading ()
3007(defalias 'allout-back-to-heading 'allout-back-to-current-heading)
96b83743
EZ
3008;;;_ > allout-pre-next-prefix ()
3009(defun allout-pre-next-prefix ()
1977b8f6
RS
3010 "Skip forward to just before the next heading line.
3011
c567ac01 3012Returns that character position."
1977b8f6 3013
8a559d4e
EZ
3014 (if (allout-next-heading)
3015 (goto-char (1- allout-recent-prefix-beginning))))
96b83743
EZ
3016;;;_ > allout-end-of-subtree (&optional current include-trailing-blank)
3017(defun allout-end-of-subtree (&optional current include-trailing-blank)
d82979ea
EZ
3018 "Put point at the end of the last leaf in the containing topic.
3019
96b83743
EZ
3020Optional CURRENT means put point at the end of the containing
3021visible topic.
3022
3023Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if
3024any, as part of the subtree. Otherwise, that trailing blank will be
3025excluded as delimiting whitespace between topics.
d82979ea
EZ
3026
3027Returns the value of point."
3028 (interactive "P")
3029 (if current
3030 (allout-back-to-current-heading)
d8350998
CY
3031 (allout-goto-prefix-doublechecked))
3032 (let ((level allout-recent-depth))
fd5359c6 3033 (allout-next-heading)
1977b8f6 3034 (while (and (not (eobp))
d8350998 3035 (> allout-recent-depth level))
fd5359c6 3036 (allout-next-heading))
48bd8440
EZ
3037 (if (eobp)
3038 (allout-end-of-entry)
3039 (forward-char -1))
96b83743 3040 (if (and (not include-trailing-blank) (= ?\n (preceding-char)))
c567ac01 3041 (forward-char -1))
fd5359c6 3042 (setq allout-recent-end-of-subtree (point))))
96b83743
EZ
3043;;;_ > allout-end-of-current-subtree (&optional include-trailing-blank)
3044(defun allout-end-of-current-subtree (&optional include-trailing-blank)
3045
d82979ea
EZ
3046 "Put point at end of last leaf in currently visible containing topic.
3047
96b83743
EZ
3048Optional INCLUDE-TRAILING-BLANK means include a trailing blank line, if
3049any, as part of the subtree. Otherwise, that trailing blank will be
3050excluded as delimiting whitespace between topics.
3051
d82979ea
EZ
3052Returns the value of point."
3053 (interactive)
96b83743 3054 (allout-end-of-subtree t include-trailing-blank))
1c9b9df0
KM
3055;;;_ > allout-beginning-of-current-entry (&optional interactive)
3056(defun allout-beginning-of-current-entry (&optional interactive)
d82979ea 3057 "When not already there, position point at beginning of current topic header.
c567ac01
RS
3058
3059If already there, move cursor to bullet for hot-spot operation.
46771bb3 3060\(See `allout-mode' doc string for details of hot-spot operation.)"
1c9b9df0 3061 (interactive "p")
c567ac01 3062 (let ((start-point (point)))
46771bb3 3063 (move-beginning-of-line 1)
d8350998
CY
3064 (if (< 0 (allout-current-depth))
3065 (goto-char allout-recent-prefix-end)
3066 (goto-char (point-min)))
fd5359c6 3067 (allout-end-of-prefix)
1c9b9df0 3068 (if (and interactive
c567ac01 3069 (= (point) start-point))
fd5359c6 3070 (goto-char (allout-current-bullet-pos)))))
96b83743
EZ
3071;;;_ > allout-end-of-entry (&optional inclusive)
3072(defun allout-end-of-entry (&optional inclusive)
3073 "Position the point at the end of the current topics' entry.
3074
3075Optional INCLUSIVE means also include trailing empty line, if any. When
3076unset, whitespace between items separates them even when the items are
3077collapsed."
1977b8f6 3078 (interactive)
96b83743
EZ
3079 (allout-pre-next-prefix)
3080 (if (and (not inclusive) (not (bobp)) (= ?\n (preceding-char)))
3081 (forward-char -1))
3082 (point))
fd5359c6
MR
3083;;;_ > allout-end-of-current-heading ()
3084(defun allout-end-of-current-heading ()
9179616f 3085 (interactive)
fd5359c6 3086 (allout-beginning-of-current-entry)
96b83743 3087 (search-forward "\n" nil t)
d82979ea 3088 (forward-char -1))
fd5359c6 3089(defalias 'allout-end-of-heading 'allout-end-of-current-heading)
d82979ea
EZ
3090;;;_ > allout-get-body-text ()
3091(defun allout-get-body-text ()
3092 "Return the unmangled body text of the topic immediately containing point."
3093 (save-excursion
3094 (allout-end-of-prefix)
96b83743 3095 (if (not (search-forward "\n" nil t))
d82979ea
EZ
3096 nil
3097 (backward-char 1)
3098 (let ((pre-body (point)))
3099 (if (not pre-body)
3100 nil
96b83743 3101 (allout-end-of-entry t)
d82979ea
EZ
3102 (if (not (= pre-body (point)))
3103 (buffer-substring-no-properties (1+ pre-body) (point))))
3104 )
3105 )
3106 )
3107 )
1977b8f6 3108
c567ac01 3109;;;_ - Depth-wise
fd5359c6
MR
3110;;;_ > allout-ascend-to-depth (depth)
3111(defun allout-ascend-to-depth (depth)
c567ac01 3112 "Ascend to depth DEPTH, returning depth if successful, nil if not."
fd5359c6 3113 (if (and (> depth 0)(<= depth (allout-depth)))
d8350998
CY
3114 (let (last-ascended)
3115 (while (and (< depth allout-recent-depth)
3116 (setq last-ascended (allout-ascend))))
3117 (goto-char allout-recent-prefix-beginning)
1c9b9df0 3118 (if (allout-called-interactively-p) (allout-end-of-prefix))
d8350998 3119 (and last-ascended allout-recent-depth))))
1c9b9df0 3120;;;_ > allout-ascend (&optional dont-move-if-unsuccessful)
c07583cd
KS
3121(defun allout-ascend (&optional dont-move-if-unsuccessful)
3122 "Ascend one level, returning resulting depth if successful, nil if not.
3123
3124Point is left at the beginning of the level whether or not
3125successful, unless optional DONT-MOVE-IF-UNSUCCESSFUL is set, in
3126which case point is returned to its original starting location."
3127 (if dont-move-if-unsuccessful
3128 (setq dont-move-if-unsuccessful (point)))
d82979ea
EZ
3129 (prog1
3130 (if (allout-beginning-of-level)
498a6493
CY
3131 (let ((bolevel (point))
3132 (bolevel-depth allout-recent-depth))
3133 (allout-previous-heading)
c07583cd
KS
3134 (cond ((< allout-recent-depth bolevel-depth)
3135 allout-recent-depth)
3136 ((= allout-recent-depth bolevel-depth)
3137 (if dont-move-if-unsuccessful
3138 (goto-char dont-move-if-unsuccessful))
3139 (allout-depth)
3140 nil)
3141 (t
3142 ;; some topic after very first is lower depth than first:
3143 (goto-char bolevel)
3144 (allout-depth)
3145 nil))))
1c9b9df0 3146 (if (allout-called-interactively-p) (allout-end-of-prefix))))
fd5359c6
MR
3147;;;_ > allout-descend-to-depth (depth)
3148(defun allout-descend-to-depth (depth)
19b84ba3
RS
3149 "Descend to depth DEPTH within current topic.
3150
3151Returning depth if successful, nil if not."
1977b8f6 3152 (let ((start-point (point))
fd5359c6 3153 (start-depth (allout-depth)))
1977b8f6 3154 (while
fd5359c6 3155 (and (> (allout-depth) 0)
d8350998 3156 (not (= depth allout-recent-depth)) ; ... not there yet
fd5359c6 3157 (allout-next-heading) ; ... go further
d8350998 3158 (< start-depth allout-recent-depth))) ; ... still in topic
fd5359c6 3159 (if (and (> (allout-depth) 0)
d8350998 3160 (= allout-recent-depth depth))
1977b8f6
RS
3161 depth
3162 (goto-char start-point)
3163 nil))
3164 )
d8350998
CY
3165;;;_ > allout-up-current-level (arg)
3166(defun allout-up-current-level (arg)
3167 "Move out ARG levels from current visible topic."
d82979ea 3168 (interactive "p")
8a559d4e
EZ
3169 (let ((start-point (point)))
3170 (allout-back-to-current-heading)
3171 (if (not (allout-ascend))
3172 (progn (goto-char start-point)
3173 (error "Can't ascend past outermost level"))
1c9b9df0 3174 (if (allout-called-interactively-p) (allout-end-of-prefix))
8a559d4e 3175 allout-recent-prefix-beginning)))
1977b8f6 3176
c567ac01 3177;;;_ - Linear
fd5359c6
MR
3178;;;_ > allout-next-sibling (&optional depth backward)
3179(defun allout-next-sibling (&optional depth backward)
2265e017 3180 "Like `allout-forward-current-level', but respects invisible topics.
1977b8f6 3181
c567ac01 3182Traverse at optional DEPTH, or current depth if none specified.
1977b8f6 3183
c567ac01 3184Go backward if optional arg BACKWARD is non-nil.
1977b8f6 3185
d8350998 3186Return the start point of the new topic if successful, nil otherwise."
1977b8f6 3187
d8350998 3188 (if (if backward (bobp) (eobp))
1977b8f6 3189 nil
d8350998 3190 (let ((target-depth (or depth (allout-depth)))
1977b8f6 3191 (start-point (point))
ede4ac6a 3192 (start-prefix-beginning allout-recent-prefix-beginning)
d8350998
CY
3193 (count 0)
3194 leaping
c567ac01 3195 last-depth)
d8350998
CY
3196 (while (and
3197 ;; done too few single steps to resort to the leap routine:
3198 (not leaping)
3199 ;; not at limit:
3200 (not (if backward (bobp) (eobp)))
3201 ;; still traversable:
3202 (if backward (allout-previous-heading) (allout-next-heading))
3203 ;; we're below the target depth
3204 (> (setq last-depth allout-recent-depth) target-depth))
3205 (setq count (1+ count))
3206 (if (> count 7) ; lists are commonly 7 +- 2, right?-)
3207 (setq leaping t)))
3208 (cond (leaping
3209 (or (allout-next-sibling-leap target-depth backward)
3210 (progn
3211 (goto-char start-point)
3212 (if depth (allout-depth) target-depth)
3213 nil)))
3214 ((and (not (eobp))
3215 (and (> (or last-depth (allout-depth)) 0)
ede4ac6a
KS
3216 (= allout-recent-depth target-depth))
3217 (not (= start-prefix-beginning
3218 allout-recent-prefix-beginning)))
d8350998
CY
3219 allout-recent-prefix-beginning)
3220 (t
3221 (goto-char start-point)
3222 (if depth (allout-depth) target-depth)
3223 nil)))))
3224;;;_ > allout-next-sibling-leap (&optional depth backward)
3225(defun allout-next-sibling-leap (&optional depth backward)
3226 "Like `allout-next-sibling', but by direct search for topic at depth.
3227
3228Traverse at optional DEPTH, or current depth if none specified.
3229
3230Go backward if optional arg BACKWARD is non-nil.
3231
3232Return the start point of the new topic if successful, nil otherwise.
3233
3234Costs more than regular `allout-next-sibling' for short traversals:
3235
c07583cd 3236 - we have to check the prior (next, if travelling backwards)
d8350998
CY
3237 item to confirm connectivity with the prior topic, and
3238 - if confirmed, we have to reestablish the allout-recent-* settings with
3239 some extra navigation
3240 - if confirmation fails, we have to do more work to recover
3241
3242It is an increasingly big win when there are many intervening
3243offspring before the next sibling, however, so
3244`allout-next-sibling' resorts to this if it finds itself in that
3245situation."
3246
3247 (if (if backward (bobp) (eobp))
3248 nil
3249 (let* ((start-point (point))
3250 (target-depth (or depth (allout-depth)))
3251 (search-whitespace-regexp nil)
3252 (depth-biased (- target-depth 2))
3253 (expression (if (<= target-depth 1)
3254 allout-depth-one-regexp
3255 (format allout-depth-specific-regexp
3256 depth-biased depth-biased)))
3257 found
3258 done)
3259 (while (not done)
2a1408fd
DN
3260 (setq found (save-match-data
3261 (if backward
3262 (re-search-backward expression nil 'to-limit)
3263 (forward-char 1)
3264 (re-search-forward expression nil 'to-limit))))
d8350998
CY
3265 (if (and found (allout-aberrant-container-p))
3266 (setq found nil))
3267 (setq done (or found (if backward (bobp) (eobp)))))
3268 (if (not found)
3269 (progn (goto-char start-point)
3270 nil)
3271 ;; rationale: if any intervening items were at a lower depth, we
60c7bbd2 3272 ;; would now be on the first offspring at the target depth -- ie,
d8350998
CY
3273 ;; the preceeding item (per the search direction) must be at a
3274 ;; lesser depth. that's all we need to check.
3275 (if backward (allout-next-heading) (allout-previous-heading))
3276 (if (< allout-recent-depth target-depth)
3277 ;; return to start and reestablish allout-recent-*:
3278 (progn
3279 (goto-char start-point)
3280 (allout-depth)
3281 nil)
3282 (goto-char found)
3283 ;; locate cursor and set allout-recent-*:
3284 (allout-goto-prefix))))))
fd5359c6
MR
3285;;;_ > allout-previous-sibling (&optional depth backward)
3286(defun allout-previous-sibling (&optional depth backward)
d82979ea 3287 "Like `allout-forward-current-level' backwards, respecting invisible topics.
1977b8f6 3288
c567ac01 3289Optional DEPTH specifies depth to traverse, default current depth.
1977b8f6 3290
c567ac01 3291Optional BACKWARD reverses direction.
1977b8f6 3292
c567ac01 3293Return depth if successful, nil otherwise."
fd5359c6 3294 (allout-next-sibling depth (not backward))
1977b8f6 3295 )
fd5359c6
MR
3296;;;_ > allout-snug-back ()
3297(defun allout-snug-back ()
539d7736 3298 "Position cursor at end of previous topic.
19b84ba3
RS
3299
3300Presumes point is at the start of a topic prefix."
c567ac01
RS
3301 (if (or (bobp) (eobp))
3302 nil
3303 (forward-char -1))
96b83743 3304 (if (or (bobp) (not (= ?\n (preceding-char))))
c567ac01 3305 nil
96b83743 3306 (forward-char -1))
c567ac01 3307 (point))
fd5359c6
MR
3308;;;_ > allout-beginning-of-level ()
3309(defun allout-beginning-of-level ()
c567ac01 3310 "Go back to the first sibling at this level, visible or not."
fd5359c6
MR
3311 (allout-end-of-level 'backward))
3312;;;_ > allout-end-of-level (&optional backward)
3313(defun allout-end-of-level (&optional backward)
c567ac01 3314 "Go to the last sibling at this level, visible or not."
1977b8f6 3315
fd5359c6
MR
3316 (let ((depth (allout-depth)))
3317 (while (allout-previous-sibling depth nil))
d8350998 3318 (prog1 allout-recent-depth
1c9b9df0 3319 (if (allout-called-interactively-p) (allout-end-of-prefix)))))
fd5359c6
MR
3320;;;_ > allout-next-visible-heading (arg)
3321(defun allout-next-visible-heading (arg)
19b84ba3 3322 "Move to the next ARG'th visible heading line, backward if arg is negative.
c567ac01 3323
96b83743 3324Move to buffer limit in indicated direction if headings are exhausted."
1977b8f6 3325
1977b8f6 3326 (interactive "p")
0458fa80
EZ
3327 (let* ((inhibit-field-text-motion t)
3328 (backward (if (< arg 0) (setq arg (* -1 arg))))
c567ac01
RS
3329 (step (if backward -1 1))
3330 prev got)
3331
d8350998
CY
3332 (while (> arg 0)
3333 (while (and
3334 ;; Boundary condition:
3335 (not (if backward (bobp)(eobp)))
3336 ;; Move, skipping over all concealed lines in one fell swoop:
3337 (prog1 (condition-case nil (or (line-move step) t)
3338 (error nil))
3339 (allout-beginning-of-current-line))
3340 ;; Deal with apparent header line:
2a1408fd
DN
3341 (save-match-data
3342 (if (not (looking-at allout-regexp))
3343 ;; not a header line, keep looking:
d8350998 3344 t
2a1408fd
DN
3345 (allout-prefix-data)
3346 (if (and (allout-do-doublecheck)
3347 (allout-aberrant-container-p))
3348 ;; skip this aberrant prospective header line:
3349 t
8dd59f01 3350 ;; this prospective headerline qualifies -- register:
2a1408fd
DN
3351 (setq got allout-recent-prefix-beginning)
3352 ;; and break the loop:
3353 nil)))))
c567ac01
RS
3354 ;; Register this got, it may be the last:
3355 (if got (setq prev got))
3356 (setq arg (1- arg)))
3357 (cond (got ; Last move was to a prefix:
d8350998 3358 (allout-end-of-prefix))
c567ac01 3359 (prev ; Last move wasn't, but prev was:
d8350998
CY
3360 (goto-char prev)
3361 (allout-end-of-prefix))
c567ac01 3362 ((not backward) (end-of-line) nil))))
fd5359c6
MR
3363;;;_ > allout-previous-visible-heading (arg)
3364(defun allout-previous-visible-heading (arg)
c567ac01 3365 "Move to the previous heading line.
1977b8f6 3366
c567ac01 3367With argument, repeats or can move forward if negative.
2265e017 3368A heading line is one that starts with a `*' (or that `allout-regexp'
c567ac01 3369matches)."
1977b8f6 3370 (interactive "p")
d8350998 3371 (prog1 (allout-next-visible-heading (- arg))
1c9b9df0 3372 (if (allout-called-interactively-p) (allout-end-of-prefix))))
fd5359c6 3373;;;_ > allout-forward-current-level (arg)
d82979ea 3374(defun allout-forward-current-level (arg)
19b84ba3 3375 "Position point at the next heading of the same level.
1977b8f6 3376
19b84ba3 3377Takes optional repeat-count, goes backward if count is negative.
1977b8f6 3378
19b84ba3 3379Returns resulting position, else nil if none found."
d82979ea 3380 (interactive "p")
fd5359c6 3381 (let ((start-depth (allout-current-depth))
19b84ba3 3382 (start-arg arg)
d8350998 3383 (backward (> 0 arg)))
19b84ba3
RS
3384 (if (= 0 start-depth)
3385 (error "No siblings, not in a topic..."))
3386 (if backward (setq arg (* -1 arg)))
d8350998
CY
3387 (allout-back-to-current-heading)
3388 (while (and (not (zerop arg))
3389 (if backward
3390 (allout-previous-sibling)
3391 (allout-next-sibling)))
3392 (setq arg (1- arg)))
1c9b9df0 3393 (if (not (allout-called-interactively-p))
d8350998
CY
3394 nil
3395 (allout-end-of-prefix)
3396 (if (not (zerop arg))
3397 (error "Hit %s level %d topic, traversed %d of %d requested"
3398 (if backward "first" "last")
3399 allout-recent-depth
3400 (- (abs start-arg) arg)
3401 (abs start-arg))))))
fd5359c6 3402;;;_ > allout-backward-current-level (arg)
d82979ea 3403(defun allout-backward-current-level (arg)
fd5359c6 3404 "Inverse of `allout-forward-current-level'."
d82979ea 3405 (interactive "p")
1c9b9df0 3406 (if (allout-called-interactively-p)
19b84ba3 3407 (let ((current-prefix-arg (* -1 arg)))
fd5359c6
MR
3408 (call-interactively 'allout-forward-current-level))
3409 (allout-forward-current-level (* -1 arg))))
c567ac01 3410
19b84ba3 3411;;;_ #5 Alteration
c567ac01
RS
3412
3413;;;_ - Fundamental
fd5359c6
MR
3414;;;_ = allout-post-goto-bullet
3415(defvar allout-post-goto-bullet nil
3416 "Outline internal var, for `allout-pre-command-business' hot-spot operation.
19b84ba3
RS
3417
3418When set, tells post-processing to reposition on topic bullet, and
2265e017 3419then unset it. Set by `allout-pre-command-business' when implementing
19b84ba3
RS
3420hot-spot operation, where literal characters typed over a topic bullet
3421are mapped to the command of the corresponding control-key on the
2265e017 3422`allout-mode-map'.")
fd5359c6 3423(make-variable-buffer-local 'allout-post-goto-bullet)
48bd8440
EZ
3424;;;_ = allout-command-counter
3425(defvar allout-command-counter 0
3426 "Counter that monotonically increases in allout-mode buffers.
3427
3428Set by `allout-pre-command-business', to support allout addons in
3429coordinating with allout activity.")
3430(make-variable-buffer-local 'allout-command-counter)
fd5359c6
MR
3431;;;_ > allout-post-command-business ()
3432(defun allout-post-command-business ()
2265e017 3433 "Outline `post-command-hook' function.
c567ac01 3434
2265e017 3435- Implement (and clear) `allout-post-goto-bullet', for hot-spot
c567ac01
RS
3436 outline commands.
3437
96b83743 3438- Decrypt topic currently being edited if it was encrypted for a save."
c567ac01
RS
3439
3440 ; Apply any external change func:
fd5359c6 3441 (if (not (allout-mode-p)) ; In allout-mode.
19b84ba3 3442 nil
d82979ea
EZ
3443
3444 (if (and (boundp 'allout-after-save-decrypt)
3445 allout-after-save-decrypt)
3446 (allout-after-saves-handler))
3447
48bd8440 3448 ;; Implement allout-post-goto-bullet, if set:
fd5359c6
MR
3449 (if (and allout-post-goto-bullet
3450 (allout-current-bullet-pos))
3451 (progn (goto-char (allout-current-bullet-pos))
3452 (setq allout-post-goto-bullet nil)))
19b84ba3 3453 ))
fd5359c6
MR
3454;;;_ > allout-pre-command-business ()
3455(defun allout-pre-command-business ()
2265e017 3456 "Outline `pre-command-hook' function for outline buffers.
48bd8440
EZ
3457
3458Among other things, implements special behavior when the cursor is on the
3459topic bullet character.
c567ac01 3460
58edceeb
JB
3461When the cursor is on the bullet character, self-insert characters are
3462reinterpreted as the corresponding control-character in the
3463`allout-mode-map'. The `allout-mode' `post-command-hook' insures that
3464the cursor which has moved as a result of such reinterpretation is
3465positioned on the bullet character of the destination topic.
c567ac01 3466
c07583cd 3467The upshot is that you can get easy, single (ie, unmodified) key
9179616f 3468outline maneuvering operations by positioning the cursor on the bullet
58edceeb
JB
3469char. When in this mode you can use regular cursor-positioning
3470command/keystrokes to relocate the cursor off of a bullet character to
3471return to regular interpretation of self-insert characters."
d82979ea 3472
fd5359c6 3473 (if (not (allout-mode-p))
9179616f 3474 nil
48bd8440
EZ
3475 ;; Increment allout-command-counter
3476 (setq allout-command-counter (1+ allout-command-counter))
3477 ;; Do hot-spot navigation.
9179616f 3478 (if (and (eq this-command 'self-insert-command)
fd5359c6 3479 (eq (point)(allout-current-bullet-pos)))
01fc9422
EZ
3480 (allout-hotspot-key-handler))))
3481;;;_ > allout-hotspot-key-handler ()
3482(defun allout-hotspot-key-handler ()
3483 "Catchall handling of key bindings in hot-spots.
3484
3485Translates unmodified keystrokes to corresponding allout commands, when
3486they would qualify if prefixed with the allout-command-prefix, and sets
3487this-command accordingly.
3488
3489Returns the qualifying command, if any, else nil."
3490 (interactive)
1c9b9df0
KM
3491 (let* ((modified (event-modifiers last-command-event))
3492 (key-string (if (numberp last-command-event)
3493 (char-to-string
3494 (event-basic-type last-command-event))))
8989a920 3495 (key-num (cond ((numberp last-command-event) last-command-event)
01fc9422
EZ
3496 ;; for XEmacs character type:
3497 ((and (fboundp 'characterp)
8989a920
GM
3498 (apply 'characterp (list last-command-event)))
3499 (apply 'char-to-int (list last-command-event)))
01fc9422 3500 (t 0)))
d8350998 3501 mapped-binding)
01fc9422
EZ
3502
3503 (if (zerop key-num)
3504 nil
3505
d8350998
CY
3506 (if (and
3507 ;; exclude control chars and escape:
1c9b9df0 3508 (not modified)
d8350998
CY
3509 (<= 33 key-num)
3510 (setq mapped-binding
3511 (or (and (assoc key-string allout-keybindings-list)
3512 ;; translate literal membership on list:
3513 (cadr (assoc key-string allout-keybindings-list)))
3514 ;; translate as a keybinding:
2a1408fd 3515 (key-binding (vconcat allout-command-prefix
1c9b9df0
KM
3516 (vector
3517 (if (and (<= 97 key-num) ; "a"
3518 (>= 122 key-num)) ; "z"
3519 (- key-num 96) key-num)))
d8350998 3520 t))))
60c7bbd2 3521 ;; Qualified as an allout command -- do hot-spot operation.
01fc9422 3522 (setq allout-post-goto-bullet t)
1c9b9df0
KM
3523 ;; accept-defaults nil, or else we get allout-item-icon-key-handler.
3524 (setq mapped-binding (key-binding (vector key-num))))
01fc9422
EZ
3525
3526 (while (keymapp mapped-binding)
3527 (setq mapped-binding
d8350998 3528 (lookup-key mapped-binding (vector (read-char)))))
01fc9422 3529
1c9b9df0
KM
3530 (when mapped-binding
3531 (setq this-command mapped-binding)))))
01fc9422 3532
fd5359c6
MR
3533;;;_ > allout-find-file-hook ()
3534(defun allout-find-file-hook ()
4034b0e2 3535 "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'.
fd5359c6
MR
3536
3537See `allout-init' for setup instructions."
3538 (if (and allout-auto-activation
3539 (not (allout-mode-p))
3540 allout-layout)
2576c28f 3541 (allout-mode)))
c567ac01
RS
3542
3543;;;_ - Topic Format Assessment
fd5359c6
MR
3544;;;_ > allout-solicit-alternate-bullet (depth &optional current-bullet)
3545(defun allout-solicit-alternate-bullet (depth &optional current-bullet)
1977b8f6 3546
19b84ba3
RS
3547 "Prompt for and return a bullet char as an alternative to the current one.
3548
3549Offer one suitable for current depth DEPTH as default."
1977b8f6 3550
9179616f 3551 (let* ((default-bullet (or (and (stringp current-bullet) current-bullet)
fd5359c6
MR
3552 (allout-bullet-for-depth depth)))
3553 (sans-escapes (regexp-sans-escapes allout-bullets-string))
9179616f
DL
3554 choice)
3555 (save-excursion
fd5359c6 3556 (goto-char (allout-current-bullet-pos))
9179616f
DL
3557 (setq choice (solicit-char-in-string
3558 (format "Select bullet: %s ('%s' default): "
3559 sans-escapes
1c9b9df0 3560 (allout-substring-no-properties default-bullet))
9179616f
DL
3561 sans-escapes
3562 t)))
3563 (message "")
1977b8f6
RS
3564 (if (string= choice "") default-bullet choice))
3565 )
fd5359c6
MR
3566;;;_ > allout-distinctive-bullet (bullet)
3567(defun allout-distinctive-bullet (bullet)
e126900f 3568 "True if BULLET is one of those on `allout-distinctive-bullets-string'."
fd5359c6
MR
3569 (string-match (regexp-quote bullet) allout-distinctive-bullets-string))
3570;;;_ > allout-numbered-type-prefix (&optional prefix)
3571(defun allout-numbered-type-prefix (&optional prefix)
c567ac01 3572 "True if current header prefix bullet is numbered bullet."
fd5359c6
MR
3573 (and allout-numbered-bullet
3574 (string= allout-numbered-bullet
1977b8f6 3575 (if prefix
fd5359c6
MR
3576 (allout-get-prefix-bullet prefix)
3577 (allout-get-bullet)))))
d82979ea
EZ
3578;;;_ > allout-encrypted-type-prefix (&optional prefix)
3579(defun allout-encrypted-type-prefix (&optional prefix)
c07583cd 3580 "True if current header prefix bullet is for an encrypted entry (body)."
d82979ea
EZ
3581 (and allout-topic-encryption-bullet
3582 (string= allout-topic-encryption-bullet
3583 (if prefix
3584 (allout-get-prefix-bullet prefix)
3585 (allout-get-bullet)))))
fd5359c6
MR
3586;;;_ > allout-bullet-for-depth (&optional depth)
3587(defun allout-bullet-for-depth (&optional depth)
19b84ba3 3588 "Return outline topic bullet suited to optional DEPTH, or current depth."
1977b8f6 3589 ;; Find bullet in plain-bullets-string modulo DEPTH.
fd5359c6
MR
3590 (if allout-stylish-prefixes
3591 (char-to-string (aref allout-plain-bullets-string
1977b8f6 3592 (% (max 0 (- depth 2))
fd5359c6
MR
3593 allout-plain-bullets-string-len)))
3594 allout-primary-bullet)
1977b8f6
RS
3595 )
3596
c567ac01 3597;;;_ - Topic Production
fd5359c6
MR
3598;;;_ > allout-make-topic-prefix (&optional prior-bullet
3599(defun allout-make-topic-prefix (&optional prior-bullet
1977b8f6
RS
3600 new
3601 depth
3602 solicit
3603 number-control
3604 index)
3605 ;; Depth null means use current depth, non-null means we're either
3606 ;; opening a new topic after current topic, lower or higher, or we're
3607 ;; changing level of current topic.
3608 ;; Solicit dominates specified bullet-char.
c567ac01 3609;;;_ . Doc string:
19b84ba3 3610 "Generate a topic prefix suitable for optional arg DEPTH, or current depth.
c567ac01
RS
3611
3612All the arguments are optional.
3613
3614PRIOR-BULLET indicates the bullet of the prefix being changed, or
3615nil if none. This bullet may be preserved (other options
2265e017 3616notwithstanding) if it is on the `allout-distinctive-bullets-string',
c567ac01
RS
3617for instance.
3618
3619Second arg NEW indicates that a new topic is being opened after the
3620topic at point, if non-nil. Default bullet for new topics, eg, may
3621be set (contingent to other args) to numbered bullets if previous
3622sibling is one. The implication otherwise is that the current topic
60c7bbd2 3623is being adjusted -- shifted or rebulleted -- and we don't consider
c567ac01
RS
3624bullet or previous sibling.
3625
3626Third arg DEPTH forces the topic prefix to that depth, regardless of
3627the current topics' depth.
3628
9179616f
DL
3629If SOLICIT is non-nil, then the choice of bullet is solicited from
3630user. If it's a character, then that character is offered as the
c07583cd
KS
3631default, otherwise the one suited to the context (according to
3632distinction or depth) is offered. (This overrides other options,
9179616f
DL
3633including, eg, a distinctive PRIOR-BULLET.) If non-nil, then the
3634context-specific bullet is used.
c567ac01 3635
fd5359c6 3636Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet'
c567ac01
RS
3637is non-nil *and* soliciting was not explicitly invoked. Then
3638NUMBER-CONTROL non-nil forces prefix to either numbered or
3639denumbered format, depending on the value of the sixth arg, INDEX.
3640
3641\(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...)
3642
3643If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then
3644the prefix of the topic is forced to be numbered. Non-nil
3645NUMBER-CONTROL and nil INDEX forces non-numbered format on the
3646bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means
3647that the index for the numbered prefix will be derived, by counting
3648siblings back to start of level. If INDEX is a number, then that
3649number is used as the index for the numbered prefix (allowing, eg,
a0776d6b 3650sequential renumbering to not require this function counting back the
c567ac01
RS
3651index for each successive sibling)."
3652;;;_ . Code:
1977b8f6
RS
3653 ;; The options are ordered in likely frequence of use, most common
3654 ;; highest, least lowest. Ie, more likely to be doing prefix
3655 ;; adjustments than soliciting, and yet more than numbering.
3656 ;; Current prefix is least dominant, but most likely to be commonly
3657 ;; specified...
3658
3659 (let* (body
3660 numbering
3661 denumbering
fd5359c6
MR
3662 (depth (or depth (allout-depth)))
3663 (header-lead allout-header-prefix)
1977b8f6
RS
3664 (bullet-char
3665
3666 ;; Getting value for bullet char is practically the whole job:
3667
3668 (cond
60c7bbd2 3669 ; Simplest situation -- level 1:
fd5359c6 3670 ((<= depth 1) (setq header-lead "") allout-primary-bullet)
1977b8f6 3671 ; Simple, too: all asterisks:
fd5359c6 3672 (allout-old-style-prefixes
60c7bbd2 3673 ;; Cheat -- make body the whole thing, null out header-lead and
1977b8f6
RS
3674 ;; bullet-char:
3675 (setq body (make-string depth
fd5359c6 3676 (string-to-char allout-primary-bullet)))
1977b8f6
RS
3677 (setq header-lead "")
3678 "")
3679
3680 ;; (Neither level 1 nor old-style, so we're space padding.
3681 ;; Sneak it in the condition of the next case, whatever it is.)
3682
3683 ;; Solicitation overrides numbering and other cases:
3684 ((progn (setq body (make-string (- depth 2) ?\ ))
3685 ;; The actual condition:
3686 solicit)
fd5359c6 3687 (let* ((got (allout-solicit-alternate-bullet depth solicit)))
1977b8f6 3688 ;; Gotta check whether we're numbering and got a numbered bullet:
fd5359c6 3689 (setq numbering (and allout-numbered-bullet
1977b8f6 3690 (not (and number-control (not index)))
fd5359c6 3691 (string= got allout-numbered-bullet)))
1977b8f6
RS
3692 ;; Now return what we got, regardless:
3693 got))
3694
3695 ;; Numbering invoked through args:
fd5359c6 3696 ((and allout-numbered-bullet number-control)
1977b8f6 3697 (if (setq numbering (not (setq denumbering (not index))))
fd5359c6 3698 allout-numbered-bullet
19b84ba3 3699 (if (and prior-bullet
fd5359c6 3700 (not (string= allout-numbered-bullet
19b84ba3
RS
3701 prior-bullet)))
3702 prior-bullet
fd5359c6 3703 (allout-bullet-for-depth depth))))
1977b8f6
RS
3704
3705 ;;; Neither soliciting nor controlled numbering ;;;
3706 ;;; (may be controlled denumbering, tho) ;;;
3707
3708 ;; Check wrt previous sibling:
3709 ((and new ; only check for new prefixes
fd5359c6
MR
3710 (<= depth (allout-depth))
3711 allout-numbered-bullet ; ... & numbering enabled
1977b8f6
RS
3712 (not denumbering)
3713 (let ((sibling-bullet
3714 (save-excursion
3715 ;; Locate correct sibling:
fd5359c6
MR
3716 (or (>= depth (allout-depth))
3717 (allout-ascend-to-depth depth))
3718 (allout-get-bullet))))
1977b8f6 3719 (if (and sibling-bullet
fd5359c6 3720 (string= allout-numbered-bullet sibling-bullet))
1977b8f6
RS
3721 (setq numbering sibling-bullet)))))
3722
3723 ;; Distinctive prior bullet?
3724 ((and prior-bullet
fd5359c6 3725 (allout-distinctive-bullet prior-bullet)
1977b8f6 3726 ;; Either non-numbered:
fd5359c6
MR
3727 (or (not (and allout-numbered-bullet
3728 (string= prior-bullet allout-numbered-bullet)))
1977b8f6
RS
3729 ;; or numbered, and not denumbering:
3730 (setq numbering (not denumbering)))
3731 ;; Here 'tis:
3732 prior-bullet))
3733
3734 ;; Else, standard bullet per depth:
fd5359c6 3735 ((allout-bullet-for-depth depth)))))
1977b8f6
RS
3736
3737 (concat header-lead
3738 body
3739 bullet-char
3740 (if numbering
3741 (format "%d" (cond ((and index (numberp index)) index)
fd5359c6
MR
3742 (new (1+ (allout-sibling-index depth)))
3743 ((allout-sibling-index))))))
1977b8f6
RS
3744 )
3745 )
96b83743
EZ
3746;;;_ > allout-open-topic (relative-depth &optional before offer-recent-bullet)
3747(defun allout-open-topic (relative-depth &optional before offer-recent-bullet)
d82979ea 3748 "Open a new topic at depth DEPTH.
19b84ba3
RS
3749
3750New topic is situated after current one, unless optional flag BEFORE
60c7bbd2
RS
3751is non-nil, or unless current line is completely empty -- lacking even
3752whitespace -- in which case open is done on the current line.
96b83743
EZ
3753
3754When adding an offspring, it will be added immediately after the parent if
3755the other offspring are exposed, or after the last child if the offspring
c07583cd 3756are hidden. (The intervening offspring will be exposed in the latter
96b83743 3757case.)
c567ac01 3758
96b83743 3759If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
9179616f 3760
c567ac01
RS
3761Nuances:
3762
3763- Creation of new topics is with respect to the visible topic
3764 containing the cursor, regardless of intervening concealed ones.
3765
3766- New headers are generally created after/before the body of a
3767 topic. However, they are created right at cursor location if the
3768 cursor is on a blank line, even if that breaks the current topic
3769 body. This is intentional, to provide a simple means for
3770 deliberately dividing topic bodies.
3771
3772- Double spacing of topic lists is preserved. Also, the first
3773 level two topic is created double-spaced (and so would be
3774 subsequent siblings, if that's left intact). Otherwise,
3775 single-spacing is used.
3776
3777- Creation of sibling or nested topics is with respect to the topic
3778 you're starting from, even when creating backwards. This way you
3779 can easily create a sibling in front of the current topic without
a0776d6b 3780 having to go to its preceding sibling, and then open forward
c567ac01 3781 from there."
1977b8f6 3782
96b83743 3783 (allout-beginning-of-current-line)
2a1408fd
DN
3784 (save-match-data
3785 (let* ((inhibit-field-text-motion t)
3786 (depth (+ (allout-current-depth) relative-depth))
3787 (opening-on-blank (if (looking-at "^\$")
3788 (not (setq before nil))))
3789 ;; bunch o vars set while computing ref-topic
3790 opening-numbered
3791 ref-depth
3792 ref-bullet
3793 (ref-topic (save-excursion
3794 (cond ((< relative-depth 0)
3795 (allout-ascend-to-depth depth))
3796 ((>= relative-depth 1) nil)
3797 (t (allout-back-to-current-heading)))
3798 (setq ref-depth allout-recent-depth)
3799 (setq ref-bullet
3800 (if (> allout-recent-prefix-end 1)
3801 (allout-recent-bullet)
3802 ""))
3803 (setq opening-numbered
3804 (save-excursion
3805 (and allout-numbered-bullet
3806 (or (<= relative-depth 0)
3807 (allout-descend-to-depth depth))
3808 (if (allout-numbered-type-prefix)
3809 allout-numbered-bullet))))
3810 (point)))
3811 dbl-space
3812 doing-beginning
3813 start end)
3814
3815 (if (not opening-on-blank)
1977b8f6 3816 ; Positioning and vertical
60c7bbd2 3817 ; padding -- only if not
1977b8f6 3818 ; opening-on-blank:
2a1408fd
DN
3819 (progn
3820 (goto-char ref-topic)
3821 (setq dbl-space ; Determine double space action:
3822 (or (and (<= relative-depth 0) ; not descending;
3823 (save-excursion
3824 ;; at b-o-b or preceded by a blank line?
3825 (or (> 0 (forward-line -1))
3826 (looking-at "^\\s-*$")
3827 (bobp)))
3828 (save-excursion
3829 ;; succeeded by a blank line?
3830 (allout-end-of-current-subtree)
3831 (looking-at "\n\n")))
3832 (and (= ref-depth 1)
3833 (or before
3834 (= depth 1)
3835 (save-excursion
3836 ;; Don't already have following
3837 ;; vertical padding:
3838 (not (allout-pre-next-prefix)))))))
3839
3840 ;; Position to prior heading, if inserting backwards, and not
3841 ;; going outwards:
3842 (if (and before (>= relative-depth 0))
3843 (progn (allout-back-to-current-heading)
3844 (setq doing-beginning (bobp))
3845 (if (not (bobp))
3846 (allout-previous-heading)))
3847 (if (and before (bobp))
3848 (open-line 1)))
3849
3850 (if (<= relative-depth 0)
3851 ;; Not going inwards, don't snug up:
3852 (if doing-beginning
3853 (if (not dbl-space)
3854 (open-line 1)
3855 (open-line 2))
3856 (if before
3857 (progn (end-of-line)
3858 (allout-pre-next-prefix)
3859 (while (and (= ?\n (following-char))
3860 (save-excursion
3861 (forward-char 1)
3862 (allout-hidden-p)))
3863 (forward-char 1))
3864 (if (not (looking-at "^$"))
3865 (open-line 1)))
3866 (allout-end-of-current-subtree)
3867 (if (looking-at "\n\n") (forward-char 1))))
8dd59f01 3868 ;; Going inwards -- double-space if first offspring is
2a1408fd
DN
3869 ;; double-spaced, otherwise snug up.
3870 (allout-end-of-entry)
3871 (if (eobp)
3872 (newline 1)
3873 (line-move 1))
3874 (allout-beginning-of-current-line)
3875 (backward-char 1)
3876 (if (bolp)
3877 ;; Blank lines between current header body and next
8dd59f01 3878 ;; header -- get to last substantive (non-white-space)
2a1408fd
DN
3879 ;; line in body:
3880 (progn (setq dbl-space t)
3881 (re-search-backward "[^ \t\n]" nil t)))
3882 (if (looking-at "\n\n")
3883 (setq dbl-space t))
3884 (if (save-excursion
3885 (allout-next-heading)
3886 (when (> allout-recent-depth ref-depth)
3887 ;; This is an offspring.
3888 (forward-line -1)
3889 (looking-at "^\\s-*$")))
3890 (progn (forward-line 1)
96b83743 3891 (open-line 1)
2a1408fd
DN
3892 (forward-line 1)))
3893 (allout-end-of-current-line))
3894
3895 ;;(if doing-beginning (goto-char doing-beginning))
3896 (if (not (bobp))
3897 ;; We insert a newline char rather than using open-line to
3898 ;; avoid rear-stickiness inheritence of read-only property.
3899 (progn (if (and (not (> depth ref-depth))
3900 (not before))
3901 (open-line 1)
3902 (if (and (not dbl-space) (> depth ref-depth))
3903 (newline 1)
3904 (if dbl-space
3905 (open-line 1)
3906 (if (not before)
3907 (newline 1)))))
3908 (if (and dbl-space (not (> relative-depth 0)))
3909 (newline 1))
3910 (if (and (not (eobp))
3911 (or (not (bolp))
3912 (and (not (bobp))
3913 ;; bolp doesnt detect concealed
3914 ;; trailing newlines, compensate:
3915 (save-excursion
3916 (forward-char -1)
3917 (allout-hidden-p)))))
3918 (forward-char 1))))
3919 ))
3920 (setq start (point))
3921 (insert (concat (allout-make-topic-prefix opening-numbered t depth)
3922 " "))
3923 (setq end (1+ (point)))
3924
3925 (allout-rebullet-heading (and offer-recent-bullet ref-bullet)
3926 depth nil nil t)
3927 (if (> relative-depth 0)
3928 (save-excursion (goto-char ref-topic)
3929 (allout-show-children)))
3930 (end-of-line)
48bd8440 3931
2a1408fd
DN
3932 (run-hook-with-args 'allout-structure-added-hook start end)
3933 )
1977b8f6
RS
3934 )
3935 )
fd5359c6
MR
3936;;;_ > allout-open-subtopic (arg)
3937(defun allout-open-subtopic (arg)
c567ac01
RS
3938 "Open new topic header at deeper level than the current one.
3939
3940Negative universal arg means to open deeper, but place the new topic
3941prior to the current one."
1977b8f6 3942 (interactive "p")
d82979ea 3943 (allout-open-topic 1 (> 0 arg) (< 1 arg)))
fd5359c6
MR
3944;;;_ > allout-open-sibtopic (arg)
3945(defun allout-open-sibtopic (arg)
19b84ba3
RS
3946 "Open new topic header at same level as the current one.
3947
9179616f
DL
3948Positive universal arg means to use the bullet of the prior sibling.
3949
19b84ba3 3950Negative universal arg means to place the new topic prior to the current
c567ac01 3951one."
1977b8f6 3952 (interactive "p")
d82979ea 3953 (allout-open-topic 0 (> 0 arg) (not (= 1 arg))))
fd5359c6
MR
3954;;;_ > allout-open-supertopic (arg)
3955(defun allout-open-supertopic (arg)
c567ac01 3956 "Open new topic header at shallower level than the current one.
19b84ba3 3957
c567ac01
RS
3958Negative universal arg means to open shallower, but place the new
3959topic prior to the current one."
1977b8f6
RS
3960
3961 (interactive "p")
d82979ea 3962 (allout-open-topic -1 (> 0 arg) (< 1 arg)))
c567ac01
RS
3963
3964;;;_ - Outline Alteration
3965;;;_ : Topic Modification
fd5359c6
MR
3966;;;_ = allout-former-auto-filler
3967(defvar allout-former-auto-filler nil
2265e017 3968 "Name of modal fill function being wrapped by `allout-auto-fill'.")
fd5359c6
MR
3969;;;_ > allout-auto-fill ()
3970(defun allout-auto-fill ()
aad94676 3971 "`allout-mode' autofill function.
19b84ba3
RS
3972
3973Maintains outline hanging topic indentation if
fd5359c6 3974`allout-use-hanging-indents' is set."
01fc9422
EZ
3975
3976 (when (not allout-inhibit-auto-fill)
3977 (let ((fill-prefix (if allout-use-hanging-indents
3978 ;; Check for topic header indentation:
2a1408fd
DN
3979 (save-match-data
3980 (save-excursion
3981 (beginning-of-line)
3982 (if (looking-at allout-regexp)
3983 ;; ... construct indentation to account for
3984 ;; length of topic prefix:
3985 (make-string (progn (allout-end-of-prefix)
3986 (current-column))
3987 ?\ ))))))
7927f48d
KM
3988 (use-auto-fill-function
3989 (if (and (eq allout-outside-normal-auto-fill-function
3990 'allout-auto-fill)
3991 (eq auto-fill-function 'allout-auto-fill))
3992 'do-auto-fill
3993 (or allout-outside-normal-auto-fill-function
3994 auto-fill-function))))
01fc9422
EZ
3995 (if (or allout-former-auto-filler allout-use-hanging-indents)
3996 (funcall use-auto-fill-function)))))
fd5359c6
MR
3997;;;_ > allout-reindent-body (old-depth new-depth &optional number)
3998(defun allout-reindent-body (old-depth new-depth &optional number)
e126900f 3999 "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH.
c567ac01
RS
4000
4001Optional arg NUMBER indicates numbering is being added, and it must
a0776d6b 4002be accommodated.
c567ac01
RS
4003
4004Note that refill of indented paragraphs is not done."
1977b8f6
RS
4005
4006 (save-excursion
fd5359c6 4007 (allout-end-of-prefix)
c567ac01
RS
4008 (let* ((new-margin (current-column))
4009 excess old-indent-begin old-indent-end
c567ac01
RS
4010 ;; We want the column where the header-prefix text started
4011 ;; *before* the prefix was changed, so we infer it relative
4012 ;; to the new margin and the shift in depth:
4013 (old-margin (+ old-depth (- new-margin new-depth))))
353e2ef2 4014
c567ac01 4015 ;; Process lines up to (but excluding) next topic header:
fd5359c6 4016 (allout-unprotected
c567ac01
RS
4017 (save-match-data
4018 (while
96b83743 4019 (and (re-search-forward "\n\\(\\s-*\\)"
c567ac01
RS
4020 nil
4021 t)
4022 ;; Register the indent data, before we reset the
353e2ef2 4023 ;; match data with a subsequent `looking-at':
c567ac01
RS
4024 (setq old-indent-begin (match-beginning 1)
4025 old-indent-end (match-end 1))
fd5359c6 4026 (not (looking-at allout-regexp)))
d82979ea
EZ
4027 (if (> 0 (setq excess (- (- old-indent-end old-indent-begin)
4028 old-margin)))
60c7bbd2 4029 ;; Text starts left of old margin -- don't adjust:
c567ac01 4030 nil
ea18b2b1 4031 ;; Text was hanging at or right of old left margin --
c567ac01
RS
4032 ;; reindent it, preserving its existing indentation
4033 ;; beyond the old margin:
4034 (delete-region old-indent-begin old-indent-end)
d82979ea 4035 (indent-to (+ new-margin excess (current-column))))))))))
fd5359c6
MR
4036;;;_ > allout-rebullet-current-heading (arg)
4037(defun allout-rebullet-current-heading (arg)
9179616f
DL
4038 "Solicit new bullet for current visible heading."
4039 (interactive "p")
4040 (let ((initial-col (current-column))
fd5359c6 4041 (on-bullet (eq (point)(allout-current-bullet-pos)))
d8350998 4042 from to
9179616f
DL
4043 (backwards (if (< arg 0)
4044 (setq arg (* arg -1)))))
4045 (while (> arg 0)
fd5359c6
MR
4046 (save-excursion (allout-back-to-current-heading)
4047 (allout-end-of-prefix)
d8350998
CY
4048 (setq from allout-recent-prefix-beginning
4049 to allout-recent-prefix-end)
fd5359c6 4050 (allout-rebullet-heading t ;;; solicit
9179616f
DL
4051 nil ;;; depth
4052 nil ;;; number-control
4053 nil ;;; index
d8350998
CY
4054 t) ;;; do-successors
4055 (run-hook-with-args 'allout-exposure-change-hook
4056 from to t))
9179616f
DL
4057 (setq arg (1- arg))
4058 (if (<= arg 0)
4059 nil
4060 (setq initial-col nil) ; Override positioning back to init col
4061 (if (not backwards)
fd5359c6 4062 (allout-next-visible-heading 1)
d8350998 4063 (allout-goto-prefix-doublechecked)
fd5359c6 4064 (allout-next-visible-heading -1))))
9179616f 4065 (message "Done.")
fd5359c6 4066 (cond (on-bullet (goto-char (allout-current-bullet-pos)))
9179616f 4067 (initial-col (move-to-column initial-col)))))
fd5359c6
MR
4068;;;_ > allout-rebullet-heading (&optional solicit ...)
4069(defun allout-rebullet-heading (&optional solicit
1977b8f6
RS
4070 new-depth
4071 number-control
4072 index
4073 do-successors)
4074
c567ac01 4075 "Adjust bullet of current topic prefix.
1977b8f6 4076
d82979ea
EZ
4077All args are optional.
4078
9179616f
DL
4079If SOLICIT is non-nil, then the choice of bullet is solicited from
4080user. If it's a character, then that character is offered as the
c07583cd 4081default, otherwise the one suited to the context (according to
9179616f
DL
4082distinction or depth) is offered. If non-nil, then the
4083context-specific bullet is just used.
1977b8f6 4084
d82979ea 4085Second arg DEPTH forces the topic prefix to that depth, regardless
9179616f 4086of the topic's current depth.
1977b8f6 4087
c567ac01 4088Third arg NUMBER-CONTROL can force the prefix to or away from
fd5359c6 4089numbered form. It has effect only if `allout-numbered-bullet' is
c567ac01
RS
4090non-nil and soliciting was not explicitly invoked (via first arg).
4091Its effect, numbering or denumbering, then depends on the setting
75bcb912 4092of the fourth arg, INDEX.
1977b8f6 4093
75bcb912 4094If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the
c567ac01
RS
4095prefix of the topic is forced to be non-numbered. Null index and
4096non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
4097non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
4098INDEX is a number, then that number is used for the numbered
4099prefix. Non-nil and non-number means that the index for the
d82979ea 4100numbered prefix will be derived by allout-make-topic-prefix.
1977b8f6 4101
c567ac01
RS
4102Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
4103siblings.
1977b8f6 4104
fd5359c6
MR
4105Cf vars `allout-stylish-prefixes', `allout-old-style-prefixes',
4106and `allout-numbered-bullet', which all affect the behavior of
c567ac01 4107this function."
1977b8f6 4108
fd5359c6 4109 (let* ((current-depth (allout-depth))
1977b8f6 4110 (new-depth (or new-depth current-depth))
fd5359c6
MR
4111 (mb allout-recent-prefix-beginning)
4112 (me allout-recent-prefix-end)
d8350998 4113 (current-bullet (buffer-substring-no-properties (- me 1) me))
ede4ac6a 4114 (has-annotation (get-text-property mb 'allout-was-hidden))
fd5359c6 4115 (new-prefix (allout-make-topic-prefix current-bullet
1977b8f6
RS
4116 nil
4117 new-depth
4118 solicit
4119 number-control
4120 index)))
4121
c567ac01 4122 ;; Is new one is identical to old?
1977b8f6
RS
4123 (if (and (= current-depth new-depth)
4124 (string= current-bullet
4125 (substring new-prefix (1- (length new-prefix)))))
c567ac01 4126 ;; Nothing to do:
1977b8f6
RS
4127 t
4128
4129 ;; New prefix probably different from old:
c567ac01 4130 ; get rid of old one:
fd5359c6 4131 (allout-unprotected (delete-region mb me))
1977b8f6 4132 (goto-char mb)
c567ac01
RS
4133 ; Dispense with number if
4134 ; numbered-bullet prefix:
2a1408fd
DN
4135 (save-match-data
4136 (if (and allout-numbered-bullet
4137 (string= allout-numbered-bullet current-bullet)
4138 (looking-at "[0-9]+"))
4139 (allout-unprotected
4140 (delete-region (match-beginning 0)(match-end 0)))))
1977b8f6 4141
ede4ac6a
KS
4142 ;; convey 'allout-was-hidden annotation, if original had it:
4143 (if has-annotation
4144 (put-text-property 0 (length new-prefix) 'allout-was-hidden t
4145 new-prefix))
4146
c567ac01 4147 ; Put in new prefix:
fd5359c6 4148 (allout-unprotected (insert new-prefix))
1977b8f6 4149
d82979ea 4150 ;; Reindent the body if elected, margin changed, and not encrypted body:
fd5359c6 4151 (if (and allout-reindent-bodies
d82979ea
EZ
4152 (not (= new-depth current-depth))
4153 (not (allout-encrypted-topic-p)))
fd5359c6 4154 (allout-reindent-body current-depth new-depth))
1977b8f6 4155
c567ac01
RS
4156 ;; Recursively rectify successive siblings of orig topic if
4157 ;; caller elected for it:
4158 (if do-successors
4159 (save-excursion
fd5359c6 4160 (while (allout-next-sibling new-depth nil)
c567ac01
RS
4161 (setq index
4162 (cond ((numberp index) (1+ index))
fd5359c6
MR
4163 ((not number-control) (allout-sibling-index))))
4164 (if (allout-numbered-type-prefix)
4165 (allout-rebullet-heading nil ;;; solicit
c567ac01
RS
4166 new-depth ;;; new-depth
4167 number-control;;; number-control
4168 index ;;; index
4169 nil))))) ;;;(dont!)do-successors
4170 ) ; (if (and (= current-depth new-depth)...))
fd5359c6 4171 ) ; let* ((current-depth (allout-depth))...)
c567ac01 4172 ) ; defun
fd5359c6 4173;;;_ > allout-rebullet-topic (arg)
d8350998 4174(defun allout-rebullet-topic (arg &optional sans-offspring)
d82979ea 4175 "Rebullet the visible topic containing point and all contained subtopics.
19b84ba3 4176
c567ac01 4177Descends into invisible as well as visible topics, however.
1977b8f6 4178
75bcb912 4179When optional SANS-OFFSPRING is non-nil, subtopics are not
c07583cd 4180shifted. (Shifting a topic outwards without shifting its
d8350998
CY
4181offspring is disallowed, since this would create a \"containment
4182discontinuity\", where the depth difference between a topic and
4183its immediate offspring is greater than one.)
4184
c567ac01 4185With repeat count, shift topic depth by that amount."
1977b8f6 4186 (interactive "P")
96b83743 4187 (let ((start-col (current-column)))
1977b8f6
RS
4188 (save-excursion
4189 ;; Normalize arg:
4190 (cond ((null arg) (setq arg 0))
4191 ((listp arg) (setq arg (car arg))))
4192 ;; Fill the user in, in case we're shifting a big topic:
4193 (if (not (zerop arg)) (message "Shifting..."))
fd5359c6 4194 (allout-back-to-current-heading)
d8350998 4195 (if (<= (+ allout-recent-depth arg) 0)
1977b8f6 4196 (error "Attempt to shift topic below level 1"))
d8350998 4197 (allout-rebullet-topic-grunt arg nil nil nil nil sans-offspring)
1977b8f6 4198 (if (not (zerop arg)) (message "Shifting... done.")))
c567ac01 4199 (move-to-column (max 0 (+ start-col arg)))))
d8350998 4200;;;_ > allout-rebullet-topic-grunt (&optional relative-depth ...)
fd5359c6 4201(defun allout-rebullet-topic-grunt (&optional relative-depth
1977b8f6
RS
4202 starting-depth
4203 starting-point
4204 index
d8350998
CY
4205 do-successors
4206 sans-offspring)
d82979ea
EZ
4207 "Like `allout-rebullet-topic', but on nearest containing topic
4208\(visible or not).
1977b8f6 4209
d82979ea 4210See `allout-rebullet-heading' for rebulleting behavior.
1977b8f6 4211
d82979ea 4212All arguments are optional.
1977b8f6 4213
d82979ea
EZ
4214First arg RELATIVE-DEPTH means to shift the depth of the entire
4215topic that amount.
e126900f 4216
d8350998
CY
4217Several subsequent args are for internal recursive use by the function
4218itself: STARTING-DEPTH, STARTING-POINT, and INDEX.
4219
4220Finally, if optional SANS-OFFSPRING is non-nil then the offspring
c07583cd 4221are not shifted. (Shifting a topic outwards without shifting
d8350998
CY
4222its offspring is disallowed, since this would create a
4223\"containment discontinuity\", where the depth difference between
75bcb912 4224a topic and its immediate offspring is greater than one.)"
d8350998
CY
4225
4226 ;; XXX the recursion here is peculiar, and in general the routine may
4227 ;; need simplification with refactoring.
4228
4229 (if (and sans-offspring
4230 relative-depth
4231 (< relative-depth 0))
4232 (error (concat "Attempt to shift topic outwards without offspring,"
4233 " would cause containment discontinuity.")))
1977b8f6
RS
4234
4235 (let* ((relative-depth (or relative-depth 0))
fd5359c6 4236 (new-depth (allout-depth))
1977b8f6
RS
4237 (starting-depth (or starting-depth new-depth))
4238 (on-starting-call (null starting-point))
4239 (index (or index
4240 ;; Leave index null on starting call, so rebullet-heading
4241 ;; calculates it at what might be new depth:
4242 (and (or (zerop relative-depth)
4243 (not on-starting-call))
fd5359c6 4244 (allout-sibling-index))))
d8350998 4245 (starting-index index)
1977b8f6 4246 (moving-outwards (< 0 relative-depth))
d8350998
CY
4247 (starting-point (or starting-point (point)))
4248 (local-point (point)))
1977b8f6
RS
4249
4250 ;; Sanity check for excessive promotion done only on starting call:
4251 (and on-starting-call
4252 moving-outwards
4253 (> 0 (+ starting-depth relative-depth))
d8350998 4254 (error "Attempt to shift topic out beyond level 1"))
1977b8f6
RS
4255
4256 (cond ((= starting-depth new-depth)
d8350998
CY
4257 ;; We're at depth to work on this one.
4258
4259 ;; When shifting out we work on the children before working on
4260 ;; the parent to avoid interim `allout-aberrant-container-p'
4261 ;; aberrancy, and vice-versa when shifting in:
4262 (if (>= relative-depth 0)
4263 (allout-rebullet-heading nil
4264 (+ starting-depth relative-depth)
4265 nil ;;; number
4266 index
4267 nil)) ;;; do-successors
4268 (when (not sans-offspring)
4269 ;; ... and work on subsequent ones which are at greater depth:
4270 (setq index 0)
4271 (allout-next-heading)
4272 (while (and (not (eobp))
4273 (< starting-depth (allout-depth)))
4274 (setq index (1+ index))
4275 (allout-rebullet-topic-grunt relative-depth
4276 (1+ starting-depth)
4277 starting-point
4278 index)))
4279 (when (< relative-depth 0)
4280 (save-excursion
4281 (goto-char local-point)
4282 (allout-rebullet-heading nil ;;; solicit
4283 (+ starting-depth relative-depth)
4284 nil ;;; number
4285 starting-index
4286 nil)))) ;;; do-successors
1977b8f6
RS
4287
4288 ((< starting-depth new-depth)
60c7bbd2 4289 ;; Rare case -- subtopic more than one level deeper than parent.
1977b8f6 4290 ;; Treat this one at an even deeper level:
d8350998
CY
4291 (allout-rebullet-topic-grunt relative-depth
4292 new-depth
4293 starting-point
4294 index
4295 sans-offspring)))
1977b8f6
RS
4296
4297 (if on-starting-call
4298 (progn
4299 ;; Rectify numbering of former siblings of the adjusted topic,
4300 ;; if topic has changed depth
4301 (if (or do-successors
4302 (and (not (zerop relative-depth))
d8350998
CY
4303 (or (= allout-recent-depth starting-depth)
4304 (= allout-recent-depth (+ starting-depth
1977b8f6 4305 relative-depth)))))
fd5359c6 4306 (allout-rebullet-heading nil nil nil nil t))
1977b8f6
RS
4307 ;; Now rectify numbering of new siblings of the adjusted topic,
4308 ;; if depth has been changed:
4309 (progn (goto-char starting-point)
4310 (if (not (zerop relative-depth))
fd5359c6 4311 (allout-rebullet-heading nil nil nil nil t)))))
1977b8f6
RS
4312 )
4313 )
fd5359c6
MR
4314;;;_ > allout-renumber-to-depth (&optional depth)
4315(defun allout-renumber-to-depth (&optional depth)
19b84ba3
RS
4316 "Renumber siblings at current depth.
4317
4318Affects superior topics if optional arg DEPTH is less than current depth.
c567ac01
RS
4319
4320Returns final depth."
4321
4322 ;; Proceed by level, processing subsequent siblings on each,
4323 ;; ascending until we get shallower than the start depth:
4324
fd5359c6 4325 (let ((ascender (allout-depth))
9179616f 4326 was-eobp)
c567ac01 4327 (while (and (not (eobp))
fd5359c6 4328 (allout-depth)
d8350998 4329 (>= allout-recent-depth depth)
c567ac01
RS
4330 (>= ascender depth))
4331 ; Skip over all topics at
4332 ; lesser depths, which can not
4333 ; have been disturbed:
9179616f 4334 (while (and (not (setq was-eobp (eobp)))
d8350998 4335 (> allout-recent-depth ascender))
fd5359c6 4336 (allout-next-heading))
c567ac01 4337 ; Prime ascender for ascension:
d8350998
CY
4338 (setq ascender (1- allout-recent-depth))
4339 (if (>= allout-recent-depth depth)
fd5359c6 4340 (allout-rebullet-heading nil ;;; solicit
c567ac01
RS
4341 nil ;;; depth
4342 nil ;;; number-control
4343 nil ;;; index
9179616f
DL
4344 t)) ;;; do-successors
4345 (if was-eobp (goto-char (point-max)))))
d8350998 4346 allout-recent-depth)
fd5359c6
MR
4347;;;_ > allout-number-siblings (&optional denumber)
4348(defun allout-number-siblings (&optional denumber)
c567ac01 4349 "Assign numbered topic prefix to this topic and its siblings.
1977b8f6 4350
60c7bbd2 4351With universal argument, denumber -- assign default bullet to this
c567ac01 4352topic and its siblings.
1977b8f6 4353
c567ac01
RS
4354With repeated universal argument (`^U^U'), solicit bullet for each
4355rebulleting each topic at this level."
1977b8f6
RS
4356
4357 (interactive "P")
4358
4359 (save-excursion
fd5359c6
MR
4360 (allout-back-to-current-heading)
4361 (allout-beginning-of-level)
d8350998 4362 (let ((depth allout-recent-depth)
c567ac01 4363 (index (if (not denumber) 1))
1977b8f6
RS
4364 (use-bullet (equal '(16) denumber))
4365 (more t))
4366 (while more
fd5359c6 4367 (allout-rebullet-heading use-bullet ;;; solicit
c567ac01 4368 depth ;;; depth
1977b8f6
RS
4369 t ;;; number-control
4370 index ;;; index
4371 nil) ;;; do-successors
4372 (if index (setq index (1+ index)))
fd5359c6
MR
4373 (setq more (allout-next-sibling depth nil))))))
4374;;;_ > allout-shift-in (arg)
4375(defun allout-shift-in (arg)
d8350998
CY
4376 "Increase depth of current heading and any items collapsed within it.
4377
4378With a negative argument, the item is shifted out using
4379`allout-shift-out', instead.
4380
4381With an argument greater than one, shift-in the item but not its
4382offspring, making the item into a sibling of its former children,
4383and a child of sibling that formerly preceeded it.
4384
4385You are not allowed to shift the first offspring of a topic
4386inwards, because that would yield a \"containment
4387discontinuity\", where the depth difference between a topic and
4388its immediate offspring is greater than one. The first topic in
4389the file can be adjusted to any positive depth, however."
d82979ea 4390
1977b8f6 4391 (interactive "p")
d8350998
CY
4392 (if (< arg 0)
4393 (allout-shift-out (* arg -1))
4394 ;; refuse to create a containment discontinuity:
4395 (save-excursion
4396 (allout-back-to-current-heading)
4397 (if (not (bobp))
4398 (let* ((current-depth allout-recent-depth)
4399 (start-point (point))
4400 (predecessor-depth (progn
4401 (forward-char -1)
4402 (allout-goto-prefix-doublechecked)
4403 (if (< (point) start-point)
4404 allout-recent-depth
4405 0))))
4406 (if (and (> predecessor-depth 0)
4407 (> (1+ current-depth)
4408 (1+ predecessor-depth)))
4409 (error (concat "Disallowed shift deeper than"
498a6493
CY
4410 " containing topic's children."))
4411 (allout-back-to-current-heading)
4412 (if (< allout-recent-depth (1+ current-depth))
4413 (allout-show-children))))))
d8350998
CY
4414 (let ((where (point)))
4415 (allout-rebullet-topic 1 (and (> arg 1) 'sans-offspring))
4416 (run-hook-with-args 'allout-structure-shifted-hook arg where))))
fd5359c6
MR
4417;;;_ > allout-shift-out (arg)
4418(defun allout-shift-out (arg)
d82979ea 4419 "Decrease depth of current heading and any topics collapsed within it.
d8350998
CY
4420This will make the item a sibling of its former container.
4421
4422With a negative argument, the item is shifted in using
4423`allout-shift-in', instead.
4424
4425With an argument greater than one, shift-out the item's offspring
4426but not the item itself, making the former children siblings of
4427the item.
d82979ea 4428
d8350998
CY
4429With an argument greater than 1, the item's offspring are shifted
4430out without shifting the item. This will make the immediate
4431subtopics into siblings of the item."
1977b8f6 4432 (interactive "p")
d8350998
CY
4433 (if (< arg 0)
4434 (allout-shift-in (* arg -1))
4435 ;; Get proper exposure in this area:
4436 (save-excursion (if (allout-ascend)
4437 (allout-show-children)))
4438 ;; Show collapsed children if there's a successor which will become
4439 ;; their sibling:
4440 (if (and (allout-current-topic-collapsed-p)
4441 (save-excursion (allout-next-sibling)))
4442 (allout-show-children))
4443 (let ((where (and (allout-depth) allout-recent-prefix-beginning)))
4444 (save-excursion
4445 (if (> arg 1)
4446 ;; Shift the offspring but not the topic:
4447 (let ((children-chart (allout-chart-subtree 1)))
4448 (if (listp (car children-chart))
4449 ;; whoops:
4450 (setq children-chart (allout-flatten children-chart)))
4451 (save-excursion
4452 (dolist (child-point children-chart)
4453 (goto-char child-point)
4454 (allout-shift-out 1))))
4455 (allout-rebullet-topic (* arg -1))))
4456 (run-hook-with-args 'allout-structure-shifted-hook (* arg -1) where))))
c567ac01 4457;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
fd5359c6
MR
4458;;;_ > allout-kill-line (&optional arg)
4459(defun allout-kill-line (&optional arg)
c567ac01 4460 "Kill line, adjusting subsequent lines suitably for outline mode."
1977b8f6
RS
4461
4462 (interactive "*P")
d82979ea 4463
96b83743
EZ
4464 (if (or (not (allout-mode-p))
4465 (not (bolp))
2a1408fd 4466 (not (save-match-data (looking-at allout-regexp))))
4034b0e2 4467 ;; Just do a regular kill:
96b83743
EZ
4468 (kill-line arg)
4469 ;; Ah, have to watch out for adjustments:
4470 (let* ((beg (point))
d8350998 4471 end
96b83743
EZ
4472 (beg-hidden (allout-hidden-p))
4473 (end-hidden (save-excursion (allout-end-of-current-line)
d8350998 4474 (setq end (point))
96b83743 4475 (allout-hidden-p)))
d8350998 4476 (depth (allout-depth)))
96b83743 4477
d8350998 4478 (allout-annotate-hidden beg end)
96b83743
EZ
4479 (if (and (not beg-hidden) (not end-hidden))
4480 (allout-unprotected (kill-line arg))
4481 (kill-line arg))
ede4ac6a
KS
4482 (allout-deannotate-hidden beg end)
4483
96b83743
EZ
4484 (if allout-numbered-bullet
4485 (save-excursion ; Renumber subsequent topics if needed:
2a1408fd 4486 (if (not (save-match-data (looking-at allout-regexp)))
d82979ea 4487 (allout-next-heading))
48bd8440
EZ
4488 (allout-renumber-to-depth depth)))
4489 (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
1b4d97b2
CY
4490;;;_ > allout-copy-line-as-kill ()
4491(defun allout-copy-line-as-kill ()
4492 "Like allout-kill-topic, but save to kill ring instead of deleting."
4493 (interactive)
4494 (let ((buffer-read-only t))
4495 (condition-case nil
4496 (allout-kill-line)
4497 (buffer-read-only nil))))
fd5359c6
MR
4498;;;_ > allout-kill-topic ()
4499(defun allout-kill-topic ()
c567ac01
RS
4500 "Kill topic together with subtopics.
4501
96b83743
EZ
4502Trailing whitespace is killed with a topic if that whitespace:
4503
4504 - would separate the topic from a subsequent sibling
4505 - would separate the topic from the end of buffer
4506 - would not be added to whitespace already separating the topic from the
4507 previous one.
4508
d8350998 4509Topic exposure is marked with text-properties, to be used by
75bcb912 4510`allout-yank-processing' for exposure recovery."
1977b8f6
RS
4511
4512 (interactive)
0458fa80 4513 (let* ((inhibit-field-text-motion t)
96b83743 4514 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
ede4ac6a 4515 end
d8350998 4516 (depth allout-recent-depth))
fd5359c6 4517 (allout-end-of-current-subtree)
96b83743
EZ
4518 (if (and (/= (current-column) 0) (not (eobp)))
4519 (forward-char 1))
1977b8f6 4520 (if (not (eobp))
2a1408fd 4521 (if (and (save-match-data (looking-at "\n"))
96b83743
EZ
4522 (or (save-excursion
4523 (or (not (allout-next-heading))
d8350998 4524 (= depth allout-recent-depth)))
96b83743
EZ
4525 (and (> (- beg (point-min)) 3)
4526 (string= (buffer-substring (- beg 2) beg) "\n\n"))))
c567ac01 4527 (forward-char 1)))
353e2ef2 4528
ede4ac6a
KS
4529 (allout-annotate-hidden beg (setq end (point)))
4530 (unwind-protect
4531 (allout-unprotected (kill-region beg end))
4532 (if buffer-read-only
4533 ;; eg, during copy-as-kill.
4534 (allout-deannotate-hidden beg end)))
d8350998 4535
1977b8f6 4536 (save-excursion
48bd8440
EZ
4537 (allout-renumber-to-depth depth))
4538 (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
1b4d97b2
CY
4539;;;_ > allout-copy-topic-as-kill ()
4540(defun allout-copy-topic-as-kill ()
75bcb912 4541 "Like `allout-kill-topic', but save to kill ring instead of deleting."
1b4d97b2
CY
4542 (interactive)
4543 (let ((buffer-read-only t))
4544 (condition-case nil
4545 (allout-kill-topic)
4546 (buffer-read-only (message "Topic copied...")))))
d8350998
CY
4547;;;_ > allout-annotate-hidden (begin end)
4548(defun allout-annotate-hidden (begin end)
4549 "Qualify text with properties to indicate exposure status."
4550
1b4d97b2
CY
4551 (let ((was-modified (buffer-modified-p))
4552 (buffer-read-only nil))
ede4ac6a 4553 (allout-deannotate-hidden begin end)
d8350998
CY
4554 (save-excursion
4555 (goto-char begin)
4556 (let (done next prev overlay)
4557 (while (not done)
4558 ;; at or advance to start of next hidden region:
4559 (if (not (allout-hidden-p))
4560 (setq next
1b4d97b2 4561 (max (1+ (point))
1c9b9df0
KM
4562 (allout-next-single-char-property-change (point)
4563 'invisible
4564 nil end))))
d8350998 4565 (if (or (not next) (eq prev next))
60c7bbd2 4566 ;; still not at start of hidden area -- must not be any left.
d8350998
CY
4567 (setq done t)
4568 (goto-char next)
4569 (setq prev next)
4570 (if (not (allout-hidden-p))
4571 ;; still not at start of hidden area.
4572 (setq done t)
4573 (setq overlay (allout-get-invisibility-overlay))
4574 (setq next (overlay-end overlay)
4575 prev next)
4576 ;; advance to end of this hidden area:
4577 (when next
4578 (goto-char next)
4579 (allout-unprotected
ede4ac6a
KS
4580 (let ((buffer-undo-list t))
4581 (put-text-property (overlay-start overlay) next
4582 'allout-was-hidden t)))))))))
d8350998 4583 (set-buffer-modified-p was-modified)))
ede4ac6a
KS
4584;;;_ > allout-deannotate-hidden (begin end)
4585(defun allout-deannotate-hidden (begin end)
4586 "Remove allout hidden-text annotation between BEGIN and END."
4587
4588 (allout-unprotected
4589 (let ((inhibit-read-only t)
4590 (buffer-undo-list t))
4591 ;(remove-text-properties begin end '(allout-was-hidden t))
4592 )))
d8350998
CY
4593;;;_ > allout-hide-by-annotation (begin end)
4594(defun allout-hide-by-annotation (begin end)
4595 "Translate text properties indicating exposure status into actual exposure."
4596 (save-excursion
4597 (goto-char begin)
4598 (let ((was-modified (buffer-modified-p))
4599 done next prev)
4600 (while (not done)
4601 ;; at or advance to start of next annotation:
4602 (if (not (get-text-property (point) 'allout-was-hidden))
1c9b9df0
KM
4603 (setq next (allout-next-single-char-property-change
4604 (point) 'allout-was-hidden nil end)))
d8350998 4605 (if (or (not next) (eq prev next))
60c7bbd2 4606 ;; no more or not advancing -- must not be any left.
d8350998
CY
4607 (setq done t)
4608 (goto-char next)
4609 (setq prev next)
4610 (if (not (get-text-property (point) 'allout-was-hidden))
4611 ;; still not at start of annotation.
4612 (setq done t)
4613 ;; advance to just after end of this annotation:
1c9b9df0
KM
4614 (setq next (allout-next-single-char-property-change
4615 (point) 'allout-was-hidden nil end))
2a1408fd 4616 (overlay-put (make-overlay prev next nil 'front-advance)
d8350998 4617 'category 'allout-exposure-category)
ede4ac6a 4618 (allout-deannotate-hidden prev next)
d8350998
CY
4619 (setq prev next)
4620 (if next (goto-char next)))))
4621 (set-buffer-modified-p was-modified))))
fd5359c6
MR
4622;;;_ > allout-yank-processing ()
4623(defun allout-yank-processing (&optional arg)
c567ac01 4624
96b83743 4625 "Incidental allout-specific business to be done just after text yanks.
19b84ba3 4626
c567ac01 4627Does depth adjustment of yanked topics, when:
1977b8f6 4628
c567ac01
RS
46291 the stuff being yanked starts with a valid outline header prefix, and
46302 it is being yanked at the end of a line which consists of only a valid
1977b8f6
RS
4631 topic prefix.
4632
a0776d6b 4633Also, adjusts numbering of subsequent siblings when appropriate.
1977b8f6 4634
c567ac01
RS
4635Depth adjustment alters the depth of all the topics being yanked
4636the amount it takes to make the first topic have the depth of the
4637header into which it's being yanked.
1977b8f6 4638
c567ac01
RS
4639The point is left in front of yanked, adjusted topics, rather than
4640at the end (and vice-versa with the mark). Non-adjusted yanks,
d82979ea 4641however, are left exactly like normal, non-allout-specific yanks."
c567ac01
RS
4642
4643 (interactive "*P")
4644 ; Get to beginning, leaving
4645 ; region around subject:
96b83743 4646 (if (< (allout-mark-marker t) (point))
c567ac01 4647 (exchange-point-and-mark))
2a1408fd
DN
4648 (save-match-data
4649 (let* ((subj-beg (point))
4650 (into-bol (bolp))
4651 (subj-end (allout-mark-marker t))
4652 ;; 'resituate' if yanking an entire topic into topic header:
4653 (resituate (and (let ((allout-inhibit-aberrance-doublecheck t))
4654 (allout-e-o-prefix-p))
4655 (looking-at allout-regexp)
4656 (allout-prefix-data)))
4657 ;; `rectify-numbering' if resituating (where several topics may
4658 ;; be resituating) or yanking a topic into a topic slot (bol):
4659 (rectify-numbering (or resituate
8dd59f01 4660 (and into-bol (looking-at allout-regexp)))))
2a1408fd 4661 (if resituate
8dd59f01 4662 ;; Yanking a topic into the start of a topic -- reconcile to fit:
2a1408fd
DN
4663 (let* ((inhibit-field-text-motion t)
4664 (prefix-len (if (not (match-end 1))
4665 1
4666 (- (match-end 1) subj-beg)))
4667 (subj-depth allout-recent-depth)
4668 (prefix-bullet (allout-recent-bullet))
4669 (adjust-to-depth
4670 ;; Nil if adjustment unnecessary, otherwise depth to which
4671 ;; adjustment should be made:
4672 (save-excursion
4673 (and (goto-char subj-end)
4674 (eolp)
4675 (goto-char subj-beg)
4676 (and (looking-at allout-regexp)
4677 (progn
4678 (beginning-of-line)
4679 (not (= (point) subj-beg)))
4680 (looking-at allout-regexp)
4681 (allout-prefix-data))
4682 allout-recent-depth)))
4683 (more t))
4684 (setq rectify-numbering allout-numbered-bullet)
4685 (if adjust-to-depth
c567ac01 4686 ; Do the adjustment:
2a1408fd
DN
4687 (progn
4688 (save-restriction
4689 (narrow-to-region subj-beg subj-end)
c567ac01
RS
4690 ; Trim off excessive blank
4691 ; line at end, if any:
2a1408fd
DN
4692 (goto-char (point-max))
4693 (if (looking-at "^$")
4694 (allout-unprotected (delete-char -1)))
c567ac01
RS
4695 ; Work backwards, with each
4696 ; shallowest level,
4697 ; successively excluding the
4698 ; last processed topic from
4699 ; the narrow region:
2a1408fd
DN
4700 (while more
4701 (allout-back-to-current-heading)
c567ac01 4702 ; go as high as we can in each bunch:
2a1408fd
DN
4703 (while (allout-ascend t))
4704 (save-excursion
4705 (allout-unprotected
4706 (allout-rebullet-topic-grunt (- adjust-to-depth
4707 subj-depth)))
4708 (allout-depth))
4709 (if (setq more (not (bobp)))
4710 (progn (widen)
4711 (forward-char -1)
4712 (narrow-to-region subj-beg (point))))))
4713 ;; Preserve new bullet if it's a distinctive one, otherwise
4714 ;; use old one:
4715 (if (string-match (regexp-quote prefix-bullet)
4716 allout-distinctive-bullets-string)
c567ac01
RS
4717 ; Delete from bullet of old to
4718 ; before bullet of new:
2a1408fd
DN
4719 (progn
4720 (beginning-of-line)
4721 (allout-unprotected
4722 (delete-region (point) subj-beg))
4723 (set-marker (allout-mark-marker t) subj-end)
4724 (goto-char subj-beg)
4725 (allout-end-of-prefix))
c567ac01
RS
4726 ; Delete base subj prefix,
4727 ; leaving old one:
2a1408fd
DN
4728 (allout-unprotected
4729 (progn
4730 (delete-region (point) (+ (point)
4731 prefix-len
4732 (- adjust-to-depth
4733 subj-depth)))
c567ac01
RS
4734 ; and delete residual subj
4735 ; prefix digits and space:
2a1408fd
DN
4736 (while (looking-at "[0-9]") (delete-char 1))
4737 (if (looking-at " ")
4738 (delete-char 1))))))
4739 (exchange-point-and-mark))))
4740 (if rectify-numbering
4741 (progn
4742 (save-excursion
c567ac01 4743 ; Give some preliminary feedback:
2a1408fd 4744 (message "... reconciling numbers")
c567ac01 4745 ; ... and renumber, in case necessary:
2a1408fd
DN
4746 (goto-char subj-beg)
4747 (if (allout-goto-prefix-doublechecked)
4748 (allout-unprotected
4749 (allout-rebullet-heading nil ;;; solicit
4750 (allout-depth) ;;; depth
4751 nil ;;; number-control
4752 nil ;;; index
4753 t)))
4754 (message ""))))
4755 (if (or into-bol resituate)
4756 (allout-hide-by-annotation (point) (allout-mark-marker t))
4757 (allout-deannotate-hidden (allout-mark-marker t) (point)))
4758 (if (not resituate)
4759 (exchange-point-and-mark))
4760 (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
fd5359c6
MR
4761;;;_ > allout-yank (&optional arg)
4762(defun allout-yank (&optional arg)
aad94676 4763 "`allout-mode' yank, with depth and numbering adjustment of yanked topics.
19b84ba3 4764
a0776d6b 4765Non-topic yanks work no differently than normal yanks.
c567ac01
RS
4766
4767If a topic is being yanked into a bare topic prefix, the depth of the
4768yanked topic is adjusted to the depth of the topic prefix.
4769
2265e017 4770 1 we're yanking in an `allout-mode' buffer
c567ac01
RS
4771 2 the stuff being yanked starts with a valid outline header prefix, and
4772 3 it is being yanked at the end of a line which consists of only a valid
4773 topic prefix.
4774
4775If these conditions hold then the depth of the yanked topics are all
4776adjusted the amount it takes to make the first one at the depth of the
4777header into which it's being yanked.
4778
4779The point is left in front of yanked, adjusted topics, rather than
4780at the end (and vice-versa with the mark). Non-adjusted yanks,
4781however, (ones that don't qualify for adjustment) are handled
4782exactly like normal yanks.
4783
a0776d6b 4784Numbering of yanked topics, and the successive siblings at the depth
c567ac01
RS
4785into which they're being yanked, is adjusted.
4786
539d7736
JB
4787`allout-yank-pop' works with `allout-yank' just like normal `yank-pop'
4788works with normal `yank' in non-outline buffers."
1977b8f6
RS
4789
4790 (interactive "*P")
4791 (setq this-command 'yank)
48bd8440
EZ
4792 (allout-unprotected
4793 (yank arg))
fd5359c6 4794 (if (allout-mode-p)
48bd8440 4795 (allout-yank-processing)))
fd5359c6
MR
4796;;;_ > allout-yank-pop (&optional arg)
4797(defun allout-yank-pop (&optional arg)
2265e017 4798 "Yank-pop like `allout-yank' when popping to bare outline prefixes.
19b84ba3
RS
4799
4800Adapts level of popped topics to level of fresh prefix.
c567ac01 4801
60c7bbd2 4802Note -- prefix changes to distinctive bullets will stick, if followed
c567ac01 4803by pops to non-distinctive yanks. Bug..."
1977b8f6
RS
4804
4805 (interactive "*p")
1977b8f6 4806 (setq this-command 'yank)
c567ac01 4807 (yank-pop arg)
fd5359c6
MR
4808 (if (allout-mode-p)
4809 (allout-yank-processing)))
1977b8f6 4810
c567ac01
RS
4811;;;_ - Specialty bullet functions
4812;;;_ : File Cross references
fd5359c6
MR
4813;;;_ > allout-resolve-xref ()
4814(defun allout-resolve-xref ()
19b84ba3
RS
4815 "Pop to file associated with current heading, if it has an xref bullet.
4816
fd5359c6 4817\(Works according to setting of `allout-file-xref-bullet')."
1977b8f6 4818 (interactive)
fd5359c6 4819 (if (not allout-file-xref-bullet)
1977b8f6 4820 (error
60c7bbd2 4821 "Outline cross references disabled -- no `allout-file-xref-bullet'")
fd5359c6 4822 (if (not (string= (allout-current-bullet) allout-file-xref-bullet))
635ca796 4823 (error "Current heading lacks cross-reference bullet `%s'"
fd5359c6 4824 allout-file-xref-bullet)
0458fa80
EZ
4825 (let ((inhibit-field-text-motion t)
4826 file-name)
2a1408fd
DN
4827 (save-match-data
4828 (save-excursion
4829 (let* ((text-start allout-recent-prefix-end)
9b026d9f 4830 (heading-end (point-at-eol)))
2a1408fd
DN
4831 (goto-char text-start)
4832 (setq file-name
4833 (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
4834 (buffer-substring (match-beginning 1)
4835 (match-end 1)))))))
69027dea 4836 (setq file-name (expand-file-name file-name))
1977b8f6
RS
4837 (if (or (file-exists-p file-name)
4838 (if (file-writable-p file-name)
4839 (y-or-n-p (format "%s not there, create one? "
4840 file-name))
4841 (error "%s not found and can't be created" file-name)))
4842 (condition-case failure
4843 (find-file-other-window file-name)
d8350998 4844 (error failure))
1977b8f6
RS
4845 (error "%s not found" file-name))
4846 )
4847 )
4848 )
4849 )
19b84ba3 4850
9179616f 4851;;;_ #6 Exposure Control
c567ac01
RS
4852
4853;;;_ - Fundamental
d82979ea
EZ
4854;;;_ > allout-flag-region (from to flag)
4855(defun allout-flag-region (from to flag)
48bd8440
EZ
4856 "Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
4857
4858Exposure-change hook `allout-exposure-change-hook' is run with the same
c07583cd 4859arguments as this function, after the exposure changes are made. (The old
48bd8440 4860`allout-view-change-hook' is being deprecated, and eventually will not be
c07583cd 4861invoked.)"
96b83743 4862
96b83743 4863 ;; We use outline invisibility spec.
01fc9422 4864 (remove-overlays from to 'category 'allout-exposure-category)
96b83743 4865 (when flag
2a1408fd 4866 (let ((o (make-overlay from to nil 'front-advance)))
01fc9422 4867 (overlay-put o 'category 'allout-exposure-category)
96b83743 4868 (when (featurep 'xemacs)
01fc9422 4869 (let ((props (symbol-plist 'allout-exposure-category)))
96b83743 4870 (while props
1c9b9df0
KM
4871 (condition-case nil
4872 ;; as of 2008-02-27, xemacs lacks modification-hooks
4873 (overlay-put o (pop props) (pop props))
4874 (error nil)))))))
da506f05 4875 (run-hooks 'allout-view-change-hook)
48bd8440 4876 (run-hook-with-args 'allout-exposure-change-hook from to flag))
fd5359c6
MR
4877;;;_ > allout-flag-current-subtree (flag)
4878(defun allout-flag-current-subtree (flag)
96b83743 4879 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
19b84ba3 4880
c567ac01 4881 (save-excursion
fd5359c6 4882 (allout-back-to-current-heading)
0458fa80
EZ
4883 (let ((inhibit-field-text-motion t))
4884 (end-of-line))
96b83743
EZ
4885 (allout-flag-region (point)
4886 ;; Exposing must not leave trailing blanks hidden,
4887 ;; but can leave them exposed when hiding, so we
4888 ;; can use flag's inverse as the
4889 ;; include-trailing-blank cue:
4890 (allout-end-of-current-subtree (not flag))
4891 flag)))
c567ac01 4892
c567ac01 4893;;;_ - Topic-specific
01fc9422
EZ
4894;;;_ > allout-show-entry ()
4895(defun allout-show-entry ()
4896 "Like `allout-show-current-entry', but reveals entries in hidden topics.
c567ac01
RS
4897
4898This is a way to give restricted peek at a concealed locality without the
4899expense of exposing its context, but can leave the outline with aberrant
96b83743
EZ
4900exposure. `allout-show-offshoot' should be used after the peek to rectify
4901the exposure."
c567ac01
RS
4902
4903 (interactive)
4904 (save-excursion
96b83743 4905 (let (beg end)
d8350998 4906 (allout-goto-prefix-doublechecked)
96b83743
EZ
4907 (setq beg (if (allout-hidden-p) (1- (point)) (point)))
4908 (setq end (allout-pre-next-prefix))
4909 (allout-flag-region beg end nil)
9179616f 4910 (list beg end))))
fd5359c6
MR
4911;;;_ > allout-show-children (&optional level strict)
4912(defun allout-show-children (&optional level strict)
c567ac01
RS
4913
4914 "If point is visible, show all direct subheadings of this heading.
19b84ba3 4915
2265e017 4916Otherwise, do `allout-show-to-offshoot', and then show subheadings.
c567ac01
RS
4917
4918Optional LEVEL specifies how many levels below the current level
4919should be shown, or all levels if t. Default is 1.
4920
4921Optional STRICT means don't resort to -show-to-offshoot, no matter
4922what. This is basically so -show-to-offshoot, which is called by
4923this function, can employ the pure offspring-revealing capabilities of
19b84ba3
RS
4924it.
4925
4926Returns point at end of subtree that was opened, if any. (May get a
4927point of non-opened subtree?)"
c567ac01
RS
4928
4929 (interactive "p")
96b83743 4930 (let ((start-point (point)))
19b84ba3 4931 (if (and (not strict)
96b83743 4932 (allout-hidden-p))
c567ac01 4933
96b83743
EZ
4934 (progn (allout-show-to-offshoot) ; Point's concealed, open to
4935 ; expose it.
4936 ;; Then recurse, but with "strict" set so we don't
4937 ;; infinite regress:
4938 (allout-show-children level t))
c567ac01 4939
19b84ba3 4940 (save-excursion
96b83743
EZ
4941 (allout-beginning-of-current-line)
4942 (save-restriction
d8350998 4943 (let* (depth
65e7eb3d
EZ
4944 ;; translate the level spec for this routine to the ones
4945 ;; used by -chart-subtree and -chart-to-reveal:
4946 (chart-level (cond ((not level) 1)
4947 ((eq level t) nil)
4948 (t level)))
4949 (chart (allout-chart-subtree chart-level))
4950 (to-reveal (or (allout-chart-to-reveal chart chart-level)
d8350998
CY
4951 ;; interactive, show discontinuous children:
4952 (and chart
1c9b9df0 4953 (allout-called-interactively-p)
d8350998
CY
4954 (save-excursion
4955 (allout-back-to-current-heading)
4956 (setq depth (allout-current-depth))
4957 (and (allout-next-heading)
4958 (> allout-recent-depth
4959 (1+ depth))))
4960 (message
4961 "Discontinuous offspring; use `%s %s'%s."
4962 (substitute-command-keys
4963 "\\[universal-argument]")
4964 (substitute-command-keys
4965 "\\[allout-shift-out]")
4966 " to elevate them.")
4967 (allout-chart-to-reveal
4968 chart (- allout-recent-depth depth))))))
96b83743
EZ
4969 (goto-char start-point)
4970 (when (and strict (allout-hidden-p))
4971 ;; Concealed root would already have been taken care of,
4972 ;; unless strict was set.
4973 (allout-flag-region (point) (allout-snug-back) nil)
4974 (when allout-show-bodies
4975 (goto-char (car to-reveal))
4976 (allout-show-current-entry)))
4977 (while to-reveal
4978 (goto-char (car to-reveal))
4979 (allout-flag-region (save-excursion (allout-snug-back) (point))
4980 (progn (search-forward "\n" nil t)
4981 (1- (point)))
4982 nil)
4983 (when allout-show-bodies
4984 (goto-char (car to-reveal))
4985 (allout-show-current-entry))
4986 (setq to-reveal (cdr to-reveal)))))))
4987 ;; Compensate for `save-excursion's maintenance of point
4988 ;; within invisible text:
4989 (goto-char start-point)))
fd5359c6
MR
4990;;;_ > allout-show-to-offshoot ()
4991(defun allout-show-to-offshoot ()
2265e017 4992 "Like `allout-show-entry', but reveals all concealed ancestors, as well.
c567ac01 4993
96b83743 4994Useful for coherently exposing to a random point in a hidden region."
c567ac01
RS
4995 (interactive)
4996 (save-excursion
0458fa80
EZ
4997 (let ((inhibit-field-text-motion t)
4998 (orig-pt (point))
d8350998 4999 (orig-pref (allout-goto-prefix-doublechecked))
c567ac01 5000 (last-at (point))
65e7eb3d
EZ
5001 (bag-it 0))
5002 (while (or (> bag-it 1) (allout-hidden-p))
96b83743 5003 (while (allout-hidden-p)
d8350998 5004 (move-beginning-of-line 1)
96b83743 5005 (if (allout-hidden-p) (forward-char -1)))
c567ac01 5006 (if (= last-at (setq last-at (point)))
65e7eb3d
EZ
5007 ;; Oops, we're not making any progress! Show the current topic
5008 ;; completely, and try one more time here, if we haven't already.
c567ac01 5009 (progn (beginning-of-line)
fd5359c6 5010 (allout-show-current-subtree)
c567ac01 5011 (goto-char orig-pt)
65e7eb3d
EZ
5012 (setq bag-it (1+ bag-it))
5013 (if (> bag-it 1)
5014 (error "allout-show-to-offshoot: %s"
5015 "Stumped by aberrant nesting.")))
5016 (if (> bag-it 0) (setq bag-it 0))
d8350998
CY
5017 (allout-show-children)
5018 (goto-char orig-pref)))
19b84ba3 5019 (goto-char orig-pt)))
fd5359c6
MR
5020 (if (allout-hidden-p)
5021 (allout-show-entry)))
5022;;;_ > allout-hide-current-entry ()
5023(defun allout-hide-current-entry ()
c567ac01
RS
5024 "Hide the body directly following this heading."
5025 (interactive)
fd5359c6 5026 (allout-back-to-current-heading)
c567ac01 5027 (save-excursion
0458fa80
EZ
5028 (let ((inhibit-field-text-motion t))
5029 (end-of-line))
96b83743 5030 (allout-flag-region (point)
d82979ea 5031 (progn (allout-end-of-entry) (point))
96b83743 5032 t)))
fd5359c6
MR
5033;;;_ > allout-show-current-entry (&optional arg)
5034(defun allout-show-current-entry (&optional arg)
96b83743 5035 "Show body following current heading, or hide entry with universal argument."
c567ac01
RS
5036
5037 (interactive "P")
5038 (if arg
fd5359c6 5039 (allout-hide-current-entry)
96b83743 5040 (save-excursion (allout-show-to-offshoot))
c567ac01 5041 (save-excursion
fd5359c6 5042 (allout-flag-region (point)
96b83743
EZ
5043 (progn (allout-end-of-entry t) (point))
5044 nil)
d82979ea 5045 )))
fd5359c6
MR
5046;;;_ > allout-show-current-subtree (&optional arg)
5047(defun allout-show-current-subtree (&optional arg)
75bcb912
JB
5048 "Show everything within the current topic.
5049With a repeat-count, expose this topic and its siblings."
19b84ba3
RS
5050 (interactive "P")
5051 (save-excursion
fd5359c6 5052 (if (<= (allout-current-depth) 0)
60c7bbd2 5053 ;; Outside any topics -- try to get to the first:
fd5359c6 5054 (if (not (allout-next-heading))
6a05d05f 5055 (error "No topics")
60c7bbd2
RS
5056 ;; got to first, outermost topic -- set to expose it and siblings:
5057 (message "Above outermost topic -- exposing all.")
96b83743
EZ
5058 (allout-flag-region (point-min)(point-max) nil))
5059 (allout-beginning-of-current-line)
19b84ba3 5060 (if (not arg)
96b83743 5061 (allout-flag-current-subtree nil)
fd5359c6
MR
5062 (allout-beginning-of-level)
5063 (allout-expose-topic '(* :))))))
96b83743
EZ
5064;;;_ > allout-current-topic-collapsed-p (&optional include-single-liners)
5065(defun allout-current-topic-collapsed-p (&optional include-single-liners)
5066 "True if the currently visible containing topic is already collapsed.
5067
64686e6d
RS
5068Single line topics intrinsically can be considered as being both
5069collapsed and uncollapsed. If optional INCLUDE-SINGLE-LINERS is
5070true, then single-line topics are considered to be collapsed. By
5071default, they are treated as being uncollapsed."
2a1408fd
DN
5072 (save-match-data
5073 (save-excursion
5074 (and
5075 ;; Is the topic all on one line (allowing for trailing blank line)?
5076 (>= (progn (allout-back-to-current-heading)
5077 (move-end-of-line 1)
5078 (point))
5079 (allout-end-of-current-subtree (not (looking-at "\n\n"))))
5080
5081 (or include-single-liners
5082 (progn (backward-char 1) (allout-hidden-p)))))))
fd5359c6
MR
5083;;;_ > allout-hide-current-subtree (&optional just-close)
5084(defun allout-hide-current-subtree (&optional just-close)
19b84ba3 5085 "Close the current topic, or containing topic if this one is already closed.
c567ac01 5086
19b84ba3 5087If this topic is closed and it's a top level topic, close this topic
353e2ef2 5088and its siblings.
19b84ba3 5089
96b83743 5090If optional arg JUST-CLOSE is non-nil, do not close the parent or
19b84ba3 5091siblings, even if the target topic is already closed."
c567ac01
RS
5092
5093 (interactive)
96b83743 5094 (let* ((from (point))
60c7bbd2 5095 (sibs-msg "Top-level topic already closed -- closing siblings...")
96b83743
EZ
5096 (current-exposed (not (allout-current-topic-collapsed-p t))))
5097 (cond (current-exposed (allout-flag-current-subtree t))
5098 (just-close nil)
d8350998 5099 ((allout-ascend) (allout-hide-current-subtree))
96b83743
EZ
5100 (t (goto-char 0)
5101 (message sibs-msg)
d8350998 5102 (allout-goto-prefix-doublechecked)
96b83743
EZ
5103 (allout-expose-topic '(0 :))
5104 (message (concat sibs-msg " Done."))))
5105 (goto-char from)))
2a1408fd
DN
5106;;;_ > allout-toggle-current-subtree-exposure
5107(defun allout-toggle-current-subtree-exposure ()
5108 "Show or hide the current subtree depending on its current state."
5109 ;; thanks to tassilo for suggesting this.
5110 (interactive)
5111 (save-excursion
5112 (allout-back-to-heading)
5113 (if (allout-hidden-p (point-at-eol))
5114 (allout-show-current-subtree)
5115 (allout-hide-current-subtree))))
fd5359c6
MR
5116;;;_ > allout-show-current-branches ()
5117(defun allout-show-current-branches ()
c567ac01
RS
5118 "Show all subheadings of this heading, but not their bodies."
5119 (interactive)
0458fa80
EZ
5120 (let ((inhibit-field-text-motion t))
5121 (beginning-of-line))
fd5359c6
MR
5122 (allout-show-children t))
5123;;;_ > allout-hide-current-leaves ()
5124(defun allout-hide-current-leaves ()
353e2ef2 5125 "Hide the bodies of the current topic and all its offspring."
c567ac01 5126 (interactive)
fd5359c6
MR
5127 (allout-back-to-current-heading)
5128 (allout-hide-region-body (point) (progn (allout-end-of-current-subtree)
c567ac01
RS
5129 (point))))
5130
5131;;;_ - Region and beyond
fd5359c6
MR
5132;;;_ > allout-show-all ()
5133(defun allout-show-all ()
c567ac01
RS
5134 "Show all of the text in the buffer."
5135 (interactive)
19b84ba3 5136 (message "Exposing entire buffer...")
96b83743 5137 (allout-flag-region (point-min) (point-max) nil)
19b84ba3 5138 (message "Exposing entire buffer... Done."))
fd5359c6
MR
5139;;;_ > allout-hide-bodies ()
5140(defun allout-hide-bodies ()
c567ac01
RS
5141 "Hide all of buffer except headings."
5142 (interactive)
fd5359c6
MR
5143 (allout-hide-region-body (point-min) (point-max)))
5144;;;_ > allout-hide-region-body (start end)
5145(defun allout-hide-region-body (start end)
c567ac01 5146 "Hide all body lines in the region, but not headings."
2a1408fd
DN
5147 (save-match-data
5148 (save-excursion
5149 (save-restriction
5150 (narrow-to-region start end)
5151 (goto-char (point-min))
5152 (let ((inhibit-field-text-motion t))
5153 (while (not (eobp))
5154 (end-of-line)
5155 (allout-flag-region (point) (allout-end-of-entry) t)
5156 (if (not (eobp))
5157 (forward-char
5158 (if (looking-at "\n\n")
5159 2 1)))))))))
c567ac01 5160
fd5359c6
MR
5161;;;_ > allout-expose-topic (spec)
5162(defun allout-expose-topic (spec)
19b84ba3 5163 "Apply exposure specs to successive outline topic items.
c567ac01 5164
fd5359c6
MR
5165Use the more convenient frontend, `allout-new-exposure', if you don't
5166need evaluation of the arguments, or even better, the `allout-layout'
19b84ba3
RS
5167variable-keyed mode-activation/auto-exposure feature of allout outline
5168mode. See the respective documentation strings for more details.
c567ac01
RS
5169
5170Cursor is left at start position.
5171
19b84ba3
RS
5172SPEC is either a number or a list.
5173
5174Successive specs on a list are applied to successive sibling topics.
c567ac01 5175
c07583cd 5176A simple spec (either a number, one of a few symbols, or the null
19b84ba3
RS
5177list) dictates the exposure for the corresponding topic.
5178
5179Non-null lists recursively designate exposure specs for respective
5180subtopics of the current topic.
c567ac01 5181
353e2ef2 5182The `:' repeat spec is used to specify exposure for any number of
19b84ba3 5183successive siblings, up to the trailing ones for which there are
353e2ef2 5184explicit specs following the `:'.
c567ac01
RS
5185
5186Simple (numeric and null-list) specs are interpreted as follows:
5187
19b84ba3
RS
5188 Numbers indicate the relative depth to open the corresponding topic.
5189 - negative numbers force the topic to be closed before opening to the
5190 absolute value of the number, so all siblings are open only to
5191 that level.
5192 - positive numbers open to the relative depth indicated by the
5193 number, but do not force already opened subtopics to be closed.
60c7bbd2 5194 - 0 means to close topic -- hide all offspring.
353e2ef2 5195 : - `repeat'
c567ac01 5196 apply prior element to all siblings at current level, *up to*
353e2ef2 5197 those siblings that would be covered by specs following the `:'
c567ac01 5198 on the list. Ie, apply to all topics at level but the last
c07583cd 5199 ones. (Only first of multiple colons at same level is
60c7bbd2 5200 respected -- subsequent ones are discarded.)
19b84ba3
RS
5201 * - completely opens the topic, including bodies.
5202 + - shows all the sub headers, but not the bodies
5203 - - exposes the body of the corresponding topic.
c567ac01
RS
5204
5205Examples:
fd5359c6 5206\(allout-expose-topic '(-1 : 0))
c567ac01
RS
5207 Close this and all following topics at current level, exposing
5208 only their immediate children, but close down the last topic
5209 at this current level completely.
fd5359c6 5210\(allout-expose-topic '(-1 () : 1 0))
c567ac01
RS
5211 Close current topic so only the immediate subtopics are shown;
5212 show the children in the second to last topic, and completely
5213 close the last one.
fd5359c6 5214\(allout-expose-topic '(-2 : -1 *))
c567ac01
RS
5215 Expose children and grandchildren of all topics at current
5216 level except the last two; expose children of the second to
5217 last and completely open the last one."
5218
5219 (interactive "xExposure spec: ")
19b84ba3
RS
5220 (if (not (listp spec))
5221 nil
fd5359c6 5222 (let ((depth (allout-depth))
19b84ba3
RS
5223 (max-pos 0)
5224 prev-elem curr-elem
96b83743 5225 stay)
19b84ba3
RS
5226 (while spec
5227 (setq prev-elem curr-elem
5228 curr-elem (car spec)
5229 spec (cdr spec))
5230 (cond ; Do current element:
5231 ((null curr-elem) nil)
5232 ((symbolp curr-elem)
fd5359c6
MR
5233 (cond ((eq curr-elem '*) (allout-show-current-subtree)
5234 (if (> allout-recent-end-of-subtree max-pos)
5235 (setq max-pos allout-recent-end-of-subtree)))
65e7eb3d
EZ
5236 ((eq curr-elem '+)
5237 (if (not (allout-hidden-p))
5238 (save-excursion (allout-hide-current-subtree t)))
5239 (allout-show-current-branches)
fd5359c6
MR
5240 (if (> allout-recent-end-of-subtree max-pos)
5241 (setq max-pos allout-recent-end-of-subtree)))
5242 ((eq curr-elem '-) (allout-show-current-entry))
19b84ba3
RS
5243 ((eq curr-elem ':)
5244 (setq stay t)
353e2ef2 5245 ;; Expand the `repeat' spec to an explicit version,
19b84ba3
RS
5246 ;; w.r.t. remaining siblings:
5247 (let ((residue ; = # of sibs not covered by remaining spec
60c7bbd2 5248 ;; Dang, could be nice to make use of the chart, sigh:
fd5359c6 5249 (- (length (allout-chart-siblings))
19b84ba3
RS
5250 (length spec))))
5251 (if (< 0 residue)
60c7bbd2 5252 ;; Some residue -- cover it with prev-elem:
19b84ba3
RS
5253 (setq spec (append (make-list residue prev-elem)
5254 spec)))))))
5255 ((numberp curr-elem)
96b83743 5256 (if (and (>= 0 curr-elem) (not (allout-hidden-p)))
fd5359c6 5257 (save-excursion (allout-hide-current-subtree t)
19b84ba3
RS
5258 (if (> 0 curr-elem)
5259 nil
fd5359c6 5260 (if (> allout-recent-end-of-subtree max-pos)
19b84ba3 5261 (setq max-pos
fd5359c6 5262 allout-recent-end-of-subtree)))))
19b84ba3 5263 (if (> (abs curr-elem) 0)
fd5359c6
MR
5264 (progn (allout-show-children (abs curr-elem))
5265 (if (> allout-recent-end-of-subtree max-pos)
5266 (setq max-pos allout-recent-end-of-subtree)))))
19b84ba3 5267 ((listp curr-elem)
fd5359c6
MR
5268 (if (allout-descend-to-depth (1+ depth))
5269 (let ((got (allout-expose-topic curr-elem)))
19b84ba3
RS
5270 (if (and got (> got max-pos)) (setq max-pos got))))))
5271 (cond (stay (setq stay nil))
5272 ((listp (car spec)) nil)
5273 ((> max-pos (point))
5274 ;; Capitalize on max-pos state to get us nearer next sibling:
5275 (progn (goto-char (min (point-max) max-pos))
fd5359c6
MR
5276 (allout-next-heading)))
5277 ((allout-next-sibling depth))))
19b84ba3 5278 max-pos)))
fd5359c6
MR
5279;;;_ > allout-old-expose-topic (spec &rest followers)
5280(defun allout-old-expose-topic (spec &rest followers)
d82979ea 5281
c07583cd 5282 "Deprecated. Use `allout-expose-topic' (with different schema
d82979ea
EZ
5283format) instead.
5284
5285Dictate wholesale exposure scheme for current topic, according to SPEC.
c567ac01
RS
5286
5287SPEC is either a number or a list. Optional successive args
5288dictate exposure for subsequent siblings of current topic.
5289
5290A simple spec (either a number, a special symbol, or the null list)
5291dictates the overall exposure for a topic. Non null lists are
5292composite specs whose first element dictates the overall exposure for
5293a topic, with the subsequent elements in the list interpreted as specs
5294that dictate the exposure for the successive offspring of the topic.
5295
5296Simple (numeric and null-list) specs are interpreted as follows:
5297
5298 - Numbers indicate the relative depth to open the corresponding topic:
5299 - negative numbers force the topic to be close before opening to the
5300 absolute value of the number.
5301 - positive numbers just open to the relative depth indicated by the number.
5302 - 0 just closes
353e2ef2
KH
5303 - `*' completely opens the topic, including bodies.
5304 - `+' shows all the sub headers, but not the bodies
5305 - `-' exposes the body and immediate offspring of the corresponding topic.
c567ac01
RS
5306
5307If the spec is a list, the first element must be a number, which
5308dictates the exposure depth of the topic as a whole. Subsequent
5309elements of the list are nested SPECs, dictating the specific exposure
5310for the corresponding offspring of the topic.
5311
e126900f 5312Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
c567ac01
RS
5313
5314 (interactive "xExposure spec: ")
0458fa80
EZ
5315 (let ((inhibit-field-text-motion t)
5316 (depth (allout-current-depth))
c567ac01
RS
5317 max-pos)
5318 (cond ((null spec) nil)
5319 ((symbolp spec)
fd5359c6
MR
5320 (if (eq spec '*) (allout-show-current-subtree))
5321 (if (eq spec '+) (allout-show-current-branches))
5322 (if (eq spec '-) (allout-show-current-entry)))
c567ac01
RS
5323 ((numberp spec)
5324 (if (>= 0 spec)
fd5359c6 5325 (save-excursion (allout-hide-current-subtree t)
c567ac01
RS
5326 (end-of-line)
5327 (if (or (not max-pos)
5328 (> (point) max-pos))
5329 (setq max-pos (point)))
5330 (if (> 0 spec)
5331 (setq spec (* -1 spec)))))
5332 (if (> spec 0)
fd5359c6 5333 (allout-show-children spec)))
c567ac01 5334 ((listp spec)
fd5359c6 5335 ;(let ((got (allout-old-expose-topic (car spec))))
c567ac01
RS
5336 ; (if (and got (or (not max-pos) (> got max-pos)))
5337 ; (setq max-pos got)))
fd5359c6 5338 (let ((new-depth (+ (allout-current-depth) 1))
c567ac01 5339 got)
fd5359c6 5340 (setq max-pos (allout-old-expose-topic (car spec)))
c567ac01
RS
5341 (setq spec (cdr spec))
5342 (if (and spec
fd5359c6
MR
5343 (allout-descend-to-depth new-depth)
5344 (not (allout-hidden-p)))
5345 (progn (setq got (apply 'allout-old-expose-topic spec))
c567ac01
RS
5346 (if (and got (or (not max-pos) (> got max-pos)))
5347 (setq max-pos got)))))))
5348 (while (and followers
5349 (progn (if (and max-pos (< (point) max-pos))
5350 (progn (goto-char max-pos)
5351 (setq max-pos nil)))
5352 (end-of-line)
fd5359c6
MR
5353 (allout-next-sibling depth)))
5354 (allout-old-expose-topic (car followers))
c567ac01
RS
5355 (setq followers (cdr followers)))
5356 max-pos))
fd5359c6
MR
5357;;;_ > allout-new-exposure '()
5358(defmacro allout-new-exposure (&rest spec)
5359 "Literal frontend for `allout-expose-topic', doesn't evaluate arguments.
2265e017
MR
5360Some arguments that would need to be quoted in `allout-expose-topic'
5361need not be quoted in `allout-new-exposure'.
c567ac01
RS
5362
5363Cursor is left at start position.
5364
d82979ea
EZ
5365Use this instead of obsolete `allout-exposure'.
5366
c567ac01 5367Examples:
bff05d9e 5368\(allout-new-exposure (-1 () () () 1) 0)
c567ac01
RS
5369 Close current topic at current level so only the immediate
5370 subtopics are shown, except also show the children of the
5371 third subtopic; and close the next topic at the current level.
bff05d9e 5372\(allout-new-exposure : -1 0)
c567ac01
RS
5373 Close all topics at current level to expose only their
5374 immediate children, except for the last topic at the current
353e2ef2 5375 level, in which even its immediate children are hidden.
bff05d9e 5376\(allout-new-exposure -2 : -1 *)
c567ac01
RS
5377 Expose children and grandchildren of first topic at current
5378 level, and expose children of subsequent topics at current
5379 level *except* for the last, which should be opened completely."
5380 (list 'save-excursion
d8350998 5381 '(if (not (or (allout-goto-prefix-doublechecked)
fd5359c6
MR
5382 (allout-next-heading)))
5383 (error "allout-new-exposure: Can't find any outline topics"))
5384 (list 'allout-expose-topic (list 'quote spec))))
c567ac01 5385
60c7bbd2 5386;;;_ #7 Systematic outline presentation -- copying, printing, flattening
19b84ba3 5387
9179616f
DL
5388;;;_ - Mapping and processing of topics
5389;;;_ ( See also Subtree Charting, in Navigation code.)
fd5359c6
MR
5390;;;_ > allout-stringify-flat-index (flat-index)
5391(defun allout-stringify-flat-index (flat-index &optional context)
9179616f
DL
5392 "Convert list representing section/subsection/... to document string.
5393
5394Optional arg CONTEXT indicates interior levels to include."
5395 (let ((delim ".")
71296446 5396 result
9179616f
DL
5397 numstr
5398 (context-depth (or (and context 2) 1)))
5399 ;; Take care of the explicit context:
5400 (while (> context-depth 0)
5401 (setq numstr (int-to-string (car flat-index))
5402 flat-index (cdr flat-index)
5403 result (if flat-index
5404 (cons delim (cons numstr result))
5405 (cons numstr result))
5406 context-depth (if flat-index (1- context-depth) 0)))
5407 (setq delim " ")
5408 ;; Take care of the indentation:
5409 (if flat-index
5410 (progn
5411 (while flat-index
5412 (setq result
5413 (cons delim
5414 (cons (make-string
5415 (1+ (truncate (if (zerop (car flat-index))
5416 1
5417 (log10 (car flat-index)))))
5418 ? )
5419 result)))
5420 (setq flat-index (cdr flat-index)))
5421 ;; Dispose of single extra delim:
5422 (setq result (cdr result))))
5423 (apply 'concat result)))
fd5359c6
MR
5424;;;_ > allout-stringify-flat-index-plain (flat-index)
5425(defun allout-stringify-flat-index-plain (flat-index)
9179616f
DL
5426 "Convert list representing section/subsection/... to document string."
5427 (let ((delim ".")
5428 result)
5429 (while flat-index
5430 (setq result (cons (int-to-string (car flat-index))
5431 (if result
5432 (cons delim result))))
5433 (setq flat-index (cdr flat-index)))
5434 (apply 'concat result)))
fd5359c6
MR
5435;;;_ > allout-stringify-flat-index-indented (flat-index)
5436(defun allout-stringify-flat-index-indented (flat-index)
9179616f
DL
5437 "Convert list representing section/subsection/... to document string."
5438 (let ((delim ".")
71296446 5439 result
9179616f
DL
5440 numstr)
5441 ;; Take care of the explicit context:
5442 (setq numstr (int-to-string (car flat-index))
5443 flat-index (cdr flat-index)
5444 result (if flat-index
5445 (cons delim (cons numstr result))
5446 (cons numstr result)))
5447 (setq delim " ")
5448 ;; Take care of the indentation:
5449 (if flat-index
5450 (progn
5451 (while flat-index
5452 (setq result
5453 (cons delim
5454 (cons (make-string
5455 (1+ (truncate (if (zerop (car flat-index))
5456 1
5457 (log10 (car flat-index)))))
5458 ? )
5459 result)))
5460 (setq flat-index (cdr flat-index)))
5461 ;; Dispose of single extra delim:
5462 (setq result (cdr result))))
5463 (apply 'concat result)))
fd5359c6
MR
5464;;;_ > allout-listify-exposed (&optional start end format)
5465(defun allout-listify-exposed (&optional start end format)
19b84ba3 5466
9179616f 5467 "Produce a list representing exposed topics in current region.
c567ac01 5468
fd5359c6 5469This list can then be used by `allout-process-exposed' to manipulate
9179616f 5470the subject region.
353e2ef2 5471
9179616f 5472Optional START and END indicate bounds of region.
19b84ba3 5473
75bcb912 5474Optional arg, FORMAT, designates an alternate presentation form for
9179616f 5475the prefix:
c567ac01 5476
60c7bbd2 5477 list -- Present prefix as numeric section.subsection..., starting with
9179616f 5478 section indicated by the list, innermost nesting first.
60c7bbd2 5479 `indent' (symbol) -- Convert header prefixes to all white space,
9179616f 5480 except for distinctive bullets.
c567ac01 5481
9179616f
DL
5482The elements of the list produced are lists that represents a topic
5483header and body. The elements of that list are:
c567ac01 5484
9179616f
DL
5485 - a number representing the depth of the topic,
5486 - a string representing the header-prefix, including trailing whitespace and
5487 bullet.
5488 - a string representing the bullet character,
5489 - and a series of strings, each containing one line of the exposed
5490 portion of the topic entry."
c567ac01 5491
9179616f
DL
5492 (interactive "r")
5493 (save-excursion
5494 (let*
0458fa80
EZ
5495 ((inhibit-field-text-motion t)
5496 ;; state vars:
5497 strings prefix result depth new-depth out gone-out bullet beg
9179616f 5498 next done)
c567ac01 5499
9179616f
DL
5500 (goto-char start)
5501 (beginning-of-line)
5502 ;; Goto initial topic, and register preceeding stuff, if any:
d8350998 5503 (if (> (allout-goto-prefix-doublechecked) start)
60c7bbd2 5504 ;; First topic follows beginning point -- register preliminary stuff:
9179616f
DL
5505 (setq result (list (list 0 "" nil
5506 (buffer-substring start (1- (point)))))))
5507 (while (and (not done)
5508 (not (eobp)) ; Loop until we've covered the region.
5509 (not (> (point) end)))
d8350998 5510 (setq depth allout-recent-depth ; Current topics depth,
fd5359c6
MR
5511 bullet (allout-recent-bullet) ; ... bullet,
5512 prefix (allout-recent-prefix)
5513 beg (progn (allout-end-of-prefix t) (point))) ; and beginning.
9179616f 5514 (setq done ; The boundary for the current topic:
fd5359c6 5515 (not (allout-next-visible-heading 1)))
d8350998 5516 (setq new-depth allout-recent-depth)
9179616f
DL
5517 (setq gone-out out
5518 out (< new-depth depth))
5519 (beginning-of-line)
5520 (setq next (point))
5521 (goto-char beg)
5522 (setq strings nil)
5523 (while (> next (point)) ; Get all the exposed text in
5524 (setq strings
5525 (cons (buffer-substring
5526 beg
5527 ;To hidden text or end of line:
5528 (progn
96b83743
EZ
5529 (end-of-line)
5530 (allout-back-to-visible-text)))
9179616f 5531 strings))
96b83743 5532 (when (< (point) next) ; Resume from after hid text, if any.
1b4d97b2
CY
5533 (line-move 1)
5534 (beginning-of-line))
9179616f
DL
5535 (setq beg (point)))
5536 ;; Accumulate list for this topic:
5537 (setq strings (nreverse strings))
5538 (setq result
5539 (cons
5540 (if format
5541 (let ((special (if (string-match
5542 (regexp-quote bullet)
fd5359c6 5543 allout-distinctive-bullets-string)
9179616f
DL
5544 bullet)))
5545 (cond ((listp format)
5546 (list depth
fd5359c6
MR
5547 (if allout-abbreviate-flattened-numbering
5548 (allout-stringify-flat-index format
9179616f 5549 gone-out)
fd5359c6 5550 (allout-stringify-flat-index-plain
9179616f
DL
5551 format))
5552 strings
5553 special))
5554 ((eq format 'indent)
5555 (if special
5556 (list depth
5557 (concat (make-string (1+ depth) ? )
5558 (substring prefix -1))
5559 strings)
5560 (list depth
5561 (make-string depth ? )
5562 strings)))
fd5359c6 5563 (t (error "allout-listify-exposed: %s %s"
9179616f
DL
5564 "invalid format" format))))
5565 (list depth prefix strings))
5566 result))
5567 ;; Reasses format, if any:
5568 (if (and format (listp format))
5569 (cond ((= new-depth depth)
5570 (setq format (cons (1+ (car format))
5571 (cdr format))))
60c7bbd2 5572 ((> new-depth depth) ; descending -- assume by 1:
9179616f
DL
5573 (setq format (cons 1 format)))
5574 (t
5575 ; Pop the residue:
5576 (while (< new-depth depth)
5577 (setq format (cdr format))
5578 (setq depth (1- depth)))
5579 ; And increment the current one:
5580 (setq format
5581 (cons (1+ (or (car format)
5582 -1))
5583 (cdr format)))))))
5584 ;; Put the list with first at front, to last at back:
5585 (nreverse result))))
c60d543d
RS
5586;;;_ > allout-region-active-p ()
5587(defmacro allout-region-active-p ()
42c3e51c
KM
5588 (cond ((fboundp 'use-region-p) '(use-region-p))
5589 ((fboundp 'region-active-p) '(region-active-p))
5590 (t 'mark-active)))
5591;;_ > allout-process-exposed (&optional func from to frombuf
9179616f 5592;;; tobuf format)
fd5359c6 5593(defun allout-process-exposed (&optional func from to frombuf tobuf
96b83743 5594 format start-num)
9179616f 5595 "Map function on exposed parts of current topic; results to another buffer.
353e2ef2 5596
d82979ea
EZ
5597All args are options; default values itemized below.
5598
5599Apply FUNCTION to exposed portions FROM position TO position in buffer
9179616f
DL
5600FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
5601alternate presentation form:
c567ac01 5602
60c7bbd2 5603 `flat' -- Present prefix as numeric section.subsection..., starting with
75bcb912 5604 section indicated by the START-NUM, innermost nesting first.
60c7bbd2 5605 X`flat-indented' -- Prefix is like `flat' for first topic at each
9179616f
DL
5606 X level, but subsequent topics have only leaf topic
5607 X number, padded with blanks to line up with first.
60c7bbd2 5608 `indent' (symbol) -- Convert header prefixes to all white space,
9179616f 5609 except for distinctive bullets.
c567ac01 5610
9179616f 5611Defaults:
d82979ea 5612 FUNCTION: `allout-insert-listified'
9179616f
DL
5613 FROM: region start, if region active, else start of buffer
5614 TO: region end, if region active, else end of buffer
5615 FROMBUF: current buffer
5616 TOBUF: buffer name derived: \"*current-buffer-name exposed*\"
5617 FORMAT: nil"
5618
5619 ; Resolve arguments,
5620 ; defaulting if necessary:
fd5359c6 5621 (if (not func) (setq func 'allout-insert-listified))
9179616f 5622 (if (not (and from to))
c60d543d 5623 (if (allout-region-active-p)
9179616f
DL
5624 (setq from (region-beginning) to (region-end))
5625 (setq from (point-min) to (point-max))))
5626 (if frombuf
5627 (if (not (bufferp frombuf))
60c7bbd2 5628 ;; Specified but not a buffer -- get it:
9179616f
DL
5629 (let ((got (get-buffer frombuf)))
5630 (if (not got)
fd5359c6 5631 (error (concat "allout-process-exposed: source buffer "
9179616f
DL
5632 frombuf
5633 " not found."))
5634 (setq frombuf got))))
60c7bbd2 5635 ;; not specified -- default it:
9179616f
DL
5636 (setq frombuf (current-buffer)))
5637 (if tobuf
5638 (if (not (bufferp tobuf))
5639 (setq tobuf (get-buffer-create tobuf)))
60c7bbd2 5640 ;; not specified -- default it:
9179616f
DL
5641 (setq tobuf (concat "*" (buffer-name frombuf) " exposed*")))
5642 (if (listp format)
5643 (nreverse format))
5644
5645 (let* ((listified
5646 (progn (set-buffer frombuf)
fd5359c6 5647 (allout-listify-exposed from to format))))
9179616f 5648 (set-buffer tobuf)
5110e166 5649 (mapc func listified)
9179616f
DL
5650 (pop-to-buffer tobuf)))
5651
5652;;;_ - Copy exposed
fd5359c6
MR
5653;;;_ > allout-insert-listified (listified)
5654(defun allout-insert-listified (listified)
9179616f
DL
5655 "Insert contents of listified outline portion in current buffer.
5656
e126900f 5657LISTIFIED is a list representing each topic header and body:
9179616f
DL
5658
5659 \`(depth prefix text)'
5660
d82979ea 5661or \`(depth prefix text bullet-plus)'
9179616f
DL
5662
5663If `bullet-plus' is specified, it is inserted just after the entire prefix."
5664 (setq listified (cdr listified))
5665 (let ((prefix (prog1
5666 (car listified)
5667 (setq listified (cdr listified))))
5668 (text (prog1
5669 (car listified)
5670 (setq listified (cdr listified))))
5671 (bullet-plus (car listified)))
eac9cf5f
PJ
5672 (insert prefix)
5673 (if bullet-plus (insert (concat " " bullet-plus)))
9179616f 5674 (while text
eac9cf5f 5675 (insert (car text))
9179616f 5676 (if (setq text (cdr text))
0949617b 5677 (insert "\n")))
eac9cf5f 5678 (insert "\n")))
fd5359c6
MR
5679;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format)
5680(defun allout-copy-exposed-to-buffer (&optional arg tobuf format)
9179616f
DL
5681 "Duplicate exposed portions of current outline to another buffer.
5682
5683Other buffer has current buffers name with \" exposed\" appended to it.
5684
5685With repeat count, copy the exposed parts of only the current topic.
5686
5687Optional second arg TOBUF is target buffer name.
5688
5689Optional third arg FORMAT, if non-nil, symbolically designates an
5690alternate presentation format for the outline:
5691
5692 `flat' - Convert topic header prefixes to numeric
5693 section.subsection... identifiers.
5694 `indent' - Convert header prefixes to all white space, except for
5695 distinctive bullets.
5696 `indent-flat' - The best of both - only the first of each level has
5697 the full path, the rest have only the section number
5698 of the leaf, preceded by the right amount of indentation."
c567ac01
RS
5699
5700 (interactive "P")
5701 (if (not tobuf)
5702 (setq tobuf (get-buffer-create (concat "*" (buffer-name) " exposed*"))))
5703 (let* ((start-pt (point))
fd5359c6
MR
5704 (beg (if arg (allout-back-to-current-heading) (point-min)))
5705 (end (if arg (allout-end-of-current-subtree) (point-max)))
9179616f
DL
5706 (buf (current-buffer))
5707 (start-list ()))
5708 (if (eq format 'flat)
5709 (setq format (if arg (save-excursion
5710 (goto-char beg)
fd5359c6 5711 (allout-topic-flat-index))
9179616f 5712 '(1))))
7fdbcd83 5713 (with-current-buffer tobuf (erase-buffer))
fd5359c6 5714 (allout-process-exposed 'allout-insert-listified
c567ac01
RS
5715 beg
5716 end
5717 (current-buffer)
9179616f
DL
5718 tobuf
5719 format start-list)
c567ac01
RS
5720 (goto-char (point-min))
5721 (pop-to-buffer buf)
5722 (goto-char start-pt)))
fd5359c6
MR
5723;;;_ > allout-flatten-exposed-to-buffer (&optional arg tobuf)
5724(defun allout-flatten-exposed-to-buffer (&optional arg tobuf)
9179616f
DL
5725 "Present numeric outline of outline's exposed portions in another buffer.
5726
60c7bbd2 5727The resulting outline is not compatible with outline mode -- use
fd5359c6 5728`allout-copy-exposed-to-buffer' if you want that.
9179616f 5729
fd5359c6 5730Use `allout-indented-exposed-to-buffer' for indented presentation.
9179616f
DL
5731
5732With repeat count, copy the exposed portions of only current topic.
5733
e126900f 5734Other buffer has current buffer's name with \" exposed\" appended to
9179616f
DL
5735it, unless optional second arg TOBUF is specified, in which case it is
5736used verbatim."
5737 (interactive "P")
fd5359c6
MR
5738 (allout-copy-exposed-to-buffer arg tobuf 'flat))
5739;;;_ > allout-indented-exposed-to-buffer (&optional arg tobuf)
5740(defun allout-indented-exposed-to-buffer (&optional arg tobuf)
9179616f
DL
5741 "Present indented outline of outline's exposed portions in another buffer.
5742
60c7bbd2 5743The resulting outline is not compatible with outline mode -- use
fd5359c6 5744`allout-copy-exposed-to-buffer' if you want that.
9179616f 5745
fd5359c6 5746Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation.
9179616f
DL
5747
5748With repeat count, copy the exposed portions of only current topic.
5749
e126900f 5750Other buffer has current buffer's name with \" exposed\" appended to
9179616f
DL
5751it, unless optional second arg TOBUF is specified, in which case it is
5752used verbatim."
5753 (interactive "P")
fd5359c6 5754 (allout-copy-exposed-to-buffer arg tobuf 'indent))
c567ac01
RS
5755
5756;;;_ - LaTeX formatting
e126900f
JB
5757;;;_ > allout-latex-verb-quote (string &optional flow)
5758(defun allout-latex-verb-quote (string &optional flow)
539d7736 5759 "Return copy of STRING for literal reproduction across LaTeX processing.
c07583cd 5760Expresses the original characters (including carriage returns) of the
539d7736 5761string across LaTeX processing."
9179616f
DL
5762 (mapconcat (function
5763 (lambda (char)
c567ac01
RS
5764 (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
5765 (concat "\\char" (number-to-string char) "{}"))
5766 ((= char ?\n) "\\\\")
9179616f 5767 (t (char-to-string char)))))
e126900f 5768 string
c567ac01 5769 ""))
fd5359c6
MR
5770;;;_ > allout-latex-verbatim-quote-curr-line ()
5771(defun allout-latex-verbatim-quote-curr-line ()
c07583cd 5772 "Express line for exact (literal) representation across LaTeX processing.
19b84ba3 5773
c07583cd 5774Adjust line contents so it is unaltered (from the original line)
539d7736 5775across LaTeX processing, within the context of a `verbatim'
c567ac01 5776environment. Leaves point at the end of the line."
0458fa80
EZ
5777 (let ((inhibit-field-text-motion t))
5778 (beginning-of-line)
5779 (let ((beg (point))
626b459f 5780 (end (point-at-eol)))
2a1408fd
DN
5781 (save-match-data
5782 (while (re-search-forward "\\\\"
5783 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
5784 end ; bounded by end-of-line
5785 1) ; no matches, move to end & return nil
5786 (goto-char (match-beginning 2))
5787 (insert "\\")
5788 (setq end (1+ end))
5789 (goto-char (1+ (match-end 2))))))))
e126900f
JB
5790;;;_ > allout-insert-latex-header (buffer)
5791(defun allout-insert-latex-header (buffer)
539d7736 5792 "Insert initial LaTeX commands at point in BUFFER."
c567ac01
RS
5793 ;; Much of this is being derived from the stuff in appendix of E in
5794 ;; the TeXBook, pg 421.
e126900f 5795 (set-buffer buffer)
c567ac01
RS
5796 (let ((doc-style (format "\n\\documentstyle{%s}\n"
5797 "report"))
fd5359c6 5798 (page-numbering (if allout-number-pages
c567ac01
RS
5799 "\\pagestyle{empty}\n"
5800 ""))
c567ac01 5801 (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n"
fd5359c6 5802 allout-title-style))
c567ac01 5803 (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n"
fd5359c6 5804 allout-label-style))
c567ac01 5805 (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n"
fd5359c6 5806 allout-head-line-style))
c567ac01 5807 (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n"
fd5359c6 5808 allout-body-line-style))
c567ac01
RS
5809 (setlength (format "%s%s%s%s"
5810 "\\newlength{\\stepsize}\n"
5811 "\\setlength{\\stepsize}{"
fd5359c6 5812 allout-indent
c567ac01
RS
5813 "}\n"))
5814 (oneheadline (format "%s%s%s%s%s%s%s"
5815 "\\newcommand{\\OneHeadLine}[3]{%\n"
5816 "\\noindent%\n"
5817 "\\hspace*{#2\\stepsize}%\n"
5818 "\\labelcmd{#1}\\hspace*{.2cm}"
5819 "\\headlinecmd{#3}\\\\["
fd5359c6 5820 allout-line-skip
c567ac01
RS
5821 "]\n}\n"))
5822 (onebodyline (format "%s%s%s%s%s%s"
5823 "\\newcommand{\\OneBodyLine}[2]{%\n"
5824 "\\noindent%\n"
5825 "\\hspace*{#1\\stepsize}%\n"
5826 "\\bodylinecmd{#2}\\\\["
fd5359c6 5827 allout-line-skip
c567ac01
RS
5828 "]\n}\n"))
5829 (begindoc "\\begin{document}\n\\begin{center}\n")
5830 (title (format "%s%s%s%s"
5831 "\\titlecmd{"
fd5359c6 5832 (allout-latex-verb-quote (if allout-title
96b83743 5833 (condition-case nil
fd5359c6 5834 (eval allout-title)
d8350998 5835 (error "<unnamed buffer>"))
c567ac01
RS
5836 "Unnamed Outline"))
5837 "}\n"
5838 "\\end{center}\n\n"))
5839 (hsize "\\hsize = 7.5 true in\n")
5840 (hoffset "\\hoffset = -1.5 true in\n")
5841 (vspace "\\vspace{.1cm}\n\n"))
5842 (insert (concat doc-style
5843 page-numbering
5844 titlecmd
5845 labelcmd
5846 headlinecmd
5847 bodylinecmd
5848 setlength
5849 oneheadline
5850 onebodyline
5851 begindoc
5852 title
5853 hsize
5854 hoffset
5855 vspace)
5856 )))
e126900f
JB
5857;;;_ > allout-insert-latex-trailer (buffer)
5858(defun allout-insert-latex-trailer (buffer)
539d7736 5859 "Insert concluding LaTeX commands at point in BUFFER."
e126900f 5860 (set-buffer buffer)
c567ac01 5861 (insert "\n\\end{document}\n"))
fd5359c6
MR
5862;;;_ > allout-latexify-one-item (depth prefix bullet text)
5863(defun allout-latexify-one-item (depth prefix bullet text)
19b84ba3
RS
5864 "Insert LaTeX commands for formatting one outline item.
5865
9179616f 5866Args are the topics numeric DEPTH, the header PREFIX lead string, the
19b84ba3 5867BULLET string, and a list of TEXT strings for the body."
c567ac01
RS
5868 (let* ((head-line (if text (car text)))
5869 (body-lines (cdr text))
5870 (curr-line)
5871 body-content bop)
5872 ; Do the head line:
71296446 5873 (insert (concat "\\OneHeadLine{\\verb\1 "
d82979ea
EZ
5874 (allout-latex-verb-quote bullet)
5875 "\1}{"
5876 depth
5877 "}{\\verb\1 "
5878 (if head-line
5879 (allout-latex-verb-quote head-line)
5880 "")
5881 "\1}\n"))
c567ac01
RS
5882 (if (not body-lines)
5883 nil
eac9cf5f
PJ
5884 ;;(insert "\\beginlines\n")
5885 (insert "\\begin{verbatim}\n")
c567ac01
RS
5886 (while body-lines
5887 (setq curr-line (car body-lines))
5888 (if (and (not body-content)
5889 (not (string-match "^\\s-*$" curr-line)))
5890 (setq body-content t))
5891 ; Mangle any occurrences of
5892 ; "\end{verbatim}" in text,
5893 ; it's special:
5894 (if (and body-content
5895 (setq bop (string-match "\\end{verbatim}" curr-line)))
5896 (setq curr-line (concat (substring curr-line 0 bop)
5897 ">"
5898 (substring curr-line bop))))
eac9cf5f
PJ
5899 ;;(insert "|" (car body-lines) "|")
5900 (insert curr-line)
fd5359c6 5901 (allout-latex-verbatim-quote-curr-line)
eac9cf5f 5902 (insert "\n")
c567ac01
RS
5903 (setq body-lines (cdr body-lines)))
5904 (if body-content
5905 (setq body-content nil)
5906 (forward-char -1)
eac9cf5f 5907 (insert "\\ ")
c567ac01 5908 (forward-char 1))
eac9cf5f
PJ
5909 ;;(insert "\\endlines\n")
5910 (insert "\\end{verbatim}\n")
c567ac01 5911 )))
fd5359c6
MR
5912;;;_ > allout-latexify-exposed (arg &optional tobuf)
5913(defun allout-latexify-exposed (arg &optional tobuf)
539d7736 5914 "Format current topics exposed portions to TOBUF for LaTeX processing.
19b84ba3
RS
5915TOBUF defaults to a buffer named the same as the current buffer, but
5916with \"*\" prepended and \" latex-formed*\" appended.
c567ac01
RS
5917
5918With repeat count, copy the exposed portions of entire buffer."
5919
5920 (interactive "P")
5921 (if (not tobuf)
5922 (setq tobuf
5923 (get-buffer-create (concat "*" (buffer-name) " latexified*"))))
5924 (let* ((start-pt (point))
fd5359c6
MR
5925 (beg (if arg (point-min) (allout-back-to-current-heading)))
5926 (end (if arg (point-max) (allout-end-of-current-subtree)))
c567ac01
RS
5927 (buf (current-buffer)))
5928 (set-buffer tobuf)
1977b8f6 5929 (erase-buffer)
fd5359c6 5930 (allout-insert-latex-header tobuf)
c567ac01 5931 (goto-char (point-max))
fd5359c6 5932 (allout-process-exposed 'allout-latexify-one-item
c567ac01
RS
5933 beg
5934 end
5935 buf
5936 tobuf)
5937 (goto-char (point-max))
fd5359c6 5938 (allout-insert-latex-trailer tobuf)
1977b8f6 5939 (goto-char (point-min))
c567ac01
RS
5940 (pop-to-buffer buf)
5941 (goto-char start-pt)))
5942
d82979ea 5943;;;_ #8 Encryption
29fac3fe
KM
5944;;;_ > allout-toggle-current-subtree-encryption (&optional keymode-cue)
5945(defun allout-toggle-current-subtree-encryption (&optional keymode-cue)
5946 "Encrypt clear or decrypt encoded topic text.
5947
5948Allout uses emacs 'epg' libary to perform encryption. Symmetric
5949and keypair encryption are supported. All encryption is ascii
5950armored.
5951
075746e2
KM
5952Entry encryption defaults to symmetric key mode unless keypair
5953recipients are associated with the file \(see
5954`epa-file-encrypt-to') or the function is invoked with a
5955\(KEYMODE-CUE) universal argument greater than 1.
5956
5957When encrypting, KEYMODE-CUE universal argument greater than 1
5958causes prompting for recipients for public-key keypair
5959encryption. Selecting no recipients results in symmetric key
29fac3fe
KM
5960encryption.
5961
075746e2
KM
5962Further, encrypting with a KEYMODE-CUE universal argument greater
5963than 4 - eg, preceded by a doubled Ctrl-U - causes association of
5964the specified recipients with the file, replacing those currently
5965associated with it. This can be used to deassociate any
5966recipients with the file, by selecting no recipients in the
5967dialog.
5968
29fac3fe
KM
5969Encrypted topic's bullets are set to a `~' to signal that the
5970contents of the topic (body and subtopics, but not heading) is
5971pending encryption or encrypted. `*' asterisk immediately after
5972the bullet signals that the body is encrypted, its absence means
5973the topic is meant to be encrypted but is not currently. When a
5974file with topics pending encryption is saved, topics pending
5975encryption are encrypted. See allout-encrypt-unencrypted-on-saves
5976for auto-encryption specifics.
0949617b 5977
6eb0a10d 5978\*NOTE WELL* that automatic encryption that happens during saves will
60c7bbd2 5979default to symmetric encryption -- you must deliberately (re)encrypt key-pair
0949617b 5980encrypted topics if you want them to continue to use the key-pair cipher.
d82979ea 5981
d8350998 5982Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
d82979ea 5983encrypted. If you want to encrypt the contents of a top-level topic, use
29fac3fe 5984\\[allout-shift-in] to increase its depth."
69027dea
EZ
5985 (interactive "P")
5986 (save-excursion
5987 (allout-back-to-current-heading)
29fac3fe
KM
5988 (allout-toggle-subtree-encryption keymode-cue)))
5989;;;_ > allout-toggle-subtree-encryption (&optional keymode-cue)
5990(defun allout-toggle-subtree-encryption (&optional keymode-cue)
c07583cd 5991 "Encrypt clear text or decrypt encoded topic contents (body and subtopics.)
69027dea 5992
075746e2
KM
5993Entry encryption defaults to symmetric key mode unless keypair
5994recipients are associated with the file \(see
5995`epa-file-encrypt-to') or the function is invoked with a
5996\(KEYMODE-CUE) universal argument greater than 1.
69027dea 5997
075746e2
KM
5998When encrypting, KEYMODE-CUE universal argument greater than 1
5999causes prompting for recipients for public-key keypair
6000encryption. Selecting no recipients results in symmetric key
6001encryption.
69027dea 6002
075746e2
KM
6003Further, encrypting with a KEYMODE-CUE universal argument greater
6004than 4 - eg, preceded by a doubled Ctrl-U - causes association of
6005the specified recipients with the file, replacing those currently
6006associated with it. This can be used to deassociate any
6007recipients with the file, by selecting no recipients in the
6008dialog.
6009
6010Encryption and decryption uses the emacs epg library.
69027dea 6011
29fac3fe 6012Encrypted text will be ascii-armored.
69027dea
EZ
6013
6014See `allout-toggle-current-subtree-encryption' for more details."
d82979ea
EZ
6015
6016 (interactive "P")
6017 (save-excursion
6018 (allout-end-of-prefix t)
6019
d8350998 6020 (if (= allout-recent-depth 1)
d82979ea
EZ
6021 (error (concat "Cannot encrypt or decrypt level 1 topics -"
6022 " shift it in to make it encryptable")))
6023
d82979ea 6024 (let* ((allout-buffer (current-buffer))
498a6493 6025 ;; Assess location:
d8350998 6026 (bullet-pos allout-recent-prefix-beginning)
d82979ea
EZ
6027 (after-bullet-pos (point))
6028 (was-encrypted
6029 (progn (if (= (point-max) after-bullet-pos)
6030 (error "no body to encrypt"))
0949617b 6031 (allout-encrypted-topic-p)))
96b83743 6032 (was-collapsed (if (not (search-forward "\n" nil t))
d82979ea
EZ
6033 nil
6034 (backward-char 1)
96b83743 6035 (allout-hidden-p)))
d82979ea
EZ
6036 (subtree-beg (1+ (point)))
6037 (subtree-end (allout-end-of-subtree))
6038 (subject-text (buffer-substring-no-properties subtree-beg
6039 subtree-end))
6040 (subtree-end-char (char-after (1- subtree-end)))
96b83743 6041 (subtree-trailing-char (char-after subtree-end))
60c7bbd2 6042 ;; kluge -- result-text needs to be nil, but we also want to
96b83743
EZ
6043 ;; check for the error condition
6044 (result-text (if (or (string= "" subject-text)
6045 (string= "\n" subject-text))
6046 (error "No topic contents to %scrypt"
6047 (if was-encrypted "de" "en"))
6048 nil))
d82979ea 6049 ;; Assess key parameters:
498a6493
CY
6050 (was-coding-system buffer-file-coding-system))
6051
6052 (when (not was-encrypted)
6053 ;; ensure that non-ascii chars pending encryption are noticed before
116f996b 6054 ;; they're encrypted, so the coding system is set to accommodate
498a6493
CY
6055 ;; them.
6056 (setq buffer-file-coding-system
1c9b9df0 6057 (allout-select-safe-coding-system subtree-beg subtree-end))
498a6493
CY
6058 ;; if the coding system for the text being encrypted is different
6059 ;; than that prevailing, then there a real risk that the coding
6060 ;; system can't be noticed by emacs when the file is visited. to
6061 ;; mitigate that, offer to preserve the coding system using a file
6062 ;; local variable.
6063 (if (and (not (equal buffer-file-coding-system
6064 was-coding-system))
6065 (yes-or-no-p
6066 (format (concat "Register coding system %s as file local"
6067 " var? Necessary when only encrypted text"
6068 " is in that coding system. ")
6069 buffer-file-coding-system)))
6070 (allout-adjust-file-variable "buffer-file-coding-system"
6071 buffer-file-coding-system)))
d82979ea
EZ
6072
6073 (setq result-text
6074 (allout-encrypt-string subject-text was-encrypted
075746e2 6075 (current-buffer) keymode-cue))
d82979ea
EZ
6076
6077 ;; Replace the subtree with the processed product.
6078 (allout-unprotected
6079 (progn
6080 (set-buffer allout-buffer)
6081 (delete-region subtree-beg subtree-end)
6082 (insert result-text)
6083 (if was-collapsed
96b83743
EZ
6084 (allout-flag-region (1- subtree-beg) (point) t))
6085 ;; adjust trailing-blank-lines to preserve topic spacing:
d82979ea 6086 (if (not was-encrypted)
96b83743
EZ
6087 (if (and (= subtree-end-char ?\n)
6088 (= subtree-trailing-char ?\n))
6089 (insert subtree-trailing-char)))
d82979ea
EZ
6090 ;; Ensure that the item has an encrypted-entry bullet:
6091 (if (not (string= (buffer-substring-no-properties
6092 (1- after-bullet-pos) after-bullet-pos)
6093 allout-topic-encryption-bullet))
6094 (progn (goto-char (1- after-bullet-pos))
6095 (delete-char 1)
6096 (insert allout-topic-encryption-bullet)))
6097 (if was-encrypted
6098 ;; Remove the is-encrypted bullet qualifier:
6099 (progn (goto-char after-bullet-pos)
6100 (delete-char 1))
6101 ;; Add the is-encrypted bullet qualifier:
6102 (goto-char after-bullet-pos)
d8350998 6103 (insert "*"))))
1b4d97b2
CY
6104 (run-hook-with-args 'allout-structure-added-hook
6105 bullet-pos subtree-end))))
075746e2 6106;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue
29fac3fe 6107;;; &optional rejected)
075746e2 6108(defun allout-encrypt-string (text decrypt allout-buffer keymode-cue
29fac3fe 6109 &optional rejected)
0949617b 6110 "Encrypt or decrypt message TEXT.
d82979ea 6111
ff3e8c8e 6112Returns the resulting string, or nil if the transformation fails.
d82979ea 6113
ff3e8c8e 6114If DECRYPT is true (default false), then decrypt instead of encrypt.
d82979ea 6115
ff3e8c8e 6116ALLOUT-BUFFER identifies the buffer containing the text.
d82979ea 6117
075746e2
KM
6118Entry encryption defaults to symmetric key mode unless keypair
6119recipients are associated with the file \(see
6120`epa-file-encrypt-to') or the function is invoked with a
6121\(KEYMODE-CUE) universal argument greater than 1.
d82979ea 6122
075746e2
KM
6123When encrypting, KEYMODE-CUE universal argument greater than 1
6124causes prompting for recipients for public-key keypair
6125encryption. Selecting no recipients results in symmetric key
6126encryption.
0949617b 6127
075746e2
KM
6128Further, encrypting with a KEYMODE-CUE universal argument greater
6129than 4 - eg, preceded by a doubled Ctrl-U - causes association of
6130the specified recipients with the file, replacing those currently
6131associated with it. This can be used to deassociate any
6132recipients with the file, by selecting no recipients in the
6133dialog.
d82979ea 6134
29fac3fe 6135Optional REJECTED is for internal use, to convey the number of
48bd8440
EZ
6136rejections due to matches against
6137`allout-encryption-ciphertext-rejection-regexps', as limited by
6138`allout-encryption-ciphertext-rejection-ceiling'.
6139
2576c28f
KM
6140NOTE: A few GnuPG v2 versions improperly preserve incorrect
6141symmetric decryption keys, preventing entry of the correct key on
6142subsequent decryption attempts until the cache times-out. That
6143can take several minutes. \(Decryption of other entries is not
6144affected.) Upgrade your EasyPG version, if you can, and you can
6145deliberately clear your gpg-agent's cache by sending it a '-HUP'
6146signal."
48bd8440 6147
ff3e8c8e 6148 (require 'epg)
29fac3fe 6149 (require 'epa)
0949617b 6150
075746e2
KM
6151 (let* ((epg-context (let* ((context (epg-make-context nil t)))
6152 (epg-context-set-passphrase-callback
6153 context #'epa-passphrase-callback-function)
6154 context))
498a6493
CY
6155 (encoding (with-current-buffer allout-buffer
6156 buffer-file-coding-system))
6157 (multibyte (with-current-buffer allout-buffer
ff3e8c8e 6158 enable-multibyte-characters))
29fac3fe
KM
6159 ;; "sanitization" avoids encryption results that are outline structure.
6160 (sani-regexps 'allout-encryption-plaintext-sanitization-regexps)
6161 (strip-plaintext-regexps (if (not decrypt)
6162 (allout-get-configvar-values
6163 sani-regexps)))
6164 (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps)
6165 (reject-ciphertext-regexps (if (not decrypt)
6166 (allout-get-configvar-values
6167 rejection-regexps)))
48bd8440
EZ
6168 (rejected (or rejected 0))
6169 (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
6170 rejected))
075746e2
KM
6171 (keypair-mode (cond (decrypt 'decrypting)
6172 ((<= (prefix-numeric-value keymode-cue) 1)
6173 'default)
6174 ((<= (prefix-numeric-value keymode-cue) 4)
6175 'prompt)
6176 ((> (prefix-numeric-value keymode-cue) 4)
6177 'prompt-save)))
6178 (keypair-message (concat "Select encryption recipients.\n"
6179 "Symmetric encryption is done if no"
6180 " recipients are selected. "))
6181 (encrypt-to (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to))
29fac3fe
KM
6182 recipients
6183 massaged-text
6184 result-text
38b2ca53 6185 )
0949617b 6186
ff3e8c8e
KM
6187 ;; Massage the subject text for encoding and filtering.
6188 (with-temp-buffer
6189 (insert text)
6190 ;; convey the text characteristics of the original buffer:
6191 (allout-set-buffer-multibyte multibyte)
6192 (when encoding
6193 (set-buffer-file-coding-system encoding)
6194 (if (not decrypt)
6195 (encode-coding-region (point-min) (point-max) encoding)))
6196
6197 ;; remove sanitization regexps matches before encrypting:
6198 (when (and strip-plaintext-regexps (not decrypt))
6199 (dolist (re strip-plaintext-regexps)
6200 (let ((re (if (listp re) (car re) re))
6201 (replacement (if (listp re) (cadr re) "")))
6202 (goto-char (point-min))
6203 (save-match-data
6204 (while (re-search-forward re nil t)
6205 (replace-match replacement nil nil))))))
6206 (setq massaged-text (buffer-substring-no-properties (point-min)
6207 (point-max))))
075746e2
KM
6208 ;; determine key mode and, if keypair, recipients:
6209 (setq recipients
6210 (case keypair-mode
6211
6212 (decrypting nil)
6213
6214 (default (if encrypt-to (epg-list-keys epg-context encrypt-to)))
6215
6216 ((prompt prompt-save)
6217 (save-window-excursion
6218 (epa-select-keys epg-context keypair-message)))))
6219
ff3e8c8e 6220 (setq result-text
ff3e8c8e 6221 (if decrypt
ff3e8c8e
KM
6222 (epg-decrypt-string epg-context
6223 (encode-coding-string massaged-text
6224 (or encoding 'utf-8)))
ff3e8c8e
KM
6225 (epg-encrypt-string epg-context
6226 (encode-coding-string massaged-text
6227 (or encoding 'utf-8))
075746e2 6228 recipients)))
ff3e8c8e
KM
6229
6230 ;; validate result -- non-empty
075746e2
KM
6231 (if (not result-text)
6232 (error "%scryption failed." (if decrypt "De" "En")))
6233
29fac3fe 6234
075746e2
KM
6235 (when (eq keypair-mode 'prompt-save)
6236 ;; set epa-file-encrypt-to in the buffer:
6237 (setq epa-file-encrypt-to (mapcar (lambda (key)
6238 (epg-user-id-string
6239 (car (epg-key-user-id-list key))))
6240 recipients))
6241 ;; change the file variable:
6242 (allout-adjust-file-variable "epa-file-encrypt-to" epa-file-encrypt-to))
d82979ea 6243
075746e2 6244 (cond
29fac3fe
KM
6245 ;; Retry (within limit) if ciphertext contains rejections:
6246 ((and (not decrypt)
6247 ;; Check for disqualification of this ciphertext:
6248 (let ((regexps reject-ciphertext-regexps)
6249 reject-it)
6250 (while (and regexps (not reject-it))
6251 (setq reject-it (string-match (car regexps) result-text))
6252 (pop regexps))
6253 reject-it))
6254 (setq rejections-left (1- rejections-left))
6255 (if (<= rejections-left 0)
6256 (error (concat "Ciphertext rejected too many times"
6257 " (%s), per `%s'")
6258 allout-encryption-ciphertext-rejection-ceiling
6259 'allout-encryption-ciphertext-rejection-regexps)
6260 ;; try again (gpg-agent may have the key cached):
6261 (allout-encrypt-string text decrypt allout-buffer keypair-mode
6262 (1+ rejected))))
6263
6264 ;; Barf if encryption yields extraordinary control chars:
6265 ((and (not decrypt)
6266 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
6267 result-text))
6268 (error (concat "Encryption produced non-armored text, which"
6269 "conflicts with allout mode -- reconfigure!")))
6270
6271 (t result-text))))
d82979ea
EZ
6272;;;_ > allout-encrypted-topic-p ()
6273(defun allout-encrypted-topic-p ()
6274 "True if the current topic is encryptable and encrypted."
6275 (save-excursion
6276 (allout-end-of-prefix t)
6277 (and (string= (buffer-substring-no-properties (1- (point)) (point))
6278 allout-topic-encryption-bullet)
2a1408fd 6279 (save-match-data (looking-at "\\*")))
d82979ea
EZ
6280 )
6281 )
d82979ea
EZ
6282;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
6283(defun allout-next-topic-pending-encryption (&optional except-mark)
6284 "Return the point of the next topic pending encryption, or nil if none.
6285
6286EXCEPT-MARK identifies a point whose containing topics should be excluded
6287from encryption. This supports 'except-current mode of
6288`allout-encrypt-unencrypted-on-saves'.
6289
75bcb912 6290Such a topic has the `allout-topic-encryption-bullet' without an
d82979ea
EZ
6291immediately following '*' that would mark the topic as being encrypted. It
6292must also have content."
6293 (let (done got content-beg)
2a1408fd
DN
6294 (save-match-data
6295 (while (not done)
d82979ea 6296
2a1408fd
DN
6297 (if (not (re-search-forward
6298 (format "\\(\\`\\|\n\\)%s *%s[^*]"
6299 (regexp-quote allout-header-prefix)
6300 (regexp-quote allout-topic-encryption-bullet))
6301 nil t))
6302 (setq got nil
6303 done t)
6304 (goto-char (setq got (match-beginning 0)))
6305 (if (save-match-data (looking-at "\n"))
6306 (forward-char 1))
6307 (setq got (point)))
6308
6309 (cond ((not got)
6310 (setq done t))
6311
6312 ((not (search-forward "\n"))
6313 (setq got nil
6314 done t))
6315
6316 ((eobp)
6317 (setq got nil
6318 done t))
6319
6320 (t
6321 (setq content-beg (point))
6322 (backward-char 1)
6323 (allout-end-of-subtree)
6324 (if (or (<= (point) content-beg)
6325 (and except-mark
6326 (<= content-beg except-mark)
6327 (>= (point) except-mark)))
6328 ;; Continue looking
6329 (setq got nil)
6330 ;; Got it!
6331 (setq done t)))
6332 )
6333 )
6334 (if got
6335 (goto-char got))
d82979ea 6336 )
d82979ea
EZ
6337 )
6338 )
6339;;;_ > allout-encrypt-decrypted (&optional except-mark)
6340(defun allout-encrypt-decrypted (&optional except-mark)
6341 "Encrypt topics pending encryption except those containing exemption point.
6342
6343EXCEPT-MARK identifies a point whose containing topics should be excluded
60c7bbd2 6344from encryption. This supports the `except-current' mode of
d82979ea
EZ
6345`allout-encrypt-unencrypted-on-saves'.
6346
6347If a topic that is currently being edited was encrypted, we return a list
6348containing the location of the topic and the location of the cursor just
6349before the topic was encrypted. This can be used, eg, to decrypt the topic
6350and exactly resituate the cursor if this is being done as part of a file
6351save. See `allout-encrypt-unencrypted-on-saves' for more info."
6352
6353 (interactive "p")
2a1408fd
DN
6354 (save-match-data
6355 (save-excursion
6356 (let* ((current-mark (point-marker))
6357 (current-mark-position (marker-position current-mark))
6358 was-modified
6359 bo-subtree
6360 editing-topic editing-point)
6361 (goto-char (point-min))
6362 (while (allout-next-topic-pending-encryption except-mark)
6363 (setq was-modified (buffer-modified-p))
6364 (when (save-excursion
6365 (and (boundp 'allout-encrypt-unencrypted-on-saves)
6366 allout-encrypt-unencrypted-on-saves
6367 (setq bo-subtree (re-search-forward "$"))
6368 (not (allout-hidden-p))
6369 (>= current-mark (point))
6370 (allout-end-of-current-subtree)
6371 (<= current-mark (point))))
d82979ea
EZ
6372 (setq editing-topic (point)
6373 ;; we had to wait for this 'til now so prior topics are
6374 ;; encrypted, any relevant text shifts are in place:
96b83743
EZ
6375 editing-point (- current-mark-position
6376 (count-trailing-whitespace-region
6377 bo-subtree current-mark-position))))
2a1408fd
DN
6378 (allout-toggle-subtree-encryption)
6379 (if (not was-modified)
6380 (set-buffer-modified-p nil))
6381 )
d82979ea
EZ
6382 (if (not was-modified)
6383 (set-buffer-modified-p nil))
2a1408fd 6384 (if editing-topic (list editing-topic editing-point))
d82979ea 6385 )
d82979ea
EZ
6386 )
6387 )
6388 )
6389
6390;;;_ #9 miscellaneous
d8350998
CY
6391;;;_ : Mode:
6392;;;_ > outlineify-sticky ()
19b84ba3 6393;; outlinify-sticky is correct spelling; provide this alias for sticklers:
0949617b 6394;;;###autoload
19b84ba3 6395(defalias 'outlinify-sticky 'outlineify-sticky)
0949617b 6396;;;###autoload
c567ac01 6397(defun outlineify-sticky (&optional arg)
a0776d6b 6398 "Activate outline mode and establish file var so it is started subsequently.
1977b8f6 6399
fd5359c6 6400See doc-string for `allout-layout' and `allout-init' for details on
19b84ba3
RS
6401setup for auto-startup."
6402
6403 (interactive "P")
6404
2576c28f
KM
6405 (if (allout-mode-p) (allout-mode)) ; deactivate so we can re-activate...
6406 (allout-mode)
19b84ba3
RS
6407
6408 (save-excursion
6409 (goto-char (point-min))
ede4ac6a 6410 (if (allout-goto-prefix)
19b84ba3 6411 t
fd5359c6 6412 (allout-open-topic 2)
60c7bbd2 6413 (insert (concat "Dummy outline topic header -- see"
d82979ea
EZ
6414 "`allout-mode' docstring: `^Hm'."))
6415 (allout-adjust-file-variable
4034b0e2 6416 "allout-layout" (or allout-layout '(-1 : 0))))))
d8350998 6417;;;_ > allout-file-vars-section-data ()
d82979ea
EZ
6418(defun allout-file-vars-section-data ()
6419 "Return data identifying the file-vars section, or nil if none.
6420
60c7bbd2 6421Returns a list of the form (BEGINNING-POINT PREFIX-STRING SUFFIX-STRING)."
d82979ea
EZ
6422 ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function.
6423 (let (beg prefix suffix)
6424 (save-excursion
1977b8f6 6425 (goto-char (point-max))
d82979ea
EZ
6426 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
6427 (if (let ((case-fold-search t))
6428 (not (search-forward "Local Variables:" nil t)))
6429 nil
6430 (setq beg (- (point) 16))
6431 (setq suffix (buffer-substring-no-properties
6432 (point)
96b83743 6433 (progn (if (search-forward "\n" nil t)
d82979ea
EZ
6434 (forward-char -1))
6435 (point))))
6436 (setq prefix (buffer-substring-no-properties
96b83743 6437 (progn (if (search-backward "\n" nil t)
d82979ea
EZ
6438 (forward-char 1))
6439 (point))
6440 beg))
6441 (list beg prefix suffix))
6442 )
6443 )
6444 )
d8350998 6445;;;_ > allout-adjust-file-variable (varname value)
d82979ea 6446(defun allout-adjust-file-variable (varname value)
a0a022d5 6447 "Adjust the setting of an Emacs file variable named VARNAME to VALUE.
d82979ea
EZ
6448
6449This activity is inhibited if either `enable-local-variables'
6450`allout-enable-file-variable-adjustment' are nil.
6451
6452When enabled, an entry for the variable is created if not already present,
6453or changed if established with a different value. The section for the file
6454variables, itself, is created if not already present. When created, the
c07583cd 6455section lines (including the section line) exist as second-level topics in
d82979ea
EZ
6456a top-level topic at the end of the file.
6457
a0a022d5 6458`enable-local-variables' must be true for any of this to happen."
d82979ea
EZ
6459 (if (not (and enable-local-variables
6460 allout-enable-file-variable-adjustment))
6461 nil
6462 (save-excursion
0458fa80
EZ
6463 (let ((inhibit-field-text-motion t)
6464 (section-data (allout-file-vars-section-data))
d82979ea
EZ
6465 beg prefix suffix)
6466 (if section-data
6467 (setq beg (car section-data)
6468 prefix (cadr section-data)
6469 suffix (car (cddr section-data)))
6470 ;; create the section
6471 (goto-char (point-max))
6472 (open-line 1)
6473 (allout-open-topic 0)
6474 (end-of-line)
6475 (insert "Local emacs vars.\n")
6476 (allout-open-topic 1)
6477 (setq beg (point)
6478 suffix ""
6479 prefix (buffer-substring-no-properties (progn
6480 (beginning-of-line)
6481 (point))
6482 beg))
6483 (goto-char beg)
6484 (insert "Local variables:\n")
6485 (allout-open-topic 0)
6486 (insert "End:\n")
6487 )
6488 ;; look for existing entry or create one, leaving point for insertion
6489 ;; of new value:
6490 (goto-char beg)
6491 (allout-show-to-offshoot)
6492 (if (search-forward (concat "\n" prefix varname ":") nil t)
6493 (let* ((value-beg (point))
96b83743 6494 (line-end (progn (if (search-forward "\n" nil t)
d82979ea
EZ
6495 (forward-char -1))
6496 (point)))
6497 (value-end (- line-end (length suffix))))
6498 (if (> value-end value-beg)
6499 (delete-region value-beg value-end)))
6500 (end-of-line)
6501 (open-line 1)
6502 (forward-line 1)
6503 (insert (concat prefix varname ":")))
6504 (insert (format " %S%s" value suffix))
6505 )
6506 )
6507 )
6508 )
d8350998
CY
6509;;;_ > allout-get-configvar-values (varname)
6510(defun allout-get-configvar-values (configvar-name)
6511 "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
6512
6513The user is prompted for removal of symbols that are unbound, and they
6514otherwise are ignored.
6515
6516CONFIGVAR-NAME should be the name of the configuration variable,
6517not its value."
6518
6519 (let ((configvar-value (symbol-value configvar-name))
6520 got)
6521 (dolist (sym configvar-value)
6522 (if (not (boundp sym))
60c7bbd2 6523 (if (yes-or-no-p (format "%s entry `%s' is unbound -- remove it? "
d8350998
CY
6524 configvar-name sym))
6525 (delq sym (symbol-value configvar-name)))
6526 (push (symbol-value sym) got)))
6527 (reverse got)))
6528;;;_ : Topics:
6529;;;_ > allout-mark-topic ()
6530(defun allout-mark-topic ()
6531 "Put the region around topic currently containing point."
6532 (interactive)
6533 (let ((inhibit-field-text-motion t))
6534 (beginning-of-line))
6535 (allout-goto-prefix-doublechecked)
6536 (push-mark (point))
6537 (allout-end-of-current-subtree)
6538 (exchange-point-and-mark))
6539;;;_ : UI:
6540;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
1977b8f6 6541(defun solicit-char-in-string (prompt string &optional do-defaulting)
c567ac01 6542 "Solicit (with first arg PROMPT) choice of a character from string STRING.
1977b8f6 6543
c567ac01 6544Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
1977b8f6
RS
6545
6546 (let ((new-prompt prompt)
6547 got)
6548
6549 (while (not got)
6550 (message "%s" new-prompt)
6551
6552 ;; We do our own reading here, so we can circumvent, eg, special
9179616f 6553 ;; treatment for `?' character. (Oughta use minibuffer keymap instead.)
1977b8f6 6554 (setq got
c567ac01 6555 (char-to-string (let ((cursor-in-echo-area nil)) (read-char))))
1977b8f6 6556
9179616f
DL
6557 (setq got
6558 (cond ((string-match (regexp-quote got) string) got)
6559 ((and do-defaulting (string= got "\r"))
6560 ;; Return empty string to default:
6561 "")
6562 ((string= got "\C-g") (signal 'quit nil))
6563 (t
6564 (setq new-prompt (concat prompt
6565 got
6566 " ...pick from: "
6567 string
6568 ""))
6569 nil))))
60c7bbd2 6570 ;; got something out of loop -- return it:
9179616f 6571 got)
1977b8f6 6572 )
d8350998
CY
6573;;;_ : Strings:
6574;;;_ > regexp-sans-escapes (string)
c567ac01
RS
6575(defun regexp-sans-escapes (regexp &optional successive-backslashes)
6576 "Return a copy of REGEXP with all character escapes stripped out.
19b84ba3 6577
60c7bbd2 6578Representations of actual backslashes -- '\\\\\\\\' -- are left as a
c567ac01
RS
6579single backslash.
6580
d82979ea 6581Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
c567ac01
RS
6582
6583 (if (string= regexp "")
6584 ""
6585 ;; Set successive-backslashes to number if current char is
6586 ;; backslash, or else to nil:
6587 (setq successive-backslashes
6588 (if (= (aref regexp 0) ?\\)
6589 (if successive-backslashes (1+ successive-backslashes) 1)
6590 nil))
6591 (if (or (not successive-backslashes) (= 2 successive-backslashes))
6592 ;; Include first char:
6593 (concat (substring regexp 0 1)
6594 (regexp-sans-escapes (substring regexp 1)))
6595 ;; Exclude first char, but maintain count:
6596 (regexp-sans-escapes (substring regexp 1) successive-backslashes))))
d8350998 6597;;;_ > count-trailing-whitespace-region (beg end)
96b83743
EZ
6598(defun count-trailing-whitespace-region (beg end)
6599 "Return number of trailing whitespace chars between BEG and END.
6600
6601If BEG is bigger than END we return 0."
6602 (if (> beg end)
6603 0
2a1408fd
DN
6604 (save-match-data
6605 (save-excursion
6606 (goto-char beg)
6607 (let ((count 0))
6608 (while (re-search-forward "[ ][ ]*$" end t)
6609 (goto-char (1+ (match-beginning 2)))
6610 (setq count (1+ count)))
6611 count)))))
d8350998
CY
6612;;;_ > allout-format-quote (string)
6613(defun allout-format-quote (string)
6614 "Return a copy of string with all \"%\" characters doubled."
6615 (apply 'concat
6616 (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char)))
6617 string)))
6618;;;_ : lists
6619;;;_ > allout-flatten (list)
6620(defun allout-flatten (list)
6621 "Return a list of all atoms in list."
6622 ;; classic.
6623 (cond ((null list) nil)
8a559d4e
EZ
6624 ((atom (car list)) (cons (car list) (allout-flatten (cdr list))))
6625 (t (append (allout-flatten (car list)) (allout-flatten (cdr list))))))
75bcb912 6626;;;_ : Compatibility:
1c9b9df0
KM
6627;;;_ : xemacs undo-in-progress provision:
6628(unless (boundp 'undo-in-progress)
6629 (defvar undo-in-progress nil
6630 "Placeholder defvar for XEmacs compatibility from allout.el.")
6631 (defadvice undo-more (around allout activate)
6632 ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs.
6633 (let ((undo-in-progress t)) ad-do-it)))
6634
d8350998 6635;;;_ > allout-mark-marker to accommodate divergent emacsen:
96b83743
EZ
6636(defun allout-mark-marker (&optional force buffer)
6637 "Accommodate the different signature for `mark-marker' across Emacsen.
6638
6639XEmacs takes two optional args, while mainline GNU Emacs does not,
6640so pass them along when appropriate."
6641 (if (featurep 'xemacs)
6642 (apply 'mark-marker force buffer)
6643 (mark-marker)))
d8350998 6644;;;_ > subst-char-in-string if necessary
d82979ea
EZ
6645(if (not (fboundp 'subst-char-in-string))
6646 (defun subst-char-in-string (fromchar tochar string &optional inplace)
6647 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
6648Unless optional argument INPLACE is non-nil, return a new string."
6649 (let ((i (length string))
6650 (newstr (if inplace string (copy-sequence string))))
6651 (while (> i 0)
6652 (setq i (1- i))
6653 (if (eq (aref newstr i) fromchar)
6654 (aset newstr i tochar)))
6655 newstr)))
d8350998 6656;;;_ > wholenump if necessary
96b83743
EZ
6657(if (not (fboundp 'wholenump))
6658 (defalias 'wholenump 'natnump))
d8350998 6659;;;_ > remove-overlays if necessary
96b83743
EZ
6660(if (not (fboundp 'remove-overlays))
6661 (defun remove-overlays (&optional beg end name val)
6662 "Clear BEG and END of overlays whose property NAME has value VAL.
6663Overlays might be moved and/or split.
6664BEG and END default respectively to the beginning and end of buffer."
6665 (unless beg (setq beg (point-min)))
6666 (unless end (setq end (point-max)))
6667 (if (< end beg)
6668 (setq beg (prog1 end (setq end beg))))
6669 (save-excursion
6670 (dolist (o (overlays-in beg end))
6671 (when (eq (overlay-get o name) val)
6672 ;; Either push this overlay outside beg...end
6673 ;; or split it to exclude beg...end
6674 ;; or delete it entirely (if it is contained in beg...end).
6675 (if (< (overlay-start o) beg)
6676 (if (> (overlay-end o) end)
6677 (progn
6678 (move-overlay (copy-overlay o)
6679 (overlay-start o) beg)
6680 (move-overlay o end (overlay-end o)))
6681 (move-overlay o (overlay-start o) beg))
6682 (if (> (overlay-end o) end)
6683 (move-overlay o end (overlay-end o))
6684 (delete-overlay o)))))))
6685 )
60c7bbd2 6686;;;_ > copy-overlay if necessary -- xemacs ~ 21.4
96b83743
EZ
6687(if (not (fboundp 'copy-overlay))
6688 (defun copy-overlay (o)
6689 "Return a copy of overlay O."
6690 (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
6691 ;; FIXME: there's no easy way to find the
6692 ;; insertion-type of the two markers.
6693 (overlay-buffer o)))
6694 (props (overlay-properties o)))
6695 (while props
6696 (overlay-put o1 (pop props) (pop props)))
6697 o1)))
60c7bbd2 6698;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4
96b83743
EZ
6699(if (not (fboundp 'add-to-invisibility-spec))
6700 (defun add-to-invisibility-spec (element)
6701 "Add ELEMENT to `buffer-invisibility-spec'.
6702See documentation for `buffer-invisibility-spec' for the kind of elements
6703that can be added."
6704 (if (eq buffer-invisibility-spec t)
6705 (setq buffer-invisibility-spec (list t)))
6706 (setq buffer-invisibility-spec
6707 (cons element buffer-invisibility-spec))))
60c7bbd2 6708;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4
96b83743
EZ
6709(if (not (fboundp 'remove-from-invisibility-spec))
6710 (defun remove-from-invisibility-spec (element)
6711 "Remove ELEMENT from `buffer-invisibility-spec'."
6712 (if (consp buffer-invisibility-spec)
6713 (setq buffer-invisibility-spec (delete element
6714 buffer-invisibility-spec)))))
60c7bbd2 6715;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs
96b83743
EZ
6716(if (not (fboundp 'move-beginning-of-line))
6717 (defun move-beginning-of-line (arg)
6718 "Move point to beginning of current line as displayed.
6719\(This disregards invisible newlines such as those
6720which are part of the text that an image rests on.)
6721
6722With argument ARG not nil or 1, move forward ARG - 1 lines first.
6723If point reaches the beginning or end of buffer, it stops there.
4034b0e2 6724To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
96b83743
EZ
6725 (interactive "p")
6726 (or arg (setq arg 1))
6727 (if (/= arg 1)
6728 (condition-case nil (line-move (1- arg)) (error nil)))
6729
8570ce80
SM
6730 ;; Move to beginning-of-line, ignoring fields and invisibles.
6731 (skip-chars-backward "^\n")
2a1408fd
DN
6732 (while (and (not (bobp))
6733 (let ((prop
6734 (get-char-property (1- (point)) 'invisible)))
6735 (if (eq buffer-invisibility-spec t)
6736 prop
6737 (or (memq prop buffer-invisibility-spec)
6738 (assq prop buffer-invisibility-spec)))))
8570ce80
SM
6739 (goto-char (if (featurep 'xemacs)
6740 (previous-property-change (point))
6741 (previous-char-property-change (point))))
6742 (skip-chars-backward "^\n"))
6743 (vertical-motion 0))
96b83743 6744)
9b026d9f 6745;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs
96b83743
EZ
6746(if (not (fboundp 'move-end-of-line))
6747 (defun move-end-of-line (arg)
6748 "Move point to end of current line as displayed.
6749\(This disregards invisible newlines such as those
6750which are part of the text that an image rests on.)
6751
6752With argument ARG not nil or 1, move forward ARG - 1 lines first.
6753If point reaches the beginning or end of buffer, it stops there.
4034b0e2 6754To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
96b83743
EZ
6755 (interactive "p")
6756 (or arg (setq arg 1))
8570ce80 6757 (let (done)
96b83743
EZ
6758 (while (not done)
6759 (let ((newpos
6760 (save-excursion
6761 (let ((goal-column 0))
6762 (and (condition-case nil
6763 (or (line-move arg) t)
6764 (error nil))
6765 (not (bobp))
6766 (progn
2a1408fd
DN
6767 (while
6768 (and
6769 (not (bobp))
6770 (let ((prop
6771 (get-char-property (1- (point))
6772 'invisible)))
6773 (if (eq buffer-invisibility-spec t)
6774 prop
6775 (or (memq prop
6776 buffer-invisibility-spec)
6777 (assq prop
6778 buffer-invisibility-spec)))))
8570ce80
SM
6779 (goto-char
6780 (previous-char-property-change (point))))
96b83743
EZ
6781 (backward-char 1)))
6782 (point)))))
6783 (goto-char newpos)
6784 (if (and (> (point) newpos)
6785 (eq (preceding-char) ?\n))
6786 (backward-char 1)
6787 (if (and (> (point) newpos) (not (eobp))
6788 (not (eq (following-char) ?\n)))
6789 ;; If we skipped something intangible
6790 ;; and now we're not really at eol,
6791 ;; keep going.
6792 (setq arg 1)
8570ce80 6793 (setq done t)))))))
96b83743 6794 )
1c9b9df0
KM
6795;;;_ > allout-next-single-char-property-change -- alias unless lacking
6796(defalias 'allout-next-single-char-property-change
6797 (if (fboundp 'next-single-char-property-change)
6798 'next-single-char-property-change
6799 'next-single-property-change)
6800 ;; No docstring because xemacs defalias doesn't support it.
6801 )
6802;;;_ > allout-previous-single-char-property-change -- alias unless lacking
6803(defalias 'allout-previous-single-char-property-change
6804 (if (fboundp 'previous-single-char-property-change)
6805 'previous-single-char-property-change
6806 'previous-single-property-change)
6807 ;; No docstring because xemacs defalias doesn't support it.
6808 )
6809;;;_ > allout-set-buffer-multibyte
2576c28f
KM
6810(if (fboundp 'set-buffer-multibyte)
6811 (defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte)
6812 (with-no-warnings
6813 ;; this definition is used only in older or alternative emacs, where
6814 ;; the setting is our only recourse.
6815 (defun allout-set-buffer-multibyte (is-multibyte)
6816 (set enable-multibyte-characters is-multibyte))))
1c9b9df0
KM
6817;;;_ > allout-select-safe-coding-system
6818(defalias 'allout-select-safe-coding-system
6819 (if (fboundp 'select-safe-coding-system)
6820 'select-safe-coding-system
6821 'detect-coding-region)
6822 )
6823;;;_ > allout-substring-no-properties
6824;; define as alias first, so byte compiler is happy.
6825(defalias 'allout-substring-no-properties 'substring-no-properties)
6826;; then supplant with definition if underlying alias absent.
6827(if (not (fboundp 'substring-no-properties))
6828 (defun allout-substring-no-properties (string &optional start end)
6829 (substring string (or start 0) end))
6830 )
96b83743 6831
96b83743 6832;;;_ #10 Unfinished
fd5359c6
MR
6833;;;_ > allout-bullet-isearch (&optional bullet)
6834(defun allout-bullet-isearch (&optional bullet)
c07583cd 6835 "Isearch (regexp) for topic with bullet BULLET."
c567ac01
RS
6836 (interactive)
6837 (if (not bullet)
6838 (setq bullet (solicit-char-in-string
6839 "ISearch for topic with bullet: "
fd5359c6 6840 (regexp-sans-escapes allout-bullets-string))))
353e2ef2 6841
c567ac01
RS
6842 (let ((isearch-regexp t)
6843 (isearch-string (concat "^"
fd5359c6 6844 allout-header-prefix
c567ac01
RS
6845 "[ \t]*"
6846 bullet)))
6847 (isearch-repeat 'forward)
6848 (isearch-mode t)))
96b83743 6849
60c7bbd2 6850;;;_ #11 Unit tests -- this should be last item before "Provide"
01fc9422
EZ
6851;;;_ > allout-run-unit-tests ()
6852(defun allout-run-unit-tests ()
6853 "Run the various allout unit tests."
6854 (message "Running allout tests...")
6855 (allout-test-resumptions)
6856 (message "Running allout tests... Done.")
6857 (sit-for .5))
6858;;;_ : test resumptions:
6859;;;_ > allout-tests-obliterate-variable (name)
6860(defun allout-tests-obliterate-variable (name)
6861 "Completely unbind variable with NAME."
1c9b9df0 6862 (if (local-variable-p name (current-buffer)) (kill-local-variable name))
01fc9422
EZ
6863 (while (boundp name) (makunbound name)))
6864;;;_ > allout-test-resumptions ()
6865(defvar allout-tests-globally-unbound nil
60c7bbd2 6866 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
01fc9422 6867(defvar allout-tests-globally-true nil
60c7bbd2 6868 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
01fc9422 6869(defvar allout-tests-locally-true nil
60c7bbd2 6870 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
01fc9422
EZ
6871(defun allout-test-resumptions ()
6872 "Exercise allout resumptions."
6873 ;; for each resumption case, we also test that the right local/global
6874 ;; scopes are affected during resumption effects:
6875
6876 ;; ensure that previously unbound variables return to the unbound state.
6877 (with-temp-buffer
6878 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6879 (allout-add-resumptions '(allout-tests-globally-unbound t))
6880 (assert (not (default-boundp 'allout-tests-globally-unbound)))
1c9b9df0 6881 (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
01fc9422
EZ
6882 (assert (boundp 'allout-tests-globally-unbound))
6883 (assert (equal allout-tests-globally-unbound t))
6884 (allout-do-resumptions)
1c9b9df0
KM
6885 (assert (not (local-variable-p 'allout-tests-globally-unbound
6886 (current-buffer))))
01fc9422
EZ
6887 (assert (not (boundp 'allout-tests-globally-unbound))))
6888
6889 ;; ensure that variable with prior global value is resumed
6890 (with-temp-buffer
6891 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6892 (setq allout-tests-globally-true t)
6893 (allout-add-resumptions '(allout-tests-globally-true nil))
6894 (assert (equal (default-value 'allout-tests-globally-true) t))
1c9b9df0 6895 (assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
01fc9422
EZ
6896 (assert (equal allout-tests-globally-true nil))
6897 (allout-do-resumptions)
1c9b9df0
KM
6898 (assert (not (local-variable-p 'allout-tests-globally-true
6899 (current-buffer))))
01fc9422
EZ
6900 (assert (boundp 'allout-tests-globally-true))
6901 (assert (equal allout-tests-globally-true t)))
6902
6903 ;; ensure that prior local value is resumed
6904 (with-temp-buffer
6905 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6906 (set (make-local-variable 'allout-tests-locally-true) t)
6907 (assert (not (default-boundp 'allout-tests-locally-true))
60c7bbd2 6908 nil (concat "Test setup mistake -- variable supposed to"
01fc9422 6909 " not have global binding, but it does."))
1c9b9df0 6910 (assert (local-variable-p 'allout-tests-locally-true (current-buffer))
60c7bbd2 6911 nil (concat "Test setup mistake -- variable supposed to have"
01fc9422
EZ
6912 " local binding, but it lacks one."))
6913 (allout-add-resumptions '(allout-tests-locally-true nil))
6914 (assert (not (default-boundp 'allout-tests-locally-true)))
1c9b9df0 6915 (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
01fc9422
EZ
6916 (assert (equal allout-tests-locally-true nil))
6917 (allout-do-resumptions)
6918 (assert (boundp 'allout-tests-locally-true))
1c9b9df0 6919 (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
01fc9422
EZ
6920 (assert (equal allout-tests-locally-true t))
6921 (assert (not (default-boundp 'allout-tests-locally-true))))
6922
6923 ;; ensure that last of multiple resumptions holds, for various scopes.
6924 (with-temp-buffer
6925 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6926 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6927 (setq allout-tests-globally-true t)
6928 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6929 (set (make-local-variable 'allout-tests-locally-true) t)
6930 (allout-add-resumptions '(allout-tests-globally-unbound t)
6931 '(allout-tests-globally-true nil)
6932 '(allout-tests-locally-true nil))
6933 (allout-add-resumptions '(allout-tests-globally-unbound 2)
6934 '(allout-tests-globally-true 3)
6935 '(allout-tests-locally-true 4))
6936 ;; reestablish many of the basic conditions are maintained after re-add:
6937 (assert (not (default-boundp 'allout-tests-globally-unbound)))
1c9b9df0 6938 (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
01fc9422
EZ
6939 (assert (equal allout-tests-globally-unbound 2))
6940 (assert (default-boundp 'allout-tests-globally-true))
1c9b9df0 6941 (assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
01fc9422
EZ
6942 (assert (equal allout-tests-globally-true 3))
6943 (assert (not (default-boundp 'allout-tests-locally-true)))
1c9b9df0 6944 (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
01fc9422
EZ
6945 (assert (equal allout-tests-locally-true 4))
6946 (allout-do-resumptions)
1c9b9df0
KM
6947 (assert (not (local-variable-p 'allout-tests-globally-unbound
6948 (current-buffer))))
01fc9422 6949 (assert (not (boundp 'allout-tests-globally-unbound)))
1c9b9df0
KM
6950 (assert (not (local-variable-p 'allout-tests-globally-true
6951 (current-buffer))))
01fc9422
EZ
6952 (assert (boundp 'allout-tests-globally-true))
6953 (assert (equal allout-tests-globally-true t))
6954 (assert (boundp 'allout-tests-locally-true))
1c9b9df0 6955 (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
01fc9422
EZ
6956 (assert (equal allout-tests-locally-true t))
6957 (assert (not (default-boundp 'allout-tests-locally-true))))
6958
6959 ;; ensure that deliberately unbinding registered variables doesn't foul things
6960 (with-temp-buffer
6961 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6962 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6963 (setq allout-tests-globally-true t)
6964 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6965 (set (make-local-variable 'allout-tests-locally-true) t)
6966 (allout-add-resumptions '(allout-tests-globally-unbound t)
6967 '(allout-tests-globally-true nil)
6968 '(allout-tests-locally-true nil))
6969 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6970 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6971 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6972 (allout-do-resumptions))
6973 )
6974;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true:
6975(when allout-run-unit-tests-on-load
6976 (allout-run-unit-tests))
6977
6978;;;_ #12 Provide
96b83743 6979(provide 'allout)
1977b8f6
RS
6980
6981;;;_* Local emacs vars.
31468dcb
SM
6982;; The following `allout-layout' local variable setting:
6983;; - closes all topics from the first topic to just before the third-to-last,
6984;; - shows the children of the third to last (config vars)
6985;; - and the second to last (code section),
6986;; - and closes the last topic (this local-variables section).
6987;;Local variables:
6988;;allout-layout: (0 : -1 -1 0)
6989;;End:
6990
6a05d05f 6991;;; allout.el ends here