diff options
| author | Eli Zaretskii | 2005-10-20 14:59:51 +0000 |
|---|---|---|
| committer | Eli Zaretskii | 2005-10-20 14:59:51 +0000 |
| commit | d82979ea94a507f59e40558b7129d78ec4676eb0 (patch) | |
| tree | 74af60f815c5649b8de60c86b212715f382b3810 | |
| parent | 214d5640414ee1a184180a88a7e8072276020921 (diff) | |
| download | emacs-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.el | 1892 |
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. | ||
| 89 | Return the passphrase. If PROMPT is nil, only return value if cached.") | ||
| 90 | (autoload 'mc-gpg-process-region "mc-gpg") | ||
| 91 | (autoload 'mc-dectivate-passwd "mailcrypt" | ||
| 92 | "*Deactivate the passphrase cache.") | ||
| 93 | |||
| 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 | ||
| 112 | A list value specifies a default layout for the current buffer, to be | 137 | A list value specifies a default layout for the current buffer, to be |
| 113 | applied upon activation of `allout-mode'. Any non-nil value will | 138 | applied upon activation of `allout-mode'. Any non-nil value will |
| 114 | automatically trigger `allout-mode', provided `allout-init' | 139 | automatically trigger `allout-mode' \(provided `allout-init' has been called |
| 115 | has been called to enable it. | 140 | to enable this behavior). |
| 116 | 141 | ||
| 117 | See the docstring for `allout-init' for details on setting up for | 142 | See the docstring for `allout-init' for details on setting up for |
| 118 | auto-mode-activation, and for `allout-expose-topic' for the format of | 143 | auto-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 | ||
| 177 | See `allout-distinctive-bullets-string' for the other kind of | 202 | See `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 | ||
| 191 | These bullets are used to distinguish topics from the run-of-the-mill | 216 | These 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, |
| 206 | software, according to the value of `allout-numbered-bullet'.) | 232 | according to the value of `allout-numbered-bullet'.) |
| 207 | 233 | ||
| 208 | See `allout-plain-bullets-string' for the selection of | 234 | See `allout-plain-bullets-string' for the selection of |
| 209 | alternating bullets. | 235 | alternating bullets. |
| @@ -337,7 +363,6 @@ disables numbering maintenance." | |||
| 337 | Set this var to the bullet you want to use for file cross-references." | 363 | Set 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 |
| 386 | formatted copy." | 411 | formatted 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 | |||
| 435 | See mailcrypt variable `mc-schemes' and mailcrypt docs for encryption schemes." | ||
| 436 | :type 'symbol | ||
| 437 | :group 'allout) | ||
| 438 | ;;;_ = allout-key-verifier-handling | ||
| 439 | (defcustom allout-key-verifier-handling 'situate | ||
| 440 | "*Dictate outline encryption key verifier handling. | ||
| 441 | |||
| 442 | The key verifier is string associated with a file that is encrypted with | ||
| 443 | the file's current symmetric encryption key. It is used, if present, to | ||
| 444 | confirm that the key entered by the user is the same as the established | ||
| 445 | one, or explicitly presenting the user with the choice to go with a | ||
| 446 | new key when a difference is encountered. | ||
| 447 | |||
| 448 | The range of values are: | ||
| 449 | |||
| 450 | situate - include key verifier string as text in the file's local-vars | ||
| 451 | section | ||
| 452 | transient - establish the value as a variable in the file's buffer, but | ||
| 453 | don't preserve it as a file variable. | ||
| 454 | disabled - don't establish or do verification. | ||
| 455 | |||
| 456 | See the docstring for the `allout-enable-file-variable-adjustment' | ||
| 457 | variable for details about allout ajustment of file variables." | ||
| 458 | :type '(choice (const situate) | ||
| 459 | (const transient) | ||
| 460 | (const disabled)) | ||
| 461 | :group 'allout) | ||
| 462 | (make-variable-buffer-local 'allout-key-verifier-handling) | ||
| 463 | ;;;_ = allout-key-hint-handling | ||
| 464 | (defcustom allout-key-hint-handling 'always | ||
| 465 | "*Dictate outline encryption key reminder handling: | ||
| 466 | |||
| 467 | always - always show reminder when prompting | ||
| 468 | needed - show reminder on key entry failure | ||
| 469 | manage - never present reminder, but still manage a file-var entry for it | ||
| 470 | disabled - don't even manage the file variable entry | ||
| 471 | |||
| 472 | See the docstring for the `allout-enable-file-variable-adjustment' | ||
| 473 | variable for details about allout ajustment of file variables." | ||
| 474 | :type '(choice (const always) | ||
| 475 | (const needed) | ||
| 476 | (const manage) | ||
| 477 | (const disabled)) | ||
| 478 | :group 'allout) | ||
| 479 | (make-variable-buffer-local 'allout-key-hint-handling) | ||
| 480 | ;;;_ = allout-encrypt-unencrypted-on-saves | ||
| 481 | (defcustom allout-encrypt-unencrypted-on-saves 'except-current | ||
| 482 | "*When saving, should topics pending encryption be encrypted? | ||
| 483 | |||
| 484 | The idea is to prevent file-system exposure of any un-encrypted stuff, and | ||
| 485 | mostly covers both deliberate file writes and auto-saves. | ||
| 486 | |||
| 487 | - Yes: encrypt all topics pending encryption, even if it's the one | ||
| 488 | currently being edited. \(In that case, the currently edited topic | ||
| 489 | will be automatically decrypted before any user interaction, so they | ||
| 490 | can continue editing but the copy on the file system will be | ||
| 491 | encrypted.) | ||
| 492 | Auto-saves will use the \"All except current topic\" mode if this | ||
| 493 | one is selected, to avoid practical difficulties - see below. | ||
| 494 | - All except current topic: skip the topic currently being edited, even if | ||
| 495 | it's pending encryption. This may expose the current topic on the | ||
| 496 | file sytem, but avoids the nuisance of prompts for the encryption | ||
| 497 | key in the middle of editing for, eg, autosaves. | ||
| 498 | This mode is used for auto-saves for both this option and \"Yes\". | ||
| 499 | - No: leave it to the user to encrypt any unencrypted topics. | ||
| 500 | |||
| 501 | For practical reasons, auto-saves always use the 'except-current policy | ||
| 502 | when auto-encryption is enabled. \(Otherwise, spurious key prompts and | ||
| 503 | unavoidable timing collisions are too disruptive.) If security for a file | ||
| 504 | requires that even the current topic is never auto-saved in the clear, | ||
| 505 | disable auto-saves for that file." | ||
| 506 | |||
| 507 | :type '(choice (const :tag "Yes" t) | ||
| 508 | (const :tag "All except current topic" except-current) | ||
| 509 | (const :tag "No" nil)) | ||
| 510 | :group 'allout) | ||
| 511 | (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) | ||
| 512 | |||
| 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 | |||
| 611 | This can range from changes to existing entries, addition of new ones, | ||
| 612 | and creation of a new local variables section when necessary. | ||
| 495 | 613 | ||
| 496 | Outline mode uses Emacs change-triggered functions to detect unruly | 614 | Emacs file variables adjustments are also inhibited if `enable-local-variables' |
| 497 | changes to concealed regions. Set this var non-nil to disable the | 615 | is nil. |
| 498 | protection, potentially increasing text-entry responsiveness a bit. | ||
| 499 | 616 | ||
| 500 | This var takes effect at `allout-mode' activation, so you may have to | 617 | Operations potentially causing edits include allout encryption routines. |
| 501 | deactivate and then reactivate the mode if you want to toggle the | 618 | See the docstring for `allout-toggle-current-subtree-encryption' for |
| 502 | behavior." | 619 | details." |
| 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 | ||
| 852 | resurrecting, on mode deactivation, bindings that existed before | ||
| 853 | activation. Being deprecated.") | ||
| 854 | ;;;_ = allout-added-bindings - being deprecated | ||
| 855 | (defvar allout-added-bindings nil | ||
| 856 | "Variable for use in V18, with allout-prior-bindings, for | ||
| 857 | resurrecting, on mode deactivation, bindings that existed before | ||
| 858 | activation. Being deprecated.") | ||
| 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 | |||
| 862 | See also `allout-post-command-business', `allout-write-file-hook', | ||
| 863 | `allout-before-change-protect', and `allout-post-command-business' | ||
| 864 | functions.") | ||
| 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 | ||
| 878 | Allout outline mode regulates alteration of concealed text to protect | 1003 | Maintained by allout-isearch-abort \(which is wrapped around the real |
| 879 | against inadvertent, unnoticed changes. This is for use by specific, | 1004 | isearch-abort), and monitored by allout-isearch-expose for action.") |
| 880 | native outline functions to temporarily override that protection. | 1005 | (make-variable-buffer-local 'allout-isearch-did-quit) |
| 881 | It'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 |
| 898 | mode from prop-line file-var activation. Used by `allout-mode' function | 1028 | mode from prop-line file-var activation. Used by `allout-mode' function |
| 899 | to track repeats.") | 1029 | to 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 | 1033 | sessions.") | |
| 904 | Currently just sets `allout-during-write-cue', so outline change-protection | 1034 | (make-variable-buffer-local 'allout-file-key-verifier-string) |
| 905 | knows 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 | |||
| 1039 | Intended as a file-specific (buffer local) setting, it defaults to the | ||
| 1040 | value of allout-default-encryption-scheme if nil.") | ||
| 1041 | (make-variable-buffer-local 'allout-encryption-scheme) | ||
| 1042 | ;;;_ = allout-key-verifier-string | ||
| 1043 | (defvar allout-key-verifier-string nil | ||
| 1044 | "Setting used to test solicited encryption keys against that already | ||
| 1045 | associated with a file. | ||
| 1046 | |||
| 1047 | It consists of an encrypted random string useful only to verify that a key | ||
| 1048 | entered by the user is effective for decryption. The key itself is \*not* | ||
| 1049 | recorded in the file anywhere, and the encrypted contents are random binary | ||
| 1050 | characters to avoid exposing greater susceptibility to search attacks. | ||
| 1051 | |||
| 1052 | The verifier string is retained as an Emacs file variable, as well as in | ||
| 1053 | the emacs buffer state, if file variable adjustments are enabled. See | ||
| 1054 | `allout-enable-file-variable-adjustment' for details about that.") | ||
| 1055 | (make-variable-buffer-local 'allout-key-verifier-string) | ||
| 1056 | (setq-default allout-key-verifier-string nil) | ||
| 1057 | ;;;_ = allout-key-hint-string | ||
| 1058 | (defvar allout-key-hint-string "" | ||
| 1059 | "Variable used to retain a reminder string for a file's encryption key. | ||
| 1060 | |||
| 1061 | See the description of `allout-key-hint-handling' for details about how | ||
| 1062 | the reminder is deployed. | ||
| 1063 | |||
| 1064 | The hint is retained as an Emacs file variable, as well as in the emacs buffer | ||
| 1065 | state, if file variable adjustments are enabled. See | ||
| 1066 | `allout-enable-file-variable-adjustment' for details about that.") | ||
| 1067 | (make-variable-buffer-local 'allout-key-hint-string) | ||
| 1068 | (setq-default allout-key-hint-string "") | ||
| 1069 | ;;;_ = allout-after-save-decrypt | ||
| 1070 | (defvar allout-after-save-decrypt nil | ||
| 1071 | "Internal variable, is nil or has the value of two points: | ||
| 1072 | |||
| 1073 | - the location of a topic to be decrypted after saving is done | ||
| 1074 | - where to situate the cursor after the decryption is performed | ||
| 1075 | |||
| 1076 | This is used to decrypt the topic that was currently being edited, if it | ||
| 1077 | was encrypted automatically as part of a file write or autosave.") | ||
| 1078 | (make-variable-buffer-local 'allout-after-save-decrypt) | ||
| 1079 | ;;;_ > allout-write-file-hook-handler () | ||
| 1080 | (defun allout-write-file-hook-handler () | ||
| 1081 | "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes." | ||
| 1082 | |||
| 1083 | (if (or (not (boundp 'allout-encrypt-unencrypted-on-saves)) | ||
| 1084 | (not allout-encrypt-unencrypted-on-saves)) | ||
| 1085 | nil | ||
| 1086 | (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves | ||
| 1087 | 'except-current) | ||
| 1088 | (point-marker)))) | ||
| 1089 | (if (save-excursion (goto-char (point-min)) | ||
| 1090 | (allout-next-topic-pending-encryption except-mark)) | ||
| 1091 | (progn | ||
| 1092 | (message "auto-encrypting pending topics") | ||
| 1093 | (sit-for 2) | ||
| 1094 | (condition-case failure | ||
| 1095 | (setq allout-after-save-decrypt | ||
| 1096 | (allout-encrypt-decrypted except-mark)) | ||
| 1097 | (error (progn | ||
| 1098 | (message | ||
| 1099 | "allout-write-file-hook-handler suppressing error %s" | ||
| 1100 | failure) | ||
| 1101 | (sit-for 2)))))) | ||
| 1102 | )) | ||
| 1103 | nil) | ||
| 1104 | ;;;_ > allout-auto-save-hook-handler () | ||
| 1105 | (defun allout-auto-save-hook-handler () | ||
| 1106 | "Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves." | ||
| 1107 | |||
| 1108 | (if allout-encrypt-unencrypted-on-saves | ||
| 1109 | ;; Always implement 'except-current policy when enabled. | ||
| 1110 | (let ((allout-encrypt-unencrypted-on-saves 'except-current)) | ||
| 1111 | (allout-write-file-hook-handler)))) | ||
| 1112 | ;;;_ > allout-after-saves-handler () | ||
| 1113 | (defun allout-after-saves-handler () | ||
| 1114 | "Decrypt topic encrypted for save, if it's currently being edited. | ||
| 1115 | |||
| 1116 | Ie, if it was pending encryption and contained the point in its body before | ||
| 1117 | the save. | ||
| 1118 | |||
| 1119 | We use values stored in `allout-after-save-decrypt' to locate the topic | ||
| 1120 | and the place for the cursor after the decryption is done." | ||
| 1121 | (if (not (and (allout-mode-p) | ||
| 1122 | (boundp 'allout-after-save-decrypt) | ||
| 1123 | allout-after-save-decrypt)) | ||
| 1124 | t | ||
| 1125 | (goto-char (car allout-after-save-decrypt)) | ||
| 1126 | (let ((was-modified (buffer-modified-p))) | ||
| 1127 | (allout-toggle-current-subtree-encryption) | ||
| 1128 | (if (not was-modified) | ||
| 1129 | (set-buffer-modified-p nil))) | ||
| 1130 | (goto-char (cadr allout-after-save-decrypt)) | ||
| 1131 | (setq allout-after-save-decrypt nil)) | ||
| 1132 | ) | ||
| 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. |
| 920 | So `allout-post-command-business' should not reactivate it...") | 1145 | So `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 | |||
| 939 | the `allout-layout' variable. (See `allout-layout' and | 1163 | the `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 | 1167 | find-file-hook, and giving `allout-auto-activation' a suitable |
| 944 | `allout-auto-activation' a suitable setting. | 1168 | setting. |
| 945 | 1169 | ||
| 946 | To prime your Emacs session for full auto-outline operation, include | 1170 | To prime your Emacs session for full auto-outline operation, include |
| 947 | the following two lines in your Emacs init file: | 1171 | the 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 | ||
| 1023 | In addition to outline navigation and exposure, allout includes: | 1250 | In 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 | |||
| 1035 | special `allout-mode' features and terminology. See also the outline | 1263 | special `allout-mode' features and terminology. See also the outline |
| 1036 | menubar additions for quick reference to many of the features, and see | 1264 | menubar additions for quick reference to many of the features, and see |
| 1037 | the docstring of the function `allout-init' for instructions on | 1265 | the docstring of the function `allout-init' for instructions on |
| 1038 | priming your Emacs session for automatic activation of `allout-mode'. | 1266 | priming your emacs session for automatic activation of `allout-mode'. |
| 1039 | 1267 | ||
| 1040 | 1268 | ||
| 1041 | The bindings are dictated by the `allout-keybindings-list' and | 1269 | The 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 | |||
| 1048 | C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree | 1276 | C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree |
| 1049 | C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry | 1277 | C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry |
| 1050 | C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all | 1278 | C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all |
| 1051 | C-c C-e allout-end-of-current-entry | allout-hide-current-leaves | 1279 | C-c C-e allout-end-of-entry | allout-hide-current-leaves |
| 1052 | C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot | 1280 | C-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. | |||
| 1064 | C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring | 1292 | C-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. |
| 1067 | C-c * allout-rebullet-current-heading Prompt for alternate bullet for | 1295 | C-c b allout-rebullet-current-heading Prompt for alternate bullet for |
| 1068 | current topic. | 1296 | current topic. |
| 1069 | C-c # allout-number-siblings Number bullets of topic and siblings - the | 1297 | C-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, | |||
| 1087 | C-c C-SPC allout-mark-topic | 1315 | C-c C-SPC allout-mark-topic |
| 1088 | C-c = c allout-copy-exposed-to-buffer | 1316 | C-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*\". |
| 1092 | C-c = p allout-flatten-exposed-to-buffer | 1320 | C-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 | |||
| 1096 | ESC ESC (allout-init t) Setup Emacs session for outline mode | 1324 | ESC ESC (allout-init t) Setup Emacs session for outline mode |
| 1097 | auto-activation. | 1325 | auto-activation. |
| 1098 | 1326 | ||
| 1327 | Encrypted Entries | ||
| 1328 | |||
| 1329 | Outline mode supports easily togglable gpg encryption of topics, with | ||
| 1330 | niceities like support for symmetric and key-pair modes, key timeout, key | ||
| 1331 | consistency checking, user-provided hinting for symmetric key mode, and | ||
| 1332 | auto-encryption of topics pending encryption on save. The aim is to enable | ||
| 1333 | reliable topic privacy while preventing accidents like neglected | ||
| 1334 | encryption, encryption with a mistaken key, forgetting which key was used, | ||
| 1335 | and other practical pitfalls. | ||
| 1336 | |||
| 1337 | See the `allout-toggle-current-subtree-encryption' function and | ||
| 1338 | `allout-encrypt-unencrypted-on-saves' customization variable for details. | ||
| 1339 | |||
| 1099 | HOT-SPOT Operation | 1340 | HOT-SPOT Operation |
| 1100 | 1341 | ||
| 1101 | Hot-spot operation provides a means for easy, single-keystroke outline | 1342 | Hot-spot operation provides a means for easy, single-keystroke outline |
| @@ -1148,11 +1389,11 @@ Topic text constituents: | |||
| 1148 | 1389 | ||
| 1149 | HEADER: The first line of a topic, include the topic PREFIX and header | 1390 | HEADER: The first line of a topic, include the topic PREFIX and header |
| 1150 | text. | 1391 | text. |
| 1151 | PREFIX: The leading text of a topic which distinguishes it from | 1392 | PREFIX: 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 | ||
| 1406 | For reference by `allout-recent' funcs. Returns BEGINNING." | 1665 | For 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 | ||
| 1614 | Optional argument LEVELS specifies the depth \(relative to start | 1873 | Optional argument LEVELS specifies the depth \(relative to start |
| 1615 | depth) for the chart. | 1874 | depth) for the chart. Subsequent optional args are not for public |
| 1875 | use. | ||
| 1876 | |||
| 1877 | Point is left at the end of the subtree. | ||
| 1616 | 1878 | ||
| 1617 | Charts are used to capture outline structure, so that outline altering | 1879 | Charts are used to capture outline structure, so that outline-altering |
| 1618 | routines need assess the structure only once, and then use the chart | 1880 | routines need assess the structure only once, and then use the chart |
| 1619 | for their elaborate manipulations. | 1881 | for their elaborate manipulations. |
| 1620 | 1882 | ||
| @@ -1625,11 +1887,9 @@ list containing, recursively, the charts for the respective subtopics. | |||
| 1625 | The chart for a topics' offspring precedes the entry for the topic | 1887 | The chart for a topics' offspring precedes the entry for the topic |
| 1626 | itself. | 1888 | itself. |
| 1627 | 1889 | ||
| 1628 | \(fn &optional LEVELS)" | 1890 | The other function parameters are for internal recursion, and should |
| 1629 | 1891 | not be specified by external callers. ORIG-DEPTH is depth of topic at | |
| 1630 | ;; The other function parameters are for internal recursion, and should | 1892 | starting 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) | 2102 | If optional CURRENT is true (default false), then put point at the end of |
| 2103 | the containing visible topic. | ||
| 2104 | |||
| 2105 | Returns the value of point." | ||
| 2106 | (interactive "P") | ||
| 2107 | (if current | ||
| 2108 | (allout-back-to-current-heading) | ||
| 2109 | (allout-goto-prefix)) | ||
| 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 | |||
| 2125 | Returns 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 | ||
| 1858 | If already there, move cursor to bullet for hot-spot operation. | 2132 | If 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 | ||
| 1923 | Positions on heading line of containing topic. Error if unable to | 2218 | Positions on heading line of containing topic. Error if unable to |
| 1924 | ascend that far, or nil if unable to ascend but optional arg | 2219 | ascend that far, or nil if unable to ascend but optional arg |
| 1925 | DONT-COMPLAIN is non-nil." | 2220 | DONT-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 | ||
| 1986 | Optional DEPTH specifies depth to traverse, default current depth. | 2281 | Optional 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 | ||
| 2059 | Takes optional repeat-count, goes backward if count is negative. | 2354 | Takes optional repeat-count, goes backward if count is negative. |
| 2060 | 2355 | ||
| 2061 | Returns resulting position, else nil if none found." | 2356 | Returns 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 | |||
| 2114 | Reveal concealed text that would be changed by current command, and | ||
| 2115 | offer user choice to commit or forego the change. Unchanged text is | ||
| 2116 | reconcealed. User has option to have changed text reconcealed. | ||
| 2117 | |||
| 2118 | Undo commands are specially treated - the user is not prompted for | ||
| 2119 | choice, the undoes are always committed (based on presumption that the | ||
| 2120 | things being undone were already subject to this regulation routine), | ||
| 2121 | and undoes always leave the changed stuff exposed. | ||
| 2122 | |||
| 2123 | Changes to concealed regions are ignored while file is being written. | ||
| 2124 | \(This is for the sake of functions that do change the file during | ||
| 2125 | writes, like crypt and zip modes.) | ||
| 2126 | |||
| 2127 | Locally bound in outline buffers to `before-change-functions', which | ||
| 2128 | in Emacs 19 is run before any change to the buffer. | ||
| 2129 | |||
| 2130 | Any functions which set [`this-command' to `undo', or which set] | ||
| 2131 | `allout-override-protect' non-nil (as does, eg, allout-flag-chars) | ||
| 2132 | are 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 | |||
| 2304 | char. When in this mode you can use regular cursor-positioning | 2485 | char. When in this mode you can use regular cursor-positioning |
| 2305 | command/keystrokes to relocate the cursor off of a bullet character to | 2486 | command/keystrokes to relocate the cursor off of a bullet character to |
| 2306 | return to regular interpretation of self-insert characters." | 2487 | return 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 | ||
| 2345 | See `allout-init' for setup instructions." | 2529 | See `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 | ||
| 2354 | Called as part of `allout-post-command-business'." | 2538 | Called 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. | ||
| 2372 | Ie, text following flag C-m \(carriage-return) is hidden until the | ||
| 2373 | next C-j (newline) char. | ||
| 2374 | |||
| 2375 | Returns 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 | ||
| 2414 | The function checks to ensure that the rebinding is done only once." | 2586 | The 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 | ||
| 2615 | actual quits." | ||
| 2616 | (interactive) | ||
| 2617 | (setq allout-isearch-did-quit nil) | ||
| 2618 | (condition-case what | ||
| 2619 | (allout-real-isearch-abort) | ||
| 2620 | ('quit (setq allout-isearch-did-quit t) | ||
| 2621 | (signal 'quit nil)))) | ||
| 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 | ||
| 2632 | New topic is situated after current one, unless optional flag BEFORE | 2846 | New topic is situated after current one, unless optional flag BEFORE |
| 2633 | is non-nil, or unless current line is complete empty (not even | 2847 | is non-nil, or unless current line is complete empty (not even |
| 2634 | whitespace), in which case open is done on current line. | 2848 | whitespace), in which case open is done on current line. |
| 2635 | 2849 | ||
| 2636 | If USE-SIB-BULLET is true, use the bullet of the prior sibling. | 2850 | If USE_RECENT_BULLET is true, offer to use the bullet of the prior sibling. |
| 2637 | 2851 | ||
| 2638 | Nuances: | 2852 | Nuances: |
| 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: | |||
| 2802 | Negative universal arg means to open deeper, but place the new topic | 3046 | Negative universal arg means to open deeper, but place the new topic |
| 2803 | prior to the current one." | 3047 | prior 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. | |||
| 2812 | Negative universal arg means to place the new topic prior to the current | 3056 | Negative universal arg means to place the new topic prior to the current |
| 2813 | one." | 3057 | one." |
| 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 | |||
| 2821 | topic prior to the current one." | 3065 | topic 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 | ||
| 3169 | All args are optional. | ||
| 3170 | |||
| 2925 | If SOLICIT is non-nil, then the choice of bullet is solicited from | 3171 | If SOLICIT is non-nil, then the choice of bullet is solicited from |
| 2926 | user. If it's a character, then that character is offered as the | 3172 | user. If it's a character, then that character is offered as the |
| 2927 | default, otherwise the one suited to the context \(according to | 3173 | default, otherwise the one suited to the context \(according to |
| 2928 | distinction or depth) is offered. If non-nil, then the | 3174 | distinction or depth) is offered. If non-nil, then the |
| 2929 | context-specific bullet is just used. | 3175 | context-specific bullet is just used. |
| 2930 | 3176 | ||
| 2931 | Second arg NEW-DEPTH forces the topic prefix to that depth, regardless | 3177 | Second arg DEPTH forces the topic prefix to that depth, regardless |
| 2932 | of the topic's current depth. | 3178 | of the topic's current depth. |
| 2933 | 3179 | ||
| 2934 | Third arg NUMBER-CONTROL can force the prefix to or away from | 3180 | Third arg NUMBER-CONTROL can force the prefix to or away from |
| 2935 | numbered form. It has effect only if `allout-numbered-bullet' is | 3181 | numbered form. It has effect only if `allout-numbered-bullet' is |
| 2936 | non-nil and soliciting was not explicitly invoked (via first arg). | 3182 | non-nil and soliciting was not explicitly invoked (via first arg). |
| 2937 | Its effect, numbering or denumbering, then depends on the setting | 3183 | Its effect, numbering or denumbering, then depends on the setting |
| 2938 | of the fourth arg, INDEX. | 3184 | of the forth arg, INDEX. |
| 2939 | 3185 | ||
| 2940 | If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the | 3186 | If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the |
| 2941 | prefix of the topic is forced to be non-numbered. Null index and | 3187 | prefix of the topic is forced to be non-numbered. Null index and |
| 2942 | non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and | 3188 | non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and |
| 2943 | non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil | 3189 | non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil |
| 2944 | INDEX is a number, then that number is used for the numbered | 3190 | INDEX is a number, then that number is used for the numbered |
| 2945 | prefix. Non-nil and non-number means that the index for the | 3191 | prefix. Non-nil and non-number means that the index for the |
| 2946 | numbered prefix will be derived by `allout-make-topic-prefix'. | 3192 | numbered prefix will be derived by allout-make-topic-prefix. |
| 2947 | 3193 | ||
| 2948 | Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding | 3194 | Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding |
| 2949 | siblings. | 3195 | siblings. |
| @@ -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 | ||
| 3015 | Descends into invisible as well as visible topics, however. | 3262 | Descends 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 | 3289 | See `allout-rebullet-heading' for rebulleting behavior. |
| 3041 | contained subtopics. See `allout-rebullet-heading' for rebulleting | ||
| 3042 | behavior. | ||
| 3043 | 3290 | ||
| 3044 | Arg RELATIVE-DEPTH means to shift the depth of the entire | 3291 | All arguments are optional. |
| 3045 | topic that amount. | ||
| 3046 | 3292 | ||
| 3047 | \(fn &optional RELATIVE-DEPTH)" | 3293 | First arg RELATIVE-DEPTH means to shift the depth of the entire |
| 3294 | topic that amount. | ||
| 3048 | 3295 | ||
| 3049 | ;; All args except the first one are for internal recursive use by the | 3296 | The rest of the args are for internal recursive use by the function |
| 3050 | ;; function itself. | 3297 | itself. 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 | |||
| 3429 | We disallow shifts that would result in the topic having a depth more than | ||
| 3430 | one level greater than the immediately previous topic, to avoid containment | ||
| 3431 | discontinuity. The first topic in the file can be adjusted to any positive | ||
| 3432 | depth, however." | ||
| 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 | |||
| 3456 | We disallow shifts that would result in the topic having a depth more than | ||
| 3457 | one level greater than the immediately previous topic, to avoid containment | ||
| 3458 | discontinuity. The first topic in the file can be adjusted to any positive | ||
| 3459 | depth, however." | ||
| 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 | ||
| 3248 | Does depth adjustment of yanked topics, when: | 3556 | Does depth adjustment of yanked topics, when: |
| 3249 | 3557 | ||
| @@ -3259,7 +3567,7 @@ header into which it's being yanked. | |||
| 3259 | 3567 | ||
| 3260 | The point is left in front of yanked, adjusted topics, rather than | 3568 | The point is left in front of yanked, adjusted topics, rather than |
| 3261 | at the end (and vice-versa with the mark). Non-adjusted yanks, | 3569 | at the end (and vice-versa with the mark). Non-adjusted yanks, |
| 3262 | however, are left exactly like normal, not outline specific yanks." | 3570 | however, 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. | ||
| 3777 | Ie, text following flag C-m \(carriage-return) is hidden until the | ||
| 3778 | next C-j (newline) char. | ||
| 3779 | |||
| 3780 | Returns the endpoint of the region." | ||
| 3781 | ;; "OFR-" prefixes to avoid collisions with vars in code calling the macro. | ||
| 3782 | ;; ie, elisp macro vars are not 'hygenic', so distinct names are necessary. | ||
| 3783 | (let ((was-inhibit-r-o inhibit-read-only) | ||
| 3784 | (was-undo-list buffer-undo-list) | ||
| 3785 | (was-modified (buffer-modified-p)) | ||
| 3786 | trans) | ||
| 3787 | (unwind-protect | ||
| 3788 | (save-excursion | ||
| 3789 | (setq inhibit-read-only t) | ||
| 3790 | (setq buffer-undo-list t) | ||
| 3791 | (if (> from to) | ||
| 3792 | (setq trans from from to to trans)) | ||
| 3793 | (subst-char-in-region from to | ||
| 3794 | (if (= flag ?\n) ?\r ?\n) | ||
| 3795 | flag t) | ||
| 3796 | ;; adjust character read-protection on all the affected lines. | ||
| 3797 | ;; we handle the region line-by-line. | ||
| 3798 | (goto-char to) | ||
| 3799 | (end-of-line) | ||
| 3800 | (setq to (min (+ 2 (point)) (point-max))) | ||
| 3801 | (goto-char from) | ||
| 3802 | (beginning-of-line) | ||
| 3803 | (while (< (point) to) | ||
| 3804 | ;; handle from start of exposed to beginning of hidden, or eol: | ||
| 3805 | (remove-text-properties (point) | ||
| 3806 | (progn (if (re-search-forward "[\r\n]" | ||
| 3807 | nil t) | ||
| 3808 | (forward-char -1)) | ||
| 3809 | (point)) | ||
| 3810 | '(read-only nil)) | ||
| 3811 | ;; handle from start of hidden, if any, to eol: | ||
| 3812 | (if (and (not (eobp)) (= (char-after (point)) ?\r)) | ||
| 3813 | (put-text-property (point) (progn (end-of-line) (point)) | ||
| 3814 | 'read-only t)) | ||
| 3815 | ;; Handle the end-of-line to beginning of next line: | ||
| 3816 | (if (not (eobp)) | ||
| 3817 | (progn (forward-char 1) | ||
| 3818 | (remove-text-properties (1- (point)) (point) | ||
| 3819 | '(read-only nil))))) | ||
| 3820 | ) | ||
| 3821 | (if (not was-modified) | ||
| 3822 | (set-buffer-modified-p nil)) | ||
| 3823 | (setq inhibit-read-only was-inhibit-r-o) | ||
| 3824 | (setq buffer-undo-list was-undo-list) | ||
| 3825 | ) | ||
| 3826 | ) | ||
| 3827 | ) | ||
| 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 | ||
| 3483 | This is a way to give restricted peek at a concealed locality without the | 3845 | This is a way to give restricted peek at a concealed locality without the |
| 3484 | expense of exposing its context, but can leave the outline with aberrant | 3846 | expense of exposing its context, but can leave the outline with aberrant |
| 3485 | exposure. `allout-hide-current-entry-completely' or `allout-show-to-offshoot' | 3847 | exposure. `allout-hide-current-entry-completely' or `allout-show-offshoot' |
| 3486 | should be used after the peek to rectify the exposure." | 3848 | should 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 | ||
| 4214 | format) instead. | ||
| 4215 | |||
| 4216 | Dictate wholesale exposure scheme for current topic, according to SPEC. | ||
| 3850 | 4217 | ||
| 3851 | SPEC is either a number or a list. Optional successive args | 4218 | SPEC is either a number or a list. Optional successive args |
| 3852 | dictate exposure for subsequent siblings of current topic. | 4219 | dictate 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 | ||
| 3930 | Cursor is left at start position. | 4294 | Cursor is left at start position. |
| 3931 | 4295 | ||
| 4296 | Use this instead of obsolete `allout-exposure'. | ||
| 4297 | |||
| 3932 | Examples: | 4298 | Examples: |
| 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 | ||
| 4160 | Apply FUNC to exposed portions FROM position TO position in buffer | 4531 | All args are options; default values itemized below. |
| 4532 | |||
| 4533 | Apply FUNCTION to exposed portions FROM position TO position in buffer | ||
| 4161 | FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an | 4534 | FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an |
| 4162 | alternate presentation form: | 4535 | alternate presentation form: |
| 4163 | 4536 | ||
| @@ -4170,7 +4543,7 @@ alternate presentation form: | |||
| 4170 | except for distinctive bullets. | 4543 | except for distinctive bullets. |
| 4171 | 4544 | ||
| 4172 | Defaults: | 4545 | Defaults: |
| 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 | ||
| 4222 | or | 4595 | or \`(depth prefix text bullet-plus)' |
| 4223 | |||
| 4224 | \`(depth prefix text bullet-plus)' | ||
| 4225 | 4596 | ||
| 4226 | If `bullet-plus' is specified, it is inserted just after the entire prefix." | 4597 | If `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 | |||
| 4888 | Contents includes body and subtopics. | ||
| 4889 | |||
| 4890 | Currently only GnuPG encryption is supported. | ||
| 4891 | |||
| 4892 | \**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg | ||
| 4893 | encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. | ||
| 4894 | |||
| 4895 | Both symmetric-key and key-pair encryption is implemented. Symmetric is | ||
| 4896 | the default, use a single \(x4) universal argument for keypair mode. | ||
| 4897 | |||
| 4898 | Encrypted topic's bullet is set to a `~' to signal that the contents of the | ||
| 4899 | topic \(body and subtopics, but not heading) is pending encryption or | ||
| 4900 | encrypted. An `*' asterisk immediately after the bullet signals that the | ||
| 4901 | body is encrypted, its absence means it's meant to be encrypted but is not | ||
| 4902 | - it's \"disclosed\". When a file with disclosed topics is saved, the user | ||
| 4903 | prompted for an ok to \(symmetric-key) encrypt the disclosed topics. NOTE | ||
| 4904 | WELL that you must explicitly \(re)encrypt key-pair encrypted topics if you | ||
| 4905 | want them to continue to be in key-pair mode. | ||
| 4906 | |||
| 4907 | Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be | ||
| 4908 | encrypted. If you want to encrypt the contents of a top-level topic, use | ||
| 4909 | \\[allout-shift-in] to increase its depth. | ||
| 4910 | |||
| 4911 | Failed transformation does not change the an entry being encrypted - | ||
| 4912 | instead, the key is re-solicited and the transformation is retried. | ||
| 4913 | \\[keyboard-quit] to abort. | ||
| 4914 | |||
| 4915 | Decryption does symmetric or key-pair key mode depending on how the text | ||
| 4916 | was encrypted. The encryption key is solicited if not currently available | ||
| 4917 | from the key cache from a recent prior encryption action. | ||
| 4918 | |||
| 4919 | Optional FETCH-KEY universal argument is used for two purposes - to provoke | ||
| 4920 | key-pair instead of symmetric encryption, or to provoke clearing of the key | ||
| 4921 | cache so keys are freshly fetched. | ||
| 4922 | |||
| 4923 | - Without any universal arguments, then the appropriate key for the is | ||
| 4924 | obtained from the cache, if available, else from the user. | ||
| 4925 | |||
| 4926 | - If FETCH-KEY is the result of one universal argument - ie, equal to 4 - | ||
| 4927 | then key-pair encryption is used. | ||
| 4928 | |||
| 4929 | - With repeated universal argument - equal to 16 - then the key cache is | ||
| 4930 | cleared before any encryption transformations, to force prompting of the | ||
| 4931 | user for the key. | ||
| 4932 | |||
| 4933 | The solicited key is retained for reuse in a buffer-specific cache for some | ||
| 4934 | set period of time \(default, 60 seconds), after which the string is | ||
| 4935 | nulled. `mailcrypt' provides the key caching functionality. You can | ||
| 4936 | adjust the key cache timeout by ajdusting the setting of the elisp variable | ||
| 4937 | `mc-passwd-timeout'. | ||
| 4938 | |||
| 4939 | If the file previously had no associated key, or had a different key than | ||
| 4940 | specified, the user is prompted to repeat the new one for corroboration. A | ||
| 4941 | random string encrypted by the new key is set on the buffer-specific | ||
| 4942 | variable `allout-key-verifier-string', for confirmation of the key when | ||
| 4943 | next obtained, before encrypting or decrypting anything with it. This | ||
| 4944 | helps avoid mistakenly shifting between keys. | ||
| 4945 | |||
| 4946 | If allout customization var `allout-key-verifier-handling' is non-nil, an | ||
| 4947 | entry for `allout-key-verifier-string' and its value is added to an Emacs | ||
| 4948 | 'local variables' section at the end of the file, which is created if | ||
| 4949 | necessary. That setting is for retention of the key verifier across emacs | ||
| 4950 | sessions. | ||
| 4951 | |||
| 4952 | Similarly, `allout-key-hint-string' stores a user-provided reminder about | ||
| 4953 | their key, and `allout-key-hint-handling' specifies when the hint is | ||
| 4954 | presented, or if key hints are disabled. If enabled \(see the | ||
| 4955 | `allout-key-hint-handling' docstring for details), the hint string is | ||
| 4956 | stored in the local-variables section of the file, and solicited whenever | ||
| 4957 | the key is changed." | ||
| 4958 | |||
| 4959 | ;;; This routine handles allout-specific business, dispatching | ||
| 4960 | ;;; encryption-specific business to allout-encrypt-string. | ||
| 4961 | |||
| 4962 | (interactive "P") | ||
| 4963 | (save-excursion | ||
| 4964 | (allout-end-of-prefix t) | ||
| 4965 | |||
| 4966 | (if (= (allout-recent-depth) 1) | ||
| 4967 | (error (concat "Cannot encrypt or decrypt level 1 topics -" | ||
| 4968 | " shift it in to make it encryptable"))) | ||
| 4969 | |||
| 4970 | (if (and fetch-key | ||
| 4971 | (not (equal fetch-key '(4)))) | ||
| 4972 | (mc-deactivate-passwd)) | ||
| 4973 | |||
| 4974 | (let* ((allout-buffer (current-buffer)) | ||
| 4975 | ;; Asses location: | ||
| 4976 | (after-bullet-pos (point)) | ||
| 4977 | (was-encrypted | ||
| 4978 | (progn (if (= (point-max) after-bullet-pos) | ||
| 4979 | (error "no body to encrypt")) | ||
| 4980 | (looking-at "\\*"))) | ||
| 4981 | (was-collapsed (if (not (re-search-forward "[\n\r]" nil t)) | ||
| 4982 | nil | ||
| 4983 | (backward-char 1) | ||
| 4984 | (looking-at "\r"))) | ||
| 4985 | (subtree-beg (1+ (point))) | ||
| 4986 | (subtree-end (allout-end-of-subtree)) | ||
| 4987 | (subject-text (buffer-substring-no-properties subtree-beg | ||
| 4988 | subtree-end)) | ||
| 4989 | (subtree-end-char (char-after (1- subtree-end))) | ||
| 4990 | (subtree-trailling-char (char-after subtree-end)) | ||
| 4991 | (place-holder (if (or (string= "" subject-text) | ||
| 4992 | (string= "\n" subject-text)) | ||
| 4993 | (error "No topic contents to %scrypt" | ||
| 4994 | (if was-encrypted "de" "en")))) | ||
| 4995 | ;; Assess key parameters: | ||
| 4996 | (key-type (or | ||
| 4997 | ;; detect the type by which it is already encrypted | ||
| 4998 | (and was-encrypted | ||
| 4999 | (allout-encrypted-text-type subject-text)) | ||
| 5000 | (and (member fetch-key '(4 (4))) | ||
| 5001 | (yes-or-no-p "Use key-pair encryption instead? ") | ||
| 5002 | 'keypair) | ||
| 5003 | 'symmetric)) | ||
| 5004 | (fetch-key (and fetch-key (not (member fetch-key '(16 (16)))))) | ||
| 5005 | result-text) | ||
| 5006 | |||
| 5007 | (setq result-text | ||
| 5008 | (allout-encrypt-string subject-text was-encrypted | ||
| 5009 | (current-buffer) key-type fetch-key)) | ||
| 5010 | |||
| 5011 | ;; Replace the subtree with the processed product. | ||
| 5012 | (allout-unprotected | ||
| 5013 | (progn | ||
| 5014 | (set-buffer allout-buffer) | ||
| 5015 | (delete-region subtree-beg subtree-end) | ||
| 5016 | (insert result-text) | ||
| 5017 | (if was-collapsed | ||
| 5018 | (allout-flag-region subtree-beg (1- (point)) ?\r)) | ||
| 5019 | ;; adjust trailling-blank-lines to preserve topic spacing: | ||
| 5020 | (if (not was-encrypted) | ||
| 5021 | (if (and (member subtree-end-char '(?\r ?\n)) | ||
| 5022 | (member subtree-trailling-char '(?\r ?\n))) | ||
| 5023 | (insert subtree-trailling-char))) | ||
| 5024 | ;; Ensure that the item has an encrypted-entry bullet: | ||
| 5025 | (if (not (string= (buffer-substring-no-properties | ||
| 5026 | (1- after-bullet-pos) after-bullet-pos) | ||
| 5027 | allout-topic-encryption-bullet)) | ||
| 5028 | (progn (goto-char (1- after-bullet-pos)) | ||
| 5029 | (delete-char 1) | ||
| 5030 | (insert allout-topic-encryption-bullet))) | ||
| 5031 | (if was-encrypted | ||
| 5032 | ;; Remove the is-encrypted bullet qualifier: | ||
| 5033 | (progn (goto-char after-bullet-pos) | ||
| 5034 | (delete-char 1)) | ||
| 5035 | ;; Add the is-encrypted bullet qualifier: | ||
| 5036 | (goto-char after-bullet-pos) | ||
| 5037 | (insert "*")) | ||
| 5038 | ) | ||
| 5039 | ) | ||
| 5040 | ) | ||
| 5041 | ) | ||
| 5042 | ) | ||
| 5043 | ;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type rekey | ||
| 5044 | ;;; &optional retried verifying) | ||
| 5045 | (defun allout-encrypt-string (text decrypt allout-buffer key-type rekey | ||
| 5046 | &optional retried verifying) | ||
| 5047 | "Encrypt or decrypt a string TEXT using KEY. | ||
| 5048 | |||
| 5049 | If optional DECRYPT is true (default false), then decrypt instead of | ||
| 5050 | encrypt. | ||
| 5051 | |||
| 5052 | Optional REKEY (default false) provokes clearing of the key cache to force | ||
| 5053 | fresh prompting for the key. | ||
| 5054 | |||
| 5055 | Optional RETRIED is for internal use - conveys the number of failed keys have | ||
| 5056 | been solicited in sequence leading to this current call. | ||
| 5057 | |||
| 5058 | Optional VERIFYING is for internal use, signifying processing of text | ||
| 5059 | solely for verification of the cached key. | ||
| 5060 | |||
| 5061 | Returns the resulting string, or nil if the transformation fails." | ||
| 5062 | |||
| 5063 | ;; Ensure that we have an alternate handle on the real mc-activate-passwd: | ||
| 5064 | (if (not (fboundp 'real-mc-activate-passwd)) | ||
| 5065 | ;; Force loads of the primary mailcrypt packages, so flet below holds. | ||
| 5066 | (progn (require 'mailcrypt) | ||
| 5067 | (load "mc-toplev") | ||
| 5068 | (fset 'real-mc-activate-passwd | ||
| 5069 | (symbol-function 'mc-activate-passwd)))) | ||
| 5070 | |||
| 5071 | (if (and rekey (not verifying)) (mc-deactivate-passwd)) | ||
| 5072 | |||
| 5073 | (catch 'encryption-failed | ||
| 5074 | (save-excursion | ||
| 5075 | |||
| 5076 | (let* ((mc-default-scheme (or allout-encryption-scheme | ||
| 5077 | allout-default-encryption-scheme)) | ||
| 5078 | (id (format "%s-%s" key-type | ||
| 5079 | (or (buffer-file-name allout-buffer) | ||
| 5080 | (buffer-name allout-buffer)))) | ||
| 5081 | (cached (real-mc-activate-passwd id nil)) | ||
| 5082 | (comment "Processed by allout driving mailcrypt") | ||
| 5083 | key work-buffer result result-text encryption-process-status) | ||
| 5084 | |||
| 5085 | (unwind-protect | ||
| 5086 | |||
| 5087 | ;; Interject our mc-activate-passwd wrapper: | ||
| 5088 | (flet ((mc-activate-passwd (id &optional prompt) | ||
| 5089 | (allout-mc-activate-passwd id prompt))) | ||
| 5090 | |||
| 5091 | (setq work-buffer | ||
| 5092 | (set-buffer (allout-encryption-produce-work-buffer text))) | ||
| 5093 | |||
| 5094 | (cond | ||
| 5095 | |||
| 5096 | ;; symmetric: | ||
| 5097 | ((equal key-type 'symmetric) | ||
| 5098 | (setq key (if verifying | ||
| 5099 | (real-mc-activate-passwd id nil) | ||
| 5100 | (allout-mc-activate-passwd id))) | ||
| 5101 | (setq encryption-process-status | ||
| 5102 | (crypt-encrypt-buffer key decrypt)) | ||
| 5103 | (if (zerop encryption-process-status) | ||
| 5104 | t | ||
| 5105 | (if verifying | ||
| 5106 | (throw 'encryption-failed nil) | ||
| 5107 | (mc-deactivate-passwd) | ||
| 5108 | (error "Symmetric-key encryption failed (%s) - wrong key?" | ||
| 5109 | encryption-process-status)))) | ||
| 5110 | |||
| 5111 | ;; encrypt 'keypair: | ||
| 5112 | ((not decrypt) | ||
| 5113 | (condition-case result | ||
| 5114 | (mailcrypt-encrypt 1) | ||
| 5115 | (error (mc-deactivate-passwd) | ||
| 5116 | (error "encryption failed: %s" | ||
| 5117 | (cadr result))))) | ||
| 5118 | |||
| 5119 | ;; decrypt 'keypair: | ||
| 5120 | (t (condition-case result | ||
| 5121 | (mc-decrypt) | ||
| 5122 | (error (mc-deactivate-passwd) | ||
| 5123 | (error "decryption failed: %s" | ||
| 5124 | (cadr result)))))) | ||
| 5125 | |||
| 5126 | (setq result-text (if (or (equal key-type 'keypair) | ||
| 5127 | (not decrypt)) | ||
| 5128 | (buffer-substring 1 (1- (point-max))) | ||
| 5129 | (buffer-string))) | ||
| 5130 | ;; validate result - non-empty | ||
| 5131 | (cond ((not result-text) | ||
| 5132 | (if verifying | ||
| 5133 | nil | ||
| 5134 | ;; Transformation was fruitless - retry with new key. | ||
| 5135 | (mc-deactivate-passwd) | ||
| 5136 | (allout-encrypt-string text allout-buffer decrypt nil | ||
| 5137 | (if retried (1+ retried) 1) | ||
| 5138 | verifying))) | ||
| 5139 | |||
| 5140 | ;; Barf if encryption yields extraordinary control chars: | ||
| 5141 | ((and (not decrypt) | ||
| 5142 | (string-match "[\C-a\C-k\C-o-\C-z\C-@]" result-text)) | ||
| 5143 | (error (concat "encryption produced unusable" | ||
| 5144 | " non-armored text - reconfigure!"))) | ||
| 5145 | |||
| 5146 | ;; valid result and just verifying or non-symmetric: | ||
| 5147 | ((or verifying (not (equal key-type 'symmetric))) | ||
| 5148 | result-text) | ||
| 5149 | |||
| 5150 | ;; valid result and regular symmetric - situate validator: | ||
| 5151 | (t | ||
| 5152 | ;; valid result and verifier needs to be situated in | ||
| 5153 | ;; allout-buffer: | ||
| 5154 | (set-buffer allout-buffer) | ||
| 5155 | (if (and (or rekey (not cached)) | ||
| 5156 | (not (allout-verify-key key allout-buffer))) | ||
| 5157 | (allout-situate-encryption-key-verifier key id)) | ||
| 5158 | result-text) | ||
| 5159 | ) | ||
| 5160 | ) | ||
| 5161 | |||
| 5162 | ;; unwind-protect emergence: | ||
| 5163 | (if work-buffer | ||
| 5164 | (kill-buffer work-buffer)) | ||
| 5165 | ) | ||
| 5166 | ) | ||
| 5167 | ) | ||
| 5168 | ) | ||
| 5169 | ) | ||
| 5170 | ;;;_ > allout-mc-activate-passwd (id &optional prompt) | ||
| 5171 | (defun allout-mc-activate-passwd (id &optional prompt) | ||
| 5172 | "Substituted for mc-activate-passwd during allout outline encryption. | ||
| 5173 | |||
| 5174 | We add key-verification to vanilla mc-activate-passwd. | ||
| 5175 | |||
| 5176 | We depend in some cases on values of the following allout-encrypt-string | ||
| 5177 | internal or prevailing variables: | ||
| 5178 | - key-type - 'symmetric or 'keypair | ||
| 5179 | - id - id associated with current key in key cache | ||
| 5180 | - allout-buffer - where subject text resides | ||
| 5181 | - retried - number of current attempts to obtain this key | ||
| 5182 | - rekey - user asked to present a new key - needs to be confirmed" | ||
| 5183 | |||
| 5184 | ;; - if we're doing non-symmetric key, just do normal mc-activate-passwd | ||
| 5185 | ;; - otherwise, if we are have a cached version of the key, then assume | ||
| 5186 | ;; it's verified and return it | ||
| 5187 | ;; - otherwise, prompt for a key, and: | ||
| 5188 | ;; - if we have a key verifier \(a string value which should decrypt | ||
| 5189 | ;; against a symmetric key), validate against the verifier | ||
| 5190 | ;; - if successful, return the verified key | ||
| 5191 | ;; - if unsuccessful: | ||
| 5192 | ;; - offer to use the new key | ||
| 5193 | ;; - if accepted, do confirm process | ||
| 5194 | ;; - if refused, try again until we get a correctly spelled one or the | ||
| 5195 | ;; user quits | ||
| 5196 | ;; - if no key verifier, resolicit the key to get corroboration and return | ||
| 5197 | ;; the corroborated key if spelled identically, or error if not. | ||
| 5198 | |||
| 5199 | (if (not (equal key-type 'symmetric)) | ||
| 5200 | ;; do regular mc-activate-passwd on non-symmetric key | ||
| 5201 | (real-mc-activate-passwd id prompt) | ||
| 5202 | |||
| 5203 | ;; Symmetric hereon: | ||
| 5204 | |||
| 5205 | (save-excursion | ||
| 5206 | (set-buffer allout-buffer) | ||
| 5207 | (let* ((hint (if (and (not (string= allout-key-hint-string "")) | ||
| 5208 | (or (equal allout-key-hint-handling 'always) | ||
| 5209 | (and (equal allout-key-hint-handling 'needed) | ||
| 5210 | retried))) | ||
| 5211 | (format " [%s]" allout-key-hint-string) | ||
| 5212 | "")) | ||
| 5213 | (retry-message (if retried (format " (%s retry)" retried) "")) | ||
| 5214 | (prompt-sans-hint (format "'%s' symmetric key%s: " | ||
| 5215 | (buffer-name allout-buffer) | ||
| 5216 | retry-message)) | ||
| 5217 | (full-prompt (format "'%s' symmetric key%s%s: " | ||
| 5218 | (buffer-name allout-buffer) | ||
| 5219 | hint retry-message)) | ||
| 5220 | (prompt full-prompt) | ||
| 5221 | (verifier-string (allout-get-encryption-key-verifier)) | ||
| 5222 | ;; force retention of cached passwords for five minutes while | ||
| 5223 | ;; we're in this particular routine: | ||
| 5224 | (mc-passwd-timeout 300) | ||
| 5225 | (cached (real-mc-activate-passwd id nil)) | ||
| 5226 | (got (or cached (real-mc-activate-passwd id full-prompt))) | ||
| 5227 | confirmation) | ||
| 5228 | |||
| 5229 | (if (not got) | ||
| 5230 | nil | ||
| 5231 | |||
| 5232 | ;; Duplicate our handle on the key so it's not clobbered by | ||
| 5233 | ;; deactivate-passwd memory clearing: | ||
| 5234 | (setq got (format "%s" got)) | ||
| 5235 | |||
| 5236 | (cond (verifier-string | ||
| 5237 | (if (and (not (allout-encrypt-string | ||
| 5238 | verifier-string 'decrypt allout-buffer | ||
| 5239 | 'symmetric nil 0 'verifying)) | ||
| 5240 | (if (yes-or-no-p | ||
| 5241 | (concat "Key differs from established" | ||
| 5242 | " - use new one instead? ")) | ||
| 5243 | ;; deactivate password for subsequent | ||
| 5244 | ;; confirmation: | ||
| 5245 | (progn (mc-deactivate-passwd) | ||
| 5246 | (setq prompt prompt-sans-hint) | ||
| 5247 | nil) | ||
| 5248 | t)) | ||
| 5249 | (progn (mc-deactivate-passwd) | ||
| 5250 | (error "Wrong key.")))) | ||
| 5251 | ;; Force confirmation by repetition for new key: | ||
| 5252 | ((or rekey (not cached)) (mc-deactivate-passwd)))) | ||
| 5253 | ;; we have a key and it's either verified and cached. | ||
| 5254 | ;; confirmation vs new input - doing mc-activate-passwd will do the | ||
| 5255 | ;; right thing, in either case: | ||
| 5256 | (setq confirmation | ||
| 5257 | (real-mc-activate-passwd id (concat prompt | ||
| 5258 | " ... confirm spelling: "))) | ||
| 5259 | (prog1 | ||
| 5260 | (if (equal got confirmation) | ||
| 5261 | confirmation | ||
| 5262 | (if (yes-or-no-p (concat "spelling of original and" | ||
| 5263 | " confirmation differ - retry? ")) | ||
| 5264 | (progn (setq retried (if retried (1+ retried) 1)) | ||
| 5265 | (mc-deactivate-passwd) | ||
| 5266 | ;; recurse to this routine: | ||
| 5267 | (mc-activate-passwd id prompt-sans-hint)) | ||
| 5268 | (mc-deactivate-passwd) | ||
| 5269 | (error "Confirmation failed."))) | ||
| 5270 | ;; reduce opportunity for memory cherry-picking by zeroing duplicate: | ||
| 5271 | (dotimes (i (length got)) | ||
| 5272 | (aset got i 0)) | ||
| 5273 | ) | ||
| 5274 | ) | ||
| 5275 | ) | ||
| 5276 | ) | ||
| 5277 | ) | ||
| 5278 | ;;;_ > allout-encryption-produce-work-buffer (text) | ||
| 5279 | (defun allout-encryption-produce-work-buffer (text) | ||
| 5280 | "Establish a new buffer filled with TEXT, for outline encrypion processing. | ||
| 5281 | |||
| 5282 | TEXT is massaged so outline collapsing, if any, is removed." | ||
| 5283 | (let ((work-buffer (generate-new-buffer " *allout encryption*"))) | ||
| 5284 | (save-excursion | ||
| 5285 | (set-buffer work-buffer) | ||
| 5286 | (insert (subst-char-in-string ?\r ?\n text))) | ||
| 5287 | work-buffer)) | ||
| 5288 | ;;;_ > allout-encrypted-topic-p () | ||
| 5289 | (defun allout-encrypted-topic-p () | ||
| 5290 | "True if the current topic is encryptable and encrypted." | ||
| 5291 | (save-excursion | ||
| 5292 | (allout-end-of-prefix t) | ||
| 5293 | (and (string= (buffer-substring-no-properties (1- (point)) (point)) | ||
| 5294 | allout-topic-encryption-bullet) | ||
| 5295 | (looking-at "\\*")) | ||
| 5296 | ) | ||
| 5297 | ) | ||
| 5298 | ;;;_ > allout-encrypted-text-type (text) | ||
| 5299 | ;;; XXX gpg-specific, not generic! | ||
| 5300 | (defun allout-encrypted-text-type (text) | ||
| 5301 | "For gpg encrypted text, return 'symmetric or 'keypair." | ||
| 5302 | |||
| 5303 | ;; Ensure mc-gpg-path has a value: | ||
| 5304 | (if (not (boundp 'mc-gpg-path)) | ||
| 5305 | (load-library "mc-gpg")) | ||
| 5306 | |||
| 5307 | (save-excursion | ||
| 5308 | (let* ((work-buffer (set-buffer | ||
| 5309 | (allout-encryption-produce-work-buffer text))) | ||
| 5310 | (result (mc-gpg-process-region (point-min) (point-max) | ||
| 5311 | nil mc-gpg-path | ||
| 5312 | '("--batch" "--decrypt") | ||
| 5313 | 'mc-gpg-decrypt-parser | ||
| 5314 | work-buffer nil))) | ||
| 5315 | (cond ((equal (nth 0 result) 'symmetric) | ||
| 5316 | 'symmetric) | ||
| 5317 | ((equal (nth 0 result) t) | ||
| 5318 | 'keypair) | ||
| 5319 | (t (error "Unrecognized/unsupported encryption type %S" | ||
| 5320 | (nth 0 result)))) | ||
| 5321 | ) | ||
| 5322 | ) | ||
| 5323 | ) | ||
| 5324 | ;;;_ > allout-create-encryption-key-verifier (key id) | ||
| 5325 | (defun allout-create-encryption-key-verifier (key id) | ||
| 5326 | "Encrypt a random message for later validation of symmetric key." | ||
| 5327 | ;; use 20 random ascii characters, across the entire ascii range. | ||
| 5328 | (random t) | ||
| 5329 | (let ((spew (make-string 20 ?\0))) | ||
| 5330 | (dotimes (i (length spew)) | ||
| 5331 | (aset spew i (1+ (random 254)))) | ||
| 5332 | (allout-encrypt-string spew nil nil 'symmetric nil nil t)) | ||
| 5333 | ) | ||
| 5334 | ;;;_ > allout-situate-encryption-key-verifier (key id) | ||
| 5335 | (defun allout-situate-encryption-key-verifier (key id) | ||
| 5336 | "Establish key verifier string on file variable. | ||
| 5337 | |||
| 5338 | We also prompt for and situate a new reminder, if reminders are enabled. | ||
| 5339 | |||
| 5340 | We massage the string to simplify programmatic adjustment. File variable | ||
| 5341 | is `allout-file-key-verifier-string'." | ||
| 5342 | (let ((verifier-string | ||
| 5343 | ;; Collapse to a single line and enclose in string quotes: | ||
| 5344 | (subst-char-in-string ?\n ?\C-a | ||
| 5345 | (allout-create-encryption-key-verifier | ||
| 5346 | key id))) | ||
| 5347 | (reminder (if (not (equal allout-key-hint-handling 'disabled)) | ||
| 5348 | (read-from-minibuffer | ||
| 5349 | "Key hint to jog your memory next time: " | ||
| 5350 | allout-key-hint-string)))) | ||
| 5351 | (setq allout-key-verifier-string verifier-string) | ||
| 5352 | (allout-adjust-file-variable "allout-key-verifier-string" | ||
| 5353 | verifier-string) | ||
| 5354 | (cond ((equal allout-key-hint-handling 'disabled) | ||
| 5355 | nil) | ||
| 5356 | ((not (string= reminder allout-key-hint-string)) | ||
| 5357 | (setq allout-key-hint-string reminder) | ||
| 5358 | (allout-adjust-file-variable "allout-key-hint-string" | ||
| 5359 | reminder))) | ||
| 5360 | ) | ||
| 5361 | ) | ||
| 5362 | ;;;_ > allout-get-encryption-key-verifier () | ||
| 5363 | (defun allout-get-encryption-key-verifier () | ||
| 5364 | "Return the text of the encrypt key verifier, unmassaged, or nil if none. | ||
| 5365 | |||
| 5366 | Derived from value of `allout-file-key-verifier-string'." | ||
| 5367 | |||
| 5368 | (let ((verifier-string (and (boundp 'allout-key-verifier-string) | ||
| 5369 | allout-key-verifier-string))) | ||
| 5370 | (if verifier-string | ||
| 5371 | ;; Return it uncollapsed | ||
| 5372 | (subst-char-in-string ?\C-a ?\n verifier-string) | ||
| 5373 | nil) | ||
| 5374 | ) | ||
| 5375 | ) | ||
| 5376 | ;;;_ > allout-verify-key (key) | ||
| 5377 | (defun allout-verify-key (key allout-buffer) | ||
| 5378 | "True if key successfully decrypts key verifier, nil otherwise. | ||
| 5379 | |||
| 5380 | \"Otherwise\" includes absence of key verifier." | ||
| 5381 | (save-excursion | ||
| 5382 | (set-buffer allout-buffer) | ||
| 5383 | (and (boundp 'allout-key-verifier-string) | ||
| 5384 | allout-key-verifier-string | ||
| 5385 | (allout-encrypt-string (allout-get-encryption-key-verifier) | ||
| 5386 | 'decrypt allout-buffer 'symmetric | ||
| 5387 | nil nil 'verifying) | ||
| 5388 | t))) | ||
| 5389 | ;;;_ > allout-next-topic-pending-encryption (&optional except-mark) | ||
| 5390 | (defun allout-next-topic-pending-encryption (&optional except-mark) | ||
| 5391 | "Return the point of the next topic pending encryption, or nil if none. | ||
| 5392 | |||
| 5393 | EXCEPT-MARK identifies a point whose containing topics should be excluded | ||
| 5394 | from encryption. This supports 'except-current mode of | ||
| 5395 | `allout-encrypt-unencrypted-on-saves'. | ||
| 5396 | |||
| 5397 | Such a topic has the allout-topic-encryption-bullet without an | ||
| 5398 | immediately following '*' that would mark the topic as being encrypted. It | ||
| 5399 | must also have content." | ||
| 5400 | (let (done got content-beg) | ||
| 5401 | (while (not done) | ||
| 5402 | |||
| 5403 | (if (not (re-search-forward | ||
| 5404 | (format "\\(\\`\\|[\n\r]\\)%s *%s[^*]" | ||
| 5405 | (regexp-quote allout-header-prefix) | ||
| 5406 | (regexp-quote allout-topic-encryption-bullet)) | ||
| 5407 | nil t)) | ||
| 5408 | (setq got nil | ||
| 5409 | done t) | ||
| 5410 | (goto-char (setq got (match-beginning 0))) | ||
| 5411 | (if (looking-at "[\n\r]") | ||
| 5412 | (forward-char 1)) | ||
| 5413 | (setq got (point))) | ||
| 5414 | |||
| 5415 | (cond ((not got) | ||
| 5416 | (setq done t)) | ||
| 5417 | |||
| 5418 | ((not (re-search-forward "[\n\r]")) | ||
| 5419 | (setq got nil | ||
| 5420 | done t)) | ||
| 5421 | |||
| 5422 | ((eobp) | ||
| 5423 | (setq got nil | ||
| 5424 | done t)) | ||
| 5425 | |||
| 5426 | (t | ||
| 5427 | (setq content-beg (point)) | ||
| 5428 | (backward-char 1) | ||
| 5429 | (allout-end-of-subtree) | ||
| 5430 | (if (or (<= (point) content-beg) | ||
| 5431 | (and except-mark | ||
| 5432 | (<= content-beg except-mark) | ||
| 5433 | (>= (point) except-mark))) | ||
| 5434 | ;; Continue looking | ||
| 5435 | (setq got nil) | ||
| 5436 | ;; Got it! | ||
| 5437 | (setq done t))) | ||
| 5438 | ) | ||
| 5439 | ) | ||
| 5440 | (if got | ||
| 5441 | (goto-char got)) | ||
| 5442 | ) | ||
| 5443 | ) | ||
| 5444 | ;;;_ > allout-encrypt-decrypted (&optional except-mark) | ||
| 5445 | (defun allout-encrypt-decrypted (&optional except-mark) | ||
| 5446 | "Encrypt topics pending encryption except those containing exemption point. | ||
| 5447 | |||
| 5448 | EXCEPT-MARK identifies a point whose containing topics should be excluded | ||
| 5449 | from encryption. This supports 'except-current mode of | ||
| 5450 | `allout-encrypt-unencrypted-on-saves'. | ||
| 5451 | |||
| 5452 | If a topic that is currently being edited was encrypted, we return a list | ||
| 5453 | containing the location of the topic and the location of the cursor just | ||
| 5454 | before the topic was encrypted. This can be used, eg, to decrypt the topic | ||
| 5455 | and exactly resituate the cursor if this is being done as part of a file | ||
| 5456 | save. See `allout-encrypt-unencrypted-on-saves' for more info." | ||
| 5457 | |||
| 5458 | (interactive "p") | ||
| 5459 | (save-excursion | ||
| 5460 | (let ((current-mark (point-marker)) | ||
| 5461 | was-modified | ||
| 5462 | bo-subtree | ||
| 5463 | editing-topic editing-point) | ||
| 5464 | (goto-char (point-min)) | ||
| 5465 | (while (allout-next-topic-pending-encryption except-mark) | ||
| 5466 | (setq was-modified (buffer-modified-p)) | ||
| 5467 | (if (save-excursion | ||
| 5468 | (and (boundp 'allout-encrypt-unencrypted-on-saves) | ||
| 5469 | allout-encrypt-unencrypted-on-saves | ||
| 5470 | (setq bo-subtree (re-search-forward "[\n\r]")) | ||
| 5471 | ;; Not collapsed: | ||
| 5472 | (string= (match-string 0) "\n") | ||
| 5473 | (>= current-mark (point)) | ||
| 5474 | (allout-end-of-current-subtree) | ||
| 5475 | (<= current-mark (point)))) | ||
| 5476 | (setq editing-topic (point) | ||
| 5477 | ;; we had to wait for this 'til now so prior topics are | ||
| 5478 | ;; encrypted, any relevant text shifts are in place: | ||
| 5479 | editing-point (marker-position current-mark))) | ||
| 5480 | (allout-toggle-current-subtree-encryption) | ||
| 5481 | (if (not was-modified) | ||
| 5482 | (set-buffer-modified-p nil)) | ||
| 5483 | ) | ||
| 5484 | (if (not was-modified) | ||
| 5485 | (set-buffer-modified-p nil)) | ||
| 5486 | (if editing-topic (list editing-topic editing-point)) | ||
| 5487 | ) | ||
| 5488 | ) | ||
| 5489 | ) | ||
| 5490 | |||
| 5491 | ;;;_ #9 miscellaneous | ||
| 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 | |||
| 5527 | Returns list `(beginning-point prefix-string suffix-string)'." | ||
| 5528 | ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function. | ||
| 5529 | (let (beg prefix suffix) | ||
| 5530 | (save-excursion | ||
| 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 | |||
| 5555 | This activity is inhibited if either `enable-local-variables' | ||
| 5556 | `allout-enable-file-variable-adjustment' are nil. | ||
| 5557 | |||
| 5558 | When enabled, an entry for the variable is created if not already present, | ||
| 5559 | or changed if established with a different value. The section for the file | ||
| 5560 | variables, itself, is created if not already present. When created, the | ||
| 5561 | section lines \(including the section line) exist as second-level topics in | ||
| 5562 | a top-level topic at the end of the file. | ||
| 5563 | |||
| 5564 | enable-local-variables must be true for any of this to happen." | ||
| 5565 | (if (not (and enable-local-variables | ||
| 5566 | allout-enable-file-variable-adjustment)) | ||
| 5567 | nil | ||
| 5568 | (save-excursion | ||
| 5569 | (let ((section-data (allout-file-vars-section-data)) | ||
| 5570 | beg prefix suffix) | ||
| 5571 | (if section-data | ||
| 5572 | (setq beg (car section-data) | ||
| 5573 | prefix (cadr section-data) | ||
| 5574 | suffix (car (cddr section-data))) | ||
| 5575 | ;; create the section | ||
| 5576 | (goto-char (point-max)) | ||
| 5577 | (open-line 1) | ||
| 5578 | (allout-open-topic 0) | ||
| 5579 | (end-of-line) | ||
| 5580 | (insert "Local emacs vars.\n") | ||
| 5581 | (allout-open-topic 1) | ||
| 5582 | (setq beg (point) | ||
| 5583 | suffix "" | ||
| 5584 | prefix (buffer-substring-no-properties (progn | ||
| 5585 | (beginning-of-line) | ||
| 5586 | (point)) | ||
| 5587 | beg)) | ||
| 5588 | (goto-char beg) | ||
| 5589 | (insert "Local variables:\n") | ||
| 5590 | (allout-open-topic 0) | ||
| 5591 | (insert "End:\n") | ||
| 5592 | ) | ||
| 5593 | ;; look for existing entry or create one, leaving point for insertion | ||
| 5594 | ;; of new value: | ||
| 5595 | (goto-char beg) | ||
| 5596 | (allout-show-to-offshoot) | ||
| 5597 | (if (search-forward (concat "\n" prefix varname ":") nil t) | ||
| 5598 | (let* ((value-beg (point)) | ||
| 5599 | (line-end (progn (if (re-search-forward "[\n\r]" nil t) | ||
| 5600 | (forward-char -1)) | ||
| 5601 | (point))) | ||
| 5602 | (value-end (- line-end (length suffix)))) | ||
| 5603 | (if (> value-end value-beg) | ||
| 5604 | (delete-region value-beg value-end))) | ||
| 5605 | (end-of-line) | ||
| 5606 | (open-line 1) | ||
| 5607 | (forward-line 1) | ||
| 5608 | (insert (concat prefix varname ":"))) | ||
| 5609 | (insert (format " %S%s" value suffix)) | ||
| 5610 | ) | ||
| 5611 | ) | ||
| 5612 | ) | ||
| 5613 | ) | ||
| 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)." | |||
| 4594 | Representations of actual backslashes - '\\\\\\\\' - are left as a | 5651 | Representations of actual backslashes - '\\\\\\\\' - are left as a |
| 4595 | single backslash. | 5652 | single backslash. |
| 4596 | 5653 | ||
| 4597 | \(fn REGEXP)" | 5654 | Optional 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. | ||
| 5694 | Unless optional argument INPLACE is non-nil, return a new string." | ||
| 5695 | (let ((i (length string)) | ||
| 5696 | (newstr (if inplace string (copy-sequence string)))) | ||
| 5697 | (while (> i 0) | ||
| 5698 | (setq i (1- i)) | ||
| 5699 | (if (eq (aref newstr i) fromchar) | ||
| 5700 | (aset newstr i tochar))) | ||
| 5701 | newstr))) | ||
| 5702 | |||
| 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 | ||
| 4643 | XEmacs takes two optional args, while GNU Emacs does not, | 5707 | XEmacs takes two optional args, while mainline GNU Emacs does not, |
| 4644 | so pass them along when appropriate." | 5708 | so 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." |