3 |
;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, |
;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, |
4 |
;; 2005 Free Software Foundation, Inc. |
;; 2005 Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Ken Manheimer <klm@zope.com> |
;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> |
7 |
;; Maintainer: Ken Manheimer <klm@zope.com> |
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> |
8 |
;; Created: Dec 1991 - first release to usenet |
;; Created: Dec 1991 - first release to usenet |
9 |
;; Keywords: outlines mode wp languages |
;; Keywords: outlines wp languages |
10 |
|
|
11 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
12 |
|
|
34 |
;; programming languages. (For an example, see the allout code |
;; programming languages. (For an example, see the allout code |
35 |
;; itself, which is organized in ;; an outline framework.) |
;; itself, which is organized in ;; an outline framework.) |
36 |
;; |
;; |
37 |
;; In addition to outline navigation and exposure, allout includes: |
;; Some features: |
38 |
;; |
;; |
39 |
;; - topic-oriented repositioning, cut, and paste |
;; - classic outline-mode topic-oriented navigation and exposure adjustment |
40 |
;; - integral outline exposure-layout |
;; - topic-oriented editing including coherent topic and subtopic |
41 |
;; - incremental search with dynamic exposure and reconcealment of hidden text |
;; creation, promotion, demotion, cut/paste across depths, etc |
42 |
|
;; - incremental search with dynamic exposure and reconcealment of text |
43 |
|
;; - customizable bullet format enbles programming-language specific |
44 |
|
;; outlining, for ultimate code-folding editing. (allout code itself is |
45 |
|
;; formatted as an outline - do ESC-x eval-current-buffer in allout.el |
46 |
|
;; to try it out.) |
47 |
|
;; - configurable per-file initial exposure settings |
48 |
|
;; - symmetric-key and key-pair topic encryption, plus reliable key |
49 |
|
;; verification and user-supplied hint maintenance. (see |
50 |
|
;; allout-toggle-current-subtree-encryption docstring.) |
51 |
;; - automatic topic-number maintenance |
;; - automatic topic-number maintenance |
52 |
;; - "Hot-spot" operation, for single-keystroke maneuvering and |
;; - "hot-spot" operation, for single-keystroke maneuvering and |
53 |
;; exposure control. (See the `allout-mode' docstring.) |
;; exposure control (see the allout-mode docstring) |
54 |
|
;; - easy rendering of exposed portions into numbered, latex, indented, etc |
55 |
|
;; outline styles |
56 |
;; |
;; |
57 |
;; and many other features. |
;; and more. |
58 |
;; |
;; |
59 |
;; The outline menubar additions provide quick reference to many of |
;; The outline menubar additions provide quick reference to many of |
60 |
;; the features, and see the docstring of the function `allout-init' |
;; the features, and see the docstring of the variable `allout-init' |
61 |
;; for instructions on priming your Emacs session for automatic |
;; for instructions on priming your emacs session for automatic |
62 |
;; activation of `allout-mode'. |
;; activation of allout-mode. |
63 |
;; |
;; |
64 |
;; See the docstring of the variables `allout-layout' and |
;; See the docstring of the variables `allout-layout' and |
65 |
;; `allout-auto-activation' for details on automatic activation of |
;; `allout-auto-activation' for details on automatic activation of |
66 |
;; allout `allout-mode' as a minor mode. (It has changed since allout |
;; `allout-mode' as a minor mode. (It has changed since allout |
67 |
;; 3.x, for those of you that depend on the old method.) |
;; 3.x, for those of you that depend on the old method.) |
68 |
;; |
;; |
69 |
;; Note - the lines beginning with `;;;_' are outline topic headers. |
;; Note - the lines beginning with `;;;_' are outline topic headers. |
70 |
;; Just `ESC-x eval-current-buffer' to give it a whirl. |
;; Just `ESC-x eval-current-buffer' to give it a whirl. |
71 |
|
|
72 |
;; Ken Manheimer klm@zope.com |
;; ken manheimer (ken dot manheimer at gmail dot com) |
73 |
|
|
74 |
;;; Code: |
;;; Code: |
75 |
|
|
76 |
;;;_* Provide |
;;;_* Provide |
77 |
|
;(provide 'outline) |
78 |
(provide 'allout) |
(provide 'allout) |
79 |
|
|
80 |
|
;;;_* Dependency autoloads |
81 |
|
(eval-when-compile 'cl) ; otherwise, flet compilation fouls |
82 |
|
(autoload 'crypt-encrypt-buffer "crypt++") |
83 |
|
(setq-default crypt-encryption-type 'gpg) |
84 |
|
|
85 |
|
(autoload 'mc-encrypt "mailcrypt" |
86 |
|
"*Encrypt the current buffer") |
87 |
|
(autoload 'mc-activate-passwd "mailcrypt" |
88 |
|
"Activate the passphrase matching ID, using PROMPT for a prompt. |
89 |
|
Return the passphrase. If PROMPT is nil, only return value if cached.") |
90 |
|
(autoload 'mc-gpg-process-region "mc-gpg") |
91 |
|
(autoload 'mc-dectivate-passwd "mailcrypt" |
92 |
|
"*Deactivate the passphrase cache.") |
93 |
|
|
94 |
;;;_* USER CUSTOMIZATION VARIABLES: |
;;;_* USER CUSTOMIZATION VARIABLES: |
95 |
(defgroup allout nil |
(defgroup allout nil |
96 |
"Extensive outline mode for use alone and with other modes." |
"Extensive outline mode for use alone and with other modes." |
97 |
:prefix "allout-" |
:prefix "allout-" |
98 |
:group 'editing |
:group 'outlines) |
|
:version "22.1") |
|
99 |
|
|
100 |
;;;_ + Layout, Mode, and Topic Header Configuration |
;;;_ + Layout, Mode, and Topic Header Configuration |
101 |
|
|
136 |
|
|
137 |
A list value specifies a default layout for the current buffer, to be |
A list value specifies a default layout for the current buffer, to be |
138 |
applied upon activation of `allout-mode'. Any non-nil value will |
applied upon activation of `allout-mode'. Any non-nil value will |
139 |
automatically trigger `allout-mode', provided `allout-init' |
automatically trigger `allout-mode' \(provided `allout-init' has been called |
140 |
has been called to enable it. |
to enable this behavior). |
141 |
|
|
142 |
See the docstring for `allout-init' for details on setting up for |
See the docstring for `allout-init' for details on setting up for |
143 |
auto-mode-activation, and for `allout-expose-topic' for the format of |
auto-mode-activation, and for `allout-expose-topic' for the format of |
196 |
:group 'allout) |
:group 'allout) |
197 |
(make-variable-buffer-local 'allout-primary-bullet) |
(make-variable-buffer-local 'allout-primary-bullet) |
198 |
;;;_ = allout-plain-bullets-string |
;;;_ = allout-plain-bullets-string |
199 |
(defcustom allout-plain-bullets-string ".:,;" |
(defcustom allout-plain-bullets-string ".," |
200 |
"*The bullets normally used in outline topic prefixes. |
"*The bullets normally used in outline topic prefixes. |
201 |
|
|
202 |
See `allout-distinctive-bullets-string' for the other kind of |
See `allout-distinctive-bullets-string' for the other kind of |
210 |
:group 'allout) |
:group 'allout) |
211 |
(make-variable-buffer-local 'allout-plain-bullets-string) |
(make-variable-buffer-local 'allout-plain-bullets-string) |
212 |
;;;_ = allout-distinctive-bullets-string |
;;;_ = allout-distinctive-bullets-string |
213 |
(defcustom allout-distinctive-bullets-string "*+-=>([{}&!?#%\"X@$~_\\" |
(defcustom allout-distinctive-bullets-string "*+-=>()[{}&!?#%\"X@$~_\\:;^" |
214 |
"*Persistent outline header bullets used to distinguish special topics. |
"*Persistent outline header bullets used to distinguish special topics. |
215 |
|
|
216 |
These bullets are used to distinguish topics from the run-of-the-mill |
These bullets are used to distinguish topics from the run-of-the-mill |
223 |
`?' question topics |
`?' question topics |
224 |
`\(' parenthetic comment \(with a matching close paren inside) |
`\(' parenthetic comment \(with a matching close paren inside) |
225 |
`[' meta-note \(with a matching close ] inside) |
`[' meta-note \(with a matching close ] inside) |
226 |
`\"' a quote |
`\"' a quotation |
227 |
`=' value settings |
`=' value settings |
228 |
`~' \"more or less\" |
`~' \"more or less\" |
229 |
|
`^' see above |
230 |
|
|
231 |
... just for example. (`#' typically has a special meaning to the |
... for example. (`#' typically has a special meaning to the software, |
232 |
software, according to the value of `allout-numbered-bullet'.) |
according to the value of `allout-numbered-bullet'.) |
233 |
|
|
234 |
See `allout-plain-bullets-string' for the selection of |
See `allout-plain-bullets-string' for the selection of |
235 |
alternating bullets. |
alternating bullets. |
363 |
Set this var to the bullet you want to use for file cross-references." |
Set this var to the bullet you want to use for file cross-references." |
364 |
:type '(choice (const nil) string) |
:type '(choice (const nil) string) |
365 |
:group 'allout) |
:group 'allout) |
|
|
|
366 |
;;;_ = allout-presentation-padding |
;;;_ = allout-presentation-padding |
367 |
(defcustom allout-presentation-padding 2 |
(defcustom allout-presentation-padding 2 |
368 |
"*Presentation-format white-space padding factor, for greater indent." |
"*Presentation-format white-space padding factor, for greater indent." |
406 |
:type 'string |
:type 'string |
407 |
:group 'allout) |
:group 'allout) |
408 |
;;;_ - allout-title |
;;;_ - allout-title |
409 |
(defcustom allout-title '(or buffer-file-name (current-buffer-name)) |
(defcustom allout-title '(or buffer-file-name (buffer-name)) |
410 |
"*Expression to be evaluated to determine the title for LaTeX |
"*Expression to be evaluated to determine the title for LaTeX |
411 |
formatted copy." |
formatted copy." |
412 |
:type 'sexp |
:type 'sexp |
422 |
:type 'string |
:type 'string |
423 |
:group 'allout) |
:group 'allout) |
424 |
|
|
425 |
|
;;;_ + Topic encryption |
426 |
|
;;;_ = allout-topic-encryption-bullet |
427 |
|
(defcustom allout-topic-encryption-bullet "~" |
428 |
|
"*Bullet signifying encryption of the entry's body." |
429 |
|
:type '(choice (const nil) string) |
430 |
|
:group 'allout) |
431 |
|
;;;_ = allout-default-encryption-scheme |
432 |
|
(defcustom allout-default-encryption-scheme 'mc-scheme-gpg |
433 |
|
"*Default allout outline topic encryption mode. |
434 |
|
|
435 |
|
See mailcrypt variable `mc-schemes' and mailcrypt docs for encryption schemes." |
436 |
|
:type 'symbol |
437 |
|
:group 'allout) |
438 |
|
;;;_ = allout-key-verifier-handling |
439 |
|
(defcustom allout-key-verifier-handling 'situate |
440 |
|
"*Dictate outline encryption key verifier handling. |
441 |
|
|
442 |
|
The key verifier is string associated with a file that is encrypted with |
443 |
|
the file's current symmetric encryption key. It is used, if present, to |
444 |
|
confirm that the key entered by the user is the same as the established |
445 |
|
one, or explicitly presenting the user with the choice to go with a |
446 |
|
new key when a difference is encountered. |
447 |
|
|
448 |
|
The range of values are: |
449 |
|
|
450 |
|
situate - include key verifier string as text in the file's local-vars |
451 |
|
section |
452 |
|
transient - establish the value as a variable in the file's buffer, but |
453 |
|
don't preserve it as a file variable. |
454 |
|
disabled - don't establish or do verification. |
455 |
|
|
456 |
|
See the docstring for the `allout-enable-file-variable-adjustment' |
457 |
|
variable for details about allout ajustment of file variables." |
458 |
|
:type '(choice (const situate) |
459 |
|
(const transient) |
460 |
|
(const disabled)) |
461 |
|
:group 'allout) |
462 |
|
(make-variable-buffer-local 'allout-key-verifier-handling) |
463 |
|
;;;_ = allout-key-hint-handling |
464 |
|
(defcustom allout-key-hint-handling 'always |
465 |
|
"*Dictate outline encryption key reminder handling: |
466 |
|
|
467 |
|
always - always show reminder when prompting |
468 |
|
needed - show reminder on key entry failure |
469 |
|
manage - never present reminder, but still manage a file-var entry for it |
470 |
|
disabled - don't even manage the file variable entry |
471 |
|
|
472 |
|
See the docstring for the `allout-enable-file-variable-adjustment' |
473 |
|
variable for details about allout ajustment of file variables." |
474 |
|
:type '(choice (const always) |
475 |
|
(const needed) |
476 |
|
(const manage) |
477 |
|
(const disabled)) |
478 |
|
:group 'allout) |
479 |
|
(make-variable-buffer-local 'allout-key-hint-handling) |
480 |
|
;;;_ = allout-encrypt-unencrypted-on-saves |
481 |
|
(defcustom allout-encrypt-unencrypted-on-saves 'except-current |
482 |
|
"*When saving, should topics pending encryption be encrypted? |
483 |
|
|
484 |
|
The idea is to prevent file-system exposure of any un-encrypted stuff, and |
485 |
|
mostly covers both deliberate file writes and auto-saves. |
486 |
|
|
487 |
|
- Yes: encrypt all topics pending encryption, even if it's the one |
488 |
|
currently being edited. \(In that case, the currently edited topic |
489 |
|
will be automatically decrypted before any user interaction, so they |
490 |
|
can continue editing but the copy on the file system will be |
491 |
|
encrypted.) |
492 |
|
Auto-saves will use the \"All except current topic\" mode if this |
493 |
|
one is selected, to avoid practical difficulties - see below. |
494 |
|
- All except current topic: skip the topic currently being edited, even if |
495 |
|
it's pending encryption. This may expose the current topic on the |
496 |
|
file sytem, but avoids the nuisance of prompts for the encryption |
497 |
|
key in the middle of editing for, eg, autosaves. |
498 |
|
This mode is used for auto-saves for both this option and \"Yes\". |
499 |
|
- No: leave it to the user to encrypt any unencrypted topics. |
500 |
|
|
501 |
|
For practical reasons, auto-saves always use the 'except-current policy |
502 |
|
when auto-encryption is enabled. \(Otherwise, spurious key prompts and |
503 |
|
unavoidable timing collisions are too disruptive.) If security for a file |
504 |
|
requires that even the current topic is never auto-saved in the clear, |
505 |
|
disable auto-saves for that file." |
506 |
|
|
507 |
|
:type '(choice (const :tag "Yes" t) |
508 |
|
(const :tag "All except current topic" except-current) |
509 |
|
(const :tag "No" nil)) |
510 |
|
:group 'allout) |
511 |
|
(make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) |
512 |
|
|
513 |
;;;_ + Miscellaneous customization |
;;;_ + Miscellaneous customization |
514 |
|
|
515 |
;;;_ = allout-command-prefix |
;;;_ = allout-command-prefix |
535 |
("\C-f" allout-forward-current-level) |
("\C-f" allout-forward-current-level) |
536 |
("\C-b" allout-backward-current-level) |
("\C-b" allout-backward-current-level) |
537 |
("\C-a" allout-beginning-of-current-entry) |
("\C-a" allout-beginning-of-current-entry) |
538 |
("\C-e" allout-end-of-current-entry) |
("\C-e" allout-end-of-entry) |
539 |
; Exposure commands: |
; Exposure commands: |
540 |
("\C-i" allout-show-children) |
("\C-i" allout-show-children) |
541 |
("\C-s" allout-show-current-subtree) |
("\C-s" allout-show-current-subtree) |
542 |
("\C-h" allout-hide-current-subtree) |
("\C-h" allout-hide-current-subtree) |
543 |
|
("h" allout-hide-current-subtree) |
544 |
("\C-o" allout-show-current-entry) |
("\C-o" allout-show-current-entry) |
545 |
("!" allout-show-all) |
("!" allout-show-all) |
546 |
|
("x" allout-toggle-current-subtree-encryption) |
547 |
; Alteration commands: |
; Alteration commands: |
548 |
(" " allout-open-sibtopic) |
(" " allout-open-sibtopic) |
549 |
("." allout-open-subtopic) |
("." allout-open-subtopic) |
604 |
|
|
605 |
(make-variable-buffer-local 'allout-reindent-bodies) |
(make-variable-buffer-local 'allout-reindent-bodies) |
606 |
|
|
607 |
;;;_ = allout-inhibit-protection |
;;;_ = allout-enable-file-variable-adjustment |
608 |
(defcustom allout-inhibit-protection nil |
(defcustom allout-enable-file-variable-adjustment t |
609 |
"*Non-nil disables warnings and confirmation-checks for concealed-text edits. |
"*If non-nil, some allout outline actions can edit Emacs file variables text. |
610 |
|
|
611 |
Outline mode uses Emacs change-triggered functions to detect unruly |
This can range from changes to existing entries, addition of new ones, |
612 |
changes to concealed regions. Set this var non-nil to disable the |
and creation of a new local variables section when necessary. |
613 |
protection, potentially increasing text-entry responsiveness a bit. |
|
614 |
|
Emacs file variables adjustments are also inhibited if `enable-local-variables' |
615 |
This var takes effect at `allout-mode' activation, so you may have to |
is nil. |
616 |
deactivate and then reactivate the mode if you want to toggle the |
|
617 |
behavior." |
Operations potentially causing edits include allout encryption routines. |
618 |
|
See the docstring for `allout-toggle-current-subtree-encryption' for |
619 |
|
details." |
620 |
:type 'boolean |
:type 'boolean |
621 |
:group 'allout) |
:group 'allout) |
622 |
|
(make-variable-buffer-local 'allout-enable-file-variable-adjustment) |
623 |
|
|
624 |
;;;_* CODE - no user customizations below. |
;;;_* CODE - no user customizations below. |
625 |
|
|
846 |
(car (cdr cell))))))) |
(car (cdr cell))))))) |
847 |
keymap-list) |
keymap-list) |
848 |
map)) |
map)) |
849 |
|
;;;_ = allout-prior-bindings - being deprecated. |
850 |
|
(defvar allout-prior-bindings nil |
851 |
|
"Variable for use in V18, with allout-added-bindings, for |
852 |
|
resurrecting, on mode deactivation, bindings that existed before |
853 |
|
activation. Being deprecated.") |
854 |
|
;;;_ = allout-added-bindings - being deprecated |
855 |
|
(defvar allout-added-bindings nil |
856 |
|
"Variable for use in V18, with allout-prior-bindings, for |
857 |
|
resurrecting, on mode deactivation, bindings that existed before |
858 |
|
activation. Being deprecated.") |
859 |
;;;_ : Menu bar |
;;;_ : Menu bar |
860 |
(defvar allout-mode-exposure-menu) |
(defvar allout-mode-exposure-menu) |
861 |
(defvar allout-mode-editing-menu) |
(defvar allout-mode-editing-menu) |
886 |
["Shift Topic Out" allout-shift-out t] |
["Shift Topic Out" allout-shift-out t] |
887 |
["Rebullet Topic" allout-rebullet-topic t] |
["Rebullet Topic" allout-rebullet-topic t] |
888 |
["Rebullet Heading" allout-rebullet-current-heading t] |
["Rebullet Heading" allout-rebullet-current-heading t] |
889 |
["Number Siblings" allout-number-siblings t])) |
["Number Siblings" allout-number-siblings t] |
890 |
|
"----" |
891 |
|
["Toggle Topic Encryption" |
892 |
|
allout-toggle-current-subtree-encryption |
893 |
|
(> (allout-current-depth) 1)])) |
894 |
(easy-menu-define allout-mode-navigation-menu |
(easy-menu-define allout-mode-navigation-menu |
895 |
allout-mode-map |
allout-mode-map |
896 |
"Allout outline navigation menu." |
"Allout outline navigation menu." |
906 |
"----" |
"----" |
907 |
["Beginning of Entry" |
["Beginning of Entry" |
908 |
allout-beginning-of-current-entry t] |
allout-beginning-of-current-entry t] |
909 |
["End of Entry" allout-end-of-current-entry t] |
["End of Entry" allout-end-of-entry t] |
910 |
["End of Subtree" allout-end-of-current-subtree t])) |
["End of Subtree" allout-end-of-current-subtree t])) |
911 |
(easy-menu-define allout-mode-misc-menu |
(easy-menu-define allout-mode-misc-menu |
912 |
allout-mode-map |
allout-mode-map |
986 |
(setq allout-mode-prior-settings rebuild))))) |
(setq allout-mode-prior-settings rebuild))))) |
987 |
) |
) |
988 |
;;;_ : Mode-specific incidentals |
;;;_ : Mode-specific incidentals |
|
;;;_ = allout-during-write-cue nil |
|
|
(defvar allout-during-write-cue nil |
|
|
"Used to inhibit outline change-protection during file write. |
|
|
|
|
|
See also `allout-post-command-business', `allout-write-file-hook', |
|
|
`allout-before-change-protect', and `allout-post-command-business' |
|
|
functions.") |
|
989 |
;;;_ = allout-pre-was-isearching nil |
;;;_ = allout-pre-was-isearching nil |
990 |
(defvar allout-pre-was-isearching nil |
(defvar allout-pre-was-isearching nil |
991 |
"Cue for isearch-dynamic-exposure mechanism, implemented in |
"Cue for isearch-dynamic-exposure mechanism, implemented in |
993 |
(make-variable-buffer-local 'allout-pre-was-isearching) |
(make-variable-buffer-local 'allout-pre-was-isearching) |
994 |
;;;_ = allout-isearch-prior-pos nil |
;;;_ = allout-isearch-prior-pos nil |
995 |
(defvar allout-isearch-prior-pos nil |
(defvar allout-isearch-prior-pos nil |
996 |
"Cue for isearch-dynamic-exposure tracking, used by `allout-isearch-expose'.") |
"Cue for isearch-dynamic-exposure tracking, used by |
997 |
|
`allout-isearch-expose'.") |
998 |
(make-variable-buffer-local 'allout-isearch-prior-pos) |
(make-variable-buffer-local 'allout-isearch-prior-pos) |
999 |
;;;_ = allout-override-protect nil |
;;;_ = allout-isearch-did-quit |
1000 |
(defvar allout-override-protect nil |
(defvar allout-isearch-did-quit nil |
1001 |
"Used in `allout-mode' for regulate of concealed-text protection mechanism. |
"Distinguishes isearch conclusion and cancellation. |
1002 |
|
|
1003 |
Allout outline mode regulates alteration of concealed text to protect |
Maintained by allout-isearch-abort \(which is wrapped around the real |
1004 |
against inadvertent, unnoticed changes. This is for use by specific, |
isearch-abort), and monitored by allout-isearch-expose for action.") |
1005 |
native outline functions to temporarily override that protection. |
(make-variable-buffer-local 'allout-isearch-did-quit) |
|
It's automatically reset to nil after every buffer modification.") |
|
|
(make-variable-buffer-local 'allout-override-protect) |
|
1006 |
;;;_ > allout-unprotected (expr) |
;;;_ > allout-unprotected (expr) |
1007 |
(defmacro allout-unprotected (expression) |
(defmacro allout-unprotected (expr) |
1008 |
"Evaluate EXPRESSION with `allout-override-protect' let-bound to t." |
"Enable internal outline operations to alter read-only text." |
1009 |
`(let ((allout-override-protect t)) |
`(let ((was-inhibit-r-o inhibit-read-only)) |
1010 |
,expression)) |
(unwind-protect |
1011 |
|
(progn |
1012 |
|
(setq inhibit-read-only t) |
1013 |
|
,expr) |
1014 |
|
(setq inhibit-read-only was-inhibit-r-o) |
1015 |
|
) |
1016 |
|
) |
1017 |
|
) |
1018 |
;;;_ = allout-undo-aggregation |
;;;_ = allout-undo-aggregation |
1019 |
(defvar allout-undo-aggregation 30 |
(defvar allout-undo-aggregation 30 |
1020 |
"Amount of successive self-insert actions to bunch together per undo. |
"Amount of successive self-insert actions to bunch together per undo. |
1027 |
"Horrible hack used to prevent invalid multiple triggering of outline |
"Horrible hack used to prevent invalid multiple triggering of outline |
1028 |
mode from prop-line file-var activation. Used by `allout-mode' function |
mode from prop-line file-var activation. Used by `allout-mode' function |
1029 |
to track repeats.") |
to track repeats.") |
1030 |
;;;_ > allout-write-file-hook () |
;;;_ = allout-file-key-verifier-string |
1031 |
(defun allout-write-file-hook () |
(defvar allout-file-key-verifier-string nil |
1032 |
"In `allout-mode', run as a `write-contents-functions' activity. |
"Name for use as a file variable for verifying encryption key across |
1033 |
|
sessions.") |
1034 |
Currently just sets `allout-during-write-cue', so outline change-protection |
(make-variable-buffer-local 'allout-file-key-verifier-string) |
1035 |
knows to keep inactive during file write." |
;;;_ = allout-encryption-scheme |
1036 |
(setq allout-during-write-cue t) |
(defvar allout-encryption-scheme nil |
1037 |
nil) |
"*Allout outline topic encryption scheme pending for the current buffer. |
1038 |
|
|
1039 |
|
Intended as a file-specific (buffer local) setting, it defaults to the |
1040 |
|
value of allout-default-encryption-scheme if nil.") |
1041 |
|
(make-variable-buffer-local 'allout-encryption-scheme) |
1042 |
|
;;;_ = allout-key-verifier-string |
1043 |
|
(defvar allout-key-verifier-string nil |
1044 |
|
"Setting used to test solicited encryption keys against that already |
1045 |
|
associated with a file. |
1046 |
|
|
1047 |
|
It consists of an encrypted random string useful only to verify that a key |
1048 |
|
entered by the user is effective for decryption. The key itself is \*not* |
1049 |
|
recorded in the file anywhere, and the encrypted contents are random binary |
1050 |
|
characters to avoid exposing greater susceptibility to search attacks. |
1051 |
|
|
1052 |
|
The verifier string is retained as an Emacs file variable, as well as in |
1053 |
|
the emacs buffer state, if file variable adjustments are enabled. See |
1054 |
|
`allout-enable-file-variable-adjustment' for details about that.") |
1055 |
|
(make-variable-buffer-local 'allout-key-verifier-string) |
1056 |
|
(setq-default allout-key-verifier-string nil) |
1057 |
|
;;;_ = allout-key-hint-string |
1058 |
|
(defvar allout-key-hint-string "" |
1059 |
|
"Variable used to retain a reminder string for a file's encryption key. |
1060 |
|
|
1061 |
|
See the description of `allout-key-hint-handling' for details about how |
1062 |
|
the reminder is deployed. |
1063 |
|
|
1064 |
|
The hint is retained as an Emacs file variable, as well as in the emacs buffer |
1065 |
|
state, if file variable adjustments are enabled. See |
1066 |
|
`allout-enable-file-variable-adjustment' for details about that.") |
1067 |
|
(make-variable-buffer-local 'allout-key-hint-string) |
1068 |
|
(setq-default allout-key-hint-string "") |
1069 |
|
;;;_ = allout-after-save-decrypt |
1070 |
|
(defvar allout-after-save-decrypt nil |
1071 |
|
"Internal variable, is nil or has the value of two points: |
1072 |
|
|
1073 |
|
- the location of a topic to be decrypted after saving is done |
1074 |
|
- where to situate the cursor after the decryption is performed |
1075 |
|
|
1076 |
|
This is used to decrypt the topic that was currently being edited, if it |
1077 |
|
was encrypted automatically as part of a file write or autosave.") |
1078 |
|
(make-variable-buffer-local 'allout-after-save-decrypt) |
1079 |
|
;;;_ > allout-write-file-hook-handler () |
1080 |
|
(defun allout-write-file-hook-handler () |
1081 |
|
"Implement `allout-encrypt-unencrypted-on-saves' policy for file writes." |
1082 |
|
|
1083 |
|
(if (or (not (boundp 'allout-encrypt-unencrypted-on-saves)) |
1084 |
|
(not allout-encrypt-unencrypted-on-saves)) |
1085 |
|
nil |
1086 |
|
(let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves |
1087 |
|
'except-current) |
1088 |
|
(point-marker)))) |
1089 |
|
(if (save-excursion (goto-char (point-min)) |
1090 |
|
(allout-next-topic-pending-encryption except-mark)) |
1091 |
|
(progn |
1092 |
|
(message "auto-encrypting pending topics") |
1093 |
|
(sit-for 2) |
1094 |
|
(condition-case failure |
1095 |
|
(setq allout-after-save-decrypt |
1096 |
|
(allout-encrypt-decrypted except-mark)) |
1097 |
|
(error (progn |
1098 |
|
(message |
1099 |
|
"allout-write-file-hook-handler suppressing error %s" |
1100 |
|
failure) |
1101 |
|
(sit-for 2)))))) |
1102 |
|
)) |
1103 |
|
nil) |
1104 |
|
;;;_ > allout-auto-save-hook-handler () |
1105 |
|
(defun allout-auto-save-hook-handler () |
1106 |
|
"Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves." |
1107 |
|
|
1108 |
|
(if allout-encrypt-unencrypted-on-saves |
1109 |
|
;; Always implement 'except-current policy when enabled. |
1110 |
|
(let ((allout-encrypt-unencrypted-on-saves 'except-current)) |
1111 |
|
(allout-write-file-hook-handler)))) |
1112 |
|
;;;_ > allout-after-saves-handler () |
1113 |
|
(defun allout-after-saves-handler () |
1114 |
|
"Decrypt topic encrypted for save, if it's currently being edited. |
1115 |
|
|
1116 |
|
Ie, if it was pending encryption and contained the point in its body before |
1117 |
|
the save. |
1118 |
|
|
1119 |
|
We use values stored in `allout-after-save-decrypt' to locate the topic |
1120 |
|
and the place for the cursor after the decryption is done." |
1121 |
|
(if (not (and (allout-mode-p) |
1122 |
|
(boundp 'allout-after-save-decrypt) |
1123 |
|
allout-after-save-decrypt)) |
1124 |
|
t |
1125 |
|
(goto-char (car allout-after-save-decrypt)) |
1126 |
|
(let ((was-modified (buffer-modified-p))) |
1127 |
|
(allout-toggle-current-subtree-encryption) |
1128 |
|
(if (not was-modified) |
1129 |
|
(set-buffer-modified-p nil))) |
1130 |
|
(goto-char (cadr allout-after-save-decrypt)) |
1131 |
|
(setq allout-after-save-decrypt nil)) |
1132 |
|
) |
1133 |
|
|
1134 |
;;;_ #2 Mode activation |
;;;_ #2 Mode activation |
1135 |
;;;_ = allout-mode |
;;;_ = allout-mode |
1141 |
'allout-mode) |
'allout-mode) |
1142 |
;;;_ = allout-explicitly-deactivated |
;;;_ = allout-explicitly-deactivated |
1143 |
(defvar allout-explicitly-deactivated nil |
(defvar allout-explicitly-deactivated nil |
1144 |
"Non-nil if `allout-mode' was last deliberately deactivated. |
"If t, `allout-mode's last deactivation was deliberate. |
1145 |
So `allout-post-command-business' should not reactivate it...") |
So `allout-post-command-business' should not reactivate it...") |
1146 |
(make-variable-buffer-local 'allout-explicitly-deactivated) |
(make-variable-buffer-local 'allout-explicitly-deactivated) |
1147 |
;;;_ > allout-init (&optional mode) |
;;;_ > allout-init (&optional mode) |
|
;;;###autoload |
|
1148 |
(defun allout-init (&optional mode) |
(defun allout-init (&optional mode) |
1149 |
"Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'. |
"Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'. |
1150 |
|
|
1163 |
the `allout-layout' variable. (See `allout-layout' and |
the `allout-layout' variable. (See `allout-layout' and |
1164 |
`allout-expose-topic' docstrings for more details on auto layout). |
`allout-expose-topic' docstrings for more details on auto layout). |
1165 |
|
|
1166 |
`allout-init' works by setting up (or removing) |
`allout-init' works by setting up (or removing) the `allout-mode' |
1167 |
`allout-find-file-hook' in `find-file-hook', and giving |
find-file-hook, and giving `allout-auto-activation' a suitable |
1168 |
`allout-auto-activation' a suitable setting. |
setting. |
1169 |
|
|
1170 |
To prime your Emacs session for full auto-outline operation, include |
To prime your Emacs session for full auto-outline operation, include |
1171 |
the following two lines in your Emacs init file: |
the following two lines in your Emacs init file: |
1173 |
\(require 'allout) |
\(require 'allout) |
1174 |
\(allout-init t)" |
\(allout-init t)" |
1175 |
|
|
1176 |
(interactive |
(interactive) |
1177 |
(let ((m (completing-read |
(if (interactive-p) |
1178 |
(concat "Select outline auto setup mode " |
(progn |
1179 |
"(empty for report, ? for options) ") |
(setq mode |
1180 |
'(("nil")("full")("activate")("deactivate") |
(completing-read |
1181 |
("ask") ("report") ("")) |
(concat "Select outline auto setup mode " |
1182 |
nil |
"(empty for report, ? for options) ") |
1183 |
t))) |
'(("nil")("full")("activate")("deactivate") |
1184 |
(if (string= m "") 'report |
("ask") ("report") ("")) |
1185 |
(intern-soft m)))) |
nil |
1186 |
|
t)) |
1187 |
|
(if (string= mode "") |
1188 |
|
(setq mode 'report) |
1189 |
|
(setq mode (intern-soft mode))))) |
1190 |
(let |
(let |
1191 |
;; convenience aliases, for consistent ref to respective vars: |
;; convenience aliases, for consistent ref to respective vars: |
1192 |
((hook 'allout-find-file-hook) |
((hook 'allout-find-file-hook) |
1193 |
(curr-mode 'allout-auto-activation)) |
(curr-mode 'allout-auto-activation)) |
1194 |
|
|
1195 |
(cond ((not mode) |
(cond ((not mode) |
1196 |
(setq find-file-hook (delq hook find-file-hook)) |
(setq find-file-hooks (delq hook find-file-hooks)) |
1197 |
(if (interactive-p) |
(if (interactive-p) |
1198 |
(message "Allout outline mode auto-activation inhibited."))) |
(message "Allout outline mode auto-activation inhibited."))) |
1199 |
((eq mode 'report) |
((eq mode 'report) |
1200 |
(if (memq hook find-file-hook) |
(if (not (memq hook find-file-hooks)) |
1201 |
;; Just punt and use the reports from each of the modes: |
(allout-init nil) |
1202 |
(allout-init (symbol-value curr-mode)) |
;; Just punt and use the reports from each of the modes: |
1203 |
(allout-init nil) |
(allout-init (symbol-value curr-mode)))) |
1204 |
(message "Allout outline mode auto-activation inhibited."))) |
(t (add-hook 'find-file-hooks hook) |
|
(t (add-hook 'find-file-hook hook) |
|
1205 |
(set curr-mode ; `set', not `setq'! |
(set curr-mode ; `set', not `setq'! |
1206 |
(cond ((eq mode 'activate) |
(cond ((eq mode 'activate) |
1207 |
(message |
(message |
1249 |
|
|
1250 |
In addition to outline navigation and exposure, allout includes: |
In addition to outline navigation and exposure, allout includes: |
1251 |
|
|
1252 |
- topic-oriented repositioning, cut, and paste |
- topic-oriented repositioning, promotion/demotion, cut, and paste |
1253 |
- integral outline exposure-layout |
- integral outline exposure-layout |
1254 |
- incremental search with dynamic exposure and reconcealment of hidden text |
- incremental search with dynamic exposure and reconcealment of hidden text |
1255 |
- automatic topic-number maintenance |
- automatic topic-number maintenance |
1256 |
|
- easy topic encryption and decryption |
1257 |
- \"Hot-spot\" operation, for single-keystroke maneuvering and |
- \"Hot-spot\" operation, for single-keystroke maneuvering and |
1258 |
exposure control. \(See the allout-mode docstring.) |
exposure control. \(See the allout-mode docstring.) |
1259 |
|
|
1263 |
special `allout-mode' features and terminology. See also the outline |
special `allout-mode' features and terminology. See also the outline |
1264 |
menubar additions for quick reference to many of the features, and see |
menubar additions for quick reference to many of the features, and see |
1265 |
the docstring of the function `allout-init' for instructions on |
the docstring of the function `allout-init' for instructions on |
1266 |
priming your Emacs session for automatic activation of `allout-mode'. |
priming your emacs session for automatic activation of `allout-mode'. |
1267 |
|
|
1268 |
|
|
1269 |
The bindings are dictated by the `allout-keybindings-list' and |
The bindings are dictated by the `allout-keybindings-list' and |
1276 |
C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree |
C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree |
1277 |
C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry |
C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry |
1278 |
C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all |
C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all |
1279 |
C-c C-e allout-end-of-current-entry | allout-hide-current-leaves |
C-c C-e allout-end-of-entry | allout-hide-current-leaves |
1280 |
C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot |
C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot |
1281 |
|
|
1282 |
Topic Header Production: |
Topic Header Production: |
1292 |
C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring |
C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring |
1293 |
- distinctive bullets are not changed, others |
- distinctive bullets are not changed, others |
1294 |
alternated according to nesting depth. |
alternated according to nesting depth. |
1295 |
C-c * allout-rebullet-current-heading Prompt for alternate bullet for |
C-c b allout-rebullet-current-heading Prompt for alternate bullet for |
1296 |
current topic. |
current topic. |
1297 |
C-c # allout-number-siblings Number bullets of topic and siblings - the |
C-c # allout-number-siblings Number bullets of topic and siblings - the |
1298 |
offspring are not affected. With repeat |
offspring are not affected. With repeat |
1315 |
C-c C-SPC allout-mark-topic |
C-c C-SPC allout-mark-topic |
1316 |
C-c = c allout-copy-exposed-to-buffer |
C-c = c allout-copy-exposed-to-buffer |
1317 |
Duplicate outline, sans concealed text, to |
Duplicate outline, sans concealed text, to |
1318 |
buffer with name derived from derived from |
buffer with name derived from derived from that |
1319 |
that of current buffer - \"*XXX exposed*\". |
of current buffer - \"*BUFFERNAME exposed*\". |
1320 |
C-c = p allout-flatten-exposed-to-buffer |
C-c = p allout-flatten-exposed-to-buffer |
1321 |
Like above 'copy-exposed', but convert topic |
Like above 'copy-exposed', but convert topic |
1322 |
prefixes to section.subsection... numeric |
prefixes to section.subsection... numeric |
1324 |
ESC ESC (allout-init t) Setup Emacs session for outline mode |
ESC ESC (allout-init t) Setup Emacs session for outline mode |
1325 |
auto-activation. |
auto-activation. |
1326 |
|
|
1327 |
|
Encrypted Entries |
1328 |
|
|
1329 |
|
Outline mode supports easily togglable gpg encryption of topics, with |
1330 |
|
niceities like support for symmetric and key-pair modes, key timeout, key |
1331 |
|
consistency checking, user-provided hinting for symmetric key mode, and |
1332 |
|
auto-encryption of topics pending encryption on save. The aim is to enable |
1333 |
|
reliable topic privacy while preventing accidents like neglected |
1334 |
|
encryption, encryption with a mistaken key, forgetting which key was used, |
1335 |
|
and other practical pitfalls. |
1336 |
|
|
1337 |
|
See the `allout-toggle-current-subtree-encryption' function and |
1338 |
|
`allout-encrypt-unencrypted-on-saves' customization variable for details. |
1339 |
|
|
1340 |
HOT-SPOT Operation |
HOT-SPOT Operation |
1341 |
|
|
1342 |
Hot-spot operation provides a means for easy, single-keystroke outline |
Hot-spot operation provides a means for easy, single-keystroke outline |
1389 |
|
|
1390 |
HEADER: The first line of a topic, include the topic PREFIX and header |
HEADER: The first line of a topic, include the topic PREFIX and header |
1391 |
text. |
text. |
1392 |
PREFIX: The leading text of a topic which distinguishes it from |
PREFIX: The leading text of a topic which distinguishes it from normal |
1393 |
normal text. It has a strict form, which consists of a |
text. It has a strict form, which consists of a prefix-lead |
1394 |
prefix-lead string, padding, and a bullet. The bullet may be |
string, padding, and a bullet. The bullet may be followed by a |
1395 |
followed by a number, indicating the ordinal number of the |
number, indicating the ordinal number of the topic among its |
1396 |
topic among its siblings, a space, and then the header text. |
siblings, a space, and then the header text. |
1397 |
|
|
1398 |
The relative length of the PREFIX determines the nesting depth |
The relative length of the PREFIX determines the nesting depth |
1399 |
of the topic. |
of the topic. |
1464 |
;; off on second invocation, so we detect it as best we can, and |
;; off on second invocation, so we detect it as best we can, and |
1465 |
;; skip everything. |
;; skip everything. |
1466 |
((and same-complex-command ; Still in same complex command |
((and same-complex-command ; Still in same complex command |
1467 |
; as last time `allout-mode' invoked. |
; as last time `allout-mode' invoked. |
1468 |
active ; Already activated. |
active ; Already activated. |
1469 |
(not explicit-activation) ; Prop-line file-vars don't have args. |
(not explicit-activation) ; Prop-line file-vars don't have args. |
1470 |
(string-match "^19.1[89]" ; Bug only known to be in v19.18 and |
(string-match "^19.1[89]" ; Bug only known to be in v19.18 and |
1479 |
; active state or *de*activation |
; active state or *de*activation |
1480 |
; specifically requested: |
; specifically requested: |
1481 |
(setq allout-explicitly-deactivated t) |
(setq allout-explicitly-deactivated t) |
1482 |
|
(if (string-match "^18\." emacs-version) |
1483 |
|
; Revoke those keys that remain |
1484 |
|
; as we set them: |
1485 |
|
(let ((curr-loc (current-local-map))) |
1486 |
|
(mapcar (function |
1487 |
|
(lambda (cell) |
1488 |
|
(if (eq (lookup-key curr-loc (car cell)) |
1489 |
|
(car (cdr cell))) |
1490 |
|
(define-key curr-loc (car cell) |
1491 |
|
(assq (car cell) allout-prior-bindings))))) |
1492 |
|
allout-added-bindings) |
1493 |
|
(allout-resumptions 'allout-added-bindings) |
1494 |
|
(allout-resumptions 'allout-prior-bindings))) |
1495 |
|
|
1496 |
(if allout-old-style-prefixes |
(if allout-old-style-prefixes |
1497 |
(progn |
(progn |
1500 |
(allout-resumptions 'selective-display) |
(allout-resumptions 'selective-display) |
1501 |
(if (and (boundp 'before-change-functions) before-change-functions) |
(if (and (boundp 'before-change-functions) before-change-functions) |
1502 |
(allout-resumptions 'before-change-functions)) |
(allout-resumptions 'before-change-functions)) |
1503 |
(setq write-contents-functions |
(setq local-write-file-hooks |
1504 |
(delq 'allout-write-file-hook |
(delq 'allout-write-file-hook-handler |
1505 |
write-contents-functions)) |
local-write-file-hooks)) |
1506 |
|
(setq auto-save-hook |
1507 |
|
(delq 'allout-auto-save-hook-handler |
1508 |
|
auto-save-hook)) |
1509 |
(allout-resumptions 'paragraph-start) |
(allout-resumptions 'paragraph-start) |
1510 |
(allout-resumptions 'paragraph-separate) |
(allout-resumptions 'paragraph-separate) |
1511 |
(allout-resumptions (if (string-match "^18" emacs-version) |
(allout-resumptions (if (string-match "^18" emacs-version) |
1545 |
(cons '(allout-mode . allout-mode-map) |
(cons '(allout-mode . allout-mode-map) |
1546 |
minor-mode-map-alist)))) |
minor-mode-map-alist)))) |
1547 |
|
|
1548 |
|
; V18 minor-mode key bindings: |
1549 |
|
; Stash record of added bindings |
1550 |
|
; for later revocation: |
1551 |
|
(allout-resumptions 'allout-added-bindings |
1552 |
|
(list allout-keybindings-list)) |
1553 |
|
(allout-resumptions 'allout-prior-bindings |
1554 |
|
(list (current-local-map))) |
1555 |
; and add them: |
; and add them: |
1556 |
(use-local-map (produce-allout-mode-map allout-keybindings-list |
(use-local-map (produce-allout-mode-map allout-keybindings-list |
1557 |
(current-local-map))) |
(current-local-map))) |
1558 |
) |
) |
1559 |
|
|
1560 |
; selective-display is the |
; selective-display is the |
1561 |
; Emacs conditional exposure |
; emacs conditional exposure |
1562 |
; mechanism: |
; mechanism: |
1563 |
(allout-resumptions 'selective-display '(t)) |
(allout-resumptions 'selective-display '(t)) |
|
(if allout-inhibit-protection |
|
|
t |
|
|
(allout-resumptions 'before-change-functions |
|
|
'(allout-before-change-protect))) |
|
1564 |
(add-hook 'pre-command-hook 'allout-pre-command-business) |
(add-hook 'pre-command-hook 'allout-pre-command-business) |
1565 |
(add-hook 'post-command-hook 'allout-post-command-business) |
(add-hook 'post-command-hook 'allout-post-command-business) |
1566 |
; Temporarily set by any outline |
(add-hook 'local-write-file-hooks 'allout-write-file-hook-handler) |
1567 |
; functions that can be trusted to |
(make-variable-buffer-local 'auto-save-hook) |
1568 |
; deal properly with concealed text. |
(add-hook 'auto-save-hook 'allout-auto-save-hook-handler) |
|
(add-hook 'write-contents-functions 'allout-write-file-hook) |
|
1569 |
; Custom auto-fill func, to support |
; Custom auto-fill func, to support |
1570 |
; respect for topic headline, |
; respect for topic headline, |
1571 |
; hanging-indents, etc: |
; hanging-indents, etc: |
1596 |
(if allout-layout |
(if allout-layout |
1597 |
(setq do-layout t)) |
(setq do-layout t)) |
1598 |
|
|
1599 |
(if allout-isearch-dynamic-expose |
(if (and allout-isearch-dynamic-expose |
1600 |
|
(not (fboundp 'allout-real-isearch-abort))) |
1601 |
(allout-enwrap-isearch)) |
(allout-enwrap-isearch)) |
1602 |
|
|
1603 |
(run-hooks 'allout-mode-hook) |
(run-hooks 'allout-mode-hook) |
1636 |
) ; let* |
) ; let* |
1637 |
) ; defun |
) ; defun |
1638 |
;;;_ > allout-minor-mode |
;;;_ > allout-minor-mode |
|
;;; XXX released verion doesn't do this? |
|
1639 |
(defalias 'allout-minor-mode 'allout-mode) |
(defalias 'allout-minor-mode 'allout-mode) |
1640 |
|
|
1641 |
;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs |
;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs |
1659 |
"Buffer point last returned by `allout-end-of-current-subtree'.") |
"Buffer point last returned by `allout-end-of-current-subtree'.") |
1660 |
(make-variable-buffer-local 'allout-recent-end-of-subtree) |
(make-variable-buffer-local 'allout-recent-end-of-subtree) |
1661 |
;;;_ > allout-prefix-data (beg end) |
;;;_ > allout-prefix-data (beg end) |
1662 |
(defmacro allout-prefix-data (beginning end) |
(defmacro allout-prefix-data (beg end) |
1663 |
"Register allout-prefix state data - BEGINNING and END of prefix. |
"Register allout-prefix state data - BEGINNING and END of prefix. |
1664 |
|
|
1665 |
For reference by `allout-recent' funcs. Returns BEGINNING." |
For reference by `allout-recent' funcs. Returns BEGINNING." |
1666 |
`(setq allout-recent-prefix-end ,end |
`(setq allout-recent-prefix-end ,end |
1667 |
allout-recent-prefix-beginning ,beginning)) |
allout-recent-prefix-beginning ,beg)) |
1668 |
;;;_ > allout-recent-depth () |
;;;_ > allout-recent-depth () |
1669 |
(defmacro allout-recent-depth () |
(defmacro allout-recent-depth () |
1670 |
"Return depth of last heading encountered by an outline maneuvering function. |
"Return depth of last heading encountered by an outline maneuvering function. |
1871 |
"Produce a location \"chart\" of subtopics of the containing topic. |
"Produce a location \"chart\" of subtopics of the containing topic. |
1872 |
|
|
1873 |
Optional argument LEVELS specifies the depth \(relative to start |
Optional argument LEVELS specifies the depth \(relative to start |
1874 |
depth) for the chart. |
depth) for the chart. Subsequent optional args are not for public |
1875 |
|
use. |
1876 |
|
|
1877 |
|
Point is left at the end of the subtree. |
1878 |
|
|
1879 |
Charts are used to capture outline structure, so that outline altering |
Charts are used to capture outline structure, so that outline-altering |
1880 |
routines need assess the structure only once, and then use the chart |
routines need assess the structure only once, and then use the chart |
1881 |
for their elaborate manipulations. |
for their elaborate manipulations. |
1882 |
|
|
1887 |
The chart for a topics' offspring precedes the entry for the topic |
The chart for a topics' offspring precedes the entry for the topic |
1888 |
itself. |
itself. |
1889 |
|
|
1890 |
\(fn &optional LEVELS)" |
The other function parameters are for internal recursion, and should |
1891 |
|
not be specified by external callers. ORIG-DEPTH is depth of topic at |
1892 |
;; The other function parameters are for internal recursion, and should |
starting point, and PREV-DEPTH is depth of prior topic." |
|
;; not be specified by external callers. ORIG-DEPTH is depth of topic at |
|
|
;; starting point, and PREV-DEPTH is depth of prior topic." |
|
1893 |
|
|
1894 |
(let ((original (not orig-depth)) ; `orig-depth' set only in recursion. |
(let ((original (not orig-depth)) ; `orig-depth' set only in recursion. |
1895 |
chart curr-depth) |
chart curr-depth) |
2095 |
(if (re-search-forward allout-line-boundary-regexp nil 'move) |
(if (re-search-forward allout-line-boundary-regexp nil 'move) |
2096 |
(prog1 (goto-char (match-beginning 0)) |
(prog1 (goto-char (match-beginning 0)) |
2097 |
(allout-prefix-data (match-beginning 2)(match-end 2))))) |
(allout-prefix-data (match-beginning 2)(match-end 2))))) |
2098 |
;;;_ > allout-end-of-current-subtree () |
;;;_ > allout-end-of-subtree (&optional current) |
2099 |
(defun allout-end-of-current-subtree () |
(defun allout-end-of-subtree (&optional current) |
2100 |
"Put point at the end of the last leaf in the currently visible topic." |
"Put point at the end of the last leaf in the containing topic. |
2101 |
(interactive) |
|
2102 |
(allout-back-to-current-heading) |
If optional CURRENT is true (default false), then put point at the end of |
2103 |
|
the containing visible topic. |
2104 |
|
|
2105 |
|
Returns the value of point." |
2106 |
|
(interactive "P") |
2107 |
|
(if current |
2108 |
|
(allout-back-to-current-heading) |
2109 |
|
(allout-goto-prefix)) |
2110 |
(let ((level (allout-recent-depth))) |
(let ((level (allout-recent-depth))) |
2111 |
(allout-next-heading) |
(allout-next-heading) |
2112 |
(while (and (not (eobp)) |
(while (and (not (eobp)) |
2118 |
'(?\n ?\r)) |
'(?\n ?\r)) |
2119 |
(forward-char -1)) |
(forward-char -1)) |
2120 |
(setq allout-recent-end-of-subtree (point)))) |
(setq allout-recent-end-of-subtree (point)))) |
2121 |
|
;;;_ > allout-end-of-current-subtree () |
2122 |
|
(defun allout-end-of-current-subtree () |
2123 |
|
"Put point at end of last leaf in currently visible containing topic. |
2124 |
|
|
2125 |
|
Returns the value of point." |
2126 |
|
(interactive) |
2127 |
|
(allout-end-of-subtree t)) |
2128 |
;;;_ > allout-beginning-of-current-entry () |
;;;_ > allout-beginning-of-current-entry () |
2129 |
(defun allout-beginning-of-current-entry () |
(defun allout-beginning-of-current-entry () |
2130 |
"When not already there, position point at beginning of current topic's body. |
"When not already there, position point at beginning of current topic header. |
2131 |
|
|
2132 |
If already there, move cursor to bullet for hot-spot operation. |
If already there, move cursor to bullet for hot-spot operation. |
2133 |
\(See `allout-mode' doc string for details on hot-spot operation.)" |
\(See `allout-mode' doc string for details on hot-spot operation.)" |
2137 |
(if (and (interactive-p) |
(if (and (interactive-p) |
2138 |
(= (point) start-point)) |
(= (point) start-point)) |
2139 |
(goto-char (allout-current-bullet-pos))))) |
(goto-char (allout-current-bullet-pos))))) |
2140 |
;;;_ > allout-end-of-current-entry () |
;;;_ > allout-end-of-entry () |
2141 |
(defun allout-end-of-current-entry () |
(defun allout-end-of-entry () |
2142 |
"Position the point at the end of the current topics' entry." |
"Position the point at the end of the current topics' entry." |
2143 |
(interactive) |
(interactive) |
|
(allout-show-entry) |
|
2144 |
(prog1 (allout-pre-next-preface) |
(prog1 (allout-pre-next-preface) |
2145 |
(if (and (not (bobp))(looking-at "^$")) |
(if (and (not (bobp))(looking-at "^$")) |
2146 |
(forward-char -1)))) |
(forward-char -1)))) |
2148 |
(defun allout-end-of-current-heading () |
(defun allout-end-of-current-heading () |
2149 |
(interactive) |
(interactive) |
2150 |
(allout-beginning-of-current-entry) |
(allout-beginning-of-current-entry) |
2151 |
(forward-line -1) |
(re-search-forward "[\n\r]" nil t) |
2152 |
(end-of-line)) |
(forward-char -1)) |
2153 |
(defalias 'allout-end-of-heading 'allout-end-of-current-heading) |
(defalias 'allout-end-of-heading 'allout-end-of-current-heading) |
2154 |
|
;;;_ > allout-get-body-text () |
2155 |
|
(defun allout-get-body-text () |
2156 |
|
"Return the unmangled body text of the topic immediately containing point." |
2157 |
|
(save-excursion |
2158 |
|
(allout-end-of-prefix) |
2159 |
|
(if (not (re-search-forward "[\n\r]" nil t)) |
2160 |
|
nil |
2161 |
|
(backward-char 1) |
2162 |
|
(let ((pre-body (point))) |
2163 |
|
(if (not pre-body) |
2164 |
|
nil |
2165 |
|
(allout-end-of-entry) |
2166 |
|
(if (not (= pre-body (point))) |
2167 |
|
(buffer-substring-no-properties (1+ pre-body) (point)))) |
2168 |
|
) |
2169 |
|
) |
2170 |
|
) |
2171 |
|
) |
2172 |
|
|
2173 |
;;;_ - Depth-wise |
;;;_ - Depth-wise |
2174 |
;;;_ > allout-ascend-to-depth (depth) |
;;;_ > allout-ascend-to-depth (depth) |
2183 |
(if (= (allout-recent-depth) depth) |
(if (= (allout-recent-depth) depth) |
2184 |
(progn (goto-char allout-recent-prefix-beginning) |
(progn (goto-char allout-recent-prefix-beginning) |
2185 |
depth) |
depth) |
2186 |
(goto-char last-good))))) |
(goto-char last-good) |
2187 |
|
nil)) |
2188 |
|
(if (interactive-p) (allout-end-of-prefix)))) |
2189 |
;;;_ > allout-ascend () |
;;;_ > allout-ascend () |
2190 |
(defun allout-ascend () |
(defun allout-ascend () |
2191 |
"Ascend one level, returning t if successful, nil if not." |
"Ascend one level, returning t if successful, nil if not." |
2192 |
(if (allout-beginning-of-level) |
(prog1 |
2193 |
(allout-previous-heading))) |
(if (allout-beginning-of-level) |
2194 |
|
(allout-previous-heading)) |
2195 |
|
(if (interactive-p) (allout-end-of-prefix)))) |
2196 |
;;;_ > allout-descend-to-depth (depth) |
;;;_ > allout-descend-to-depth (depth) |
2197 |
(defun allout-descend-to-depth (depth) |
(defun allout-descend-to-depth (depth) |
2198 |
"Descend to depth DEPTH within current topic. |
"Descend to depth DEPTH within current topic. |
2212 |
nil)) |
nil)) |
2213 |
) |
) |
2214 |
;;;_ > allout-up-current-level (arg &optional dont-complain) |
;;;_ > allout-up-current-level (arg &optional dont-complain) |
2215 |
(defun allout-up-current-level (arg &optional dont-complain interactive) |
(defun allout-up-current-level (arg &optional dont-complain) |
2216 |
"Move out ARG levels from current visible topic. |
"Move out ARG levels from current visible topic. |
2217 |
|
|
2218 |
Positions on heading line of containing topic. Error if unable to |
Positions on heading line of containing topic. Error if unable to |
2219 |
ascend that far, or nil if unable to ascend but optional arg |
ascend that far, or nil if unable to ascend but optional arg |
2220 |
DONT-COMPLAIN is non-nil." |
DONT-COMPLAIN is non-nil." |
2221 |
(interactive "p\np") |
(interactive "p") |
2222 |
(allout-back-to-current-heading) |
(allout-back-to-current-heading) |
2223 |
(let ((present-level (allout-recent-depth)) |
(let ((present-level (allout-recent-depth)) |
2224 |
(last-good (point)) |
(last-good (point)) |
2239 |
(if (or failed |
(if (or failed |
2240 |
(> arg 0)) |
(> arg 0)) |
2241 |
(progn (goto-char last-good) |
(progn (goto-char last-good) |
2242 |
(if interactive (allout-end-of-prefix)) |
(if (interactive-p) (allout-end-of-prefix)) |
2243 |
(if (not dont-complain) |
(if (not dont-complain) |
2244 |
(error "Can't ascend past outermost level") |
(error "Can't ascend past outermost level") |
2245 |
(if interactive (allout-end-of-prefix)) |
(if (interactive-p) (allout-end-of-prefix)) |
2246 |
nil)) |
nil)) |
2247 |
(if interactive (allout-end-of-prefix)) |
(if (interactive-p) (allout-end-of-prefix)) |
2248 |
allout-recent-prefix-beginning))) |
allout-recent-prefix-beginning))) |
2249 |
|
|
2250 |
;;;_ - Linear |
;;;_ - Linear |
2276 |
nil)))) |
nil)))) |
2277 |
;;;_ > allout-previous-sibling (&optional depth backward) |
;;;_ > allout-previous-sibling (&optional depth backward) |
2278 |
(defun allout-previous-sibling (&optional depth backward) |
(defun allout-previous-sibling (&optional depth backward) |
2279 |
"Like `allout-forward-current-level', but backwards & respect invisible topics. |
"Like `allout-forward-current-level' backwards, respecting invisible topics. |
2280 |
|
|
2281 |
Optional DEPTH specifies depth to traverse, default current depth. |
Optional DEPTH specifies depth to traverse, default current depth. |
2282 |
|
|
2310 |
(let ((depth (allout-depth))) |
(let ((depth (allout-depth))) |
2311 |
(while (allout-previous-sibling depth nil)) |
(while (allout-previous-sibling depth nil)) |
2312 |
(prog1 (allout-recent-depth) |
(prog1 (allout-recent-depth) |
2313 |
(allout-end-of-prefix)))) |
(if (interactive-p) (allout-end-of-prefix))))) |
2314 |
;;;_ > allout-next-visible-heading (arg) |
;;;_ > allout-next-visible-heading (arg) |
2315 |
(defun allout-next-visible-heading (arg) |
(defun allout-next-visible-heading (arg) |
2316 |
"Move to the next ARG'th visible heading line, backward if arg is negative. |
"Move to the next ARG'th visible heading line, backward if arg is negative. |
2348 |
(interactive "p") |
(interactive "p") |
2349 |
(allout-next-visible-heading (- arg))) |
(allout-next-visible-heading (- arg))) |
2350 |
;;;_ > allout-forward-current-level (arg) |
;;;_ > allout-forward-current-level (arg) |
2351 |
(defun allout-forward-current-level (arg &optional interactive) |
(defun allout-forward-current-level (arg) |
2352 |
"Position point at the next heading of the same level. |
"Position point at the next heading of the same level. |
2353 |
|
|
2354 |
Takes optional repeat-count, goes backward if count is negative. |
Takes optional repeat-count, goes backward if count is negative. |
2355 |
|
|
2356 |
Returns resulting position, else nil if none found." |
Returns resulting position, else nil if none found." |
2357 |
(interactive "p\np") |
(interactive "p") |
2358 |
(let ((start-depth (allout-current-depth)) |
(let ((start-depth (allout-current-depth)) |
2359 |
(start-point (point)) |
(start-point (point)) |
2360 |
(start-arg arg) |
(start-arg arg) |
2382 |
(= (allout-recent-depth) start-depth))) |
(= (allout-recent-depth) start-depth))) |
2383 |
allout-recent-prefix-beginning |
allout-recent-prefix-beginning |
2384 |
(goto-char last-good) |
(goto-char last-good) |
2385 |
(if (not interactive) |
(if (not (interactive-p)) |
2386 |
nil |
nil |
2387 |
(allout-end-of-prefix) |
(allout-end-of-prefix) |
2388 |
(error "Hit %s level %d topic, traversed %d of %d requested" |
(error "Hit %s level %d topic, traversed %d of %d requested" |
2391 |
(- (abs start-arg) arg) |
(- (abs start-arg) arg) |
2392 |
(abs start-arg)))))) |
(abs start-arg)))))) |
2393 |
;;;_ > allout-backward-current-level (arg) |
;;;_ > allout-backward-current-level (arg) |
2394 |
(defun allout-backward-current-level (arg &optional interactive) |
(defun allout-backward-current-level (arg) |
2395 |
"Inverse of `allout-forward-current-level'." |
"Inverse of `allout-forward-current-level'." |
2396 |
(interactive "p\np") |
(interactive "p") |
2397 |
(if interactive |
(if (interactive-p) |
2398 |
(let ((current-prefix-arg (* -1 arg))) |
(let ((current-prefix-arg (* -1 arg))) |
2399 |
(call-interactively 'allout-forward-current-level)) |
(call-interactively 'allout-forward-current-level)) |
2400 |
(allout-forward-current-level (* -1 arg)))) |
(allout-forward-current-level (* -1 arg)))) |
2402 |
;;;_ #5 Alteration |
;;;_ #5 Alteration |
2403 |
|
|
2404 |
;;;_ - Fundamental |
;;;_ - Fundamental |
|
;;;_ > allout-before-change-protect (beg end) |
|
|
(defun allout-before-change-protect (beg end) |
|
|
"Outline before-change hook, regulates changes to concealed text. |
|
|
|
|
|
Reveal concealed text that would be changed by current command, and |
|
|
offer user choice to commit or forego the change. Unchanged text is |
|
|
reconcealed. User has option to have changed text reconcealed. |
|
|
|
|
|
Undo commands are specially treated - the user is not prompted for |
|
|
choice, the undoes are always committed (based on presumption that the |
|
|
things being undone were already subject to this regulation routine), |
|
|
and undoes always leave the changed stuff exposed. |
|
|
|
|
|
Changes to concealed regions are ignored while file is being written. |
|
|
\(This is for the sake of functions that do change the file during |
|
|
writes, like crypt and zip modes.) |
|
|
|
|
|
Locally bound in outline buffers to `before-change-functions', which |
|
|
in Emacs 19 is run before any change to the buffer. |
|
|
|
|
|
Any functions which set [`this-command' to `undo', or which set] |
|
|
`allout-override-protect' non-nil (as does, eg, allout-flag-chars) |
|
|
are exempt from this restriction." |
|
|
(if (and (allout-mode-p) |
|
|
; allout-override-protect |
|
|
; set by functions that know what |
|
|
; they're doing, eg outline internals: |
|
|
(not allout-override-protect) |
|
|
(not allout-during-write-cue) |
|
|
(save-match-data ; Preserve operation position state. |
|
|
; Both beginning and end chars must |
|
|
; be exposed: |
|
|
(save-excursion (if (memq this-command '(newline open-line)) |
|
|
;; Compensate for stupid Emacs {new, |
|
|
;; open-}line display optimization: |
|
|
(setq beg (1+ beg) |
|
|
end (1+ end))) |
|
|
(goto-char beg) |
|
|
(or (allout-hidden-p) |
|
|
(and (not (= beg end)) |
|
|
(goto-char end) |
|
|
(allout-hidden-p)))))) |
|
|
(save-match-data |
|
|
(if (equal this-command 'undo) |
|
|
;; Allow undo without inhibition. |
|
|
;; - Undoing new and open-line hits stupid Emacs redisplay |
|
|
;; optimization (em 19 cmds.c, ~ line 200). |
|
|
;; - Presumably, undoing what was properly protected when |
|
|
;; done. |
|
|
;; - Undo may be users' only recourse in protection faults. |
|
|
;; So, expose what getting changed: |
|
|
(progn (message "Undo! - exposing concealed target...") |
|
|
(if (allout-hidden-p) |
|
|
(allout-show-children)) |
|
|
(message "Undo!")) |
|
|
(let (response |
|
|
(rehide-completely (save-excursion (allout-goto-prefix) |
|
|
(allout-hidden-p))) |
|
|
rehide-place) |
|
|
|
|
|
(save-excursion |
|
|
(if (condition-case err |
|
|
;; Condition case to catch keyboard quits during reads. |
|
|
(progn |
|
|
; Give them a peek where |
|
|
(save-excursion |
|
|
(if (eolp) (setq rehide-place |
|
|
(allout-goto-prefix))) |
|
|
(allout-show-entry)) |
|
|
; Present the message, but... |
|
|
; leave the cursor at the location |
|
|
; until they respond: |
|
|
; Then interpret the response: |
|
|
(while |
|
|
(progn |
|
|
(message (concat "Change inside concealed" |
|
|
" region - do it? " |
|
|
"(n or 'y'/'r'eclose)")) |
|
|
(setq response (read-char)) |
|
|
(not |
|
|
(cond ((memq response '(?r ?R)) |
|
|
(setq response 'reclose)) |
|
|
((memq response '(?y ?Y ? )) |
|
|
(setq response t)) |
|
|
((memq response '(?n ?N 127)) |
|
|
(setq response nil) |
|
|
t) |
|
|
((eq response ??) |
|
|
(message |
|
|
"`r' means `yes, then reclose'") |
|
|
nil) |
|
|
(t (message "Please answer y, n, or r") |
|
|
(sit-for 1) |
|
|
nil))))) |
|
|
response) |
|
|
('quit nil)) |
|
|
; Continue: |
|
|
(if (eq response 'reclose) |
|
|
(save-excursion |
|
|
(if rehide-place (goto-char rehide-place)) |
|
|
(if rehide-completely |
|
|
(allout-hide-current-entry-completely) |
|
|
(allout-hide-current-entry))) |
|
|
(if (allout-ascend-to-depth (1- (allout-recent-depth))) |
|
|
(allout-show-children) |
|
|
(allout-show-to-offshoot))) |
|
|
; Prevent: |
|
|
(if rehide-completely |
|
|
(save-excursion |
|
|
(if rehide-place (goto-char rehide-place)) |
|
|
(allout-hide-current-entry-completely)) |
|
|
(allout-hide-current-entry)) |
|
|
(error "Change within concealed region prevented")))))) |
|
|
) ; if |
|
|
) ; defun |
|
2405 |
;;;_ = allout-post-goto-bullet |
;;;_ = allout-post-goto-bullet |
2406 |
(defvar allout-post-goto-bullet nil |
(defvar allout-post-goto-bullet nil |
2407 |
"Outline internal var, for `allout-pre-command-business' hot-spot operation. |
"Outline internal var, for `allout-pre-command-business' hot-spot operation. |
2416 |
(defun allout-post-command-business () |
(defun allout-post-command-business () |
2417 |
"Outline `post-command-hook' function. |
"Outline `post-command-hook' function. |
2418 |
|
|
|
- Null `allout-override-protect', so it's not left open. |
|
|
|
|
2419 |
- Implement (and clear) `allout-post-goto-bullet', for hot-spot |
- Implement (and clear) `allout-post-goto-bullet', for hot-spot |
2420 |
outline commands. |
outline commands. |
2421 |
|
|
2422 |
- Massages `buffer-undo-list' so successive, standard character self-inserts |
- Decrypt topic currently being edited if it was encrypted for a save. |
2423 |
are aggregated. This kludge compensates for lack of undo bunching when |
|
2424 |
`before-change-functions' is used." |
- Massage buffer-undo-list so successive, standard character self-inserts are |
2425 |
|
aggregated. This kludge compensates for lack of undo bunching when |
2426 |
|
before-change-functions is used." |
2427 |
|
|
2428 |
; Apply any external change func: |
; Apply any external change func: |
2429 |
(if (not (allout-mode-p)) ; In allout-mode. |
(if (not (allout-mode-p)) ; In allout-mode. |
2430 |
nil |
nil |
|
(setq allout-override-protect nil) |
|
2431 |
(if allout-isearch-dynamic-expose |
(if allout-isearch-dynamic-expose |
2432 |
(allout-isearch-rectification)) |
(allout-isearch-rectification)) |
|
(if allout-during-write-cue |
|
|
;; Was used by allout-before-change-protect, done with it now: |
|
|
(setq allout-during-write-cue nil)) |
|
2433 |
;; Undo bunching business: |
;; Undo bunching business: |
2434 |
(if (and (listp buffer-undo-list) ; Undo history being kept. |
(if (and (listp buffer-undo-list) ; Undo history being kept. |
2435 |
(equal this-command 'self-insert-command) |
(equal this-command 'self-insert-command) |
2458 |
(setq buffer-undo-list |
(setq buffer-undo-list |
2459 |
(cons (cons prev-from cur-to) |
(cons (cons prev-from cur-to) |
2460 |
(cdr (cdr (cdr buffer-undo-list)))))))) |
(cdr (cdr (cdr buffer-undo-list)))))))) |
2461 |
|
|
2462 |
|
(if (and (boundp 'allout-after-save-decrypt) |
2463 |
|
allout-after-save-decrypt) |
2464 |
|
(allout-after-saves-handler)) |
2465 |
|
|
2466 |
;; Implement -post-goto-bullet, if set: (must be after undo business) |
;; Implement -post-goto-bullet, if set: (must be after undo business) |
2467 |
(if (and allout-post-goto-bullet |
(if (and allout-post-goto-bullet |
2468 |
(allout-current-bullet-pos)) |
(allout-current-bullet-pos)) |
2485 |
char. When in this mode you can use regular cursor-positioning |
char. When in this mode you can use regular cursor-positioning |
2486 |
command/keystrokes to relocate the cursor off of a bullet character to |
command/keystrokes to relocate the cursor off of a bullet character to |
2487 |
return to regular interpretation of self-insert characters." |
return to regular interpretation of self-insert characters." |
2488 |
|
|
2489 |
(if (not (allout-mode-p)) |
(if (not (allout-mode-p)) |
2490 |
;; Shouldn't be invoked if not in allout allout-mode, but just in case: |
;; Shouldn't be invoked if not in allout-mode, but just in case: |
2491 |
nil |
nil |
2492 |
;; Register isearch status: |
;; Register isearch status: |
2493 |
(if (and (boundp 'isearch-mode) isearch-mode) |
(if (and (boundp 'isearch-mode) isearch-mode) |
2499 |
(let* ((this-key-num (cond |
(let* ((this-key-num (cond |
2500 |
((numberp last-command-char) |
((numberp last-command-char) |
2501 |
last-command-char) |
last-command-char) |
2502 |
((fboundp 'char-to-int) |
;; Only xemacs has characterp. |
2503 |
|
((and (fboundp 'characterp) |
2504 |
|
(characterp last-command-char)) |
2505 |
(char-to-int last-command-char)) |
(char-to-int last-command-char)) |
2506 |
(t 0))) |
(t 0))) |
2507 |
mapped-binding) |
mapped-binding) |
2524 |
this-command mapped-binding))))))) |
this-command mapped-binding))))))) |
2525 |
;;;_ > allout-find-file-hook () |
;;;_ > allout-find-file-hook () |
2526 |
(defun allout-find-file-hook () |
(defun allout-find-file-hook () |
2527 |
"Activate `allout-mode' when `allout-auto-activation' & `allout-layout' are non-nil. |
"Activate `allout-mode' when `allout-auto-activation', `allout-layout' non-nil. |
2528 |
|
|
2529 |
See `allout-init' for setup instructions." |
See `allout-init' for setup instructions." |
2530 |
(if (and allout-auto-activation |
(if (and allout-auto-activation |
2537 |
|
|
2538 |
Called as part of `allout-post-command-business'." |
Called as part of `allout-post-command-business'." |
2539 |
|
|
2540 |
(let ((isearching isearch-mode)) |
(let ((isearching (and (boundp 'isearch-mode) isearch-mode))) |
2541 |
(cond ((and isearching (not allout-pre-was-isearching)) |
(cond ((and isearching (not allout-pre-was-isearching)) |
2542 |
(allout-isearch-expose 'start)) |
(allout-isearch-expose 'start)) |
2543 |
((and isearching allout-pre-was-isearching) |
((and isearching allout-pre-was-isearching) |
2545 |
((and (not isearching) allout-pre-was-isearching) |
((and (not isearching) allout-pre-was-isearching) |
2546 |
(allout-isearch-expose 'final)) |
(allout-isearch-expose 'final)) |
2547 |
;; Not and wasn't isearching: |
;; Not and wasn't isearching: |
2548 |
(t (setq allout-isearch-prior-pos nil))))) |
(t (setq allout-isearch-prior-pos nil) |
2549 |
|
(setq allout-isearch-did-quit nil))))) |
2550 |
;;;_ = allout-isearch-was-font-lock |
;;;_ = allout-isearch-was-font-lock |
2551 |
(defvar allout-isearch-was-font-lock |
(defvar allout-isearch-was-font-lock |
2552 |
(and (boundp 'font-lock-mode) font-lock-mode)) |
(and (boundp 'font-lock-mode) font-lock-mode)) |
|
|
|
|
;;;_ > allout-flag-region (from to flag) |
|
|
(defmacro allout-flag-region (from to flag) |
|
|
"Hide or show lines from FROM to TO, via Emacs `selective-display' FLAG char. |
|
|
Ie, text following flag C-m \(carriage-return) is hidden until the |
|
|
next C-j (newline) char. |
|
|
|
|
|
Returns the endpoint of the region." |
|
|
`(let ((buffer-read-only nil) |
|
|
(allout-override-protect t)) |
|
|
(subst-char-in-region ,from ,to |
|
|
(if (= ,flag ?\n) ?\r ?\n) |
|
|
,flag t))) |
|
|
|
|
2553 |
;;;_ > allout-isearch-expose (mode) |
;;;_ > allout-isearch-expose (mode) |
2554 |
(defun allout-isearch-expose (mode) |
(defun allout-isearch-expose (mode) |
2555 |
"MODE is either 'clear, 'start, 'continue, or 'final." |
"MODE is either 'clear, 'start, 'continue, or 'final." |
2574 |
(setq allout-isearch-prior-pos nil) |
(setq allout-isearch-prior-pos nil) |
2575 |
(if (not (eq mode 'final)) |
(if (not (eq mode 'final)) |
2576 |
(setq allout-isearch-prior-pos (cons (point) (allout-show-entry))) |
(setq allout-isearch-prior-pos (cons (point) (allout-show-entry))) |
2577 |
(if isearch-mode-end-hook-quit |
(if allout-isearch-did-quit |
2578 |
nil |
nil |
2579 |
(setq allout-isearch-prior-pos nil) |
(setq allout-isearch-prior-pos nil) |
2580 |
(allout-show-children))))) |
(allout-show-children)))) |
2581 |
|
(setq allout-isearch-did-quit nil)) |
2582 |
;;;_ > allout-enwrap-isearch () |
;;;_ > allout-enwrap-isearch () |
2583 |
(defun allout-enwrap-isearch () |
(defun allout-enwrap-isearch () |
2584 |
"Impose `isearch-abort' wrapper for dynamic exposure in isearch. |
"Impose `allout-mode' isearch-abort wrapper for dynamic exposure in isearch. |
2585 |
|
|
2586 |
The function checks to ensure that the rebinding is done only once." |
The function checks to ensure that the rebinding is done only once." |
2587 |
(add-hook 'isearch-mode-end-hook 'allout-isearch-rectification)) |
|
2588 |
|
(add-hook 'isearch-mode-end-hook 'allout-isearch-rectification) |
2589 |
|
(if (fboundp 'allout-real-isearch-abort) |
2590 |
|
;; |
2591 |
|
nil |
2592 |
|
; Ensure load of isearch-mode: |
2593 |
|
(if (or (and (fboundp 'isearch-mode) |
2594 |
|
(fboundp 'isearch-abort)) |
2595 |
|
(condition-case error |
2596 |
|
(load-library "isearch-mode") |
2597 |
|
('file-error (message |
2598 |
|
"Skipping isearch-mode provisions - %s '%s'" |
2599 |
|
(car (cdr error)) |
2600 |
|
(car (cdr (cdr error)))) |
2601 |
|
(sit-for 1) |
2602 |
|
;; Inhibit subsequent tries and return nil: |
2603 |
|
(setq allout-isearch-dynamic-expose nil)))) |
2604 |
|
;; Isearch-mode loaded, encapsulate specific entry points for |
2605 |
|
;; outline dynamic-exposure business: |
2606 |
|
(progn |
2607 |
|
;; stash crucial isearch-mode funcs under known, private |
2608 |
|
;; names, then register wrapper functions under the old |
2609 |
|
;; names, in their stead: |
2610 |
|
(fset 'allout-real-isearch-abort (symbol-function 'isearch-abort)) |
2611 |
|
(fset 'isearch-abort 'allout-isearch-abort))))) |
2612 |
|
;;;_ > allout-isearch-abort () |
2613 |
|
(defun allout-isearch-abort () |
2614 |
|
"Wrapper for allout-real-isearch-abort \(which see), to register |
2615 |
|
actual quits." |
2616 |
|
(interactive) |
2617 |
|
(setq allout-isearch-did-quit nil) |
2618 |
|
(condition-case what |
2619 |
|
(allout-real-isearch-abort) |
2620 |
|
('quit (setq allout-isearch-did-quit t) |
2621 |
|
(signal 'quit nil)))) |
2622 |
|
|
2623 |
;;; Prevent unnecessary font-lock while isearching! |
;;; Prevent unnecessary font-lock while isearching! |
2624 |
(defvar isearch-was-font-locking nil) |
(defvar isearch-was-font-locking nil) |
2625 |
(defun isearch-inhibit-font-lock () |
(defun isearch-inhibit-font-lock () |
2626 |
"Inhibit `font-lock-mode' while isearching - for use on `isearch-mode-hook'." |
"Inhibit `font-lock' while isearching - for use on `isearch-mode-hook'." |
2627 |
(if (and (allout-mode-p) (boundp 'font-lock-mode) font-lock-mode) |
(if (and (allout-mode-p) (boundp 'font-lock-mode) font-lock-mode) |
2628 |
(setq isearch-was-font-locking t |
(setq isearch-was-font-locking t |
2629 |
font-lock-mode nil))) |
font-lock-mode nil))) |
2671 |
(if prefix |
(if prefix |
2672 |
(allout-get-prefix-bullet prefix) |
(allout-get-prefix-bullet prefix) |
2673 |
(allout-get-bullet))))) |
(allout-get-bullet))))) |
2674 |
|
;;;_ > allout-encrypted-type-prefix (&optional prefix) |
2675 |
|
(defun allout-encrypted-type-prefix (&optional prefix) |
2676 |
|
"True if current header prefix bullet is for an encrypted entry \(body)." |
2677 |
|
(and allout-topic-encryption-bullet |
2678 |
|
(string= allout-topic-encryption-bullet |
2679 |
|
(if prefix |
2680 |
|
(allout-get-prefix-bullet prefix) |
2681 |
|
(allout-get-bullet))))) |
2682 |
;;;_ > allout-bullet-for-depth (&optional depth) |
;;;_ > allout-bullet-for-depth (&optional depth) |
2683 |
(defun allout-bullet-for-depth (&optional depth) |
(defun allout-bullet-for-depth (&optional depth) |
2684 |
"Return outline topic bullet suited to optional DEPTH, or current depth." |
"Return outline topic bullet suited to optional DEPTH, or current depth." |
2839 |
((allout-sibling-index)))))) |
((allout-sibling-index)))))) |
2840 |
) |
) |
2841 |
) |
) |
2842 |
;;;_ > allout-open-topic (relative-depth &optional before use-sib-bullet) |
;;;_ > allout-open-topic (relative-depth &optional before use_recent_bullet) |
2843 |
(defun allout-open-topic (relative-depth &optional before use-sib-bullet) |
(defun allout-open-topic (relative-depth &optional before use_recent_bullet) |
2844 |
"Open a new topic at depth RELATIVE-DEPTH. |
"Open a new topic at depth DEPTH. |
2845 |
|
|
2846 |
New topic is situated after current one, unless optional flag BEFORE |
New topic is situated after current one, unless optional flag BEFORE |
2847 |
is non-nil, or unless current line is complete empty (not even |
is non-nil, or unless current line is complete empty (not even |
2848 |
whitespace), in which case open is done on current line. |
whitespace), in which case open is done on current line. |
2849 |
|
|
2850 |
If USE-SIB-BULLET is true, use the bullet of the prior sibling. |
If USE_RECENT_BULLET is true, offer to use the bullet of the prior sibling. |
2851 |
|
|
2852 |
Nuances: |
Nuances: |
2853 |
|
|
2874 |
(let* ((depth (+ (allout-current-depth) relative-depth)) |
(let* ((depth (+ (allout-current-depth) relative-depth)) |
2875 |
(opening-on-blank (if (looking-at "^\$") |
(opening-on-blank (if (looking-at "^\$") |
2876 |
(not (setq before nil)))) |
(not (setq before nil)))) |
2877 |
opening-numbered ; Will get while computing ref-topic, below |
;; bunch o vars set while computing ref-topic |
2878 |
ref-depth ; Will get while computing ref-topic, below |
opening-numbered |
2879 |
ref-bullet ; Will get while computing ref-topic, next |
opening-encrypted |
2880 |
|
ref-depth |
2881 |
|
ref-bullet |
2882 |
(ref-topic (save-excursion |
(ref-topic (save-excursion |
2883 |
(cond ((< relative-depth 0) |
(cond ((< relative-depth 0) |
2884 |
(allout-ascend-to-depth depth)) |
(allout-ascend-to-depth depth)) |
2896 |
(allout-descend-to-depth depth)) |
(allout-descend-to-depth depth)) |
2897 |
(if (allout-numbered-type-prefix) |
(if (allout-numbered-type-prefix) |
2898 |
allout-numbered-bullet)))) |
allout-numbered-bullet)))) |
2899 |
|
(setq opening-encrypted |
2900 |
|
(save-excursion |
2901 |
|
(and allout-topic-encryption-bullet |
2902 |
|
(or (<= relative-depth 0) |
2903 |
|
(allout-descend-to-depth depth)) |
2904 |
|
(if (allout-numbered-type-prefix) |
2905 |
|
allout-numbered-bullet)))) |
2906 |
(point))) |
(point))) |
2907 |
dbl-space |
dbl-space |
2908 |
doing-beginning) |
doing-beginning) |
2941 |
(if (not (bobp)) |
(if (not (bobp)) |
2942 |
(allout-previous-heading))) |
(allout-previous-heading))) |
2943 |
(if (and before (bobp)) |
(if (and before (bobp)) |
2944 |
(allout-unprotected (open-line 1)))) |
(allout-unprotected (allout-open-line-not-read-only)))) |
2945 |
|
|
2946 |
(if (<= relative-depth 0) |
(if (<= relative-depth 0) |
2947 |
;; Not going inwards, don't snug up: |
;; Not going inwards, don't snug up: |
2948 |
(if doing-beginning |
(if doing-beginning |
2949 |
(allout-unprotected (open-line (if dbl-space 2 1))) |
(allout-unprotected |
2950 |
|
(if (not dbl-space) |
2951 |
|
(allout-open-line-not-read-only) |
2952 |
|
(allout-open-line-not-read-only) |
2953 |
|
(allout-open-line-not-read-only))) |
2954 |
(if before |
(if before |
2955 |
(progn (end-of-line) |
(progn (end-of-line) |
2956 |
(allout-pre-next-preface) |
(allout-pre-next-preface) |
2957 |
(while (= ?\r (following-char)) |
(while (= ?\r (following-char)) |
2958 |
(forward-char 1)) |
(forward-char 1)) |
2959 |
(if (not (looking-at "^$")) |
(if (not (looking-at "^$")) |
2960 |
(allout-unprotected (open-line 1)))) |
(allout-unprotected |
2961 |
|
(allout-open-line-not-read-only)))) |
2962 |
(allout-end-of-current-subtree))) |
(allout-end-of-current-subtree))) |
2963 |
;; Going inwards - double-space if first offspring is, |
;; Going inwards - double-space if first offspring is, |
2964 |
;; otherwise snug up. |
;; otherwise snug up. |
2976 |
(progn (forward-line -1) |
(progn (forward-line -1) |
2977 |
(looking-at "^\\s-*$")))) |
(looking-at "^\\s-*$")))) |
2978 |
(progn (forward-line 1) |
(progn (forward-line 1) |
2979 |
(allout-unprotected (open-line 1)))) |
(allout-unprotected |
2980 |
|
(allout-open-line-not-read-only)) |
2981 |
|
(forward-line 1))) |
2982 |
(end-of-line)) |
(end-of-line)) |
2983 |
;;(if doing-beginning (goto-char doing-beginning)) |
;;(if doing-beginning (goto-char doing-beginning)) |
2984 |
(if (not (bobp)) |
(if (not (bobp)) |
2985 |
|
;; We insert a newline char rather than using open-line to |
2986 |
|
;; avoid rear-stickiness inheritence of read-only property. |
2987 |
(progn (if (and (not (> depth ref-depth)) |
(progn (if (and (not (> depth ref-depth)) |
2988 |
(not before)) |
(not before)) |
2989 |
(allout-unprotected (open-line 1)) |
(allout-unprotected |
2990 |
|
(allout-open-line-not-read-only)) |
2991 |
(if (> depth ref-depth) |
(if (> depth ref-depth) |
2992 |
(allout-unprotected (newline 1)) |
(allout-unprotected |
2993 |
|
(allout-open-line-not-read-only)) |
2994 |
(if dbl-space |
(if dbl-space |
2995 |
(allout-unprotected (open-line 1)) |
(allout-unprotected |
2996 |
|
(allout-open-line-not-read-only)) |
2997 |
(if (not before) |
(if (not before) |
2998 |
(allout-unprotected (newline 1)))))) |
(allout-unprotected (newline 1)))))) |
2999 |
(if dbl-space |
(if dbl-space |
3000 |
(allout-unprotected (newline 1))) |
(allout-unprotected (newline 1))) |
3001 |
(if (and (not (eobp)) |
(if (and (not (eobp)) |
3002 |
(not (bolp))) |
(not (bolp))) |
3003 |
(forward-char 1)))) |
(forward-char 1)))) |
3004 |
)) |
)) |
3005 |
(insert (concat (allout-make-topic-prefix opening-numbered |
(insert (concat (allout-make-topic-prefix opening-numbered |
3006 |
t |
t |
3007 |
depth) |
depth) |
3008 |
" ")) |
" ")) |
3009 |
|
|
3010 |
;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) |
;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) |
3011 |
|
|
3012 |
|
|
3013 |
(allout-rebullet-heading (and use-sib-bullet ref-bullet);;; solicit |
(allout-rebullet-heading (and use_recent_bullet ;;; solicit |
3014 |
|
ref-bullet) |
3015 |
depth ;;; depth |
depth ;;; depth |
3016 |
nil ;;; number-control |
nil ;;; number-control |
3017 |
nil ;;; index |
nil ;;; index |
3018 |
t) (end-of-line) |
t) |
3019 |
|
(end-of-line) |
3020 |
) |
) |
3021 |
) |
) |
3022 |
;;;_ . open-topic contingencies |
;;;_ . open-topic contingencies |
3032 |
;;;_ ; buffer boundaries - special provisions for beginning and end ob |
;;;_ ; buffer boundaries - special provisions for beginning and end ob |
3033 |
;;;_ ; level 1 topics have special provisions also - double space. |
;;;_ ; level 1 topics have special provisions also - double space. |
3034 |
;;;_ ; location of new topic |
;;;_ ; location of new topic |
3035 |
|
;;;_ > allout-open-line-not-read-only () |
3036 |
|
(defun allout-open-line-not-read-only () |
3037 |
|
"Open line and remove inherited read-only text prop from new char, if any." |
3038 |
|
(open-line 1) |
3039 |
|
(if (plist-get (text-properties-at (point)) 'read-only) |
3040 |
|
(allout-unprotected |
3041 |
|
(remove-text-properties (point) (+ 1 (point)) '(read-only nil))))) |
3042 |
;;;_ > allout-open-subtopic (arg) |
;;;_ > allout-open-subtopic (arg) |
3043 |
(defun allout-open-subtopic (arg) |
(defun allout-open-subtopic (arg) |
3044 |
"Open new topic header at deeper level than the current one. |
"Open new topic header at deeper level than the current one. |
3046 |
Negative universal arg means to open deeper, but place the new topic |
Negative universal arg means to open deeper, but place the new topic |
3047 |
prior to the current one." |
prior to the current one." |
3048 |
(interactive "p") |
(interactive "p") |
3049 |
(allout-open-topic 1 (> 0 arg))) |
(allout-open-topic 1 (> 0 arg) (< 1 arg))) |
3050 |
;;;_ > allout-open-sibtopic (arg) |
;;;_ > allout-open-sibtopic (arg) |
3051 |
(defun allout-open-sibtopic (arg) |
(defun allout-open-sibtopic (arg) |
3052 |
"Open new topic header at same level as the current one. |
"Open new topic header at same level as the current one. |
3056 |
Negative universal arg means to place the new topic prior to the current |
Negative universal arg means to place the new topic prior to the current |
3057 |
one." |
one." |
3058 |
(interactive "p") |
(interactive "p") |
3059 |
(allout-open-topic 0 (> 0 arg) (< 1 arg))) |
(allout-open-topic 0 (> 0 arg) (not (= 1 arg)))) |
3060 |
;;;_ > allout-open-supertopic (arg) |
;;;_ > allout-open-supertopic (arg) |
3061 |
(defun allout-open-supertopic (arg) |
(defun allout-open-supertopic (arg) |
3062 |
"Open new topic header at shallower level than the current one. |
"Open new topic header at shallower level than the current one. |
3065 |
topic prior to the current one." |
topic prior to the current one." |
3066 |
|
|
3067 |
(interactive "p") |
(interactive "p") |
3068 |
(allout-open-topic -1 (> 0 arg))) |
(allout-open-topic -1 (> 0 arg) (< 1 arg))) |
3069 |
|
|
3070 |
;;;_ - Outline Alteration |
;;;_ - Outline Alteration |
3071 |
;;;_ : Topic Modification |
;;;_ : Topic Modification |
3121 |
(setq old-indent-begin (match-beginning 1) |
(setq old-indent-begin (match-beginning 1) |
3122 |
old-indent-end (match-end 1)) |
old-indent-end (match-end 1)) |
3123 |
(not (looking-at allout-regexp))) |
(not (looking-at allout-regexp))) |
3124 |
(if (> 0 (setq excess (- (current-column) |
(if (> 0 (setq excess (- (- old-indent-end old-indent-begin) |
3125 |
old-margin))) |
old-margin))) |
3126 |
;; Text starts left of old margin - don't adjust: |
;; Text starts left of old margin - don't adjust: |
3127 |
nil |
nil |
3128 |
;; Text was hanging at or right of old left margin - |
;; Text was hanging at or right of old left margin - |
3129 |
;; reindent it, preserving its existing indentation |
;; reindent it, preserving its existing indentation |
3130 |
;; beyond the old margin: |
;; beyond the old margin: |
3131 |
(delete-region old-indent-begin old-indent-end) |
(delete-region old-indent-begin old-indent-end) |
3132 |
(indent-to (+ new-margin excess))))))))) |
(indent-to (+ new-margin excess (current-column)))))))))) |
3133 |
;;;_ > allout-rebullet-current-heading (arg) |
;;;_ > allout-rebullet-current-heading (arg) |
3134 |
(defun allout-rebullet-current-heading (arg) |
(defun allout-rebullet-current-heading (arg) |
3135 |
"Solicit new bullet for current visible heading." |
"Solicit new bullet for current visible heading." |
3166 |
|
|
3167 |
"Adjust bullet of current topic prefix. |
"Adjust bullet of current topic prefix. |
3168 |
|
|
3169 |
|
All args are optional. |
3170 |
|
|
3171 |
If SOLICIT is non-nil, then the choice of bullet is solicited from |
If SOLICIT is non-nil, then the choice of bullet is solicited from |
3172 |
user. If it's a character, then that character is offered as the |
user. If it's a character, then that character is offered as the |
3173 |
default, otherwise the one suited to the context \(according to |
default, otherwise the one suited to the context \(according to |
3174 |
distinction or depth) is offered. If non-nil, then the |
distinction or depth) is offered. If non-nil, then the |
3175 |
context-specific bullet is just used. |
context-specific bullet is just used. |
3176 |
|
|
3177 |
Second arg NEW-DEPTH forces the topic prefix to that depth, regardless |
Second arg DEPTH forces the topic prefix to that depth, regardless |
3178 |
of the topic's current depth. |
of the topic's current depth. |
3179 |
|
|
3180 |
Third arg NUMBER-CONTROL can force the prefix to or away from |
Third arg NUMBER-CONTROL can force the prefix to or away from |
3181 |
numbered form. It has effect only if `allout-numbered-bullet' is |
numbered form. It has effect only if `allout-numbered-bullet' is |
3182 |
non-nil and soliciting was not explicitly invoked (via first arg). |
non-nil and soliciting was not explicitly invoked (via first arg). |
3183 |
Its effect, numbering or denumbering, then depends on the setting |
Its effect, numbering or denumbering, then depends on the setting |
3184 |
of the fourth arg, INDEX. |
of the forth arg, INDEX. |
3185 |
|
|
3186 |
If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the |
If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the |
3187 |
prefix of the topic is forced to be non-numbered. Null index and |
prefix of the topic is forced to be non-numbered. Null index and |
3188 |
non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and |
non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and |
3189 |
non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil |
non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil |
3190 |
INDEX is a number, then that number is used for the numbered |
INDEX is a number, then that number is used for the numbered |
3191 |
prefix. Non-nil and non-number means that the index for the |
prefix. Non-nil and non-number means that the index for the |
3192 |
numbered prefix will be derived by `allout-make-topic-prefix'. |
numbered prefix will be derived by allout-make-topic-prefix. |
3193 |
|
|
3194 |
Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding |
Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding |
3195 |
siblings. |
siblings. |
3232 |
; Put in new prefix: |
; Put in new prefix: |
3233 |
(allout-unprotected (insert new-prefix)) |
(allout-unprotected (insert new-prefix)) |
3234 |
|
|
3235 |
;; Reindent the body if elected and margin changed: |
;; Reindent the body if elected, margin changed, and not encrypted body: |
3236 |
(if (and allout-reindent-bodies |
(if (and allout-reindent-bodies |
3237 |
(not (= new-depth current-depth))) |
(not (= new-depth current-depth)) |
3238 |
|
(not (allout-encrypted-topic-p))) |
3239 |
(allout-reindent-body current-depth new-depth)) |
(allout-reindent-body current-depth new-depth)) |
3240 |
|
|
3241 |
;; Recursively rectify successive siblings of orig topic if |
;; Recursively rectify successive siblings of orig topic if |
3257 |
) ; defun |
) ; defun |
3258 |
;;;_ > allout-rebullet-topic (arg) |
;;;_ > allout-rebullet-topic (arg) |
3259 |
(defun allout-rebullet-topic (arg) |
(defun allout-rebullet-topic (arg) |
3260 |
"Like `allout-rebullet-topic-grunt', but start from topic visible at point. |
"Rebullet the visible topic containing point and all contained subtopics. |
3261 |
|
|
3262 |
Descends into invisible as well as visible topics, however. |
Descends into invisible as well as visible topics, however. |
3263 |
|
|
3283 |
starting-point |
starting-point |
3284 |
index |
index |
3285 |
do-successors) |
do-successors) |
3286 |
|
"Like `allout-rebullet-topic', but on nearest containing topic |
3287 |
|
\(visible or not). |
3288 |
|
|
3289 |
"Rebullet the topic at point, visible or invisible, and all |
See `allout-rebullet-heading' for rebulleting behavior. |
|
contained subtopics. See `allout-rebullet-heading' for rebulleting |
|
|
behavior. |
|
3290 |
|
|
3291 |
Arg RELATIVE-DEPTH means to shift the depth of the entire |
All arguments are optional. |
|
topic that amount. |
|
3292 |
|
|
3293 |
\(fn &optional RELATIVE-DEPTH)" |
First arg RELATIVE-DEPTH means to shift the depth of the entire |
3294 |
|
topic that amount. |
3295 |
|
|
3296 |
;; All args except the first one are for internal recursive use by the |
The rest of the args are for internal recursive use by the function |
3297 |
;; function itself. |
itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." |
3298 |
|
|
3299 |
(let* ((relative-depth (or relative-depth 0)) |
(let* ((relative-depth (or relative-depth 0)) |
3300 |
(new-depth (allout-depth)) |
(new-depth (allout-depth)) |
3424 |
(setq more (allout-next-sibling depth nil)))))) |
(setq more (allout-next-sibling depth nil)))))) |
3425 |
;;;_ > allout-shift-in (arg) |
;;;_ > allout-shift-in (arg) |
3426 |
(defun allout-shift-in (arg) |
(defun allout-shift-in (arg) |
3427 |
"Increase depth of current heading and any topics collapsed within it." |
"Increase depth of current heading and any topics collapsed within it. |
3428 |
|
|
3429 |
|
We disallow shifts that would result in the topic having a depth more than |
3430 |
|
one level greater than the immediately previous topic, to avoid containment |
3431 |
|
discontinuity. The first topic in the file can be adjusted to any positive |
3432 |
|
depth, however." |
3433 |
(interactive "p") |
(interactive "p") |
3434 |
|
(if (> arg 0) |
3435 |
|
(save-excursion |
3436 |
|
(allout-back-to-current-heading) |
3437 |
|
(if (not (bobp)) |
3438 |
|
(let* ((current-depth (allout-recent-depth)) |
3439 |
|
(start-point (point)) |
3440 |
|
(predecessor-depth (progn |
3441 |
|
(forward-char -1) |
3442 |
|
(allout-goto-prefix) |
3443 |
|
(if (< (point) start-point) |
3444 |
|
(allout-recent-depth) |
3445 |
|
0)))) |
3446 |
|
(if (and (> predecessor-depth 0) |
3447 |
|
(> (+ current-depth arg) |
3448 |
|
(1+ predecessor-depth))) |
3449 |
|
(error (concat "May not shift deeper than offspring depth" |
3450 |
|
" of previous topic"))))))) |
3451 |
(allout-rebullet-topic arg)) |
(allout-rebullet-topic arg)) |
3452 |
;;;_ > allout-shift-out (arg) |
;;;_ > allout-shift-out (arg) |
3453 |
(defun allout-shift-out (arg) |
(defun allout-shift-out (arg) |
3454 |
"Decrease depth of current heading and any topics collapsed within it." |
"Decrease depth of current heading and any topics collapsed within it. |
3455 |
|
|
3456 |
|
We disallow shifts that would result in the topic having a depth more than |
3457 |
|
one level greater than the immediately previous topic, to avoid containment |
3458 |
|
discontinuity. The first topic in the file can be adjusted to any positive |
3459 |
|
depth, however." |
3460 |
(interactive "p") |
(interactive "p") |
3461 |
|
(if (< arg 0) |
3462 |
|
(allout-shift-in (* arg -1))) |
3463 |
(allout-rebullet-topic (* arg -1))) |
(allout-rebullet-topic (* arg -1))) |
3464 |
;;;_ : Surgery (kill-ring) functions with special provisions for outlines: |
;;;_ : Surgery (kill-ring) functions with special provisions for outlines: |
3465 |
;;;_ > allout-kill-line (&optional arg) |
;;;_ > allout-kill-line (&optional arg) |
3467 |
"Kill line, adjusting subsequent lines suitably for outline mode." |
"Kill line, adjusting subsequent lines suitably for outline mode." |
3468 |
|
|
3469 |
(interactive "*P") |
(interactive "*P") |
3470 |
(if (not (and (allout-mode-p) ; active outline mode, |
|
3471 |
allout-numbered-bullet ; numbers may need adjustment, |
(let ((start-point (point)) |
3472 |
(bolp) ; may be clipping topic head, |
(leading-kill-ring-entry (car kill-ring)) |
3473 |
(looking-at allout-regexp))) ; are clipping topic head. |
binding) |
3474 |
;; Above conditions do not obtain - just do a regular kill: |
|
3475 |
(kill-line arg) |
(condition-case err |
3476 |
;; Ah, have to watch out for adjustments: |
|
3477 |
(let* ((depth (allout-depth))) |
(if (not (and (allout-mode-p) ; active outline mode, |
3478 |
; Do the kill: |
allout-numbered-bullet ; numbers may need adjustment, |
3479 |
(kill-line arg) |
(bolp) ; may be clipping topic head, |
3480 |
|
(looking-at allout-regexp))) ; are clipping topic head. |
3481 |
|
;; Above conditions do not obtain - just do a regular kill: |
3482 |
|
(kill-line arg) |
3483 |
|
;; Ah, have to watch out for adjustments: |
3484 |
|
(let* ((depth (allout-depth)) |
3485 |
|
(start-point (point)) |
3486 |
|
binding) |
3487 |
|
; Do the kill, presenting option |
3488 |
|
; for read-only text: |
3489 |
|
(kill-line arg) |
3490 |
; Provide some feedback: |
; Provide some feedback: |
3491 |
(sit-for 0) |
(sit-for 0) |
3492 |
(save-excursion |
(save-excursion |
3493 |
; Start with the topic |
; Start with the topic |
3494 |
; following killed line: |
; following killed line: |
3495 |
(if (not (looking-at allout-regexp)) |
(if (not (looking-at allout-regexp)) |
3496 |
(allout-next-heading)) |
(allout-next-heading)) |
3497 |
(allout-renumber-to-depth depth))))) |
(allout-renumber-to-depth depth)))) |
3498 |
|
;; condition case handler: |
3499 |
|
(text-read-only |
3500 |
|
(goto-char start-point) |
3501 |
|
(setq binding (where-is-internal 'allout-kill-topic nil t)) |
3502 |
|
(cond ((not binding) (setq binding "")) |
3503 |
|
((arrayp binding) |
3504 |
|
(setq binding (mapconcat 'key-description (list binding) ", "))) |
3505 |
|
(t (setq binding (format "%s" binding)))) |
3506 |
|
;; ensure prior kill-ring leader is properly restored: |
3507 |
|
(if (eq leading-kill-ring-entry (cadr kill-ring)) |
3508 |
|
;; Aborted kill got pushed on front - ditch it: |
3509 |
|
(pop kill-ring) |
3510 |
|
;; Aborted kill got appended to prior - resurrect prior: |
3511 |
|
(setcar kill-ring leading-kill-ring-entry)) |
3512 |
|
;; make last-command skip this failed command, so kill-appending |
3513 |
|
;; conditions track: |
3514 |
|
(setq this-command last-command) |
3515 |
|
(error (concat "read-only text hit - use %s allout-kill-topic to" |
3516 |
|
" discard collapsed stuff") |
3517 |
|
binding))) |
3518 |
|
) |
3519 |
|
) |
3520 |
;;;_ > allout-kill-topic () |
;;;_ > allout-kill-topic () |
3521 |
(defun allout-kill-topic () |
(defun allout-kill-topic () |
3522 |
"Kill topic together with subtopics. |
"Kill topic together with subtopics. |
3544 |
(>= (allout-recent-depth) depth)))) |
(>= (allout-recent-depth) depth)))) |
3545 |
(forward-char 1))) |
(forward-char 1))) |
3546 |
|
|
3547 |
(kill-region beg (point)) |
(allout-unprotected (kill-region beg (point))) |
3548 |
(sit-for 0) |
(sit-for 0) |
3549 |
(save-excursion |
(save-excursion |
3550 |
(allout-renumber-to-depth depth)))) |
(allout-renumber-to-depth depth)))) |
3551 |
;;;_ > allout-yank-processing () |
;;;_ > allout-yank-processing () |
3552 |
(defun allout-yank-processing (&optional arg) |
(defun allout-yank-processing (&optional arg) |
3553 |
|
|
3554 |
"Incidental outline specific business to be done just after text yanks. |
"Incidental outline-specific business to be done just after text yanks. |
3555 |
|
|
3556 |
Does depth adjustment of yanked topics, when: |
Does depth adjustment of yanked topics, when: |
3557 |
|
|
3567 |
|
|
3568 |
The point is left in front of yanked, adjusted topics, rather than |
The point is left in front of yanked, adjusted topics, rather than |
3569 |
at the end (and vice-versa with the mark). Non-adjusted yanks, |
at the end (and vice-versa with the mark). Non-adjusted yanks, |
3570 |
however, are left exactly like normal, not outline specific yanks." |
however, are left exactly like normal, non-allout-specific yanks." |
3571 |
|
|
3572 |
(interactive "*P") |
(interactive "*P") |
3573 |
; Get to beginning, leaving |
; Get to beginning, leaving |
3771 |
;;;_ #6 Exposure Control |
;;;_ #6 Exposure Control |
3772 |
|
|
3773 |
;;;_ - Fundamental |
;;;_ - Fundamental |
3774 |
|
;;;_ > allout-flag-region (from to flag) |
3775 |
|
(defun allout-flag-region (from to flag) |
3776 |
|
"Hide or show lines from FROM to TO, via Emacs selective-display FLAG char. |
3777 |
|
Ie, text following flag C-m \(carriage-return) is hidden until the |
3778 |
|
next C-j (newline) char. |
3779 |
|
|
3780 |
|
Returns the endpoint of the region." |
3781 |
|
;; "OFR-" prefixes to avoid collisions with vars in code calling the macro. |
3782 |
|
;; ie, elisp macro vars are not 'hygenic', so distinct names are necessary. |
3783 |
|
(let ((was-inhibit-r-o inhibit-read-only) |
3784 |
|
(was-undo-list buffer-undo-list) |
3785 |
|
(was-modified (buffer-modified-p)) |
3786 |
|
trans) |
3787 |
|
(unwind-protect |
3788 |
|
(save-excursion |
3789 |
|
(setq inhibit-read-only t) |
3790 |
|
(setq buffer-undo-list t) |
3791 |
|
(if (> from to) |
3792 |
|
(setq trans from from to to trans)) |
3793 |
|
(subst-char-in-region from to |
3794 |
|
(if (= flag ?\n) ?\r ?\n) |
3795 |
|
flag t) |
3796 |
|
;; adjust character read-protection on all the affected lines. |
3797 |
|
;; we handle the region line-by-line. |
3798 |
|
(goto-char to) |
3799 |
|
(end-of-line) |
3800 |
|
(setq to (min (+ 2 (point)) (point-max))) |
3801 |
|
(goto-char from) |
3802 |
|
(beginning-of-line) |
3803 |
|
(while (< (point) to) |
3804 |
|
;; handle from start of exposed to beginning of hidden, or eol: |
3805 |
|
(remove-text-properties (point) |
3806 |
|
(progn (if (re-search-forward "[\r\n]" |
3807 |
|
nil t) |
3808 |
|
(forward-char -1)) |
3809 |
|
(point)) |
3810 |
|
'(read-only nil)) |
3811 |
|
;; handle from start of hidden, if any, to eol: |
3812 |
|
(if (and (not (eobp)) (= (char-after (point)) ?\r)) |
3813 |
|
(put-text-property (point) (progn (end-of-line) (point)) |
3814 |
|
'read-only t)) |
3815 |
|
;; Handle the end-of-line to beginning of next line: |
3816 |
|
(if (not (eobp)) |
3817 |
|
(progn (forward-char 1) |
3818 |
|
(remove-text-properties (1- (point)) (point) |
3819 |
|
'(read-only nil))))) |
3820 |
|
) |
3821 |
|
(if (not was-modified) |
3822 |
|
(set-buffer-modified-p nil)) |
3823 |
|
(setq inhibit-read-only was-inhibit-r-o) |
3824 |
|
(setq buffer-undo-list was-undo-list) |
3825 |
|
) |
3826 |
|
) |
3827 |
|
) |
3828 |
;;;_ > allout-flag-current-subtree (flag) |
;;;_ > allout-flag-current-subtree (flag) |
3829 |
(defun allout-flag-current-subtree (flag) |
(defun allout-flag-current-subtree (flag) |
3830 |
"Hide or show subtree of currently-visible topic. |
"Hide or show subtree of currently-visible topic. |
3833 |
|
|
3834 |
(save-excursion |
(save-excursion |
3835 |
(allout-back-to-current-heading) |
(allout-back-to-current-heading) |
3836 |
(allout-flag-region (point) |
(let ((from (point)) |
3837 |
(progn (allout-end-of-current-subtree) (1- (point))) |
(to (progn (allout-end-of-current-subtree) (1- (point))))) |
3838 |
flag))) |
(allout-flag-region from to flag)))) |
3839 |
|
|
3840 |
;;;_ - Topic-specific |
;;;_ - Topic-specific |
3841 |
;;;_ > allout-show-entry () |
;;;_ > allout-show-entry () |
3844 |
|
|
3845 |
This is a way to give restricted peek at a concealed locality without the |
This is a way to give restricted peek at a concealed locality without the |
3846 |
expense of exposing its context, but can leave the outline with aberrant |
expense of exposing its context, but can leave the outline with aberrant |
3847 |
exposure. `allout-hide-current-entry-completely' or `allout-show-to-offshoot' |
exposure. `allout-hide-current-entry-completely' or `allout-show-offshoot' |
3848 |
should be used after the peek to rectify the exposure." |
should be used after the peek to rectify the exposure." |
3849 |
|
|
3850 |
(interactive) |
(interactive) |
3964 |
(allout-back-to-current-heading) |
(allout-back-to-current-heading) |
3965 |
(save-excursion |
(save-excursion |
3966 |
(allout-flag-region (point) |
(allout-flag-region (point) |
3967 |
(progn (allout-end-of-current-entry) (point)) |
(progn (allout-end-of-entry) (point)) |
3968 |
?\r))) |
?\r))) |
3969 |
;;;_ > allout-show-current-entry (&optional arg) |
;;;_ > allout-show-current-entry (&optional arg) |
3970 |
(defun allout-show-current-entry (&optional arg) |
(defun allout-show-current-entry (&optional arg) |
3976 |
(allout-hide-current-entry) |
(allout-hide-current-entry) |
3977 |
(save-excursion |
(save-excursion |
3978 |
(allout-flag-region (point) |
(allout-flag-region (point) |
3979 |
(progn (allout-end-of-current-entry) (point)) |
(progn (allout-end-of-entry) (point)) |
3980 |
?\n)))) |
?\n) |
3981 |
|
))) |
3982 |
;;;_ > allout-hide-current-entry-completely () |
;;;_ > allout-hide-current-entry-completely () |
3983 |
; ... allout-hide-current-entry-completely also for isearch dynamic exposure: |
; ... allout-hide-current-entry-completely also for isearch dynamic exposure: |
3984 |
(defun allout-hide-current-entry-completely () |
(defun allout-hide-current-entry-completely () |
4209 |
max-pos))) |
max-pos))) |
4210 |
;;;_ > allout-old-expose-topic (spec &rest followers) |
;;;_ > allout-old-expose-topic (spec &rest followers) |
4211 |
(defun allout-old-expose-topic (spec &rest followers) |
(defun allout-old-expose-topic (spec &rest followers) |
4212 |
"Dictate wholesale exposure scheme for current topic, according to SPEC. |
|
4213 |
|
"Deprecated. Use `allout-expose-topic' \(with different schema |
4214 |
|
format) instead. |
4215 |
|
|
4216 |
|
Dictate wholesale exposure scheme for current topic, according to SPEC. |
4217 |
|
|
4218 |
SPEC is either a number or a list. Optional successive args |
SPEC is either a number or a list. Optional successive args |
4219 |
dictate exposure for subsequent siblings of current topic. |
dictate exposure for subsequent siblings of current topic. |
4285 |
(allout-old-expose-topic (car followers)) |
(allout-old-expose-topic (car followers)) |
4286 |
(setq followers (cdr followers))) |
(setq followers (cdr followers))) |
4287 |
max-pos)) |
max-pos)) |
|
(make-obsolete 'allout-old-expose-topic |
|
|
"use `allout-expose-topic' (with different schema format) instead." |
|
|
"19.23") |
|
4288 |
;;;_ > allout-new-exposure '() |
;;;_ > allout-new-exposure '() |
4289 |
(defmacro allout-new-exposure (&rest spec) |
(defmacro allout-new-exposure (&rest spec) |
4290 |
"Literal frontend for `allout-expose-topic', doesn't evaluate arguments. |
"Literal frontend for `allout-expose-topic', doesn't evaluate arguments. |
4293 |
|
|
4294 |
Cursor is left at start position. |
Cursor is left at start position. |
4295 |
|
|
4296 |
|
Use this instead of obsolete `allout-exposure'. |
4297 |
|
|
4298 |
Examples: |
Examples: |
4299 |
\(allout-new-exposure (-1 () () () 1) 0) |
\(allout-new-exposure (-1 () () () 1) 0) |
4300 |
Close current topic at current level so only the immediate |
Close current topic at current level so only the immediate |
4517 |
(cdr format))))))) |
(cdr format))))))) |
4518 |
;; Put the list with first at front, to last at back: |
;; Put the list with first at front, to last at back: |
4519 |
(nreverse result)))) |
(nreverse result)))) |
4520 |
|
;;;_ > my-region-active-p () |
4521 |
|
(defmacro my-region-active-p () |
4522 |
|
(if (fboundp 'region-active-p) |
4523 |
|
'(region-active-p) |
4524 |
|
'mark-active)) |
4525 |
;;;_ > allout-process-exposed (&optional func from to frombuf |
;;;_ > allout-process-exposed (&optional func from to frombuf |
4526 |
;;; tobuf format) |
;;; tobuf format) |
4527 |
(defun allout-process-exposed (&optional func from to frombuf tobuf |
(defun allout-process-exposed (&optional func from to frombuf tobuf |
4528 |
format start-num) |
format &optional start-num) |
4529 |
"Map function on exposed parts of current topic; results to another buffer. |
"Map function on exposed parts of current topic; results to another buffer. |
4530 |
|
|
4531 |
Apply FUNC to exposed portions FROM position TO position in buffer |
All args are options; default values itemized below. |
4532 |
|
|
4533 |
|
Apply FUNCTION to exposed portions FROM position TO position in buffer |
4534 |
FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an |
FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an |
4535 |
alternate presentation form: |
alternate presentation form: |
4536 |
|
|
4543 |
except for distinctive bullets. |
except for distinctive bullets. |
4544 |
|
|
4545 |
Defaults: |
Defaults: |
4546 |
FUNC: `allout-insert-listified' |
FUNCTION: `allout-insert-listified' |
4547 |
FROM: region start, if region active, else start of buffer |
FROM: region start, if region active, else start of buffer |
4548 |
TO: region end, if region active, else end of buffer |
TO: region end, if region active, else end of buffer |
4549 |
FROMBUF: current buffer |
FROMBUF: current buffer |
4592 |
|
|
4593 |
\`(depth prefix text)' |
\`(depth prefix text)' |
4594 |
|
|
4595 |
or |
or \`(depth prefix text bullet-plus)' |
|
|
|
|
\`(depth prefix text bullet-plus)' |
|
4596 |
|
|
4597 |
If `bullet-plus' is specified, it is inserted just after the entire prefix." |
If `bullet-plus' is specified, it is inserted just after the entire prefix." |
4598 |
(setq listified (cdr listified)) |
(setq listified (cdr listified)) |
4608 |
(while text |
(while text |
4609 |
(insert (car text)) |
(insert (car text)) |
4610 |
(if (setq text (cdr text)) |
(if (setq text (cdr text)) |
4611 |
(insert "\n"))) |
(insert-string "\n"))) |
4612 |
(insert "\n"))) |
(insert "\n"))) |
4613 |
;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format) |
;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format) |
4614 |
(defun allout-copy-exposed-to-buffer (&optional arg tobuf format) |
(defun allout-copy-exposed-to-buffer (&optional arg tobuf format) |
4811 |
body-content bop) |
body-content bop) |
4812 |
; Do the head line: |
; Do the head line: |
4813 |
(insert (concat "\\OneHeadLine{\\verb\1 " |
(insert (concat "\\OneHeadLine{\\verb\1 " |
4814 |
(allout-latex-verb-quote bullet) |
(allout-latex-verb-quote bullet) |
4815 |
"\1}{" |
"\1}{" |
4816 |
depth |
depth |
4817 |
"}{\\verb\1 " |
"}{\\verb\1 " |
4818 |
(if head-line |
(if head-line |
4819 |
(allout-latex-verb-quote head-line) |
(allout-latex-verb-quote head-line) |
4820 |
"") |
"") |
4821 |
"\1}\n")) |
"\1}\n")) |
4822 |
(if (not body-lines) |
(if (not body-lines) |
4823 |
nil |
nil |
4824 |
;;(insert "\\beginlines\n") |
;;(insert "\\beginlines\n") |
4880 |
(pop-to-buffer buf) |
(pop-to-buffer buf) |
4881 |
(goto-char start-pt))) |
(goto-char start-pt))) |
4882 |
|
|
4883 |
;;;_ #8 miscellaneous |
;;;_ #8 Encryption |
4884 |
|
;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-key) |
4885 |
|
(defun allout-toggle-current-subtree-encryption (&optional fetch-key) |
4886 |
|
"Encrypt clear text or decrypt encoded contents of a topic. |
4887 |
|
|
4888 |
|
Contents includes body and subtopics. |
4889 |
|
|
4890 |
|
Currently only GnuPG encryption is supported. |
4891 |
|
|
4892 |
|
\**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg |
4893 |
|
encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. |
4894 |
|
|
4895 |
|
Both symmetric-key and key-pair encryption is implemented. Symmetric is |
4896 |
|
the default, use a single \(x4) universal argument for keypair mode. |
4897 |
|
|
4898 |
|
Encrypted topic's bullet is set to a `~' to signal that the contents of the |
4899 |
|
topic \(body and subtopics, but not heading) is pending encryption or |
4900 |
|
encrypted. An `*' asterisk immediately after the bullet signals that the |
4901 |
|
body is encrypted, its absence means it's meant to be encrypted but is not |
4902 |
|
- it's \"disclosed\". When a file with disclosed topics is saved, the user |
4903 |
|
prompted for an ok to \(symmetric-key) encrypt the disclosed topics. NOTE |
4904 |
|
WELL that you must explicitly \(re)encrypt key-pair encrypted topics if you |
4905 |
|
want them to continue to be in key-pair mode. |
4906 |
|
|
4907 |
|
Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be |
4908 |
|
encrypted. If you want to encrypt the contents of a top-level topic, use |
4909 |
|
\\[allout-shift-in] to increase its depth. |
4910 |
|
|
4911 |
|
Failed transformation does not change the an entry being encrypted - |
4912 |
|
instead, the key is re-solicited and the transformation is retried. |
4913 |
|
\\[keyboard-quit] to abort. |
4914 |
|
|
4915 |
|
Decryption does symmetric or key-pair key mode depending on how the text |
4916 |
|
was encrypted. The encryption key is solicited if not currently available |
4917 |
|
from the key cache from a recent prior encryption action. |
4918 |
|
|
4919 |
|
Optional FETCH-KEY universal argument is used for two purposes - to provoke |
4920 |
|
key-pair instead of symmetric encryption, or to provoke clearing of the key |
4921 |
|
cache so keys are freshly fetched. |
4922 |
|
|
4923 |
|
- Without any universal arguments, then the appropriate key for the is |
4924 |
|
obtained from the cache, if available, else from the user. |
4925 |
|
|
4926 |
|
- If FETCH-KEY is the result of one universal argument - ie, equal to 4 - |
4927 |
|
then key-pair encryption is used. |
4928 |
|
|
4929 |
|
- With repeated universal argument - equal to 16 - then the key cache is |
4930 |
|
cleared before any encryption transformations, to force prompting of the |
4931 |
|
user for the key. |
4932 |
|
|
4933 |
|
The solicited key is retained for reuse in a buffer-specific cache for some |
4934 |
|
set period of time \(default, 60 seconds), after which the string is |
4935 |
|
nulled. `mailcrypt' provides the key caching functionality. You can |
4936 |
|
adjust the key cache timeout by ajdusting the setting of the elisp variable |
4937 |
|
`mc-passwd-timeout'. |
4938 |
|
|
4939 |
|
If the file previously had no associated key, or had a different key than |
4940 |
|
specified, the user is prompted to repeat the new one for corroboration. A |
4941 |
|
random string encrypted by the new key is set on the buffer-specific |
4942 |
|
variable `allout-key-verifier-string', for confirmation of the key when |
4943 |
|
next obtained, before encrypting or decrypting anything with it. This |
4944 |
|
helps avoid mistakenly shifting between keys. |
4945 |
|
|
4946 |
|
If allout customization var `allout-key-verifier-handling' is non-nil, an |
4947 |
|
entry for `allout-key-verifier-string' and its value is added to an Emacs |
4948 |
|
'local variables' section at the end of the file, which is created if |
4949 |
|
necessary. That setting is for retention of the key verifier across emacs |
4950 |
|
sessions. |
4951 |
|
|
4952 |
|
Similarly, `allout-key-hint-string' stores a user-provided reminder about |
4953 |
|
their key, and `allout-key-hint-handling' specifies when the hint is |
4954 |
|
presented, or if key hints are disabled. If enabled \(see the |
4955 |
|
`allout-key-hint-handling' docstring for details), the hint string is |
4956 |
|
stored in the local-variables section of the file, and solicited whenever |
4957 |
|
the key is changed." |
4958 |
|
|
4959 |
|
;;; This routine handles allout-specific business, dispatching |
4960 |
|
;;; encryption-specific business to allout-encrypt-string. |
4961 |
|
|
4962 |
|
(interactive "P") |
4963 |
|
(save-excursion |
4964 |
|
(allout-end-of-prefix t) |
4965 |
|
|
4966 |
|
(if (= (allout-recent-depth) 1) |
4967 |
|
(error (concat "Cannot encrypt or decrypt level 1 topics -" |
4968 |
|
" shift it in to make it encryptable"))) |
4969 |
|
|
4970 |
|
(if (and fetch-key |
4971 |
|
(not (equal fetch-key '(4)))) |
4972 |
|
(mc-deactivate-passwd)) |
4973 |
|
|
4974 |
|
(let* ((allout-buffer (current-buffer)) |
4975 |
|
;; Asses location: |
4976 |
|
(after-bullet-pos (point)) |
4977 |
|
(was-encrypted |
4978 |
|
(progn (if (= (point-max) after-bullet-pos) |
4979 |
|
(error "no body to encrypt")) |
4980 |
|
(looking-at "\\*"))) |
4981 |
|
(was-collapsed (if (not (re-search-forward "[\n\r]" nil t)) |
4982 |
|
nil |
4983 |
|
(backward-char 1) |
4984 |
|
(looking-at "\r"))) |
4985 |
|
(subtree-beg (1+ (point))) |
4986 |
|
(subtree-end (allout-end-of-subtree)) |
4987 |
|
(subject-text (buffer-substring-no-properties subtree-beg |
4988 |
|
subtree-end)) |
4989 |
|
(subtree-end-char (char-after (1- subtree-end))) |
4990 |
|
(subtree-trailling-char (char-after subtree-end)) |
4991 |
|
(place-holder (if (or (string= "" subject-text) |
4992 |
|
(string= "\n" subject-text)) |
4993 |
|
(error "No topic contents to %scrypt" |
4994 |
|
(if was-encrypted "de" "en")))) |
4995 |
|
;; Assess key parameters: |
4996 |
|
(key-type (or |
4997 |
|
;; detect the type by which it is already encrypted |
4998 |
|
(and was-encrypted |
4999 |
|
(allout-encrypted-text-type subject-text)) |
5000 |
|
(and (member fetch-key '(4 (4))) |
5001 |
|
(yes-or-no-p "Use key-pair encryption instead? ") |
5002 |
|
'keypair) |
5003 |
|
'symmetric)) |
5004 |
|
(fetch-key (and fetch-key (not (member fetch-key '(16 (16)))))) |
5005 |
|
result-text) |
5006 |
|
|
5007 |
|
(setq result-text |
5008 |
|
(allout-encrypt-string subject-text was-encrypted |
5009 |
|
(current-buffer) key-type fetch-key)) |
5010 |
|
|
5011 |
|
;; Replace the subtree with the processed product. |
5012 |
|
(allout-unprotected |
5013 |
|
(progn |
5014 |
|
(set-buffer allout-buffer) |
5015 |
|
(delete-region subtree-beg subtree-end) |
5016 |
|
(insert result-text) |
5017 |
|
(if was-collapsed |
5018 |
|
(allout-flag-region subtree-beg (1- (point)) ?\r)) |
5019 |
|
;; adjust trailling-blank-lines to preserve topic spacing: |
5020 |
|
(if (not was-encrypted) |
5021 |
|
(if (and (member subtree-end-char '(?\r ?\n)) |
5022 |
|
(member subtree-trailling-char '(?\r ?\n))) |
5023 |
|
(insert subtree-trailling-char))) |
5024 |
|
;; Ensure that the item has an encrypted-entry bullet: |
5025 |
|
(if (not (string= (buffer-substring-no-properties |
5026 |
|
(1- after-bullet-pos) after-bullet-pos) |
5027 |
|
allout-topic-encryption-bullet)) |
5028 |
|
(progn (goto-char (1- after-bullet-pos)) |
5029 |
|
(delete-char 1) |
5030 |
|
(insert allout-topic-encryption-bullet))) |
5031 |
|
(if was-encrypted |
5032 |
|
;; Remove the is-encrypted bullet qualifier: |
5033 |
|
(progn (goto-char after-bullet-pos) |
5034 |
|
(delete-char 1)) |
5035 |
|
;; Add the is-encrypted bullet qualifier: |
5036 |
|
(goto-char after-bullet-pos) |
5037 |
|
(insert "*")) |
5038 |
|
) |
5039 |
|
) |
5040 |
|
) |
5041 |
|
) |
5042 |
|
) |
5043 |
|
;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type rekey |
5044 |
|
;;; &optional retried verifying) |
5045 |
|
(defun allout-encrypt-string (text decrypt allout-buffer key-type rekey |
5046 |
|
&optional retried verifying) |
5047 |
|
"Encrypt or decrypt a string TEXT using KEY. |
5048 |
|
|
5049 |
|
If optional DECRYPT is true (default false), then decrypt instead of |
5050 |
|
encrypt. |
5051 |
|
|
5052 |
|
Optional REKEY (default false) provokes clearing of the key cache to force |
5053 |
|
fresh prompting for the key. |
5054 |
|
|
5055 |
|
Optional RETRIED is for internal use - conveys the number of failed keys have |
5056 |
|
been solicited in sequence leading to this current call. |
5057 |
|
|
5058 |
|
Optional VERIFYING is for internal use, signifying processing of text |
5059 |
|
solely for verification of the cached key. |
5060 |
|
|
5061 |
|
Returns the resulting string, or nil if the transformation fails." |
5062 |
|
|
5063 |
|
;; Ensure that we have an alternate handle on the real mc-activate-passwd: |
5064 |
|
(if (not (fboundp 'real-mc-activate-passwd)) |
5065 |
|
;; Force loads of the primary mailcrypt packages, so flet below holds. |
5066 |
|
(progn (require 'mailcrypt) |
5067 |
|
(load "mc-toplev") |
5068 |
|
(fset 'real-mc-activate-passwd |
5069 |
|
(symbol-function 'mc-activate-passwd)))) |
5070 |
|
|
5071 |
|
(if (and rekey (not verifying)) (mc-deactivate-passwd)) |
5072 |
|
|
5073 |
|
(catch 'encryption-failed |
5074 |
|
(save-excursion |
5075 |
|
|
5076 |
|
(let* ((mc-default-scheme (or allout-encryption-scheme |
5077 |
|
allout-default-encryption-scheme)) |
5078 |
|
(id (format "%s-%s" key-type |
5079 |
|
(or (buffer-file-name allout-buffer) |
5080 |
|
(buffer-name allout-buffer)))) |
5081 |
|
(cached (real-mc-activate-passwd id nil)) |
5082 |
|
(comment "Processed by allout driving mailcrypt") |
5083 |
|
key work-buffer result result-text encryption-process-status) |
5084 |
|
|
5085 |
|
(unwind-protect |
5086 |
|
|
5087 |
|
;; Interject our mc-activate-passwd wrapper: |
5088 |
|
(flet ((mc-activate-passwd (id &optional prompt) |
5089 |
|
(allout-mc-activate-passwd id prompt))) |
5090 |
|
|
5091 |
|
(setq work-buffer |
5092 |
|
(set-buffer (allout-encryption-produce-work-buffer text))) |
5093 |
|
|
5094 |
|
(cond |
5095 |
|
|
5096 |
|
;; symmetric: |
5097 |
|
((equal key-type 'symmetric) |
5098 |
|
(setq key (if verifying |
5099 |
|
(real-mc-activate-passwd id nil) |
5100 |
|
(allout-mc-activate-passwd id))) |
5101 |
|
(setq encryption-process-status |
5102 |
|
(crypt-encrypt-buffer key decrypt)) |
5103 |
|
(if (zerop encryption-process-status) |
5104 |
|
t |
5105 |
|
(if verifying |
5106 |
|
(throw 'encryption-failed nil) |
5107 |
|
(mc-deactivate-passwd) |
5108 |
|
(error "Symmetric-key encryption failed (%s) - wrong key?" |
5109 |
|
encryption-process-status)))) |
5110 |
|
|
5111 |
|
;; encrypt 'keypair: |
5112 |
|
((not decrypt) |
5113 |
|
(condition-case result |
5114 |
|
(mailcrypt-encrypt 1) |
5115 |
|
(error (mc-deactivate-passwd) |
5116 |
|
(error "encryption failed: %s" |
5117 |
|
(cadr result))))) |
5118 |
|
|
5119 |
|
;; decrypt 'keypair: |
5120 |
|
(t (condition-case result |
5121 |
|
(mc-decrypt) |
5122 |
|
(error (mc-deactivate-passwd) |
5123 |
|
(error "decryption failed: %s" |
5124 |
|
(cadr result)))))) |
5125 |
|
|
5126 |
|
(setq result-text (if (or (equal key-type 'keypair) |
5127 |
|
(not decrypt)) |
5128 |
|
(buffer-substring 1 (1- (point-max))) |
5129 |
|
(buffer-string))) |
5130 |
|
;; validate result - non-empty |
5131 |
|
(cond ((not result-text) |
5132 |
|
(if verifying |
5133 |
|
nil |
5134 |
|
;; Transformation was fruitless - retry with new key. |
5135 |
|
(mc-deactivate-passwd) |
5136 |
|
(allout-encrypt-string text allout-buffer decrypt nil |
5137 |
|
(if retried (1+ retried) 1) |
5138 |
|
verifying))) |
5139 |
|
|
5140 |
|
;; Barf if encryption yields extraordinary control chars: |
5141 |
|
((and (not decrypt) |
5142 |
|
(string-match "[\C-a\C-k\C-o-\C-z\C-@]" result-text)) |
5143 |
|
(error (concat "encryption produced unusable" |
5144 |
|
" non-armored text - reconfigure!"))) |
5145 |
|
|
5146 |
|
;; valid result and just verifying or non-symmetric: |
5147 |
|
((or verifying (not (equal key-type 'symmetric))) |
5148 |
|
result-text) |
5149 |
|
|
5150 |
|
;; valid result and regular symmetric - situate validator: |
5151 |
|
(t |
5152 |
|
;; valid result and verifier needs to be situated in |
5153 |
|
;; allout-buffer: |
5154 |
|
(set-buffer allout-buffer) |
5155 |
|
(if (and (or rekey (not cached)) |
5156 |
|
(not (allout-verify-key key allout-buffer))) |
5157 |
|
(allout-situate-encryption-key-verifier key id)) |
5158 |
|
result-text) |
5159 |
|
) |
5160 |
|
) |
5161 |
|
|
5162 |
|
;; unwind-protect emergence: |
5163 |
|
(if work-buffer |
5164 |
|
(kill-buffer work-buffer)) |
5165 |
|
) |
5166 |
|
) |
5167 |
|
) |
5168 |
|
) |
5169 |
|
) |
5170 |
|
;;;_ > allout-mc-activate-passwd (id &optional prompt) |
5171 |
|
(defun allout-mc-activate-passwd (id &optional prompt) |
5172 |
|
"Substituted for mc-activate-passwd during allout outline encryption. |
5173 |
|
|
5174 |
|
We add key-verification to vanilla mc-activate-passwd. |
5175 |
|
|
5176 |
|
We depend in some cases on values of the following allout-encrypt-string |
5177 |
|
internal or prevailing variables: |
5178 |
|
- key-type - 'symmetric or 'keypair |
5179 |
|
- id - id associated with current key in key cache |
5180 |
|
- allout-buffer - where subject text resides |
5181 |
|
- retried - number of current attempts to obtain this key |
5182 |
|
- rekey - user asked to present a new key - needs to be confirmed" |
5183 |
|
|
5184 |
|
;; - if we're doing non-symmetric key, just do normal mc-activate-passwd |
5185 |
|
;; - otherwise, if we are have a cached version of the key, then assume |
5186 |
|
;; it's verified and return it |
5187 |
|
;; - otherwise, prompt for a key, and: |
5188 |
|
;; - if we have a key verifier \(a string value which should decrypt |
5189 |
|
;; against a symmetric key), validate against the verifier |
5190 |
|
;; - if successful, return the verified key |
5191 |
|
;; - if unsuccessful: |
5192 |
|
;; - offer to use the new key |
5193 |
|
;; - if accepted, do confirm process |
5194 |
|
;; - if refused, try again until we get a correctly spelled one or the |
5195 |
|
;; user quits |
5196 |
|
;; - if no key verifier, resolicit the key to get corroboration and return |
5197 |
|
;; the corroborated key if spelled identically, or error if not. |
5198 |
|
|
5199 |
|
(if (not (equal key-type 'symmetric)) |
5200 |
|
;; do regular mc-activate-passwd on non-symmetric key |
5201 |
|
(real-mc-activate-passwd id prompt) |
5202 |
|
|
5203 |
|
;; Symmetric hereon: |
5204 |
|
|
5205 |
|
(save-excursion |
5206 |
|
(set-buffer allout-buffer) |
5207 |
|
(let* ((hint (if (and (not (string= allout-key-hint-string "")) |
5208 |
|
(or (equal allout-key-hint-handling 'always) |
5209 |
|
(and (equal allout-key-hint-handling 'needed) |
5210 |
|
retried))) |
5211 |
|
(format " [%s]" allout-key-hint-string) |
5212 |
|
"")) |
5213 |
|
(retry-message (if retried (format " (%s retry)" retried) "")) |
5214 |
|
(prompt-sans-hint (format "'%s' symmetric key%s: " |
5215 |
|
(buffer-name allout-buffer) |
5216 |
|
retry-message)) |
5217 |
|
(full-prompt (format "'%s' symmetric key%s%s: " |
5218 |
|
(buffer-name allout-buffer) |
5219 |
|
hint retry-message)) |
5220 |
|
(prompt full-prompt) |
5221 |
|
(verifier-string (allout-get-encryption-key-verifier)) |
5222 |
|
;; force retention of cached passwords for five minutes while |
5223 |
|
;; we're in this particular routine: |
5224 |
|
(mc-passwd-timeout 300) |
5225 |
|
(cached (real-mc-activate-passwd id nil)) |
5226 |
|
(got (or cached (real-mc-activate-passwd id full-prompt))) |
5227 |
|
confirmation) |
5228 |
|
|
5229 |
|
(if (not got) |
5230 |
|
nil |
5231 |
|
|
5232 |
|
;; Duplicate our handle on the key so it's not clobbered by |
5233 |
|
;; deactivate-passwd memory clearing: |
5234 |
|
(setq got (format "%s" got)) |
5235 |
|
|
5236 |
|
(cond (verifier-string |
5237 |
|
(if (and (not (allout-encrypt-string |
5238 |
|
verifier-string 'decrypt allout-buffer |
5239 |
|
'symmetric nil 0 'verifying)) |
5240 |
|
(if (yes-or-no-p |
5241 |
|
(concat "Key differs from established" |
5242 |
|
" - use new one instead? ")) |
5243 |
|
;; deactivate password for subsequent |
5244 |
|
;; confirmation: |
5245 |
|
(progn (mc-deactivate-passwd) |
5246 |
|
(setq prompt prompt-sans-hint) |
5247 |
|
nil) |
5248 |
|
t)) |
5249 |
|
(progn (mc-deactivate-passwd) |
5250 |
|
(error "Wrong key.")))) |
5251 |
|
;; Force confirmation by repetition for new key: |
5252 |
|
((or rekey (not cached)) (mc-deactivate-passwd)))) |
5253 |
|
;; we have a key and it's either verified and cached. |
5254 |
|
;; confirmation vs new input - doing mc-activate-passwd will do the |
5255 |
|
;; right thing, in either case: |
5256 |
|
(setq confirmation |
5257 |
|
(real-mc-activate-passwd id (concat prompt |
5258 |
|
" ... confirm spelling: "))) |
5259 |
|
(prog1 |
5260 |
|
(if (equal got confirmation) |
5261 |
|
confirmation |
5262 |
|
(if (yes-or-no-p (concat "spelling of original and" |
5263 |
|
" confirmation differ - retry? ")) |
5264 |
|
(progn (setq retried (if retried (1+ retried) 1)) |
5265 |
|
(mc-deactivate-passwd) |
5266 |
|
;; recurse to this routine: |
5267 |
|
(mc-activate-passwd id prompt-sans-hint)) |
5268 |
|
(mc-deactivate-passwd) |
5269 |
|
(error "Confirmation failed."))) |
5270 |
|
;; reduce opportunity for memory cherry-picking by zeroing duplicate: |
5271 |
|
(dotimes (i (length got)) |
5272 |
|
(aset got i 0)) |
5273 |
|
) |
5274 |
|
) |
5275 |
|
) |
5276 |
|
) |
5277 |
|
) |
5278 |
|
;;;_ > allout-encryption-produce-work-buffer (text) |
5279 |
|
(defun allout-encryption-produce-work-buffer (text) |
5280 |
|
"Establish a new buffer filled with TEXT, for outline encrypion processing. |
5281 |
|
|
5282 |
|
TEXT is massaged so outline collapsing, if any, is removed." |
5283 |
|
(let ((work-buffer (generate-new-buffer " *allout encryption*"))) |
5284 |
|
(save-excursion |
5285 |
|
(set-buffer work-buffer) |
5286 |
|
(insert (subst-char-in-string ?\r ?\n text))) |
5287 |
|
work-buffer)) |
5288 |
|
;;;_ > allout-encrypted-topic-p () |
5289 |
|
(defun allout-encrypted-topic-p () |
5290 |
|
"True if the current topic is encryptable and encrypted." |
5291 |
|
(save-excursion |
5292 |
|
(allout-end-of-prefix t) |
5293 |
|
(and (string= (buffer-substring-no-properties (1- (point)) (point)) |
5294 |
|
allout-topic-encryption-bullet) |
5295 |
|
(looking-at "\\*")) |
5296 |
|
) |
5297 |
|
) |
5298 |
|
;;;_ > allout-encrypted-text-type (text) |
5299 |
|
;;; XXX gpg-specific, not generic! |
5300 |
|
(defun allout-encrypted-text-type (text) |
5301 |
|
"For gpg encrypted text, return 'symmetric or 'keypair." |
5302 |
|
|
5303 |
|
;; Ensure mc-gpg-path has a value: |
5304 |
|
(if (not (boundp 'mc-gpg-path)) |
5305 |
|
(load-library "mc-gpg")) |
5306 |
|
|
5307 |
|
(save-excursion |
5308 |
|
(let* ((work-buffer (set-buffer |
5309 |
|
(allout-encryption-produce-work-buffer text))) |
5310 |
|
(result (mc-gpg-process-region (point-min) (point-max) |
5311 |
|
nil mc-gpg-path |
5312 |
|
'("--batch" "--decrypt") |
5313 |
|
'mc-gpg-decrypt-parser |
5314 |
|
work-buffer nil))) |
5315 |
|
(cond ((equal (nth 0 result) 'symmetric) |
5316 |
|
'symmetric) |
5317 |
|
((equal (nth 0 result) t) |
5318 |
|
'keypair) |
5319 |
|
(t (error "Unrecognized/unsupported encryption type %S" |
5320 |
|
(nth 0 result)))) |
5321 |
|
) |
5322 |
|
) |
5323 |
|
) |
5324 |
|
;;;_ > allout-create-encryption-key-verifier (key id) |
5325 |
|
(defun allout-create-encryption-key-verifier (key id) |
5326 |
|
"Encrypt a random message for later validation of symmetric key." |
5327 |
|
;; use 20 random ascii characters, across the entire ascii range. |
5328 |
|
(random t) |
5329 |
|
(let ((spew (make-string 20 ?\0))) |
5330 |
|
(dotimes (i (length spew)) |
5331 |
|
(aset spew i (1+ (random 254)))) |
5332 |
|
(allout-encrypt-string spew nil nil 'symmetric nil nil t)) |
5333 |
|
) |
5334 |
|
;;;_ > allout-situate-encryption-key-verifier (key id) |
5335 |
|
(defun allout-situate-encryption-key-verifier (key id) |
5336 |
|
"Establish key verifier string on file variable. |
5337 |
|
|
5338 |
|
We also prompt for and situate a new reminder, if reminders are enabled. |
5339 |
|
|
5340 |
|
We massage the string to simplify programmatic adjustment. File variable |
5341 |
|
is `allout-file-key-verifier-string'." |
5342 |
|
(let ((verifier-string |
5343 |
|
;; Collapse to a single line and enclose in string quotes: |
5344 |
|
(subst-char-in-string ?\n ?\C-a |
5345 |
|
(allout-create-encryption-key-verifier |
5346 |
|
key id))) |
5347 |
|
(reminder (if (not (equal allout-key-hint-handling 'disabled)) |
5348 |
|
(read-from-minibuffer |
5349 |
|
"Key hint to jog your memory next time: " |
5350 |
|
allout-key-hint-string)))) |
5351 |
|
(setq allout-key-verifier-string verifier-string) |
5352 |
|
(allout-adjust-file-variable "allout-key-verifier-string" |
5353 |
|
verifier-string) |
5354 |
|
(cond ((equal allout-key-hint-handling 'disabled) |
5355 |
|
nil) |
5356 |
|
((not (string= reminder allout-key-hint-string)) |
5357 |
|
(setq allout-key-hint-string reminder) |
5358 |
|
(allout-adjust-file-variable "allout-key-hint-string" |
5359 |
|
reminder))) |
5360 |
|
) |
5361 |
|
) |
5362 |
|
;;;_ > allout-get-encryption-key-verifier () |
5363 |
|
(defun allout-get-encryption-key-verifier () |
5364 |
|
"Return the text of the encrypt key verifier, unmassaged, or nil if none. |
5365 |
|
|
5366 |
|
Derived from value of `allout-file-key-verifier-string'." |
5367 |
|
|
5368 |
|
(let ((verifier-string (and (boundp 'allout-key-verifier-string) |
5369 |
|
allout-key-verifier-string))) |
5370 |
|
(if verifier-string |
5371 |
|
;; Return it uncollapsed |
5372 |
|
(subst-char-in-string ?\C-a ?\n verifier-string) |
5373 |
|
nil) |
5374 |
|
) |
5375 |
|
) |
5376 |
|
;;;_ > allout-verify-key (key) |
5377 |
|
(defun allout-verify-key (key allout-buffer) |
5378 |
|
"True if key successfully decrypts key verifier, nil otherwise. |
5379 |
|
|
5380 |
|
\"Otherwise\" includes absence of key verifier." |
5381 |
|
(save-excursion |
5382 |
|
(set-buffer allout-buffer) |
5383 |
|
(and (boundp 'allout-key-verifier-string) |
5384 |
|
allout-key-verifier-string |
5385 |
|
(allout-encrypt-string (allout-get-encryption-key-verifier) |
5386 |
|
'decrypt allout-buffer 'symmetric |
5387 |
|
nil nil 'verifying) |
5388 |
|
t))) |
5389 |
|
;;;_ > allout-next-topic-pending-encryption (&optional except-mark) |
5390 |
|
(defun allout-next-topic-pending-encryption (&optional except-mark) |
5391 |
|
"Return the point of the next topic pending encryption, or nil if none. |
5392 |
|
|
5393 |
|
EXCEPT-MARK identifies a point whose containing topics should be excluded |
5394 |
|
from encryption. This supports 'except-current mode of |
5395 |
|
`allout-encrypt-unencrypted-on-saves'. |
5396 |
|
|
5397 |
|
Such a topic has the allout-topic-encryption-bullet without an |
5398 |
|
immediately following '*' that would mark the topic as being encrypted. It |
5399 |
|
must also have content." |
5400 |
|
(let (done got content-beg) |
5401 |
|
(while (not done) |
5402 |
|
|
5403 |
|
(if (not (re-search-forward |
5404 |
|
(format "\\(\\`\\|[\n\r]\\)%s *%s[^*]" |
5405 |
|
(regexp-quote allout-header-prefix) |
5406 |
|
(regexp-quote allout-topic-encryption-bullet)) |
5407 |
|
nil t)) |
5408 |
|
(setq got nil |
5409 |
|
done t) |
5410 |
|
(goto-char (setq got (match-beginning 0))) |
5411 |
|
(if (looking-at "[\n\r]") |
5412 |
|
(forward-char 1)) |
5413 |
|
(setq got (point))) |
5414 |
|
|
5415 |
|
(cond ((not got) |
5416 |
|
(setq done t)) |
5417 |
|
|
5418 |
|
((not (re-search-forward "[\n\r]")) |
5419 |
|
(setq got nil |
5420 |
|
done t)) |
5421 |
|
|
5422 |
|
((eobp) |
5423 |
|
(setq got nil |
5424 |
|
done t)) |
5425 |
|
|
5426 |
|
(t |
5427 |
|
(setq content-beg (point)) |
5428 |
|
(backward-char 1) |
5429 |
|
(allout-end-of-subtree) |
5430 |
|
(if (or (<= (point) content-beg) |
5431 |
|
(and except-mark |
5432 |
|
(<= content-beg except-mark) |
5433 |
|
(>= (point) except-mark))) |
5434 |
|
;; Continue looking |
5435 |
|
(setq got nil) |
5436 |
|
;; Got it! |
5437 |
|
(setq done t))) |
5438 |
|
) |
5439 |
|
) |
5440 |
|
(if got |
5441 |
|
(goto-char got)) |
5442 |
|
) |
5443 |
|
) |
5444 |
|
;;;_ > allout-encrypt-decrypted (&optional except-mark) |
5445 |
|
(defun allout-encrypt-decrypted (&optional except-mark) |
5446 |
|
"Encrypt topics pending encryption except those containing exemption point. |
5447 |
|
|
5448 |
|
EXCEPT-MARK identifies a point whose containing topics should be excluded |
5449 |
|
from encryption. This supports 'except-current mode of |
5450 |
|
`allout-encrypt-unencrypted-on-saves'. |
5451 |
|
|
5452 |
|
If a topic that is currently being edited was encrypted, we return a list |
5453 |
|
containing the location of the topic and the location of the cursor just |
5454 |
|
before the topic was encrypted. This can be used, eg, to decrypt the topic |
5455 |
|
and exactly resituate the cursor if this is being done as part of a file |
5456 |
|
save. See `allout-encrypt-unencrypted-on-saves' for more info." |
5457 |
|
|
5458 |
|
(interactive "p") |
5459 |
|
(save-excursion |
5460 |
|
(let ((current-mark (point-marker)) |
5461 |
|
was-modified |
5462 |
|
bo-subtree |
5463 |
|
editing-topic editing-point) |
5464 |
|
(goto-char (point-min)) |
5465 |
|
(while (allout-next-topic-pending-encryption except-mark) |
5466 |
|
(setq was-modified (buffer-modified-p)) |
5467 |
|
(if (save-excursion |
5468 |
|
(and (boundp 'allout-encrypt-unencrypted-on-saves) |
5469 |
|
allout-encrypt-unencrypted-on-saves |
5470 |
|
(setq bo-subtree (re-search-forward "[\n\r]")) |
5471 |
|
;; Not collapsed: |
5472 |
|
(string= (match-string 0) "\n") |
5473 |
|
(>= current-mark (point)) |
5474 |
|
(allout-end-of-current-subtree) |
5475 |
|
(<= current-mark (point)))) |
5476 |
|
(setq editing-topic (point) |
5477 |
|
;; we had to wait for this 'til now so prior topics are |
5478 |
|
;; encrypted, any relevant text shifts are in place: |
5479 |
|
editing-point (marker-position current-mark))) |
5480 |
|
(allout-toggle-current-subtree-encryption) |
5481 |
|
(if (not was-modified) |
5482 |
|
(set-buffer-modified-p nil)) |
5483 |
|
) |
5484 |
|
(if (not was-modified) |
5485 |
|
(set-buffer-modified-p nil)) |
5486 |
|
(if editing-topic (list editing-topic editing-point)) |
5487 |
|
) |
5488 |
|
) |
5489 |
|
) |
5490 |
|
|
5491 |
|
;;;_ #9 miscellaneous |
5492 |
;;;_ > allout-mark-topic () |
;;;_ > allout-mark-topic () |
5493 |
(defun allout-mark-topic () |
(defun allout-mark-topic () |
5494 |
"Put the region around topic currently containing point." |
"Put the region around topic currently containing point." |
5517 |
t |
t |
5518 |
(allout-open-topic 2) |
(allout-open-topic 2) |
5519 |
(insert (concat "Dummy outline topic header - see" |
(insert (concat "Dummy outline topic header - see" |
5520 |
"`allout-mode' docstring: `^Hm'.")) |
"`allout-mode' docstring: `^Hm'.")) |
5521 |
(forward-line 1) |
(allout-adjust-file-variable |
5522 |
|
"allout-layout" (format "%s" (or allout-layout '(-1 : 0))))))) |
5523 |
|
;;;_ > allout-file-vars-section-data () |
5524 |
|
(defun allout-file-vars-section-data () |
5525 |
|
"Return data identifying the file-vars section, or nil if none. |
5526 |
|
|
5527 |
|
Returns list `(beginning-point prefix-string suffix-string)'." |
5528 |
|
;; minimally gleaned from emacs 21.4 files.el hack-local-variables function. |
5529 |
|
(let (beg prefix suffix) |
5530 |
|
(save-excursion |
5531 |
(goto-char (point-max)) |
(goto-char (point-max)) |
5532 |
(open-line 1) |
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) |
5533 |
(allout-open-topic 0) |
(if (let ((case-fold-search t)) |
5534 |
(insert "Local emacs vars.\n") |
(not (search-forward "Local Variables:" nil t))) |
5535 |
(allout-open-topic 1) |
nil |
5536 |
(insert "(`allout-layout' is for allout.el allout-mode)\n") |
(setq beg (- (point) 16)) |
5537 |
(allout-open-topic 0) |
(setq suffix (buffer-substring-no-properties |
5538 |
(insert "Local variables:\n") |
(point) |
5539 |
(allout-open-topic 0) |
(progn (if (re-search-forward "[\n\r]" nil t) |
5540 |
(insert (format "allout-layout: %s\n" |
(forward-char -1)) |
5541 |
(or allout-layout |
(point)))) |
5542 |
'(-1 : 0)))) |
(setq prefix (buffer-substring-no-properties |
5543 |
(allout-open-topic 0) |
(progn (if (re-search-backward "[\n\r]" nil t) |
5544 |
(insert "End:\n")))) |
(forward-char 1)) |
5545 |
|
(point)) |
5546 |
|
beg)) |
5547 |
|
(list beg prefix suffix)) |
5548 |
|
) |
5549 |
|
) |
5550 |
|
) |
5551 |
|
;;;_ > allout-adjust-file-variable (varname value) |
5552 |
|
(defun allout-adjust-file-variable (varname value) |
5553 |
|
"Adjust the setting of an emacs file variable named VARNAME to VALUE. |
5554 |
|
|
5555 |
|
This activity is inhibited if either `enable-local-variables' |
5556 |
|
`allout-enable-file-variable-adjustment' are nil. |
5557 |
|
|
5558 |
|
When enabled, an entry for the variable is created if not already present, |
5559 |
|
or changed if established with a different value. The section for the file |
5560 |
|
variables, itself, is created if not already present. When created, the |
5561 |
|
section lines \(including the section line) exist as second-level topics in |
5562 |
|
a top-level topic at the end of the file. |
5563 |
|
|
5564 |
|
enable-local-variables must be true for any of this to happen." |
5565 |
|
(if (not (and enable-local-variables |
5566 |
|
allout-enable-file-variable-adjustment)) |
5567 |
|
nil |
5568 |
|
(save-excursion |
5569 |
|
(let ((section-data (allout-file-vars-section-data)) |
5570 |
|
beg prefix suffix) |
5571 |
|
(if section-data |
5572 |
|
(setq beg (car section-data) |
5573 |
|
prefix (cadr section-data) |
5574 |
|
suffix (car (cddr section-data))) |
5575 |
|
;; create the section |
5576 |
|
(goto-char (point-max)) |
5577 |
|
(open-line 1) |
5578 |
|
(allout-open-topic 0) |
5579 |
|
(end-of-line) |
5580 |
|
(insert "Local emacs vars.\n") |
5581 |
|
(allout-open-topic 1) |
5582 |
|
(setq beg (point) |
5583 |
|
suffix "" |
5584 |
|
prefix (buffer-substring-no-properties (progn |
5585 |
|
(beginning-of-line) |
5586 |
|
(point)) |
5587 |
|
beg)) |
5588 |
|
(goto-char beg) |
5589 |
|
(insert "Local variables:\n") |
5590 |
|
(allout-open-topic 0) |
5591 |
|
(insert "End:\n") |
5592 |
|
) |
5593 |
|
;; look for existing entry or create one, leaving point for insertion |
5594 |
|
;; of new value: |
5595 |
|
(goto-char beg) |
5596 |
|
(allout-show-to-offshoot) |
5597 |
|
(if (search-forward (concat "\n" prefix varname ":") nil t) |
5598 |
|
(let* ((value-beg (point)) |
5599 |
|
(line-end (progn (if (re-search-forward "[\n\r]" nil t) |
5600 |
|
(forward-char -1)) |
5601 |
|
(point))) |
5602 |
|
(value-end (- line-end (length suffix)))) |
5603 |
|
(if (> value-end value-beg) |
5604 |
|
(delete-region value-beg value-end))) |
5605 |
|
(end-of-line) |
5606 |
|
(open-line 1) |
5607 |
|
(forward-line 1) |
5608 |
|
(insert (concat prefix varname ":"))) |
5609 |
|
(insert (format " %S%s" value suffix)) |
5610 |
|
) |
5611 |
|
) |
5612 |
|
) |
5613 |
|
) |
5614 |
;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) |
;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) |
5615 |
(defun solicit-char-in-string (prompt string &optional do-defaulting) |
(defun solicit-char-in-string (prompt string &optional do-defaulting) |
5616 |
"Solicit (with first arg PROMPT) choice of a character from string STRING. |
"Solicit (with first arg PROMPT) choice of a character from string STRING. |
5651 |
Representations of actual backslashes - '\\\\\\\\' - are left as a |
Representations of actual backslashes - '\\\\\\\\' - are left as a |
5652 |
single backslash. |
single backslash. |
5653 |
|
|
5654 |
\(fn REGEXP)" |
Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." |
|
;; Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion. |
|
5655 |
|
|
5656 |
(if (string= regexp "") |
(if (string= regexp "") |
5657 |
"" |
"" |
5667 |
(regexp-sans-escapes (substring regexp 1))) |
(regexp-sans-escapes (substring regexp 1))) |
5668 |
;; Exclude first char, but maintain count: |
;; Exclude first char, but maintain count: |
5669 |
(regexp-sans-escapes (substring regexp 1) successive-backslashes)))) |
(regexp-sans-escapes (substring regexp 1) successive-backslashes)))) |
|
;;;_ > my-region-active-p () |
|
|
(defmacro my-region-active-p () |
|
|
(if (fboundp 'region-active-p) |
|
|
'(region-active-p) |
|
|
'mark-active)) |
|
5670 |
;;;_ - add-hook definition for divergent emacsen |
;;;_ - add-hook definition for divergent emacsen |
5671 |
;;;_ > add-hook (hook function &optional append) |
;;;_ > add-hook (hook function &optional append) |
5672 |
(if (not (fboundp 'add-hook)) |
(if (not (fboundp 'add-hook)) |
5687 |
(if append |
(if append |
5688 |
(nconc (symbol-value hook) (list function)) |
(nconc (symbol-value hook) (list function)) |
5689 |
(cons function (symbol-value hook))))))) |
(cons function (symbol-value hook))))))) |
5690 |
|
;;;_ > subst-char-in-string if necessary |
5691 |
|
(if (not (fboundp 'subst-char-in-string)) |
5692 |
|
(defun subst-char-in-string (fromchar tochar string &optional inplace) |
5693 |
|
"Replace FROMCHAR with TOCHAR in STRING each time it occurs. |
5694 |
|
Unless optional argument INPLACE is non-nil, return a new string." |
5695 |
|
(let ((i (length string)) |
5696 |
|
(newstr (if inplace string (copy-sequence string)))) |
5697 |
|
(while (> i 0) |
5698 |
|
(setq i (1- i)) |
5699 |
|
(if (eq (aref newstr i) fromchar) |
5700 |
|
(aset newstr i tochar))) |
5701 |
|
newstr))) |
5702 |
|
|
5703 |
;;;_ : my-mark-marker to accommodate divergent emacsen: |
;;;_ : my-mark-marker to accommodate divergent emacsen: |
5704 |
(defun my-mark-marker (&optional force buffer) |
(defun my-mark-marker (&optional force buffer) |
5705 |
"Accommodate the different signature for `mark-marker' across Emacsen. |
"Accommodate the different signature for `mark-marker' across Emacsen. |
5706 |
|
|
5707 |
XEmacs takes two optional args, while GNU Emacs does not, |
XEmacs takes two optional args, while mainline GNU Emacs does not, |
5708 |
so pass them along when appropriate." |
so pass them along when appropriate." |
5709 |
(if (featurep 'xemacs) |
(if (string-match " XEmacs " emacs-version) |
5710 |
(mark-marker force buffer) |
(mark-marker force buffer) |
5711 |
(mark-marker))) |
(mark-marker))) |
5712 |
|
|
5713 |
;;;_ #9 Under development |
;;;_ #10 Under development |
5714 |
;;;_ > allout-bullet-isearch (&optional bullet) |
;;;_ > allout-bullet-isearch (&optional bullet) |
5715 |
(defun allout-bullet-isearch (&optional bullet) |
(defun allout-bullet-isearch (&optional bullet) |
5716 |
"Isearch \(regexp) for topic with bullet BULLET." |
"Isearch \(regexp) for topic with bullet BULLET." |