vc-bzr fix for bug #7792.
[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 3329 (step (if backward -1 1))
82b392a4 3330 (progress (allout-current-bullet-pos))
c567ac01
RS
3331 prev got)
3332
d8350998
CY
3333 (while (> arg 0)
3334 (while (and
3335 ;; Boundary condition:
3336 (not (if backward (bobp)(eobp)))
3337 ;; Move, skipping over all concealed lines in one fell swoop:
3338 (prog1 (condition-case nil (or (line-move step) t)
3339 (error nil))
82b392a4
KM
3340 (allout-beginning-of-current-line)
3341 ;; line-move can wind up on the same line if long.
3342 ;; when moving forward, that would yield no-progress
3343 (when (and (not backward)
3344 (<= (point) progress))
3345 ;; ensure progress by doing line-move from end-of-line:
3346 (end-of-line)
3347 (condition-case nil (or (line-move step) t)
3348 (error nil))
3349 (allout-beginning-of-current-line)
3350 (setq progress (point))))
d8350998 3351 ;; Deal with apparent header line:
2a1408fd
DN
3352 (save-match-data
3353 (if (not (looking-at allout-regexp))
3354 ;; not a header line, keep looking:
d8350998 3355 t
2a1408fd
DN
3356 (allout-prefix-data)
3357 (if (and (allout-do-doublecheck)
3358 (allout-aberrant-container-p))
3359 ;; skip this aberrant prospective header line:
3360 t
8dd59f01 3361 ;; this prospective headerline qualifies -- register:
2a1408fd
DN
3362 (setq got allout-recent-prefix-beginning)
3363 ;; and break the loop:
3364 nil)))))
c567ac01
RS
3365 ;; Register this got, it may be the last:
3366 (if got (setq prev got))
3367 (setq arg (1- arg)))
3368 (cond (got ; Last move was to a prefix:
d8350998 3369 (allout-end-of-prefix))
c567ac01 3370 (prev ; Last move wasn't, but prev was:
d8350998
CY
3371 (goto-char prev)
3372 (allout-end-of-prefix))
c567ac01 3373 ((not backward) (end-of-line) nil))))
fd5359c6
MR
3374;;;_ > allout-previous-visible-heading (arg)
3375(defun allout-previous-visible-heading (arg)
c567ac01 3376 "Move to the previous heading line.
1977b8f6 3377
c567ac01 3378With argument, repeats or can move forward if negative.
2265e017 3379A heading line is one that starts with a `*' (or that `allout-regexp'
c567ac01 3380matches)."
1977b8f6 3381 (interactive "p")
d8350998 3382 (prog1 (allout-next-visible-heading (- arg))
1c9b9df0 3383 (if (allout-called-interactively-p) (allout-end-of-prefix))))
fd5359c6 3384;;;_ > allout-forward-current-level (arg)
d82979ea 3385(defun allout-forward-current-level (arg)
19b84ba3 3386 "Position point at the next heading of the same level.
1977b8f6 3387
19b84ba3 3388Takes optional repeat-count, goes backward if count is negative.
1977b8f6 3389
19b84ba3 3390Returns resulting position, else nil if none found."
d82979ea 3391 (interactive "p")
fd5359c6 3392 (let ((start-depth (allout-current-depth))
19b84ba3 3393 (start-arg arg)
d8350998 3394 (backward (> 0 arg)))
19b84ba3
RS
3395 (if (= 0 start-depth)
3396 (error "No siblings, not in a topic..."))
3397 (if backward (setq arg (* -1 arg)))
d8350998
CY
3398 (allout-back-to-current-heading)
3399 (while (and (not (zerop arg))
3400 (if backward
3401 (allout-previous-sibling)
3402 (allout-next-sibling)))
3403 (setq arg (1- arg)))
1c9b9df0 3404 (if (not (allout-called-interactively-p))
d8350998
CY
3405 nil
3406 (allout-end-of-prefix)
3407 (if (not (zerop arg))
3408 (error "Hit %s level %d topic, traversed %d of %d requested"
3409 (if backward "first" "last")
3410 allout-recent-depth
3411 (- (abs start-arg) arg)
3412 (abs start-arg))))))
fd5359c6 3413;;;_ > allout-backward-current-level (arg)
d82979ea 3414(defun allout-backward-current-level (arg)
fd5359c6 3415 "Inverse of `allout-forward-current-level'."
d82979ea 3416 (interactive "p")
1c9b9df0 3417 (if (allout-called-interactively-p)
19b84ba3 3418 (let ((current-prefix-arg (* -1 arg)))
fd5359c6
MR
3419 (call-interactively 'allout-forward-current-level))
3420 (allout-forward-current-level (* -1 arg))))
c567ac01 3421
19b84ba3 3422;;;_ #5 Alteration
c567ac01
RS
3423
3424;;;_ - Fundamental
fd5359c6
MR
3425;;;_ = allout-post-goto-bullet
3426(defvar allout-post-goto-bullet nil
3427 "Outline internal var, for `allout-pre-command-business' hot-spot operation.
19b84ba3
RS
3428
3429When set, tells post-processing to reposition on topic bullet, and
2265e017 3430then unset it. Set by `allout-pre-command-business' when implementing
19b84ba3
RS
3431hot-spot operation, where literal characters typed over a topic bullet
3432are mapped to the command of the corresponding control-key on the
2265e017 3433`allout-mode-map'.")
fd5359c6 3434(make-variable-buffer-local 'allout-post-goto-bullet)
48bd8440
EZ
3435;;;_ = allout-command-counter
3436(defvar allout-command-counter 0
3437 "Counter that monotonically increases in allout-mode buffers.
3438
3439Set by `allout-pre-command-business', to support allout addons in
3440coordinating with allout activity.")
3441(make-variable-buffer-local 'allout-command-counter)
fd5359c6
MR
3442;;;_ > allout-post-command-business ()
3443(defun allout-post-command-business ()
2265e017 3444 "Outline `post-command-hook' function.
c567ac01 3445
2265e017 3446- Implement (and clear) `allout-post-goto-bullet', for hot-spot
c567ac01
RS
3447 outline commands.
3448
96b83743 3449- Decrypt topic currently being edited if it was encrypted for a save."
c567ac01
RS
3450
3451 ; Apply any external change func:
fd5359c6 3452 (if (not (allout-mode-p)) ; In allout-mode.
19b84ba3 3453 nil
d82979ea
EZ
3454
3455 (if (and (boundp 'allout-after-save-decrypt)
3456 allout-after-save-decrypt)
3457 (allout-after-saves-handler))
3458
48bd8440 3459 ;; Implement allout-post-goto-bullet, if set:
fd5359c6
MR
3460 (if (and allout-post-goto-bullet
3461 (allout-current-bullet-pos))
3462 (progn (goto-char (allout-current-bullet-pos))
3463 (setq allout-post-goto-bullet nil)))
19b84ba3 3464 ))
fd5359c6
MR
3465;;;_ > allout-pre-command-business ()
3466(defun allout-pre-command-business ()
2265e017 3467 "Outline `pre-command-hook' function for outline buffers.
48bd8440
EZ
3468
3469Among other things, implements special behavior when the cursor is on the
3470topic bullet character.
c567ac01 3471
58edceeb
JB
3472When the cursor is on the bullet character, self-insert characters are
3473reinterpreted as the corresponding control-character in the
3474`allout-mode-map'. The `allout-mode' `post-command-hook' insures that
3475the cursor which has moved as a result of such reinterpretation is
3476positioned on the bullet character of the destination topic.
c567ac01 3477
c07583cd 3478The upshot is that you can get easy, single (ie, unmodified) key
9179616f 3479outline maneuvering operations by positioning the cursor on the bullet
58edceeb
JB
3480char. When in this mode you can use regular cursor-positioning
3481command/keystrokes to relocate the cursor off of a bullet character to
3482return to regular interpretation of self-insert characters."
d82979ea 3483
fd5359c6 3484 (if (not (allout-mode-p))
9179616f 3485 nil
48bd8440
EZ
3486 ;; Increment allout-command-counter
3487 (setq allout-command-counter (1+ allout-command-counter))
3488 ;; Do hot-spot navigation.
9179616f 3489 (if (and (eq this-command 'self-insert-command)
fd5359c6 3490 (eq (point)(allout-current-bullet-pos)))
01fc9422
EZ
3491 (allout-hotspot-key-handler))))
3492;;;_ > allout-hotspot-key-handler ()
3493(defun allout-hotspot-key-handler ()
3494 "Catchall handling of key bindings in hot-spots.
3495
3496Translates unmodified keystrokes to corresponding allout commands, when
3497they would qualify if prefixed with the allout-command-prefix, and sets
3498this-command accordingly.
3499
3500Returns the qualifying command, if any, else nil."
3501 (interactive)
1c9b9df0
KM
3502 (let* ((modified (event-modifiers last-command-event))
3503 (key-string (if (numberp last-command-event)
3504 (char-to-string
3505 (event-basic-type last-command-event))))
8989a920 3506 (key-num (cond ((numberp last-command-event) last-command-event)
01fc9422
EZ
3507 ;; for XEmacs character type:
3508 ((and (fboundp 'characterp)
8989a920
GM
3509 (apply 'characterp (list last-command-event)))
3510 (apply 'char-to-int (list last-command-event)))
01fc9422 3511 (t 0)))
d8350998 3512 mapped-binding)
01fc9422
EZ
3513
3514 (if (zerop key-num)
3515 nil
3516
d8350998
CY
3517 (if (and
3518 ;; exclude control chars and escape:
1c9b9df0 3519 (not modified)
d8350998
CY
3520 (<= 33 key-num)
3521 (setq mapped-binding
3522 (or (and (assoc key-string allout-keybindings-list)
3523 ;; translate literal membership on list:
3524 (cadr (assoc key-string allout-keybindings-list)))
3525 ;; translate as a keybinding:
2a1408fd 3526 (key-binding (vconcat allout-command-prefix
1c9b9df0
KM
3527 (vector
3528 (if (and (<= 97 key-num) ; "a"
3529 (>= 122 key-num)) ; "z"
3530 (- key-num 96) key-num)))
d8350998 3531 t))))
60c7bbd2 3532 ;; Qualified as an allout command -- do hot-spot operation.
01fc9422 3533 (setq allout-post-goto-bullet t)
1c9b9df0
KM
3534 ;; accept-defaults nil, or else we get allout-item-icon-key-handler.
3535 (setq mapped-binding (key-binding (vector key-num))))
01fc9422
EZ
3536
3537 (while (keymapp mapped-binding)
3538 (setq mapped-binding
d8350998 3539 (lookup-key mapped-binding (vector (read-char)))))
01fc9422 3540
1c9b9df0
KM
3541 (when mapped-binding
3542 (setq this-command mapped-binding)))))
01fc9422 3543
fd5359c6
MR
3544;;;_ > allout-find-file-hook ()
3545(defun allout-find-file-hook ()
4034b0e2 3546 "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'.
fd5359c6
MR
3547
3548See `allout-init' for setup instructions."
3549 (if (and allout-auto-activation
3550 (not (allout-mode-p))
3551 allout-layout)
2576c28f 3552 (allout-mode)))
c567ac01
RS
3553
3554;;;_ - Topic Format Assessment
fd5359c6
MR
3555;;;_ > allout-solicit-alternate-bullet (depth &optional current-bullet)
3556(defun allout-solicit-alternate-bullet (depth &optional current-bullet)
1977b8f6 3557
19b84ba3
RS
3558 "Prompt for and return a bullet char as an alternative to the current one.
3559
3560Offer one suitable for current depth DEPTH as default."
1977b8f6 3561
9179616f 3562 (let* ((default-bullet (or (and (stringp current-bullet) current-bullet)
fd5359c6
MR
3563 (allout-bullet-for-depth depth)))
3564 (sans-escapes (regexp-sans-escapes allout-bullets-string))
9179616f
DL
3565 choice)
3566 (save-excursion
fd5359c6 3567 (goto-char (allout-current-bullet-pos))
9179616f
DL
3568 (setq choice (solicit-char-in-string
3569 (format "Select bullet: %s ('%s' default): "
3570 sans-escapes
1c9b9df0 3571 (allout-substring-no-properties default-bullet))
9179616f
DL
3572 sans-escapes
3573 t)))
3574 (message "")
1977b8f6
RS
3575 (if (string= choice "") default-bullet choice))
3576 )
fd5359c6
MR
3577;;;_ > allout-distinctive-bullet (bullet)
3578(defun allout-distinctive-bullet (bullet)
e126900f 3579 "True if BULLET is one of those on `allout-distinctive-bullets-string'."
fd5359c6
MR
3580 (string-match (regexp-quote bullet) allout-distinctive-bullets-string))
3581;;;_ > allout-numbered-type-prefix (&optional prefix)
3582(defun allout-numbered-type-prefix (&optional prefix)
c567ac01 3583 "True if current header prefix bullet is numbered bullet."
fd5359c6
MR
3584 (and allout-numbered-bullet
3585 (string= allout-numbered-bullet
1977b8f6 3586 (if prefix
fd5359c6
MR
3587 (allout-get-prefix-bullet prefix)
3588 (allout-get-bullet)))))
d82979ea
EZ
3589;;;_ > allout-encrypted-type-prefix (&optional prefix)
3590(defun allout-encrypted-type-prefix (&optional prefix)
c07583cd 3591 "True if current header prefix bullet is for an encrypted entry (body)."
d82979ea
EZ
3592 (and allout-topic-encryption-bullet
3593 (string= allout-topic-encryption-bullet
3594 (if prefix
3595 (allout-get-prefix-bullet prefix)
3596 (allout-get-bullet)))))
fd5359c6
MR
3597;;;_ > allout-bullet-for-depth (&optional depth)
3598(defun allout-bullet-for-depth (&optional depth)
19b84ba3 3599 "Return outline topic bullet suited to optional DEPTH, or current depth."
1977b8f6 3600 ;; Find bullet in plain-bullets-string modulo DEPTH.
fd5359c6
MR
3601 (if allout-stylish-prefixes
3602 (char-to-string (aref allout-plain-bullets-string
1977b8f6 3603 (% (max 0 (- depth 2))
fd5359c6
MR
3604 allout-plain-bullets-string-len)))
3605 allout-primary-bullet)
1977b8f6
RS
3606 )
3607
c567ac01 3608;;;_ - Topic Production
fd5359c6
MR
3609;;;_ > allout-make-topic-prefix (&optional prior-bullet
3610(defun allout-make-topic-prefix (&optional prior-bullet
1977b8f6
RS
3611 new
3612 depth
3613 solicit
3614 number-control
3615 index)
3616 ;; Depth null means use current depth, non-null means we're either
3617 ;; opening a new topic after current topic, lower or higher, or we're
3618 ;; changing level of current topic.
3619 ;; Solicit dominates specified bullet-char.
c567ac01 3620;;;_ . Doc string:
19b84ba3 3621 "Generate a topic prefix suitable for optional arg DEPTH, or current depth.
c567ac01
RS
3622
3623All the arguments are optional.
3624
3625PRIOR-BULLET indicates the bullet of the prefix being changed, or
3626nil if none. This bullet may be preserved (other options
2265e017 3627notwithstanding) if it is on the `allout-distinctive-bullets-string',
c567ac01
RS
3628for instance.
3629
3630Second arg NEW indicates that a new topic is being opened after the
3631topic at point, if non-nil. Default bullet for new topics, eg, may
3632be set (contingent to other args) to numbered bullets if previous
3633sibling is one. The implication otherwise is that the current topic
60c7bbd2 3634is being adjusted -- shifted or rebulleted -- and we don't consider
c567ac01
RS
3635bullet or previous sibling.
3636
3637Third arg DEPTH forces the topic prefix to that depth, regardless of
3638the current topics' depth.
3639
9179616f
DL
3640If SOLICIT is non-nil, then the choice of bullet is solicited from
3641user. If it's a character, then that character is offered as the
c07583cd
KS
3642default, otherwise the one suited to the context (according to
3643distinction or depth) is offered. (This overrides other options,
9179616f
DL
3644including, eg, a distinctive PRIOR-BULLET.) If non-nil, then the
3645context-specific bullet is used.
c567ac01 3646
fd5359c6 3647Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet'
c567ac01
RS
3648is non-nil *and* soliciting was not explicitly invoked. Then
3649NUMBER-CONTROL non-nil forces prefix to either numbered or
3650denumbered format, depending on the value of the sixth arg, INDEX.
3651
3652\(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...)
3653
3654If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then
3655the prefix of the topic is forced to be numbered. Non-nil
3656NUMBER-CONTROL and nil INDEX forces non-numbered format on the
3657bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means
3658that the index for the numbered prefix will be derived, by counting
3659siblings back to start of level. If INDEX is a number, then that
3660number is used as the index for the numbered prefix (allowing, eg,
a0776d6b 3661sequential renumbering to not require this function counting back the
c567ac01
RS
3662index for each successive sibling)."
3663;;;_ . Code:
1977b8f6
RS
3664 ;; The options are ordered in likely frequence of use, most common
3665 ;; highest, least lowest. Ie, more likely to be doing prefix
3666 ;; adjustments than soliciting, and yet more than numbering.
3667 ;; Current prefix is least dominant, but most likely to be commonly
3668 ;; specified...
3669
3670 (let* (body
3671 numbering
3672 denumbering
fd5359c6
MR
3673 (depth (or depth (allout-depth)))
3674 (header-lead allout-header-prefix)
1977b8f6
RS
3675 (bullet-char
3676
3677 ;; Getting value for bullet char is practically the whole job:
3678
3679 (cond
60c7bbd2 3680 ; Simplest situation -- level 1:
fd5359c6 3681 ((<= depth 1) (setq header-lead "") allout-primary-bullet)
1977b8f6 3682 ; Simple, too: all asterisks:
fd5359c6 3683 (allout-old-style-prefixes
60c7bbd2 3684 ;; Cheat -- make body the whole thing, null out header-lead and
1977b8f6
RS
3685 ;; bullet-char:
3686 (setq body (make-string depth
fd5359c6 3687 (string-to-char allout-primary-bullet)))
1977b8f6
RS
3688 (setq header-lead "")
3689 "")
3690
3691 ;; (Neither level 1 nor old-style, so we're space padding.
3692 ;; Sneak it in the condition of the next case, whatever it is.)
3693
3694 ;; Solicitation overrides numbering and other cases:
3695 ((progn (setq body (make-string (- depth 2) ?\ ))
3696 ;; The actual condition:
3697 solicit)
fd5359c6 3698 (let* ((got (allout-solicit-alternate-bullet depth solicit)))
1977b8f6 3699 ;; Gotta check whether we're numbering and got a numbered bullet:
fd5359c6 3700 (setq numbering (and allout-numbered-bullet
1977b8f6 3701 (not (and number-control (not index)))
fd5359c6 3702 (string= got allout-numbered-bullet)))
1977b8f6
RS
3703 ;; Now return what we got, regardless:
3704 got))
3705
3706 ;; Numbering invoked through args:
fd5359c6 3707 ((and allout-numbered-bullet number-control)
1977b8f6 3708 (if (setq numbering (not (setq denumbering (not index))))
fd5359c6 3709 allout-numbered-bullet
19b84ba3 3710 (if (and prior-bullet
fd5359c6 3711 (not (string= allout-numbered-bullet
19b84ba3
RS
3712 prior-bullet)))
3713 prior-bullet
fd5359c6 3714 (allout-bullet-for-depth depth))))
1977b8f6
RS
3715
3716 ;;; Neither soliciting nor controlled numbering ;;;
3717 ;;; (may be controlled denumbering, tho) ;;;
3718
3719 ;; Check wrt previous sibling:
3720 ((and new ; only check for new prefixes
fd5359c6
MR
3721 (<= depth (allout-depth))
3722 allout-numbered-bullet ; ... & numbering enabled
1977b8f6
RS
3723 (not denumbering)
3724 (let ((sibling-bullet
3725 (save-excursion
3726 ;; Locate correct sibling:
fd5359c6
MR
3727 (or (>= depth (allout-depth))
3728 (allout-ascend-to-depth depth))
3729 (allout-get-bullet))))
1977b8f6 3730 (if (and sibling-bullet
fd5359c6 3731 (string= allout-numbered-bullet sibling-bullet))
1977b8f6
RS
3732 (setq numbering sibling-bullet)))))
3733
3734 ;; Distinctive prior bullet?
3735 ((and prior-bullet
fd5359c6 3736 (allout-distinctive-bullet prior-bullet)
1977b8f6 3737 ;; Either non-numbered:
fd5359c6
MR
3738 (or (not (and allout-numbered-bullet
3739 (string= prior-bullet allout-numbered-bullet)))
1977b8f6
RS
3740 ;; or numbered, and not denumbering:
3741 (setq numbering (not denumbering)))
3742 ;; Here 'tis:
3743 prior-bullet))
3744
3745 ;; Else, standard bullet per depth:
fd5359c6 3746 ((allout-bullet-for-depth depth)))))
1977b8f6
RS
3747
3748 (concat header-lead
3749 body
3750 bullet-char
3751 (if numbering
3752 (format "%d" (cond ((and index (numberp index)) index)
fd5359c6
MR
3753 (new (1+ (allout-sibling-index depth)))
3754 ((allout-sibling-index))))))
1977b8f6
RS
3755 )
3756 )
96b83743
EZ
3757;;;_ > allout-open-topic (relative-depth &optional before offer-recent-bullet)
3758(defun allout-open-topic (relative-depth &optional before offer-recent-bullet)
d82979ea 3759 "Open a new topic at depth DEPTH.
19b84ba3
RS
3760
3761New topic is situated after current one, unless optional flag BEFORE
60c7bbd2
RS
3762is non-nil, or unless current line is completely empty -- lacking even
3763whitespace -- in which case open is done on the current line.
96b83743
EZ
3764
3765When adding an offspring, it will be added immediately after the parent if
3766the other offspring are exposed, or after the last child if the offspring
c07583cd 3767are hidden. (The intervening offspring will be exposed in the latter
96b83743 3768case.)
c567ac01 3769
96b83743 3770If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
9179616f 3771
c567ac01
RS
3772Nuances:
3773
3774- Creation of new topics is with respect to the visible topic
3775 containing the cursor, regardless of intervening concealed ones.
3776
3777- New headers are generally created after/before the body of a
3778 topic. However, they are created right at cursor location if the
3779 cursor is on a blank line, even if that breaks the current topic
3780 body. This is intentional, to provide a simple means for
3781 deliberately dividing topic bodies.
3782
3783- Double spacing of topic lists is preserved. Also, the first
3784 level two topic is created double-spaced (and so would be
3785 subsequent siblings, if that's left intact). Otherwise,
3786 single-spacing is used.
3787
3788- Creation of sibling or nested topics is with respect to the topic
3789 you're starting from, even when creating backwards. This way you
3790 can easily create a sibling in front of the current topic without
a0776d6b 3791 having to go to its preceding sibling, and then open forward
c567ac01 3792 from there."
1977b8f6 3793
96b83743 3794 (allout-beginning-of-current-line)
2a1408fd
DN
3795 (save-match-data
3796 (let* ((inhibit-field-text-motion t)
3797 (depth (+ (allout-current-depth) relative-depth))
3798 (opening-on-blank (if (looking-at "^\$")
3799 (not (setq before nil))))
3800 ;; bunch o vars set while computing ref-topic
3801 opening-numbered
3802 ref-depth
3803 ref-bullet
3804 (ref-topic (save-excursion
3805 (cond ((< relative-depth 0)
3806 (allout-ascend-to-depth depth))
3807 ((>= relative-depth 1) nil)
3808 (t (allout-back-to-current-heading)))
3809 (setq ref-depth allout-recent-depth)
3810 (setq ref-bullet
3811 (if (> allout-recent-prefix-end 1)
3812 (allout-recent-bullet)
3813 ""))
3814 (setq opening-numbered
3815 (save-excursion
3816 (and allout-numbered-bullet
3817 (or (<= relative-depth 0)
3818 (allout-descend-to-depth depth))
3819 (if (allout-numbered-type-prefix)
3820 allout-numbered-bullet))))
3821 (point)))
3822 dbl-space
3823 doing-beginning
3824 start end)
3825
3826 (if (not opening-on-blank)
1977b8f6 3827 ; Positioning and vertical
60c7bbd2 3828 ; padding -- only if not
1977b8f6 3829 ; opening-on-blank:
2a1408fd
DN
3830 (progn
3831 (goto-char ref-topic)
3832 (setq dbl-space ; Determine double space action:
3833 (or (and (<= relative-depth 0) ; not descending;
3834 (save-excursion
3835 ;; at b-o-b or preceded by a blank line?
3836 (or (> 0 (forward-line -1))
3837 (looking-at "^\\s-*$")
3838 (bobp)))
3839 (save-excursion
3840 ;; succeeded by a blank line?
3841 (allout-end-of-current-subtree)
3842 (looking-at "\n\n")))
3843 (and (= ref-depth 1)
3844 (or before
3845 (= depth 1)
3846 (save-excursion
3847 ;; Don't already have following
3848 ;; vertical padding:
3849 (not (allout-pre-next-prefix)))))))
3850
3851 ;; Position to prior heading, if inserting backwards, and not
3852 ;; going outwards:
3853 (if (and before (>= relative-depth 0))
3854 (progn (allout-back-to-current-heading)
3855 (setq doing-beginning (bobp))
3856 (if (not (bobp))
3857 (allout-previous-heading)))
3858 (if (and before (bobp))
3859 (open-line 1)))
3860
3861 (if (<= relative-depth 0)
3862 ;; Not going inwards, don't snug up:
3863 (if doing-beginning
3864 (if (not dbl-space)
3865 (open-line 1)
3866 (open-line 2))
3867 (if before
3868 (progn (end-of-line)
3869 (allout-pre-next-prefix)
3870 (while (and (= ?\n (following-char))
3871 (save-excursion
3872 (forward-char 1)
3873 (allout-hidden-p)))
3874 (forward-char 1))
3875 (if (not (looking-at "^$"))
3876 (open-line 1)))
3877 (allout-end-of-current-subtree)
3878 (if (looking-at "\n\n") (forward-char 1))))
8dd59f01 3879 ;; Going inwards -- double-space if first offspring is
2a1408fd
DN
3880 ;; double-spaced, otherwise snug up.
3881 (allout-end-of-entry)
3882 (if (eobp)
3883 (newline 1)
3884 (line-move 1))
3885 (allout-beginning-of-current-line)
3886 (backward-char 1)
3887 (if (bolp)
3888 ;; Blank lines between current header body and next
8dd59f01 3889 ;; header -- get to last substantive (non-white-space)
2a1408fd
DN
3890 ;; line in body:
3891 (progn (setq dbl-space t)
3892 (re-search-backward "[^ \t\n]" nil t)))
3893 (if (looking-at "\n\n")
3894 (setq dbl-space t))
3895 (if (save-excursion
3896 (allout-next-heading)
3897 (when (> allout-recent-depth ref-depth)
3898 ;; This is an offspring.
3899 (forward-line -1)
3900 (looking-at "^\\s-*$")))
3901 (progn (forward-line 1)
96b83743 3902 (open-line 1)
2a1408fd
DN
3903 (forward-line 1)))
3904 (allout-end-of-current-line))
3905
3906 ;;(if doing-beginning (goto-char doing-beginning))
3907 (if (not (bobp))
3908 ;; We insert a newline char rather than using open-line to
3909 ;; avoid rear-stickiness inheritence of read-only property.
3910 (progn (if (and (not (> depth ref-depth))
3911 (not before))
3912 (open-line 1)
3913 (if (and (not dbl-space) (> depth ref-depth))
3914 (newline 1)
3915 (if dbl-space
3916 (open-line 1)
3917 (if (not before)
3918 (newline 1)))))
3919 (if (and dbl-space (not (> relative-depth 0)))
3920 (newline 1))
3921 (if (and (not (eobp))
3922 (or (not (bolp))
3923 (and (not (bobp))
3924 ;; bolp doesnt detect concealed
3925 ;; trailing newlines, compensate:
3926 (save-excursion
3927 (forward-char -1)
3928 (allout-hidden-p)))))
3929 (forward-char 1))))
3930 ))
3931 (setq start (point))
3932 (insert (concat (allout-make-topic-prefix opening-numbered t depth)
3933 " "))
3934 (setq end (1+ (point)))
3935
3936 (allout-rebullet-heading (and offer-recent-bullet ref-bullet)
3937 depth nil nil t)
3938 (if (> relative-depth 0)
3939 (save-excursion (goto-char ref-topic)
3940 (allout-show-children)))
3941 (end-of-line)
48bd8440 3942
2a1408fd
DN
3943 (run-hook-with-args 'allout-structure-added-hook start end)
3944 )
1977b8f6
RS
3945 )
3946 )
fd5359c6
MR
3947;;;_ > allout-open-subtopic (arg)
3948(defun allout-open-subtopic (arg)
c567ac01
RS
3949 "Open new topic header at deeper level than the current one.
3950
3951Negative universal arg means to open deeper, but place the new topic
3952prior to the current one."
1977b8f6 3953 (interactive "p")
d82979ea 3954 (allout-open-topic 1 (> 0 arg) (< 1 arg)))
fd5359c6
MR
3955;;;_ > allout-open-sibtopic (arg)
3956(defun allout-open-sibtopic (arg)
19b84ba3
RS
3957 "Open new topic header at same level as the current one.
3958
9179616f
DL
3959Positive universal arg means to use the bullet of the prior sibling.
3960
19b84ba3 3961Negative universal arg means to place the new topic prior to the current
c567ac01 3962one."
1977b8f6 3963 (interactive "p")
d82979ea 3964 (allout-open-topic 0 (> 0 arg) (not (= 1 arg))))
fd5359c6
MR
3965;;;_ > allout-open-supertopic (arg)
3966(defun allout-open-supertopic (arg)
c567ac01 3967 "Open new topic header at shallower level than the current one.
19b84ba3 3968
c567ac01
RS
3969Negative universal arg means to open shallower, but place the new
3970topic prior to the current one."
1977b8f6
RS
3971
3972 (interactive "p")
d82979ea 3973 (allout-open-topic -1 (> 0 arg) (< 1 arg)))
c567ac01
RS
3974
3975;;;_ - Outline Alteration
3976;;;_ : Topic Modification
fd5359c6
MR
3977;;;_ = allout-former-auto-filler
3978(defvar allout-former-auto-filler nil
2265e017 3979 "Name of modal fill function being wrapped by `allout-auto-fill'.")
fd5359c6
MR
3980;;;_ > allout-auto-fill ()
3981(defun allout-auto-fill ()
aad94676 3982 "`allout-mode' autofill function.
19b84ba3
RS
3983
3984Maintains outline hanging topic indentation if
fd5359c6 3985`allout-use-hanging-indents' is set."
01fc9422
EZ
3986
3987 (when (not allout-inhibit-auto-fill)
3988 (let ((fill-prefix (if allout-use-hanging-indents
3989 ;; Check for topic header indentation:
2a1408fd
DN
3990 (save-match-data
3991 (save-excursion
3992 (beginning-of-line)
3993 (if (looking-at allout-regexp)
3994 ;; ... construct indentation to account for
3995 ;; length of topic prefix:
3996 (make-string (progn (allout-end-of-prefix)
3997 (current-column))
3998 ?\ ))))))
7927f48d
KM
3999 (use-auto-fill-function
4000 (if (and (eq allout-outside-normal-auto-fill-function
4001 'allout-auto-fill)
4002 (eq auto-fill-function 'allout-auto-fill))
4003 'do-auto-fill
4004 (or allout-outside-normal-auto-fill-function
4005 auto-fill-function))))
01fc9422
EZ
4006 (if (or allout-former-auto-filler allout-use-hanging-indents)
4007 (funcall use-auto-fill-function)))))
fd5359c6
MR
4008;;;_ > allout-reindent-body (old-depth new-depth &optional number)
4009(defun allout-reindent-body (old-depth new-depth &optional number)
e126900f 4010 "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH.
c567ac01
RS
4011
4012Optional arg NUMBER indicates numbering is being added, and it must
a0776d6b 4013be accommodated.
c567ac01
RS
4014
4015Note that refill of indented paragraphs is not done."
1977b8f6
RS
4016
4017 (save-excursion
fd5359c6 4018 (allout-end-of-prefix)
c567ac01
RS
4019 (let* ((new-margin (current-column))
4020 excess old-indent-begin old-indent-end
c567ac01
RS
4021 ;; We want the column where the header-prefix text started
4022 ;; *before* the prefix was changed, so we infer it relative
4023 ;; to the new margin and the shift in depth:
4024 (old-margin (+ old-depth (- new-margin new-depth))))
353e2ef2 4025
c567ac01 4026 ;; Process lines up to (but excluding) next topic header:
fd5359c6 4027 (allout-unprotected
c567ac01
RS
4028 (save-match-data
4029 (while
96b83743 4030 (and (re-search-forward "\n\\(\\s-*\\)"
c567ac01
RS
4031 nil
4032 t)
4033 ;; Register the indent data, before we reset the
353e2ef2 4034 ;; match data with a subsequent `looking-at':
c567ac01
RS
4035 (setq old-indent-begin (match-beginning 1)
4036 old-indent-end (match-end 1))
fd5359c6 4037 (not (looking-at allout-regexp)))
d82979ea
EZ
4038 (if (> 0 (setq excess (- (- old-indent-end old-indent-begin)
4039 old-margin)))
60c7bbd2 4040 ;; Text starts left of old margin -- don't adjust:
c567ac01 4041 nil
ea18b2b1 4042 ;; Text was hanging at or right of old left margin --
c567ac01
RS
4043 ;; reindent it, preserving its existing indentation
4044 ;; beyond the old margin:
4045 (delete-region old-indent-begin old-indent-end)
d82979ea 4046 (indent-to (+ new-margin excess (current-column))))))))))
fd5359c6
MR
4047;;;_ > allout-rebullet-current-heading (arg)
4048(defun allout-rebullet-current-heading (arg)
9179616f
DL
4049 "Solicit new bullet for current visible heading."
4050 (interactive "p")
4051 (let ((initial-col (current-column))
fd5359c6 4052 (on-bullet (eq (point)(allout-current-bullet-pos)))
d8350998 4053 from to
9179616f
DL
4054 (backwards (if (< arg 0)
4055 (setq arg (* arg -1)))))
4056 (while (> arg 0)
fd5359c6
MR
4057 (save-excursion (allout-back-to-current-heading)
4058 (allout-end-of-prefix)
d8350998
CY
4059 (setq from allout-recent-prefix-beginning
4060 to allout-recent-prefix-end)
fd5359c6 4061 (allout-rebullet-heading t ;;; solicit
9179616f
DL
4062 nil ;;; depth
4063 nil ;;; number-control
4064 nil ;;; index
d8350998
CY
4065 t) ;;; do-successors
4066 (run-hook-with-args 'allout-exposure-change-hook
4067 from to t))
9179616f
DL
4068 (setq arg (1- arg))
4069 (if (<= arg 0)
4070 nil
4071 (setq initial-col nil) ; Override positioning back to init col
4072 (if (not backwards)
fd5359c6 4073 (allout-next-visible-heading 1)
d8350998 4074 (allout-goto-prefix-doublechecked)
fd5359c6 4075 (allout-next-visible-heading -1))))
9179616f 4076 (message "Done.")
fd5359c6 4077 (cond (on-bullet (goto-char (allout-current-bullet-pos)))
9179616f 4078 (initial-col (move-to-column initial-col)))))
fd5359c6
MR
4079;;;_ > allout-rebullet-heading (&optional solicit ...)
4080(defun allout-rebullet-heading (&optional solicit
1977b8f6
RS
4081 new-depth
4082 number-control
4083 index
4084 do-successors)
4085
c567ac01 4086 "Adjust bullet of current topic prefix.
1977b8f6 4087
d82979ea
EZ
4088All args are optional.
4089
9179616f
DL
4090If SOLICIT is non-nil, then the choice of bullet is solicited from
4091user. If it's a character, then that character is offered as the
c07583cd 4092default, otherwise the one suited to the context (according to
9179616f
DL
4093distinction or depth) is offered. If non-nil, then the
4094context-specific bullet is just used.
1977b8f6 4095
d82979ea 4096Second arg DEPTH forces the topic prefix to that depth, regardless
9179616f 4097of the topic's current depth.
1977b8f6 4098
c567ac01 4099Third arg NUMBER-CONTROL can force the prefix to or away from
fd5359c6 4100numbered form. It has effect only if `allout-numbered-bullet' is
c567ac01
RS
4101non-nil and soliciting was not explicitly invoked (via first arg).
4102Its effect, numbering or denumbering, then depends on the setting
75bcb912 4103of the fourth arg, INDEX.
1977b8f6 4104
75bcb912 4105If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the
c567ac01
RS
4106prefix of the topic is forced to be non-numbered. Null index and
4107non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
4108non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
4109INDEX is a number, then that number is used for the numbered
4110prefix. Non-nil and non-number means that the index for the
d82979ea 4111numbered prefix will be derived by allout-make-topic-prefix.
1977b8f6 4112
c567ac01
RS
4113Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
4114siblings.
1977b8f6 4115
fd5359c6
MR
4116Cf vars `allout-stylish-prefixes', `allout-old-style-prefixes',
4117and `allout-numbered-bullet', which all affect the behavior of
c567ac01 4118this function."
1977b8f6 4119
fd5359c6 4120 (let* ((current-depth (allout-depth))
1977b8f6 4121 (new-depth (or new-depth current-depth))
fd5359c6
MR
4122 (mb allout-recent-prefix-beginning)
4123 (me allout-recent-prefix-end)
d8350998 4124 (current-bullet (buffer-substring-no-properties (- me 1) me))
ede4ac6a 4125 (has-annotation (get-text-property mb 'allout-was-hidden))
fd5359c6 4126 (new-prefix (allout-make-topic-prefix current-bullet
1977b8f6
RS
4127 nil
4128 new-depth
4129 solicit
4130 number-control
4131 index)))
4132
c567ac01 4133 ;; Is new one is identical to old?
1977b8f6
RS
4134 (if (and (= current-depth new-depth)
4135 (string= current-bullet
4136 (substring new-prefix (1- (length new-prefix)))))
c567ac01 4137 ;; Nothing to do:
1977b8f6
RS
4138 t
4139
4140 ;; New prefix probably different from old:
c567ac01 4141 ; get rid of old one:
fd5359c6 4142 (allout-unprotected (delete-region mb me))
1977b8f6 4143 (goto-char mb)
c567ac01
RS
4144 ; Dispense with number if
4145 ; numbered-bullet prefix:
2a1408fd
DN
4146 (save-match-data
4147 (if (and allout-numbered-bullet
4148 (string= allout-numbered-bullet current-bullet)
4149 (looking-at "[0-9]+"))
4150 (allout-unprotected
4151 (delete-region (match-beginning 0)(match-end 0)))))
1977b8f6 4152
ede4ac6a
KS
4153 ;; convey 'allout-was-hidden annotation, if original had it:
4154 (if has-annotation
4155 (put-text-property 0 (length new-prefix) 'allout-was-hidden t
4156 new-prefix))
4157
c567ac01 4158 ; Put in new prefix:
fd5359c6 4159 (allout-unprotected (insert new-prefix))
1977b8f6 4160
d82979ea 4161 ;; Reindent the body if elected, margin changed, and not encrypted body:
fd5359c6 4162 (if (and allout-reindent-bodies
d82979ea
EZ
4163 (not (= new-depth current-depth))
4164 (not (allout-encrypted-topic-p)))
fd5359c6 4165 (allout-reindent-body current-depth new-depth))
1977b8f6 4166
c567ac01
RS
4167 ;; Recursively rectify successive siblings of orig topic if
4168 ;; caller elected for it:
4169 (if do-successors
4170 (save-excursion
fd5359c6 4171 (while (allout-next-sibling new-depth nil)
c567ac01
RS
4172 (setq index
4173 (cond ((numberp index) (1+ index))
fd5359c6
MR
4174 ((not number-control) (allout-sibling-index))))
4175 (if (allout-numbered-type-prefix)
4176 (allout-rebullet-heading nil ;;; solicit
c567ac01
RS
4177 new-depth ;;; new-depth
4178 number-control;;; number-control
4179 index ;;; index
4180 nil))))) ;;;(dont!)do-successors
4181 ) ; (if (and (= current-depth new-depth)...))
fd5359c6 4182 ) ; let* ((current-depth (allout-depth))...)
c567ac01 4183 ) ; defun
fd5359c6 4184;;;_ > allout-rebullet-topic (arg)
d8350998 4185(defun allout-rebullet-topic (arg &optional sans-offspring)
d82979ea 4186 "Rebullet the visible topic containing point and all contained subtopics.
19b84ba3 4187
c567ac01 4188Descends into invisible as well as visible topics, however.
1977b8f6 4189
75bcb912 4190When optional SANS-OFFSPRING is non-nil, subtopics are not
c07583cd 4191shifted. (Shifting a topic outwards without shifting its
d8350998
CY
4192offspring is disallowed, since this would create a \"containment
4193discontinuity\", where the depth difference between a topic and
4194its immediate offspring is greater than one.)
4195
c567ac01 4196With repeat count, shift topic depth by that amount."
1977b8f6 4197 (interactive "P")
96b83743 4198 (let ((start-col (current-column)))
1977b8f6
RS
4199 (save-excursion
4200 ;; Normalize arg:
4201 (cond ((null arg) (setq arg 0))
4202 ((listp arg) (setq arg (car arg))))
4203 ;; Fill the user in, in case we're shifting a big topic:
4204 (if (not (zerop arg)) (message "Shifting..."))
fd5359c6 4205 (allout-back-to-current-heading)
d8350998 4206 (if (<= (+ allout-recent-depth arg) 0)
1977b8f6 4207 (error "Attempt to shift topic below level 1"))
d8350998 4208 (allout-rebullet-topic-grunt arg nil nil nil nil sans-offspring)
1977b8f6 4209 (if (not (zerop arg)) (message "Shifting... done.")))
c567ac01 4210 (move-to-column (max 0 (+ start-col arg)))))
d8350998 4211;;;_ > allout-rebullet-topic-grunt (&optional relative-depth ...)
fd5359c6 4212(defun allout-rebullet-topic-grunt (&optional relative-depth
1977b8f6
RS
4213 starting-depth
4214 starting-point
4215 index
d8350998
CY
4216 do-successors
4217 sans-offspring)
d82979ea
EZ
4218 "Like `allout-rebullet-topic', but on nearest containing topic
4219\(visible or not).
1977b8f6 4220
d82979ea 4221See `allout-rebullet-heading' for rebulleting behavior.
1977b8f6 4222
d82979ea 4223All arguments are optional.
1977b8f6 4224
d82979ea
EZ
4225First arg RELATIVE-DEPTH means to shift the depth of the entire
4226topic that amount.
e126900f 4227
d8350998
CY
4228Several subsequent args are for internal recursive use by the function
4229itself: STARTING-DEPTH, STARTING-POINT, and INDEX.
4230
4231Finally, if optional SANS-OFFSPRING is non-nil then the offspring
c07583cd 4232are not shifted. (Shifting a topic outwards without shifting
d8350998
CY
4233its offspring is disallowed, since this would create a
4234\"containment discontinuity\", where the depth difference between
75bcb912 4235a topic and its immediate offspring is greater than one.)"
d8350998
CY
4236
4237 ;; XXX the recursion here is peculiar, and in general the routine may
4238 ;; need simplification with refactoring.
4239
4240 (if (and sans-offspring
4241 relative-depth
4242 (< relative-depth 0))
4243 (error (concat "Attempt to shift topic outwards without offspring,"
4244 " would cause containment discontinuity.")))
1977b8f6
RS
4245
4246 (let* ((relative-depth (or relative-depth 0))
fd5359c6 4247 (new-depth (allout-depth))
1977b8f6
RS
4248 (starting-depth (or starting-depth new-depth))
4249 (on-starting-call (null starting-point))
4250 (index (or index
4251 ;; Leave index null on starting call, so rebullet-heading
4252 ;; calculates it at what might be new depth:
4253 (and (or (zerop relative-depth)
4254 (not on-starting-call))
fd5359c6 4255 (allout-sibling-index))))
d8350998 4256 (starting-index index)
1977b8f6 4257 (moving-outwards (< 0 relative-depth))
d8350998
CY
4258 (starting-point (or starting-point (point)))
4259 (local-point (point)))
1977b8f6
RS
4260
4261 ;; Sanity check for excessive promotion done only on starting call:
4262 (and on-starting-call
4263 moving-outwards
4264 (> 0 (+ starting-depth relative-depth))
d8350998 4265 (error "Attempt to shift topic out beyond level 1"))
1977b8f6
RS
4266
4267 (cond ((= starting-depth new-depth)
d8350998
CY
4268 ;; We're at depth to work on this one.
4269
4270 ;; When shifting out we work on the children before working on
4271 ;; the parent to avoid interim `allout-aberrant-container-p'
4272 ;; aberrancy, and vice-versa when shifting in:
4273 (if (>= relative-depth 0)
4274 (allout-rebullet-heading nil
4275 (+ starting-depth relative-depth)
4276 nil ;;; number
4277 index
4278 nil)) ;;; do-successors
4279 (when (not sans-offspring)
4280 ;; ... and work on subsequent ones which are at greater depth:
4281 (setq index 0)
4282 (allout-next-heading)
4283 (while (and (not (eobp))
4284 (< starting-depth (allout-depth)))
4285 (setq index (1+ index))
4286 (allout-rebullet-topic-grunt relative-depth
4287 (1+ starting-depth)
4288 starting-point
4289 index)))
4290 (when (< relative-depth 0)
4291 (save-excursion
4292 (goto-char local-point)
4293 (allout-rebullet-heading nil ;;; solicit
4294 (+ starting-depth relative-depth)
4295 nil ;;; number
4296 starting-index
4297 nil)))) ;;; do-successors
1977b8f6
RS
4298
4299 ((< starting-depth new-depth)
60c7bbd2 4300 ;; Rare case -- subtopic more than one level deeper than parent.
1977b8f6 4301 ;; Treat this one at an even deeper level:
d8350998
CY
4302 (allout-rebullet-topic-grunt relative-depth
4303 new-depth
4304 starting-point
4305 index
4306 sans-offspring)))
1977b8f6
RS
4307
4308 (if on-starting-call
4309 (progn
4310 ;; Rectify numbering of former siblings of the adjusted topic,
4311 ;; if topic has changed depth
4312 (if (or do-successors
4313 (and (not (zerop relative-depth))
d8350998
CY
4314 (or (= allout-recent-depth starting-depth)
4315 (= allout-recent-depth (+ starting-depth
1977b8f6 4316 relative-depth)))))
fd5359c6 4317 (allout-rebullet-heading nil nil nil nil t))
1977b8f6
RS
4318 ;; Now rectify numbering of new siblings of the adjusted topic,
4319 ;; if depth has been changed:
4320 (progn (goto-char starting-point)
4321 (if (not (zerop relative-depth))
fd5359c6 4322 (allout-rebullet-heading nil nil nil nil t)))))
1977b8f6
RS
4323 )
4324 )
fd5359c6
MR
4325;;;_ > allout-renumber-to-depth (&optional depth)
4326(defun allout-renumber-to-depth (&optional depth)
19b84ba3
RS
4327 "Renumber siblings at current depth.
4328
4329Affects superior topics if optional arg DEPTH is less than current depth.
c567ac01
RS
4330
4331Returns final depth."
4332
4333 ;; Proceed by level, processing subsequent siblings on each,
4334 ;; ascending until we get shallower than the start depth:
4335
fd5359c6 4336 (let ((ascender (allout-depth))
9179616f 4337 was-eobp)
c567ac01 4338 (while (and (not (eobp))
fd5359c6 4339 (allout-depth)
d8350998 4340 (>= allout-recent-depth depth)
c567ac01
RS
4341 (>= ascender depth))
4342 ; Skip over all topics at
4343 ; lesser depths, which can not
4344 ; have been disturbed:
9179616f 4345 (while (and (not (setq was-eobp (eobp)))
d8350998 4346 (> allout-recent-depth ascender))
fd5359c6 4347 (allout-next-heading))
c567ac01 4348 ; Prime ascender for ascension:
d8350998
CY
4349 (setq ascender (1- allout-recent-depth))
4350 (if (>= allout-recent-depth depth)
fd5359c6 4351 (allout-rebullet-heading nil ;;; solicit
c567ac01
RS
4352 nil ;;; depth
4353 nil ;;; number-control
4354 nil ;;; index
9179616f
DL
4355 t)) ;;; do-successors
4356 (if was-eobp (goto-char (point-max)))))
d8350998 4357 allout-recent-depth)
fd5359c6
MR
4358;;;_ > allout-number-siblings (&optional denumber)
4359(defun allout-number-siblings (&optional denumber)
c567ac01 4360 "Assign numbered topic prefix to this topic and its siblings.
1977b8f6 4361
60c7bbd2 4362With universal argument, denumber -- assign default bullet to this
c567ac01 4363topic and its siblings.
1977b8f6 4364
c567ac01
RS
4365With repeated universal argument (`^U^U'), solicit bullet for each
4366rebulleting each topic at this level."
1977b8f6
RS
4367
4368 (interactive "P")
4369
4370 (save-excursion
fd5359c6
MR
4371 (allout-back-to-current-heading)
4372 (allout-beginning-of-level)
d8350998 4373 (let ((depth allout-recent-depth)
c567ac01 4374 (index (if (not denumber) 1))
1977b8f6
RS
4375 (use-bullet (equal '(16) denumber))
4376 (more t))
4377 (while more
fd5359c6 4378 (allout-rebullet-heading use-bullet ;;; solicit
c567ac01 4379 depth ;;; depth
1977b8f6
RS
4380 t ;;; number-control
4381 index ;;; index
4382 nil) ;;; do-successors
4383 (if index (setq index (1+ index)))
fd5359c6
MR
4384 (setq more (allout-next-sibling depth nil))))))
4385;;;_ > allout-shift-in (arg)
4386(defun allout-shift-in (arg)
d8350998
CY
4387 "Increase depth of current heading and any items collapsed within it.
4388
4389With a negative argument, the item is shifted out using
4390`allout-shift-out', instead.
4391
4392With an argument greater than one, shift-in the item but not its
4393offspring, making the item into a sibling of its former children,
4394and a child of sibling that formerly preceeded it.
4395
4396You are not allowed to shift the first offspring of a topic
4397inwards, because that would yield a \"containment
4398discontinuity\", where the depth difference between a topic and
4399its immediate offspring is greater than one. The first topic in
4400the file can be adjusted to any positive depth, however."
d82979ea 4401
1977b8f6 4402 (interactive "p")
d8350998
CY
4403 (if (< arg 0)
4404 (allout-shift-out (* arg -1))
4405 ;; refuse to create a containment discontinuity:
4406 (save-excursion
4407 (allout-back-to-current-heading)
4408 (if (not (bobp))
4409 (let* ((current-depth allout-recent-depth)
4410 (start-point (point))
4411 (predecessor-depth (progn
4412 (forward-char -1)
4413 (allout-goto-prefix-doublechecked)
4414 (if (< (point) start-point)
4415 allout-recent-depth
4416 0))))
4417 (if (and (> predecessor-depth 0)
4418 (> (1+ current-depth)
4419 (1+ predecessor-depth)))
4420 (error (concat "Disallowed shift deeper than"
498a6493
CY
4421 " containing topic's children."))
4422 (allout-back-to-current-heading)
4423 (if (< allout-recent-depth (1+ current-depth))
4424 (allout-show-children))))))
d8350998
CY
4425 (let ((where (point)))
4426 (allout-rebullet-topic 1 (and (> arg 1) 'sans-offspring))
4427 (run-hook-with-args 'allout-structure-shifted-hook arg where))))
fd5359c6
MR
4428;;;_ > allout-shift-out (arg)
4429(defun allout-shift-out (arg)
d82979ea 4430 "Decrease depth of current heading and any topics collapsed within it.
d8350998
CY
4431This will make the item a sibling of its former container.
4432
4433With a negative argument, the item is shifted in using
4434`allout-shift-in', instead.
4435
4436With an argument greater than one, shift-out the item's offspring
4437but not the item itself, making the former children siblings of
4438the item.
d82979ea 4439
d8350998
CY
4440With an argument greater than 1, the item's offspring are shifted
4441out without shifting the item. This will make the immediate
4442subtopics into siblings of the item."
1977b8f6 4443 (interactive "p")
d8350998
CY
4444 (if (< arg 0)
4445 (allout-shift-in (* arg -1))
4446 ;; Get proper exposure in this area:
4447 (save-excursion (if (allout-ascend)
4448 (allout-show-children)))
4449 ;; Show collapsed children if there's a successor which will become
4450 ;; their sibling:
4451 (if (and (allout-current-topic-collapsed-p)
4452 (save-excursion (allout-next-sibling)))
4453 (allout-show-children))
4454 (let ((where (and (allout-depth) allout-recent-prefix-beginning)))
4455 (save-excursion
4456 (if (> arg 1)
4457 ;; Shift the offspring but not the topic:
4458 (let ((children-chart (allout-chart-subtree 1)))
4459 (if (listp (car children-chart))
4460 ;; whoops:
4461 (setq children-chart (allout-flatten children-chart)))
4462 (save-excursion
4463 (dolist (child-point children-chart)
4464 (goto-char child-point)
4465 (allout-shift-out 1))))
4466 (allout-rebullet-topic (* arg -1))))
4467 (run-hook-with-args 'allout-structure-shifted-hook (* arg -1) where))))
c567ac01 4468;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
fd5359c6
MR
4469;;;_ > allout-kill-line (&optional arg)
4470(defun allout-kill-line (&optional arg)
c567ac01 4471 "Kill line, adjusting subsequent lines suitably for outline mode."
1977b8f6
RS
4472
4473 (interactive "*P")
d82979ea 4474
96b83743
EZ
4475 (if (or (not (allout-mode-p))
4476 (not (bolp))
2a1408fd 4477 (not (save-match-data (looking-at allout-regexp))))
4034b0e2 4478 ;; Just do a regular kill:
96b83743
EZ
4479 (kill-line arg)
4480 ;; Ah, have to watch out for adjustments:
4481 (let* ((beg (point))
d8350998 4482 end
96b83743
EZ
4483 (beg-hidden (allout-hidden-p))
4484 (end-hidden (save-excursion (allout-end-of-current-line)
d8350998 4485 (setq end (point))
96b83743 4486 (allout-hidden-p)))
d8350998 4487 (depth (allout-depth)))
96b83743 4488
d8350998 4489 (allout-annotate-hidden beg end)
96b83743
EZ
4490 (if (and (not beg-hidden) (not end-hidden))
4491 (allout-unprotected (kill-line arg))
4492 (kill-line arg))
ede4ac6a
KS
4493 (allout-deannotate-hidden beg end)
4494
96b83743
EZ
4495 (if allout-numbered-bullet
4496 (save-excursion ; Renumber subsequent topics if needed:
2a1408fd 4497 (if (not (save-match-data (looking-at allout-regexp)))
d82979ea 4498 (allout-next-heading))
48bd8440
EZ
4499 (allout-renumber-to-depth depth)))
4500 (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
1b4d97b2
CY
4501;;;_ > allout-copy-line-as-kill ()
4502(defun allout-copy-line-as-kill ()
4503 "Like allout-kill-topic, but save to kill ring instead of deleting."
4504 (interactive)
4505 (let ((buffer-read-only t))
4506 (condition-case nil
4507 (allout-kill-line)
4508 (buffer-read-only nil))))
fd5359c6
MR
4509;;;_ > allout-kill-topic ()
4510(defun allout-kill-topic ()
c567ac01
RS
4511 "Kill topic together with subtopics.
4512
96b83743
EZ
4513Trailing whitespace is killed with a topic if that whitespace:
4514
4515 - would separate the topic from a subsequent sibling
4516 - would separate the topic from the end of buffer
4517 - would not be added to whitespace already separating the topic from the
4518 previous one.
4519
d8350998 4520Topic exposure is marked with text-properties, to be used by
75bcb912 4521`allout-yank-processing' for exposure recovery."
1977b8f6
RS
4522
4523 (interactive)
0458fa80 4524 (let* ((inhibit-field-text-motion t)
96b83743 4525 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
ede4ac6a 4526 end
d8350998 4527 (depth allout-recent-depth))
fd5359c6 4528 (allout-end-of-current-subtree)
96b83743
EZ
4529 (if (and (/= (current-column) 0) (not (eobp)))
4530 (forward-char 1))
1977b8f6 4531 (if (not (eobp))
2a1408fd 4532 (if (and (save-match-data (looking-at "\n"))
96b83743
EZ
4533 (or (save-excursion
4534 (or (not (allout-next-heading))
d8350998 4535 (= depth allout-recent-depth)))
96b83743
EZ
4536 (and (> (- beg (point-min)) 3)
4537 (string= (buffer-substring (- beg 2) beg) "\n\n"))))
c567ac01 4538 (forward-char 1)))
353e2ef2 4539
ede4ac6a
KS
4540 (allout-annotate-hidden beg (setq end (point)))
4541 (unwind-protect
4542 (allout-unprotected (kill-region beg end))
4543 (if buffer-read-only
4544 ;; eg, during copy-as-kill.
4545 (allout-deannotate-hidden beg end)))
d8350998 4546
1977b8f6 4547 (save-excursion
48bd8440
EZ
4548 (allout-renumber-to-depth depth))
4549 (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
1b4d97b2
CY
4550;;;_ > allout-copy-topic-as-kill ()
4551(defun allout-copy-topic-as-kill ()
75bcb912 4552 "Like `allout-kill-topic', but save to kill ring instead of deleting."
1b4d97b2
CY
4553 (interactive)
4554 (let ((buffer-read-only t))
4555 (condition-case nil
4556 (allout-kill-topic)
4557 (buffer-read-only (message "Topic copied...")))))
d8350998
CY
4558;;;_ > allout-annotate-hidden (begin end)
4559(defun allout-annotate-hidden (begin end)
4560 "Qualify text with properties to indicate exposure status."
4561
1b4d97b2
CY
4562 (let ((was-modified (buffer-modified-p))
4563 (buffer-read-only nil))
ede4ac6a 4564 (allout-deannotate-hidden begin end)
d8350998
CY
4565 (save-excursion
4566 (goto-char begin)
4567 (let (done next prev overlay)
4568 (while (not done)
4569 ;; at or advance to start of next hidden region:
4570 (if (not (allout-hidden-p))
4571 (setq next
1b4d97b2 4572 (max (1+ (point))
1c9b9df0
KM
4573 (allout-next-single-char-property-change (point)
4574 'invisible
4575 nil end))))
d8350998 4576 (if (or (not next) (eq prev next))
60c7bbd2 4577 ;; still not at start of hidden area -- must not be any left.
d8350998
CY
4578 (setq done t)
4579 (goto-char next)
4580 (setq prev next)
4581 (if (not (allout-hidden-p))
4582 ;; still not at start of hidden area.
4583 (setq done t)
4584 (setq overlay (allout-get-invisibility-overlay))
4585 (setq next (overlay-end overlay)
4586 prev next)
4587 ;; advance to end of this hidden area:
4588 (when next
4589 (goto-char next)
4590 (allout-unprotected
ede4ac6a
KS
4591 (let ((buffer-undo-list t))
4592 (put-text-property (overlay-start overlay) next
4593 'allout-was-hidden t)))))))))
d8350998 4594 (set-buffer-modified-p was-modified)))
ede4ac6a
KS
4595;;;_ > allout-deannotate-hidden (begin end)
4596(defun allout-deannotate-hidden (begin end)
4597 "Remove allout hidden-text annotation between BEGIN and END."
4598
4599 (allout-unprotected
4600 (let ((inhibit-read-only t)
4601 (buffer-undo-list t))
4602 ;(remove-text-properties begin end '(allout-was-hidden t))
4603 )))
d8350998
CY
4604;;;_ > allout-hide-by-annotation (begin end)
4605(defun allout-hide-by-annotation (begin end)
4606 "Translate text properties indicating exposure status into actual exposure."
4607 (save-excursion
4608 (goto-char begin)
4609 (let ((was-modified (buffer-modified-p))
4610 done next prev)
4611 (while (not done)
4612 ;; at or advance to start of next annotation:
4613 (if (not (get-text-property (point) 'allout-was-hidden))
1c9b9df0
KM
4614 (setq next (allout-next-single-char-property-change
4615 (point) 'allout-was-hidden nil end)))
d8350998 4616 (if (or (not next) (eq prev next))
60c7bbd2 4617 ;; no more or not advancing -- must not be any left.
d8350998
CY
4618 (setq done t)
4619 (goto-char next)
4620 (setq prev next)
4621 (if (not (get-text-property (point) 'allout-was-hidden))
4622 ;; still not at start of annotation.
4623 (setq done t)
4624 ;; advance to just after end of this annotation:
1c9b9df0
KM
4625 (setq next (allout-next-single-char-property-change
4626 (point) 'allout-was-hidden nil end))
2a1408fd 4627 (overlay-put (make-overlay prev next nil 'front-advance)
d8350998 4628 'category 'allout-exposure-category)
ede4ac6a 4629 (allout-deannotate-hidden prev next)
d8350998
CY
4630 (setq prev next)
4631 (if next (goto-char next)))))
4632 (set-buffer-modified-p was-modified))))
fd5359c6
MR
4633;;;_ > allout-yank-processing ()
4634(defun allout-yank-processing (&optional arg)
c567ac01 4635
96b83743 4636 "Incidental allout-specific business to be done just after text yanks.
19b84ba3 4637
c567ac01 4638Does depth adjustment of yanked topics, when:
1977b8f6 4639
c567ac01
RS
46401 the stuff being yanked starts with a valid outline header prefix, and
46412 it is being yanked at the end of a line which consists of only a valid
1977b8f6
RS
4642 topic prefix.
4643
a0776d6b 4644Also, adjusts numbering of subsequent siblings when appropriate.
1977b8f6 4645
c567ac01
RS
4646Depth adjustment alters the depth of all the topics being yanked
4647the amount it takes to make the first topic have the depth of the
4648header into which it's being yanked.
1977b8f6 4649
c567ac01
RS
4650The point is left in front of yanked, adjusted topics, rather than
4651at the end (and vice-versa with the mark). Non-adjusted yanks,
d82979ea 4652however, are left exactly like normal, non-allout-specific yanks."
c567ac01
RS
4653
4654 (interactive "*P")
4655 ; Get to beginning, leaving
4656 ; region around subject:
96b83743 4657 (if (< (allout-mark-marker t) (point))
c567ac01 4658 (exchange-point-and-mark))
2a1408fd
DN
4659 (save-match-data
4660 (let* ((subj-beg (point))
4661 (into-bol (bolp))
4662 (subj-end (allout-mark-marker t))
4663 ;; 'resituate' if yanking an entire topic into topic header:
4664 (resituate (and (let ((allout-inhibit-aberrance-doublecheck t))
4665 (allout-e-o-prefix-p))
4666 (looking-at allout-regexp)
4667 (allout-prefix-data)))
4668 ;; `rectify-numbering' if resituating (where several topics may
4669 ;; be resituating) or yanking a topic into a topic slot (bol):
4670 (rectify-numbering (or resituate
8dd59f01 4671 (and into-bol (looking-at allout-regexp)))))
2a1408fd 4672 (if resituate
8dd59f01 4673 ;; Yanking a topic into the start of a topic -- reconcile to fit:
2a1408fd
DN
4674 (let* ((inhibit-field-text-motion t)
4675 (prefix-len (if (not (match-end 1))
4676 1
4677 (- (match-end 1) subj-beg)))
4678 (subj-depth allout-recent-depth)
4679 (prefix-bullet (allout-recent-bullet))
4680 (adjust-to-depth
4681 ;; Nil if adjustment unnecessary, otherwise depth to which
4682 ;; adjustment should be made:
4683 (save-excursion
4684 (and (goto-char subj-end)
4685 (eolp)
4686 (goto-char subj-beg)
4687 (and (looking-at allout-regexp)
4688 (progn
4689 (beginning-of-line)
4690 (not (= (point) subj-beg)))
4691 (looking-at allout-regexp)
4692 (allout-prefix-data))
4693 allout-recent-depth)))
4694 (more t))
4695 (setq rectify-numbering allout-numbered-bullet)
4696 (if adjust-to-depth
c567ac01 4697 ; Do the adjustment:
2a1408fd
DN
4698 (progn
4699 (save-restriction
4700 (narrow-to-region subj-beg subj-end)
c567ac01
RS
4701 ; Trim off excessive blank
4702 ; line at end, if any:
2a1408fd
DN
4703 (goto-char (point-max))
4704 (if (looking-at "^$")
4705 (allout-unprotected (delete-char -1)))
c567ac01
RS
4706 ; Work backwards, with each
4707 ; shallowest level,
4708 ; successively excluding the
4709 ; last processed topic from
4710 ; the narrow region:
2a1408fd
DN
4711 (while more
4712 (allout-back-to-current-heading)
c567ac01 4713 ; go as high as we can in each bunch:
2a1408fd
DN
4714 (while (allout-ascend t))
4715 (save-excursion
4716 (allout-unprotected
4717 (allout-rebullet-topic-grunt (- adjust-to-depth
4718 subj-depth)))
4719 (allout-depth))
4720 (if (setq more (not (bobp)))
4721 (progn (widen)
4722 (forward-char -1)
4723 (narrow-to-region subj-beg (point))))))
4724 ;; Preserve new bullet if it's a distinctive one, otherwise
4725 ;; use old one:
4726 (if (string-match (regexp-quote prefix-bullet)
4727 allout-distinctive-bullets-string)
c567ac01
RS
4728 ; Delete from bullet of old to
4729 ; before bullet of new:
2a1408fd
DN
4730 (progn
4731 (beginning-of-line)
4732 (allout-unprotected
4733 (delete-region (point) subj-beg))
4734 (set-marker (allout-mark-marker t) subj-end)
4735 (goto-char subj-beg)
4736 (allout-end-of-prefix))
c567ac01
RS
4737 ; Delete base subj prefix,
4738 ; leaving old one:
2a1408fd
DN
4739 (allout-unprotected
4740 (progn
4741 (delete-region (point) (+ (point)
4742 prefix-len
4743 (- adjust-to-depth
4744 subj-depth)))
c567ac01
RS
4745 ; and delete residual subj
4746 ; prefix digits and space:
2a1408fd
DN
4747 (while (looking-at "[0-9]") (delete-char 1))
4748 (if (looking-at " ")
4749 (delete-char 1))))))
4750 (exchange-point-and-mark))))
4751 (if rectify-numbering
4752 (progn
4753 (save-excursion
c567ac01 4754 ; Give some preliminary feedback:
2a1408fd 4755 (message "... reconciling numbers")
c567ac01 4756 ; ... and renumber, in case necessary:
2a1408fd
DN
4757 (goto-char subj-beg)
4758 (if (allout-goto-prefix-doublechecked)
4759 (allout-unprotected
4760 (allout-rebullet-heading nil ;;; solicit
4761 (allout-depth) ;;; depth
4762 nil ;;; number-control
4763 nil ;;; index
4764 t)))
4765 (message ""))))
4766 (if (or into-bol resituate)
4767 (allout-hide-by-annotation (point) (allout-mark-marker t))
4768 (allout-deannotate-hidden (allout-mark-marker t) (point)))
4769 (if (not resituate)
4770 (exchange-point-and-mark))
4771 (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
fd5359c6
MR
4772;;;_ > allout-yank (&optional arg)
4773(defun allout-yank (&optional arg)
aad94676 4774 "`allout-mode' yank, with depth and numbering adjustment of yanked topics.
19b84ba3 4775
a0776d6b 4776Non-topic yanks work no differently than normal yanks.
c567ac01
RS
4777
4778If a topic is being yanked into a bare topic prefix, the depth of the
4779yanked topic is adjusted to the depth of the topic prefix.
4780
2265e017 4781 1 we're yanking in an `allout-mode' buffer
c567ac01
RS
4782 2 the stuff being yanked starts with a valid outline header prefix, and
4783 3 it is being yanked at the end of a line which consists of only a valid
4784 topic prefix.
4785
4786If these conditions hold then the depth of the yanked topics are all
4787adjusted the amount it takes to make the first one at the depth of the
4788header into which it's being yanked.
4789
4790The point is left in front of yanked, adjusted topics, rather than
4791at the end (and vice-versa with the mark). Non-adjusted yanks,
4792however, (ones that don't qualify for adjustment) are handled
4793exactly like normal yanks.
4794
a0776d6b 4795Numbering of yanked topics, and the successive siblings at the depth
c567ac01
RS
4796into which they're being yanked, is adjusted.
4797
539d7736
JB
4798`allout-yank-pop' works with `allout-yank' just like normal `yank-pop'
4799works with normal `yank' in non-outline buffers."
1977b8f6
RS
4800
4801 (interactive "*P")
4802 (setq this-command 'yank)
48bd8440
EZ
4803 (allout-unprotected
4804 (yank arg))
fd5359c6 4805 (if (allout-mode-p)
48bd8440 4806 (allout-yank-processing)))
fd5359c6
MR
4807;;;_ > allout-yank-pop (&optional arg)
4808(defun allout-yank-pop (&optional arg)
2265e017 4809 "Yank-pop like `allout-yank' when popping to bare outline prefixes.
19b84ba3
RS
4810
4811Adapts level of popped topics to level of fresh prefix.
c567ac01 4812
60c7bbd2 4813Note -- prefix changes to distinctive bullets will stick, if followed
c567ac01 4814by pops to non-distinctive yanks. Bug..."
1977b8f6
RS
4815
4816 (interactive "*p")
1977b8f6 4817 (setq this-command 'yank)
c567ac01 4818 (yank-pop arg)
fd5359c6
MR
4819 (if (allout-mode-p)
4820 (allout-yank-processing)))
1977b8f6 4821
c567ac01
RS
4822;;;_ - Specialty bullet functions
4823;;;_ : File Cross references
fd5359c6
MR
4824;;;_ > allout-resolve-xref ()
4825(defun allout-resolve-xref ()
19b84ba3
RS
4826 "Pop to file associated with current heading, if it has an xref bullet.
4827
fd5359c6 4828\(Works according to setting of `allout-file-xref-bullet')."
1977b8f6 4829 (interactive)
fd5359c6 4830 (if (not allout-file-xref-bullet)
1977b8f6 4831 (error
60c7bbd2 4832 "Outline cross references disabled -- no `allout-file-xref-bullet'")
fd5359c6 4833 (if (not (string= (allout-current-bullet) allout-file-xref-bullet))
635ca796 4834 (error "Current heading lacks cross-reference bullet `%s'"
fd5359c6 4835 allout-file-xref-bullet)
0458fa80
EZ
4836 (let ((inhibit-field-text-motion t)
4837 file-name)
2a1408fd
DN
4838 (save-match-data
4839 (save-excursion
4840 (let* ((text-start allout-recent-prefix-end)
9b026d9f 4841 (heading-end (point-at-eol)))
2a1408fd
DN
4842 (goto-char text-start)
4843 (setq file-name
4844 (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
4845 (buffer-substring (match-beginning 1)
4846 (match-end 1)))))))
69027dea 4847 (setq file-name (expand-file-name file-name))
1977b8f6
RS
4848 (if (or (file-exists-p file-name)
4849 (if (file-writable-p file-name)
4850 (y-or-n-p (format "%s not there, create one? "
4851 file-name))
4852 (error "%s not found and can't be created" file-name)))
4853 (condition-case failure
4854 (find-file-other-window file-name)
d8350998 4855 (error failure))
1977b8f6
RS
4856 (error "%s not found" file-name))
4857 )
4858 )
4859 )
4860 )
19b84ba3 4861
9179616f 4862;;;_ #6 Exposure Control
c567ac01
RS
4863
4864;;;_ - Fundamental
d82979ea
EZ
4865;;;_ > allout-flag-region (from to flag)
4866(defun allout-flag-region (from to flag)
48bd8440
EZ
4867 "Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
4868
4869Exposure-change hook `allout-exposure-change-hook' is run with the same
c07583cd 4870arguments as this function, after the exposure changes are made. (The old
48bd8440 4871`allout-view-change-hook' is being deprecated, and eventually will not be
c07583cd 4872invoked.)"
96b83743 4873
96b83743 4874 ;; We use outline invisibility spec.
01fc9422 4875 (remove-overlays from to 'category 'allout-exposure-category)
96b83743 4876 (when flag
2a1408fd 4877 (let ((o (make-overlay from to nil 'front-advance)))
01fc9422 4878 (overlay-put o 'category 'allout-exposure-category)
96b83743 4879 (when (featurep 'xemacs)
01fc9422 4880 (let ((props (symbol-plist 'allout-exposure-category)))
96b83743 4881 (while props
1c9b9df0
KM
4882 (condition-case nil
4883 ;; as of 2008-02-27, xemacs lacks modification-hooks
4884 (overlay-put o (pop props) (pop props))
4885 (error nil)))))))
da506f05 4886 (run-hooks 'allout-view-change-hook)
48bd8440 4887 (run-hook-with-args 'allout-exposure-change-hook from to flag))
fd5359c6
MR
4888;;;_ > allout-flag-current-subtree (flag)
4889(defun allout-flag-current-subtree (flag)
96b83743 4890 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
19b84ba3 4891
c567ac01 4892 (save-excursion
fd5359c6 4893 (allout-back-to-current-heading)
0458fa80
EZ
4894 (let ((inhibit-field-text-motion t))
4895 (end-of-line))
96b83743
EZ
4896 (allout-flag-region (point)
4897 ;; Exposing must not leave trailing blanks hidden,
4898 ;; but can leave them exposed when hiding, so we
4899 ;; can use flag's inverse as the
4900 ;; include-trailing-blank cue:
4901 (allout-end-of-current-subtree (not flag))
4902 flag)))
c567ac01 4903
c567ac01 4904;;;_ - Topic-specific
01fc9422
EZ
4905;;;_ > allout-show-entry ()
4906(defun allout-show-entry ()
4907 "Like `allout-show-current-entry', but reveals entries in hidden topics.
c567ac01
RS
4908
4909This is a way to give restricted peek at a concealed locality without the
4910expense of exposing its context, but can leave the outline with aberrant
96b83743
EZ
4911exposure. `allout-show-offshoot' should be used after the peek to rectify
4912the exposure."
c567ac01
RS
4913
4914 (interactive)
4915 (save-excursion
96b83743 4916 (let (beg end)
d8350998 4917 (allout-goto-prefix-doublechecked)
96b83743
EZ
4918 (setq beg (if (allout-hidden-p) (1- (point)) (point)))
4919 (setq end (allout-pre-next-prefix))
4920 (allout-flag-region beg end nil)
9179616f 4921 (list beg end))))
fd5359c6
MR
4922;;;_ > allout-show-children (&optional level strict)
4923(defun allout-show-children (&optional level strict)
c567ac01
RS
4924
4925 "If point is visible, show all direct subheadings of this heading.
19b84ba3 4926
2265e017 4927Otherwise, do `allout-show-to-offshoot', and then show subheadings.
c567ac01
RS
4928
4929Optional LEVEL specifies how many levels below the current level
4930should be shown, or all levels if t. Default is 1.
4931
4932Optional STRICT means don't resort to -show-to-offshoot, no matter
4933what. This is basically so -show-to-offshoot, which is called by
4934this function, can employ the pure offspring-revealing capabilities of
19b84ba3
RS
4935it.
4936
4937Returns point at end of subtree that was opened, if any. (May get a
4938point of non-opened subtree?)"
c567ac01
RS
4939
4940 (interactive "p")
96b83743 4941 (let ((start-point (point)))
19b84ba3 4942 (if (and (not strict)
96b83743 4943 (allout-hidden-p))
c567ac01 4944
96b83743
EZ
4945 (progn (allout-show-to-offshoot) ; Point's concealed, open to
4946 ; expose it.
4947 ;; Then recurse, but with "strict" set so we don't
4948 ;; infinite regress:
4949 (allout-show-children level t))
c567ac01 4950
19b84ba3 4951 (save-excursion
96b83743
EZ
4952 (allout-beginning-of-current-line)
4953 (save-restriction
d8350998 4954 (let* (depth
65e7eb3d
EZ
4955 ;; translate the level spec for this routine to the ones
4956 ;; used by -chart-subtree and -chart-to-reveal:
4957 (chart-level (cond ((not level) 1)
4958 ((eq level t) nil)
4959 (t level)))
4960 (chart (allout-chart-subtree chart-level))
4961 (to-reveal (or (allout-chart-to-reveal chart chart-level)
d8350998
CY
4962 ;; interactive, show discontinuous children:
4963 (and chart
1c9b9df0 4964 (allout-called-interactively-p)
d8350998
CY
4965 (save-excursion
4966 (allout-back-to-current-heading)
4967 (setq depth (allout-current-depth))
4968 (and (allout-next-heading)
4969 (> allout-recent-depth
4970 (1+ depth))))
4971 (message
4972 "Discontinuous offspring; use `%s %s'%s."
4973 (substitute-command-keys
4974 "\\[universal-argument]")
4975 (substitute-command-keys
4976 "\\[allout-shift-out]")
4977 " to elevate them.")
4978 (allout-chart-to-reveal
4979 chart (- allout-recent-depth depth))))))
96b83743
EZ
4980 (goto-char start-point)
4981 (when (and strict (allout-hidden-p))
4982 ;; Concealed root would already have been taken care of,
4983 ;; unless strict was set.
4984 (allout-flag-region (point) (allout-snug-back) nil)
4985 (when allout-show-bodies
4986 (goto-char (car to-reveal))
4987 (allout-show-current-entry)))
4988 (while to-reveal
4989 (goto-char (car to-reveal))
4990 (allout-flag-region (save-excursion (allout-snug-back) (point))
4991 (progn (search-forward "\n" nil t)
4992 (1- (point)))
4993 nil)
4994 (when allout-show-bodies
4995 (goto-char (car to-reveal))
4996 (allout-show-current-entry))
4997 (setq to-reveal (cdr to-reveal)))))))
4998 ;; Compensate for `save-excursion's maintenance of point
4999 ;; within invisible text:
5000 (goto-char start-point)))
fd5359c6
MR
5001;;;_ > allout-show-to-offshoot ()
5002(defun allout-show-to-offshoot ()
2265e017 5003 "Like `allout-show-entry', but reveals all concealed ancestors, as well.
c567ac01 5004
96b83743 5005Useful for coherently exposing to a random point in a hidden region."
c567ac01
RS
5006 (interactive)
5007 (save-excursion
0458fa80
EZ
5008 (let ((inhibit-field-text-motion t)
5009 (orig-pt (point))
d8350998 5010 (orig-pref (allout-goto-prefix-doublechecked))
c567ac01 5011 (last-at (point))
65e7eb3d
EZ
5012 (bag-it 0))
5013 (while (or (> bag-it 1) (allout-hidden-p))
96b83743 5014 (while (allout-hidden-p)
d8350998 5015 (move-beginning-of-line 1)
96b83743 5016 (if (allout-hidden-p) (forward-char -1)))
c567ac01 5017 (if (= last-at (setq last-at (point)))
65e7eb3d
EZ
5018 ;; Oops, we're not making any progress! Show the current topic
5019 ;; completely, and try one more time here, if we haven't already.
c567ac01 5020 (progn (beginning-of-line)
fd5359c6 5021 (allout-show-current-subtree)
c567ac01 5022 (goto-char orig-pt)
65e7eb3d
EZ
5023 (setq bag-it (1+ bag-it))
5024 (if (> bag-it 1)
5025 (error "allout-show-to-offshoot: %s"
5026 "Stumped by aberrant nesting.")))
5027 (if (> bag-it 0) (setq bag-it 0))
d8350998
CY
5028 (allout-show-children)
5029 (goto-char orig-pref)))
19b84ba3 5030 (goto-char orig-pt)))
fd5359c6
MR
5031 (if (allout-hidden-p)
5032 (allout-show-entry)))
5033;;;_ > allout-hide-current-entry ()
5034(defun allout-hide-current-entry ()
c567ac01
RS
5035 "Hide the body directly following this heading."
5036 (interactive)
fd5359c6 5037 (allout-back-to-current-heading)
c567ac01 5038 (save-excursion
0458fa80
EZ
5039 (let ((inhibit-field-text-motion t))
5040 (end-of-line))
96b83743 5041 (allout-flag-region (point)
d82979ea 5042 (progn (allout-end-of-entry) (point))
96b83743 5043 t)))
fd5359c6
MR
5044;;;_ > allout-show-current-entry (&optional arg)
5045(defun allout-show-current-entry (&optional arg)
96b83743 5046 "Show body following current heading, or hide entry with universal argument."
c567ac01
RS
5047
5048 (interactive "P")
5049 (if arg
fd5359c6 5050 (allout-hide-current-entry)
96b83743 5051 (save-excursion (allout-show-to-offshoot))
c567ac01 5052 (save-excursion
fd5359c6 5053 (allout-flag-region (point)
96b83743
EZ
5054 (progn (allout-end-of-entry t) (point))
5055 nil)
d82979ea 5056 )))
fd5359c6
MR
5057;;;_ > allout-show-current-subtree (&optional arg)
5058(defun allout-show-current-subtree (&optional arg)
75bcb912
JB
5059 "Show everything within the current topic.
5060With a repeat-count, expose this topic and its siblings."
19b84ba3
RS
5061 (interactive "P")
5062 (save-excursion
fd5359c6 5063 (if (<= (allout-current-depth) 0)
60c7bbd2 5064 ;; Outside any topics -- try to get to the first:
fd5359c6 5065 (if (not (allout-next-heading))
6a05d05f 5066 (error "No topics")
60c7bbd2
RS
5067 ;; got to first, outermost topic -- set to expose it and siblings:
5068 (message "Above outermost topic -- exposing all.")
96b83743
EZ
5069 (allout-flag-region (point-min)(point-max) nil))
5070 (allout-beginning-of-current-line)
19b84ba3 5071 (if (not arg)
96b83743 5072 (allout-flag-current-subtree nil)
fd5359c6
MR
5073 (allout-beginning-of-level)
5074 (allout-expose-topic '(* :))))))
96b83743
EZ
5075;;;_ > allout-current-topic-collapsed-p (&optional include-single-liners)
5076(defun allout-current-topic-collapsed-p (&optional include-single-liners)
5077 "True if the currently visible containing topic is already collapsed.
5078
64686e6d
RS
5079Single line topics intrinsically can be considered as being both
5080collapsed and uncollapsed. If optional INCLUDE-SINGLE-LINERS is
5081true, then single-line topics are considered to be collapsed. By
5082default, they are treated as being uncollapsed."
2a1408fd
DN
5083 (save-match-data
5084 (save-excursion
5085 (and
5086 ;; Is the topic all on one line (allowing for trailing blank line)?
5087 (>= (progn (allout-back-to-current-heading)
82b392a4
KM
5088 (let ((inhibit-field-text-motion t))
5089 (move-end-of-line 1))
2a1408fd
DN
5090 (point))
5091 (allout-end-of-current-subtree (not (looking-at "\n\n"))))
5092
5093 (or include-single-liners
5094 (progn (backward-char 1) (allout-hidden-p)))))))
fd5359c6
MR
5095;;;_ > allout-hide-current-subtree (&optional just-close)
5096(defun allout-hide-current-subtree (&optional just-close)
19b84ba3 5097 "Close the current topic, or containing topic if this one is already closed.
c567ac01 5098
19b84ba3 5099If this topic is closed and it's a top level topic, close this topic
353e2ef2 5100and its siblings.
19b84ba3 5101
96b83743 5102If optional arg JUST-CLOSE is non-nil, do not close the parent or
19b84ba3 5103siblings, even if the target topic is already closed."
c567ac01
RS
5104
5105 (interactive)
96b83743 5106 (let* ((from (point))
60c7bbd2 5107 (sibs-msg "Top-level topic already closed -- closing siblings...")
96b83743
EZ
5108 (current-exposed (not (allout-current-topic-collapsed-p t))))
5109 (cond (current-exposed (allout-flag-current-subtree t))
5110 (just-close nil)
d8350998 5111 ((allout-ascend) (allout-hide-current-subtree))
96b83743
EZ
5112 (t (goto-char 0)
5113 (message sibs-msg)
d8350998 5114 (allout-goto-prefix-doublechecked)
96b83743
EZ
5115 (allout-expose-topic '(0 :))
5116 (message (concat sibs-msg " Done."))))
5117 (goto-char from)))
2a1408fd
DN
5118;;;_ > allout-toggle-current-subtree-exposure
5119(defun allout-toggle-current-subtree-exposure ()
5120 "Show or hide the current subtree depending on its current state."
5121 ;; thanks to tassilo for suggesting this.
5122 (interactive)
5123 (save-excursion
5124 (allout-back-to-heading)
5125 (if (allout-hidden-p (point-at-eol))
5126 (allout-show-current-subtree)
5127 (allout-hide-current-subtree))))
fd5359c6
MR
5128;;;_ > allout-show-current-branches ()
5129(defun allout-show-current-branches ()
c567ac01
RS
5130 "Show all subheadings of this heading, but not their bodies."
5131 (interactive)
0458fa80
EZ
5132 (let ((inhibit-field-text-motion t))
5133 (beginning-of-line))
fd5359c6
MR
5134 (allout-show-children t))
5135;;;_ > allout-hide-current-leaves ()
5136(defun allout-hide-current-leaves ()
353e2ef2 5137 "Hide the bodies of the current topic and all its offspring."
c567ac01 5138 (interactive)
fd5359c6
MR
5139 (allout-back-to-current-heading)
5140 (allout-hide-region-body (point) (progn (allout-end-of-current-subtree)
c567ac01
RS
5141 (point))))
5142
5143;;;_ - Region and beyond
fd5359c6
MR
5144;;;_ > allout-show-all ()
5145(defun allout-show-all ()
c567ac01
RS
5146 "Show all of the text in the buffer."
5147 (interactive)
19b84ba3 5148 (message "Exposing entire buffer...")
96b83743 5149 (allout-flag-region (point-min) (point-max) nil)
19b84ba3 5150 (message "Exposing entire buffer... Done."))
fd5359c6
MR
5151;;;_ > allout-hide-bodies ()
5152(defun allout-hide-bodies ()
c567ac01
RS
5153 "Hide all of buffer except headings."
5154 (interactive)
fd5359c6
MR
5155 (allout-hide-region-body (point-min) (point-max)))
5156;;;_ > allout-hide-region-body (start end)
5157(defun allout-hide-region-body (start end)
c567ac01 5158 "Hide all body lines in the region, but not headings."
2a1408fd
DN
5159 (save-match-data
5160 (save-excursion
5161 (save-restriction
5162 (narrow-to-region start end)
5163 (goto-char (point-min))
5164 (let ((inhibit-field-text-motion t))
5165 (while (not (eobp))
5166 (end-of-line)
5167 (allout-flag-region (point) (allout-end-of-entry) t)
5168 (if (not (eobp))
5169 (forward-char
5170 (if (looking-at "\n\n")
5171 2 1)))))))))
c567ac01 5172
fd5359c6
MR
5173;;;_ > allout-expose-topic (spec)
5174(defun allout-expose-topic (spec)
19b84ba3 5175 "Apply exposure specs to successive outline topic items.
c567ac01 5176
fd5359c6
MR
5177Use the more convenient frontend, `allout-new-exposure', if you don't
5178need evaluation of the arguments, or even better, the `allout-layout'
19b84ba3
RS
5179variable-keyed mode-activation/auto-exposure feature of allout outline
5180mode. See the respective documentation strings for more details.
c567ac01
RS
5181
5182Cursor is left at start position.
5183
19b84ba3
RS
5184SPEC is either a number or a list.
5185
5186Successive specs on a list are applied to successive sibling topics.
c567ac01 5187
c07583cd 5188A simple spec (either a number, one of a few symbols, or the null
19b84ba3
RS
5189list) dictates the exposure for the corresponding topic.
5190
5191Non-null lists recursively designate exposure specs for respective
5192subtopics of the current topic.
c567ac01 5193
353e2ef2 5194The `:' repeat spec is used to specify exposure for any number of
19b84ba3 5195successive siblings, up to the trailing ones for which there are
353e2ef2 5196explicit specs following the `:'.
c567ac01
RS
5197
5198Simple (numeric and null-list) specs are interpreted as follows:
5199
19b84ba3
RS
5200 Numbers indicate the relative depth to open the corresponding topic.
5201 - negative numbers force the topic to be closed before opening to the
5202 absolute value of the number, so all siblings are open only to
5203 that level.
5204 - positive numbers open to the relative depth indicated by the
5205 number, but do not force already opened subtopics to be closed.
60c7bbd2 5206 - 0 means to close topic -- hide all offspring.
353e2ef2 5207 : - `repeat'
c567ac01 5208 apply prior element to all siblings at current level, *up to*
353e2ef2 5209 those siblings that would be covered by specs following the `:'
c567ac01 5210 on the list. Ie, apply to all topics at level but the last
c07583cd 5211 ones. (Only first of multiple colons at same level is
60c7bbd2 5212 respected -- subsequent ones are discarded.)
19b84ba3
RS
5213 * - completely opens the topic, including bodies.
5214 + - shows all the sub headers, but not the bodies
5215 - - exposes the body of the corresponding topic.
c567ac01
RS
5216
5217Examples:
fd5359c6 5218\(allout-expose-topic '(-1 : 0))
c567ac01
RS
5219 Close this and all following topics at current level, exposing
5220 only their immediate children, but close down the last topic
5221 at this current level completely.
fd5359c6 5222\(allout-expose-topic '(-1 () : 1 0))
c567ac01
RS
5223 Close current topic so only the immediate subtopics are shown;
5224 show the children in the second to last topic, and completely
5225 close the last one.
fd5359c6 5226\(allout-expose-topic '(-2 : -1 *))
c567ac01
RS
5227 Expose children and grandchildren of all topics at current
5228 level except the last two; expose children of the second to
5229 last and completely open the last one."
5230
5231 (interactive "xExposure spec: ")
19b84ba3
RS
5232 (if (not (listp spec))
5233 nil
fd5359c6 5234 (let ((depth (allout-depth))
19b84ba3
RS
5235 (max-pos 0)
5236 prev-elem curr-elem
96b83743 5237 stay)
19b84ba3
RS
5238 (while spec
5239 (setq prev-elem curr-elem
5240 curr-elem (car spec)
5241 spec (cdr spec))
5242 (cond ; Do current element:
5243 ((null curr-elem) nil)
5244 ((symbolp curr-elem)
fd5359c6
MR
5245 (cond ((eq curr-elem '*) (allout-show-current-subtree)
5246 (if (> allout-recent-end-of-subtree max-pos)
5247 (setq max-pos allout-recent-end-of-subtree)))
65e7eb3d
EZ
5248 ((eq curr-elem '+)
5249 (if (not (allout-hidden-p))
5250 (save-excursion (allout-hide-current-subtree t)))
5251 (allout-show-current-branches)
fd5359c6
MR
5252 (if (> allout-recent-end-of-subtree max-pos)
5253 (setq max-pos allout-recent-end-of-subtree)))
5254 ((eq curr-elem '-) (allout-show-current-entry))
19b84ba3
RS
5255 ((eq curr-elem ':)
5256 (setq stay t)
353e2ef2 5257 ;; Expand the `repeat' spec to an explicit version,
19b84ba3
RS
5258 ;; w.r.t. remaining siblings:
5259 (let ((residue ; = # of sibs not covered by remaining spec
60c7bbd2 5260 ;; Dang, could be nice to make use of the chart, sigh:
fd5359c6 5261 (- (length (allout-chart-siblings))
19b84ba3
RS
5262 (length spec))))
5263 (if (< 0 residue)
60c7bbd2 5264 ;; Some residue -- cover it with prev-elem:
19b84ba3
RS
5265 (setq spec (append (make-list residue prev-elem)
5266 spec)))))))
5267 ((numberp curr-elem)
96b83743 5268 (if (and (>= 0 curr-elem) (not (allout-hidden-p)))
fd5359c6 5269 (save-excursion (allout-hide-current-subtree t)
19b84ba3
RS
5270 (if (> 0 curr-elem)
5271 nil
fd5359c6 5272 (if (> allout-recent-end-of-subtree max-pos)
19b84ba3 5273 (setq max-pos
fd5359c6 5274 allout-recent-end-of-subtree)))))
19b84ba3 5275 (if (> (abs curr-elem) 0)
fd5359c6
MR
5276 (progn (allout-show-children (abs curr-elem))
5277 (if (> allout-recent-end-of-subtree max-pos)
5278 (setq max-pos allout-recent-end-of-subtree)))))
19b84ba3 5279 ((listp curr-elem)
fd5359c6
MR
5280 (if (allout-descend-to-depth (1+ depth))
5281 (let ((got (allout-expose-topic curr-elem)))
19b84ba3
RS
5282 (if (and got (> got max-pos)) (setq max-pos got))))))
5283 (cond (stay (setq stay nil))
5284 ((listp (car spec)) nil)
5285 ((> max-pos (point))
5286 ;; Capitalize on max-pos state to get us nearer next sibling:
5287 (progn (goto-char (min (point-max) max-pos))
fd5359c6
MR
5288 (allout-next-heading)))
5289 ((allout-next-sibling depth))))
19b84ba3 5290 max-pos)))
fd5359c6
MR
5291;;;_ > allout-old-expose-topic (spec &rest followers)
5292(defun allout-old-expose-topic (spec &rest followers)
d82979ea 5293
c07583cd 5294 "Deprecated. Use `allout-expose-topic' (with different schema
d82979ea
EZ
5295format) instead.
5296
5297Dictate wholesale exposure scheme for current topic, according to SPEC.
c567ac01
RS
5298
5299SPEC is either a number or a list. Optional successive args
5300dictate exposure for subsequent siblings of current topic.
5301
5302A simple spec (either a number, a special symbol, or the null list)
5303dictates the overall exposure for a topic. Non null lists are
5304composite specs whose first element dictates the overall exposure for
5305a topic, with the subsequent elements in the list interpreted as specs
5306that dictate the exposure for the successive offspring of the topic.
5307
5308Simple (numeric and null-list) specs are interpreted as follows:
5309
5310 - Numbers indicate the relative depth to open the corresponding topic:
5311 - negative numbers force the topic to be close before opening to the
5312 absolute value of the number.
5313 - positive numbers just open to the relative depth indicated by the number.
5314 - 0 just closes
353e2ef2
KH
5315 - `*' completely opens the topic, including bodies.
5316 - `+' shows all the sub headers, but not the bodies
5317 - `-' exposes the body and immediate offspring of the corresponding topic.
c567ac01
RS
5318
5319If the spec is a list, the first element must be a number, which
5320dictates the exposure depth of the topic as a whole. Subsequent
5321elements of the list are nested SPECs, dictating the specific exposure
5322for the corresponding offspring of the topic.
5323
e126900f 5324Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
c567ac01
RS
5325
5326 (interactive "xExposure spec: ")
0458fa80
EZ
5327 (let ((inhibit-field-text-motion t)
5328 (depth (allout-current-depth))
c567ac01
RS
5329 max-pos)
5330 (cond ((null spec) nil)
5331 ((symbolp spec)
fd5359c6
MR
5332 (if (eq spec '*) (allout-show-current-subtree))
5333 (if (eq spec '+) (allout-show-current-branches))
5334 (if (eq spec '-) (allout-show-current-entry)))
c567ac01
RS
5335 ((numberp spec)
5336 (if (>= 0 spec)
fd5359c6 5337 (save-excursion (allout-hide-current-subtree t)
c567ac01
RS
5338 (end-of-line)
5339 (if (or (not max-pos)
5340 (> (point) max-pos))
5341 (setq max-pos (point)))
5342 (if (> 0 spec)
5343 (setq spec (* -1 spec)))))
5344 (if (> spec 0)
fd5359c6 5345 (allout-show-children spec)))
c567ac01 5346 ((listp spec)
fd5359c6 5347 ;(let ((got (allout-old-expose-topic (car spec))))
c567ac01
RS
5348 ; (if (and got (or (not max-pos) (> got max-pos)))
5349 ; (setq max-pos got)))
fd5359c6 5350 (let ((new-depth (+ (allout-current-depth) 1))
c567ac01 5351 got)
fd5359c6 5352 (setq max-pos (allout-old-expose-topic (car spec)))
c567ac01
RS
5353 (setq spec (cdr spec))
5354 (if (and spec
fd5359c6
MR
5355 (allout-descend-to-depth new-depth)
5356 (not (allout-hidden-p)))
5357 (progn (setq got (apply 'allout-old-expose-topic spec))
c567ac01
RS
5358 (if (and got (or (not max-pos) (> got max-pos)))
5359 (setq max-pos got)))))))
5360 (while (and followers
5361 (progn (if (and max-pos (< (point) max-pos))
5362 (progn (goto-char max-pos)
5363 (setq max-pos nil)))
5364 (end-of-line)
fd5359c6
MR
5365 (allout-next-sibling depth)))
5366 (allout-old-expose-topic (car followers))
c567ac01
RS
5367 (setq followers (cdr followers)))
5368 max-pos))
fd5359c6
MR
5369;;;_ > allout-new-exposure '()
5370(defmacro allout-new-exposure (&rest spec)
5371 "Literal frontend for `allout-expose-topic', doesn't evaluate arguments.
2265e017
MR
5372Some arguments that would need to be quoted in `allout-expose-topic'
5373need not be quoted in `allout-new-exposure'.
c567ac01
RS
5374
5375Cursor is left at start position.
5376
d82979ea
EZ
5377Use this instead of obsolete `allout-exposure'.
5378
c567ac01 5379Examples:
bff05d9e 5380\(allout-new-exposure (-1 () () () 1) 0)
c567ac01
RS
5381 Close current topic at current level so only the immediate
5382 subtopics are shown, except also show the children of the
5383 third subtopic; and close the next topic at the current level.
bff05d9e 5384\(allout-new-exposure : -1 0)
c567ac01
RS
5385 Close all topics at current level to expose only their
5386 immediate children, except for the last topic at the current
353e2ef2 5387 level, in which even its immediate children are hidden.
bff05d9e 5388\(allout-new-exposure -2 : -1 *)
c567ac01
RS
5389 Expose children and grandchildren of first topic at current
5390 level, and expose children of subsequent topics at current
5391 level *except* for the last, which should be opened completely."
5392 (list 'save-excursion
d8350998 5393 '(if (not (or (allout-goto-prefix-doublechecked)
fd5359c6
MR
5394 (allout-next-heading)))
5395 (error "allout-new-exposure: Can't find any outline topics"))
5396 (list 'allout-expose-topic (list 'quote spec))))
c567ac01 5397
60c7bbd2 5398;;;_ #7 Systematic outline presentation -- copying, printing, flattening
19b84ba3 5399
9179616f
DL
5400;;;_ - Mapping and processing of topics
5401;;;_ ( See also Subtree Charting, in Navigation code.)
fd5359c6
MR
5402;;;_ > allout-stringify-flat-index (flat-index)
5403(defun allout-stringify-flat-index (flat-index &optional context)
9179616f
DL
5404 "Convert list representing section/subsection/... to document string.
5405
5406Optional arg CONTEXT indicates interior levels to include."
5407 (let ((delim ".")
71296446 5408 result
9179616f
DL
5409 numstr
5410 (context-depth (or (and context 2) 1)))
5411 ;; Take care of the explicit context:
5412 (while (> context-depth 0)
5413 (setq numstr (int-to-string (car flat-index))
5414 flat-index (cdr flat-index)
5415 result (if flat-index
5416 (cons delim (cons numstr result))
5417 (cons numstr result))
5418 context-depth (if flat-index (1- context-depth) 0)))
5419 (setq delim " ")
5420 ;; Take care of the indentation:
5421 (if flat-index
5422 (progn
5423 (while flat-index
5424 (setq result
5425 (cons delim
5426 (cons (make-string
5427 (1+ (truncate (if (zerop (car flat-index))
5428 1
5429 (log10 (car flat-index)))))
5430 ? )
5431 result)))
5432 (setq flat-index (cdr flat-index)))
5433 ;; Dispose of single extra delim:
5434 (setq result (cdr result))))
5435 (apply 'concat result)))
fd5359c6
MR
5436;;;_ > allout-stringify-flat-index-plain (flat-index)
5437(defun allout-stringify-flat-index-plain (flat-index)
9179616f
DL
5438 "Convert list representing section/subsection/... to document string."
5439 (let ((delim ".")
5440 result)
5441 (while flat-index
5442 (setq result (cons (int-to-string (car flat-index))
5443 (if result
5444 (cons delim result))))
5445 (setq flat-index (cdr flat-index)))
5446 (apply 'concat result)))
fd5359c6
MR
5447;;;_ > allout-stringify-flat-index-indented (flat-index)
5448(defun allout-stringify-flat-index-indented (flat-index)
9179616f
DL
5449 "Convert list representing section/subsection/... to document string."
5450 (let ((delim ".")
71296446 5451 result
9179616f
DL
5452 numstr)
5453 ;; Take care of the explicit context:
5454 (setq numstr (int-to-string (car flat-index))
5455 flat-index (cdr flat-index)
5456 result (if flat-index
5457 (cons delim (cons numstr result))
5458 (cons numstr result)))
5459 (setq delim " ")
5460 ;; Take care of the indentation:
5461 (if flat-index
5462 (progn
5463 (while flat-index
5464 (setq result
5465 (cons delim
5466 (cons (make-string
5467 (1+ (truncate (if (zerop (car flat-index))
5468 1
5469 (log10 (car flat-index)))))
5470 ? )
5471 result)))
5472 (setq flat-index (cdr flat-index)))
5473 ;; Dispose of single extra delim:
5474 (setq result (cdr result))))
5475 (apply 'concat result)))
fd5359c6
MR
5476;;;_ > allout-listify-exposed (&optional start end format)
5477(defun allout-listify-exposed (&optional start end format)
19b84ba3 5478
9179616f 5479 "Produce a list representing exposed topics in current region.
c567ac01 5480
fd5359c6 5481This list can then be used by `allout-process-exposed' to manipulate
9179616f 5482the subject region.
353e2ef2 5483
9179616f 5484Optional START and END indicate bounds of region.
19b84ba3 5485
75bcb912 5486Optional arg, FORMAT, designates an alternate presentation form for
9179616f 5487the prefix:
c567ac01 5488
60c7bbd2 5489 list -- Present prefix as numeric section.subsection..., starting with
9179616f 5490 section indicated by the list, innermost nesting first.
60c7bbd2 5491 `indent' (symbol) -- Convert header prefixes to all white space,
9179616f 5492 except for distinctive bullets.
c567ac01 5493
9179616f
DL
5494The elements of the list produced are lists that represents a topic
5495header and body. The elements of that list are:
c567ac01 5496
9179616f
DL
5497 - a number representing the depth of the topic,
5498 - a string representing the header-prefix, including trailing whitespace and
5499 bullet.
5500 - a string representing the bullet character,
5501 - and a series of strings, each containing one line of the exposed
5502 portion of the topic entry."
c567ac01 5503
9179616f
DL
5504 (interactive "r")
5505 (save-excursion
5506 (let*
0458fa80
EZ
5507 ((inhibit-field-text-motion t)
5508 ;; state vars:
5509 strings prefix result depth new-depth out gone-out bullet beg
9179616f 5510 next done)
c567ac01 5511
9179616f
DL
5512 (goto-char start)
5513 (beginning-of-line)
5514 ;; Goto initial topic, and register preceeding stuff, if any:
d8350998 5515 (if (> (allout-goto-prefix-doublechecked) start)
60c7bbd2 5516 ;; First topic follows beginning point -- register preliminary stuff:
9179616f
DL
5517 (setq result (list (list 0 "" nil
5518 (buffer-substring start (1- (point)))))))
5519 (while (and (not done)
5520 (not (eobp)) ; Loop until we've covered the region.
5521 (not (> (point) end)))
d8350998 5522 (setq depth allout-recent-depth ; Current topics depth,
fd5359c6
MR
5523 bullet (allout-recent-bullet) ; ... bullet,
5524 prefix (allout-recent-prefix)
5525 beg (progn (allout-end-of-prefix t) (point))) ; and beginning.
9179616f 5526 (setq done ; The boundary for the current topic:
fd5359c6 5527 (not (allout-next-visible-heading 1)))
d8350998 5528 (setq new-depth allout-recent-depth)
9179616f
DL
5529 (setq gone-out out
5530 out (< new-depth depth))
5531 (beginning-of-line)
5532 (setq next (point))
5533 (goto-char beg)
5534 (setq strings nil)
5535 (while (> next (point)) ; Get all the exposed text in
5536 (setq strings
5537 (cons (buffer-substring
5538 beg
5539 ;To hidden text or end of line:
5540 (progn
96b83743
EZ
5541 (end-of-line)
5542 (allout-back-to-visible-text)))
9179616f 5543 strings))
96b83743 5544 (when (< (point) next) ; Resume from after hid text, if any.
1b4d97b2
CY
5545 (line-move 1)
5546 (beginning-of-line))
9179616f
DL
5547 (setq beg (point)))
5548 ;; Accumulate list for this topic:
5549 (setq strings (nreverse strings))
5550 (setq result
5551 (cons
5552 (if format
5553 (let ((special (if (string-match
5554 (regexp-quote bullet)
fd5359c6 5555 allout-distinctive-bullets-string)
9179616f
DL
5556 bullet)))
5557 (cond ((listp format)
5558 (list depth
fd5359c6
MR
5559 (if allout-abbreviate-flattened-numbering
5560 (allout-stringify-flat-index format
9179616f 5561 gone-out)
fd5359c6 5562 (allout-stringify-flat-index-plain
9179616f
DL
5563 format))
5564 strings
5565 special))
5566 ((eq format 'indent)
5567 (if special
5568 (list depth
5569 (concat (make-string (1+ depth) ? )
5570 (substring prefix -1))
5571 strings)
5572 (list depth
5573 (make-string depth ? )
5574 strings)))
fd5359c6 5575 (t (error "allout-listify-exposed: %s %s"
9179616f
DL
5576 "invalid format" format))))
5577 (list depth prefix strings))
5578 result))
5579 ;; Reasses format, if any:
5580 (if (and format (listp format))
5581 (cond ((= new-depth depth)
5582 (setq format (cons (1+ (car format))
5583 (cdr format))))
60c7bbd2 5584 ((> new-depth depth) ; descending -- assume by 1:
9179616f
DL
5585 (setq format (cons 1 format)))
5586 (t
5587 ; Pop the residue:
5588 (while (< new-depth depth)
5589 (setq format (cdr format))
5590 (setq depth (1- depth)))
5591 ; And increment the current one:
5592 (setq format
5593 (cons (1+ (or (car format)
5594 -1))
5595 (cdr format)))))))
5596 ;; Put the list with first at front, to last at back:
5597 (nreverse result))))
c60d543d
RS
5598;;;_ > allout-region-active-p ()
5599(defmacro allout-region-active-p ()
42c3e51c
KM
5600 (cond ((fboundp 'use-region-p) '(use-region-p))
5601 ((fboundp 'region-active-p) '(region-active-p))
5602 (t 'mark-active)))
5603;;_ > allout-process-exposed (&optional func from to frombuf
9179616f 5604;;; tobuf format)
fd5359c6 5605(defun allout-process-exposed (&optional func from to frombuf tobuf
96b83743 5606 format start-num)
9179616f 5607 "Map function on exposed parts of current topic; results to another buffer.
353e2ef2 5608
d82979ea
EZ
5609All args are options; default values itemized below.
5610
5611Apply FUNCTION to exposed portions FROM position TO position in buffer
9179616f
DL
5612FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
5613alternate presentation form:
c567ac01 5614
60c7bbd2 5615 `flat' -- Present prefix as numeric section.subsection..., starting with
75bcb912 5616 section indicated by the START-NUM, innermost nesting first.
60c7bbd2 5617 X`flat-indented' -- Prefix is like `flat' for first topic at each
9179616f
DL
5618 X level, but subsequent topics have only leaf topic
5619 X number, padded with blanks to line up with first.
60c7bbd2 5620 `indent' (symbol) -- Convert header prefixes to all white space,
9179616f 5621 except for distinctive bullets.
c567ac01 5622
9179616f 5623Defaults:
d82979ea 5624 FUNCTION: `allout-insert-listified'
9179616f
DL
5625 FROM: region start, if region active, else start of buffer
5626 TO: region end, if region active, else end of buffer
5627 FROMBUF: current buffer
5628 TOBUF: buffer name derived: \"*current-buffer-name exposed*\"
5629 FORMAT: nil"
5630
5631 ; Resolve arguments,
5632 ; defaulting if necessary:
fd5359c6 5633 (if (not func) (setq func 'allout-insert-listified))
9179616f 5634 (if (not (and from to))
c60d543d 5635 (if (allout-region-active-p)
9179616f
DL
5636 (setq from (region-beginning) to (region-end))
5637 (setq from (point-min) to (point-max))))
5638 (if frombuf
5639 (if (not (bufferp frombuf))
60c7bbd2 5640 ;; Specified but not a buffer -- get it:
9179616f
DL
5641 (let ((got (get-buffer frombuf)))
5642 (if (not got)
fd5359c6 5643 (error (concat "allout-process-exposed: source buffer "
9179616f
DL
5644 frombuf
5645 " not found."))
5646 (setq frombuf got))))
60c7bbd2 5647 ;; not specified -- default it:
9179616f
DL
5648 (setq frombuf (current-buffer)))
5649 (if tobuf
5650 (if (not (bufferp tobuf))
5651 (setq tobuf (get-buffer-create tobuf)))
60c7bbd2 5652 ;; not specified -- default it:
9179616f
DL
5653 (setq tobuf (concat "*" (buffer-name frombuf) " exposed*")))
5654 (if (listp format)
5655 (nreverse format))
5656
5657 (let* ((listified
5658 (progn (set-buffer frombuf)
fd5359c6 5659 (allout-listify-exposed from to format))))
9179616f 5660 (set-buffer tobuf)
5110e166 5661 (mapc func listified)
9179616f
DL
5662 (pop-to-buffer tobuf)))
5663
5664;;;_ - Copy exposed
fd5359c6
MR
5665;;;_ > allout-insert-listified (listified)
5666(defun allout-insert-listified (listified)
9179616f
DL
5667 "Insert contents of listified outline portion in current buffer.
5668
e126900f 5669LISTIFIED is a list representing each topic header and body:
9179616f
DL
5670
5671 \`(depth prefix text)'
5672
d82979ea 5673or \`(depth prefix text bullet-plus)'
9179616f
DL
5674
5675If `bullet-plus' is specified, it is inserted just after the entire prefix."
5676 (setq listified (cdr listified))
5677 (let ((prefix (prog1
5678 (car listified)
5679 (setq listified (cdr listified))))
5680 (text (prog1
5681 (car listified)
5682 (setq listified (cdr listified))))
5683 (bullet-plus (car listified)))
eac9cf5f
PJ
5684 (insert prefix)
5685 (if bullet-plus (insert (concat " " bullet-plus)))
9179616f 5686 (while text
eac9cf5f 5687 (insert (car text))
9179616f 5688 (if (setq text (cdr text))
0949617b 5689 (insert "\n")))
eac9cf5f 5690 (insert "\n")))
fd5359c6
MR
5691;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format)
5692(defun allout-copy-exposed-to-buffer (&optional arg tobuf format)
9179616f
DL
5693 "Duplicate exposed portions of current outline to another buffer.
5694
5695Other buffer has current buffers name with \" exposed\" appended to it.
5696
5697With repeat count, copy the exposed parts of only the current topic.
5698
5699Optional second arg TOBUF is target buffer name.
5700
5701Optional third arg FORMAT, if non-nil, symbolically designates an
5702alternate presentation format for the outline:
5703
5704 `flat' - Convert topic header prefixes to numeric
5705 section.subsection... identifiers.
5706 `indent' - Convert header prefixes to all white space, except for
5707 distinctive bullets.
5708 `indent-flat' - The best of both - only the first of each level has
5709 the full path, the rest have only the section number
5710 of the leaf, preceded by the right amount of indentation."
c567ac01
RS
5711
5712 (interactive "P")
5713 (if (not tobuf)
5714 (setq tobuf (get-buffer-create (concat "*" (buffer-name) " exposed*"))))
5715 (let* ((start-pt (point))
fd5359c6
MR
5716 (beg (if arg (allout-back-to-current-heading) (point-min)))
5717 (end (if arg (allout-end-of-current-subtree) (point-max)))
9179616f
DL
5718 (buf (current-buffer))
5719 (start-list ()))
5720 (if (eq format 'flat)
5721 (setq format (if arg (save-excursion
5722 (goto-char beg)
fd5359c6 5723 (allout-topic-flat-index))
9179616f 5724 '(1))))
7fdbcd83 5725 (with-current-buffer tobuf (erase-buffer))
fd5359c6 5726 (allout-process-exposed 'allout-insert-listified
c567ac01
RS
5727 beg
5728 end
5729 (current-buffer)
9179616f
DL
5730 tobuf
5731 format start-list)
c567ac01
RS
5732 (goto-char (point-min))
5733 (pop-to-buffer buf)
5734 (goto-char start-pt)))
fd5359c6
MR
5735;;;_ > allout-flatten-exposed-to-buffer (&optional arg tobuf)
5736(defun allout-flatten-exposed-to-buffer (&optional arg tobuf)
9179616f
DL
5737 "Present numeric outline of outline's exposed portions in another buffer.
5738
60c7bbd2 5739The resulting outline is not compatible with outline mode -- use
fd5359c6 5740`allout-copy-exposed-to-buffer' if you want that.
9179616f 5741
fd5359c6 5742Use `allout-indented-exposed-to-buffer' for indented presentation.
9179616f
DL
5743
5744With repeat count, copy the exposed portions of only current topic.
5745
e126900f 5746Other buffer has current buffer's name with \" exposed\" appended to
9179616f
DL
5747it, unless optional second arg TOBUF is specified, in which case it is
5748used verbatim."
5749 (interactive "P")
fd5359c6
MR
5750 (allout-copy-exposed-to-buffer arg tobuf 'flat))
5751;;;_ > allout-indented-exposed-to-buffer (&optional arg tobuf)
5752(defun allout-indented-exposed-to-buffer (&optional arg tobuf)
9179616f
DL
5753 "Present indented outline of outline's exposed portions in another buffer.
5754
60c7bbd2 5755The resulting outline is not compatible with outline mode -- use
fd5359c6 5756`allout-copy-exposed-to-buffer' if you want that.
9179616f 5757
fd5359c6 5758Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation.
9179616f
DL
5759
5760With repeat count, copy the exposed portions of only current topic.
5761
e126900f 5762Other buffer has current buffer's name with \" exposed\" appended to
9179616f
DL
5763it, unless optional second arg TOBUF is specified, in which case it is
5764used verbatim."
5765 (interactive "P")
fd5359c6 5766 (allout-copy-exposed-to-buffer arg tobuf 'indent))
c567ac01
RS
5767
5768;;;_ - LaTeX formatting
e126900f
JB
5769;;;_ > allout-latex-verb-quote (string &optional flow)
5770(defun allout-latex-verb-quote (string &optional flow)
539d7736 5771 "Return copy of STRING for literal reproduction across LaTeX processing.
c07583cd 5772Expresses the original characters (including carriage returns) of the
539d7736 5773string across LaTeX processing."
9179616f
DL
5774 (mapconcat (function
5775 (lambda (char)
c567ac01
RS
5776 (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
5777 (concat "\\char" (number-to-string char) "{}"))
5778 ((= char ?\n) "\\\\")
9179616f 5779 (t (char-to-string char)))))
e126900f 5780 string
c567ac01 5781 ""))
fd5359c6
MR
5782;;;_ > allout-latex-verbatim-quote-curr-line ()
5783(defun allout-latex-verbatim-quote-curr-line ()
c07583cd 5784 "Express line for exact (literal) representation across LaTeX processing.
19b84ba3 5785
c07583cd 5786Adjust line contents so it is unaltered (from the original line)
539d7736 5787across LaTeX processing, within the context of a `verbatim'
c567ac01 5788environment. Leaves point at the end of the line."
0458fa80
EZ
5789 (let ((inhibit-field-text-motion t))
5790 (beginning-of-line)
5791 (let ((beg (point))
626b459f 5792 (end (point-at-eol)))
2a1408fd
DN
5793 (save-match-data
5794 (while (re-search-forward "\\\\"
5795 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
5796 end ; bounded by end-of-line
5797 1) ; no matches, move to end & return nil
5798 (goto-char (match-beginning 2))
5799 (insert "\\")
5800 (setq end (1+ end))
5801 (goto-char (1+ (match-end 2))))))))
e126900f
JB
5802;;;_ > allout-insert-latex-header (buffer)
5803(defun allout-insert-latex-header (buffer)
539d7736 5804 "Insert initial LaTeX commands at point in BUFFER."
c567ac01
RS
5805 ;; Much of this is being derived from the stuff in appendix of E in
5806 ;; the TeXBook, pg 421.
e126900f 5807 (set-buffer buffer)
c567ac01
RS
5808 (let ((doc-style (format "\n\\documentstyle{%s}\n"
5809 "report"))
fd5359c6 5810 (page-numbering (if allout-number-pages
c567ac01
RS
5811 "\\pagestyle{empty}\n"
5812 ""))
c567ac01 5813 (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n"
fd5359c6 5814 allout-title-style))
c567ac01 5815 (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n"
fd5359c6 5816 allout-label-style))
c567ac01 5817 (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n"
fd5359c6 5818 allout-head-line-style))
c567ac01 5819 (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n"
fd5359c6 5820 allout-body-line-style))
c567ac01
RS
5821 (setlength (format "%s%s%s%s"
5822 "\\newlength{\\stepsize}\n"
5823 "\\setlength{\\stepsize}{"
fd5359c6 5824 allout-indent
c567ac01
RS
5825 "}\n"))
5826 (oneheadline (format "%s%s%s%s%s%s%s"
5827 "\\newcommand{\\OneHeadLine}[3]{%\n"
5828 "\\noindent%\n"
5829 "\\hspace*{#2\\stepsize}%\n"
5830 "\\labelcmd{#1}\\hspace*{.2cm}"
5831 "\\headlinecmd{#3}\\\\["
fd5359c6 5832 allout-line-skip
c567ac01
RS
5833 "]\n}\n"))
5834 (onebodyline (format "%s%s%s%s%s%s"
5835 "\\newcommand{\\OneBodyLine}[2]{%\n"
5836 "\\noindent%\n"
5837 "\\hspace*{#1\\stepsize}%\n"
5838 "\\bodylinecmd{#2}\\\\["
fd5359c6 5839 allout-line-skip
c567ac01
RS
5840 "]\n}\n"))
5841 (begindoc "\\begin{document}\n\\begin{center}\n")
5842 (title (format "%s%s%s%s"
5843 "\\titlecmd{"
fd5359c6 5844 (allout-latex-verb-quote (if allout-title
96b83743 5845 (condition-case nil
fd5359c6 5846 (eval allout-title)
d8350998 5847 (error "<unnamed buffer>"))
c567ac01
RS
5848 "Unnamed Outline"))
5849 "}\n"
5850 "\\end{center}\n\n"))
5851 (hsize "\\hsize = 7.5 true in\n")
5852 (hoffset "\\hoffset = -1.5 true in\n")
5853 (vspace "\\vspace{.1cm}\n\n"))
5854 (insert (concat doc-style
5855 page-numbering
5856 titlecmd
5857 labelcmd
5858 headlinecmd
5859 bodylinecmd
5860 setlength
5861 oneheadline
5862 onebodyline
5863 begindoc
5864 title
5865 hsize
5866 hoffset
5867 vspace)
5868 )))
e126900f
JB
5869;;;_ > allout-insert-latex-trailer (buffer)
5870(defun allout-insert-latex-trailer (buffer)
539d7736 5871 "Insert concluding LaTeX commands at point in BUFFER."
e126900f 5872 (set-buffer buffer)
c567ac01 5873 (insert "\n\\end{document}\n"))
fd5359c6
MR
5874;;;_ > allout-latexify-one-item (depth prefix bullet text)
5875(defun allout-latexify-one-item (depth prefix bullet text)
19b84ba3
RS
5876 "Insert LaTeX commands for formatting one outline item.
5877
9179616f 5878Args are the topics numeric DEPTH, the header PREFIX lead string, the
19b84ba3 5879BULLET string, and a list of TEXT strings for the body."
c567ac01
RS
5880 (let* ((head-line (if text (car text)))
5881 (body-lines (cdr text))
5882 (curr-line)
5883 body-content bop)
5884 ; Do the head line:
71296446 5885 (insert (concat "\\OneHeadLine{\\verb\1 "
d82979ea
EZ
5886 (allout-latex-verb-quote bullet)
5887 "\1}{"
5888 depth
5889 "}{\\verb\1 "
5890 (if head-line
5891 (allout-latex-verb-quote head-line)
5892 "")
5893 "\1}\n"))
c567ac01
RS
5894 (if (not body-lines)
5895 nil
eac9cf5f
PJ
5896 ;;(insert "\\beginlines\n")
5897 (insert "\\begin{verbatim}\n")
c567ac01
RS
5898 (while body-lines
5899 (setq curr-line (car body-lines))
5900 (if (and (not body-content)
5901 (not (string-match "^\\s-*$" curr-line)))
5902 (setq body-content t))
5903 ; Mangle any occurrences of
5904 ; "\end{verbatim}" in text,
5905 ; it's special:
5906 (if (and body-content
5907 (setq bop (string-match "\\end{verbatim}" curr-line)))
5908 (setq curr-line (concat (substring curr-line 0 bop)
5909 ">"
5910 (substring curr-line bop))))
eac9cf5f
PJ
5911 ;;(insert "|" (car body-lines) "|")
5912 (insert curr-line)
fd5359c6 5913 (allout-latex-verbatim-quote-curr-line)
eac9cf5f 5914 (insert "\n")
c567ac01
RS
5915 (setq body-lines (cdr body-lines)))
5916 (if body-content
5917 (setq body-content nil)
5918 (forward-char -1)
eac9cf5f 5919 (insert "\\ ")
c567ac01 5920 (forward-char 1))
eac9cf5f
PJ
5921 ;;(insert "\\endlines\n")
5922 (insert "\\end{verbatim}\n")
c567ac01 5923 )))
fd5359c6
MR
5924;;;_ > allout-latexify-exposed (arg &optional tobuf)
5925(defun allout-latexify-exposed (arg &optional tobuf)
539d7736 5926 "Format current topics exposed portions to TOBUF for LaTeX processing.
19b84ba3
RS
5927TOBUF defaults to a buffer named the same as the current buffer, but
5928with \"*\" prepended and \" latex-formed*\" appended.
c567ac01
RS
5929
5930With repeat count, copy the exposed portions of entire buffer."
5931
5932 (interactive "P")
5933 (if (not tobuf)
5934 (setq tobuf
5935 (get-buffer-create (concat "*" (buffer-name) " latexified*"))))
5936 (let* ((start-pt (point))
fd5359c6
MR
5937 (beg (if arg (point-min) (allout-back-to-current-heading)))
5938 (end (if arg (point-max) (allout-end-of-current-subtree)))
c567ac01
RS
5939 (buf (current-buffer)))
5940 (set-buffer tobuf)
1977b8f6 5941 (erase-buffer)
fd5359c6 5942 (allout-insert-latex-header tobuf)
c567ac01 5943 (goto-char (point-max))
fd5359c6 5944 (allout-process-exposed 'allout-latexify-one-item
c567ac01
RS
5945 beg
5946 end
5947 buf
5948 tobuf)
5949 (goto-char (point-max))
fd5359c6 5950 (allout-insert-latex-trailer tobuf)
1977b8f6 5951 (goto-char (point-min))
c567ac01
RS
5952 (pop-to-buffer buf)
5953 (goto-char start-pt)))
5954
d82979ea 5955;;;_ #8 Encryption
29fac3fe
KM
5956;;;_ > allout-toggle-current-subtree-encryption (&optional keymode-cue)
5957(defun allout-toggle-current-subtree-encryption (&optional keymode-cue)
5958 "Encrypt clear or decrypt encoded topic text.
5959
5960Allout uses emacs 'epg' libary to perform encryption. Symmetric
5961and keypair encryption are supported. All encryption is ascii
5962armored.
5963
075746e2
KM
5964Entry encryption defaults to symmetric key mode unless keypair
5965recipients are associated with the file \(see
5966`epa-file-encrypt-to') or the function is invoked with a
5967\(KEYMODE-CUE) universal argument greater than 1.
5968
5969When encrypting, KEYMODE-CUE universal argument greater than 1
5970causes prompting for recipients for public-key keypair
5971encryption. Selecting no recipients results in symmetric key
29fac3fe
KM
5972encryption.
5973
075746e2
KM
5974Further, encrypting with a KEYMODE-CUE universal argument greater
5975than 4 - eg, preceded by a doubled Ctrl-U - causes association of
5976the specified recipients with the file, replacing those currently
5977associated with it. This can be used to deassociate any
5978recipients with the file, by selecting no recipients in the
5979dialog.
5980
29fac3fe
KM
5981Encrypted topic's bullets are set to a `~' to signal that the
5982contents of the topic (body and subtopics, but not heading) is
5983pending encryption or encrypted. `*' asterisk immediately after
5984the bullet signals that the body is encrypted, its absence means
5985the topic is meant to be encrypted but is not currently. When a
5986file with topics pending encryption is saved, topics pending
5987encryption are encrypted. See allout-encrypt-unencrypted-on-saves
5988for auto-encryption specifics.
0949617b 5989
6eb0a10d 5990\*NOTE WELL* that automatic encryption that happens during saves will
60c7bbd2 5991default to symmetric encryption -- you must deliberately (re)encrypt key-pair
0949617b 5992encrypted topics if you want them to continue to use the key-pair cipher.
d82979ea 5993
d8350998 5994Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
d82979ea 5995encrypted. If you want to encrypt the contents of a top-level topic, use
29fac3fe 5996\\[allout-shift-in] to increase its depth."
69027dea
EZ
5997 (interactive "P")
5998 (save-excursion
5999 (allout-back-to-current-heading)
29fac3fe
KM
6000 (allout-toggle-subtree-encryption keymode-cue)))
6001;;;_ > allout-toggle-subtree-encryption (&optional keymode-cue)
6002(defun allout-toggle-subtree-encryption (&optional keymode-cue)
c07583cd 6003 "Encrypt clear text or decrypt encoded topic contents (body and subtopics.)
69027dea 6004
075746e2
KM
6005Entry encryption defaults to symmetric key mode unless keypair
6006recipients are associated with the file \(see
6007`epa-file-encrypt-to') or the function is invoked with a
6008\(KEYMODE-CUE) universal argument greater than 1.
69027dea 6009
075746e2
KM
6010When encrypting, KEYMODE-CUE universal argument greater than 1
6011causes prompting for recipients for public-key keypair
6012encryption. Selecting no recipients results in symmetric key
6013encryption.
69027dea 6014
075746e2
KM
6015Further, encrypting with a KEYMODE-CUE universal argument greater
6016than 4 - eg, preceded by a doubled Ctrl-U - causes association of
6017the specified recipients with the file, replacing those currently
6018associated with it. This can be used to deassociate any
6019recipients with the file, by selecting no recipients in the
6020dialog.
6021
6022Encryption and decryption uses the emacs epg library.
69027dea 6023
29fac3fe 6024Encrypted text will be ascii-armored.
69027dea
EZ
6025
6026See `allout-toggle-current-subtree-encryption' for more details."
d82979ea
EZ
6027
6028 (interactive "P")
6029 (save-excursion
6030 (allout-end-of-prefix t)
6031
d8350998 6032 (if (= allout-recent-depth 1)
d82979ea
EZ
6033 (error (concat "Cannot encrypt or decrypt level 1 topics -"
6034 " shift it in to make it encryptable")))
6035
d82979ea 6036 (let* ((allout-buffer (current-buffer))
498a6493 6037 ;; Assess location:
d8350998 6038 (bullet-pos allout-recent-prefix-beginning)
d82979ea
EZ
6039 (after-bullet-pos (point))
6040 (was-encrypted
6041 (progn (if (= (point-max) after-bullet-pos)
6042 (error "no body to encrypt"))
0949617b 6043 (allout-encrypted-topic-p)))
96b83743 6044 (was-collapsed (if (not (search-forward "\n" nil t))
d82979ea
EZ
6045 nil
6046 (backward-char 1)
96b83743 6047 (allout-hidden-p)))
d82979ea
EZ
6048 (subtree-beg (1+ (point)))
6049 (subtree-end (allout-end-of-subtree))
6050 (subject-text (buffer-substring-no-properties subtree-beg
6051 subtree-end))
6052 (subtree-end-char (char-after (1- subtree-end)))
96b83743 6053 (subtree-trailing-char (char-after subtree-end))
60c7bbd2 6054 ;; kluge -- result-text needs to be nil, but we also want to
96b83743
EZ
6055 ;; check for the error condition
6056 (result-text (if (or (string= "" subject-text)
6057 (string= "\n" subject-text))
6058 (error "No topic contents to %scrypt"
6059 (if was-encrypted "de" "en"))
6060 nil))
d82979ea 6061 ;; Assess key parameters:
498a6493
CY
6062 (was-coding-system buffer-file-coding-system))
6063
6064 (when (not was-encrypted)
6065 ;; ensure that non-ascii chars pending encryption are noticed before
116f996b 6066 ;; they're encrypted, so the coding system is set to accommodate
498a6493
CY
6067 ;; them.
6068 (setq buffer-file-coding-system
1c9b9df0 6069 (allout-select-safe-coding-system subtree-beg subtree-end))
498a6493
CY
6070 ;; if the coding system for the text being encrypted is different
6071 ;; than that prevailing, then there a real risk that the coding
6072 ;; system can't be noticed by emacs when the file is visited. to
6073 ;; mitigate that, offer to preserve the coding system using a file
6074 ;; local variable.
6075 (if (and (not (equal buffer-file-coding-system
6076 was-coding-system))
6077 (yes-or-no-p
6078 (format (concat "Register coding system %s as file local"
6079 " var? Necessary when only encrypted text"
6080 " is in that coding system. ")
6081 buffer-file-coding-system)))
6082 (allout-adjust-file-variable "buffer-file-coding-system"
6083 buffer-file-coding-system)))
d82979ea
EZ
6084
6085 (setq result-text
6086 (allout-encrypt-string subject-text was-encrypted
075746e2 6087 (current-buffer) keymode-cue))
d82979ea
EZ
6088
6089 ;; Replace the subtree with the processed product.
6090 (allout-unprotected
6091 (progn
6092 (set-buffer allout-buffer)
6093 (delete-region subtree-beg subtree-end)
6094 (insert result-text)
6095 (if was-collapsed
96b83743
EZ
6096 (allout-flag-region (1- subtree-beg) (point) t))
6097 ;; adjust trailing-blank-lines to preserve topic spacing:
d82979ea 6098 (if (not was-encrypted)
96b83743
EZ
6099 (if (and (= subtree-end-char ?\n)
6100 (= subtree-trailing-char ?\n))
6101 (insert subtree-trailing-char)))
d82979ea
EZ
6102 ;; Ensure that the item has an encrypted-entry bullet:
6103 (if (not (string= (buffer-substring-no-properties
6104 (1- after-bullet-pos) after-bullet-pos)
6105 allout-topic-encryption-bullet))
6106 (progn (goto-char (1- after-bullet-pos))
6107 (delete-char 1)
6108 (insert allout-topic-encryption-bullet)))
6109 (if was-encrypted
6110 ;; Remove the is-encrypted bullet qualifier:
6111 (progn (goto-char after-bullet-pos)
6112 (delete-char 1))
6113 ;; Add the is-encrypted bullet qualifier:
6114 (goto-char after-bullet-pos)
d8350998 6115 (insert "*"))))
1b4d97b2
CY
6116 (run-hook-with-args 'allout-structure-added-hook
6117 bullet-pos subtree-end))))
075746e2 6118;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue
29fac3fe 6119;;; &optional rejected)
075746e2 6120(defun allout-encrypt-string (text decrypt allout-buffer keymode-cue
29fac3fe 6121 &optional rejected)
0949617b 6122 "Encrypt or decrypt message TEXT.
d82979ea 6123
ff3e8c8e 6124Returns the resulting string, or nil if the transformation fails.
d82979ea 6125
ff3e8c8e 6126If DECRYPT is true (default false), then decrypt instead of encrypt.
d82979ea 6127
ff3e8c8e 6128ALLOUT-BUFFER identifies the buffer containing the text.
d82979ea 6129
075746e2
KM
6130Entry encryption defaults to symmetric key mode unless keypair
6131recipients are associated with the file \(see
6132`epa-file-encrypt-to') or the function is invoked with a
6133\(KEYMODE-CUE) universal argument greater than 1.
d82979ea 6134
075746e2
KM
6135When encrypting, KEYMODE-CUE universal argument greater than 1
6136causes prompting for recipients for public-key keypair
6137encryption. Selecting no recipients results in symmetric key
6138encryption.
0949617b 6139
075746e2
KM
6140Further, encrypting with a KEYMODE-CUE universal argument greater
6141than 4 - eg, preceded by a doubled Ctrl-U - causes association of
6142the specified recipients with the file, replacing those currently
6143associated with it. This can be used to deassociate any
6144recipients with the file, by selecting no recipients in the
6145dialog.
d82979ea 6146
29fac3fe 6147Optional REJECTED is for internal use, to convey the number of
48bd8440
EZ
6148rejections due to matches against
6149`allout-encryption-ciphertext-rejection-regexps', as limited by
6150`allout-encryption-ciphertext-rejection-ceiling'.
6151
2576c28f
KM
6152NOTE: A few GnuPG v2 versions improperly preserve incorrect
6153symmetric decryption keys, preventing entry of the correct key on
6154subsequent decryption attempts until the cache times-out. That
6155can take several minutes. \(Decryption of other entries is not
6156affected.) Upgrade your EasyPG version, if you can, and you can
6157deliberately clear your gpg-agent's cache by sending it a '-HUP'
6158signal."
48bd8440 6159
ff3e8c8e 6160 (require 'epg)
29fac3fe 6161 (require 'epa)
0949617b 6162
075746e2
KM
6163 (let* ((epg-context (let* ((context (epg-make-context nil t)))
6164 (epg-context-set-passphrase-callback
6165 context #'epa-passphrase-callback-function)
6166 context))
498a6493
CY
6167 (encoding (with-current-buffer allout-buffer
6168 buffer-file-coding-system))
6169 (multibyte (with-current-buffer allout-buffer
ff3e8c8e 6170 enable-multibyte-characters))
29fac3fe
KM
6171 ;; "sanitization" avoids encryption results that are outline structure.
6172 (sani-regexps 'allout-encryption-plaintext-sanitization-regexps)
6173 (strip-plaintext-regexps (if (not decrypt)
6174 (allout-get-configvar-values
6175 sani-regexps)))
6176 (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps)
6177 (reject-ciphertext-regexps (if (not decrypt)
6178 (allout-get-configvar-values
6179 rejection-regexps)))
48bd8440
EZ
6180 (rejected (or rejected 0))
6181 (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
6182 rejected))
075746e2
KM
6183 (keypair-mode (cond (decrypt 'decrypting)
6184 ((<= (prefix-numeric-value keymode-cue) 1)
6185 'default)
6186 ((<= (prefix-numeric-value keymode-cue) 4)
6187 'prompt)
6188 ((> (prefix-numeric-value keymode-cue) 4)
6189 'prompt-save)))
6190 (keypair-message (concat "Select encryption recipients.\n"
6191 "Symmetric encryption is done if no"
6192 " recipients are selected. "))
6193 (encrypt-to (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to))
29fac3fe
KM
6194 recipients
6195 massaged-text
6196 result-text
38b2ca53 6197 )
0949617b 6198
ff3e8c8e
KM
6199 ;; Massage the subject text for encoding and filtering.
6200 (with-temp-buffer
6201 (insert text)
6202 ;; convey the text characteristics of the original buffer:
6203 (allout-set-buffer-multibyte multibyte)
6204 (when encoding
6205 (set-buffer-file-coding-system encoding)
6206 (if (not decrypt)
6207 (encode-coding-region (point-min) (point-max) encoding)))
6208
6209 ;; remove sanitization regexps matches before encrypting:
6210 (when (and strip-plaintext-regexps (not decrypt))
6211 (dolist (re strip-plaintext-regexps)
6212 (let ((re (if (listp re) (car re) re))
6213 (replacement (if (listp re) (cadr re) "")))
6214 (goto-char (point-min))
6215 (save-match-data
6216 (while (re-search-forward re nil t)
6217 (replace-match replacement nil nil))))))
6218 (setq massaged-text (buffer-substring-no-properties (point-min)
6219 (point-max))))
075746e2
KM
6220 ;; determine key mode and, if keypair, recipients:
6221 (setq recipients
6222 (case keypair-mode
6223
6224 (decrypting nil)
6225
6226 (default (if encrypt-to (epg-list-keys epg-context encrypt-to)))
6227
6228 ((prompt prompt-save)
6229 (save-window-excursion
6230 (epa-select-keys epg-context keypair-message)))))
6231
ff3e8c8e 6232 (setq result-text
ff3e8c8e 6233 (if decrypt
ff3e8c8e
KM
6234 (epg-decrypt-string epg-context
6235 (encode-coding-string massaged-text
6236 (or encoding 'utf-8)))
ff3e8c8e
KM
6237 (epg-encrypt-string epg-context
6238 (encode-coding-string massaged-text
6239 (or encoding 'utf-8))
075746e2 6240 recipients)))
ff3e8c8e
KM
6241
6242 ;; validate result -- non-empty
075746e2
KM
6243 (if (not result-text)
6244 (error "%scryption failed." (if decrypt "De" "En")))
6245
29fac3fe 6246
075746e2
KM
6247 (when (eq keypair-mode 'prompt-save)
6248 ;; set epa-file-encrypt-to in the buffer:
6249 (setq epa-file-encrypt-to (mapcar (lambda (key)
6250 (epg-user-id-string
6251 (car (epg-key-user-id-list key))))
6252 recipients))
6253 ;; change the file variable:
6254 (allout-adjust-file-variable "epa-file-encrypt-to" epa-file-encrypt-to))
d82979ea 6255
075746e2 6256 (cond
29fac3fe
KM
6257 ;; Retry (within limit) if ciphertext contains rejections:
6258 ((and (not decrypt)
6259 ;; Check for disqualification of this ciphertext:
6260 (let ((regexps reject-ciphertext-regexps)
6261 reject-it)
6262 (while (and regexps (not reject-it))
6263 (setq reject-it (string-match (car regexps) result-text))
6264 (pop regexps))
6265 reject-it))
6266 (setq rejections-left (1- rejections-left))
6267 (if (<= rejections-left 0)
6268 (error (concat "Ciphertext rejected too many times"
6269 " (%s), per `%s'")
6270 allout-encryption-ciphertext-rejection-ceiling
6271 'allout-encryption-ciphertext-rejection-regexps)
6272 ;; try again (gpg-agent may have the key cached):
6273 (allout-encrypt-string text decrypt allout-buffer keypair-mode
6274 (1+ rejected))))
6275
6276 ;; Barf if encryption yields extraordinary control chars:
6277 ((and (not decrypt)
6278 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
6279 result-text))
6280 (error (concat "Encryption produced non-armored text, which"
6281 "conflicts with allout mode -- reconfigure!")))
6282
6283 (t result-text))))
d82979ea
EZ
6284;;;_ > allout-encrypted-topic-p ()
6285(defun allout-encrypted-topic-p ()
6286 "True if the current topic is encryptable and encrypted."
6287 (save-excursion
6288 (allout-end-of-prefix t)
6289 (and (string= (buffer-substring-no-properties (1- (point)) (point))
6290 allout-topic-encryption-bullet)
2a1408fd 6291 (save-match-data (looking-at "\\*")))
d82979ea
EZ
6292 )
6293 )
d82979ea
EZ
6294;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
6295(defun allout-next-topic-pending-encryption (&optional except-mark)
6296 "Return the point of the next topic pending encryption, or nil if none.
6297
6298EXCEPT-MARK identifies a point whose containing topics should be excluded
6299from encryption. This supports 'except-current mode of
6300`allout-encrypt-unencrypted-on-saves'.
6301
75bcb912 6302Such a topic has the `allout-topic-encryption-bullet' without an
d82979ea
EZ
6303immediately following '*' that would mark the topic as being encrypted. It
6304must also have content."
6305 (let (done got content-beg)
2a1408fd
DN
6306 (save-match-data
6307 (while (not done)
d82979ea 6308
2a1408fd
DN
6309 (if (not (re-search-forward
6310 (format "\\(\\`\\|\n\\)%s *%s[^*]"
6311 (regexp-quote allout-header-prefix)
6312 (regexp-quote allout-topic-encryption-bullet))
6313 nil t))
6314 (setq got nil
6315 done t)
6316 (goto-char (setq got (match-beginning 0)))
6317 (if (save-match-data (looking-at "\n"))
6318 (forward-char 1))
6319 (setq got (point)))
6320
6321 (cond ((not got)
6322 (setq done t))
6323
6324 ((not (search-forward "\n"))
6325 (setq got nil
6326 done t))
6327
6328 ((eobp)
6329 (setq got nil
6330 done t))
6331
6332 (t
6333 (setq content-beg (point))
6334 (backward-char 1)
6335 (allout-end-of-subtree)
6336 (if (or (<= (point) content-beg)
6337 (and except-mark
6338 (<= content-beg except-mark)
6339 (>= (point) except-mark)))
6340 ;; Continue looking
6341 (setq got nil)
6342 ;; Got it!
6343 (setq done t)))
6344 )
6345 )
6346 (if got
6347 (goto-char got))
d82979ea 6348 )
d82979ea
EZ
6349 )
6350 )
6351;;;_ > allout-encrypt-decrypted (&optional except-mark)
6352(defun allout-encrypt-decrypted (&optional except-mark)
6353 "Encrypt topics pending encryption except those containing exemption point.
6354
6355EXCEPT-MARK identifies a point whose containing topics should be excluded
60c7bbd2 6356from encryption. This supports the `except-current' mode of
d82979ea
EZ
6357`allout-encrypt-unencrypted-on-saves'.
6358
6359If a topic that is currently being edited was encrypted, we return a list
6360containing the location of the topic and the location of the cursor just
6361before the topic was encrypted. This can be used, eg, to decrypt the topic
6362and exactly resituate the cursor if this is being done as part of a file
6363save. See `allout-encrypt-unencrypted-on-saves' for more info."
6364
6365 (interactive "p")
2a1408fd
DN
6366 (save-match-data
6367 (save-excursion
6368 (let* ((current-mark (point-marker))
6369 (current-mark-position (marker-position current-mark))
6370 was-modified
6371 bo-subtree
6372 editing-topic editing-point)
6373 (goto-char (point-min))
6374 (while (allout-next-topic-pending-encryption except-mark)
6375 (setq was-modified (buffer-modified-p))
6376 (when (save-excursion
6377 (and (boundp 'allout-encrypt-unencrypted-on-saves)
6378 allout-encrypt-unencrypted-on-saves
6379 (setq bo-subtree (re-search-forward "$"))
6380 (not (allout-hidden-p))
6381 (>= current-mark (point))
6382 (allout-end-of-current-subtree)
6383 (<= current-mark (point))))
d82979ea
EZ
6384 (setq editing-topic (point)
6385 ;; we had to wait for this 'til now so prior topics are
6386 ;; encrypted, any relevant text shifts are in place:
96b83743
EZ
6387 editing-point (- current-mark-position
6388 (count-trailing-whitespace-region
6389 bo-subtree current-mark-position))))
2a1408fd
DN
6390 (allout-toggle-subtree-encryption)
6391 (if (not was-modified)
6392 (set-buffer-modified-p nil))
6393 )
d82979ea
EZ
6394 (if (not was-modified)
6395 (set-buffer-modified-p nil))
2a1408fd 6396 (if editing-topic (list editing-topic editing-point))
d82979ea 6397 )
d82979ea
EZ
6398 )
6399 )
6400 )
6401
6402;;;_ #9 miscellaneous
d8350998
CY
6403;;;_ : Mode:
6404;;;_ > outlineify-sticky ()
19b84ba3 6405;; outlinify-sticky is correct spelling; provide this alias for sticklers:
0949617b 6406;;;###autoload
19b84ba3 6407(defalias 'outlinify-sticky 'outlineify-sticky)
0949617b 6408;;;###autoload
c567ac01 6409(defun outlineify-sticky (&optional arg)
a0776d6b 6410 "Activate outline mode and establish file var so it is started subsequently.
1977b8f6 6411
fd5359c6 6412See doc-string for `allout-layout' and `allout-init' for details on
19b84ba3
RS
6413setup for auto-startup."
6414
6415 (interactive "P")
6416
2576c28f
KM
6417 (if (allout-mode-p) (allout-mode)) ; deactivate so we can re-activate...
6418 (allout-mode)
19b84ba3
RS
6419
6420 (save-excursion
6421 (goto-char (point-min))
ede4ac6a 6422 (if (allout-goto-prefix)
19b84ba3 6423 t
fd5359c6 6424 (allout-open-topic 2)
60c7bbd2 6425 (insert (concat "Dummy outline topic header -- see"
d82979ea
EZ
6426 "`allout-mode' docstring: `^Hm'."))
6427 (allout-adjust-file-variable
4034b0e2 6428 "allout-layout" (or allout-layout '(-1 : 0))))))
d8350998 6429;;;_ > allout-file-vars-section-data ()
d82979ea
EZ
6430(defun allout-file-vars-section-data ()
6431 "Return data identifying the file-vars section, or nil if none.
6432
60c7bbd2 6433Returns a list of the form (BEGINNING-POINT PREFIX-STRING SUFFIX-STRING)."
d82979ea
EZ
6434 ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function.
6435 (let (beg prefix suffix)
6436 (save-excursion
1977b8f6 6437 (goto-char (point-max))
d82979ea
EZ
6438 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
6439 (if (let ((case-fold-search t))
6440 (not (search-forward "Local Variables:" nil t)))
6441 nil
6442 (setq beg (- (point) 16))
6443 (setq suffix (buffer-substring-no-properties
6444 (point)
96b83743 6445 (progn (if (search-forward "\n" nil t)
d82979ea
EZ
6446 (forward-char -1))
6447 (point))))
6448 (setq prefix (buffer-substring-no-properties
96b83743 6449 (progn (if (search-backward "\n" nil t)
d82979ea
EZ
6450 (forward-char 1))
6451 (point))
6452 beg))
6453 (list beg prefix suffix))
6454 )
6455 )
6456 )
d8350998 6457;;;_ > allout-adjust-file-variable (varname value)
d82979ea 6458(defun allout-adjust-file-variable (varname value)
a0a022d5 6459 "Adjust the setting of an Emacs file variable named VARNAME to VALUE.
d82979ea
EZ
6460
6461This activity is inhibited if either `enable-local-variables'
6462`allout-enable-file-variable-adjustment' are nil.
6463
6464When enabled, an entry for the variable is created if not already present,
6465or changed if established with a different value. The section for the file
6466variables, itself, is created if not already present. When created, the
c07583cd 6467section lines (including the section line) exist as second-level topics in
d82979ea
EZ
6468a top-level topic at the end of the file.
6469
a0a022d5 6470`enable-local-variables' must be true for any of this to happen."
d82979ea
EZ
6471 (if (not (and enable-local-variables
6472 allout-enable-file-variable-adjustment))
6473 nil
6474 (save-excursion
0458fa80
EZ
6475 (let ((inhibit-field-text-motion t)
6476 (section-data (allout-file-vars-section-data))
d82979ea
EZ
6477 beg prefix suffix)
6478 (if section-data
6479 (setq beg (car section-data)
6480 prefix (cadr section-data)
6481 suffix (car (cddr section-data)))
6482 ;; create the section
6483 (goto-char (point-max))
6484 (open-line 1)
6485 (allout-open-topic 0)
6486 (end-of-line)
6487 (insert "Local emacs vars.\n")
6488 (allout-open-topic 1)
6489 (setq beg (point)
6490 suffix ""
6491 prefix (buffer-substring-no-properties (progn
6492 (beginning-of-line)
6493 (point))
6494 beg))
6495 (goto-char beg)
6496 (insert "Local variables:\n")
6497 (allout-open-topic 0)
6498 (insert "End:\n")
6499 )
6500 ;; look for existing entry or create one, leaving point for insertion
6501 ;; of new value:
6502 (goto-char beg)
6503 (allout-show-to-offshoot)
6504 (if (search-forward (concat "\n" prefix varname ":") nil t)
6505 (let* ((value-beg (point))
96b83743 6506 (line-end (progn (if (search-forward "\n" nil t)
d82979ea
EZ
6507 (forward-char -1))
6508 (point)))
6509 (value-end (- line-end (length suffix))))
6510 (if (> value-end value-beg)
6511 (delete-region value-beg value-end)))
6512 (end-of-line)
6513 (open-line 1)
6514 (forward-line 1)
6515 (insert (concat prefix varname ":")))
6516 (insert (format " %S%s" value suffix))
6517 )
6518 )
6519 )
6520 )
d8350998
CY
6521;;;_ > allout-get-configvar-values (varname)
6522(defun allout-get-configvar-values (configvar-name)
6523 "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
6524
6525The user is prompted for removal of symbols that are unbound, and they
6526otherwise are ignored.
6527
6528CONFIGVAR-NAME should be the name of the configuration variable,
6529not its value."
6530
6531 (let ((configvar-value (symbol-value configvar-name))
6532 got)
6533 (dolist (sym configvar-value)
6534 (if (not (boundp sym))
60c7bbd2 6535 (if (yes-or-no-p (format "%s entry `%s' is unbound -- remove it? "
d8350998
CY
6536 configvar-name sym))
6537 (delq sym (symbol-value configvar-name)))
6538 (push (symbol-value sym) got)))
6539 (reverse got)))
6540;;;_ : Topics:
6541;;;_ > allout-mark-topic ()
6542(defun allout-mark-topic ()
6543 "Put the region around topic currently containing point."
6544 (interactive)
6545 (let ((inhibit-field-text-motion t))
6546 (beginning-of-line))
6547 (allout-goto-prefix-doublechecked)
6548 (push-mark (point))
6549 (allout-end-of-current-subtree)
6550 (exchange-point-and-mark))
6551;;;_ : UI:
6552;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
1977b8f6 6553(defun solicit-char-in-string (prompt string &optional do-defaulting)
c567ac01 6554 "Solicit (with first arg PROMPT) choice of a character from string STRING.
1977b8f6 6555
c567ac01 6556Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
1977b8f6
RS
6557
6558 (let ((new-prompt prompt)
6559 got)
6560
6561 (while (not got)
6562 (message "%s" new-prompt)
6563
6564 ;; We do our own reading here, so we can circumvent, eg, special
9179616f 6565 ;; treatment for `?' character. (Oughta use minibuffer keymap instead.)
1977b8f6 6566 (setq got
c567ac01 6567 (char-to-string (let ((cursor-in-echo-area nil)) (read-char))))
1977b8f6 6568
9179616f
DL
6569 (setq got
6570 (cond ((string-match (regexp-quote got) string) got)
6571 ((and do-defaulting (string= got "\r"))
6572 ;; Return empty string to default:
6573 "")
6574 ((string= got "\C-g") (signal 'quit nil))
6575 (t
6576 (setq new-prompt (concat prompt
6577 got
6578 " ...pick from: "
6579 string
6580 ""))
6581 nil))))
60c7bbd2 6582 ;; got something out of loop -- return it:
9179616f 6583 got)
1977b8f6 6584 )
d8350998
CY
6585;;;_ : Strings:
6586;;;_ > regexp-sans-escapes (string)
c567ac01
RS
6587(defun regexp-sans-escapes (regexp &optional successive-backslashes)
6588 "Return a copy of REGEXP with all character escapes stripped out.
19b84ba3 6589
60c7bbd2 6590Representations of actual backslashes -- '\\\\\\\\' -- are left as a
c567ac01
RS
6591single backslash.
6592
d82979ea 6593Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
c567ac01
RS
6594
6595 (if (string= regexp "")
6596 ""
6597 ;; Set successive-backslashes to number if current char is
6598 ;; backslash, or else to nil:
6599 (setq successive-backslashes
6600 (if (= (aref regexp 0) ?\\)
6601 (if successive-backslashes (1+ successive-backslashes) 1)
6602 nil))
6603 (if (or (not successive-backslashes) (= 2 successive-backslashes))
6604 ;; Include first char:
6605 (concat (substring regexp 0 1)
6606 (regexp-sans-escapes (substring regexp 1)))
6607 ;; Exclude first char, but maintain count:
6608 (regexp-sans-escapes (substring regexp 1) successive-backslashes))))
d8350998 6609;;;_ > count-trailing-whitespace-region (beg end)
96b83743
EZ
6610(defun count-trailing-whitespace-region (beg end)
6611 "Return number of trailing whitespace chars between BEG and END.
6612
6613If BEG is bigger than END we return 0."
6614 (if (> beg end)
6615 0
2a1408fd
DN
6616 (save-match-data
6617 (save-excursion
6618 (goto-char beg)
6619 (let ((count 0))
6620 (while (re-search-forward "[ ][ ]*$" end t)
6621 (goto-char (1+ (match-beginning 2)))
6622 (setq count (1+ count)))
6623 count)))))
d8350998
CY
6624;;;_ > allout-format-quote (string)
6625(defun allout-format-quote (string)
6626 "Return a copy of string with all \"%\" characters doubled."
6627 (apply 'concat
6628 (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char)))
6629 string)))
6630;;;_ : lists
6631;;;_ > allout-flatten (list)
6632(defun allout-flatten (list)
6633 "Return a list of all atoms in list."
6634 ;; classic.
6635 (cond ((null list) nil)
8a559d4e
EZ
6636 ((atom (car list)) (cons (car list) (allout-flatten (cdr list))))
6637 (t (append (allout-flatten (car list)) (allout-flatten (cdr list))))))
75bcb912 6638;;;_ : Compatibility:
1c9b9df0
KM
6639;;;_ : xemacs undo-in-progress provision:
6640(unless (boundp 'undo-in-progress)
6641 (defvar undo-in-progress nil
6642 "Placeholder defvar for XEmacs compatibility from allout.el.")
6643 (defadvice undo-more (around allout activate)
6644 ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs.
6645 (let ((undo-in-progress t)) ad-do-it)))
6646
d8350998 6647;;;_ > allout-mark-marker to accommodate divergent emacsen:
96b83743
EZ
6648(defun allout-mark-marker (&optional force buffer)
6649 "Accommodate the different signature for `mark-marker' across Emacsen.
6650
6651XEmacs takes two optional args, while mainline GNU Emacs does not,
6652so pass them along when appropriate."
6653 (if (featurep 'xemacs)
6654 (apply 'mark-marker force buffer)
6655 (mark-marker)))
d8350998 6656;;;_ > subst-char-in-string if necessary
d82979ea
EZ
6657(if (not (fboundp 'subst-char-in-string))
6658 (defun subst-char-in-string (fromchar tochar string &optional inplace)
6659 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
6660Unless optional argument INPLACE is non-nil, return a new string."
6661 (let ((i (length string))
6662 (newstr (if inplace string (copy-sequence string))))
6663 (while (> i 0)
6664 (setq i (1- i))
6665 (if (eq (aref newstr i) fromchar)
6666 (aset newstr i tochar)))
6667 newstr)))
d8350998 6668;;;_ > wholenump if necessary
96b83743
EZ
6669(if (not (fboundp 'wholenump))
6670 (defalias 'wholenump 'natnump))
d8350998 6671;;;_ > remove-overlays if necessary
96b83743
EZ
6672(if (not (fboundp 'remove-overlays))
6673 (defun remove-overlays (&optional beg end name val)
6674 "Clear BEG and END of overlays whose property NAME has value VAL.
6675Overlays might be moved and/or split.
6676BEG and END default respectively to the beginning and end of buffer."
6677 (unless beg (setq beg (point-min)))
6678 (unless end (setq end (point-max)))
6679 (if (< end beg)
6680 (setq beg (prog1 end (setq end beg))))
6681 (save-excursion
6682 (dolist (o (overlays-in beg end))
6683 (when (eq (overlay-get o name) val)
6684 ;; Either push this overlay outside beg...end
6685 ;; or split it to exclude beg...end
6686 ;; or delete it entirely (if it is contained in beg...end).
6687 (if (< (overlay-start o) beg)
6688 (if (> (overlay-end o) end)
6689 (progn
6690 (move-overlay (copy-overlay o)
6691 (overlay-start o) beg)
6692 (move-overlay o end (overlay-end o)))
6693 (move-overlay o (overlay-start o) beg))
6694 (if (> (overlay-end o) end)
6695 (move-overlay o end (overlay-end o))
6696 (delete-overlay o)))))))
6697 )
60c7bbd2 6698;;;_ > copy-overlay if necessary -- xemacs ~ 21.4
96b83743
EZ
6699(if (not (fboundp 'copy-overlay))
6700 (defun copy-overlay (o)
6701 "Return a copy of overlay O."
6702 (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
6703 ;; FIXME: there's no easy way to find the
6704 ;; insertion-type of the two markers.
6705 (overlay-buffer o)))
6706 (props (overlay-properties o)))
6707 (while props
6708 (overlay-put o1 (pop props) (pop props)))
6709 o1)))
60c7bbd2 6710;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4
96b83743
EZ
6711(if (not (fboundp 'add-to-invisibility-spec))
6712 (defun add-to-invisibility-spec (element)
6713 "Add ELEMENT to `buffer-invisibility-spec'.
6714See documentation for `buffer-invisibility-spec' for the kind of elements
6715that can be added."
6716 (if (eq buffer-invisibility-spec t)
6717 (setq buffer-invisibility-spec (list t)))
6718 (setq buffer-invisibility-spec
6719 (cons element buffer-invisibility-spec))))
60c7bbd2 6720;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4
96b83743
EZ
6721(if (not (fboundp 'remove-from-invisibility-spec))
6722 (defun remove-from-invisibility-spec (element)
6723 "Remove ELEMENT from `buffer-invisibility-spec'."
6724 (if (consp buffer-invisibility-spec)
6725 (setq buffer-invisibility-spec (delete element
6726 buffer-invisibility-spec)))))
60c7bbd2 6727;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs
96b83743
EZ
6728(if (not (fboundp 'move-beginning-of-line))
6729 (defun move-beginning-of-line (arg)
6730 "Move point to beginning of current line as displayed.
6731\(This disregards invisible newlines such as those
6732which are part of the text that an image rests on.)
6733
6734With argument ARG not nil or 1, move forward ARG - 1 lines first.
6735If point reaches the beginning or end of buffer, it stops there.
4034b0e2 6736To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
96b83743
EZ
6737 (interactive "p")
6738 (or arg (setq arg 1))
6739 (if (/= arg 1)
6740 (condition-case nil (line-move (1- arg)) (error nil)))
6741
8570ce80
SM
6742 ;; Move to beginning-of-line, ignoring fields and invisibles.
6743 (skip-chars-backward "^\n")
2a1408fd
DN
6744 (while (and (not (bobp))
6745 (let ((prop
6746 (get-char-property (1- (point)) 'invisible)))
6747 (if (eq buffer-invisibility-spec t)
6748 prop
6749 (or (memq prop buffer-invisibility-spec)
6750 (assq prop buffer-invisibility-spec)))))
8570ce80
SM
6751 (goto-char (if (featurep 'xemacs)
6752 (previous-property-change (point))
6753 (previous-char-property-change (point))))
6754 (skip-chars-backward "^\n"))
6755 (vertical-motion 0))
96b83743 6756)
9b026d9f 6757;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs
96b83743
EZ
6758(if (not (fboundp 'move-end-of-line))
6759 (defun move-end-of-line (arg)
6760 "Move point to end of current line as displayed.
6761\(This disregards invisible newlines such as those
6762which are part of the text that an image rests on.)
6763
6764With argument ARG not nil or 1, move forward ARG - 1 lines first.
6765If point reaches the beginning or end of buffer, it stops there.
4034b0e2 6766To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
96b83743
EZ
6767 (interactive "p")
6768 (or arg (setq arg 1))
8570ce80 6769 (let (done)
96b83743
EZ
6770 (while (not done)
6771 (let ((newpos
6772 (save-excursion
6773 (let ((goal-column 0))
6774 (and (condition-case nil
6775 (or (line-move arg) t)
6776 (error nil))
6777 (not (bobp))
6778 (progn
2a1408fd
DN
6779 (while
6780 (and
6781 (not (bobp))
6782 (let ((prop
6783 (get-char-property (1- (point))
6784 'invisible)))
6785 (if (eq buffer-invisibility-spec t)
6786 prop
6787 (or (memq prop
6788 buffer-invisibility-spec)
6789 (assq prop
6790 buffer-invisibility-spec)))))
8570ce80
SM
6791 (goto-char
6792 (previous-char-property-change (point))))
96b83743
EZ
6793 (backward-char 1)))
6794 (point)))))
6795 (goto-char newpos)
6796 (if (and (> (point) newpos)
6797 (eq (preceding-char) ?\n))
6798 (backward-char 1)
6799 (if (and (> (point) newpos) (not (eobp))
6800 (not (eq (following-char) ?\n)))
6801 ;; If we skipped something intangible
6802 ;; and now we're not really at eol,
6803 ;; keep going.
6804 (setq arg 1)
8570ce80 6805 (setq done t)))))))
96b83743 6806 )
1c9b9df0
KM
6807;;;_ > allout-next-single-char-property-change -- alias unless lacking
6808(defalias 'allout-next-single-char-property-change
6809 (if (fboundp 'next-single-char-property-change)
6810 'next-single-char-property-change
6811 'next-single-property-change)
6812 ;; No docstring because xemacs defalias doesn't support it.
6813 )
6814;;;_ > allout-previous-single-char-property-change -- alias unless lacking
6815(defalias 'allout-previous-single-char-property-change
6816 (if (fboundp 'previous-single-char-property-change)
6817 'previous-single-char-property-change
6818 'previous-single-property-change)
6819 ;; No docstring because xemacs defalias doesn't support it.
6820 )
6821;;;_ > allout-set-buffer-multibyte
2576c28f
KM
6822(if (fboundp 'set-buffer-multibyte)
6823 (defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte)
6824 (with-no-warnings
6825 ;; this definition is used only in older or alternative emacs, where
6826 ;; the setting is our only recourse.
6827 (defun allout-set-buffer-multibyte (is-multibyte)
6828 (set enable-multibyte-characters is-multibyte))))
1c9b9df0
KM
6829;;;_ > allout-select-safe-coding-system
6830(defalias 'allout-select-safe-coding-system
6831 (if (fboundp 'select-safe-coding-system)
6832 'select-safe-coding-system
6833 'detect-coding-region)
6834 )
6835;;;_ > allout-substring-no-properties
6836;; define as alias first, so byte compiler is happy.
6837(defalias 'allout-substring-no-properties 'substring-no-properties)
6838;; then supplant with definition if underlying alias absent.
6839(if (not (fboundp 'substring-no-properties))
6840 (defun allout-substring-no-properties (string &optional start end)
6841 (substring string (or start 0) end))
6842 )
96b83743 6843
96b83743 6844;;;_ #10 Unfinished
fd5359c6
MR
6845;;;_ > allout-bullet-isearch (&optional bullet)
6846(defun allout-bullet-isearch (&optional bullet)
c07583cd 6847 "Isearch (regexp) for topic with bullet BULLET."
c567ac01
RS
6848 (interactive)
6849 (if (not bullet)
6850 (setq bullet (solicit-char-in-string
6851 "ISearch for topic with bullet: "
fd5359c6 6852 (regexp-sans-escapes allout-bullets-string))))
353e2ef2 6853
c567ac01
RS
6854 (let ((isearch-regexp t)
6855 (isearch-string (concat "^"
fd5359c6 6856 allout-header-prefix
c567ac01
RS
6857 "[ \t]*"
6858 bullet)))
6859 (isearch-repeat 'forward)
6860 (isearch-mode t)))
96b83743 6861
60c7bbd2 6862;;;_ #11 Unit tests -- this should be last item before "Provide"
01fc9422
EZ
6863;;;_ > allout-run-unit-tests ()
6864(defun allout-run-unit-tests ()
6865 "Run the various allout unit tests."
6866 (message "Running allout tests...")
6867 (allout-test-resumptions)
6868 (message "Running allout tests... Done.")
6869 (sit-for .5))
6870;;;_ : test resumptions:
6871;;;_ > allout-tests-obliterate-variable (name)
6872(defun allout-tests-obliterate-variable (name)
6873 "Completely unbind variable with NAME."
1c9b9df0 6874 (if (local-variable-p name (current-buffer)) (kill-local-variable name))
01fc9422
EZ
6875 (while (boundp name) (makunbound name)))
6876;;;_ > allout-test-resumptions ()
6877(defvar allout-tests-globally-unbound nil
60c7bbd2 6878 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
01fc9422 6879(defvar allout-tests-globally-true nil
60c7bbd2 6880 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
01fc9422 6881(defvar allout-tests-locally-true nil
60c7bbd2 6882 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
01fc9422
EZ
6883(defun allout-test-resumptions ()
6884 "Exercise allout resumptions."
6885 ;; for each resumption case, we also test that the right local/global
6886 ;; scopes are affected during resumption effects:
6887
6888 ;; ensure that previously unbound variables return to the unbound state.
6889 (with-temp-buffer
6890 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6891 (allout-add-resumptions '(allout-tests-globally-unbound t))
6892 (assert (not (default-boundp 'allout-tests-globally-unbound)))
1c9b9df0 6893 (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
01fc9422
EZ
6894 (assert (boundp 'allout-tests-globally-unbound))
6895 (assert (equal allout-tests-globally-unbound t))
6896 (allout-do-resumptions)
1c9b9df0
KM
6897 (assert (not (local-variable-p 'allout-tests-globally-unbound
6898 (current-buffer))))
01fc9422
EZ
6899 (assert (not (boundp 'allout-tests-globally-unbound))))
6900
6901 ;; ensure that variable with prior global value is resumed
6902 (with-temp-buffer
6903 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6904 (setq allout-tests-globally-true t)
6905 (allout-add-resumptions '(allout-tests-globally-true nil))
6906 (assert (equal (default-value 'allout-tests-globally-true) t))
1c9b9df0 6907 (assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
01fc9422
EZ
6908 (assert (equal allout-tests-globally-true nil))
6909 (allout-do-resumptions)
1c9b9df0
KM
6910 (assert (not (local-variable-p 'allout-tests-globally-true
6911 (current-buffer))))
01fc9422
EZ
6912 (assert (boundp 'allout-tests-globally-true))
6913 (assert (equal allout-tests-globally-true t)))
6914
6915 ;; ensure that prior local value is resumed
6916 (with-temp-buffer
6917 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6918 (set (make-local-variable 'allout-tests-locally-true) t)
6919 (assert (not (default-boundp 'allout-tests-locally-true))
60c7bbd2 6920 nil (concat "Test setup mistake -- variable supposed to"
01fc9422 6921 " not have global binding, but it does."))
1c9b9df0 6922 (assert (local-variable-p 'allout-tests-locally-true (current-buffer))
60c7bbd2 6923 nil (concat "Test setup mistake -- variable supposed to have"
01fc9422
EZ
6924 " local binding, but it lacks one."))
6925 (allout-add-resumptions '(allout-tests-locally-true nil))
6926 (assert (not (default-boundp 'allout-tests-locally-true)))
1c9b9df0 6927 (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
01fc9422
EZ
6928 (assert (equal allout-tests-locally-true nil))
6929 (allout-do-resumptions)
6930 (assert (boundp 'allout-tests-locally-true))
1c9b9df0 6931 (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
01fc9422
EZ
6932 (assert (equal allout-tests-locally-true t))
6933 (assert (not (default-boundp 'allout-tests-locally-true))))
6934
6935 ;; ensure that last of multiple resumptions holds, for various scopes.
6936 (with-temp-buffer
6937 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6938 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6939 (setq allout-tests-globally-true t)
6940 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6941 (set (make-local-variable 'allout-tests-locally-true) t)
6942 (allout-add-resumptions '(allout-tests-globally-unbound t)
6943 '(allout-tests-globally-true nil)
6944 '(allout-tests-locally-true nil))
6945 (allout-add-resumptions '(allout-tests-globally-unbound 2)
6946 '(allout-tests-globally-true 3)
6947 '(allout-tests-locally-true 4))
6948 ;; reestablish many of the basic conditions are maintained after re-add:
6949 (assert (not (default-boundp 'allout-tests-globally-unbound)))
1c9b9df0 6950 (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
01fc9422
EZ
6951 (assert (equal allout-tests-globally-unbound 2))
6952 (assert (default-boundp 'allout-tests-globally-true))
1c9b9df0 6953 (assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
01fc9422
EZ
6954 (assert (equal allout-tests-globally-true 3))
6955 (assert (not (default-boundp 'allout-tests-locally-true)))
1c9b9df0 6956 (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
01fc9422
EZ
6957 (assert (equal allout-tests-locally-true 4))
6958 (allout-do-resumptions)
1c9b9df0
KM
6959 (assert (not (local-variable-p 'allout-tests-globally-unbound
6960 (current-buffer))))
01fc9422 6961 (assert (not (boundp 'allout-tests-globally-unbound)))
1c9b9df0
KM
6962 (assert (not (local-variable-p 'allout-tests-globally-true
6963 (current-buffer))))
01fc9422
EZ
6964 (assert (boundp 'allout-tests-globally-true))
6965 (assert (equal allout-tests-globally-true t))
6966 (assert (boundp 'allout-tests-locally-true))
1c9b9df0 6967 (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
01fc9422
EZ
6968 (assert (equal allout-tests-locally-true t))
6969 (assert (not (default-boundp 'allout-tests-locally-true))))
6970
6971 ;; ensure that deliberately unbinding registered variables doesn't foul things
6972 (with-temp-buffer
6973 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6974 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6975 (setq allout-tests-globally-true t)
6976 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6977 (set (make-local-variable 'allout-tests-locally-true) t)
6978 (allout-add-resumptions '(allout-tests-globally-unbound t)
6979 '(allout-tests-globally-true nil)
6980 '(allout-tests-locally-true nil))
6981 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6982 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6983 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6984 (allout-do-resumptions))
6985 )
6986;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true:
6987(when allout-run-unit-tests-on-load
6988 (allout-run-unit-tests))
6989
6990;;;_ #12 Provide
96b83743 6991(provide 'allout)
1977b8f6
RS
6992
6993;;;_* Local emacs vars.
31468dcb
SM
6994;; The following `allout-layout' local variable setting:
6995;; - closes all topics from the first topic to just before the third-to-last,
6996;; - shows the children of the third to last (config vars)
6997;; - and the second to last (code section),
6998;; - and closes the last topic (this local-variables section).
6999;;Local variables:
7000;;allout-layout: (0 : -1 -1 0)
7001;;End:
7002
6a05d05f 7003;;; allout.el ends here