aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2005-10-20 14:59:51 +0000
committerEli Zaretskii2005-10-20 14:59:51 +0000
commitd82979ea94a507f59e40558b7129d78ec4676eb0 (patch)
tree74af60f815c5649b8de60c86b212715f382b3810
parent214d5640414ee1a184180a88a7e8072276020921 (diff)
downloademacs-d82979ea94a507f59e40558b7129d78ec4676eb0.tar.gz
emacs-d82979ea94a507f59e40558b7129d78ec4676eb0.zip
Add autoloads of crypt++ and mailcrypt routines, all for encryption
functionality. allout customization subgroup now positioned in `outlines' group instead of prior `editing' group. (allout-encrypt-string, allout-encryption-produce-work-buffer) (allout-encrypted-topic-p, allout-encrypted-text-type) (allout-mc-activate-passwd, allout-create-encryption-key-verifier) (allout-situate-encryption-key-verifier) (allout-get-encryption-key-verifier, allout-verify-key) (allout-next-topic-pending-encryption) (allout-encrypt-decrypted, allout-encrypted-type-prefix): New functions. (outline-topic-encryption-bullet, outline-default-encryption-scheme) (outline-key-verifier-handling, outline-key-hint-handling) (outline-encrypt-unencrypted-on-saves): New defcustoms. (allout-file-key-verifier-string, allout-encryption-scheme) (allout-key-verifier-string, allout-key-hint-string) (allout-after-save-decrypt): New variables. (allout-write-file-hook-handler, allout-auto-save-hook-handler) (allout-after-saves-handler): New hook functions. (allout-post-command-business): Do allout-after-save-decrypt. (allout-enable-file-variable-adjustment): Custom var to enable mechanism for adding and adjusting settings of Emacs file variables. (allout-adjust-file-variable, allout-file-vars-section-data): New functions, implement the mechanism. (outlineify-sticky): Use the file vars mechanism. (allout-inhibit-protection, allout-during-write-cue) (allout-override-protect, allout-before-change-protect): Removed. (allout-flag-region, allout-open-topic): Revised to adjust read-only text. (allout-open-line-not-read-only): Added to facilitate read-only text based protection. (allout-kill-line): Revised to adjust read-only text, clue the user about the inhibition. (allout-unprotected): Robustified with an unwind-protect. (allout-shift-in, allout-shift-out): Disallow manually shifting a topic deeper than the offspring depth of the previous topic - avoiding confusing "containment discontinuities". (allout-reindent-bodies): Fixed retention of body relative hanging indent during promotion of collapsed bodies. (allout-open-topic): Made it easy to open new topic with same bullet as current topic - topic creation functions provided with any universal argument provokes now prompt for bullet, defaulting to the bullet of the previous topic. (allout-plain-bullets-string, allout-distinctive-bullets-string): Plain bullet alternates '.' period and ',' comma only. All other bullets are relegated to special status (but customizable). (allout-end-of-entry): Renamed from 'allout-end-of-current-entry since it actually operates w.r.t. most immediately containing entry, visible or not. (allout-hide-current-entry, allout-show-current-entry): Use the revised version. (allout-old-expose-topic): Solidify deprecation. (allout-end-of-subtree): Added, so we can span concealed as well as visible topics. (allout-end-of-current-subtree): Use `allout-end-of-subtree'. (allout-end-of-current-heading): Tweaked to just respect the first line. (allout-get-body-text): Added. (allout-ascend-to-depth, allout-ascend): Position at end of prefix when invoked interactively. (allout-up-current-level): Use `interactive-p'. (allout-mode, allout-init): Miscellaneous docstring and operational refinements, as well as hookups of new encryption stuff. (allout-beginning-of-current-entry): Now works as advertised. (allout-end-of-current-entry): Relieved of superfluous allout-show-entry. (allout-isearch-rectification): Refine condition for isearching (allout-isearch-abort, allout-enwrap-isearch). (allout-flag-region, my-region-active-p): Relocated some macros. (allout-title): Fallback title is '(buffer-name)', not non-existing '(current-buffer-name)'. (subst-char-in-string): Define if absent (for some XEmacs versions). Corrected commentary 'keywords' to legitimate ones. Updated comentary author info (using my current email address, obscurified).
-rw-r--r--lisp/allout.el1892
1 files changed, 1478 insertions, 414 deletions
diff --git a/lisp/allout.el b/lisp/allout.el
index a64ba4b8f9f..b6c4fa21d2b 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -3,10 +3,10 @@
3;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004,
4;; 2005 Free Software Foundation, Inc. 4;; 2005 Free Software Foundation, Inc.
5 5
6;; Author: Ken Manheimer <klm@zope.com> 6;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
7;; Maintainer: Ken Manheimer <klm@zope.com> 7;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
8;; Created: Dec 1991 - first release to usenet 8;; Created: Dec 1991 - first release to usenet
9;; Keywords: outlines mode wp languages 9;; Keywords: outlines wp languages
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12 12
@@ -34,43 +34,68 @@
34;; programming languages. (For an example, see the allout code 34;; programming languages. (For an example, see the allout code
35;; itself, which is organized in ;; an outline framework.) 35;; itself, which is organized in ;; an outline framework.)
36;; 36;;
37;; In addition to outline navigation and exposure, allout includes: 37;; Some features:
38;; 38;;
39;; - topic-oriented repositioning, cut, and paste 39;; - classic outline-mode topic-oriented navigation and exposure adjustment
40;; - integral outline exposure-layout 40;; - topic-oriented editing including coherent topic and subtopic
41;; - incremental search with dynamic exposure and reconcealment of hidden text 41;; 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.)
42;; - automatic topic-number maintenance 51;; - automatic topic-number maintenance
43;; - "Hot-spot" operation, for single-keystroke maneuvering and 52;; - "hot-spot" operation, for single-keystroke maneuvering and
44;; exposure control. (See the `allout-mode' docstring.) 53;; exposure control (see the allout-mode docstring)
54;; - easy rendering of exposed portions into numbered, latex, indented, etc
55;; outline styles
45;; 56;;
46;; and many other features. 57;; and more.
47;; 58;;
48;; The outline menubar additions provide quick reference to many of 59;; The outline menubar additions provide quick reference to many of
49;; the features, and see the docstring of the function `allout-init' 60;; the features, and see the docstring of the variable `allout-init'
50;; for instructions on priming your Emacs session for automatic 61;; for instructions on priming your emacs session for automatic
51;; activation of `allout-mode'. 62;; activation of allout-mode.
52;; 63;;
53;; See the docstring of the variables `allout-layout' and 64;; See the docstring of the variables `allout-layout' and
54;; `allout-auto-activation' for details on automatic activation of 65;; `allout-auto-activation' for details on automatic activation of
55;; allout `allout-mode' as a minor mode. (It has changed since allout 66;; `allout-mode' as a minor mode. (It has changed since allout
56;; 3.x, for those of you that depend on the old method.) 67;; 3.x, for those of you that depend on the old method.)
57;; 68;;
58;; Note - the lines beginning with `;;;_' are outline topic headers. 69;; Note - the lines beginning with `;;;_' are outline topic headers.
59;; Just `ESC-x eval-current-buffer' to give it a whirl. 70;; Just `ESC-x eval-current-buffer' to give it a whirl.
60 71
61;; Ken Manheimer klm@zope.com 72;; ken manheimer (ken dot manheimer at gmail dot com)
62 73
63;;; Code: 74;;; Code:
64 75
65;;;_* Provide 76;;;_* Provide
77;(provide 'outline)
66(provide 'allout) 78(provide 'allout)
67 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.
89Return 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
68;;;_* USER CUSTOMIZATION VARIABLES: 94;;;_* USER CUSTOMIZATION VARIABLES:
69(defgroup allout nil 95(defgroup allout nil
70 "Extensive outline mode for use alone and with other modes." 96 "Extensive outline mode for use alone and with other modes."
71 :prefix "allout-" 97 :prefix "allout-"
72 :group 'editing 98 :group 'outlines)
73 :version "22.1")
74 99
75;;;_ + Layout, Mode, and Topic Header Configuration 100;;;_ + Layout, Mode, and Topic Header Configuration
76 101
@@ -111,8 +136,8 @@ Buffer-specific.
111 136
112A list value specifies a default layout for the current buffer, to be 137A list value specifies a default layout for the current buffer, to be
113applied upon activation of `allout-mode'. Any non-nil value will 138applied upon activation of `allout-mode'. Any non-nil value will
114automatically trigger `allout-mode', provided `allout-init' 139automatically trigger `allout-mode' \(provided `allout-init' has been called
115has been called to enable it. 140to enable this behavior).
116 141
117See the docstring for `allout-init' for details on setting up for 142See the docstring for `allout-init' for details on setting up for
118auto-mode-activation, and for `allout-expose-topic' for the format of 143auto-mode-activation, and for `allout-expose-topic' for the format of
@@ -171,7 +196,7 @@ bullets."
171 :group 'allout) 196 :group 'allout)
172(make-variable-buffer-local 'allout-primary-bullet) 197(make-variable-buffer-local 'allout-primary-bullet)
173;;;_ = allout-plain-bullets-string 198;;;_ = allout-plain-bullets-string
174(defcustom allout-plain-bullets-string ".:,;" 199(defcustom allout-plain-bullets-string ".,"
175 "*The bullets normally used in outline topic prefixes. 200 "*The bullets normally used in outline topic prefixes.
176 201
177See `allout-distinctive-bullets-string' for the other kind of 202See `allout-distinctive-bullets-string' for the other kind of
@@ -185,7 +210,7 @@ of this var to take effect."
185 :group 'allout) 210 :group 'allout)
186(make-variable-buffer-local 'allout-plain-bullets-string) 211(make-variable-buffer-local 'allout-plain-bullets-string)
187;;;_ = allout-distinctive-bullets-string 212;;;_ = allout-distinctive-bullets-string
188(defcustom allout-distinctive-bullets-string "*+-=>([{}&!?#%\"X@$~_\\" 213(defcustom allout-distinctive-bullets-string "*+-=>()[{}&!?#%\"X@$~_\\:;^"
189 "*Persistent outline header bullets used to distinguish special topics. 214 "*Persistent outline header bullets used to distinguish special topics.
190 215
191These bullets are used to distinguish topics from the run-of-the-mill 216These bullets are used to distinguish topics from the run-of-the-mill
@@ -198,12 +223,13 @@ rebulleting, so they can be used to characterize topics, eg:
198 `?' question topics 223 `?' question topics
199 `\(' parenthetic comment \(with a matching close paren inside) 224 `\(' parenthetic comment \(with a matching close paren inside)
200 `[' meta-note \(with a matching close ] inside) 225 `[' meta-note \(with a matching close ] inside)
201 `\"' a quote 226 `\"' a quotation
202 `=' value settings 227 `=' value settings
203 `~' \"more or less\" 228 `~' \"more or less\"
229 `^' see above
204 230
205... just for example. (`#' typically has a special meaning to the 231 ... for example. (`#' typically has a special meaning to the software,
206software, according to the value of `allout-numbered-bullet'.) 232according to the value of `allout-numbered-bullet'.)
207 233
208See `allout-plain-bullets-string' for the selection of 234See `allout-plain-bullets-string' for the selection of
209alternating bullets. 235alternating bullets.
@@ -337,7 +363,6 @@ disables numbering maintenance."
337Set this var to the bullet you want to use for file cross-references." 363Set this var to the bullet you want to use for file cross-references."
338 :type '(choice (const nil) string) 364 :type '(choice (const nil) string)
339 :group 'allout) 365 :group 'allout)
340
341;;;_ = allout-presentation-padding 366;;;_ = allout-presentation-padding
342(defcustom allout-presentation-padding 2 367(defcustom allout-presentation-padding 2
343 "*Presentation-format white-space padding factor, for greater indent." 368 "*Presentation-format white-space padding factor, for greater indent."
@@ -381,7 +406,7 @@ numbers are always used."
381 :type 'string 406 :type 'string
382 :group 'allout) 407 :group 'allout)
383;;;_ - allout-title 408;;;_ - allout-title
384(defcustom allout-title '(or buffer-file-name (current-buffer-name)) 409(defcustom allout-title '(or buffer-file-name (buffer-name))
385 "*Expression to be evaluated to determine the title for LaTeX 410 "*Expression to be evaluated to determine the title for LaTeX
386formatted copy." 411formatted copy."
387 :type 'sexp 412 :type 'sexp
@@ -397,6 +422,94 @@ formatted copy."
397 :type 'string 422 :type 'string
398 :group 'allout) 423 :group 'allout)
399 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
435See 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
442The key verifier is string associated with a file that is encrypted with
443the file's current symmetric encryption key. It is used, if present, to
444confirm that the key entered by the user is the same as the established
445one, or explicitly presenting the user with the choice to go with a
446new key when a difference is encountered.
447
448The 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
456See the docstring for the `allout-enable-file-variable-adjustment'
457variable 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
472See the docstring for the `allout-enable-file-variable-adjustment'
473variable 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
484The idea is to prevent file-system exposure of any un-encrypted stuff, and
485mostly 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
501For practical reasons, auto-saves always use the 'except-current policy
502when auto-encryption is enabled. \(Otherwise, spurious key prompts and
503unavoidable timing collisions are too disruptive.) If security for a file
504requires that even the current topic is never auto-saved in the clear,
505disable 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
400;;;_ + Miscellaneous customization 513;;;_ + Miscellaneous customization
401 514
402;;;_ = allout-command-prefix 515;;;_ = allout-command-prefix
@@ -422,13 +535,15 @@ unless optional third, non-nil element is present.")
422 ("\C-f" allout-forward-current-level) 535 ("\C-f" allout-forward-current-level)
423 ("\C-b" allout-backward-current-level) 536 ("\C-b" allout-backward-current-level)
424 ("\C-a" allout-beginning-of-current-entry) 537 ("\C-a" allout-beginning-of-current-entry)
425 ("\C-e" allout-end-of-current-entry) 538 ("\C-e" allout-end-of-entry)
426 ; Exposure commands: 539 ; Exposure commands:
427 ("\C-i" allout-show-children) 540 ("\C-i" allout-show-children)
428 ("\C-s" allout-show-current-subtree) 541 ("\C-s" allout-show-current-subtree)
429 ("\C-h" allout-hide-current-subtree) 542 ("\C-h" allout-hide-current-subtree)
543 ("h" allout-hide-current-subtree)
430 ("\C-o" allout-show-current-entry) 544 ("\C-o" allout-show-current-entry)
431 ("!" allout-show-all) 545 ("!" allout-show-all)
546 ("x" allout-toggle-current-subtree-encryption)
432 ; Alteration commands: 547 ; Alteration commands:
433 (" " allout-open-sibtopic) 548 (" " allout-open-sibtopic)
434 ("." allout-open-subtopic) 549 ("." allout-open-subtopic)
@@ -489,19 +604,22 @@ those that do not have the variable `comment-start' set. A value of
489 604
490(make-variable-buffer-local 'allout-reindent-bodies) 605(make-variable-buffer-local 'allout-reindent-bodies)
491 606
492;;;_ = allout-inhibit-protection 607;;;_ = allout-enable-file-variable-adjustment
493(defcustom allout-inhibit-protection nil 608(defcustom allout-enable-file-variable-adjustment t
494 "*Non-nil disables warnings and confirmation-checks for concealed-text edits. 609 "*If non-nil, some allout outline actions can edit Emacs file variables text.
610
611This can range from changes to existing entries, addition of new ones,
612and creation of a new local variables section when necessary.
495 613
496Outline mode uses Emacs change-triggered functions to detect unruly 614Emacs file variables adjustments are also inhibited if `enable-local-variables'
497changes to concealed regions. Set this var non-nil to disable the 615is nil.
498protection, potentially increasing text-entry responsiveness a bit.
499 616
500This var takes effect at `allout-mode' activation, so you may have to 617Operations potentially causing edits include allout encryption routines.
501deactivate and then reactivate the mode if you want to toggle the 618See the docstring for `allout-toggle-current-subtree-encryption' for
502behavior." 619details."
503 :type 'boolean 620 :type 'boolean
504 :group 'allout) 621 :group 'allout)
622(make-variable-buffer-local 'allout-enable-file-variable-adjustment)
505 623
506;;;_* CODE - no user customizations below. 624;;;_* CODE - no user customizations below.
507 625
@@ -509,7 +627,7 @@ behavior."
509;;;_ : Version 627;;;_ : Version
510;;;_ = allout-version 628;;;_ = allout-version
511(defvar allout-version 629(defvar allout-version
512 (let ((rcs-rev "$Revision$")) 630 (let ((rcs-rev "$Revision: 1.68 $"))
513 (condition-case err 631 (condition-case err
514 (save-match-data 632 (save-match-data
515 (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) 633 (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev)
@@ -728,7 +846,16 @@ See doc string for allout-keybindings-list for format of binding list."
728 (car (cdr cell))))))) 846 (car (cdr cell)))))))
729 keymap-list) 847 keymap-list)
730 map)) 848 map))
731 849;;;_ = allout-prior-bindings - being deprecated.
850(defvar allout-prior-bindings nil
851 "Variable for use in V18, with allout-added-bindings, for
852resurrecting, on mode deactivation, bindings that existed before
853activation. 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
857resurrecting, on mode deactivation, bindings that existed before
858activation. Being deprecated.")
732;;;_ : Menu bar 859;;;_ : Menu bar
733(defvar allout-mode-exposure-menu) 860(defvar allout-mode-exposure-menu)
734(defvar allout-mode-editing-menu) 861(defvar allout-mode-editing-menu)
@@ -759,7 +886,11 @@ See doc string for allout-keybindings-list for format of binding list."
759 ["Shift Topic Out" allout-shift-out t] 886 ["Shift Topic Out" allout-shift-out t]
760 ["Rebullet Topic" allout-rebullet-topic t] 887 ["Rebullet Topic" allout-rebullet-topic t]
761 ["Rebullet Heading" allout-rebullet-current-heading t] 888 ["Rebullet Heading" allout-rebullet-current-heading t]
762 ["Number Siblings" allout-number-siblings t])) 889 ["Number Siblings" allout-number-siblings t]
890 "----"
891 ["Toggle Topic Encryption"
892 allout-toggle-current-subtree-encryption
893 (> (allout-current-depth) 1)]))
763 (easy-menu-define allout-mode-navigation-menu 894 (easy-menu-define allout-mode-navigation-menu
764 allout-mode-map 895 allout-mode-map
765 "Allout outline navigation menu." 896 "Allout outline navigation menu."
@@ -775,7 +906,7 @@ See doc string for allout-keybindings-list for format of binding list."
775 "----" 906 "----"
776 ["Beginning of Entry" 907 ["Beginning of Entry"
777 allout-beginning-of-current-entry t] 908 allout-beginning-of-current-entry t]
778 ["End of Entry" allout-end-of-current-entry t] 909 ["End of Entry" allout-end-of-entry t]
779 ["End of Subtree" allout-end-of-current-subtree t])) 910 ["End of Subtree" allout-end-of-current-subtree t]))
780 (easy-menu-define allout-mode-misc-menu 911 (easy-menu-define allout-mode-misc-menu
781 allout-mode-map 912 allout-mode-map
@@ -855,13 +986,6 @@ from the list."
855 (setq allout-mode-prior-settings rebuild))))) 986 (setq allout-mode-prior-settings rebuild)))))
856 ) 987 )
857;;;_ : Mode-specific incidentals 988;;;_ : Mode-specific incidentals
858;;;_ = allout-during-write-cue nil
859(defvar allout-during-write-cue nil
860 "Used to inhibit outline change-protection during file write.
861
862See also `allout-post-command-business', `allout-write-file-hook',
863`allout-before-change-protect', and `allout-post-command-business'
864functions.")
865;;;_ = allout-pre-was-isearching nil 989;;;_ = allout-pre-was-isearching nil
866(defvar allout-pre-was-isearching nil 990(defvar allout-pre-was-isearching nil
867 "Cue for isearch-dynamic-exposure mechanism, implemented in 991 "Cue for isearch-dynamic-exposure mechanism, implemented in
@@ -869,22 +993,28 @@ allout-pre- and -post-command-hooks.")
869(make-variable-buffer-local 'allout-pre-was-isearching) 993(make-variable-buffer-local 'allout-pre-was-isearching)
870;;;_ = allout-isearch-prior-pos nil 994;;;_ = allout-isearch-prior-pos nil
871(defvar allout-isearch-prior-pos nil 995(defvar allout-isearch-prior-pos nil
872 "Cue for isearch-dynamic-exposure tracking, used by `allout-isearch-expose'.") 996 "Cue for isearch-dynamic-exposure tracking, used by
997`allout-isearch-expose'.")
873(make-variable-buffer-local 'allout-isearch-prior-pos) 998(make-variable-buffer-local 'allout-isearch-prior-pos)
874;;;_ = allout-override-protect nil 999;;;_ = allout-isearch-did-quit
875(defvar allout-override-protect nil 1000(defvar allout-isearch-did-quit nil
876 "Used in `allout-mode' for regulate of concealed-text protection mechanism. 1001 "Distinguishes isearch conclusion and cancellation.
877 1002
878Allout outline mode regulates alteration of concealed text to protect 1003Maintained by allout-isearch-abort \(which is wrapped around the real
879against inadvertent, unnoticed changes. This is for use by specific, 1004isearch-abort), and monitored by allout-isearch-expose for action.")
880native outline functions to temporarily override that protection. 1005(make-variable-buffer-local 'allout-isearch-did-quit)
881It's automatically reset to nil after every buffer modification.")
882(make-variable-buffer-local 'allout-override-protect)
883;;;_ > allout-unprotected (expr) 1006;;;_ > allout-unprotected (expr)
884(defmacro allout-unprotected (expression) 1007(defmacro allout-unprotected (expr)
885 "Evaluate EXPRESSION with `allout-override-protect' let-bound to t." 1008 "Enable internal outline operations to alter read-only text."
886 `(let ((allout-override-protect t)) 1009 `(let ((was-inhibit-r-o inhibit-read-only))
887 ,expression)) 1010 (unwind-protect
1011 (progn
1012 (setq inhibit-read-only t)
1013 ,expr)
1014 (setq inhibit-read-only was-inhibit-r-o)
1015 )
1016 )
1017 )
888;;;_ = allout-undo-aggregation 1018;;;_ = allout-undo-aggregation
889(defvar allout-undo-aggregation 30 1019(defvar allout-undo-aggregation 30
890 "Amount of successive self-insert actions to bunch together per undo. 1020 "Amount of successive self-insert actions to bunch together per undo.
@@ -897,14 +1027,109 @@ the way that `before-change-functions' and undo interact.")
897 "Horrible hack used to prevent invalid multiple triggering of outline 1027 "Horrible hack used to prevent invalid multiple triggering of outline
898mode from prop-line file-var activation. Used by `allout-mode' function 1028mode from prop-line file-var activation. Used by `allout-mode' function
899to track repeats.") 1029to track repeats.")
900;;;_ > allout-write-file-hook () 1030;;;_ = allout-file-key-verifier-string
901(defun allout-write-file-hook () 1031(defvar allout-file-key-verifier-string nil
902 "In `allout-mode', run as a `write-contents-functions' activity. 1032 "Name for use as a file variable for verifying encryption key across
903 1033sessions.")
904Currently just sets `allout-during-write-cue', so outline change-protection 1034(make-variable-buffer-local 'allout-file-key-verifier-string)
905knows to keep inactive during file write." 1035;;;_ = allout-encryption-scheme
906 (setq allout-during-write-cue t) 1036(defvar allout-encryption-scheme nil
907 nil) 1037 "*Allout outline topic encryption scheme pending for the current buffer.
1038
1039Intended as a file-specific (buffer local) setting, it defaults to the
1040value 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
1045associated with a file.
1046
1047It consists of an encrypted random string useful only to verify that a key
1048entered by the user is effective for decryption. The key itself is \*not*
1049recorded in the file anywhere, and the encrypted contents are random binary
1050characters to avoid exposing greater susceptibility to search attacks.
1051
1052The verifier string is retained as an Emacs file variable, as well as in
1053the 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
1061See the description of `allout-key-hint-handling' for details about how
1062the reminder is deployed.
1063
1064The hint is retained as an Emacs file variable, as well as in the emacs buffer
1065state, 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
1076This is used to decrypt the topic that was currently being edited, if it
1077was 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
1116Ie, if it was pending encryption and contained the point in its body before
1117the save.
1118
1119We use values stored in `allout-after-save-decrypt' to locate the topic
1120and 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 )
908 1133
909;;;_ #2 Mode activation 1134;;;_ #2 Mode activation
910;;;_ = allout-mode 1135;;;_ = allout-mode
@@ -916,11 +1141,10 @@ knows to keep inactive during file write."
916 'allout-mode) 1141 'allout-mode)
917;;;_ = allout-explicitly-deactivated 1142;;;_ = allout-explicitly-deactivated
918(defvar allout-explicitly-deactivated nil 1143(defvar allout-explicitly-deactivated nil
919 "Non-nil if `allout-mode' was last deliberately deactivated. 1144 "If t, `allout-mode's last deactivation was deliberate.
920So `allout-post-command-business' should not reactivate it...") 1145So `allout-post-command-business' should not reactivate it...")
921(make-variable-buffer-local 'allout-explicitly-deactivated) 1146(make-variable-buffer-local 'allout-explicitly-deactivated)
922;;;_ > allout-init (&optional mode) 1147;;;_ > allout-init (&optional mode)
923;;;###autoload
924(defun allout-init (&optional mode) 1148(defun allout-init (&optional mode)
925 "Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'. 1149 "Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'.
926 1150
@@ -939,9 +1163,9 @@ of allout outline mode, contingent to the buffer-specific setting of
939the `allout-layout' variable. (See `allout-layout' and 1163the `allout-layout' variable. (See `allout-layout' and
940`allout-expose-topic' docstrings for more details on auto layout). 1164`allout-expose-topic' docstrings for more details on auto layout).
941 1165
942`allout-init' works by setting up (or removing) 1166`allout-init' works by setting up (or removing) the `allout-mode'
943`allout-find-file-hook' in `find-file-hook', and giving 1167find-file-hook, and giving `allout-auto-activation' a suitable
944`allout-auto-activation' a suitable setting. 1168setting.
945 1169
946To prime your Emacs session for full auto-outline operation, include 1170To prime your Emacs session for full auto-outline operation, include
947the following two lines in your Emacs init file: 1171the following two lines in your Emacs init file:
@@ -949,32 +1173,35 @@ the following two lines in your Emacs init file:
949\(require 'allout) 1173\(require 'allout)
950\(allout-init t)" 1174\(allout-init t)"
951 1175
952 (interactive 1176 (interactive)
953 (let ((m (completing-read 1177 (if (interactive-p)
954 (concat "Select outline auto setup mode " 1178 (progn
955 "(empty for report, ? for options) ") 1179 (setq mode
956 '(("nil")("full")("activate")("deactivate") 1180 (completing-read
957 ("ask") ("report") ("")) 1181 (concat "Select outline auto setup mode "
958 nil 1182 "(empty for report, ? for options) ")
959 t))) 1183 '(("nil")("full")("activate")("deactivate")
960 (if (string= m "") 'report 1184 ("ask") ("report") (""))
961 (intern-soft m)))) 1185 nil
1186 t))
1187 (if (string= mode "")
1188 (setq mode 'report)
1189 (setq mode (intern-soft mode)))))
962 (let 1190 (let
963 ;; convenience aliases, for consistent ref to respective vars: 1191 ;; convenience aliases, for consistent ref to respective vars:
964 ((hook 'allout-find-file-hook) 1192 ((hook 'allout-find-file-hook)
965 (curr-mode 'allout-auto-activation)) 1193 (curr-mode 'allout-auto-activation))
966 1194
967 (cond ((not mode) 1195 (cond ((not mode)
968 (setq find-file-hook (delq hook find-file-hook)) 1196 (setq find-file-hooks (delq hook find-file-hooks))
969 (if (interactive-p) 1197 (if (interactive-p)
970 (message "Allout outline mode auto-activation inhibited."))) 1198 (message "Allout outline mode auto-activation inhibited.")))
971 ((eq mode 'report) 1199 ((eq mode 'report)
972 (if (memq hook find-file-hook) 1200 (if (not (memq hook find-file-hooks))
973 ;; Just punt and use the reports from each of the modes: 1201 (allout-init nil)
974 (allout-init (symbol-value curr-mode)) 1202 ;; Just punt and use the reports from each of the modes:
975 (allout-init nil) 1203 (allout-init (symbol-value curr-mode))))
976 (message "Allout outline mode auto-activation inhibited."))) 1204 (t (add-hook 'find-file-hooks hook)
977 (t (add-hook 'find-file-hook hook)
978 (set curr-mode ; `set', not `setq'! 1205 (set curr-mode ; `set', not `setq'!
979 (cond ((eq mode 'activate) 1206 (cond ((eq mode 'activate)
980 (message 1207 (message
@@ -1022,10 +1249,11 @@ outline.)
1022 1249
1023In addition to outline navigation and exposure, allout includes: 1250In addition to outline navigation and exposure, allout includes:
1024 1251
1025 - topic-oriented repositioning, cut, and paste 1252 - topic-oriented repositioning, promotion/demotion, cut, and paste
1026 - integral outline exposure-layout 1253 - integral outline exposure-layout
1027 - incremental search with dynamic exposure and reconcealment of hidden text 1254 - incremental search with dynamic exposure and reconcealment of hidden text
1028 - automatic topic-number maintenance 1255 - automatic topic-number maintenance
1256 - easy topic encryption and decryption
1029 - \"Hot-spot\" operation, for single-keystroke maneuvering and 1257 - \"Hot-spot\" operation, for single-keystroke maneuvering and
1030 exposure control. \(See the allout-mode docstring.) 1258 exposure control. \(See the allout-mode docstring.)
1031 1259
@@ -1035,7 +1263,7 @@ Below is a description of the bindings, and then explanation of
1035special `allout-mode' features and terminology. See also the outline 1263special `allout-mode' features and terminology. See also the outline
1036menubar additions for quick reference to many of the features, and see 1264menubar additions for quick reference to many of the features, and see
1037the docstring of the function `allout-init' for instructions on 1265the docstring of the function `allout-init' for instructions on
1038priming your Emacs session for automatic activation of `allout-mode'. 1266priming your emacs session for automatic activation of `allout-mode'.
1039 1267
1040 1268
1041The bindings are dictated by the `allout-keybindings-list' and 1269The bindings are dictated by the `allout-keybindings-list' and
@@ -1048,7 +1276,7 @@ C-c C-p allout-previous-visible-heading | C-c C-i allout-show-children
1048C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree 1276C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree
1049C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry 1277C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry
1050C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all 1278C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all
1051C-c C-e allout-end-of-current-entry | allout-hide-current-leaves 1279C-c C-e allout-end-of-entry | allout-hide-current-leaves
1052C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot 1280C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot
1053 1281
1054 Topic Header Production: 1282 Topic Header Production:
@@ -1064,7 +1292,7 @@ C-c < allout-shift-out ... less deep.
1064C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring 1292C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring
1065 - distinctive bullets are not changed, others 1293 - distinctive bullets are not changed, others
1066 alternated according to nesting depth. 1294 alternated according to nesting depth.
1067C-c * allout-rebullet-current-heading Prompt for alternate bullet for 1295C-c b allout-rebullet-current-heading Prompt for alternate bullet for
1068 current topic. 1296 current topic.
1069C-c # allout-number-siblings Number bullets of topic and siblings - the 1297C-c # allout-number-siblings Number bullets of topic and siblings - the
1070 offspring are not affected. With repeat 1298 offspring are not affected. With repeat
@@ -1087,8 +1315,8 @@ M-x outlineify-sticky Activate outline mode for current buffer,
1087C-c C-SPC allout-mark-topic 1315C-c C-SPC allout-mark-topic
1088C-c = c allout-copy-exposed-to-buffer 1316C-c = c allout-copy-exposed-to-buffer
1089 Duplicate outline, sans concealed text, to 1317 Duplicate outline, sans concealed text, to
1090 buffer with name derived from derived from 1318 buffer with name derived from derived from that
1091 that of current buffer - \"*XXX exposed*\". 1319 of current buffer - \"*BUFFERNAME exposed*\".
1092C-c = p allout-flatten-exposed-to-buffer 1320C-c = p allout-flatten-exposed-to-buffer
1093 Like above 'copy-exposed', but convert topic 1321 Like above 'copy-exposed', but convert topic
1094 prefixes to section.subsection... numeric 1322 prefixes to section.subsection... numeric
@@ -1096,6 +1324,19 @@ C-c = p allout-flatten-exposed-to-buffer
1096ESC ESC (allout-init t) Setup Emacs session for outline mode 1324ESC ESC (allout-init t) Setup Emacs session for outline mode
1097 auto-activation. 1325 auto-activation.
1098 1326
1327 Encrypted Entries
1328
1329Outline mode supports easily togglable gpg encryption of topics, with
1330niceities like support for symmetric and key-pair modes, key timeout, key
1331consistency checking, user-provided hinting for symmetric key mode, and
1332auto-encryption of topics pending encryption on save. The aim is to enable
1333reliable topic privacy while preventing accidents like neglected
1334encryption, encryption with a mistaken key, forgetting which key was used,
1335and other practical pitfalls.
1336
1337See the `allout-toggle-current-subtree-encryption' function and
1338`allout-encrypt-unencrypted-on-saves' customization variable for details.
1339
1099 HOT-SPOT Operation 1340 HOT-SPOT Operation
1100 1341
1101Hot-spot operation provides a means for easy, single-keystroke outline 1342Hot-spot operation provides a means for easy, single-keystroke outline
@@ -1148,11 +1389,11 @@ Topic text constituents:
1148 1389
1149HEADER: The first line of a topic, include the topic PREFIX and header 1390HEADER: The first line of a topic, include the topic PREFIX and header
1150 text. 1391 text.
1151PREFIX: The leading text of a topic which distinguishes it from 1392PREFIX: The leading text of a topic which distinguishes it from normal
1152 normal text. It has a strict form, which consists of a 1393 text. It has a strict form, which consists of a prefix-lead
1153 prefix-lead string, padding, and a bullet. The bullet may be 1394 string, padding, and a bullet. The bullet may be followed by a
1154 followed by a number, indicating the ordinal number of the 1395 number, indicating the ordinal number of the topic among its
1155 topic among its siblings, a space, and then the header text. 1396 siblings, a space, and then the header text.
1156 1397
1157 The relative length of the PREFIX determines the nesting depth 1398 The relative length of the PREFIX determines the nesting depth
1158 of the topic. 1399 of the topic.
@@ -1223,7 +1464,7 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1223 ;; off on second invocation, so we detect it as best we can, and 1464 ;; off on second invocation, so we detect it as best we can, and
1224 ;; skip everything. 1465 ;; skip everything.
1225 ((and same-complex-command ; Still in same complex command 1466 ((and same-complex-command ; Still in same complex command
1226 ; as last time `allout-mode' invoked. 1467 ; as last time `allout-mode' invoked.
1227 active ; Already activated. 1468 active ; Already activated.
1228 (not explicit-activation) ; Prop-line file-vars don't have args. 1469 (not explicit-activation) ; Prop-line file-vars don't have args.
1229 (string-match "^19.1[89]" ; Bug only known to be in v19.18 and 1470 (string-match "^19.1[89]" ; Bug only known to be in v19.18 and
@@ -1238,6 +1479,19 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1238 ; active state or *de*activation 1479 ; active state or *de*activation
1239 ; specifically requested: 1480 ; specifically requested:
1240 (setq allout-explicitly-deactivated t) 1481 (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)))
1241 1495
1242 (if allout-old-style-prefixes 1496 (if allout-old-style-prefixes
1243 (progn 1497 (progn
@@ -1246,9 +1500,12 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1246 (allout-resumptions 'selective-display) 1500 (allout-resumptions 'selective-display)
1247 (if (and (boundp 'before-change-functions) before-change-functions) 1501 (if (and (boundp 'before-change-functions) before-change-functions)
1248 (allout-resumptions 'before-change-functions)) 1502 (allout-resumptions 'before-change-functions))
1249 (setq write-contents-functions 1503 (setq local-write-file-hooks
1250 (delq 'allout-write-file-hook 1504 (delq 'allout-write-file-hook-handler
1251 write-contents-functions)) 1505 local-write-file-hooks))
1506 (setq auto-save-hook
1507 (delq 'allout-auto-save-hook-handler
1508 auto-save-hook))
1252 (allout-resumptions 'paragraph-start) 1509 (allout-resumptions 'paragraph-start)
1253 (allout-resumptions 'paragraph-separate) 1510 (allout-resumptions 'paragraph-separate)
1254 (allout-resumptions (if (string-match "^18" emacs-version) 1511 (allout-resumptions (if (string-match "^18" emacs-version)
@@ -1288,25 +1545,27 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1288 (cons '(allout-mode . allout-mode-map) 1545 (cons '(allout-mode . allout-mode-map)
1289 minor-mode-map-alist)))) 1546 minor-mode-map-alist))))
1290 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)))
1291 ; and add them: 1555 ; and add them:
1292 (use-local-map (produce-allout-mode-map allout-keybindings-list 1556 (use-local-map (produce-allout-mode-map allout-keybindings-list
1293 (current-local-map))) 1557 (current-local-map)))
1294 ) 1558 )
1295 1559
1296 ; selective-display is the 1560 ; selective-display is the
1297 ; Emacs conditional exposure 1561 ; emacs conditional exposure
1298 ; mechanism: 1562 ; mechanism:
1299 (allout-resumptions 'selective-display '(t)) 1563 (allout-resumptions 'selective-display '(t))
1300 (if allout-inhibit-protection
1301 t
1302 (allout-resumptions 'before-change-functions
1303 '(allout-before-change-protect)))
1304 (add-hook 'pre-command-hook 'allout-pre-command-business) 1564 (add-hook 'pre-command-hook 'allout-pre-command-business)
1305 (add-hook 'post-command-hook 'allout-post-command-business) 1565 (add-hook 'post-command-hook 'allout-post-command-business)
1306 ; Temporarily set by any outline 1566 (add-hook 'local-write-file-hooks 'allout-write-file-hook-handler)
1307 ; functions that can be trusted to 1567 (make-variable-buffer-local 'auto-save-hook)
1308 ; deal properly with concealed text. 1568 (add-hook 'auto-save-hook 'allout-auto-save-hook-handler)
1309 (add-hook 'write-contents-functions 'allout-write-file-hook)
1310 ; Custom auto-fill func, to support 1569 ; Custom auto-fill func, to support
1311 ; respect for topic headline, 1570 ; respect for topic headline,
1312 ; hanging-indents, etc: 1571 ; hanging-indents, etc:
@@ -1337,7 +1596,8 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1337 (if allout-layout 1596 (if allout-layout
1338 (setq do-layout t)) 1597 (setq do-layout t))
1339 1598
1340 (if allout-isearch-dynamic-expose 1599 (if (and allout-isearch-dynamic-expose
1600 (not (fboundp 'allout-real-isearch-abort)))
1341 (allout-enwrap-isearch)) 1601 (allout-enwrap-isearch))
1342 1602
1343 (run-hooks 'allout-mode-hook) 1603 (run-hooks 'allout-mode-hook)
@@ -1376,7 +1636,6 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1376 ) ; let* 1636 ) ; let*
1377 ) ; defun 1637 ) ; defun
1378;;;_ > allout-minor-mode 1638;;;_ > allout-minor-mode
1379;;; XXX released verion doesn't do this?
1380(defalias 'allout-minor-mode 'allout-mode) 1639(defalias 'allout-minor-mode 'allout-mode)
1381 1640
1382;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs 1641;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs
@@ -1400,12 +1659,12 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1400 "Buffer point last returned by `allout-end-of-current-subtree'.") 1659 "Buffer point last returned by `allout-end-of-current-subtree'.")
1401(make-variable-buffer-local 'allout-recent-end-of-subtree) 1660(make-variable-buffer-local 'allout-recent-end-of-subtree)
1402;;;_ > allout-prefix-data (beg end) 1661;;;_ > allout-prefix-data (beg end)
1403(defmacro allout-prefix-data (beginning end) 1662(defmacro allout-prefix-data (beg end)
1404 "Register allout-prefix state data - BEGINNING and END of prefix. 1663 "Register allout-prefix state data - BEGINNING and END of prefix.
1405 1664
1406For reference by `allout-recent' funcs. Returns BEGINNING." 1665For reference by `allout-recent' funcs. Returns BEGINNING."
1407 `(setq allout-recent-prefix-end ,end 1666 `(setq allout-recent-prefix-end ,end
1408 allout-recent-prefix-beginning ,beginning)) 1667 allout-recent-prefix-beginning ,beg))
1409;;;_ > allout-recent-depth () 1668;;;_ > allout-recent-depth ()
1410(defmacro allout-recent-depth () 1669(defmacro allout-recent-depth ()
1411 "Return depth of last heading encountered by an outline maneuvering function. 1670 "Return depth of last heading encountered by an outline maneuvering function.
@@ -1612,9 +1871,12 @@ Return the location of the beginning of the heading, or nil if not found."
1612 "Produce a location \"chart\" of subtopics of the containing topic. 1871 "Produce a location \"chart\" of subtopics of the containing topic.
1613 1872
1614Optional argument LEVELS specifies the depth \(relative to start 1873Optional argument LEVELS specifies the depth \(relative to start
1615depth) for the chart. 1874depth) for the chart. Subsequent optional args are not for public
1875use.
1876
1877Point is left at the end of the subtree.
1616 1878
1617Charts are used to capture outline structure, so that outline altering 1879Charts are used to capture outline structure, so that outline-altering
1618routines need assess the structure only once, and then use the chart 1880routines need assess the structure only once, and then use the chart
1619for their elaborate manipulations. 1881for their elaborate manipulations.
1620 1882
@@ -1625,11 +1887,9 @@ list containing, recursively, the charts for the respective subtopics.
1625The chart for a topics' offspring precedes the entry for the topic 1887The chart for a topics' offspring precedes the entry for the topic
1626itself. 1888itself.
1627 1889
1628\(fn &optional LEVELS)" 1890The other function parameters are for internal recursion, and should
1629 1891not be specified by external callers. ORIG-DEPTH is depth of topic at
1630 ;; The other function parameters are for internal recursion, and should 1892starting point, and PREV-DEPTH is depth of prior topic."
1631 ;; not be specified by external callers. ORIG-DEPTH is depth of topic at
1632 ;; starting point, and PREV-DEPTH is depth of prior topic."
1633 1893
1634 (let ((original (not orig-depth)) ; `orig-depth' set only in recursion. 1894 (let ((original (not orig-depth)) ; `orig-depth' set only in recursion.
1635 chart curr-depth) 1895 chart curr-depth)
@@ -1835,11 +2095,18 @@ Returns that character position."
1835 (if (re-search-forward allout-line-boundary-regexp nil 'move) 2095 (if (re-search-forward allout-line-boundary-regexp nil 'move)
1836 (prog1 (goto-char (match-beginning 0)) 2096 (prog1 (goto-char (match-beginning 0))
1837 (allout-prefix-data (match-beginning 2)(match-end 2))))) 2097 (allout-prefix-data (match-beginning 2)(match-end 2)))))
1838;;;_ > allout-end-of-current-subtree () 2098;;;_ > allout-end-of-subtree (&optional current)
1839(defun allout-end-of-current-subtree () 2099(defun allout-end-of-subtree (&optional current)
1840 "Put point at the end of the last leaf in the currently visible topic." 2100 "Put point at the end of the last leaf in the containing topic.
1841 (interactive) 2101
1842 (allout-back-to-current-heading) 2102If optional CURRENT is true (default false), then put point at the end of
2103the containing visible topic.
2104
2105Returns the value of point."
2106 (interactive "P")
2107 (if current
2108 (allout-back-to-current-heading)
2109 (allout-goto-prefix))
1843 (let ((level (allout-recent-depth))) 2110 (let ((level (allout-recent-depth)))
1844 (allout-next-heading) 2111 (allout-next-heading)
1845 (while (and (not (eobp)) 2112 (while (and (not (eobp))
@@ -1851,9 +2118,16 @@ Returns that character position."
1851 '(?\n ?\r)) 2118 '(?\n ?\r))
1852 (forward-char -1)) 2119 (forward-char -1))
1853 (setq allout-recent-end-of-subtree (point)))) 2120 (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
2125Returns the value of point."
2126 (interactive)
2127 (allout-end-of-subtree t))
1854;;;_ > allout-beginning-of-current-entry () 2128;;;_ > allout-beginning-of-current-entry ()
1855(defun allout-beginning-of-current-entry () 2129(defun allout-beginning-of-current-entry ()
1856 "When not already there, position point at beginning of current topic's body. 2130 "When not already there, position point at beginning of current topic header.
1857 2131
1858If already there, move cursor to bullet for hot-spot operation. 2132If already there, move cursor to bullet for hot-spot operation.
1859\(See `allout-mode' doc string for details on hot-spot operation.)" 2133\(See `allout-mode' doc string for details on hot-spot operation.)"
@@ -1863,11 +2137,10 @@ If already there, move cursor to bullet for hot-spot operation.
1863 (if (and (interactive-p) 2137 (if (and (interactive-p)
1864 (= (point) start-point)) 2138 (= (point) start-point))
1865 (goto-char (allout-current-bullet-pos))))) 2139 (goto-char (allout-current-bullet-pos)))))
1866;;;_ > allout-end-of-current-entry () 2140;;;_ > allout-end-of-entry ()
1867(defun allout-end-of-current-entry () 2141(defun allout-end-of-entry ()
1868 "Position the point at the end of the current topics' entry." 2142 "Position the point at the end of the current topics' entry."
1869 (interactive) 2143 (interactive)
1870 (allout-show-entry)
1871 (prog1 (allout-pre-next-preface) 2144 (prog1 (allout-pre-next-preface)
1872 (if (and (not (bobp))(looking-at "^$")) 2145 (if (and (not (bobp))(looking-at "^$"))
1873 (forward-char -1)))) 2146 (forward-char -1))))
@@ -1875,9 +2148,27 @@ If already there, move cursor to bullet for hot-spot operation.
1875(defun allout-end-of-current-heading () 2148(defun allout-end-of-current-heading ()
1876 (interactive) 2149 (interactive)
1877 (allout-beginning-of-current-entry) 2150 (allout-beginning-of-current-entry)
1878 (forward-line -1) 2151 (re-search-forward "[\n\r]" nil t)
1879 (end-of-line)) 2152 (forward-char -1))
1880(defalias 'allout-end-of-heading 'allout-end-of-current-heading) 2153(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 )
1881 2172
1882;;;_ - Depth-wise 2173;;;_ - Depth-wise
1883;;;_ > allout-ascend-to-depth (depth) 2174;;;_ > allout-ascend-to-depth (depth)
@@ -1892,12 +2183,16 @@ If already there, move cursor to bullet for hot-spot operation.
1892 (if (= (allout-recent-depth) depth) 2183 (if (= (allout-recent-depth) depth)
1893 (progn (goto-char allout-recent-prefix-beginning) 2184 (progn (goto-char allout-recent-prefix-beginning)
1894 depth) 2185 depth)
1895 (goto-char last-good))))) 2186 (goto-char last-good)
2187 nil))
2188 (if (interactive-p) (allout-end-of-prefix))))
1896;;;_ > allout-ascend () 2189;;;_ > allout-ascend ()
1897(defun allout-ascend () 2190(defun allout-ascend ()
1898 "Ascend one level, returning t if successful, nil if not." 2191 "Ascend one level, returning t if successful, nil if not."
1899 (if (allout-beginning-of-level) 2192 (prog1
1900 (allout-previous-heading))) 2193 (if (allout-beginning-of-level)
2194 (allout-previous-heading))
2195 (if (interactive-p) (allout-end-of-prefix))))
1901;;;_ > allout-descend-to-depth (depth) 2196;;;_ > allout-descend-to-depth (depth)
1902(defun allout-descend-to-depth (depth) 2197(defun allout-descend-to-depth (depth)
1903 "Descend to depth DEPTH within current topic. 2198 "Descend to depth DEPTH within current topic.
@@ -1917,13 +2212,13 @@ Returning depth if successful, nil if not."
1917 nil)) 2212 nil))
1918 ) 2213 )
1919;;;_ > allout-up-current-level (arg &optional dont-complain) 2214;;;_ > allout-up-current-level (arg &optional dont-complain)
1920(defun allout-up-current-level (arg &optional dont-complain interactive) 2215(defun allout-up-current-level (arg &optional dont-complain)
1921 "Move out ARG levels from current visible topic. 2216 "Move out ARG levels from current visible topic.
1922 2217
1923Positions on heading line of containing topic. Error if unable to 2218Positions on heading line of containing topic. Error if unable to
1924ascend that far, or nil if unable to ascend but optional arg 2219ascend that far, or nil if unable to ascend but optional arg
1925DONT-COMPLAIN is non-nil." 2220DONT-COMPLAIN is non-nil."
1926 (interactive "p\np") 2221 (interactive "p")
1927 (allout-back-to-current-heading) 2222 (allout-back-to-current-heading)
1928 (let ((present-level (allout-recent-depth)) 2223 (let ((present-level (allout-recent-depth))
1929 (last-good (point)) 2224 (last-good (point))
@@ -1944,12 +2239,12 @@ DONT-COMPLAIN is non-nil."
1944 (if (or failed 2239 (if (or failed
1945 (> arg 0)) 2240 (> arg 0))
1946 (progn (goto-char last-good) 2241 (progn (goto-char last-good)
1947 (if interactive (allout-end-of-prefix)) 2242 (if (interactive-p) (allout-end-of-prefix))
1948 (if (not dont-complain) 2243 (if (not dont-complain)
1949 (error "Can't ascend past outermost level") 2244 (error "Can't ascend past outermost level")
1950 (if interactive (allout-end-of-prefix)) 2245 (if (interactive-p) (allout-end-of-prefix))
1951 nil)) 2246 nil))
1952 (if interactive (allout-end-of-prefix)) 2247 (if (interactive-p) (allout-end-of-prefix))
1953 allout-recent-prefix-beginning))) 2248 allout-recent-prefix-beginning)))
1954 2249
1955;;;_ - Linear 2250;;;_ - Linear
@@ -1981,7 +2276,7 @@ Return depth if successful, nil otherwise."
1981 nil)))) 2276 nil))))
1982;;;_ > allout-previous-sibling (&optional depth backward) 2277;;;_ > allout-previous-sibling (&optional depth backward)
1983(defun allout-previous-sibling (&optional depth backward) 2278(defun allout-previous-sibling (&optional depth backward)
1984 "Like `allout-forward-current-level', but backwards & respect invisible topics. 2279 "Like `allout-forward-current-level' backwards, respecting invisible topics.
1985 2280
1986Optional DEPTH specifies depth to traverse, default current depth. 2281Optional DEPTH specifies depth to traverse, default current depth.
1987 2282
@@ -2015,7 +2310,7 @@ Presumes point is at the start of a topic prefix."
2015 (let ((depth (allout-depth))) 2310 (let ((depth (allout-depth)))
2016 (while (allout-previous-sibling depth nil)) 2311 (while (allout-previous-sibling depth nil))
2017 (prog1 (allout-recent-depth) 2312 (prog1 (allout-recent-depth)
2018 (allout-end-of-prefix)))) 2313 (if (interactive-p) (allout-end-of-prefix)))))
2019;;;_ > allout-next-visible-heading (arg) 2314;;;_ > allout-next-visible-heading (arg)
2020(defun allout-next-visible-heading (arg) 2315(defun allout-next-visible-heading (arg)
2021 "Move to the next ARG'th visible heading line, backward if arg is negative. 2316 "Move to the next ARG'th visible heading line, backward if arg is negative.
@@ -2053,13 +2348,13 @@ matches)."
2053 (interactive "p") 2348 (interactive "p")
2054 (allout-next-visible-heading (- arg))) 2349 (allout-next-visible-heading (- arg)))
2055;;;_ > allout-forward-current-level (arg) 2350;;;_ > allout-forward-current-level (arg)
2056(defun allout-forward-current-level (arg &optional interactive) 2351(defun allout-forward-current-level (arg)
2057 "Position point at the next heading of the same level. 2352 "Position point at the next heading of the same level.
2058 2353
2059Takes optional repeat-count, goes backward if count is negative. 2354Takes optional repeat-count, goes backward if count is negative.
2060 2355
2061Returns resulting position, else nil if none found." 2356Returns resulting position, else nil if none found."
2062 (interactive "p\np") 2357 (interactive "p")
2063 (let ((start-depth (allout-current-depth)) 2358 (let ((start-depth (allout-current-depth))
2064 (start-point (point)) 2359 (start-point (point))
2065 (start-arg arg) 2360 (start-arg arg)
@@ -2087,7 +2382,7 @@ Returns resulting position, else nil if none found."
2087 (= (allout-recent-depth) start-depth))) 2382 (= (allout-recent-depth) start-depth)))
2088 allout-recent-prefix-beginning 2383 allout-recent-prefix-beginning
2089 (goto-char last-good) 2384 (goto-char last-good)
2090 (if (not interactive) 2385 (if (not (interactive-p))
2091 nil 2386 nil
2092 (allout-end-of-prefix) 2387 (allout-end-of-prefix)
2093 (error "Hit %s level %d topic, traversed %d of %d requested" 2388 (error "Hit %s level %d topic, traversed %d of %d requested"
@@ -2096,10 +2391,10 @@ Returns resulting position, else nil if none found."
2096 (- (abs start-arg) arg) 2391 (- (abs start-arg) arg)
2097 (abs start-arg)))))) 2392 (abs start-arg))))))
2098;;;_ > allout-backward-current-level (arg) 2393;;;_ > allout-backward-current-level (arg)
2099(defun allout-backward-current-level (arg &optional interactive) 2394(defun allout-backward-current-level (arg)
2100 "Inverse of `allout-forward-current-level'." 2395 "Inverse of `allout-forward-current-level'."
2101 (interactive "p\np") 2396 (interactive "p")
2102 (if interactive 2397 (if (interactive-p)
2103 (let ((current-prefix-arg (* -1 arg))) 2398 (let ((current-prefix-arg (* -1 arg)))
2104 (call-interactively 'allout-forward-current-level)) 2399 (call-interactively 'allout-forward-current-level))
2105 (allout-forward-current-level (* -1 arg)))) 2400 (allout-forward-current-level (* -1 arg))))
@@ -2107,121 +2402,6 @@ Returns resulting position, else nil if none found."
2107;;;_ #5 Alteration 2402;;;_ #5 Alteration
2108 2403
2109;;;_ - Fundamental 2404;;;_ - Fundamental
2110;;;_ > allout-before-change-protect (beg end)
2111(defun allout-before-change-protect (beg end)
2112 "Outline before-change hook, regulates changes to concealed text.
2113
2114Reveal concealed text that would be changed by current command, and
2115offer user choice to commit or forego the change. Unchanged text is
2116reconcealed. User has option to have changed text reconcealed.
2117
2118Undo commands are specially treated - the user is not prompted for
2119choice, the undoes are always committed (based on presumption that the
2120things being undone were already subject to this regulation routine),
2121and undoes always leave the changed stuff exposed.
2122
2123Changes to concealed regions are ignored while file is being written.
2124\(This is for the sake of functions that do change the file during
2125writes, like crypt and zip modes.)
2126
2127Locally bound in outline buffers to `before-change-functions', which
2128in Emacs 19 is run before any change to the buffer.
2129
2130Any functions which set [`this-command' to `undo', or which set]
2131`allout-override-protect' non-nil (as does, eg, allout-flag-chars)
2132are exempt from this restriction."
2133 (if (and (allout-mode-p)
2134 ; allout-override-protect
2135 ; set by functions that know what
2136 ; they're doing, eg outline internals:
2137 (not allout-override-protect)
2138 (not allout-during-write-cue)
2139 (save-match-data ; Preserve operation position state.
2140 ; Both beginning and end chars must
2141 ; be exposed:
2142 (save-excursion (if (memq this-command '(newline open-line))
2143 ;; Compensate for stupid Emacs {new,
2144 ;; open-}line display optimization:
2145 (setq beg (1+ beg)
2146 end (1+ end)))
2147 (goto-char beg)
2148 (or (allout-hidden-p)
2149 (and (not (= beg end))
2150 (goto-char end)
2151 (allout-hidden-p))))))
2152 (save-match-data
2153 (if (equal this-command 'undo)
2154 ;; Allow undo without inhibition.
2155 ;; - Undoing new and open-line hits stupid Emacs redisplay
2156 ;; optimization (em 19 cmds.c, ~ line 200).
2157 ;; - Presumably, undoing what was properly protected when
2158 ;; done.
2159 ;; - Undo may be users' only recourse in protection faults.
2160 ;; So, expose what getting changed:
2161 (progn (message "Undo! - exposing concealed target...")
2162 (if (allout-hidden-p)
2163 (allout-show-children))
2164 (message "Undo!"))
2165 (let (response
2166 (rehide-completely (save-excursion (allout-goto-prefix)
2167 (allout-hidden-p)))
2168 rehide-place)
2169
2170 (save-excursion
2171 (if (condition-case err
2172 ;; Condition case to catch keyboard quits during reads.
2173 (progn
2174 ; Give them a peek where
2175 (save-excursion
2176 (if (eolp) (setq rehide-place
2177 (allout-goto-prefix)))
2178 (allout-show-entry))
2179 ; Present the message, but...
2180 ; leave the cursor at the location
2181 ; until they respond:
2182 ; Then interpret the response:
2183 (while
2184 (progn
2185 (message (concat "Change inside concealed"
2186 " region - do it? "
2187 "(n or 'y'/'r'eclose)"))
2188 (setq response (read-char))
2189 (not
2190 (cond ((memq response '(?r ?R))
2191 (setq response 'reclose))
2192 ((memq response '(?y ?Y ? ))
2193 (setq response t))
2194 ((memq response '(?n ?N 127))
2195 (setq response nil)
2196 t)
2197 ((eq response ??)
2198 (message
2199 "`r' means `yes, then reclose'")
2200 nil)
2201 (t (message "Please answer y, n, or r")
2202 (sit-for 1)
2203 nil)))))
2204 response)
2205 ('quit nil))
2206 ; Continue:
2207 (if (eq response 'reclose)
2208 (save-excursion
2209 (if rehide-place (goto-char rehide-place))
2210 (if rehide-completely
2211 (allout-hide-current-entry-completely)
2212 (allout-hide-current-entry)))
2213 (if (allout-ascend-to-depth (1- (allout-recent-depth)))
2214 (allout-show-children)
2215 (allout-show-to-offshoot)))
2216 ; Prevent:
2217 (if rehide-completely
2218 (save-excursion
2219 (if rehide-place (goto-char rehide-place))
2220 (allout-hide-current-entry-completely))
2221 (allout-hide-current-entry))
2222 (error "Change within concealed region prevented"))))))
2223 ) ; if
2224 ) ; defun
2225;;;_ = allout-post-goto-bullet 2405;;;_ = allout-post-goto-bullet
2226(defvar allout-post-goto-bullet nil 2406(defvar allout-post-goto-bullet nil
2227 "Outline internal var, for `allout-pre-command-business' hot-spot operation. 2407 "Outline internal var, for `allout-pre-command-business' hot-spot operation.
@@ -2236,24 +2416,20 @@ are mapped to the command of the corresponding control-key on the
2236(defun allout-post-command-business () 2416(defun allout-post-command-business ()
2237 "Outline `post-command-hook' function. 2417 "Outline `post-command-hook' function.
2238 2418
2239- Null `allout-override-protect', so it's not left open.
2240
2241- Implement (and clear) `allout-post-goto-bullet', for hot-spot 2419- Implement (and clear) `allout-post-goto-bullet', for hot-spot
2242 outline commands. 2420 outline commands.
2243 2421
2244- Massages `buffer-undo-list' so successive, standard character self-inserts 2422- Decrypt topic currently being edited if it was encrypted for a save.
2245 are aggregated. This kludge compensates for lack of undo bunching when 2423
2246 `before-change-functions' is used." 2424- 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."
2247 2427
2248 ; Apply any external change func: 2428 ; Apply any external change func:
2249 (if (not (allout-mode-p)) ; In allout-mode. 2429 (if (not (allout-mode-p)) ; In allout-mode.
2250 nil 2430 nil
2251 (setq allout-override-protect nil)
2252 (if allout-isearch-dynamic-expose 2431 (if allout-isearch-dynamic-expose
2253 (allout-isearch-rectification)) 2432 (allout-isearch-rectification))
2254 (if allout-during-write-cue
2255 ;; Was used by allout-before-change-protect, done with it now:
2256 (setq allout-during-write-cue nil))
2257 ;; Undo bunching business: 2433 ;; Undo bunching business:
2258 (if (and (listp buffer-undo-list) ; Undo history being kept. 2434 (if (and (listp buffer-undo-list) ; Undo history being kept.
2259 (equal this-command 'self-insert-command) 2435 (equal this-command 'self-insert-command)
@@ -2282,6 +2458,11 @@ are mapped to the command of the corresponding control-key on the
2282 (setq buffer-undo-list 2458 (setq buffer-undo-list
2283 (cons (cons prev-from cur-to) 2459 (cons (cons prev-from cur-to)
2284 (cdr (cdr (cdr buffer-undo-list)))))))) 2460 (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
2285 ;; Implement -post-goto-bullet, if set: (must be after undo business) 2466 ;; Implement -post-goto-bullet, if set: (must be after undo business)
2286 (if (and allout-post-goto-bullet 2467 (if (and allout-post-goto-bullet
2287 (allout-current-bullet-pos)) 2468 (allout-current-bullet-pos))
@@ -2304,8 +2485,9 @@ outline maneuvering operations by positioning the cursor on the bullet
2304char. When in this mode you can use regular cursor-positioning 2485char. When in this mode you can use regular cursor-positioning
2305command/keystrokes to relocate the cursor off of a bullet character to 2486command/keystrokes to relocate the cursor off of a bullet character to
2306return to regular interpretation of self-insert characters." 2487return to regular interpretation of self-insert characters."
2488
2307 (if (not (allout-mode-p)) 2489 (if (not (allout-mode-p))
2308 ;; Shouldn't be invoked if not in allout allout-mode, but just in case: 2490 ;; Shouldn't be invoked if not in allout-mode, but just in case:
2309 nil 2491 nil
2310 ;; Register isearch status: 2492 ;; Register isearch status:
2311 (if (and (boundp 'isearch-mode) isearch-mode) 2493 (if (and (boundp 'isearch-mode) isearch-mode)
@@ -2317,7 +2499,9 @@ return to regular interpretation of self-insert characters."
2317 (let* ((this-key-num (cond 2499 (let* ((this-key-num (cond
2318 ((numberp last-command-char) 2500 ((numberp last-command-char)
2319 last-command-char) 2501 last-command-char)
2320 ((fboundp 'char-to-int) 2502 ;; Only xemacs has characterp.
2503 ((and (fboundp 'characterp)
2504 (characterp last-command-char))
2321 (char-to-int last-command-char)) 2505 (char-to-int last-command-char))
2322 (t 0))) 2506 (t 0)))
2323 mapped-binding) 2507 mapped-binding)
@@ -2340,7 +2524,7 @@ return to regular interpretation of self-insert characters."
2340 this-command mapped-binding))))))) 2524 this-command mapped-binding)))))))
2341;;;_ > allout-find-file-hook () 2525;;;_ > allout-find-file-hook ()
2342(defun allout-find-file-hook () 2526(defun allout-find-file-hook ()
2343 "Activate `allout-mode' when `allout-auto-activation' & `allout-layout' are non-nil. 2527 "Activate `allout-mode' when `allout-auto-activation', `allout-layout' non-nil.
2344 2528
2345See `allout-init' for setup instructions." 2529See `allout-init' for setup instructions."
2346 (if (and allout-auto-activation 2530 (if (and allout-auto-activation
@@ -2353,7 +2537,7 @@ See `allout-init' for setup instructions."
2353 2537
2354Called as part of `allout-post-command-business'." 2538Called as part of `allout-post-command-business'."
2355 2539
2356 (let ((isearching isearch-mode)) 2540 (let ((isearching (and (boundp 'isearch-mode) isearch-mode)))
2357 (cond ((and isearching (not allout-pre-was-isearching)) 2541 (cond ((and isearching (not allout-pre-was-isearching))
2358 (allout-isearch-expose 'start)) 2542 (allout-isearch-expose 'start))
2359 ((and isearching allout-pre-was-isearching) 2543 ((and isearching allout-pre-was-isearching)
@@ -2361,24 +2545,11 @@ Called as part of `allout-post-command-business'."
2361 ((and (not isearching) allout-pre-was-isearching) 2545 ((and (not isearching) allout-pre-was-isearching)
2362 (allout-isearch-expose 'final)) 2546 (allout-isearch-expose 'final))
2363 ;; Not and wasn't isearching: 2547 ;; Not and wasn't isearching:
2364 (t (setq allout-isearch-prior-pos nil))))) 2548 (t (setq allout-isearch-prior-pos nil)
2549 (setq allout-isearch-did-quit nil)))))
2365;;;_ = allout-isearch-was-font-lock 2550;;;_ = allout-isearch-was-font-lock
2366(defvar allout-isearch-was-font-lock 2551(defvar allout-isearch-was-font-lock
2367 (and (boundp 'font-lock-mode) font-lock-mode)) 2552 (and (boundp 'font-lock-mode) font-lock-mode))
2368
2369;;;_ > allout-flag-region (from to flag)
2370(defmacro allout-flag-region (from to flag)
2371 "Hide or show lines from FROM to TO, via Emacs `selective-display' FLAG char.
2372Ie, text following flag C-m \(carriage-return) is hidden until the
2373next C-j (newline) char.
2374
2375Returns the endpoint of the region."
2376 `(let ((buffer-read-only nil)
2377 (allout-override-protect t))
2378 (subst-char-in-region ,from ,to
2379 (if (= ,flag ?\n) ?\r ?\n)
2380 ,flag t)))
2381
2382;;;_ > allout-isearch-expose (mode) 2553;;;_ > allout-isearch-expose (mode)
2383(defun allout-isearch-expose (mode) 2554(defun allout-isearch-expose (mode)
2384 "MODE is either 'clear, 'start, 'continue, or 'final." 2555 "MODE is either 'clear, 'start, 'continue, or 'final."
@@ -2403,21 +2574,56 @@ Returns the endpoint of the region."
2403 (setq allout-isearch-prior-pos nil) 2574 (setq allout-isearch-prior-pos nil)
2404 (if (not (eq mode 'final)) 2575 (if (not (eq mode 'final))
2405 (setq allout-isearch-prior-pos (cons (point) (allout-show-entry))) 2576 (setq allout-isearch-prior-pos (cons (point) (allout-show-entry)))
2406 (if isearch-mode-end-hook-quit 2577 (if allout-isearch-did-quit
2407 nil 2578 nil
2408 (setq allout-isearch-prior-pos nil) 2579 (setq allout-isearch-prior-pos nil)
2409 (allout-show-children))))) 2580 (allout-show-children))))
2581 (setq allout-isearch-did-quit nil))
2410;;;_ > allout-enwrap-isearch () 2582;;;_ > allout-enwrap-isearch ()
2411(defun allout-enwrap-isearch () 2583(defun allout-enwrap-isearch ()
2412 "Impose `isearch-abort' wrapper for dynamic exposure in isearch. 2584 "Impose `allout-mode' isearch-abort wrapper for dynamic exposure in isearch.
2413 2585
2414The function checks to ensure that the rebinding is done only once." 2586The function checks to ensure that the rebinding is done only once."
2415 (add-hook 'isearch-mode-end-hook 'allout-isearch-rectification)) 2587
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
2615actual 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))))
2416 2622
2417;;; Prevent unnecessary font-lock while isearching! 2623;;; Prevent unnecessary font-lock while isearching!
2418(defvar isearch-was-font-locking nil) 2624(defvar isearch-was-font-locking nil)
2419(defun isearch-inhibit-font-lock () 2625(defun isearch-inhibit-font-lock ()
2420 "Inhibit `font-lock-mode' while isearching - for use on `isearch-mode-hook'." 2626 "Inhibit `font-lock' while isearching - for use on `isearch-mode-hook'."
2421 (if (and (allout-mode-p) (boundp 'font-lock-mode) font-lock-mode) 2627 (if (and (allout-mode-p) (boundp 'font-lock-mode) font-lock-mode)
2422 (setq isearch-was-font-locking t 2628 (setq isearch-was-font-locking t
2423 font-lock-mode nil))) 2629 font-lock-mode nil)))
@@ -2465,6 +2671,14 @@ Offer one suitable for current depth DEPTH as default."
2465 (if prefix 2671 (if prefix
2466 (allout-get-prefix-bullet prefix) 2672 (allout-get-prefix-bullet prefix)
2467 (allout-get-bullet))))) 2673 (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)))))
2468;;;_ > allout-bullet-for-depth (&optional depth) 2682;;;_ > allout-bullet-for-depth (&optional depth)
2469(defun allout-bullet-for-depth (&optional depth) 2683(defun allout-bullet-for-depth (&optional depth)
2470 "Return outline topic bullet suited to optional DEPTH, or current depth." 2684 "Return outline topic bullet suited to optional DEPTH, or current depth."
@@ -2625,15 +2839,15 @@ index for each successive sibling)."
2625 ((allout-sibling-index)))))) 2839 ((allout-sibling-index))))))
2626 ) 2840 )
2627 ) 2841 )
2628;;;_ > allout-open-topic (relative-depth &optional before use-sib-bullet) 2842;;;_ > allout-open-topic (relative-depth &optional before use_recent_bullet)
2629(defun allout-open-topic (relative-depth &optional before use-sib-bullet) 2843(defun allout-open-topic (relative-depth &optional before use_recent_bullet)
2630 "Open a new topic at depth RELATIVE-DEPTH. 2844 "Open a new topic at depth DEPTH.
2631 2845
2632New topic is situated after current one, unless optional flag BEFORE 2846New topic is situated after current one, unless optional flag BEFORE
2633is non-nil, or unless current line is complete empty (not even 2847is non-nil, or unless current line is complete empty (not even
2634whitespace), in which case open is done on current line. 2848whitespace), in which case open is done on current line.
2635 2849
2636If USE-SIB-BULLET is true, use the bullet of the prior sibling. 2850If USE_RECENT_BULLET is true, offer to use the bullet of the prior sibling.
2637 2851
2638Nuances: 2852Nuances:
2639 2853
@@ -2660,9 +2874,11 @@ Nuances:
2660 (let* ((depth (+ (allout-current-depth) relative-depth)) 2874 (let* ((depth (+ (allout-current-depth) relative-depth))
2661 (opening-on-blank (if (looking-at "^\$") 2875 (opening-on-blank (if (looking-at "^\$")
2662 (not (setq before nil)))) 2876 (not (setq before nil))))
2663 opening-numbered ; Will get while computing ref-topic, below 2877 ;; bunch o vars set while computing ref-topic
2664 ref-depth ; Will get while computing ref-topic, below 2878 opening-numbered
2665 ref-bullet ; Will get while computing ref-topic, next 2879 opening-encrypted
2880 ref-depth
2881 ref-bullet
2666 (ref-topic (save-excursion 2882 (ref-topic (save-excursion
2667 (cond ((< relative-depth 0) 2883 (cond ((< relative-depth 0)
2668 (allout-ascend-to-depth depth)) 2884 (allout-ascend-to-depth depth))
@@ -2680,6 +2896,13 @@ Nuances:
2680 (allout-descend-to-depth depth)) 2896 (allout-descend-to-depth depth))
2681 (if (allout-numbered-type-prefix) 2897 (if (allout-numbered-type-prefix)
2682 allout-numbered-bullet)))) 2898 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))))
2683 (point))) 2906 (point)))
2684 dbl-space 2907 dbl-space
2685 doing-beginning) 2908 doing-beginning)
@@ -2718,19 +2941,24 @@ Nuances:
2718 (if (not (bobp)) 2941 (if (not (bobp))
2719 (allout-previous-heading))) 2942 (allout-previous-heading)))
2720 (if (and before (bobp)) 2943 (if (and before (bobp))
2721 (allout-unprotected (open-line 1)))) 2944 (allout-unprotected (allout-open-line-not-read-only))))
2722 2945
2723 (if (<= relative-depth 0) 2946 (if (<= relative-depth 0)
2724 ;; Not going inwards, don't snug up: 2947 ;; Not going inwards, don't snug up:
2725 (if doing-beginning 2948 (if doing-beginning
2726 (allout-unprotected (open-line (if dbl-space 2 1))) 2949 (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)))
2727 (if before 2954 (if before
2728 (progn (end-of-line) 2955 (progn (end-of-line)
2729 (allout-pre-next-preface) 2956 (allout-pre-next-preface)
2730 (while (= ?\r (following-char)) 2957 (while (= ?\r (following-char))
2731 (forward-char 1)) 2958 (forward-char 1))
2732 (if (not (looking-at "^$")) 2959 (if (not (looking-at "^$"))
2733 (allout-unprotected (open-line 1)))) 2960 (allout-unprotected
2961 (allout-open-line-not-read-only))))
2734 (allout-end-of-current-subtree))) 2962 (allout-end-of-current-subtree)))
2735 ;; Going inwards - double-space if first offspring is, 2963 ;; Going inwards - double-space if first offspring is,
2736 ;; otherwise snug up. 2964 ;; otherwise snug up.
@@ -2748,38 +2976,47 @@ Nuances:
2748 (progn (forward-line -1) 2976 (progn (forward-line -1)
2749 (looking-at "^\\s-*$")))) 2977 (looking-at "^\\s-*$"))))
2750 (progn (forward-line 1) 2978 (progn (forward-line 1)
2751 (allout-unprotected (open-line 1)))) 2979 (allout-unprotected
2980 (allout-open-line-not-read-only))
2981 (forward-line 1)))
2752 (end-of-line)) 2982 (end-of-line))
2753 ;;(if doing-beginning (goto-char doing-beginning)) 2983 ;;(if doing-beginning (goto-char doing-beginning))
2754 (if (not (bobp)) 2984 (if (not (bobp))
2985 ;; We insert a newline char rather than using open-line to
2986 ;; avoid rear-stickiness inheritence of read-only property.
2755 (progn (if (and (not (> depth ref-depth)) 2987 (progn (if (and (not (> depth ref-depth))
2756 (not before)) 2988 (not before))
2757 (allout-unprotected (open-line 1)) 2989 (allout-unprotected
2990 (allout-open-line-not-read-only))
2758 (if (> depth ref-depth) 2991 (if (> depth ref-depth)
2759 (allout-unprotected (newline 1)) 2992 (allout-unprotected
2993 (allout-open-line-not-read-only))
2760 (if dbl-space 2994 (if dbl-space
2761 (allout-unprotected (open-line 1)) 2995 (allout-unprotected
2996 (allout-open-line-not-read-only))
2762 (if (not before) 2997 (if (not before)
2763 (allout-unprotected (newline 1)))))) 2998 (allout-unprotected (newline 1))))))
2764 (if dbl-space 2999 (if dbl-space
2765 (allout-unprotected (newline 1))) 3000 (allout-unprotected (newline 1)))
2766 (if (and (not (eobp)) 3001 (if (and (not (eobp))
2767 (not (bolp))) 3002 (not (bolp)))
2768 (forward-char 1)))) 3003 (forward-char 1))))
2769 )) 3004 ))
2770 (insert (concat (allout-make-topic-prefix opening-numbered 3005 (insert (concat (allout-make-topic-prefix opening-numbered
2771 t 3006 t
2772 depth) 3007 depth)
2773 " ")) 3008 " "))
2774 3009
2775 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) 3010 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1))))
2776 3011
2777 3012
2778 (allout-rebullet-heading (and use-sib-bullet ref-bullet);;; solicit 3013 (allout-rebullet-heading (and use_recent_bullet ;;; solicit
3014 ref-bullet)
2779 depth ;;; depth 3015 depth ;;; depth
2780 nil ;;; number-control 3016 nil ;;; number-control
2781 nil ;;; index 3017 nil ;;; index
2782 t) (end-of-line) 3018 t)
3019 (end-of-line)
2783 ) 3020 )
2784 ) 3021 )
2785;;;_ . open-topic contingencies 3022;;;_ . open-topic contingencies
@@ -2795,6 +3032,13 @@ Nuances:
2795;;;_ ; buffer boundaries - special provisions for beginning and end ob 3032;;;_ ; buffer boundaries - special provisions for beginning and end ob
2796;;;_ ; level 1 topics have special provisions also - double space. 3033;;;_ ; level 1 topics have special provisions also - double space.
2797;;;_ ; location of new topic 3034;;;_ ; 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)))))
2798;;;_ > allout-open-subtopic (arg) 3042;;;_ > allout-open-subtopic (arg)
2799(defun allout-open-subtopic (arg) 3043(defun allout-open-subtopic (arg)
2800 "Open new topic header at deeper level than the current one. 3044 "Open new topic header at deeper level than the current one.
@@ -2802,7 +3046,7 @@ Nuances:
2802Negative universal arg means to open deeper, but place the new topic 3046Negative universal arg means to open deeper, but place the new topic
2803prior to the current one." 3047prior to the current one."
2804 (interactive "p") 3048 (interactive "p")
2805 (allout-open-topic 1 (> 0 arg))) 3049 (allout-open-topic 1 (> 0 arg) (< 1 arg)))
2806;;;_ > allout-open-sibtopic (arg) 3050;;;_ > allout-open-sibtopic (arg)
2807(defun allout-open-sibtopic (arg) 3051(defun allout-open-sibtopic (arg)
2808 "Open new topic header at same level as the current one. 3052 "Open new topic header at same level as the current one.
@@ -2812,7 +3056,7 @@ Positive universal arg means to use the bullet of the prior sibling.
2812Negative universal arg means to place the new topic prior to the current 3056Negative universal arg means to place the new topic prior to the current
2813one." 3057one."
2814 (interactive "p") 3058 (interactive "p")
2815 (allout-open-topic 0 (> 0 arg) (< 1 arg))) 3059 (allout-open-topic 0 (> 0 arg) (not (= 1 arg))))
2816;;;_ > allout-open-supertopic (arg) 3060;;;_ > allout-open-supertopic (arg)
2817(defun allout-open-supertopic (arg) 3061(defun allout-open-supertopic (arg)
2818 "Open new topic header at shallower level than the current one. 3062 "Open new topic header at shallower level than the current one.
@@ -2821,7 +3065,7 @@ Negative universal arg means to open shallower, but place the new
2821topic prior to the current one." 3065topic prior to the current one."
2822 3066
2823 (interactive "p") 3067 (interactive "p")
2824 (allout-open-topic -1 (> 0 arg))) 3068 (allout-open-topic -1 (> 0 arg) (< 1 arg)))
2825 3069
2826;;;_ - Outline Alteration 3070;;;_ - Outline Alteration
2827;;;_ : Topic Modification 3071;;;_ : Topic Modification
@@ -2877,15 +3121,15 @@ Note that refill of indented paragraphs is not done."
2877 (setq old-indent-begin (match-beginning 1) 3121 (setq old-indent-begin (match-beginning 1)
2878 old-indent-end (match-end 1)) 3122 old-indent-end (match-end 1))
2879 (not (looking-at allout-regexp))) 3123 (not (looking-at allout-regexp)))
2880 (if (> 0 (setq excess (- (current-column) 3124 (if (> 0 (setq excess (- (- old-indent-end old-indent-begin)
2881 old-margin))) 3125 old-margin)))
2882 ;; Text starts left of old margin - don't adjust: 3126 ;; Text starts left of old margin - don't adjust:
2883 nil 3127 nil
2884 ;; Text was hanging at or right of old left margin - 3128 ;; Text was hanging at or right of old left margin -
2885 ;; reindent it, preserving its existing indentation 3129 ;; reindent it, preserving its existing indentation
2886 ;; beyond the old margin: 3130 ;; beyond the old margin:
2887 (delete-region old-indent-begin old-indent-end) 3131 (delete-region old-indent-begin old-indent-end)
2888 (indent-to (+ new-margin excess))))))))) 3132 (indent-to (+ new-margin excess (current-column))))))))))
2889;;;_ > allout-rebullet-current-heading (arg) 3133;;;_ > allout-rebullet-current-heading (arg)
2890(defun allout-rebullet-current-heading (arg) 3134(defun allout-rebullet-current-heading (arg)
2891 "Solicit new bullet for current visible heading." 3135 "Solicit new bullet for current visible heading."
@@ -2922,28 +3166,30 @@ Note that refill of indented paragraphs is not done."
2922 3166
2923 "Adjust bullet of current topic prefix. 3167 "Adjust bullet of current topic prefix.
2924 3168
3169All args are optional.
3170
2925If SOLICIT is non-nil, then the choice of bullet is solicited from 3171If SOLICIT is non-nil, then the choice of bullet is solicited from
2926user. If it's a character, then that character is offered as the 3172user. If it's a character, then that character is offered as the
2927default, otherwise the one suited to the context \(according to 3173default, otherwise the one suited to the context \(according to
2928distinction or depth) is offered. If non-nil, then the 3174distinction or depth) is offered. If non-nil, then the
2929context-specific bullet is just used. 3175context-specific bullet is just used.
2930 3176
2931Second arg NEW-DEPTH forces the topic prefix to that depth, regardless 3177Second arg DEPTH forces the topic prefix to that depth, regardless
2932of the topic's current depth. 3178of the topic's current depth.
2933 3179
2934Third arg NUMBER-CONTROL can force the prefix to or away from 3180Third arg NUMBER-CONTROL can force the prefix to or away from
2935numbered form. It has effect only if `allout-numbered-bullet' is 3181numbered form. It has effect only if `allout-numbered-bullet' is
2936non-nil and soliciting was not explicitly invoked (via first arg). 3182non-nil and soliciting was not explicitly invoked (via first arg).
2937Its effect, numbering or denumbering, then depends on the setting 3183Its effect, numbering or denumbering, then depends on the setting
2938of the fourth arg, INDEX. 3184of the forth arg, INDEX.
2939 3185
2940If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the 3186If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the
2941prefix of the topic is forced to be non-numbered. Null index and 3187prefix of the topic is forced to be non-numbered. Null index and
2942non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and 3188non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
2943non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil 3189non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
2944INDEX is a number, then that number is used for the numbered 3190INDEX is a number, then that number is used for the numbered
2945prefix. Non-nil and non-number means that the index for the 3191prefix. Non-nil and non-number means that the index for the
2946numbered prefix will be derived by `allout-make-topic-prefix'. 3192numbered prefix will be derived by allout-make-topic-prefix.
2947 3193
2948Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding 3194Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
2949siblings. 3195siblings.
@@ -2986,9 +3232,10 @@ this function."
2986 ; Put in new prefix: 3232 ; Put in new prefix:
2987 (allout-unprotected (insert new-prefix)) 3233 (allout-unprotected (insert new-prefix))
2988 3234
2989 ;; Reindent the body if elected and margin changed: 3235 ;; Reindent the body if elected, margin changed, and not encrypted body:
2990 (if (and allout-reindent-bodies 3236 (if (and allout-reindent-bodies
2991 (not (= new-depth current-depth))) 3237 (not (= new-depth current-depth))
3238 (not (allout-encrypted-topic-p)))
2992 (allout-reindent-body current-depth new-depth)) 3239 (allout-reindent-body current-depth new-depth))
2993 3240
2994 ;; Recursively rectify successive siblings of orig topic if 3241 ;; Recursively rectify successive siblings of orig topic if
@@ -3010,7 +3257,7 @@ this function."
3010 ) ; defun 3257 ) ; defun
3011;;;_ > allout-rebullet-topic (arg) 3258;;;_ > allout-rebullet-topic (arg)
3012(defun allout-rebullet-topic (arg) 3259(defun allout-rebullet-topic (arg)
3013 "Like `allout-rebullet-topic-grunt', but start from topic visible at point. 3260 "Rebullet the visible topic containing point and all contained subtopics.
3014 3261
3015Descends into invisible as well as visible topics, however. 3262Descends into invisible as well as visible topics, however.
3016 3263
@@ -3036,18 +3283,18 @@ With repeat count, shift topic depth by that amount."
3036 starting-point 3283 starting-point
3037 index 3284 index
3038 do-successors) 3285 do-successors)
3286 "Like `allout-rebullet-topic', but on nearest containing topic
3287\(visible or not).
3039 3288
3040 "Rebullet the topic at point, visible or invisible, and all 3289See `allout-rebullet-heading' for rebulleting behavior.
3041contained subtopics. See `allout-rebullet-heading' for rebulleting
3042behavior.
3043 3290
3044Arg RELATIVE-DEPTH means to shift the depth of the entire 3291All arguments are optional.
3045topic that amount.
3046 3292
3047\(fn &optional RELATIVE-DEPTH)" 3293First arg RELATIVE-DEPTH means to shift the depth of the entire
3294topic that amount.
3048 3295
3049 ;; All args except the first one are for internal recursive use by the 3296The rest of the args are for internal recursive use by the function
3050 ;; function itself. 3297itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX."
3051 3298
3052 (let* ((relative-depth (or relative-depth 0)) 3299 (let* ((relative-depth (or relative-depth 0))
3053 (new-depth (allout-depth)) 3300 (new-depth (allout-depth))
@@ -3177,13 +3424,42 @@ rebulleting each topic at this level."
3177 (setq more (allout-next-sibling depth nil)))))) 3424 (setq more (allout-next-sibling depth nil))))))
3178;;;_ > allout-shift-in (arg) 3425;;;_ > allout-shift-in (arg)
3179(defun allout-shift-in (arg) 3426(defun allout-shift-in (arg)
3180 "Increase depth of current heading and any topics collapsed within it." 3427 "Increase depth of current heading and any topics collapsed within it.
3428
3429We disallow shifts that would result in the topic having a depth more than
3430one level greater than the immediately previous topic, to avoid containment
3431discontinuity. The first topic in the file can be adjusted to any positive
3432depth, however."
3181 (interactive "p") 3433 (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")))))))
3182 (allout-rebullet-topic arg)) 3451 (allout-rebullet-topic arg))
3183;;;_ > allout-shift-out (arg) 3452;;;_ > allout-shift-out (arg)
3184(defun allout-shift-out (arg) 3453(defun allout-shift-out (arg)
3185 "Decrease depth of current heading and any topics collapsed within it." 3454 "Decrease depth of current heading and any topics collapsed within it.
3455
3456We disallow shifts that would result in the topic having a depth more than
3457one level greater than the immediately previous topic, to avoid containment
3458discontinuity. The first topic in the file can be adjusted to any positive
3459depth, however."
3186 (interactive "p") 3460 (interactive "p")
3461 (if (< arg 0)
3462 (allout-shift-in (* arg -1)))
3187 (allout-rebullet-topic (* arg -1))) 3463 (allout-rebullet-topic (* arg -1)))
3188;;;_ : Surgery (kill-ring) functions with special provisions for outlines: 3464;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
3189;;;_ > allout-kill-line (&optional arg) 3465;;;_ > allout-kill-line (&optional arg)
@@ -3191,24 +3467,56 @@ rebulleting each topic at this level."
3191 "Kill line, adjusting subsequent lines suitably for outline mode." 3467 "Kill line, adjusting subsequent lines suitably for outline mode."
3192 3468
3193 (interactive "*P") 3469 (interactive "*P")
3194 (if (not (and (allout-mode-p) ; active outline mode, 3470
3195 allout-numbered-bullet ; numbers may need adjustment, 3471 (let ((start-point (point))
3196 (bolp) ; may be clipping topic head, 3472 (leading-kill-ring-entry (car kill-ring))
3197 (looking-at allout-regexp))) ; are clipping topic head. 3473 binding)
3198 ;; Above conditions do not obtain - just do a regular kill: 3474
3199 (kill-line arg) 3475 (condition-case err
3200 ;; Ah, have to watch out for adjustments: 3476
3201 (let* ((depth (allout-depth))) 3477 (if (not (and (allout-mode-p) ; active outline mode,
3202 ; Do the kill: 3478 allout-numbered-bullet ; numbers may need adjustment,
3203 (kill-line arg) 3479 (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)
3204 ; Provide some feedback: 3490 ; Provide some feedback:
3205 (sit-for 0) 3491 (sit-for 0)
3206 (save-excursion 3492 (save-excursion
3207 ; Start with the topic 3493 ; Start with the topic
3208 ; following killed line: 3494 ; following killed line:
3209 (if (not (looking-at allout-regexp)) 3495 (if (not (looking-at allout-regexp))
3210 (allout-next-heading)) 3496 (allout-next-heading))
3211 (allout-renumber-to-depth depth))))) 3497 (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 )
3212;;;_ > allout-kill-topic () 3520;;;_ > allout-kill-topic ()
3213(defun allout-kill-topic () 3521(defun allout-kill-topic ()
3214 "Kill topic together with subtopics. 3522 "Kill topic together with subtopics.
@@ -3236,14 +3544,14 @@ Leaves primary topic's trailing vertical whitespace, if any."
3236 (>= (allout-recent-depth) depth)))) 3544 (>= (allout-recent-depth) depth))))
3237 (forward-char 1))) 3545 (forward-char 1)))
3238 3546
3239 (kill-region beg (point)) 3547 (allout-unprotected (kill-region beg (point)))
3240 (sit-for 0) 3548 (sit-for 0)
3241 (save-excursion 3549 (save-excursion
3242 (allout-renumber-to-depth depth)))) 3550 (allout-renumber-to-depth depth))))
3243;;;_ > allout-yank-processing () 3551;;;_ > allout-yank-processing ()
3244(defun allout-yank-processing (&optional arg) 3552(defun allout-yank-processing (&optional arg)
3245 3553
3246 "Incidental outline specific business to be done just after text yanks. 3554 "Incidental outline-specific business to be done just after text yanks.
3247 3555
3248Does depth adjustment of yanked topics, when: 3556Does depth adjustment of yanked topics, when:
3249 3557
@@ -3259,7 +3567,7 @@ header into which it's being yanked.
3259 3567
3260The point is left in front of yanked, adjusted topics, rather than 3568The point is left in front of yanked, adjusted topics, rather than
3261at the end (and vice-versa with the mark). Non-adjusted yanks, 3569at the end (and vice-versa with the mark). Non-adjusted yanks,
3262however, are left exactly like normal, not outline specific yanks." 3570however, are left exactly like normal, non-allout-specific yanks."
3263 3571
3264 (interactive "*P") 3572 (interactive "*P")
3265 ; Get to beginning, leaving 3573 ; Get to beginning, leaving
@@ -3463,6 +3771,60 @@ by pops to non-distinctive yanks. Bug..."
3463;;;_ #6 Exposure Control 3771;;;_ #6 Exposure Control
3464 3772
3465;;;_ - Fundamental 3773;;;_ - 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.
3777Ie, text following flag C-m \(carriage-return) is hidden until the
3778next C-j (newline) char.
3779
3780Returns 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 )
3466;;;_ > allout-flag-current-subtree (flag) 3828;;;_ > allout-flag-current-subtree (flag)
3467(defun allout-flag-current-subtree (flag) 3829(defun allout-flag-current-subtree (flag)
3468 "Hide or show subtree of currently-visible topic. 3830 "Hide or show subtree of currently-visible topic.
@@ -3471,9 +3833,9 @@ See `allout-flag-region' for more details."
3471 3833
3472 (save-excursion 3834 (save-excursion
3473 (allout-back-to-current-heading) 3835 (allout-back-to-current-heading)
3474 (allout-flag-region (point) 3836 (let ((from (point))
3475 (progn (allout-end-of-current-subtree) (1- (point))) 3837 (to (progn (allout-end-of-current-subtree) (1- (point)))))
3476 flag))) 3838 (allout-flag-region from to flag))))
3477 3839
3478;;;_ - Topic-specific 3840;;;_ - Topic-specific
3479;;;_ > allout-show-entry () 3841;;;_ > allout-show-entry ()
@@ -3482,7 +3844,7 @@ See `allout-flag-region' for more details."
3482 3844
3483This is a way to give restricted peek at a concealed locality without the 3845This is a way to give restricted peek at a concealed locality without the
3484expense of exposing its context, but can leave the outline with aberrant 3846expense of exposing its context, but can leave the outline with aberrant
3485exposure. `allout-hide-current-entry-completely' or `allout-show-to-offshoot' 3847exposure. `allout-hide-current-entry-completely' or `allout-show-offshoot'
3486should be used after the peek to rectify the exposure." 3848should be used after the peek to rectify the exposure."
3487 3849
3488 (interactive) 3850 (interactive)
@@ -3602,7 +3964,7 @@ aberrant exposure states produced by `allout-show-entry'."
3602 (allout-back-to-current-heading) 3964 (allout-back-to-current-heading)
3603 (save-excursion 3965 (save-excursion
3604 (allout-flag-region (point) 3966 (allout-flag-region (point)
3605 (progn (allout-end-of-current-entry) (point)) 3967 (progn (allout-end-of-entry) (point))
3606 ?\r))) 3968 ?\r)))
3607;;;_ > allout-show-current-entry (&optional arg) 3969;;;_ > allout-show-current-entry (&optional arg)
3608(defun allout-show-current-entry (&optional arg) 3970(defun allout-show-current-entry (&optional arg)
@@ -3614,8 +3976,9 @@ aberrant exposure states produced by `allout-show-entry'."
3614 (allout-hide-current-entry) 3976 (allout-hide-current-entry)
3615 (save-excursion 3977 (save-excursion
3616 (allout-flag-region (point) 3978 (allout-flag-region (point)
3617 (progn (allout-end-of-current-entry) (point)) 3979 (progn (allout-end-of-entry) (point))
3618 ?\n)))) 3980 ?\n)
3981 )))
3619;;;_ > allout-hide-current-entry-completely () 3982;;;_ > allout-hide-current-entry-completely ()
3620; ... allout-hide-current-entry-completely also for isearch dynamic exposure: 3983; ... allout-hide-current-entry-completely also for isearch dynamic exposure:
3621(defun allout-hide-current-entry-completely () 3984(defun allout-hide-current-entry-completely ()
@@ -3846,7 +4209,11 @@ Examples:
3846 max-pos))) 4209 max-pos)))
3847;;;_ > allout-old-expose-topic (spec &rest followers) 4210;;;_ > allout-old-expose-topic (spec &rest followers)
3848(defun allout-old-expose-topic (spec &rest followers) 4211(defun allout-old-expose-topic (spec &rest followers)
3849 "Dictate wholesale exposure scheme for current topic, according to SPEC. 4212
4213 "Deprecated. Use `allout-expose-topic' \(with different schema
4214format) instead.
4215
4216Dictate wholesale exposure scheme for current topic, according to SPEC.
3850 4217
3851SPEC is either a number or a list. Optional successive args 4218SPEC is either a number or a list. Optional successive args
3852dictate exposure for subsequent siblings of current topic. 4219dictate exposure for subsequent siblings of current topic.
@@ -3918,9 +4285,6 @@ Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
3918 (allout-old-expose-topic (car followers)) 4285 (allout-old-expose-topic (car followers))
3919 (setq followers (cdr followers))) 4286 (setq followers (cdr followers)))
3920 max-pos)) 4287 max-pos))
3921(make-obsolete 'allout-old-expose-topic
3922 "use `allout-expose-topic' (with different schema format) instead."
3923 "19.23")
3924;;;_ > allout-new-exposure '() 4288;;;_ > allout-new-exposure '()
3925(defmacro allout-new-exposure (&rest spec) 4289(defmacro allout-new-exposure (&rest spec)
3926 "Literal frontend for `allout-expose-topic', doesn't evaluate arguments. 4290 "Literal frontend for `allout-expose-topic', doesn't evaluate arguments.
@@ -3929,6 +4293,8 @@ need not be quoted in `allout-new-exposure'.
3929 4293
3930Cursor is left at start position. 4294Cursor is left at start position.
3931 4295
4296Use this instead of obsolete `allout-exposure'.
4297
3932Examples: 4298Examples:
3933\(allout-new-exposure (-1 () () () 1) 0) 4299\(allout-new-exposure (-1 () () () 1) 0)
3934 Close current topic at current level so only the immediate 4300 Close current topic at current level so only the immediate
@@ -4151,13 +4517,20 @@ header and body. The elements of that list are:
4151 (cdr format))))))) 4517 (cdr format)))))))
4152 ;; Put the list with first at front, to last at back: 4518 ;; Put the list with first at front, to last at back:
4153 (nreverse result)))) 4519 (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))
4154;;;_ > allout-process-exposed (&optional func from to frombuf 4525;;;_ > allout-process-exposed (&optional func from to frombuf
4155;;; tobuf format) 4526;;; tobuf format)
4156(defun allout-process-exposed (&optional func from to frombuf tobuf 4527(defun allout-process-exposed (&optional func from to frombuf tobuf
4157 format start-num) 4528 format &optional start-num)
4158 "Map function on exposed parts of current topic; results to another buffer. 4529 "Map function on exposed parts of current topic; results to another buffer.
4159 4530
4160Apply FUNC to exposed portions FROM position TO position in buffer 4531All args are options; default values itemized below.
4532
4533Apply FUNCTION to exposed portions FROM position TO position in buffer
4161FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an 4534FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
4162alternate presentation form: 4535alternate presentation form:
4163 4536
@@ -4170,7 +4543,7 @@ alternate presentation form:
4170 except for distinctive bullets. 4543 except for distinctive bullets.
4171 4544
4172Defaults: 4545Defaults:
4173 FUNC: `allout-insert-listified' 4546 FUNCTION: `allout-insert-listified'
4174 FROM: region start, if region active, else start of buffer 4547 FROM: region start, if region active, else start of buffer
4175 TO: region end, if region active, else end of buffer 4548 TO: region end, if region active, else end of buffer
4176 FROMBUF: current buffer 4549 FROMBUF: current buffer
@@ -4219,9 +4592,7 @@ LISTIFIED is a list representing each topic header and body:
4219 4592
4220 \`(depth prefix text)' 4593 \`(depth prefix text)'
4221 4594
4222or 4595or \`(depth prefix text bullet-plus)'
4223
4224 \`(depth prefix text bullet-plus)'
4225 4596
4226If `bullet-plus' is specified, it is inserted just after the entire prefix." 4597If `bullet-plus' is specified, it is inserted just after the entire prefix."
4227 (setq listified (cdr listified)) 4598 (setq listified (cdr listified))
@@ -4237,7 +4608,7 @@ If `bullet-plus' is specified, it is inserted just after the entire prefix."
4237 (while text 4608 (while text
4238 (insert (car text)) 4609 (insert (car text))
4239 (if (setq text (cdr text)) 4610 (if (setq text (cdr text))
4240 (insert "\n"))) 4611 (insert-string "\n")))
4241 (insert "\n"))) 4612 (insert "\n")))
4242;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format) 4613;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format)
4243(defun allout-copy-exposed-to-buffer (&optional arg tobuf format) 4614(defun allout-copy-exposed-to-buffer (&optional arg tobuf format)
@@ -4440,14 +4811,14 @@ BULLET string, and a list of TEXT strings for the body."
4440 body-content bop) 4811 body-content bop)
4441 ; Do the head line: 4812 ; Do the head line:
4442 (insert (concat "\\OneHeadLine{\\verb\1 " 4813 (insert (concat "\\OneHeadLine{\\verb\1 "
4443 (allout-latex-verb-quote bullet) 4814 (allout-latex-verb-quote bullet)
4444 "\1}{" 4815 "\1}{"
4445 depth 4816 depth
4446 "}{\\verb\1 " 4817 "}{\\verb\1 "
4447 (if head-line 4818 (if head-line
4448 (allout-latex-verb-quote head-line) 4819 (allout-latex-verb-quote head-line)
4449 "") 4820 "")
4450 "\1}\n")) 4821 "\1}\n"))
4451 (if (not body-lines) 4822 (if (not body-lines)
4452 nil 4823 nil
4453 ;;(insert "\\beginlines\n") 4824 ;;(insert "\\beginlines\n")
@@ -4509,7 +4880,615 @@ With repeat count, copy the exposed portions of entire buffer."
4509 (pop-to-buffer buf) 4880 (pop-to-buffer buf)
4510 (goto-char start-pt))) 4881 (goto-char start-pt)))
4511 4882
4512;;;_ #8 miscellaneous 4883;;;_ #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
4888Contents includes body and subtopics.
4889
4890Currently only GnuPG encryption is supported.
4891
4892\**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg
4893encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
4894
4895Both symmetric-key and key-pair encryption is implemented. Symmetric is
4896the default, use a single \(x4) universal argument for keypair mode.
4897
4898Encrypted topic's bullet is set to a `~' to signal that the contents of the
4899topic \(body and subtopics, but not heading) is pending encryption or
4900encrypted. An `*' asterisk immediately after the bullet signals that the
4901body 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
4903prompted for an ok to \(symmetric-key) encrypt the disclosed topics. NOTE
4904WELL that you must explicitly \(re)encrypt key-pair encrypted topics if you
4905want them to continue to be in key-pair mode.
4906
4907Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be
4908encrypted. If you want to encrypt the contents of a top-level topic, use
4909\\[allout-shift-in] to increase its depth.
4910
4911Failed transformation does not change the an entry being encrypted -
4912instead, the key is re-solicited and the transformation is retried.
4913\\[keyboard-quit] to abort.
4914
4915Decryption does symmetric or key-pair key mode depending on how the text
4916was encrypted. The encryption key is solicited if not currently available
4917from the key cache from a recent prior encryption action.
4918
4919Optional FETCH-KEY universal argument is used for two purposes - to provoke
4920key-pair instead of symmetric encryption, or to provoke clearing of the key
4921cache 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
4933The solicited key is retained for reuse in a buffer-specific cache for some
4934set period of time \(default, 60 seconds), after which the string is
4935nulled. `mailcrypt' provides the key caching functionality. You can
4936adjust the key cache timeout by ajdusting the setting of the elisp variable
4937`mc-passwd-timeout'.
4938
4939If the file previously had no associated key, or had a different key than
4940specified, the user is prompted to repeat the new one for corroboration. A
4941random string encrypted by the new key is set on the buffer-specific
4942variable `allout-key-verifier-string', for confirmation of the key when
4943next obtained, before encrypting or decrypting anything with it. This
4944helps avoid mistakenly shifting between keys.
4945
4946If allout customization var `allout-key-verifier-handling' is non-nil, an
4947entry 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
4949necessary. That setting is for retention of the key verifier across emacs
4950sessions.
4951
4952Similarly, `allout-key-hint-string' stores a user-provided reminder about
4953their key, and `allout-key-hint-handling' specifies when the hint is
4954presented, or if key hints are disabled. If enabled \(see the
4955`allout-key-hint-handling' docstring for details), the hint string is
4956stored in the local-variables section of the file, and solicited whenever
4957the 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
5049If optional DECRYPT is true (default false), then decrypt instead of
5050encrypt.
5051
5052Optional REKEY (default false) provokes clearing of the key cache to force
5053fresh prompting for the key.
5054
5055Optional RETRIED is for internal use - conveys the number of failed keys have
5056been solicited in sequence leading to this current call.
5057
5058Optional VERIFYING is for internal use, signifying processing of text
5059solely for verification of the cached key.
5060
5061Returns 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
5174We add key-verification to vanilla mc-activate-passwd.
5175
5176We depend in some cases on values of the following allout-encrypt-string
5177internal 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
5282TEXT 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
5338We also prompt for and situate a new reminder, if reminders are enabled.
5339
5340We massage the string to simplify programmatic adjustment. File variable
5341is `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
5366Derived 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
5393EXCEPT-MARK identifies a point whose containing topics should be excluded
5394from encryption. This supports 'except-current mode of
5395`allout-encrypt-unencrypted-on-saves'.
5396
5397Such a topic has the allout-topic-encryption-bullet without an
5398immediately following '*' that would mark the topic as being encrypted. It
5399must 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
5448EXCEPT-MARK identifies a point whose containing topics should be excluded
5449from encryption. This supports 'except-current mode of
5450`allout-encrypt-unencrypted-on-saves'.
5451
5452If a topic that is currently being edited was encrypted, we return a list
5453containing the location of the topic and the location of the cursor just
5454before the topic was encrypted. This can be used, eg, to decrypt the topic
5455and exactly resituate the cursor if this is being done as part of a file
5456save. 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
4513;;;_ > allout-mark-topic () 5492;;;_ > allout-mark-topic ()
4514(defun allout-mark-topic () 5493(defun allout-mark-topic ()
4515 "Put the region around topic currently containing point." 5494 "Put the region around topic currently containing point."
@@ -4538,22 +5517,100 @@ setup for auto-startup."
4538 t 5517 t
4539 (allout-open-topic 2) 5518 (allout-open-topic 2)
4540 (insert (concat "Dummy outline topic header - see" 5519 (insert (concat "Dummy outline topic header - see"
4541 "`allout-mode' docstring: `^Hm'.")) 5520 "`allout-mode' docstring: `^Hm'."))
4542 (forward-line 1) 5521 (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
5527Returns 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
4543 (goto-char (point-max)) 5531 (goto-char (point-max))
4544 (open-line 1) 5532 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
4545 (allout-open-topic 0) 5533 (if (let ((case-fold-search t))
4546 (insert "Local emacs vars.\n") 5534 (not (search-forward "Local Variables:" nil t)))
4547 (allout-open-topic 1) 5535 nil
4548 (insert "(`allout-layout' is for allout.el allout-mode)\n") 5536 (setq beg (- (point) 16))
4549 (allout-open-topic 0) 5537 (setq suffix (buffer-substring-no-properties
4550 (insert "Local variables:\n") 5538 (point)
4551 (allout-open-topic 0) 5539 (progn (if (re-search-forward "[\n\r]" nil t)
4552 (insert (format "allout-layout: %s\n" 5540 (forward-char -1))
4553 (or allout-layout 5541 (point))))
4554 '(-1 : 0)))) 5542 (setq prefix (buffer-substring-no-properties
4555 (allout-open-topic 0) 5543 (progn (if (re-search-backward "[\n\r]" nil t)
4556 (insert "End:\n")))) 5544 (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
5555This activity is inhibited if either `enable-local-variables'
5556`allout-enable-file-variable-adjustment' are nil.
5557
5558When enabled, an entry for the variable is created if not already present,
5559or changed if established with a different value. The section for the file
5560variables, itself, is created if not already present. When created, the
5561section lines \(including the section line) exist as second-level topics in
5562a top-level topic at the end of the file.
5563
5564enable-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 )
4557;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) 5614;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
4558(defun solicit-char-in-string (prompt string &optional do-defaulting) 5615(defun solicit-char-in-string (prompt string &optional do-defaulting)
4559 "Solicit (with first arg PROMPT) choice of a character from string STRING. 5616 "Solicit (with first arg PROMPT) choice of a character from string STRING.
@@ -4594,8 +5651,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
4594Representations of actual backslashes - '\\\\\\\\' - are left as a 5651Representations of actual backslashes - '\\\\\\\\' - are left as a
4595single backslash. 5652single backslash.
4596 5653
4597\(fn REGEXP)" 5654Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
4598;; Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion.
4599 5655
4600 (if (string= regexp "") 5656 (if (string= regexp "")
4601 "" 5657 ""
@@ -4611,11 +5667,6 @@ single backslash.
4611 (regexp-sans-escapes (substring regexp 1))) 5667 (regexp-sans-escapes (substring regexp 1)))
4612 ;; Exclude first char, but maintain count: 5668 ;; Exclude first char, but maintain count:
4613 (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) 5669 (regexp-sans-escapes (substring regexp 1) successive-backslashes))))
4614;;;_ > my-region-active-p ()
4615(defmacro my-region-active-p ()
4616 (if (fboundp 'region-active-p)
4617 '(region-active-p)
4618 'mark-active))
4619;;;_ - add-hook definition for divergent emacsen 5670;;;_ - add-hook definition for divergent emacsen
4620;;;_ > add-hook (hook function &optional append) 5671;;;_ > add-hook (hook function &optional append)
4621(if (not (fboundp 'add-hook)) 5672(if (not (fboundp 'add-hook))
@@ -4636,17 +5687,30 @@ function. If HOOK is void, it is first set to nil."
4636 (if append 5687 (if append
4637 (nconc (symbol-value hook) (list function)) 5688 (nconc (symbol-value hook) (list function))
4638 (cons function (symbol-value hook))))))) 5689 (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.
5694Unless 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
4639;;;_ : my-mark-marker to accommodate divergent emacsen: 5703;;;_ : my-mark-marker to accommodate divergent emacsen:
4640(defun my-mark-marker (&optional force buffer) 5704(defun my-mark-marker (&optional force buffer)
4641 "Accommodate the different signature for `mark-marker' across Emacsen. 5705 "Accommodate the different signature for `mark-marker' across Emacsen.
4642 5706
4643XEmacs takes two optional args, while GNU Emacs does not, 5707XEmacs takes two optional args, while mainline GNU Emacs does not,
4644so pass them along when appropriate." 5708so pass them along when appropriate."
4645 (if (featurep 'xemacs) 5709 (if (string-match " XEmacs " emacs-version)
4646 (mark-marker force buffer) 5710 (mark-marker force buffer)
4647 (mark-marker))) 5711 (mark-marker)))
4648 5712
4649;;;_ #9 Under development 5713;;;_ #10 Under development
4650;;;_ > allout-bullet-isearch (&optional bullet) 5714;;;_ > allout-bullet-isearch (&optional bullet)
4651(defun allout-bullet-isearch (&optional bullet) 5715(defun allout-bullet-isearch (&optional bullet)
4652 "Isearch \(regexp) for topic with bullet BULLET." 5716 "Isearch \(regexp) for topic with bullet BULLET."